// bravoprocs.sr

// Last modified November 26, 1979  6:22 PM by Taft


get "BRAVO1.DF"
get "ST.DF";
get "CHAR.DF";
get "VM.DF"
get "ALTOFILESYS.D"
get "STATE.DF"


// Incoming Procedures

external	[
	ugt
	move
	umin
	divmod
	mult
	puts
	gets
	]


// Incoming Statics

external	[
	ccommand
	vfwheel
	vfIniting
	vbbs
	]


// Outgoing Procedures

external	[
// formerly in bravostprocs.sr
	stsize
	stcopy
	stcompare
	stappend
	stget
	stput
	stnum
	slget
	slput
	sbwsize
	slappend
	sttoint
	SbSetSize
	uc
	FChInSb

// formerly in bravooutprocs.sr
	outnum
	outsb
	innum

// formerly in err.sr
	errhlt
	errhlta
//	SYSERR
	SysErr
	]


// Outgoing Statics

external	[
// formerly in err.sr
	ckperr
	ckproc
	]


// Local Statics

static	[
// formerly in bravooutprocs.sr
	ccolumn

// formerly in err.sr
	ckperr
	ckproc
	]


// Local Manifests

manifest	[
	idigmax = 16
	maxcolumn = 60
	cchmax = 100
	]


//////////////////
// bravostprocs.sr
//////////////////


//  S T S I Z E
//  number of characters in st
let stsize(st) = valof
[
// if rv st eq 1 then resultis st>>ST.cch;
resultis st>>SB.cch;
]


//  S T C O P Y
and stcopy(st1, st2) be
[
// if (rv st1 ne 1) & (rv st2 ne 1) then
// 	[
	move(st2, st1, sbwsize(st2));
// 	]
// for cp = 0 to umin(stsize(st1), stsize(st2))-1 do
// 	stput(st1, cp, stget(st2, cp));
// if rv st1 ne 1 then st1>>SB.cch = stsize(st2);
]


// S T C O M P A R E
// compares 2 ST strings
// returns -1 (when st1 < st2), 0 (st1 = st2), or 1 (st1 > st2)
and stcompare(st1, st2) = valof
[
// let sb1 = st1;
// let cp1 = 0;
// let cch1 = st1>>SB.cch;
// if rv st1 eq 1 then
// 	[
// 	sb1 = st1>>ST.sb;
// 	cp1 = st1>>ST.pp;
// 	cch1 = st1>>ST.cch;
// 	]
// let sb2 = st2;
// let cp2 = 0;
// let cch2 = st2>>SB.cch;
// if rv st2 eq 1 then
// 	[
// 	sb2 = st2>>ST.sb;
// 	cp2 = st2>>ST.pp;
// 	cch2 = st2>>ST.cch;
// 	]
// for dcp = 0 to umin(cch1, cch2)-1 do
// 	[
// 	let ch1 = sb1>>SB.ch ↑ (cp1+dcp);
// 	let ch2 = sb2>>SB.ch ↑ (cp2+dcp);
let cch1 = st1>>SB.cch
let cch2 = st2>>SB.cch
for tcp = 0 to umin(cch1, cch2)-1 do
	[
	let ch1 = st1>>SB.ch ↑ tcp
	let ch2 = st2>>SB.ch ↑ tcp
	if ch1 ls ch2 then resultis -1;
	if ch1 gr ch2 then resultis 1;
	]
if cch1 ls cch2 then resultis -1;
if cch1 gr cch2 then resultis 1;
resultis 0;
]


// S T A P P E N D
and stappend(sb, st) = valof
[
let cch1 = sb>>SB.cch;
let cch2 = stsize(st);
sb>>SB.cch = cch1+cch2;
for dcp = 0 to cch2-1 do
	sb>>SB.ch ↑ (cch1+dcp) = stget(st, dcp);
resultis sb;
]


