'NBR is a MicroSoft BASIC-80 (r) basic program that adds line 
' numbers to a file
'labels of the form "[label]" are converted to the appropriate 
' line number

ver$ = "1.24, 10 Nov 85"
REM	copyright 1985 by	Brian Dugle
				6002 Carrindale Ct
				Burke, VA 22015
				(703) 569-3036

REM	This program may be used by any individual for non-commercial 
	purposes; it may not be sold alone or as part of a group of 
	"public domain" programs

'NOTE!!
'    lines that end with a colon must be terminated with a linefeed
'    (^P^J in WordStar) to continue on the next physical line--
'    this also applies to 'if' statements continued on multiple
'    lines, ie, end physical lines that continue on the next line
'    with a LINEFEED, not a RETURN...
'    Lines continued in this manner are still limited to a total 
'    of 255 chars (including LFs, TABs, etc), this program does 
'    not check for this error, it crashes!!

'define constants for variable type, size of arrays...

defint a-z:
tblsz = 50:
codesz = 150:
dim lblname$ (tblsz), lblval (tblsz), progline$ (codesz)

'functions - boolean

def fnisodd (n) = ( (n and 1) = 1 )
def fniseven (n) = ( (n and 1) = 0 )
def fniswhitespace (c) = ( instr (whitespace$, c) > 0 )
def fnisremline (l$) = ( left$ (l$, 1) = rmk$ )
def fnisblankline (l$) = ( len (l$) = 0 )
def fnislabelline (l$) = ( left$ (l$, 1) = lblstcode$ )

'	other functions...

def fnlnum (n) = n * incr + startnum

'logical values and ascii constants

false = 0: 
true = not false:
blank$ = chr$ (32):
tab$ = chr$ (9):
lf$ = chr$ (10):
cr$ = chr$ (13):
quote$ = chr$ (34):
cl$ = chr$ (26)

'program parameters and initialized variables

startnum = 100: 
incr = 10:
infile = 1: 
outfile = 2

rmk$ = "'":
lblstcode$ = "[":
lblendcode$ = "]":
maxlblnum = 0:
whitespace$ = blank$ + tab$

'___________________________________________________main program

print cl$:
print "nbr.bas vers "; ver$; " (c) Brian Dugle"

[get filename]
input "Enter the program name: ", progname$

upr$ = progname$: 
gosub [make upper]: 
progname$ = upr$:
infilname$ = progname$ + ".ASC": 
outfilname$ = progname$ + ".NUM":
symfilname$ = progname$ + ".SYM"

'............................................pass one

pass = 1
on error goto [open error]
open "I", infile, infilname$

'ln keeps track of lines in output ".NUM" file, sourceln counts 
	input file lines for use in error messages

ln = 0:
sourceln = 1:
print "Free memory ="; fre (0)

while not eof (infile) and (ln <= codesz)

'	...keep user up to date on progress...

	print cr$;:
	print using "pass 1, source line ### mem = #####"; 
		sourceln; fre (0);

'...get a line and check if it should be kept for output

	line input # infile, progline$ (ln):
	if 	fnisremline (progline$ (ln)) 
		or 
		fnisblankline (progline$ (ln)) 
	then [next pass1 line]

'...if the line is not a remark and is not blank, then check 
	to see if the line starts with a label, if so then 
	add to list of labels...
'Note! remarks made with REM will stay in the file...

	lblptr = instr (progline$ (ln), lblstcode$):
	if lblptr = 1 then gosub [eval label]

	ln = ln + 1

[next pass1 line]
'Note! arriving at this label directly skips incrementing line 
	number but source line is incr'd

	sourceln = sourceln + 1
wend

lastln = ln - 1

'possible error, codesz terminated input--if so tell user

if not eof (infile) and ln >= codesz then
	print "Source file too big, ran out of romm at"; ln; "lines":
	print "Change the variable 'codesz' and try again...":
	end

close infile

'............................................pass two

