// BUILDa -- Sproull 7/77
// last modified by E. McCreight, April 18, 1980 4:25 PM
get "sysdefs.d"
get "altofilesys.d"
get "disks.d"
get "nsil.defs"
structure TERM:
[
next word
switchChar word
phrase @str
switchPhrase @str
]
manifest
[
null = 0
]
external
[ CopyCarefully// defined in this module
InsureDiskSpace
RepairComment
CopyString
CopyWl
BackupFiles
Oracle
ErrorMessage // defined elsewhere
ParseTitle
ChangeExtension
fileNameVec
fileNameCount
reWork
useRoute
multiWire
revStr
remCm
PutTempStrmWithHelp
TemplateGetArg
CreateStringStream
firstTerm
lastTerm
Wss// OS statics
ReadBlock
FileLength
SetFilePos
TruncateDiskStream
DeleteFile
sysDisk
SetupFstream
CurrentPos
]
manifest
[
FileNameWordLength=20
charItem = 1
]
static
[
nameVec
nameCount
]
let CopyWl() be if reWork then
[
let strOld=vec FileNameWordLength
let str=vec FileNameWordLength
let strNew=vec FileNameWordLength
MoveBlock(strOld, fileNameVec!0, FileNameWordLength)
ChangeExtension(strOld, ".wlOld")
MoveBlock(str, fileNameVec!0, FileNameWordLength)
ChangeExtension(str, ".wl")
MoveBlock(strNew, fileNameVec!0, FileNameWordLength)
ChangeExtension(strNew, ".wlNew")
let msg="Not enough disk space: BUILD sequence not fully completed"
if CopyCarefully(str, strOld) then// Into .wlOld
[
if CopyCarefully(strNew, str) then// Into .wl
[
DeleteFile(strNew)
return//All fine...
]
if CopyCarefully(strOld, str) then//Return .wlOld to .wl
[
ErrorMessage(msg)
return//As if op not done
]
ErrorMessage("Disaster! -- your original .wl file is on .wlOld")
return
]
ErrorMessage(msg)
]
and CopyCarefully(fromFile, toFile) = valof
[
let si=OpenFile(fromFile, ksTypeReadOnly,1)
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 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 CopyString(dest,source) be MoveBlock(dest,source,(source>>STRING.length rshift 1)+1)
and BackupFiles() be
[
let ftpTemplate = vec 300
let ftpTemplateFile = OpenFile("buildbackuptemplate.cm", ksTypeReadOnly,
charItem)
if ftpTemplateFile eq 0 then
[
ftpTemplateFile = CreateStringStream(ftpTemplate, 599)
Wss(ftpTemplateFile, "ftp IVY/c conn/c DoradoLogic dump/c $ZF.dm $ZCN.ad $ZN.wl $ZRN.lc $ZN.bp $ZN.er $ZGN.ge $ZRN.re $ZRN-E.nl $ZRN-C.nl $ZAN.sil **.lb# **dict.analyze ")
Wss(ftpTemplateFile, "conn/c d1drawings store/s sil.press $ZF.press ")
Wss(ftpTemplateFile, "; ftp maxc/c conn/c d1logic dump/c $ZF.dm $ZCN.ad $ZN.wl $ZRN.lc $ZMN.mwl $ZMN.mh $ZMN.mhi $ZN.bp $ZN.er $ZGN.ge $ZRN.re $ZRN-E.nl $ZRN-C.nl $ZAN.sil **.lb# **dict.analyze *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
nameVec = fileNameVec
nameCount = fileNameCount
let skipEntry = false
[
switchon Gets(tstr) into
// repeat
[
// command characters
case $L:// local parameters
case $l:
AddLocalParams(rstr, Gets(tstr))
resultis true
case $W:// worldwide (global) parameters
case $w:
AddGlobalParams(rstr, Gets(tstr))
resultis true
case $B: // basic file root (without numbers)
case $b:
FileName(rstr, tstr, all, true, false)
resultis true
case $N: // basic file root w/ numbers
case $n:
FileName(rstr, tstr, all, false, false)
resultis true
case $F: // full file root with rev levels
case $f:
FileName(rstr, tstr, all, true, true)
resultis true
// modifier characters
case $A:
case $a:
all = true
endcase
case $V:// pick up two parameters for namevec & count
case $v:
nameVec = TemplateGetArg(as)
nameCount = TemplateGetArg(as)
endcase
case $C: // re-work only
case $c:
if not reWork then break
endcase
case $M: // multi-wire only
case $m:
if not multiWire then break
endcase
case $R: // Route only
case $r:
if not useRoute then break
endcase
case $G: // Gobble only
case $g:
if useRoute then break
endcase
]
] repeat
//if we got here then the entry is to be skipped
[
if Endofs(tstr) then break
let c = Gets(tstr)
if c le $*s then [ Puts(rstr,c); break ]
] repeat
resultis true
]
and AddLocalParams(stream, char) be
[
if char ge $a & char le $Z then char = char-$a+$A
let term = firstTerm
while term ne null do
[
if term>>TERM.phrase.length gr 0 then
[
let termChar = term>>TERM.switchPhrase.char↑1
if termChar ge $a & termChar le $z then
termChar = termChar-$a+$A
if termChar eq char then
[
Puts(stream, $*S)
for i=1 to term>>TERM.phrase.length do
Puts(stream, term>>TERM.phrase.char↑i)
if term>>TERM.switchPhrase.length gr 1 then
[
Puts(stream, term>>TERM.switchChar)
for i=2 to term>>TERM.switchPhrase.length do
Puts(stream, term>>TERM.switchPhrase.char↑i)
]
]
]
term = term>>TERM.next
]
]
and AddGlobalParams(stream, char) be
[
if char ge $a & char le $Z then char = char-$a+$A
let term = firstTerm
while term ne null do
[
if term>>TERM.phrase.length eq 0 then
[
let termChar = term>>TERM.switchPhrase.char↑1
if termChar ge $a & termChar le $z then
termChar = termChar-$a+$A
if termChar eq char then
[
for i=2 to term>>TERM.switchPhrase.length do
Puts(stream, term>>TERM.switchPhrase.char↑i)
]
]
term = term>>TERM.next
]
]
and FileName(stream, tstr, all, removeSuffix, addRev) be
[
let templateExtension = vec 20
let telen = 0
let endC = false
unless Endofs(tstr) do
[
endC = Gets(tstr)
until endC le $*s do
[
telen = telen+1
templateExtension>>str.char↑telen = endC
if Endofs(tstr) then [ endC=false; break ]
endC = Gets(tstr)
]
]
templateExtension>>str.length = telen
for i=0 to (all? nameCount-1, 0) do
[
if i gr 0 then Puts(stream, $*s)
let string = vec 50
MoveBlock(string, nameVec!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("-Rev-", string)
AppendS(revStr, string)
]
AppendS((telen gr 0? templateExtension, ext), string)
Wss(stream, string)
]
if endC ne false then Puts(stream,endC)
]