// 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
[

FileNameWordLength=20
MaxFileNames=40
fpLookSize=6
charItem = 1
]

let MergePN() be
[

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
[

MoveBlock(p, fileNameVec!i, FileNameWordLength)
ChangeExtension(p, ".pn")
pnNameVec!i=p
p=p+FileNameWordLength

]
let pnFiles=vec MaxFileNames*fpLookSize
FindFiles(pnNameVec, pnFiles, fileNameCount)

for i=0 to fileNameCount-1 do
[

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 file

]

]

and FindFiles(names, pr, count) be
[

let s=OpenFile("SysDir",ksTypeReadOnly,0,0,fpSysDir)
LookupEntries(s, names, pr, count, true)
Closes(s)

]


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
[

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 true

]

and CopyWl() be
[

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")
]

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 then

[

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
[

DeleteFile(strNew)
DeleteFile(strAd)
return

]
ErrorMessage(msg)

]

]

and CopyCarefully(fromFile, toFile) = valof
[

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
[

let wi=ReadBlock(si, buffer, buflen)
unless InsureDiskSpace(wi, -1) then [ res=false; break ]
WriteBlock(so, buffer, wi)

]
if res then
[

let v=vec 1
FileLength(si, v)//To a byte position
SetFilePos(so, v)
TruncateDiskStream(so)

]
Closes(so)
Closes(si)
@#335=buffer
resultis res

]

and InsureDiskSpace(wds, returnFlag; numargs na) = valof
[

if na eq 1 then returnFlag=false
let pag=(wds+256) rshift 8
if sysDisk>>DSK.diskKd>>KDH.freePages ls pag then
[

if returnFlag then resultis false
ErrorMessage("Not enough disk space to continue!")

]
resultis true

]

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

and BackupFiles() be
[

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
[

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 beginning

]

PutTempStrmWithHelp(Oracle, remCm, ftpTemplateFile)
Closes(ftpTemplateFile)

]

and Oracle(as) = valof
[

structure AS:// argument structure
[

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 spaces

]

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
[

switchon Gets(tstr) into
// repeat
[

// command characters

case $B: // basic file root (without numbers)
case $b:

BackupFileName(rstr, tstr, all, true, false)
break

case $N: // basic file root w/ numbers
case $n:

BackupFileName(rstr, tstr, all, false, false)
break

case $F: // full file root with rev levels
case $f:

BackupFileName(rstr, tstr, all, true, revStr)
break

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

// modifier characters

case $A:
case $a:

all = true
endcase

case $C: // re-work only
case $c:

test reWork
ifso loop
ifnot until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcase

case $R: // Route only
case $r:

test useRoute
ifso loop
ifnot until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcase

case $G: // Gobble only
case $g:

test reWork
ifnot loop
ifso until Endofs(tstr)%(Gets(tstr) eq $*s) do [ ]
endcase

]

] repeat

resultis true

]

and BackupFileName(stream, tstr, all, removeSuffix, addRev) be
[

let templateExtension = vec 20
let telen = 0
unless Endofs(tstr) do
[

let char = Gets(tstr)
until char eq $*s do
[

telen = telen+1
templateExtension>>str.char↑telen = char
if Endofs(tstr) then break
char = Gets(tstr)

]

]
templateExtension>>str.length = telen

for i=0 to (all? fileNameCount-1, 0) do
[

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
[

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 digits

] repeat

if addRev then
[

AppendS("-", string)
AppendS(addRev, string)

]

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

Wss(stream, string)
Puts(stream, $*s)

]

]


and ErrorMessage(msg) be
[

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)
]