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

Update from System 78.

Files:
1 modified

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) 
     
    201201                                 "Strobe Early" "Strobe Late" 
    202202                                 "Servo Reverse -- Strobe Early"  ;NO COMMAS INSIDE STRINGS 
    203                                  "Servo Reverse -- Strobe Late"   : IN MACLISP 
     203                                 "Servo Reverse -- Strobe Late"   ; IN MACLISP 
    204204                                 "Servo Forward -- Strobe Early" 
    205205                                 "Servo Forward -- Strobe Late") 
     
    298298 
    299299;returns t if wins 
     300; if DISK-BLOCK-NUM a list, its (track head sector). 
    300301(DEFUN CC-DISK-XFER (FCN DISK-BLOCK-NUM CORE-PAGE-NUM N-BLOCKS) 
    301   (PROG (TRACK HEAD SECTOR DUSH ERRCNT STATUS) 
     302  (PROG (TRACK HEAD SECTOR DUSH ERRCNT STATUS 
     303         FINAL-DUSH FINAL-ADDRESS FINAL-SECTOR FINAL-HEAD FINAL-TRACK) 
    302304     (DECLARE (FIXNUM TRACK HEAD SECTOR DUSH ERRCNT STATUS)) 
    303305     (COND ((NOT CC-DISK-TYPE)(CC-DISK-INIT))) 
    304306     (SETQ ERRCNT CC-DISK-RETRY-COUNT) 
    305      (SETQ TRACK (// DISK-BLOCK-NUM BLOCKS-PER-CYLINDER)) 
    306      (SETQ SECTOR (\ DISK-BLOCK-NUM BLOCKS-PER-CYLINDER)) 
    307      (SETQ HEAD (// SECTOR BLOCKS-PER-TRACK) 
    308            SECTOR (\ SECTOR BLOCKS-PER-TRACK)) 
     307     (COND ((NUMBERP DISK-BLOCK-NUM) 
     308            (SETQ TRACK (// DISK-BLOCK-NUM BLOCKS-PER-CYLINDER)) 
     309            (SETQ SECTOR (\ DISK-BLOCK-NUM BLOCKS-PER-CYLINDER)) 
     310            (SETQ HEAD (// SECTOR BLOCKS-PER-TRACK) 
     311                  SECTOR (\ SECTOR BLOCKS-PER-TRACK)) 
     312            (SETQ FINAL-ADDRESS (+ DISK-BLOCK-NUM (1- N-BLOCKS)) 
     313                  FINAL-TRACK (// FINAL-ADDRESS BLOCKS-PER-CYLINDER) 
     314                  FINAL-SECTOR (\ FINAL-ADDRESS BLOCKS-PER-CYLINDER) 
     315                  FINAL-HEAD (// FINAL-SECTOR BLOCKS-PER-TRACK) 
     316                  FINAL-SECTOR (\ FINAL-SECTOR BLOCKS-PER-TRACK))) 
     317           (T (SETQ TRACK (CAR DISK-BLOCK-NUM) 
     318                    HEAD (CADR DISK-BLOCK-NUM) 
     319                    SECTOR (CADDR DISK-BLOCK-NUM))))                 
    309320     (SETQ DUSH (+ (CC-SHIFT TRACK 16.) (LSH HEAD 8) SECTOR)) 
    310321     (AND (> N-BLOCKS 366) ;We only want to use 1 page for the command list 
     
    327338       (AND (ZEROP (LOGAND 1 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS)))) 
    328339            (GO WAIT)))) 
     340     (SETQ FINAL-DUSH (PHYS-MEM-READ (+ CC-DISK-ADDRESS 2))) 
    329341     (COND ((NOT (ZEROP (LOGAND STATUS 47777560))) 
    330342                ; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE, 
     
    337349            (PRINT 'RETRYING) 
    338350            (TERPRI) 
     351            ;(BREAK CC-DISK-ERROR T) 
     352            (GO LP)) 
     353           ((AND (NUMBERP FINAL-TRACK) 
     354                 (OR (NOT (= FINAL-TRACK (LDB 2014 FINAL-DUSH))) 
     355                     (NOT (= FINAL-HEAD (LDB 1010 FINAL-DUSH))) 
     356                     (NOT (= FINAL-SECTOR (LDB 0010 FINAL-DUSH))))) 
     357            (FORMAT T "~%Final disk address incorrect, is ~D,~D,~D; should be ~D,~D,~D" 
     358                    (LDB 2014 FINAL-DUSH) (LDB 1010 FINAL-DUSH) (LDB 0010 FINAL-DUSH) 
     359                    FINAL-TRACK FINAL-HEAD FINAL-SECTOR) 
     360            (BREAK 'CC-FINAL-DISK-ADDRESS-ERROR T) 
    339361            (GO LP))) 
    340362     (RETURN T)         ;won 
     
    344366; MAINLY GOOD FOR RETRYING TRANSFERS THAT LOSE, ETC. 
    345367(DEFUN CC-DISK-XFER-TRACK-HEAD-SECTOR (FCN TRACK HEAD SECTOR CORE-PAGE-NUM N-BLOCKS) 
    346   (DECLARE (FIXNUM TRACK HEAD SECTOR DUSH ERRCNT STATUS)) 
    347   (PROG (DUSH ERRCNT STATUS) 
    348      (SETQ ERRCNT CC-DISK-RETRY-COUNT) 
    349      (SETQ DUSH (+ (CC-SHIFT TRACK 16.) (LSH HEAD 8) SECTOR)) 
    350      (AND (> N-BLOCKS 366) ;We only want to use 1 page for the command list 
    351           (ERROR N-BLOCKS 'TOO-MANY-BLOCKS-FOR-CMD-LIST 'FAIL-ACT)) 
    352  LP  ;;Set up the command list, starting at location 12, a bit of a kludge 
    353      (DO ((I 12 (1+ I)) 
    354           (A CORE-PAGE-NUM (1+ A)) 
    355           (N N-BLOCKS (1- N))) 
    356          ((= N 0)) 
    357        (PHYS-MEM-WRITE I (+ (CC-SHIFT A 8) (COND ((= N 1) 0) (T 1))))) 
    358      (LET ((CTALK-BARF-AT-WRITE-ERRORS NIL))  ;THESE MIGHT NOT READ BACK EXACTLY THE SAME... 
    359       (PROG NIL  
    360        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 0) FCN) ;Store command, does reset 
    361        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 1) 12)  ;Store CLP 
    362        (SETQ CC-DISK-LAST-CMD FCN CC-DISK-LAST-CLP 12) 
    363        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 2) DUSH)  ;Store disk address 
    364        (PHYS-MEM-WRITE (+ CC-DISK-ADDRESS 3) 0)   ;Start transfer 
    365   WAIT ;;This loop awaits completion 
    366        #M (SLEEP-JIFFIES 2) 
    367        #Q (PROCESS-SLEEP 2) 
    368        (AND (ZEROP (LOGAND 1 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS)))) 
    369             (GO WAIT)))) 
    370      (COND ((NOT (ZEROP (LOGAND STATUS 47777560))) 
    371                 ; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE, 
    372                 ; HEADER ECC, ECC HARD, ECC SOFT, OVERRUN, TRANSFER ABORTED, 
    373                 ; START-BLOCK ERR, TIMEOUT, SEEK ERR, OFF LINE, OFF CYL, FAULT, 
    374                 ;    NO SEL, MUL SEL 
    375             (CC-DISK-ANALYZE) 
    376             (AND (ZEROP (SETQ ERRCNT (1- ERRCNT))) 
    377                  (RETURN NIL)) 
    378             (PRINT 'RETRYING) 
    379             (TERPRI) 
    380             (GO LP))) 
    381      )) 
     368  (CC-DISK-XFER FCN (LIST TRACK HEAD SECTOR) CORE-PAGE-NUM N-BLOCKS)) 
    382369 
    383370 
     
    533520    (CC-DISK-READ-IN-CORE 'PAGE))) 
    534521 
    535 (DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY NIL  
     522(DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY () 
    536523  (DO ((TABLE-ADR PHT-ADDR (+ TABLE-ADR 2)) 
    537524       (HASH-ADR) 
    538525       (PHT1) 
    539        (COUNT (LSH SIZE-OF-PAGE-TABLE -1) (1- COUNT)) 
     526       (COUNT (LSH (QF-POINTER (PHYS-MEM-READ (+ PAGE-SIZE %SYS-COM-PAGE-TABLE-SIZE))) -1) 
     527              (1- COUNT)) 
    540528       (NUMBER-ERRORS 0)) 
    541529      ((= COUNT 0) NUMBER-ERRORS)