//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(635)
]

let Main() be
[
@#420 = 0 //turn off display for speed
if LoadRam(RamImage) eq 0 then InitBcplRuntime()
InitAna()  //Junta(levKeyboard,InitAna)l4268
]


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



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 
[l4268
prescan = true
psfile = OpenFile("Swatee",ksTypeReadWrite,0,verLatestCreate,0,0,SilZone)
Puts(psfile,-1)l5538
]

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


[l4268
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 specifiedl5538
fn>>str.length = fnl-2
OpenErFile(fn)
MoveBlock(efn, fn, 128)
loopl6808
]
if ErFile eq 0 then
[l5538
MakeFileName(efn, fn, prescan? ".pe",".er")
OpenErFile(efn)l6808
]
test prescan
ifsol5538
[l5538
let RefFile = FileIn(fn)
if RefFile then loop//  marked as file for reference only 
WriteCursor(Wns,page)
GetCompNames(0,DictName)
OutSymbols()l6808
]
ifnot
[l5538

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

l5538
] repeat
if prescan then
[l4268
WriteCursor($o)
NewItem = SpaceBase
Zero(hashtab,htsize)
Puts(psfile,-1)  //flags stream as done
Resets(psfile)
MakeFileName(efn, efn, ".ps")
PreScanOut(efn)l5538
]
WriteCursor(Wss,"dn")

Ws("*n*n*n*n*nANALYZE of July 10, 1979  --  [")
Wns(dsp,worstErrorLevel)
Ws("] = worst error severity")
CloseErFile() 
finishl4269
//SpeakVersion()  //CounterJunta(SpeakVersion)l4268

] 

//and SpeakVersion() be
//[
//Ws("*n*n*n*n*nANALYZE June 21, 1979")
//finishl4269
//]

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)

l4268
]

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

[l4268
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 = sll5538
] repeat
resultis truel4268
]

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

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 = 0l4269
]

and ErrorAtSeverity(s) be
[
if s gr worstErrorLevel then worstErrorLevel = sl4269
]

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
[l4268
CallSwat("Can't Open Input File: ",fn)
finishl5538
]

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 
[l4268
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
[l5538
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) l6808
]

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. 
[l5538

if tempv>>item.color eq Magenta then [ ColorCount=ColorCount+1; loop ]
if font ls 8 then font = font/2
switchon font intol6808
[l6808
	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: loopl6808
]
l6808
]

//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  
[l5538
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+ll6808
]l5538
l5538
 


]
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
[l4268
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)l5538
if TitlePage eq -2 then Err("*nPage number cited in SIL title region is not incremented from former files.",warning)l5538
]

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")
		endcasel4268
	]
	L = L>>item.linkl4268
] repeat
resultis 0
l4268

]

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
[l4268
AddBadItem(x,y,4)
returnl5538
]

let ch = obj>>item.string.char^1
let link = Mact!ch

//the macro must be defined
if link eq 0 then
[l4268
Errxy(x,y,"Font 4 macro has no definition")
returnl5538
]


until link eq 0 do //grind down the definition
[l4268
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
[l5538
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
l6808
]l5538
]

l4268
]

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

and Err(s1, severity; numargs na) be
[
if na ls 2 then severity = serious
Wss(ErFile, s1)
ErrorAtSeverity(severity)l4269
]

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

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

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
[l4269
let char =str>>str.char^ptr 
if char ge $0 & char le $9 then [ val = val*10 + char - $0; cnt=cnt+1 ]l5539
]
if cnt eq 0 then resultis true
resultis val & #77777  //make sure my is positivel4269
]