// EdBUILDa -- Sproull 7/77, Rosen 4/17/78, Chang 7/31/78
// Last modified by Chang on October 28, 1979  7:01 PM

get "sysdefs.d"
get "altofilesys.d"
get "disks.d"
get "nsil.defs"

external
	[ CopyCarefully	// defined in this module
	InsureDiskSpace
	RepairComment
	CopyString
	CopyWl
	MakeFileNames
	MergePN
	FindFiles
	BackupFiles
	ChangeExtension

	ErrorMessage // defined elsewhere
	ParseTitle
	fileNameVec
	fileNameCount
	reWork
	useRoute
	revStr
	adStr
	oldRevStr
	strWl
	strOldWl
	strBase
	remCm
	PutTempStrmWithHelp
	CreateStringStream
	analyzeNameVec
	analyzeNameCount
	RunProg
	errorS

	Wss	// OS statics
	ReadBlock
	FileLength
	SetFilePos
	TruncateDiskStream
	DeleteFile
	sysDisk
	SetupFstream
	CurrentPos
	]


manifest
[(635)\f1
FileNameWordLength=20
MaxFileNames=40
fpLookSize=6
charItem = 1
]

let MergePN() be
[\f1
let silFiles=vec MaxFileNames*fpLookSize
//should be using analyzeNameVec, but need file names
FindFiles(fileNameVec, silFiles, fileNameCount)
let pnNameVec=vec MaxFileNames*(FileNameWordLength+1)
let p=pnNameVec+MaxFileNames
for i=0 to fileNameCount-1 do
[l4269\f1
MoveBlock(p, fileNameVec!i, FileNameWordLength)
ChangeExtension(p, ".pn")
pnNameVec!i=p
p=p+FileNameWordLengthl5539\f1
]
let pnFiles=vec MaxFileNames*fpLookSize
FindFiles(pnNameVec, pnFiles, fileNameCount)

for i=0 to fileNameCount-1 do
[l4269\f1
let p=pnFiles+i*fpLookSize
if p!0 eq 0 then loop		//No pn's to merge
let s=OpenFile(pnNameVec!i,ksTypeReadOnly,0,0,p+1)
if s eq 0 then CallSwat("Cannot open a .PN file", pnNameVec!i)
let out=OpenFile(fileNameVec!i,ksTypeReadWrite,0,0,silFiles+i*fpLookSize+1)
if out eq 0 then CallSwat("Cannot open a .SIL file", fileNameVec!i)
let a=FileLength(s); Resets(s)
InsureDiskSpace(a/2)		//This many more words.
FileLength(out)		//Get to end of existing SIL file
Gets(s)			//Past password
until Endofs(s) do Puts(out, Gets(s))
Closes(s)
Closes(out)
DeleteFile(pnNameVec!i)		//Get rid of .PN filel5539\f1
]l4269\f1
]

and FindFiles(names, pr, count) be
[\f1
let s=OpenFile("SysDir",ksTypeReadOnly,0,0,fpSysDir)
LookupEntries(s, names, pr, count, true)
Closes(s)l4269\f1
]


and MakeFileNames() be
[		AppendS(oldRevStr,adStr)
		AppendS("to",adStr)
		AppendS(revStr,adStr)
		MoveBlock(strBase, fileNameVec!0, FileNameWordLength)
		strBase>>str.length = (strBase>>str.length)-6	//truncate XX.sil
		MoveBlock(strWl,strBase,FileNameWordLength)
		AppendS("01.wl",strWl)
		MoveBlock(strOldWl,strBase,FileNameWordLength)
		AppendS("-",strOldWl)
		AppendS(oldRevStr,strOldWl)
		AppendS(".wl",strOldWl)
]

and RepairComment(nlFile,titV) = valof
[\f1
let tempFile = OpenFile("build.temp",ksTypeReadWrite,charItem)
let c=Gets(nlFile)
if c ne $*n then [ Closes(nlFile); resultis false ]
c=Gets(nlFile)
if c ne $; then [ Closes(nlFile); resultis false ]
while c ne $*n do c=Gets(nlFile)	// remove the first comment line
until Endofs(nlFile) do Puts(tempFile, Gets(nlFile))
TruncateDiskStream(tempFile)
let commentLine = vec 50
commentLine!0=0
AppendS("*n;",commentLine)
ParseTitle(2,titV,5,commentLine)
AppendS(" -MARKED BUILT- *n",commentLine)
Resets(nlFile)
Wss(nlFile, commentLine)
Resets(tempFile)
until Endofs(tempFile) do Puts(nlFile, Gets(tempFile))
Resets(tempFile)
TruncateDiskStream(tempFile)
Closes(tempFile)
Closes(nlFile)
resultis truel4269\f1
]

