;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for Lambda-Diag version 7.1 ;;; Reason: ;;; patches required for explorer diags ;;; Written 19-Mar-86 13:42:21 by pace at site LMI Cambridge ;;; while running on Lambda Two from band 2 ;;; with Experimental System 110.121, Experimental Lambda-Diag 7.0, Experimental Local-File 68.1, Experimental FILE-Server 18.2, Experimental Unix-Interface 9.0, Experimental ZMail 65.7, Experimental Object Lisp 3.0, Experimental Tape 6.0, Experimental Site Data Editor 3.1, Experimental Tiger 24.0, Experimental KERMIT 31.2, Experimental Window-Maker 1.0, Experimental Gateway 4.0, Experimental TCP-Kernel 39.5, Experimental TCP-User 62.5, Experimental TCP-Server 45.5, Experimental MEDIUM-RESOLUTION-COLOR 3.0, Experimental MICRO-COMPILATION-TOOLS 3.0, microcode 1408, SDU ROM 102, Alpha III Cambridge. ; From file DJ: L.LAMBDA-DIAG; EXPLORER-SPI.LISP#28 at 19-Mar-86 13:42:22 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; EXPLORER-SPI  " (defvar spi-baud-rate 2400.) )) ; From file DJ: L.LAMBDA-DIAG; REGINT-EXPLORER.LISP#49 at 19-Mar-86 13:43:13 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; REGINT-EXPLORER  " (defmethod (regint-explorer :full-save) (&aux (imod 0) spi-status trace-adr) (cond ((not lam-full-save-valid) (lam-stop-mach) (lam-passive-save) (setq spi-status (spi-read-spi-status)) (if (ldb-test (byte 1 8) spi-status) ;imod-low (setq imod (spi-read-obus))) (if (ldb-test (byte 1 9) spi-status) ;imod-hi (setq imod (ash (spi-read-obus) 32.))) (cond ((zerop (ldb (byte 1 12.) spi-status)) ;halt FF (spi-trace-off) (setq lam-noop-flag (not (ldb-test (byte 1 7.) spi-status))) (setq lam-saved-ir nil) (spi-write-ir 0) (setq lam-saved-lpc (spi-read-nth-previous-pc 2)) (setq lam-saved-pc (ldb (byte 14. 0) (spi-read-nth-previous-pc 1))) (spi-write-trace-ram-adr (logand 1777 (- (spi-read-trace-ram-adr) 1))) (setq lam-last-inst-had-halt-bit t) ) ((null new-full-save) (setq lam-saved-lpc (spi-read-pc)) (setq lam-saved-ir (logior imod (spi-read-ir))) (spi-trace-off) (spi-single-step) ;execute inst in real IREG (setq lam-saved-pc (spi-read-pc)) (setq lam-noop-flag (not (ldb-test (byte 1 7) (spi-read-spi-status)))) (spi-force-noop) (spi-single-step) (spi-force-noop) (spi-single-step) ) (t (setq lam-saved-lpc (spi-read-pc)) (setq lam-saved-ir (logior imod (spi-read-ir))) (spi-trace-off) ;have to turn off before reading adr (setq trace-adr (logand 1777 (spi-read-trace-ram-adr))) (spi-trace-on) (spi-execute-ireg-at-full-speed) (spi-trace-off) (spi-write-trace-ram-adr (logand 1777 trace-adr)) (let ((trace-data (spi-read-trace-ram-data))) (setq lam-saved-pc (ldb (byte 14. 0) trace-data)) (setq lam-noop-flag (not (ldb-test (byte 1 15.) trace-data)))) (spi-write-trace-ram-adr trace-adr) ) ) (lam-save-mem-status) (cond ((null lam-saved-ir) (setq lam-saved-ir (send self :read-c-mem lam-saved-lpc)))) (setq memory-configuration-list nil) (when (= (ldb (byte 24. 0) (send *proc* :read-a-mem #o100)) (send lam-file-symbols-loaded-from :version)) (setq memory-configuration-list (get-explorer-memory-from-a-mem))) (setq lam-full-save-valid t)))) )) ; From file DJ: L.LAMBDA-DIAG; REGINT-EXPLORER.LISP#49 at 19-Mar-86 13:43:16 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; REGINT-EXPLORER  " (defun get-explorer-memory-from-a-mem (&aux result) (do ((i 0 (1+ i))) (()) (let ((a-pmo (lam-lookup-name (intern (format nil "A-PMO-~d" i) "LAM"))) (a-pmh (lam-lookup-name (intern (format nil "A-PMH-~d" i) "LAM")))) (cond ((null a-pmo) (return)) (t (setq a-pmo (- a-pmo raamo)) (setq a-pmh (- a-pmh raamo)) (let ((offset (send *proc* :read-a-mem a-pmo)) (size (send *proc* :read-a-mem a-pmh))) (cond ((zerop size) (return)) (t (push (list size offset) result)))))))) (reverse result)) )) ; From file DJ: L.LAMBDA-DIAG; PRINT-UINST.LISP#35 at 19-Mar-86 13:43:56 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; PRINT-UINST  " (defconst lam-header-desc '( (select-field header-type 2305 (%HEADER-TYPE-ERROR %HEADER-TYPE-FEF %HEADER-TYPE-ARRAY-LEADER %HEADER-TYPE-LIST %HEADER-TYPE-FLONUM %HEADER-TYPE-COMPLEX %HEADER-TYPE-BIGNUM %HEADER-TYPE-RATIONAL %HEADER-TYPE-FAST-FEF-FIXED-ARGS-NO-LOCALS %HEADER-TYPE-FAST-FEF-VAR-ARGS-NO-LOCALS %HEADER-TYPE-FAST-FEF-FIXED-ARGS-WITH-LOCALS %HEADER-TYPE-FAST-FEF-VAR-ARGS-WITH-LOCALS )))) )) ; From file DJ: L.LAMBDA-DIAG; LAM.LISP#76 at 19-Mar-86 13:45:07 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAM  " (DEFUN (:PROPERTY summarize-opcs lam-colon-cmd) (ending-address) (if (null lam-saved-opcs-valid) (lam-save-opcs)) (or ending-address (setq ending-address (ecase (send *proc* :proc-type) (:lambda 7777) (:explorer 1777)))) (do ((adr 0 (1+ adr)) (censor-count) (censor-symbol) (new-censor-symbol) ;may have be a list with do-not-break list on the front. (new-real-censor-symbol) ;do-not-break-list is flushed if it was there. (last-censor-symbol) (opc) (regadr) (base-sym) (last-base-sym) (dif) (min-dif) (max-dif) (opc-adr-of-base) (ch)) ((or (>= adr ending-address) (and (setq ch (read-char-no-hang)) (not (= ch #\space)))) (cond ((not (null censor-count)) (format t "~&**censored ~O ~A's" censor-count censor-symbol) (setq censor-count nil))) (cond (last-base-sym (cond ((= (1+ opc-adr-of-base) adr) (format t "~%opc ~o// ~s ~o" opc-adr-of-base last-base-sym min-dif)) (t (format t "~%opc ~o-~o// ~A ~o-~o" opc-adr-of-base (1- adr) last-base-sym min-dif max-dif))))) nil) (setq opc (ecase (send *proc* :proc-type) (:lambda (aref lam-saved-opcs adr)) (:explorer (ldb (byte 14. 0) (send *proc* :read-opc adr))))) (cond ((not (zerop opc)) (setq regadr (+ opc racmo)) (let ((idx (lam-find-value regadr))) (cond ((>= idx 0) (setq base-sym (car (aref lam-symbols-value idx))) (setq last-censor-symbol new-censor-symbol) (cond ((setq new-censor-symbol (memq-or-memql base-sym summarize-opcs-censor-list)) (cond (last-base-sym (cond ((= (1+ opc-adr-of-base) adr) (format t "~%opc ~o// ~s ~o" opc-adr-of-base last-base-sym min-dif)) (t (format t "~%opc ~o-~o// ~A ~o-~o" opc-adr-of-base (1- adr) last-base-sym min-dif max-dif))) (setq last-base-sym nil))) (setq new-real-censor-symbol (if (symbolp new-censor-symbol) new-censor-symbol (cdr new-censor-symbol))) ;flush do-not-break list (cond ((null censor-count) (setq censor-count 1) (setq censor-symbol new-real-censor-symbol)) ((eq new-real-censor-symbol censor-symbol) (setq censor-count (1+ censor-count))) (t (format t "~&**censored ~O ~A's" censor-count censor-symbol) (setq censor-count 1 censor-symbol new-real-censor-symbol)))) ;following term inplements do-not-break-loop for one frob test. ((and (not (null censor-count)) (listp last-censor-symbol) ; (memq base-sym (car last-censor-symbol)) (< (1+ adr) ending-address) (memq (base-sym-of-opc (1+ adr)) (cdr last-censor-symbol))) (setq censor-count (1+ censor-count))) (t (cond ((not (null censor-count)) (format t "~&**censored ~O ~A's" censor-count censor-symbol) (setq censor-count nil))) (cond ((and last-base-sym (not (eq base-sym last-base-sym))) (cond ((= (1+ opc-adr-of-base) adr) (format t "~%opc ~o// ~s ~o" opc-adr-of-base last-base-sym min-dif)) (t (format t "~%opc ~o-~o// ~A ~o-~o" opc-adr-of-base (1- adr) last-base-sym min-dif max-dif))))) (cond ((not (eq base-sym last-base-sym)) (setq last-base-sym base-sym opc-adr-of-base adr min-dif 1000000 max-dif -105))) (setq dif (- regadr (cdr (aref lam-symbols-value idx)))) (setq min-dif (min min-dif dif) max-dif (max max-dif dif)) ;(setq closest-sym (cond ((zerop dif) base-sym) ; (t (list base-sym dif)))) ;(format t "~&opc ~O// ~A " adr closest-sym) ;(lam-print-reg-adr-contents ; (+ (logand 177777 (aref lam-saved-opcs adr)) racmo)) )) )) ) )) ) (format t "~&")) )) ; From file DJ: L.LAMBDA-DIAG; LAM.LISP#76 at 19-Mar-86 13:45:13 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAM  " (defun base-sym-of-opc (opc-adr) (let ((idx (lam-find-value (+ racmo (ecase (send *proc* :proc-type) (:lambda (aref lam-saved-opcs opc-adr)) (:explorer (ldb (byte 14. 0) (send *proc* :read-opc opc-adr)))))))) (cond ((>= idx 0) (car (aref lam-symbols-value idx)))))) )) ; From file DJ: L.LAMBDA-DIAG; LAMQF.LISP#33 at 19-Mar-86 13:46:59 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAMQF  " (DEFUN QF-VIRTUAL-MEM-MAP (ADR WRITE-CYCLE) (IF (NULL PHT-ADDR) (QF-SETUP-PHT-ADDR)) (SETQ ADR (QF-POINTER ADR)) ;FLUSH DATA TYPE ETC. (COND (*straight-map-mode* adr) ((< ADR (QF-POINTER (PHYS-MEM-READ (+ 400 %SYS-COM-WIRED-SIZE)))) ADR) ((>= adr qf-io-space-virtual-address) -5) ;multibus ((>= adr qf-multibus-virtual-address) -4) ;io space ((>= adr qf-a-memory-virtual-address) -3) ;a-memory ((EQ (ASH ADR -8) LAST-MAPPED-VIRTUAL-PAGE) (+ (LOGAND 377 ADR) (ASH LAST-MAPPED-PHYSICAL-PAGE 8))) (T (OR QF-PHT-CACHE (QF-REFILL-PHT-CACHE)) (LET ((PHT-SIZE (CADR QF-PHT-CACHE))) (DECLARE (FIXNUM PHT-SIZE)) (DO ((HASH (QF-COMPUTE-PAGE-HASH ADR) (+ HASH 2)) (PHT1) (PHT2) (TEM)(STS) (set-cache t) (COUNT (LSH PHT-SIZE -1) (1- COUNT))) ((= COUNT 0) -1) ;INACCESSIBLE (DECLARE (FIXNUM HASH PHT1 PHT2 COUNT TEM STS)) (AND (>= HASH PHT-SIZE) (SETQ HASH (- HASH PHT-SIZE))) (SETQ PHT1 (PHYS-MEM-READ (+ PHT-ADDR HASH))) (COND ((= 0 (LOGAND 100 PHT1)) ;NO VALID BIT (RETURN -1)) ;INACCESSIBLE ((= 0 (QF-MASK-PAGE-NUMBER (LOGXOR ADR PHT1))) ;ADDRESS MATCH (SETQ STS (LOGAND 7 PHT1)) ;ISOLATE SWAP STATUS CODE (COND ((OR (= STS 0) ;UNUSED ENTRY (= STS 6) ;UNUSED CODES (= STS 7)) (ERROR 'BAD-PAGE-HASH-ENTRY-AT-ADR HASH 'FAIL-ACT))) (SETQ PHT2 (PHYS-MEM-READ (+ PHT-ADDR HASH 1))) ;IN CORE, GET ADDRESS (COND ((= 5 (LDB %%PHT2-MAP-STATUS-CODE PHT2)) ;MAY BE IN PDL-BUFFER (setq set-cache nil) ;dont cache pdl buffer pages.. (cond ((and (NOT (< ADR (SETQ TEM (QF-POINTER (LAM-SYMBOLIC-EXAMINE-REGISTER 'A-PDL-BUFFER-VIRTUAL-ADDRESS))))) (<= ADR (+ TEM (LOGAND PDL-BUFFER-SIZE-MASK (- (LAM-SYMBOLIC-EXAMINE-REGISTER 'PP) (LAM-SYMBOLIC-EXAMINE-REGISTER 'a-pdl-buffer-head)))))) (RETURN -2)))) ;IN PDL-BUFFER ) ;IF DOING A WRITE-CYCLE INTO A PAGE, SET PHT1-MODIFIED BIT ;THIS HOPEFULLY ASSURES PAGE WILL GET WRITTEN ON DISK IF IT ;GETS SWAPPED OUT, EVEN IF THE ACCESS IS NOT READ/WRITE. (COND (WRITE-CYCLE (PHYS-MEM-WRITE (+ PHT-ADDR HASH) (DPB 1 %%PHT1-MODIFIED-BIT PHT1)))) (IF SET-CACHE (SETQ LAST-MAPPED-PHYSICAL-PAGE (LDB %%PHT2-PHYSICAL-PAGE-NUMBER PHT2) LAST-MAPPED-VIRTUAL-PAGE (ASH ADR -8))) (RETURN (+ (ASH (LDB %%PHT2-PHYSICAL-PAGE-NUMBER PHT2) 8) (LOGAND 377 ADR)))))))))) )) ; From file DJ: L.LAMBDA-DIAG; LAMQF.LISP#33 at 19-Mar-86 13:47:06 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAMQF  " (DEFUN QF-MEM-READ-TRANSPORT (ADR &optional inhibit-forwarding-messages) "Return contents of memory address ADR as a bignum, swapping or forwarding if nec." (LET (DATA) (DECLARE (FIXNUM DATA)) (SETQ DATA (QF-VIRTUAL-MEM-READ ADR)) (COND ((< DATA 0) (QF-SWAP-IN ADR) (SETQ DATA (QF-VIRTUAL-MEM-READ ADR)))) (AND (< DATA 0) (ERROR 'QF-MEM-READ-INACCESSIBLE ADR 'FAIL-ACT)) (SELECT (QF-DATA-TYPE DATA) ((DTP-GC-FORWARD DTP-ONE-Q-FORWARD DTP-HEADER-FORWARD DTP-EXTERNAL-VALUE-CELL-POINTER dtp-rplacd-forward) (if (null inhibit-forwarding-messages) (format t " ~s " (nth (qf-data-type data) q-data-types))) (QF-MEM-READ-TRANSPORT DATA)) (DTP-BODY-FORWARD (if (null inhibit-forwarding-messages) (format t " BODY-FORWARD ")) (QF-MEM-READ-TRANSPORT (+ (QF-POINTER (- ADR DATA)) (QF-MEM-READ DATA)))) (T DATA)))) )) ; From file DJ: L.LAMBDA-DIAG; LAMQF.LISP#33 at 19-Mar-86 13:47:52 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAMQF  " (DEFUN QF-CAR (LMOB &optional inhibit-forwarding-messages) (LET ((TYPE (QF-DATA-TYPE LMOB))) (cond ((or (= TYPE DTP-LIST) (= TYPE DTP-LOCATIVE) (= TYPE DTP-CLOSURE) (= type dtp-stack-closure) (= TYPE DTP-ENTITY)) (QF-TYPED-POINTER (QF-MEM-READ-TRANSPORT LMOB))) ((and (= type dtp-symbol) (zerop (qf-pointer lmob))) lmob) ((= type dtp-gc-forward) (if (null inhibit-forwarding-messages) (format t " GC-FORWARD ")) (qf-car (qf-typed-pointer (qf-mem-read-transport lmob)))) (t (ferror nil "Neither a cons nor a locative -- QF-CAR: ~s" LMOB))))) )) ; From file DJ: L.LAMBDA-DIAG; LAMQF.LISP#33 at 19-Mar-86 13:48:23 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAMQF  " (DEFUN QF-CDR (LMOB &optional inhibit-forwarding-messages) (LET ((TYPE (QF-DATA-TYPE LMOB))(L LMOB)) (SELECTN TYPE (DTP-LOCATIVE (QF-CAR LMOB)) ((DTP-LIST DTP-CLOSURE dtp-stack-closure DTP-ENTITY) (LET ((CDRC (QF-CDR-CODE (DO ((X (QF-MEM-READ LMOB) (QF-MEM-READ L))) (NIL) (SELECTN (QF-DATA-TYPE X) ((DTP-HEADER-FORWARD DTP-GC-FORWARD DTP-RPLACD-FORWARD) (if (null inhibit-forwarding-messages) (format t " ~s " (nth (qf-data-type x) q-data-types))) (SETQ L X)) (OTHERWISE (RETURN X))))))) (LET ((X (SELECT CDRC (cdr-normal (QF-MEM-READ (1+ L))) ;FULL CONS (cdr-error (ERROR '|CDR-ERROR encountered - QF-CDR| LMOB 'FAIL-ACT)) (cdr-nil QF-NIL) ;CDR NIL (cdr-next (1+ L)) (OTHERWISE (ERROR '|Lose big -- QF-CDR|))))) (DO ((X X (QF-MEM-READ X)) (ADR L X)) (NIL) (SELECTN (QF-DATA-TYPE X) ((DTP-HEADER-FORWARD DTP-GC-FORWARD DTP-ONE-Q-FORWARD DTP-EXTERNAL-VALUE-CELL-POINTER) (if (null inhibit-forwarding-messages) (format t " ~s " (nth (qf-data-type x) q-data-types))) NIL) (DTP-BODY-FORWARD (if (null inhibit-forwarding-messages) (format t " BODY-FORWARD ")) (LET ((OFFSET (- (QF-POINTER ADR) (QF-POINTER X)))) (SETQ X (+ (QF-MEM-READ X) OFFSET)))) (OTHERWISE (RETURN (QF-TYPED-POINTER X)))))))) (DTP-SYMBOL (cond ((and (= type dtp-symbol) (zerop (qf-pointer lmob))) lmob) (t (ferror nil "non-NIL symbol -- QF-CDR: ~s" LMOB)))) (dtp-gc-forward (if (null inhibit-forwarding-messages) (format t " GC-FORWARD ")) (qf-cdr (qf-typed-pointer (qf-mem-read-transport lmob)))) (OTHERWISE (ferror nil "Neither a cons nor a locative -- QF-CDR: ~s" LMOB))))) )) ; From file DJ: L.LAMBDA-DIAG; LAMQF.LISP#33 at 19-Mar-86 13:48:57 #8R LAMBDA#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LAMBDA"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; LAMQF  " (DEFUN QF-ARRAY-SETUP (Q &optional inhibit-forwarding-messages) (PROG (N) (OR (= (QF-DATA-TYPE Q) DTP-ARRAY-POINTER) (FERROR NIL "Data type of supposed array is ~s, not DTP-ARRAY-POINTER" (QF-DATA-TYPE Q))) A (SETQ QF-ARRAY-HEADER-ADDRESS (QF-POINTER Q)) (SETQ QF-ARRAY-HEADER (QF-MEM-READ QF-ARRAY-HEADER-ADDRESS)) (SETQ N (QF-DATA-TYPE QF-ARRAY-HEADER)) (COND ((= N DTP-ARRAY-HEADER)) ((OR (= N DTP-HEADER-FORWARD) (= N DTP-GC-FORWARD)) (if (null inhibit-forwarding-messages) (format t " ~s " (nth (qf-data-type qf-array-header) q-data-types))) (SETQ Q QF-ARRAY-HEADER) (GO A)) (T (FERROR NIL "Data type of supposed array header is ~s, not DTP-ARRAY-HEADER" N))) (SETQ QF-ARRAY-DISPLACED-P (= 1 (LDB %%ARRAY-DISPLACED-BIT QF-ARRAY-HEADER))) (SETQ QF-ARRAY-HAS-LEADER-P (= 1 (LDB %%ARRAY-LEADER-BIT QF-ARRAY-HEADER))) (SETQ QF-ARRAY-NUMBER-DIMS (LDB %%ARRAY-NUMBER-DIMENSIONS QF-ARRAY-HEADER)) (SETQ QF-ARRAY-DATA-ORIGIN (+ QF-ARRAY-NUMBER-DIMS QF-ARRAY-HEADER-ADDRESS)) (COND ((= 0 (LDB %%ARRAY-LONG-LENGTH-FLAG QF-ARRAY-HEADER)) (SETQ QF-ARRAY-LENGTH (LDB %%ARRAY-INDEX-LENGTH-IF-SHORT QF-ARRAY-HEADER))) (T (SETQ QF-ARRAY-DATA-ORIGIN (1+ QF-ARRAY-DATA-ORIGIN)) (SETQ QF-ARRAY-LENGTH (QF-POINTER (QF-MEM-READ (1+ QF-ARRAY-HEADER-ADDRESS)))))) )) )) ; From file DJ: L.LAMBDA-DIAG; UNIX-FS.LISP#4 at 19-Mar-86 13:50:26 #10R SDU#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SDU"))) (COMPILER::PATCH-SOURCE-FILE "SYS: LAMBDA-DIAG; UNIX-FS  " (defun test-dpo () (mapcar #'(lambda (x) (format t "~&~24a" x) (multiple-value-bind (offs path) (disk-partition-offset (parse-unix-pathname x)) (format t "~a ~a" offs path))) test-dpo-list)) ))