pass = 2
open "O", outfile, outfilname$

for ln = 0 to lastln

'	progress check...

	print cr$;:
	print using "pass 2, prog line ##### mem = #####"; 
		fnlnum (ln); fre (0);

'reformat line

'if line is a label location, only action required is to make it 
	a remark, skip everything else

	if fnislabelline ( progline$ (ln) ) then
		progline$ (ln) = str$ (fnlnum (ln)) + tab$ + 
			"' " + progline$ (ln):
		goto [print line]

'add the line number to progline$ (ln) and add tabs following 
	linefeeds to maintain indenting

	progline$ (ln) = 
		str$ (fnlnum (ln)) + tab$ + progline$ (ln):
	lfpos = instr (progline$ (ln), lf$):
	while lfpos <> 0:
		c$ = mid$ (progline$ (ln), lfpos+1, 1):
		if c$ = cr$ then
 			lfpos = lfpos + 1
		progline$ (ln) =
 			left$ (progline$ (ln), lfpos) + tab$ +
	 		mid$ (progline$ (ln), lfpos+1):
		lfpos = instr (lfpos+1, progline$ (ln), lf$):
	wend

'set quote positions

'search progline$ (ln) for quotes (chr$(34)), save position of 
	each quote char in quotepos$
'positions are one byte values saved in a string variable

	qpos = instr (progline$ (ln), quote$):
	quotepos$ = ""
	while qpos <> 0:
		quotepos$ = quotepos$ + chr$ (qpos):
		qpos = instr (qpos+1, progline$ (ln), quote$):
	wend
	if fnisodd (len (quotepos$)) then
		errmsg$ = "Quotes not paired":
		gosub [print errmsg]
	else
		quotepos$ = quotepos$ + chr$ (255)

'delete trailing remarks in progline$ (ln)
	start by finding first rmk$ that is not in a quoted 
	string and return its position in remptr

	remptr = instr (progline$ (ln), rmk$):
	while remptr > 0:
		ptr = remptr:
		gosub [check ptr in quotes]:
		if ptrinquotes then
			remptr = instr (remptr+1, progline$ (ln), rmk$)
	wend

'if remptr is found, then delete trailing remark and whitespace 
	from end of line

	if remptr > 0 then
		progline$ (ln) = left$ (progline$ (ln), remptr - 1):
		p = len (progline$ (ln)):
		while fniswhitespace ( mid$ (progline$ (ln), p, 1) ):
			p = p - 1: wend:
		progline$ (ln) = left$ (progline$ (ln), p)

'search for labels, convert to line numbers, insert in line and 
	print to output file

	numlbls = 0:
	lblptr = instr (progline$ (ln), lblstcode$):
	while lblptr > 0:
		ptr = lblptr:
		gosub [check ptr in quotes]:
		if not ptrinquotes then 
			gosub [save label num]
		lblptr = instr (lblptr+1, progline$ (ln), lblstcode$):
	wend:
	gosub [insert label nums]

[print line]

'print the current line and then delete it to make more workspace

	print # outfile, progline$ (ln):
	progline$ (ln) = ""

next ln

'............................................finish up

close outfile

'put the symbol table in a disk file that can be LISTed from 
	MBASIC...

open "O", outfile, symfilname$:
print # outfile, "1  'Label listing of: " + progname$ + ".BAS":
for i = 0 to maxlblnum-1:
	print # outfile, str$ (lblval (i)); 
		" '[" + lblname$ (i) + "]":
next
close:
print:
end

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[make upper]

'pass a string to the routine in upr$
'routine checks each char and, if lower case, converts it to 
' upper case
'result returned in upr$

for c = 1 to len (upr$):
	cupr$ = mid$ (upr$, c, 1)

'	...if cupr$ is lower case, convert it and insert into upr$...

	if (cupr$ >= "a") and (cupr$ <= "z") then
		cupr$ = chr$ ( asc (cupr$) - 32 ):
		upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1)

next c
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[open error]