and CopyWl() be
[\f1
MakeFileNames()
let strFinal=vec FileNameWordLength
let strAd=vec FileNameWordLength
let strFinalAd=vec FileNameWordLength
let strSigs=vec FileNameWordLength
let strNew=vec FileNameWordLength
MoveBlock(strNew, strWl, FileNameWordLength)
ChangeExtension(strNew, ".wlNew")
MoveBlock(strFinal, strBase, FileNameWordLength)
AppendS("-",strFinal)
AppendS(revStr,strFinal)
AppendS(".wl",strFinal)
MoveBlock(strSigs, strFinal, FileNameWordLength)
ChangeExtension(strSigs, ".sigs")
let strPres = vec FileNameWordLength
MoveBlock(strPres, strWl, FileNameWordLength)
ChangeExtension(strPres, ".ps")
let sigpres = OpenFile(strPres,ksTypeReadOnly,1)
if sigpres ne 0 then 
		[ test CopyCarefully(strPres,strSigs)
		ifso DeleteFile(strPres)
		ifnot ErrorMessage("couldn't copy .PS file.")
		]
let pres = OpenFile("prescan.tx",ksTypeReadOnly,1)
if pres ne 0 then
		[ test CopyCarefully("prescan.tx",strSigs)
		ifso DeleteFile("prescan.tx")
  	ifnot ErrorMessage("couldn't copy prescan.tx")
		]l4096\f1
if (pres eq 0)&(sigpres eq 0) then ErrorMessage("  Can not open .PS or .TX file")
if not reWork then
		[
		if CopyCarefully(strWl, strFinal) then [ DeleteFile(strWl); return ]
		ErrorMessage("couldn't copy .WL file")
		return
		]
DeleteFile(strWl)
if reWork thenl4096\f1
[l4896\f1
MoveBlock(strAd, strWl, FileNameWordLength)
ChangeExtension(strAd, ".ad")
MoveBlock(strFinalAd, strBase, FileNameWordLength)
AppendS("-",strFinalAd)
AppendS(adStr,strFinalAd)
AppendS(".ad",strFinalAd) 
let msg="Not enough disk space: BUILD sequence not fully completed"

if CopyCarefully(strNew, strFinal) &
	CopyCarefully(strAd, strFinalAd)
then		// Into .wl
[l5539\f1
DeleteFile(strNew)
DeleteFile(strAd)
returnl6816\f1
]
ErrorMessage(msg)l5536\f1
]l4896\f1
]

and CopyCarefully(fromFile, toFile) = valof
[\f1
let si=OpenFile(fromFile, ksTypeReadOnly,1)
if si eq 0 then CallSwat(" Cannot open file ",fromFile)
let so=OpenFile(toFile, ksTypeWriteOnly,1)
let buffer=@#335
let top=lv fromFile-2000
if Usc(top, buffer) le 0 then CallSwat("No room for file buffer")
@#335=top+1
let buflen=top-buffer
let res = true
until Endofs(si) do
[l4269\f1
let wi=ReadBlock(si, buffer, buflen)
unless InsureDiskSpace(wi, -1) then [ res=false; break ]
WriteBlock(so, buffer, wi)l5539\f1
]
if res then
[l4269\f1
let v=vec 1
FileLength(si, v)		//To a byte position
SetFilePos(so, v)
TruncateDiskStream(so)l5539\f1
]
Closes(so)
Closes(si)
@#335=buffer
resultis resl4269\f1
]

and InsureDiskSpace(wds, returnFlag; numargs na) = valof
[\f1
if na eq 1 then returnFlag=false
let pag=(wds+256) rshift 8
if sysDisk>>DSK.diskKd>>KDH.freePages ls pag then
[l4269\f1
if returnFlag then resultis false
ErrorMessage("Not enough disk space to continue!")l5539\f1
]
resultis truel4269\f1
]

and CopyString(dest,source) be MoveBlock(dest,source,(source>>STRING.length rshift 1)+1)

