;;;-*- Mode:LISP; Package:LAMBDA; Lowercase:T; Base:8; Readtable:ZL -*- code segment to do disk op. (build-iopb iopb-base-address smd-read-command default-unit head cylinder sector 1 ;one sector 2 ;dma-count 2000) ;buffer area address (disk-go-command) (wait-for-iopb-completion) (defun build-iopb (iopb-base-address command unit head cylinder starting-sector number-of-sectors dma-count buffer-memory-address &optional (fctn 'write-iopb)) (FUNCALL FCTN 0 command) (FUNCALL FCTN 1 word-mode-option) ;command options (FUNCALL FCTN 2 0) ;reset status (FUNCALL FCTN 3 0) ;reset errors (FUNCALL FCTN 4 unit) ;unit select (FUNCALL FCTN 5 head) ;head select (FUNCALL FCTN 6 (ldb 1010 cylinder)) ;cylinder select [high byte] (FUNCALL FCTN 7 (ldb 0010 cylinder)) ;cylinder select [low byte] (FUNCALL FCTN 10 (ldb 1010 starting-sector)) ;high byte (FUNCALL FCTN 11 (ldb 0010 starting-sector)) ;low byte (FUNCALL FCTN 12 (ldb 1010 number-of-sectors)) ;sector count [high byte] (FUNCALL FCTN 13 (ldb 0010 number-of-sectors)) ;sector count [low byte] (FUNCALL FCTN 14 dma-count) ;dma count (let ((buf (if (listp buffer-memory-address) (car buffer-memory-address) (multibus-real-address buffer-memory-address)))) (FUNCALL FCTN 15 (ldb 2010 buf)) ;buffer [data] address (FUNCALL FCTN 16 (ldb 1010 buf)) (FUNCALL FCTN 17 (ldb 0010 buf))) (FUNCALL FCTN 20 (ldb 1010 disk-base-reg-address)) ;must be the same as that set by switch (FUNCALL FCTN 21 (ldb 0010 disk-base-reg-address)) (FUNCALL FCTN 22 0) ;relative address irrelevent in (FUNCALL FCTN 23 0) ; absolute addressing mode (FUNCALL FCTN 24 0) ;reserved (FUNCALL FCTN 25 0) ;no linked iopbs [XMB] (FUNCALL FCTN 26 0) ;no linked iopbs [MSB] (FUNCALL FCTN 27 0)) (defun build-iopb-in-nubus-memory (nubus-base-address command unit head cylinder starting-sector number-of-sectors dma-count buffer-memory-address) (build-iopb (* 4 nubus-base-address) command unit head cylinder starting-sector number-of-sectors dma-count (list buffer-memory-address) 'write-iopb-to-nubus)) (defun disk-go-command () ;GO! (let ((prime-memory-adr (+ (ash (cadr (car (send *proc* :memory-configuration-list))) 10.) ;(dpb (SEND *PROC* :MEM-SLOT) (byte 4 24.) #xf0000000) (* debug-program-share-iopb-structure 4)))) (send *proc* :bus-write-byte (+ prime-memory-adr share-iopb-runme-offset) 1) (send *proc* :bus-write-byte multibus-interrupt-7 1))) (DEFUN WAIT-FOR-IOPB-COMPLETION (&OPTIONAL (BREAK-ON-ERROR-P T) (FCTN 'READ-IOPB)) (DO ((STATUS (READ-IOPB-STATUS FCTN) (READ-IOPB-STATUS FCTN)) (START-TIME (TIME))) ;initialize time (()) (COND ((OR (= STATUS 0) (= STATUS SMD-BUSY))) ;command in progress ((= STATUS SMD-OP-OK) (RETURN STATUS)) ((= STATUS SMD-ERROR) (COND ((NOT (NULL BREAK-ON-ERROR-P)) (PRINT-IP-ERROR (READ-IOPB-ERROR FCTN)) (ferror 'eagle-disk-error "disk error status ~o, type ~O" STATUS (READ-IOPB-ERROR FCTN)) (return status)) (T (RETURN STATUS)))) (T (FORMAT T "~%bad disk status read ~o: current iopb" STATUS) (PRINT-IOPB IOPB-BASE-ADDRESS FCTN))) )) (DEFUN LAM-DISK-XFER-VIA-NUBUS (FCN DISK-BLOCK-NUM CORE-PAGE-NUM N-BLOCKS &optional (dma-count 2)) (cond ((and (null sectors-per-track) (eq (send *proc* :disk-type) 'unknown)) (really-setup-for-unknown))) (PROG (CYLINDER HEAD SECTOR ERRCNT DBN FINAL-ADDRESS FINAL-SECTOR FINAL-HEAD FINAL-CYLINDER) (LET ((SECTORS-PER-CYLINDER (* sectors-per-track heads-per-cylinder)) ;BLOCKS-PER-CYLINDER ;(SECTORS-PER-TRACK BLOCKS-PER-TRACK) ) (SETQ DBN DISK-BLOCK-NUM) ; (COND ((NOT LAM-DISK-TYPE)(LAM-DISK-INIT))) (SETQ ERRCNT LAM-DISK-RETRY-COUNT) (COND ((NUMBERP DBN) (SETQ CYLINDER (// DBN SECTORS-PER-CYLINDER)) (SETQ SECTOR (\ DBN SECTORS-PER-CYLINDER)) (SETQ HEAD (// SECTOR SECTORS-PER-TRACK) SECTOR (\ SECTOR SECTORS-PER-TRACK)) (SETQ FINAL-ADDRESS (+ DBN (1- N-BLOCKS)) FINAL-CYLINDER (// FINAL-ADDRESS SECTORS-PER-CYLINDER) FINAL-SECTOR (\ FINAL-ADDRESS SECTORS-PER-CYLINDER) FINAL-HEAD (// FINAL-SECTOR SECTORS-PER-TRACK) FINAL-SECTOR (\ FINAL-SECTOR SECTORS-PER-TRACK))) (T (SETQ CYLINDER (CAR DBN) HEAD (CADR DBN) SECTOR (CADDR DBN)))) (setq cylinder (lam-offset-cylinder cylinder)) (WRITE-MULTIBUS-MAPPING-REGISTER lam-multibus-mapping-register-base (+ 1_23. (CADR-PAGE-TO-NUBUS-PAGE 1))) ;sys-communication-area, page 1 (DOTIMES (C N-BLOCKS) (WRITE-MULTIBUS-MAPPING-REGISTER (+ lam-multibus-mapping-register-base lam-multibus-mapping-register-data-offset c) (+ 1_23. (CADR-PAGE-TO-NUBUS-PAGE(+ C CORE-PAGE-NUM))))) (BUILD-IOPB-IN-NUBUS-MEMORY 650 FCN DEFAULT-UNIT HEAD CYLINDER SECTOR N-BLOCKS dma-count (ASH (+ lam-multibus-mapping-register-base lam-multibus-mapping-register-data-offset) 10.)) (DISK-GO-COMMAND) (WAIT-FOR-IOPB-COMPLETION-NUBUS 650) (RETURN T)))) (defun write-multibus-mapping-register (page-number data) (if (not (< page-number 2000)) (break "page number too big")) (dotimes (c 3) (funcall *proc* :multibus-byte-write (+ #16r18000 (* 4 page-number) c) (ldb (dpb c 1102 10) data))) data) (DEFCONST IP-ERROR-CODES-ALIST '((0 . "everything ok, or the controller hasn't looked yet") (#16R10 . "disk-not-ready") (#16R11 . "invalid disk address") (#16R12 . "seek error") (#16R13 . "ecc code error-data field") (#16R14 . "invalid command code") (#16R15 . "/"unused/"") (#16R16 . "invalid sector in command") (#16R17 . "/"spare/"") (#16R18 . "bus timeout") (#16R19 . "/"not used/"") (#16R1A . "disk write-proctected") (#16R1B . "unit not selected") (#16R1C . "no address mark - header field") (#16R1D . "/"not used/"") (#16R1E . "drive faulted") (#16R1F . "/"not used/"") (#16R20 . "/"not used/"") (#16R21 . "/"not used/"") (#16R22 . "/"not used/"") (#16R23 . "uncorrectable error") (#16R24 . "/"spare/"") (#16R25 . "/"spare/"") (#16R26 . "no sector pulse") (#16R27 . "data overrun") (#16R28 . "no index pulse on write format") (#16R29 . "sector not found") (#16R2A . "id field error-wrong head") (#16R2B . "invalid sync in data field") (#16R2D . "seek timeout error") (#16R2E . "busy timeout") (#16R2F . "not on cylinder") (#16R30 . "rtz timeout") (#16R31 . "format overrun on data") (#16R40 . "unit not initialized") (#16R42 . "gap specification error") (#16R4B . "seek error") (#16R4C . "mapped header error") (#16R50 . "sector per track error in UIB, 2190 only") (#16R51 . "bytes//sector speccification error") (#16R52 . "interleave specification error") (#16R53 . "invalid head address") (#16R54 . "invalid DMA burst count, 2190 only")))