// A L T O E X E C U T I V E // Internal Exec Commands - QFD.bcpl // Copyright Xerox Corporation 1979, 1980 // last edited by R. Johnsson, May 23, 1980 9:55 AM get "AltoDefs.d" get "Disks.d" get "AltoFileSys.d" get "Bfs.d" get "Time.d" get "Streams.d" get "ComStruct.bcpl" external [ Qfd TimeDiv // TimeConvA CONVUDT // TimeIO ] let Qfd(ISTREAM, DSTREAM) be [ let FN = vec 100 let SWVEC = vec 20 SetupReadParam(FN, SWVEC, ISTREAM, SWVEC) let T = 0 while (T eq 0) & (ReadParam($P, -1, FN) ne -1) & not Cancel() do [ MAKETIMELINE() test SWVEC!0 eq 0 ifso T = ShowFile(FN) ifnot switchon Capitalize(SWVEC!1) into [ case $S: [ T = ShowSerial(FN); endcase ] case $V: [ T = ShowDa(FN, false); endcase ] case $R: [ T = ShowDa(FN, true); endcase ] ] ] ] and ShowFile(fn) = valof [ static copyFp let RememberFP(fp,nil,nil,nil,nil) = valof [ if fp ne 0 & fp>>FP.leaderVirtualDa ne 0 then [ MoveBlock(copyFp, fp, lFP); resultis true ] resultis false ] let readDate = vec lTIME let fp = vec lFP; copyFp = fp Zero(copyFp, lFP) let S = MyOpenFile(fn,ksTypeReadOnly,0,0,0,0,0,0,0,RememberFP); if S then [ GetReadDate(fp, readDate) S = OpenFile(fn, ksTypeReadOnly, charItem, 0, copyFp) ] if S eq 0 then resultis WRITE(FORMATN("File does not exist.*N", fn), true) resultis ShowStream(S, readDate) ] and ShowSerial(sn) = valof [ let sn1, sn2 = 0, 0 for i = 1 to sn>>STRING.length do [ let c = sn>>STRING.char^i switchon c into [ case $0 to $7: [ sn2 = sn2 lshift 3 + c-$0; endcase] case $,: [ sn1 = sn2; sn2 = 0 ] ] ] resultis ShowSN(sn1, sn2) ] and ShowSN(sn1, sn2) = valof [ let foundone = false let fp = 0 let t = 0 for i = 1 to DIRHDBLK!0 do [ let myde = DIRHDBLK!i if myde>>MYDE.TYPE eq ISFILE & myde>>MYDE.FP.serialNumber.word2 eq sn2 & myde>>MYDE.FP.serialNumber.word1 eq sn1 then [ fp = lv myde>>MYDE.FP let readDate = vec lTIME GetReadDate(fp, readDate) let S = OpenFile(0,ksTypeReadOnly,charItem,0,fp) if S ne 0 then [ foundone = true; t = ShowStream(S, readDate) ] if t ne 0 then break ] ] unless foundone do resultis WRITE(FORMATN("No file with SN=, found.*N", sn1, sn2), true) resultis t ] and ShowDa(s, real) = valof [ let rda = 0 for i = 1 to s>>STRING.length do [ let c = s>>STRING.char^i if c ls $0 % c gr $7 then break rda = rda lshift 3 + c-$0 ] unless real % RealDiskDA(sysDisk, rda, lv rda) do resultis WRITE(FORMATN("Bad disk address ().*N", rda), true) let vda = VirtualDiskDA(sysDisk, lv rda) let label = vec lDL if GetLabel(rda, label) ne 0 then resultis WRITE(FORMATN("Can't read page (=real page ).*N", vda, rda), true) let sn1 = label>>DL.fileId.serialNumber.word1 let sn2 = label>>DL.fileId.serialNumber.word2 if sn1 eq -1 & sn2 eq -1 then resultis WRITE(FORMATN("Page (=real page ) is free.*N", vda, rda), true) resultis ShowSN(sn1, sn2) ] and ShowStream(Stream, readDate) = valof [ let leader = vec 256 ReadLeaderPage(Stream, leader) let cfa = vec lCFA GetCompleteFa(Stream,cfa) let cTime, wTime, rTime = vec 10, vec 10, vec 10 let utv = vec lenUTV UNPACKDT(lv leader>>LD.created, utv); CONVUDT(cTime, utv) UNPACKDT(lv leader>>LD.written, utv); CONVUDT(wTime, utv) test (readDate!0 % readDate!1) ne 0 ifso [ UNPACKDT(readDate, utv); CONVUDT(rTime, utv) ] ifnot rTime = "not read" MoveBlock(lv leader>>LD.read, readDate, lTIME) // put it back WriteLeaderPage(Stream, leader) let dl = vec 1 FileLength(Stream, dl) let pages = vec 1 TimeDiv(dl, 256*2, pages) let length = vec 10 ConvDouble(length, dl) Closes(Stream) let line1 = vec 60 FORMAT(line1, "*300*301 SN=, leaderDA= bytes pages*n", lv leader>>LD.name, cfa>>CFA.fp.serialNumber.word1, cfa>>CFA.fp.serialNumber.word2, cfa>>CFA.fp.leaderVirtualDa, length, pages!1+2) resultis WRITE(FORMATN(" create: write: read: *n", line1, cTime, wTime, rTime), true) ] and ConvDouble(s, lvd) be [ let appendchar(s, c) be [ let l = s>>STRING.length+1 s>>STRING.length = l s>>STRING.char^l = c ] let xn(s, lvd) be [ if lvd!1 ne 0 % lvd!0 ne 0 then [ let r = TimeDiv(lvd, 10, lvd)+$0 xn(s, lvd) appendchar(s, r) ] ] s!0 = 0 test lvd!1 eq 0 & lvd!0 eq 0 ifso appendchar(s, $0) ifnot xn(s, lvd) ] and GetReadDate(fp, lvDate) be [ let buf = vec 255 let das = vec 1 das!0 = fp>>FP.leaderVirtualDa das!1 = fillInDA if das!0 eq 0 then [ Zero(lvDate, lTIME); return ] ActOnDiskPages(sysDisk, 0, das, fp, 0, 0, DCreadD, 0, 0, buf, 0, 0, true) // read leader page into buf, return on check error MoveBlock(lvDate, lv buf>>LD.read, lTIME) ] and GetLabel(realda, lvLabel) = valof [ let buf = vec 255 let kcb = vec lKCB Zero(kcb, lKCB) kcb>>KCB.headerAddress = kcb + (offset KCB.header)/16 kcb>>KCB.labelAddress = lvLabel kcb>>KCB.dataAddress = buf kcb>>KCB.header.diskAddress = realda kcb>>KCB.command = readLD until @diskCommand eq 0 loop for try = 1 to 10 do [ kcb>>KCB.status = 0 @diskCommand = kcb until @diskCommand eq 0 loop if (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus then break ] resultis kcb>>KCB.status & DSTerrorBits ]