' DEBUG.INC:	Structured BASIC Program Debugger, version 1.12
'
' version:		6-20-84
' compiler:		Structured BASIC v1.12
' uses:			nothing
' module type:	include

procedure DEBUG.SETUP
	'Set up stack of procedure names
	DB.NPROCS = 10
	dim DB.LABEL$(DB.NPROCS),DB.LINE(DB.NPROCS)

	'Set up cursor and output variables
	DB.STATUS.LINE = 25
	DB.CUROFF = 0 : DB.CURON = 1
	DB.BLINK = 5 : DB.CURCNT = DB.BLINK
	DB.CURSOR$ = chr$(&H5F)
	DB.BKSP$ = chr$(8)
	DB.RET$ = chr$(13)
	DB.TLBOX$ = chr$(&HC9) : DB.TRBOX$ = chr$(&HBB)
	DB.BLBOX$ = chr$(&HC8) : DB.BRBOX$ = chr$(&HBC)
	DB.TOP$ = chr$(&HCD)   : DB.SIDE$ = chr$(&HBA)
	DB.MASK$ = "\                              \"

	'String for proofing labels input as breakpoints
	DB.LABCHRS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."

	'Establish error and key trapping (F10 stops debugger)
	on error goto DB.BASIC.ERROR
	on key(10) do DEBUG.KEYBD.STOP
	key off
	key (10) on

	DB.LEVEL = 0				'No procedures entered yet
	DB.BPOINT = 0				'No breakpoints in effect
	DB.CMDSTOP = 0				'No command keyboard stops

	do DEBUG.HELLO
	do DEBUG.PUSH.CURSOR
	do DEBUG.CLR.MSG
	do DEBUG.CMD
endproc

DB.BASIC.ERROR| 				'Error routine for BASIC errors
	do DEBUG.BASIC.ERROR
	do DEBUG.CMD
	resume

procedure DEBUG.KEYBD.STOP		'Entered when F10 pressed
	DB.CMDSTOP = 1
endproc

procedure DEBUG.HELLO			'Describe available functions
	cls
	print "The Structured BASIC Program Debugger 1.12"
	print string$(80,&HC4);
	print
	print "You can enter the debugger by:"
	print 
	print "   1. Pressing F10 during program execution,"
	print "   2. Setting a procedure breakpoint with the B command,"
	print "   3. Your program causing a BASIC error."
	print
	print "In the debugger, you can type:"
	print
	print "   X  to exit into BASIC (type CONT to go back),"
	print "   D  to list the Structured BASIC procedures called,"
	print "   B  to set a procedure breakpoint,"
    print "   G  to resume your program's execution."
endproc

procedure DEBUG.BASIC.ERROR		'Process BASIC errors
	color 15,0
	locate DB.STATUS.LINE,1,CUROFF
	print using "##### ";ERL;
	DB.ERROR = ERR
	if DB.ERROR > 77
		DB.ERROR = 77
	endif
	do DEBUG.ERROR.MSG
	locate ,,CURON
	color 7,0
endproc

procedure DEBUG.ERROR.MSG		'Decode BASIC error msg
	restore DB.ERROR.MSGS
	repeat
		read DB.ERR.KEY,DB.ERROR.MSG$
		if DB.ERR.KEY = DB.ERROR
			break
		endif
	until DB.ERR.KEY = 77
	print using DB.MASK$;DB.ERROR.MSG$
endproc

procedure DEBUG.PROC			'Handle procedure call
	do DEBUG.PUSH.CURSOR
	DB.LEVEL = DB.LEVEL + 1
	DB.LABEL$(DB.LEVEL) = DEBUG.LABEL$
	DB.LINE(DB.LEVEL) = DEBUG.LINE
	do DEBUG.TRACE.MSG
	if DB.BPOINT = 1 and DB.BPLABEL$ = DEBUG.LABEL$
		DB.CMDSTOP = 1
	endif
	if DB.CMDSTOP = 1
		do DEBUG.CLR.CMD
		do DEBUG.CMD
		DB.CMDSTOP = 0
	endif
	do DEBUG.POP.CURSOR
endproc

procedure DEBUG.ENDP			'Handle procedure exit
	do DEBUG.PUSH.CURSOR
	DB.LEVEL = DB.LEVEL - 1
	do DEBUG.TRACE.MSG
	do DEBUG.POP.CURSOR
endproc

procedure DEBUG.TRACE.MSG		'Display procedure and line
	color 15,0
	locate DB.STATUS.LINE,1,CUROFF
	if DB.LEVEL > 0
		print using "##### ";DB.LINE(DB.LEVEL);
		print using DB.MASK$;DB.LABEL$(DB.LEVEL);
	else
		print using DB.MASK$;"Exit";
	endif
	locate ,,CURON
	color 7,0
endproc

procedure DEBUG.CMD				'Get and process commands
	DB.DONE = 0
	repeat
		do DEBUG.GET.CMD
		do DEBUG.DO.CMD
	until DB.DONE = 1
	do DEBUG.CLR.CMD
endproc

procedure DEBUG.GET.CMD 		'Get and proof debugger command
	do DEBUG.CLR.CMD
	print "debug: ";
	repeat
		do DEBUG.GET.KEY
		DB.ISKEY = instr("BDGX",DB.KEY$)
	until DB.ISKEY > 0
endproc

procedure DEBUG.DO.CMD			'Call procedure for each command
	if DB.KEY$ = "G"
		DB.DONE = 1
	elseif DB.KEY$ = "X"
		do DEBUG.DO.STOP
	elseif DB.KEY$ = "B"
		do DEBUG.DO.BPOINT
	elseif DB.KEY$ = "D"
		do DEBUG.DO.DUMP
	else
		beep
	endif
endproc

