//		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 <S> 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=<B>,<B> 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 (<B>).*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 <B> (=real page <B>).*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 <B> (=real page <B>) 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<S>*301   SN=<B>,<B>  leaderDA=<B>   <S> bytes   <UD> 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("<S>  create: <S>  write: <S>  read: <S>*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
	]