//Compat.Bcpl -- Compatibility with old OS
//Copyright Xerox Corporation 1979
get "AltoFileSys.d"
get "streams.d"

// outgoing procedure
external [
	InitializeCompatibility
	GetSysDir
	]

// statics declared elsewhere
external [
	dsp		//Display stream for OS
	keys		//Keyboard stream
	sysFont		// Default system display font
	badStream
	sysZone
	sysDisk
	]


// Incoming procedures
external [
// from Os -- dirs
	OpenFile; SetWorkingDir; CreateDiskStream
	DeleteFile
//	  -- streams
	Puts; Gets; Resets
	Closes
	EofError

	ReadBlock
	WriteBlock
	PositionPtr
	FilePos
	FindFdEntry
	SetFilePos
	CleanupDiskStream
	ReadLeaderPage
	GetCompleteFa
	RealDiskDA
	VirtualDiskDA
	DeleteDiskPages
	PositionPage
	TruncateDiskStream
// Display
	CreateDisplayStream
	ShowDisplayStream
//	  -- misc
	Noop
	Usc
	SysErr
	DoubleAdd
	MoveBlock
	RetryCall
	SetBlock
	DefaultArgs
	]

// outgoing procs
external [
	OverWrite
	MissingSysProc
	Creates
	LookupEntry
	ReadFileStuff
	ReadVec
	WriteVec
	OldPositionPtr
	MoveStream
	FlushPage
	DeleteFileS
	OpenAFile
	GetAFile
	CreateAFile
	DeleteAFile
	CloseAFile
	Display
	GetChar
	BStore
	BMove
	AddObj
	DelObj
	Mem
	IncMem
	GetFixed; FreeFixed; FixedLeft
	RealDA; VirtualDA
	]

// error codes
manifest [
	ecBadOst=2001
	ecCantOpenStream=2002
	ecMissingProc=2005
	ecNoSysDirStream=2006
	ecNotSysDir=2007
	]

static gotSysDir

// string streams
structure SS[
	@ST
	addr word
	charPtr word		// offset by SS.big
	big word			// 0 for Bcpl string, 1 for big string
	]
manifest lSS=size SS/16

// old stream types
manifest	[
	ostMin=0
	ostDiskRo=0
	ostDiskWo=1
	ostDiskRw=2
	ostDiskRoCh=3
	ostDiskWoCh=4
	ostDiskRwCh=5
	ostString=6
	ostBigString=7
	ostKeys=9
	ostDisplay=10
	ostMax=10
	]


// Routines for compatibility with the old Os

let Creates(param, ost, errRtn; numargs na)=valof
	[

	if na ls 3 then errRtn=SysErr
	let s=selecton ost into
	 [
	 case ostString: CreateStringStream(param, 0)
	 case ostBigString: CreateStringStream(param, 1)
	 case ostKeys: keys
	 case ostDisplay: valof [
		if param eq 0 then resultis dsp
		let ww=param!3; if ww eq 0 then ww=38
		let f=param!2; if f eq 0 then f=sysFont
		let ht=((f!-2)+1)&(-2)
		let len=param!1-param!0
		let nl=len/(ww*ht+4)
		let s=CreateDisplayStream(nl, param!0, len, f, ww)
		ShowDisplayStream(s)
		resultis s
		]
	 case ostDiskRo to ostDiskRwCh:
		CreateDiskStream(param, KsTypeOfOst(ost),
		 ItemSizeOfOst(ost), Noop, errRtn, sysZone, 0)
	 default: SysErr(ost, ecBadOst)
	 ]
	if s eq 0 then SysErr(param, ecCantOpenStream)
	s>>ST.error=errRtn
	resultis s
	]

and KsTypeOfOst(ost)=(table [
			ksTypeReadOnly
			ksTypeWriteOnly
			ksTypeReadWrite
			ksTypeReadOnly
			ksTypeWriteOnly
			ksTypeReadWrite
			])!ost

and ItemSizeOfOst(ost)=(table [ 2; 2; 2; 1; 1; 1 ])!ost


and LookupEntry(dir, name) = valof
	[
	if dir ne badStream then SysErr(dir, ecNotSysDir)
	Resets(badStream)		//get gotSysDir set up
	let p=FindFdEntry(gotSysDir, name)
	if p eq -1 then resultis false
	SetFilePos(gotSysDir, 0, 2*p)
	resultis true
	]

and ReadVec(s, addr, countMinus1)= valof
	[
	if s eq badStream then s=gotSysDir
	resultis ReadBlock(s, addr, countMinus1+1)-1
	]

and WriteVec(s, addr, countMinus1)=WriteBlock(s, addr, countMinus1+1)

and OldPositionPtr(s, newPosPlus2)=PositionPtr(s, newPosPlus2-2)

and MoveStream(s, deltaWords) be
	[
	if s eq badStream then s=gotSysDir
	let v=vec 2; FilePos(s, v)
	let w=vec 2; w!0=(deltaWords ge 0 ? 0, -1); w!1=deltaWords
	DoubleAdd(v, w); DoubleAdd(v, w)
	SetFilePos(s, v)
	]