procedure DEBUG.DO.STOP 		'Handle exit to BASIC
	print "exit to BASIC";
	do DEBUG.POP.CURSOR
	print : print "Type CONT to go back to debugger..."
	stop
endproc

procedure DEBUG.DO.BPOINT		'Set breakpoint
	do DEBUG.CLR.CMD
	print "breakpoint: ";
	do DEBUG.GET.STRING
	DB.BPLABEL$ = DB.INPUT$
	if len(DB.BPLABEL$) > 0
		DB.BPOINT = 1
	else
		DB.BPOINT = 0
	endif
endproc

procedure DEBUG.DO.DUMP 		'Dump stack of procedure calls
	print "dump procedure stack";
	locate 1,38
	print DB.TLBOX$;
	for DB.I = 1 to 40 : print DB.TOP$; : next DB.I
    print DB.TRBOX$
	for DB.I = DB.LEVEL to 1 step -1
		locate ,38
		print DB.SIDE$;" ";
		print using "##### ";DB.LINE(DB.I);
		print using DB.MASK$;DB.LABEL$(DB.I);
		print " ";DB.SIDE$
	NEXT DB.I
	locate ,38
	print DB.BLBOX$;
	for DB.I = 1 to 40 : print DB.TOP$; : next DB.I
	print DB.BRBOX$;
endproc

procedure DEBUG.GET.STRING		'Get label name for breakpoint
	DB.INPUT$ = ""
	DB.START.COL = pos(0)
	repeat
		do DEBUG.GET.KEY
		if DB.KEY$ = DB.RET$ break
		if DB.KEY$ = DB.BKSP$
			do DEBUG.DEL.CHAR
		elseif INSTR(DB.LABCHRS$,DB.KEY$) > 0
			do DEBUG.INS.CHAR
		else
			beep
		endif
	until 1 = 0
endproc

procedure DEBUG.GET.KEY 		'Get uppercase key from keyboard
	repeat
		do DEBUG.CURSOR
		DB.KEY$ = inkey$
	until len(DB.KEY$) > 0
	if asc(DB.KEY$) > 96 and asc(DB.KEY$) < 123
		DB.KEY$ = chr$(asc(DB.KEY$) - 32)
	endif
endproc

procedure DEBUG.INS.CHAR		'Add char to end of breakpoint label
	if pos(0) < 79
		print DB.KEY$;
		DB.INPUT$ = DB.INPUT$ + DB.KEY$
	else
		beep
	endif
endproc

procedure DEBUG.DEL.CHAR		'Handle backspace key in input
	DB.CUR.COL = pos(0)
	if DB.CUR.COL > DB.START.COL
		DB.INPUT$ = left$(DB.INPUT$,len(DB.INPUT$)-1)
		print " ";
		locate ,DB.CUR.COL-1
	else
		beep
	endif
endproc

procedure DEBUG.CURSOR			'Simulate BASIC cursor
	if DB.CURCNT = DB.BLINK
		if DB.CURCHAR$ = DB.CURSOR$
			DB.CURCHAR$ = " "
		else
			DB.CURCHAR$ = DB.CURSOR$
		endif
		DB.CURCNT = 0
	endif
	print DB.CURCHAR$;
	DB.CURCNT = DB.CURCNT + 1
	locate ,pos(0)-1
endproc

procedure DEBUG.CLR.CMD 		'Clear command area of status line
	locate DB.STATUS.LINE,40,CUROFF
	print space$(40);
	locate DB.STATUS.LINE,40,CURON
endproc

procedure DEBUG.CLR.MSG 		'Clear message area of status line
	locate DB.STATUS.LINE,1,CUROFF
	print space$(40);
	locate DB.STATUS.LINE,1,CURON
endproc

procedure DEBUG.PUSH.CURSOR		'Save program's cursor
	DB.ROW = csrlin : DB.COL = pos(0)
endproc

procedure DEBUG.POP.CURSOR		'Restore program's cursor
	locate DB.ROW,DB.COL
endproc

DB.ERROR.MSGS|					'Table of BASIC error messages
	data  1,"NEXT without FOR"
	data  2,"Syntax error"
	data  3,"RETURN without GOSUB"
	data  4,"Out of data"
	data  5,"Illegal function call"
	data  6,"Overflow"
	data  7,"Out of memory"
	data  8,"Undefined line number"
	data  9,"Subscript out of range"
	data 10,"Duplicate definition"
	data 11,"Division by zero"
	data 12,"Illegal direct"
	data 13,"Type mismatch"
	data 14,"Out of string space"
	data 15,"String too long"
	data 16,"String formula too complex"
	data 17,"Can't continue"
	data 18,"Undefined user function"
	data 19,"No RESUME"
	data 20,"RESUME without error"
	data 22,"Missing operand"
	data 23,"Line buffer overflow"
	data 24,"Device timeout"
	data 25,"Device fault"
	data 26,"FOR without NEXT"
	data 27,"Out of paper"
	data 29,"WHILE without WEND"
	data 30,"WEND without WHILE"
	data 50,"FIELD overflow"
	data 51,"Internal error"
	data 52,"Bad file number"
	data 53,"File not found"
	data 54,"Bad file mode"
	data 55,"File already open"
	data 57,"Device I/O error"
	data 58,"File already exists"
	data 61,"Disk full"
	data 62,"Input past end"
	data 63,"Bad record number"
	data 64,"Bad file name"
	data 66,"Direct statement in file"
	data 67,"Too many files"
	data 68,"Device unavailable"
	data 69,"Communication buffer overflow"
	data 70,"Disk Write Protect"
	data 71,"Disk not ready"
	data 72,"Disk media error"
	data 73,"Advanced feature"
	data 74,"Rename across disks"
	data 75,"Path/file access error"
	data 76,"Path not found"
	data 77,"Unprintable error"