(FILECREATED " 2-JUN-83 18:25:29" {PHYLUM}<LISPCORE>SOURCES>DISKDLION.;2 6500
changes to: (VARS DISKDLIONCOMS)
previous date: " 4-APR-83 12:58:44" {PHYLUM}<LISPCORE>FUGUE>DISKDLION.;86)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT DISKDLIONCOMS)
(RPAQQ DISKDLIONCOMS [(VARS DDFNS)
(FNS \DL.DISKINIT \DL.ACTONVMEMFILE \DL.ACTONVMEMPAGE \DL.DISKSEEK \DL.XFERDISK
\DL.DISKOP \D2V \V2HDSEC \V2CYL)
(FNS INITDLIONDISK)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LLFAULT)
(GLOBALVARS SEC/HD SEC/CYL \DISKTYPE))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (INITDLIONDISK])
(RPAQQ DDFNS (\DL.DISKINIT \DL.ACTONVMEMFILE \DL.ACTONVMEMPAGE \DL.DISKSEEK \DL.XFERDISK \DL.DISKOP
\D2V \V2HDSEC \V2CYL))
(DEFINEQ
(\DL.DISKINIT
[LAMBDA NIL (* bvm: "31-MAR-83 23:07")
(COND
((NEQ 0 (LOGAND 40Q (\DEVICE.INPUT 3)))
(SETQQ \DISKTYPE \SA4000)
(SETQ SEC/HD 34Q)
(SETQ SEC/CYL 340Q))
((NEQ 0 (LOGAND 100Q (\DEVICE.INPUT 6)))
(SETQQ \DISKTYPE \QUANTUM)
(SETQ SEC/HD 20Q)
(SETQ SEC/CYL 200Q))
(T (SETQQ \DISKTYPE \SA1000)
(SETQ SEC/HD 20Q)
(SETQ SEC/CYL 100Q])
(\DL.ACTONVMEMFILE
[LAMBDA (FILEPAGE BUFFER NPAGES WRITEFLAG) (* bvm: " 4-APR-83 12:58")
(DECLARE (GLOBALVARS \FPTOVP))
(FRPTQ NPAGES (\DL.ACTONVMEMPAGE (COND
(\FPTOVP (* New way, page is in boot file)
(* Pilot page is zero-based, vmem page is one-base)
(SUB1 FILEPAGE))
(T (* Old way, page is in sysout after initial core image)
(IPLUS 5775Q FILEPAGE)))
BUFFER WRITEFLAG)
(* the simple IPLUS here is actually converting from sysout file page number into a raw disk address.
Obviously, this will have to change, since it assumes, e.g., no bad pages in this region of the disk)
(SETQ BUFFER (\ADDBASE BUFFER WORDSPERPAGE))
(add FILEPAGE 1])
(\DL.ACTONVMEMPAGE
[LAMBDA (FILEPAGE BUFFER WRITEFLAG) (* bvm: "31-MAR-83 22:47")
(PROG ((LINKBASE (ADDBASE \IOCBPAGE 177Q))
(I 52Q))
LP [COND
((OR (IGREATERP (\GETBASE LINKBASE 3)
FILEPAGE)
(EQ 0 (\GETBASE LINKBASE 3)))
(RETURN (\DL.XFERDISK (IPLUS (\D2V (\GETBASE LINKBASE 1)
(\GETBASE LINKBASE 2))
(IDIFFERENCE FILEPAGE (\GETBASE LINKBASE 0)))
BUFFER WRITEFLAG]
(SETQ LINKBASE (\ADDBASE LINKBASE 3))
(COND
((EQ 0 I)
(RAID)
(RETURN)))
(SETQ I (SUB1 I))
(GO LP])
(\DL.DISKSEEK
[LAMBDA (CYL) (* bvm: "31-MAR-83 22:47")
(PROG [SEEKBITS (DISP (IDIFFERENCE CYL (\GETBASE \IOCBPAGE 11Q]
(COND
((ZEROP DISP)
(RETURN 0)))
(SETQ SEEKBITS 2040Q)
(COND
((IGREATERP 0 DISP)
(SETQ DISP (IMINUS DISP)))
(T (SETQ SEEKBITS 2140Q)))
(\PUTBASE \IOCBPAGE 127Q (LOGOR SEEKBITS 200Q))
(\PUTBASE \IOCBPAGE 131Q SEEKBITS)
(\PUTBASE \IOCBPAGE 121Q (ADD1 (LOGXOR DISP 177777Q)))
(\PUTBASE \IOCBPAGE 11Q CYL)
(RETURN (\DL.DISKOP 522Q])
(\DL.XFERDISK
[LAMBDA (DA BUFFER WRITEFLG) (* bvm: "31-MAR-83 22:47")
(\DL.DISKSEEK (\V2CYL DA))
(PROG ((RETRYCNT 12Q)
(HDSEC (\V2HDSEC DA))
STATUS)
LP (\PUTBASE \IOCBPAGE 12Q HDSEC)
(\PUTBASE \IOCBPAGE 100Q 1)
(\PUTBASE \IOCBPAGE 113Q (COND
(WRITEFLG 2073Q)
(T 2060Q)))
(\PUTBASE \IOCBPAGE 115Q (SUB1 (fetch (POINTER PAGE#) of BUFFER)))
(\PUTBASE \IOCBPAGE 116Q (COND
(WRITEFLG 34Q)
(T 36Q)))
(\PUTBASE \IOCBPAGE 117Q (LOGOR (LOGAND (\GETBASE \IOCBPAGE 117Q)
3777Q)
(LLSH (LOGAND HDSEC 177400Q)
3)))
(\PUTBASE \IOCBPAGE 120Q (LOGOR (LOGAND (\GETBASE \IOCBPAGE 120Q)
3777Q)
(LLSH (LOGAND HDSEC 177400Q)
3))) (* DSKRD1=DISKOP)
(COND
((ZEROP (\DL.DISKOP 543Q))
(RETURN T)))
(SETQ RETRYCNT (SUB1 RETRYCNT))
(COND
((ZEROP RETRYCNT)
(RAID))
(T (GO LP])
(\DL.DISKOP
[LAMBDA (IOCB) (* edited: "16-MAR-83 11:57")
(\PUTBASE \IOPAGE 1 IOCB)
(\PUTBASE \IOCBPAGE 3 400Q)
(\DEVICE.OUTPUT 40Q 3)
(until (ZEROP (LOGAND (\GETBASE \IOCBPAGE 3)
400Q)))
(LOGAND 77Q (\GETBASE \IOCBPAGE 3])
(\D2V
[LAMBDA (CYL HDSEC) (* lmm "13-DEC-82 17:40")
(PROG ((HD (FOLDLO HDSEC 400Q))
(SEC (IMOD HDSEC 400Q)))
(RETURN (IPLUS (ITIMES CYL SEC/CYL)
(ITIMES HD SEC/HD)
SEC])
(\V2HDSEC
[LAMBDA (DA) (* scp " 8-MAR-83 02:20")
(* returns the head and sector number, packed into one
word, for the disk address DA)
(PROG ((SEC (IMOD DA SEC/HD))
(HD (IQUOTIENT (IMOD DA SEC/CYL)
SEC/HD)))
(RETURN (LOGOR (LLSH HD 10Q)
SEC])
(\V2CYL
[LAMBDA (DA) (* scp " 8-MAR-83 02:22")
(* returns the cylinder number of virtual disk address
DA)
(IQUOTIENT DA SEC/CYL])
)
(DEFINEQ
(INITDLIONDISK
[LAMBDA NIL (* bvm: "31-MAR-83 22:45")
(MAPC (QUOTE (\MAKENUMBER \SETGLOBALVAL.UFN \RPLPTR.UFN \HTFIND \SLOWIPLUS2 \SLOWIDIFFERENCE
\SLOWLLSH1 \SLOWLLSH8 \SLOWLRSH1 \SLOWLRSH8 \SLOWLOGOR2 \SLOWLOGAND2
\SLOWLOGXOR2 \SLOWIGREATERP \SLOWIQUOTIENT \SLOWITIMES2 IMOD IREMAINDER)
)
(FUNCTION \LOCKFN))
(MAPC DDFNS (FUNCTION \LOCKFN))
(MAPC (QUOTE (\SMALLNEGSPACE \IOCBPAGE \MDSTypeTable \HTCOLL \HTMAIN \VMBASEDP SEC/HD SEC/CYL
\DISKTYPE))
(FUNCTION \LOCKVAR])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LLFAULT)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS SEC/HD SEC/CYL \DISKTYPE)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(INITDLIONDISK)
)
(PUTPROPS DISKDLION COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (800 5629 (\DL.DISKINIT 810 . 1237) (\DL.ACTONVMEMFILE 1239 . 2105) (\DL.ACTONVMEMPAGE
2107 . 2730) (\DL.DISKSEEK 2732 . 3351) (\DL.XFERDISK 3353 . 4392) (\DL.DISKOP 4394 . 4699) (\D2V 4701
. 4945) (\V2HDSEC 4947 . 5354) (\V2CYL 5356 . 5627)) (5630 6215 (INITDLIONDISK 5640 . 6213)))))
STOP