//  NetDelaysUtil.bcpl 

get "NetDelays.defs"

static LastChar

//Manhatten distance = x + y
//Euclidean distance = Sqrt( x*x + y*y)
//The resultis is divided by 4 to convert to 10ths of inches
let FindDistance(node) be
	[
	if node>>node.OldX eq -1 then [ node>>node.Distance = 0; return ]  //first node in net
	let x = node>>node.OldX - node>>node.NewX; if x ls 0 then x = -x; x=(x+2)/4
	let y = node>>node.OldY - node>>node.NewY; if y ls 0 then y = -y; y=(y+2)/4
	test Manhatten eq true
		ifso node>>node.Distance = x + y  //distance in 10ths of inches
		ifnot node>>node.Distance = Sqrt( x*x + y*y, 1)
	]

//inplement sqrt( 35*D*(.0005*D + .0034*P)  )
//  ie sqrt(  .0175*D*D + .119*P*D  )
and FindDelay(D,P,str) = valof
	[
	let val1,val2 = 0,0
	if (P ls -10) % (P gr 100) then CallSwat("Pin count =",P)
	//clean up funny values on don't care calls
	if (D le 0) % (P ls 2) then resultis 0
	//if (D le 0) then [ Msg( "($D.", D/10); Msg( "$D)", D rem 10); resultis 0 ]
	//if (P ls 2) then [ Msg( "($D)", P);  resultis 0 ]

	val1 = MulDiv(D,D,10); val1 = MulDiv(val1,175,10000)  //(D*D)*.0175
	val2 = D*P; val2 = MulDiv(val2,119,1000)  //(D*P)*.119
	val1 = Sqrt(val1 + val2)
	if Debug ge 2 then
		[
		test printedDly ifso Msg("; "); ifnot printedDly=true
		Msg( "$D", D/10)
		let Drem = D rem 10; if Drem ne 0 then Msg( ".$D", Drem)
		Msg( ",$D=$D", P, val1/10)
		let Vrem = val1 rem 10; if Vrem ne 0 then Msg( ".$D", Vrem)
		Msg(str)
		]
	resultis val1
	]

//do Ym = 1/2 of (Yold + val/Yold)  **use 10*val if parm = 10*val
and Sqrt(parm,scale; numargs nargs) = valof  //do Ym = 1/2 of (Yold + val/Yold)  **use 10*val because val is *10
	[ if parm ls 0 then CallSwat("Can't take Sqrt of negative num")
	if nargs ls 2 then scale = 10
	if parm eq 0 then resultis 0
	let cnt = 0
	let LastVal = 1
	let LastLastVal = 0
		[
		let NewVal = (LastVal + MulDiv(parm,scale,LastVal)) rshift 1
		if NewVal eq LastVal then resultis NewVal
		if NewVal eq LastLastVal then resultis NewVal
		cnt = cnt+1
		if cnt gr 10 then
			[ PutTemplate(screen,"value after $D iterations = $D.*n",cnt,LastVal)
			for i=0 to 20000 do i=i ]
		LastLastVal = LastVal; LastVal = NewVal
		] repeat
	]

and FindChar(char) =valof
	[ if Char() eq char then resultis char; if Done then resultis $*n ] repeat