'error on attempt to open input file

if err = 53 then 
	print "Error, file: " infilname$ " not found, check spelling":
	resume [get filename]
else
	on error goto 0

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[eval label]

'pass 1--extract a label from a line when lblptr = 1, ie, 
' line starts with a label
'if it is not already in the list, add it to the list

gosub [get label]:
if lblerr then
	errmsg$ = "Incorrect label format":
	gosub [print errmsg]:
	goto [end eval label]
gosub [match label]:
if inlist then
	gosub [lbl dbl def]
else
	gosub [add to list]
[end eval label]
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[lbl dbl def]
'error, found label already in list during pass one

errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + 
	str$ (ln) + ", value is" + str$ (lblval (n)):
gosub [print errmsg]:
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[add to list]

'pass one--add a new label to the list
'make label value the next line, remark line will not be the
' target of the goto or gosub

lblname$ (maxlblnum) = lbl$:
lblval (maxlblnum) = fnlnum (ln + 1):
maxlblnum = maxlblnum + 1:
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[check ptr in quotes]

'remark and label identifiers are not significant when in 
' quoted strings
'this routine checks ptr to see if it is within a quoted string
'uses quotepos$
'returns boolean ptrinquotes

if ptr > 255 then
	errmsg$ = "Pointer value too high, " + str$ (ptr):
	gosub [print errmsg]:
	stop

qnum = 1:
qpos = asc (quotepos$)
'...ASC function returns ascii code of first char in a string...

while ptr > qpos:
	qnum = qnum + 1:
	qpos = asc (mid$ (quotepos$, qnum, 1)):
wend
ptrinquotes = fniseven (qnum)
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[save label num]

'pass two--change a label to its value
'arrive here with "lblptr" pointing to start of a label in 
' "progline$ (ln)"
'find label in list and save value & position to replace or 
'print error:  undefined label

gosub [get label]:
if lblerr then
	errmsg$ = "Incorrect label format at pos" + str$ (lblptr):
	gosub [print errmsg]:
	goto [end save label num]

gosub [match label]:
if not inlist then
	errmsg$ = "Undefined label '[" + lbl$ + "]'":
	gosub [print errmsg]:
	goto [end save label num]

'found a good label, save position & value, bump counter

	labelpos (numlbls) = lblptr:
	labelval (numlbls) = lblval (n):
	numlbls = numlbls + 1

[end save label num]
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[insert label nums]

'numlbls is the number of labels found in this line
'they must be replaced from the far end first so that the position
' of each insertion does not change
'array labelval () holds the label value to insert
'array labelpos () holds the pointer, where to insert it
' both arrays are set to 10 subscripts by default...

for lp = numlbls-1 to 0 step -1
	endlblptr = instr (labelpos (lp), progline$ (ln), lblendcode$):
	progline$ (ln) = 
		left$ (progline$ (ln), (labelpos (lp) - 1)) +
		str$ ( labelval (lp) ) + 
		mid$ (progline$ (ln), endlblptr + 1)
next lp
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[get label]

'call with lblptr pointing to lblstcode$ in progline$ (ln)
'return with label name in lbl$, error in lblerr, lblptr not 
' changed

endlblptr = instr (lblptr, progline$ (ln), lblendcode$):
lblerr = (endlblptr = 0):
if not lblerr then
	lbl$ = mid$ (	progline$ (ln), 
			(lblptr + 1), 
			(endlblptr - lblptr -1) )
else
	lbl$ = ""
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[match label]

'find label in label list, return result in boolean "inlist"
' if in list, return subscript in "n"

inlist = false:
n = -1:
while (n < maxlblnum) and not inlist:
	n = n + 1:
	inlist = (lbl$ = lblname$ (n)):
wend:
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[print errmsg]

'message passed in "errmsg$"
'prints to screen and outfile

if pass = 1 then
	print:
	print "Error: "; errmsg$
else if pass = 2 then
	print # outfile, errmsg$
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~