// Log.bcpl - Routines for handling logging entries.
// Copyright Xerox Corporation 1979
// last modified October 7, 1978  3:42 AM by Boggs

get "AltoFileSys.d"
get "Streams.d"

external
[
// outgoing procedures
LogOpen; LogClose; MakeLogEntry

// incoming statics
disableLogging

fpSysLog; faSysLog
sysZone; sysDisk
]

// incoming procedures
DefaultArgs
EnumerateFp
CreateDiskStream
MoveBlock
DayTime
FileLength
WriteBlock
CloseDiskStream
KsBufferAddress
KsSetBufferAddress
CleanupDiskStream
Allocate
Free
LnPageSize
ReturnFrom
JumpToFa
GetCurrentFa
]

static [ disableLogging; LogS ]

//	L O G S

//---------------------------------------------------------------------------
structure LOGV:		// Log entry value
//---------------------------------------------------------------------------
[
type bit 6
length bit 10
time @TIME
fp @FP			//Usually for file access
]
manifest lLOGV = size LOGV/16

manifest	// LOGV types
[
typLogFree = 0
typLogOpenFile = 1		//Accessed a file.
typLogDeleteFile = 2		//Deleted a file.
typLogCreateFile = 3		//Created a brand new file.
typLogRenameFile = 4		//Re-used an allocated file
typLogReformatDirectory = 5	//Re-shuffled directory.
typLogString = 63		//Bcpl string for all to see.
]

// Make log entries -- but not references to system files.

let LogOpen(zone) be unless disableLogging then
	[
	LogS=CreateDiskStream(fpSysLog, 0, 0, 0, 0, zone, noLog)
	if LogS eq 0 then return
	LogS>>ST.error=LogRetX
	LogS>>ST.par1=LogOpen
	FileLength(LogS)		// Get to the end
	LogXClose(zone)
	]
	
and LogClose(zone) be if LogS then
	[
	LogS>>ST.par1=LogClose
	LogXOpen(zone)
	CloseDiskStream(LogS)
	LogS=0
	]

and LogXOpen(zone) be
	[
	let a=Allocate(zone, 256)
	KsSetBufferAddress(LogS, a)
	JumpToFa(LogS, faSysLog)	//Fill the buffer.
	FileLength(LogS)		//Make damn sure at end!
	]

and LogXClose(zone) be
	[
	CleanupDiskStream(LogS)
	GetCurrentFa(LogS, faSysLog)	// remember a disk address
	let a=KsBufferAddress(LogS)
	Free(zone, a)
	]

and MakeLogEntry(logType, filePtr, logInfo, zone, disk; numargs n) be
	[
	static svp
	DefaultArgs(lv n, -2, 0, sysZone, sysDisk)
	let CheckLogFp(fp) be
		[ if svp ne 0 &
		   svp>>FP.leaderVirtualDa eq fp>>FP.leaderVirtualDa
		   then svp=0
		]
	svp=filePtr
	EnumerateFp(CheckLogFp)

	if LogS eq 0 % logInfo eq noLog % disk ne sysDisk %
	  (filePtr ne 0 & (svp eq 0 % filePtr>>FP.serialNumber.nolog ne 0))
		then return

	LogS>>ST.par1=MakeLogEntry
	LogXOpen(zone)
	if LogS eq 0 then return	//Error encountered in "xopen"
	let a=vec lLOGV
	MoveBlock(lv a>>LOGV.fp, filePtr, lFP)
	DayTime(lv a>>LOGV.time)
	a>>LOGV.type=logType
	let l=(logInfo ne 0)? logInfo!0, 0
	a>>LOGV.length=lLOGV+l
//[ external [ Wns; FilePos; Ws; dsp ]
//	Ws("Log at "); Wns(dsp, FilePos(LogS)); Ws(" for ")
//	Wns(dsp, lLOGV+l); Ws("*N")
//]
	WriteBlock(LogS, a, lLOGV)
	if l then WriteBlock(LogS, logInfo+1, l)
	LogXClose(zone)
	]

and LogRetX() be
	[
	let s=LogS
	LogS=0
	ReturnFrom(s>>ST.par1)
	]