and BackupFiles() be
[\f1
RunProg("Ftp", -1)		//Put in FTP, switches ,etc.
Puts(remCm, $*s)

let ftpTemplate = vec 300
let ftpTemplateFile = OpenFile("EDbuildbackuptemplate.cm", ksTypeReadOnly,
 charItem)
if ftpTemplateFile eq 0 then
[l4269\f1
ftpTemplateFile = CreateStringStream(ftpTemplate, 599)
Wss(ftpTemplateFile, "iris/c dump/c $ZF.dmSil $ZF.wl $ZCO.ad  $ZF.sigs $ZB**.sil  *n")
SetupFstream(ftpTemplateFile, ftpTemplate, 1,
 CurrentPos(ftpTemplateFile)) // position back to beginningl5539\f1
]

PutTempStrmWithHelp(Oracle, remCm, ftpTemplateFile)
Closes(ftpTemplateFile)l4269\f1
]

and Oracle(as) = valof
[\f1
structure AS:		// argument structure
[l4269\f1
resultStream word
args word
nArgs word
templStream word
argIndex word
char word		// last escape character
radix word		// numeric field (in range [2...16])
width word		// minimum field width
justifyLeft word	// true if left-justified, false otherwise
signed word	// true if signed or packed, false if unsigned or unpacked
double word	// true if double precision, false otherwise
fill word		// fill character to replace leading spacesl5539\f1
]

let rstr = as>>AS.resultStream
let tstr = as>>AS.templStream
if as>>AS.char ne $Z & as>>AS.char ne $z then resultis false
let all = false
[l4269\f1
switchon Gets(tstr) into
// repeat
[l5539\f1
// command characters

case $B: // basic file root (without numbers)
case $b:l6809\f1
BackupFileName(rstr, tstr, all, true, false)
breakl8079\f1

case $N: // basic file root w/ numbers
case $n:l6809\f1
BackupFileName(rstr, tstr, all, false, false)
breakl8079\f1

case $F: // full file root with rev levels
case $f:l6809\f1
BackupFileName(rstr, tstr, all, true, revStr)
breakl8079\f1

case $O:	//oldrev string
case $o:
		MakeFileNames()
		BackupFileName(rstr,tstr,all,true,adStr)
		break

// modifier characters

case $A:
case $a:l6809\f1
all = true
endcasel8079\f1

case $C: // re-work only
case $c:l6809\f1
test reWork
ifso loop
ifnot until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcasel8079\f1

case $R: // Route only
case $r:l6809\f1
test useRoute
ifso loop
ifnot until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcasel8079\f1

case $G: // Gobble only
case $g:l6809\f1
test reWork
ifnot loop
ifso until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcasel8079\f1
l8079\f1
]l5539\f1
] repeat

resultis truel4269\f1
]

and BackupFileName(stream, tstr, all, removeSuffix, addRev) be
[\f1
let templateExtension = vec 20
let telen = 0
unless Endofs(tstr) do
[l4269\f1
let char = Gets(tstr)
until char eq $*s do
[l5539\f1
telen = telen+1
templateExtension>>str.char^telen = char
if Endofs(tstr) then break
char = Gets(tstr)l6809\f1
]l5539\f1
]
templateExtension>>str.length = telen

for i=0 to (all? fileNameCount-1, 0) do
[l4269\f1
let string = vec 50
MoveBlock(string, fileNameVec!i, FileNameWordLength)

let lenWExt = string>>str.length
ChangeExtension(string, "")		//Remove extension
let lenWOExt = string>>str.length

let extLen = lenWExt-lenWOExt
let ext = vec 20
ext>>str.length = extLen
for j=1 to extLen do ext>>str.char^j = string>>str.char^(lenWOExt+j)

if removeSuffix then
[l5539\f1
let len=string>>str.length
let c=string>>str.char^len
if c ls $0 % c gr $9 % len eq 1 then break
string>>str.length=len-1		//Remove trailing digitsl6809\f1
] repeat

if addRev then
[l5539\f1
AppendS("-", string)
AppendS(addRev, string)l6809\f1
]

AppendS((telen gr 0? templateExtension, ext), string)

Wss(stream, string)
Puts(stream, $*s)l5539\f1
]l4269\f1
]


and ErrorMessage(msg) be
[\f1
if errorS eq 0 then
[
	MakeFileNames()
	let str = vec 100
	@str = 0
	AppendS(strBase,str)
	AppendS(".be",str)
	errorS = OpenFile(str,ksTypeWriteOnly)
]
WSS(errorS,msg)
]
\f1