and Char() = valof
	[
	if Endofs(file) then [ Done = true; resultis $*n ]
	let c = Gets(file)
	if c eq ($Z&#37) then resultis FindChar($*n)
	resultis c
	]

and GetNum() = valof
	[  let num,startednum = 0,false
		[
		LastChar = Char(); if (LastChar ls $0) % (LastChar gr $9) then 
			test (startednum % Done)
				ifso resultis num; ifnot loop 
		num = num*10 + (LastChar-$0)
		startednum = true
		] repeat
	]

and GetStr(str,endChar; numargs nargs) = valof
	[
	if nargs ls 2 then endChar = 0
	str!0 = 0; let length = 0
		[
		let char = Char()
		if (char eq endChar) % (char le #40) then test (length eq 0)&(char ne $*n)
			ifso loop
			ifnot [ str>>str.length = length; resultis char ]
		length = length+1
		str>>str.char^length = char
		] repeat
	]

and Msg(parm1,parm2,parm3,parm4,parm5,parm6; numargs nargs) be
	[
	test nargs eq 1
		ifso
			[
			if screenEn then Wss(screen,parm1)
			Wss(disko,parm1)
			]
		ifnot
			[
			if screenEn then PutTemplate(screen,parm1,parm2,parm3,parm4,parm5,parm6)
			PutTemplate(disko,parm1,parm2,parm3,parm4,parm5,parm6)
			]
	]

//checks all characters of the shorter string eq the start of the second string
//ignores the difference between upper and lower case characters
and StEq(S1,S2) =valof
	[
	let result = StComp(S1,S2)
	resultis ( result ge 3)%(result le -3)? false,true
	//if (not S1!0) % (not S2!0) then resultis true  //null string means "don't care" so do it
	//let Length = S1>>str.length ls S2>>str.length? S1>>str.length,S2>>str.length
	//for i = 1 to Length do
		//if ((S1>>str.char^i xor S2>>str.char^i) & #137) ne 0 then resultis false
	//resultis true
	]

//Returns + if S2 wins, - if S1 wins
//Returns 0 if identical
//Returns//1 if different only by capitalization
//returns 2 if one is the prefix of the other
//returns 3 if strings are different
and StComp(s1, s2) = valof
	[
	let ls1 = s1>>str.length
	let ls2 = s2>>str.length
	let s1wins = 0
	for i = 1 to ((ls1 ls ls2)? ls1, ls2) do
		[
		let c1 = s1>>str.char^i
		let c2 = s2>>str.char^i
		if c1 eq c2 then loop
		if ((c1 xor c2)&($A eqv $a)) ne 0 then
			resultis ( (c1%($A xor $a)) gr (c2%($A xor $a)) ) ? 3,-3
		if s1wins ne 0 then loop
		s1wins = ((c1 ge $A)&(c1 le $Z))? 1,-1
		]
	if ls1 ne ls2 then resultis (ls1 gr ls2)? 2,-2
	resultis s1wins
	]

and AppendC(string,char) be
	[
	let st = string>>str.length +1
	string>>str.char^st = char
	string>>str.length = st
	]

and AppendS(std,sts) be //copy from source to destination
	for i = 1 to sts>>str.length do AppendC(std,sts>>str.char^i)


and MulDiv(a,b,c) = valof // Returns a*b/c  using unsigned arithmetic.
	[
	let NovaCode=table
		[
		#55001	// STA 3,1,2
		#155000 // MOV 2,3  save stack pointer
		#111000 // MOV 0,2  a
		#21403	// LDA 0,3,3
		#101220	// MOVZR 0,0	c/2
		#61020  // MUL
		#31403  // LDA 2,3,3 c
		#61021  // DIV
		#101010 //  MOV# 0,0
		#121000 // MOV 1,0
		#171000 // MOV 3,2
		#35001	// LDA 3,1,2
		#1401	// JMP 1,3
		]
	resultis NovaCode(a,b,c)
	]
(635)\f1 54f0 8f1 2423f0 8f1 15f0 8f1 11f0 8f1 95f0 8f1 155f0 8f1 16f0 4f1 16f0 4f1 34f0 4f1
and MakeFileName(RefName,NewName,extension) be
	[
	NewName>>str.length = 0
	for i = 1 to RefName>>str.length do
		[
		let c = RefName>>str.char^i
		if c eq $. then break
		AppendC(NewName,c)
		]
	for i = 1 to extension>>str.length do AppendC(NewName,extension>>str.char^i)
	]

and CopyToWLFile() be
	[ external [ SetFilePos; DoubleAdd ]
	let CurrFposn = vec 2
	//CurrFposn!0 = -1; CurrFposn!1 = -1
	//DoubleAdd(Fposn,CurrFposn)  //subtract 1 from Fposn
	FilePos(file,CurrFposn)
	SetFilePos(file,Fposn)
	Fposn!0 = not Fposn!0; Fposn!1 = not Fposn!1
	DoubleAdd(Fposn,CurrFposn)  //difference is now in Fposn
	for i = 0 to Fposn!1 do Puts(WLout, Gets(file))
	]

and GetSomeMem(wrds) =valof
	[
	let result = @#335
	@#335 = result + wrds
	resultis result
	]
\f1
and SendTab() be
	[ external [ GetBitPos; SetBitPos ]
	Puts(disko,$*t)
	if screenEn eq 0 then return
	let currPosn = GetBitPos(screen)
	let newPosn = Tb0
	if currPosn ge Tb0 then newPosn = Tb1
	if currPosn ge Tb1 then newPosn = Tb2
	if currPosn ge Tb2 then newPosn = Tb3
	if currPosn ge Tb3 then newPosn = currPosn+64
	SetBitPos(screen,newPosn)
	]

and InitBravoFile(OutName) be
	[
	Wss(disko,"Page Numbers: Yes   First Page: 1*n")
	if not Debug then Wss(disko,"Columns:     2   Edge Margin:     .8*"   Between Columns:     .0*"*n")
	Wss(disko,"Heading:*032")
	PutTemplate(disko, "q(0,$D)", (Tb0+Bf)*35)
	PutTemplate(disko, "(1,$D)", (Tb1+Bf)*35)
	PutTemplate(disko, "(2,$D)", (Tb2+Bf)*35)
	PutTemplate(disko, "(3,$D)\f1*n", (Tb3+Bf)*35)
	Wss(disko,OutName)
	Wss(disko,"*032y756q\f1*n")
	]
\f1
and WhatICtype(char,num,board,val; numargs nargs) =valof
	[
	if (char ls $a)%(char gr $z)%(num ls 0)%(num gr 99)%(board ls 0)%(board gr LastFile) then 			CallSwat("Invalid IC pointer")
	let pointer = 26*num + (char - $a)
	let wptr = (pointer rshift 3) + ( (26*100)/8 )*board//done this way to provent integer ovfl
	let bitptr = pointer & 7
	
	if nargs eq 4 then
		[
		let newbits = (val&3) lshift 2*bitptr
		ICtable!wptr = ICtable!wptr % newbits
		]
	resultis ((ICtable!wptr) rshift (2*bitptr)) & 3
	]
\f1
and EdgePinTermination(ch,num, board, val; numargs nargs) =valof
	[
	if (ch ne $e)&(ch ne $c) then resultis 0
	if TermTable eq 0 then resultis 0
	if (LastChar eq $T) % (LastChar eq $t) then resultis 1
	if ch eq $c then num = num+200
	num = num + 400*board

	let wptr = num rshift 4
	let bitptr = num & #17
	let newbit = 1 lshift bitptr
	let reslt = ((TermTable!wptr) rshift bitptr)  & 1
	test nargs eq 4
		ifso TermTable!wptr = TermTable!wptr % newbit
		ifnot TermTable!wptr = TermTable!wptr & (not newbit)
	resultis reslt
	]
\f1 351f0 9f1 46f0 14f1 8f0 9f1 17f0 15f1 8f0 9f1