Ignore:
Timestamp:
08/18/11 17:38:53 (3 years ago)
Author:
rjs
Message:

Update from System 78.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lcadr/ccdisk.lisp

    r204 r274  
    2323                  %PHT-DUMMY-VIRTUAL-ADDRESS
    2424                  MICRO-CODE-SYMBOL-AREA-START MICRO-CODE-SYMBOL-AREA-END
    25                   PHT-ADDR SIZE-OF-PAGE-TABLE
     25                  PHT-ADDR
    2626                  INITIAL-LOD-NAME N-PARTITIONS
    2727                  N-HEADS N-CYLINDERS N-BLOCKS-PER-TRACK
     
    123123    (PRINC '|ECC ERROR BIT POSITION |)
    124124    (PRIN1 (LOGLDB 0020 (PHYS-MEM-READ (+ CC-DISK-ADDRESS 3))))
    125     (PRINT 'SAVED-COMMAND)
     125    (PRINT 'LAST-CC-COMMAND)
    126126    (CC-TYPE-OUT CC-DISK-LAST-CMD CC-DISK-CMD-DESC T T)
    127127    (PRINT 'DISK-ADDRESS)
     
    129129    (PRINT 'MEMORY-ADDRESS)
    130130    (PRIN1 (LOGLDB 0026 (PHYS-MEM-READ (+ CC-DISK-ADDRESS 1))))
    131     (PRINT 'SAVED-COMMAND-LIST-POINTER)
     131    (PRINT 'LAST-CC-COMMAND-LIST-POINTER)
    132132    (PRIN1 CC-DISK-LAST-CLP)
    133133    (PRINT 'COMMAND-LIST)
     
    202202                                 "Strobe Early" "Strobe Late"
    203203                                 "Servo Reverse -- Strobe Early"  ;NO COMMAS INSIDE STRINGS
    204                                  "Servo Reverse -- Strobe Late"   : IN MACLISP
     204                                 "Servo Reverse -- Strobe Late"   ; IN MACLISP
    205205                                 "Servo Forward -- Strobe Early"
    206206                                 "Servo Forward -- Strobe Late")
     
    300300
    301301;returns t if wins
     302; if DISK-BLOCK-NUM a list, its (track head sector).
    302303(DEFUN CC-DISK-XFER (FCN DISK-BLOCK-NUM CORE-PAGE-NUM N-BLOCKS)
    303   (PROG (TRACK HEAD SECTOR DUSH ERRCNT STATUS)
     304  (PROG (TRACK HEAD SECTOR DUSH ERRCNT STATUS
     305         FINAL-DUSH FINAL-ADDRESS FINAL-SECTOR FINAL-HEAD FINAL-TRACK)
    304306     (DECLARE (FIXNUM TRACK HEAD SECTOR DUSH ERRCNT STATUS))
    305307     (COND ((NOT CC-DISK-TYPE)(CC-DISK-INIT)))
    306308     (SETQ ERRCNT CC-DISK-RETRY-COUNT)
    307      (SETQ TRACK (// DISK-BLOCK-NUM BLOCKS-PER-CYLINDER))
    308      (SETQ SECTOR (\ DISK-BLOCK-NUM BLOCKS-PER-CYLINDER))
    309      (SETQ HEAD (// SECTOR BLOCKS-PER-TRACK)
    310            SECTOR (\ SECTOR BLOCKS-PER-TRACK))
     309     (COND ((NUMBERP DISK-BLOCK-NUM)
     310            (SETQ TRACK (// DISK-BLOCK-NUM BLOCKS-PER-CYLINDER))
     311            (SETQ SECTOR (\ DISK-BLOCK-NUM BLOCKS-PER-CYLINDER))
     312            (SETQ HEAD (// SECTOR BLOCKS-PER-TRACK)
     313                  SECTOR (\ SECTOR BLOCKS-PER-TRACK))
     314            (SETQ FINAL-ADDRESS (+ DISK-BLOCK-NUM (1- N-BLOCKS))
     315                  FINAL-TRACK (// FINAL-ADDRESS BLOCKS-PER-CYLINDER)
     316                  FINAL-SECTOR (\ FINAL-ADDRESS BLOCKS-PER-CYLINDER)
     317                  FINAL-HEAD (// FINAL-SECTOR BLOCKS-PER-TRACK)
     318                  FINAL-SECTOR (\ FINAL-SECTOR BLOCKS-PER-TRACK)))
     319           (T (SETQ TRACK (CAR DISK-BLOCK-NUM)
     320                    HEAD (CADR DISK-BLOCK-NUM)
     321                    SECTOR (CADDR DISK-BLOCK-NUM))))               
    311322     (SETQ DUSH (+ (CC-SHIFT TRACK 16.) (LSH HEAD 8) SECTOR))
    312323     (AND (> N-BLOCKS 366) ;We only want to use 1 page for the command list
     
    329340       (AND (ZEROP (LOGAND 1 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS))))
    330341            (GO WAIT))))
     342     (SETQ FINAL-DUSH (PHYS-MEM-READ (+ CC-DISK-ADDRESS 2)))
    331343     (COND ((NOT (ZEROP (LOGAND STATUS 47777560)))
    332344                ; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE,
     
    339351            (PRINT 'RETRYING)
    340352            (TERPRI)
     353            ;(BREAK CC-DISK-ERROR T)
     354            (GO LP))
     355           ((AND (NUMBERP FINAL-TRACK)
     356                 (OR (NOT (= FINAL-TRACK (LDB 2014 FINAL-DUSH)))
     357                     (NOT (= FINAL-HEAD (LDB 1010 FINAL-DUSH)))
     358                     (NOT (= FINAL-SECTOR (LDB 0010 FINAL-DUSH)))))
     359            (FORMAT T "~%Final disk address incorrect, is ~D,~D,~D; should be ~D,~D,~D"
     360                    (LDB 2014 FINAL-DUSH) (LDB 1010 FINAL-DUSH) (LDB 0010 FINAL-DUSH)
     361                    FINAL-TRACK FINAL-HEAD FINAL-SECTOR)
     362            (BREAK 'CC-FINAL-DISK-ADDRESS-ERROR T)
    341363            (GO LP)))
    342364     (RETURN T)         ;won
     
    346368; MAINLY GOOD FOR RETRYING TRANSFERS THAT LOSE, ETC.
    347369(DEFUN CC-DISK-XFER-TRACK-HEAD-SECTOR (FCN TRACK HEAD SECTOR CORE-PAGE-NUM N-BLOCKS)
    348   (DECLARE (FIXNUM TRACK HEAD SECTOR DUSH ERRCNT STATUS))
    349   (PROG (DUSH ERRCNT STATUS)
    350      (SETQ ERRCNT CC-DISK-RETRY-COUNT)
    351      (SETQ DUSH (+ (CC-SHIFT TRACK 16.) (LSH HEAD 8) SECTOR))
    352      (AND (> N-BLOCKS 366) ;We only want to use 1 page for the command list
    353           (ERROR N-BLOCKS 'TOO-MANY-BLOCKS-FOR-CMD-LIST 'FAIL-ACT))
    354  LP  ;;Set up the command list, starting at location 12, a bit of a kludge
    355      (DO ((I 12 (1+ I))
    356           (A CORE-PAGE-NUM (1+ A))
    357           (N N-BLOCKS (1- N)))
    358          ((= N 0))
    359        (PHYS-MEM-WRITE I (+ (CC-SHIFT A 8) (COND ((= N 1) 0) (T 1)))))
    360      (LET ((CTALK-BARF-AT-WRITE-ERRORS NIL))  ;THESE MIGHT NOT READ BACK EXACTLY THE SAME...
    361       (PROG NIL
    362        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 0) FCN) ;Store command, does reset
    363        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 1) 12)  ;Store CLP
    364        (SETQ CC-DISK-LAST-CMD FCN CC-DISK-LAST-CLP 12)
    365        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 2) DUSH)  ;Store disk address
    366        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 3) 0)   ;Start transfer
    367   WAIT ;;This loop awaits completion
    368        #M (SLEEP-JIFFIES 2)
    369        #Q (PROCESS-SLEEP 2)
    370        (AND (ZEROP (LOGAND 1 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS))))
    371             (GO WAIT))))
    372      (COND ((NOT (ZEROP (LOGAND STATUS 47777560)))
    373                 ; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE,
    374                 ; HEADER ECC, ECC HARD, ECC SOFT, OVERRUN, TRANSFER ABORTED,
    375                 ; START-BLOCK ERR, TIMEOUT, SEEK ERR, OFF LINE, OFF CYL, FAULT,
    376                 ;    NO SEL, MUL SEL
    377             (CC-DISK-ANALYZE)
    378             (AND (ZEROP (SETQ ERRCNT (1- ERRCNT)))
    379                  (RETURN NIL))
    380             (PRINT 'RETRYING)
    381             (TERPRI)
    382             (GO LP)))
    383      ))
     370  (CC-DISK-XFER FCN (LIST TRACK HEAD SECTOR) CORE-PAGE-NUM N-BLOCKS))
    384371
    385372
     
    536523    (CC-DISK-READ-IN-CORE 'PAGE)))
    537524
    538 (DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY NIL
     525(DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY ()
    539526  (DO ((TABLE-ADR PHT-ADDR (+ TABLE-ADR 2))
    540527       (HASH-ADR)
    541528       (PHT1)
    542        (COUNT (LSH SIZE-OF-PAGE-TABLE -1) (1- COUNT))
     529       (COUNT (LSH (QF-POINTER (PHYS-MEM-READ (+ PAGE-SIZE %SYS-COM-PAGE-TABLE-SIZE))) -1)
     530              (1- COUNT))
    543531       (NUMBER-ERRORS 0))
    544532      ((= COUNT 0) NUMBER-ERRORS)
Note: See TracChangeset for help on using the changeset viewer.