// S T G E T
and stget(st, cp) = valof
[
if cp ls 0 then resultis chnil;
// if rv st eq 1 then
// 	[
// 	if cp ge st>>ST.cch then resultis chnil;
// 	cp = cp+st>>ST.pp;
// 	st = st>>ST.sb;
// 	]
if cp ge st>>SB.cch then resultis chnil;
resultis st>>SB.ch ↑ cp;
]


// S T P U T
and stput(st, cp, ch) be
[
// if rv st eq 1 then
// 	[
// 	cp = cp+st>>ST.pp;
// 	st = st>>ST.sb;
// 	]
st>>SB.ch ↑ cp = ch;
]


// S T N U M
and stnum(st, int, intradix, cch, fzf, flj, fsigned; numargs carg) = valof
[
switchon carg into
	[
case 2:	intradix = 10
case 3:	cch = 0
case 4:	fzf = false
case 5:	flj = false
case 6:	fsigned = true
	]
if intradix le 1 then errhlta(154);
test fsigned & (int ls 0) ifso
	int = -int
ifnot fsigned = false;
let rgdig = vec idigmax;
let idig = nil;
for idig1 = 0 to idigmax-1 do
	[
	idig = idig1;
	let tdig = nil;
	int = divmod(int, intradix, lv tdig);
	rgdig ! idig = tdig+$0;
	if int eq 0 then
		[
		if fsigned then
			[
			idig = idig+1;
			rgdig ! idig = $-;
			]
		break;
		]
	]
if cch eq 0 then cch = idig+1;
// test rv st eq 1 ifso
// 	cch = st>>ST.cch
// ifnot
	SbSetSize(st, cch);
for cp = 0 to cch-1 do
	test idig+1 gr cch ifso
		stput(st, cp, chlfbogus)
	ifnot test flj ifso
		test (idig-cp) ge 0 ifso
			stput(st, cp, rgdig ! (idig-cp))
		ifnot stput(st, cp, chsp);
	ifnot test (cch-1-cp) le idig ifso
		stput(st, cp, rgdig ! (cch-1-cp))
	ifnot test fzf ifso
		stput(st, cp, $0)
	ifnot stput(st, cp, chsp);
resultis st;
]


// S L P U T
//
and slput(sl, cp, ch,maxch; numargs ca) be
[
if ca eq 3 then maxch= -1
test ugt(cp,maxch-1)
	ifso	sl>>SL.cch= maxch
	ifnot	sl>>SL.ch ↑ cp = ch;
]


// S L G E T
//
and slget(sl, cp) = valof
[
if (cp ls 0) % (cp ge sl>>SL.cch) then resultis chnil;
resultis sl>>SL.ch ↑ cp;
]


// S B W S I Z E
//
and sbwsize(sb) = (sb>>SB.cch rshift 1)+1;


// U C
//
and uc(char) = valof
[
test (char le $z) & (char ge $a) ifso resultis char-#40
ifnot resultis char;
]


// S L A P P E N D
//
and slappend(sl, st, maxch; numargs ca) be
[
if ca eq 2 then maxch = -1
let cch1 = sl>>SL.cch;
let cch2 = stsize(st);
sl>>SL.cch = cch1+cch2;
test ugt(sl>>SL.cch, maxch-1)
	ifso	sl>>SL.cch= maxch
	ifnot	for dcp = 0 to cch2-1 do sl>>SL.ch ↑ (cch1+dcp) = 
		 stget(st, dcp);
]


// S T T O I N T
//
and sttoint(sb) = valof
[
let sum = 0;
let fpos = true;
let i = 0;
let digit = stget(sb, i)-$0;
if digit eq $- then
	[
	fpos = false;
	i = 1;
	]
if digit eq $+ then
	i = 1;
let sbsiz = stsize(sb);
for ich = i to sbsiz-1 do
	[
	digit = stget(sb, ich)-$0;
	if (digit gr 9) % (digit ls 0) then
		[
		unless fpos do
			sum = -sum;
		resultis sum;
		]
	sum = mult(sum, 10)+digit;
	]
unless fpos do
	sum = -sum;
resultis sum;
]