and FlushPage(s)=CleanupDiskStream(s)

and DeleteFileS(s, pageNo, byteNo; numargs na) be
	[
	let buf=vec 256
	if byteNo eq 512 then [ pageNo=pageNo+1; byteNo=0 ]
	test na eq 1 % pageNo eq 0
	 ifso
		[
		let cfa=vec lCFA; GetCompleteFa(s, cfa)
		DeleteDiskPages(sysDisk, buf, cfa>>CFA.fp.leaderVirtualDa, lv cfa>>CFA.fp, 0)
		]
	 ifnot
		[
		PositionPage(s, pageNo); PositionPtr(s, byteNo)
		TruncateDiskStream(s)
		]
	]

and GetAFile(name, ost, errRtn; numargs na)=valof
	[
	DefaultArgs(lv na, 1, ostDiskRw, SysErr)
	resultis OpenAFile(name, ost, errRtn, verLatestCreate)
	]

and OpenAFile(name, ost, errRtn, version; numargs na)=valof
	[
	DefaultArgs(lv na, 1, ostDiskRw, SysErr, verLatest)
	resultis OpenFile(name, KsTypeOfOst(ost), ItemSizeOfOst(ost),
	  version, 0, errRtn)
	]

and CloseAFile(s) be Closes(s)

and DeleteAFile(nam) be DeleteFile(nam)

and ReadFileStuff(s, v) be ReadLeaderPage(s, v)

and GetSysDir(s, datum) be
	[
	unless gotSysDir then
	   [
	   let s=OpenFile("SysDir.", ksTypeReadOnly)
	   if s eq 0 then SysErr(s, ecNoSysDirStream)
	   gotSysDir=s
	   ]
	RetryCall(gotSysDir, datum)
	]

and RealDA(vda) = valof
	[
	let a=nil
	RealDiskDA(sysDisk, vda, lv a)
	resultis a
	]

and VirtualDA(rda) = VirtualDiskDA(sysDisk, lv rda)

and Display(c) be Puts(dsp, c)

and GetChar() be Gets(keys)

and BStore(dest, value, countMinus1) be
 SetBlock(dest, value, countMinus1+1)

and BMove(source, dest, countMinus1) be
 MoveBlock(dest, source, countMinus1+1)

and AddObj(type, ptr)=0
and DelObj(type, ptr)=0
and Mem(v) be [ v!0=0; v!1=0 ]
and MissingSysProc() be SysErr(nil, ecMissingProc)


// the SS structure declaration is global (streams.d), and should be
// retrieved if this code is separated from the rest

and CreateStringStream(str, big)=valof
	[
	let StringGets(s)=valof
		[
		let t=s>>SS.charPtr
		if t ge StrLn(s) then EofError(s)
		t=t+1
		s>>SS.charPtr=t
		resultis s>>SS.addr>>STRING.char↑t
		]
	
	and StringPuts(s, c) be
		[
		let t=s>>SS.charPtr
		if not s>>SS.big & t gr maxStringIndex then EofError(s)
		t=t+1; s>>SS.charPtr=t
		s>>SS.addr>>STRING.char↑t=c
		let olength=StrLn(s)
		if t gr olength then
			[
			let a=s>>SS.addr
			test s>>SS.big 
			then 	a!0=t-1
			or	a>>STRING.length=t
			]
		]
	
	and ResetStringStream(s) be s>>SS.charPtr=s>>SS.big
	
	and EndofStringStream(s)=s>>SS.charPtr ge StrLn(s)

	and StrLn(s) =
		((s>>SS.big ne 0)?
		 s>>SS.addr!0+1, s>>SS.addr>>STRING.length)

	and StringClose(s) be (sysZone>>ZN.Free)(sysZone, s)

	let s=(sysZone>>ZN.Allocate)(sysZone, lSS)
	for i=0 to lSS-1 do s!i=SysErr
	s>>SS.gets=StringGets; s>>SS.puts=StringPuts
	s>>SS.reset=ResetStringStream; s>>SS.endof=EndofStringStream
	s>>SS.close=StringClose
	s>>SS.addr=str; s>>SS.big=big; s>>SS.charPtr=big
	resultis s
	]


//Following is called at finish time to reset things

and InitializeCompatibility() be
	[
	gotSysDir=0

	[

// Addresses in ENTVEC
	manifest [
		evKBOPEN=#1000
		evKBINT=#1001
		//#1002 -- some kind of signal to COMMAND
		evDINIT=#1005
		evDPUT=#1006
		evCHKRB=#1007
		evGCRB=#1010
		evFONT=#1011
		evOUTLD=#1013
		evINLD=#1014
		evLINKF=#1015
		evINITALTOIOUSES=#1016
		evPARTY=#1020
		evMYADD=#1021
		]
	external [
//		sysFont
		CursorLink
		sysStatics
		CallSwat
		]

//For new OS, patch most of these to CallSwat
	SetBlock(#1000,CallSwat,#1021-#1000+1)
	rv evFONT=sysFont
	rv evLINKF=lv CursorLink
	rv evINITALTOIOUSES=sysStatics
	]

	]