Changeset 274 for trunk/lisp/lcadr/ccdisk.lisp
- Timestamp:
- 08/18/11 10:38:53 (22 months ago)
- Files:
-
- 1 modified
-
trunk/lisp/lcadr/ccdisk.lisp (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/lisp/lcadr/ccdisk.lisp
r204 r274 23 23 %PHT-DUMMY-VIRTUAL-ADDRESS 24 24 MICRO-CODE-SYMBOL-AREA-START MICRO-CODE-SYMBOL-AREA-END 25 PHT-ADDR SIZE-OF-PAGE-TABLE25 PHT-ADDR 26 26 INITIAL-LOD-NAME N-PARTITIONS 27 27 N-HEADS N-CYLINDERS N-BLOCKS-PER-TRACK … … 123 123 (PRINC '|ECC ERROR BIT POSITION |) 124 124 (PRIN1 (LOGLDB 0020 (PHYS-MEM-READ (+ CC-DISK-ADDRESS 3)))) 125 (PRINT ' SAVED-COMMAND)125 (PRINT 'LAST-CC-COMMAND) 126 126 (CC-TYPE-OUT CC-DISK-LAST-CMD CC-DISK-CMD-DESC T T) 127 127 (PRINT 'DISK-ADDRESS) … … 129 129 (PRINT 'MEMORY-ADDRESS) 130 130 (PRIN1 (LOGLDB 0026 (PHYS-MEM-READ (+ CC-DISK-ADDRESS 1)))) 131 (PRINT ' SAVED-COMMAND-LIST-POINTER)131 (PRINT 'LAST-CC-COMMAND-LIST-POINTER) 132 132 (PRIN1 CC-DISK-LAST-CLP) 133 133 (PRINT 'COMMAND-LIST) … … 201 201 "Strobe Early" "Strobe Late" 202 202 "Servo Reverse -- Strobe Early" ;NO COMMAS INSIDE STRINGS 203 "Servo Reverse -- Strobe Late" :IN MACLISP203 "Servo Reverse -- Strobe Late" ; IN MACLISP 204 204 "Servo Forward -- Strobe Early" 205 205 "Servo Forward -- Strobe Late") … … 298 298 299 299 ;returns t if wins 300 ; if DISK-BLOCK-NUM a list, its (track head sector). 300 301 (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) 302 304 (DECLARE (FIXNUM TRACK HEAD SECTOR DUSH ERRCNT STATUS)) 303 305 (COND ((NOT CC-DISK-TYPE)(CC-DISK-INIT))) 304 306 (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)))) 309 320 (SETQ DUSH (+ (CC-SHIFT TRACK 16.) (LSH HEAD 8) SECTOR)) 310 321 (AND (> N-BLOCKS 366) ;We only want to use 1 page for the command list … … 327 338 (AND (ZEROP (LOGAND 1 (SETQ STATUS (PHYS-MEM-READ CC-DISK-ADDRESS)))) 328 339 (GO WAIT)))) 340 (SETQ FINAL-DUSH (PHYS-MEM-READ (+ CC-DISK-ADDRESS 2))) 329 341 (COND ((NOT (ZEROP (LOGAND STATUS 47777560))) 330 342 ; ERROR BITS: INTERNAL PARITY, NXM, MEM PAR, HEADER COMPARE, … … 337 349 (PRINT 'RETRYING) 338 350 (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) 339 361 (GO LP))) 340 362 (RETURN T) ;won … … 344 366 ; MAINLY GOOD FOR RETRYING TRANSFERS THAT LOSE, ETC. 345 367 (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)) 382 369 383 370 … … 533 520 (CC-DISK-READ-IN-CORE 'PAGE))) 534 521 535 (DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY NIL522 (DEFUN CC-CHECK-PAGE-HASH-TABLE-ACCESSIBILITY () 536 523 (DO ((TABLE-ADR PHT-ADDR (+ TABLE-ADR 2)) 537 524 (HASH-ADR) 538 525 (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)) 540 528 (NUMBER-ERRORS 0)) 541 529 ((= COUNT 0) NUMBER-ERRORS)
