//ana.bcpl
//new analyzer for sil files
// last modified by E. McCreight, November 23, 1977 9:36 AM
get "sysdefs.d"
get "ana.defs"
static
[
ColorCount
//list headers
Comps = 0; Vlines = 0; Hlines = 0; Strings = 0; Numbers = 0; Locgroups = 0; Schars = 0
BadItems = 0
//Special symbol table pointers
Instp; Outstp; Gndstp; Pseudstp
page = 0; lastTitlePage=-1
OutFile=0; ErFile = 0; FileName; worstErrorLevel = noError; prescan = false; psfile
GenNameString; GenNameCount
Lprvec; Dprvec; fpDict=0; dict = 0
SilZone; Mact; hashtab; NewItem
Space//size of object space
SpaceBase //base of space
SpaceTop; Message = 0
debugswitch = false
]
external
[
LoadRam; InitBcplRuntime; RamImage
Ws; Wns; dsp
InitCursor; WriteCursor
]
let Main() be
[
@#420 = 0 //turn off display for speed
if LoadRam(RamImage) eq 0 then InitBcplRuntime()
InitAna() //Junta(levKeyboard,InitAna)
]
and InitAna(arg) be
[
let v = vec 50
InitCursor(v,50,0,0)
WriteCursor(Wss,"pg")
//initialize a zone for the file system
let v = vec 2500
SilZone = InitializeZone(v,2500)
//initialize the Macro Definition Table
let v = vec Mtsize
Mact = v
//symbol table
let v = vec htsize
hashtab = v
let v=vec 20
GenNameString=v
//use remaining space for the objects
@#335 = LoadRam // reclaim once-only code
Space = ((lv arg) - @#335)-2000 //leave 1000 words for the stack
if Usc(Space,2000) ls 0 then CallSwat("Insufficient Object Storage")
SpaceBase = @#335 //EndCode
@#335 = (@#335)+Space //set EndCode
SpaceTop = (@#335)-128 //leave margin for error
AnaMain()//never returns
]
and AnaMain() be
[
let DictName=vec 20
FindDictLibraries(DictName)
let comcm = OpenFile("COM.CM",ksTypeReadOnly,1,0,fpComCm,0,SilZone) //bytes
if comcm eq 0 then CallSwat("Can’t open COM.CM")
let fn = vec 128
FileName = fn
ReadNext(comcm,fn) //throw away name "ANALYZE.RUN"
let NewOnly = false
let fnl = fn>>str.length //but look for switch /d
let lc = fn>>str.char↑fnl
if ((lc eq $d)%(lc eq $D))&(fn>>str.char↑(fnl-1) eq $/) then debugswitch = true
if ((lc eq $n)%(lc eq $N))&(fn>>str.char↑(fnl-1) eq $/) then NewOnly = true
if ((lc eq $p)%(lc eq $P))&(fn>>str.char↑(fnl-1) eq $/) then
[
prescan = true
psfile = OpenFile("Swatee",ksTypeReadWrite,0,verLatestCreate,0,0,SilZone)
Puts(psfile,-1)
]
//fpDict = Dprvec+1
//dict = OpenFile(0,ksTypeReadOnly,1,0,fpDict,0,SilZone)
//if dict eq 0 then CallSwat("Can’t open first Dictionary file")
let efn = vec 128; efn!0 = 0
[
if not ReadNext(comcm,fn) then break //no more files
WriteCursor(Wss,"pg")
WriteCursor($i)
InitStorage()
fnl = fn>>str.length
lc = fn>>str.char↑fnl
if (fnl gr 2)&((lc eq $e)%(lc eq $E))&(fn>>str.char↑(fnl-1) eq $/) then
[ // error file specified
fn>>str.length = fnl-2
OpenErFile(fn)
MoveBlock(efn, fn, 128)
loop
]
if ErFile eq 0 then
[
MakeFileName(efn, fn, prescan? ".pe",".er")
OpenErFile(efn)
]
test prescan
ifso
[
let RefFile = FileIn(fn)
if RefFile then loop// marked as file for reference only
WriteCursor(Wns,page)
GetCompNames(0,DictName)
OutSymbols()
]
ifnot
[
//OutFile = GetFile(fn,".nl",1) ///node list
let SkipFile = FileIn(fn,NewOnly) //read the input file
WriteCursor(Wns,page)
if SkipFile then loop // BUILT&"/N" or marked as file as "Reference"
let numDicts = GetCompNames(0,DictName) //read dictionary headers
AddComps() //build component templates and add to comps
FixOverlap() //coalesce overlapping lines
DoSchars()
DoSignames()
DoComponents()
ConnectVlines()
ConnectHlines()
DefaultTypeNames()//default missing component names where possible
for i = 0 to numDicts do
[
if PinCheck(i) then break //all components have been found
if i eq numDicts & worstErrorLevel ge serious then
Err2("*nNot all components were found in your Dictionary(s)")
]
WriteCursor($o)
DoOutput()
if debugswitch then PrintStructs()
if worstErrorLevel ge 2 then if ColorCount gr 0 do
[
let msg = vec 40; msg!0 = 0
AppendS("*nRemindr: ",msg); AppendN(ColorCount,msg)
Err2(msg, " items with Magenta color were skipped")
]
Closes(OutFile)
if debugswitch then CallSwat("done with ",fn)
]
] repeat
if prescan then
[
WriteCursor($o)
NewItem = SpaceBase
Zero(hashtab,htsize)
Puts(psfile,-1) //flags stream as done
Resets(psfile)
MakeFileName(efn, efn, ".ps")
PreScanOut(efn)
]
WriteCursor(Wss,"dn")
Ws("*n*n*n*n*nANALYZE of July 10, 1979 -- [")
Wns(dsp,worstErrorLevel)
Ws("] = worst error severity")
CloseErFile()
finish
//SpeakVersion() //CounterJunta(SpeakVersion)
]
//and SpeakVersion() be
//[
//Ws("*n*n*n*n*nANALYZE June 21, 1979")
//finish
//]
and InitStorage() be
[
Comps = 0
Vlines = 0
Hlines = 0
Strings = 0
Numbers = 0
Locgroups = 0
Schars = 0
BadItems = 0
ColorCount = 0
NewItem= SpaceBase
Zero(Mact,Mtsize)
Zero(hashtab,htsize)
Instp = DefineSymbol("IN",stPin)
Outstp = DefineSymbol("OUT",stPin)
Gndstp = DefineSymbol("Gnd",stSig)
Pseudstp = DefineSymbol("+",stSig)
]
and ReadNext(stream,string) = valof
[
let ch = $*s
if Endofs(stream) then resultis false
until (Endofs(stream)%(ch gr $*s))do ch = Gets(stream)
if ch le $*s then resultis false
string>>str.length = 1
string>>str.char↑1 = ch
[
if Endofs(stream) then break
ch = Gets(stream)
if ch le $*s then break
let sl = string>>str.length+1
string>>str.char↑sl = ch
string>>str.length = sl
] repeat
resultis true
]
and OpenErFile(name) be
[
if ErFile ne 0 then CloseErFile()
ErFile = OpenFile(name,ksTypeReadWrite,1,0,0,0,SilZone)
Wss(ErFile, "[0] = worst error severity*n")
]
and CloseErFile() be
[
if ErFile eq 0 then return
TruncateDiskStream(ErFile)
Resets(ErFile)
Gets(ErFile) // over the initial "["
Puts(ErFile, $0+worstErrorLevel)
Closes(ErFile)
worstErrorLevel = noError
ErFile = 0
]
and ErrorAtSeverity(s) be
[
if s gr worstErrorLevel then worstErrorLevel = s
]
and FileIn(fn,NewOnly; numargs arguments) =valof
[
if arguments ls 2 then NewOnly = false
let s = OpenFile(fn,ksTypeReadOnly,0,0,0,0,SilZone)
if s eq 0 then
[
CallSwat("Can’t Open Input File: ",fn)
finish
]
let pw = Gets(s)
if pw ne #34562 & pw ne #34563 then CallSwat(fn, "is not a valid SIL file")
if pw eq #34563 & NewOnly eq true then [ Closes(s); resultis true ] //marked BUILT
if arguments eq 2 then OutFile = GetFile(fn,".nl",1) ///node list for normal mode
let titlev=vec 200
ParseTitle(0, titlev, 200)//Initialize for title parsing
let tempv = vec 135 //temporary vector for object
Err2("*nReading ",fn,noError)
until Endofs(s) do //read file
[
let mname = Gets(s)
for i = 1 to 4 do tempv!i = Gets(s)
let font = tempv>>item.font
if font ls 14 then //read in the string
[
tempv!5 = Gets(s)
if tempv>>item.string.length gr 1 then
for j = 1 to (tempv>>item.string.length)/2 do
tempv!(5+j) = Gets(s)
]
let Font4component = false
let c = tempv>>item.string.char↑1
if (font eq 8)&(c ge $0)&(c le$9) then Font4component = true
test mname eq -1
ifso //this is a picture element.
[
if tempv>>item.color eq Magenta then [ ColorCount=ColorCount+1; loop ]
if font ls 8 then font = font/2
switchon font into
[
case 1: if tempv>>item.italic eq 0 then [ Dofont1string(tempv,0,0);loop ]
//ParseTitle gets called if font1 italic
case 0: case 2: ParseTitle(1, titlev, tempv); loop
case 3: if tempv>>item.italic eq 0 then Dofont3string(tempv,0,0);loop
case 14: Dorectangle(tempv,0,0);loop
case 8: unless Font4component do [ Dousermacro(tempv,0,0);loop ]
case 9:
case 10:
case 11:
case 12:
case 13: Docomponent(tempv,0,0);loop
default: loop
]
]
//this block is part of a macro definition in the user’s private macros
//put it into Mact for later expansion
ifnot unless (mname ge $0)&(mname le$9) do
[
if (mname & #177600) ne 0 then
CallSwat("Screwed up parsing Font 4 macro definitions!!!")
let l = Length(tempv)
CheckFit(l)
MoveBlock(NewItem,tempv,l) //copy tempv into the list
NewItem>>item.link = Mact!mname
Mact!mname = NewItem
NewItem=NewItem+l
]
]
Resets(s); LibUpdate(8,s) //stream is closed by LibUpdate
//ifnot Closes(s)
//update any libraries required
for i = 9 to 13 do LibUpdate(i,0)
tempv!0=0//For a string
//first look for a page number and use it if found
ParseTitle(2, titlev, 4, tempv)//Make comment string
let TitlePage = GetNum(tempv) //returns -1 if no number is found
if (TitlePage eq lastTitlePage) & (TitlePage gr 0) then TitlePage = -2
page = TitlePage gr 0? TitlePage, page+1
lastTitlePage = TitlePage
//now look for all entries in the title block
let fntitle=ParseTitle(2, titlev, 1)
tempv!0=0//For a string
AppendS("*n;", tempv)
ParseTitle(2, titlev, 5, tempv)//Make comment string
let RefOnly = ParseTitle(4,titlev) //see if this is just a reference document
if pw eq #34563 then AppendS(" MARKED BUILT ", tempv)
if tempv>>str.length gr 2 then //don’t make complaints if there isn’t a title block
[
ParseTitle(3, titlev, ErFile)//Complain if not parsed correctly
Err(tempv,noError);
if OutFile then
[
Wss(OutFile, tempv)//Put in output as comment
if RefOnly then Wss(OutFile, "*n@*n")//make the .nl file cosher
]
unless StEq(fn, fntitle, nil) then Err("*nFile name cited in SIL title region does not match true filename.", warning)
if TitlePage eq -1 then Err("*nCan’t find valid page number in SIL title region.",warning)
if TitlePage eq -2 then Err("*nPage number cited in SIL title region is not incremented from former files.",warning)
]
MoveBlock(GenNameString,fntitle,20)
GenNameCount=fntitle? 1,0
if RefOnly then //return if file is marked as reference
[
if arguments eq 2 then Closes(OutFile) //close output of not Prescan
resultis true
]
let L = BadItems //now report any arrors found while reading file in
[
if L eq 0 then break
switchon L>>node.type into
[
case 3: Errxy(L>>node.x,L>>node.y,"Malformed font 3 string")
endcase
case 4: Errxy(L>>node.x,L>>node.y,"Font 4 string more than one character long")
endcase
case 5: Errxy(L>>node.x,L>>node.y,"Component more than one character long")
endcase
]
L = L>>item.link
] repeat
resultis 0
]
and Dousermacro(obj,x0,y0) be //expand a user macro
[
//the definition contains relativized coordinates. Expand
//at the point x,y:
let x = x0 + obj>>item.xmin
let y = y0 + obj>>item.ymin
//the string must be exactly one character long
if obj>>item.string.length ne 1 then
[
AddBadItem(x,y,4)
return
]
let ch = obj>>item.string.char↑1
let link = Mact!ch
//the macro must be defined
if link eq 0 then
[
Errxy(x,y,"Font 4 macro has no definition")
return
]
until link eq 0 do //grind down the definition
[
let tl = link; link = link>>item.link
let font = tl>>item.font
if font ls 8 then [ font = font/2; if tl>>item.italic then font = 2 ]
switchon font into
[
case 1: Dofont1string(tl,x,y);loop
case 3: Dofont3string(tl,x,y);loop
case 14: Dorectangle(tl,x,y);loop
case 8: Dousermacro(tl,x,y);loop
case 9:
case 10:
case 11:
case 12:
case 13: Docomponent(tl,x,y);loop
default: loop
]
]
]
and Errxy(x,y,str,str2,severity; numargs na) be
[
if na ls 5 then severity = serious
let v = vec 128; v!0 = 0
AppendS("*n(",v)
AppendN(x,v)
AppendC($,,v)
AppendN(y,v)
AppendS(") ",v)
AppendS(str,v)
if na gr 3 then AppendS(str2,v)
Err(v, severity)
]
and Err2(s1,s2,severity; numargs na) be
[
if na ls 3 then severity = serious
Err(s1, severity)
Err(s2, severity)
]
and Err(s1, severity; numargs na) be
[
if na ls 2 then severity = serious
Wss(ErFile, s1)
ErrorAtSeverity(severity)
]
and MakeFileName(v, fname, ext) be
[
MoveBlock(v, fname, 100)
let j = 0
for i=1 to fname>>str.length do [ if fname>>str.char↑i eq $. then break; j=i ]
v>>str.length = j
AppendS(ext,v) //add the extension
]
and GetFile(fname,ext,byteword) = valof //1 for bytes,0 for words
[
let v = vec 128
MakeFileName(v, fname, ext)
let stream = OpenFile(v,ksTypeWriteOnly,byteword,0,0,0,SilZone)
if stream eq 0 then CallSwat("Can’t Open ",v)
resultis stream
]
and GetNum(str) =valof
[
if str>>str.length eq 0 then resultis true
let val,cnt=0,0
for ptr = 1 to str>>str.length do
[
let char =str>>str.char↑ptr
if char ge $0 & char le $9 then [ val = val*10 + char - $0; cnt=cnt+1 ]
]
if cnt eq 0 then resultis true
resultis val & #77777 //make sure my is positive
]