// S B S E T S I Z E
and SbSetSize(sb, cch) = valof
[
sb>>SB.cch = cch;
// if cch eq 0 then rv sb = 0;
resultis sb;
]


// S T S U B S T R I N G
// and StSubstring(st1, st2, pp, cch) = valof
// [
// rv st1 = 1;
// st1>>ST.cch = cch;
// if rv st2 ne 1 then
// 	[
// 	st1>>ST.pp = pp;
// 	st1>>ST.sb = st2;
// 	resultis st1;
// 	]
// st1>>ST.pp = (st2>>ST.pp)+pp;
// st1>>ST.sb = st2>>ST.sb;
// resultis st1;
// ] // end StSubstring
// 
// 
// S T S U B S T R I N G I
// and StSubstringI(st1, st2, pp1, pp2) = StSubstring(st1, st2, pp1, (pp2-pp1)+1)
// end StSubstringI


// F C H I N S B
and FChInSb(ch, sb) = valof
[
for cp = 0 to sb>>SB.cch-1 do
	if ch eq sb>>SB.ch ↑ cp then resultis true;
resultis false;
] // end FChInSb




//////////////////
// bravooutprocs.sr
//////////////////


// O U T N U M

and outnum(fn, number, radix, width, zf, lj, signed; numargs N) = valof
[
if N ls 7 then signed = false;
if N ls 6 then lj = true;
if N ls 5 then zf = false;
if N ls 4 then width = 0;
if N ls 3 then radix = 10;
if N ls 2 % (fn ge maxfn) then errhlta(152);

let pxnum = vec 8
let mod = 0
let negative = false

let sb = vec cchmax/2 +1;
sb ! 0 = 0;
stnum(sb, number, radix, width, zf, lj, signed);
outsb(fn, sb);
]


// O U T S B

and outsb(fn, sb; numargs n) be
[
if n ne 2 then errhlta(153);
let j = 0;
for i = 1 to (sb ! 0) << lh do
	test (i << odd) ne 0 ifso
		[
		puts(fn, (sb ! j) << rh);
		j = j+1;
		ccolumn = ccolumn+1;
		]
	ifnot	[
		puts(fn, (sb ! j) << lh)
		ccolumn = ccolumn+1
		]
] // end outsb


// I N N U M
//
and innum(fn, radix; numargs N) = valof
[ 
if N eq 1 then radix = 10;
let digit = gets(fn)-$0;
let sum = 0;
until digit gr 9 % digit ls 0 do
	[ 
	sum = sum*radix+digit;
	digit = gets(fn)-$0;
	]
resultis sum;
]




//////////////////
// err.sr
//////////////////


// E R R H L T
and errhlt(sb) be
[
errhlta(2, sb)
]

// E R R C K
// and errck(sb) be
// [
// errhlta(2, sb)
// ]

// S Y S E R R 
// and SYSERR(sb) be
// [
// errhlt("ser");
// ]

and SysErr(p1, errCode, nil, nil) be
[
let t = p1; p1 = errCode; errCode = t
CallSwatErrorFile("Sys.errors", lv p1)
]

// E R R H L T A
and errhlta(errCode, nil, nil, nil) be
[
CallSwatErrorFile(0, lv errCode)
]


and CallSwatErrorFile(fileName, lvErrCode) be
[
manifest ClearBit=#100000
let bravoErrorFileName = "Bravo.error"
if fileName eq 0 then fileName = bravoErrorFileName
// lvErrCode ! 5 ="*c*cType <control>k to exit*c"
// lvErrCode ! 6 ="At command #"
// lvErrCode ! 7 = ccommand
lvErrCode ! 3 = ccommand
if vfIniting & vbbs >> BBS.fInstalled & not vfwheel then
	[ @lvErrCode = 3; fileName = bravoErrorFileName ]
unless vfwheel do @lvErrCode=@lvErrCode%ClearBit
	[
	(table [ #77403; #1401 ]) (fileName, lvErrCode)
	@lvErrCode=1
	fileName = bravoErrorFileName
	] repeatuntil vfwheel
]