ASMDEBUG.SOF

DECLARE FUNCTION a.label$ (s1$)
DECLARE SUB c.print (s1$)
DECLARE FUNCTION a.checkcom% (s1$)
DECLARE FUNCTION a.getcom$ (s1$, on1%)
DECLARE FUNCTION a.count% (fl1$, s1$)
DECLARE FUNCTION c.nospc$ (s$)
DECLARE FUNCTION c.stringword$ (s$, ps%)
DECLARE FUNCTION c.removetab$ (k1$)
DECLARE FUNCTION replace$ (s$, r1$, r2$) 'string,string to change,string to replace
DECLARE SUB c.delay (seconds!)
DIM CONST.separators AS STRING
CONST.separators = " ,;"

'Error Call
'ON ERROR GOTO errors

'Define a Procedure
procno% = 1
procsearch% = 0

CLS         'Get a good screen
WIDTH 40, 25
COLOR 10
cmd$ = c.nospc$(COMMAND$)
IF (cmd$ = "") THEN INPUT "File name"; fl1$ ELSE fl1$ = c.stringword$(cmd$, 1)
sourcefile$ = fl1$ + ".asm"
IF (cmd$ <> "") THEN PRINT "File asked = "; fl1$

'1 Count no. of procedures
PRINT
PRINT
a1% = a.count%(sourcefile$, "=>")
COLOR 11
c.print "No. Of Procedures =" + STR$(a1%)
DIM Proc.names(a1%) AS STRING
DIM Proc.address(a1%) AS LONG
DIM Comment.names(a1%) AS STRING

'2 Count no. of Labels
a1% = a.count%(sourcefile$, "::")
COLOR 11
c.print "No. Of Labels =" + STR$(a1%)
DIM Label.names(a1%) AS STRING
DIM Label.address(a1%) AS LONG

 
PRINT
PRINT
COLOR 12
c.print "Checking File . . ."
procno% = 0
lablno% = 0
size& = 0
count& = 0
OPEN "I", #1, sourcefile$
PRINT
PRINT
COLOR 13
DO UNTIL EOF(1)
LINE INPUT #1, a1$
a1$ = a.getcom$(a1$, 0)
IF (LEN(a1$) > 0) THEN a2% = ASC(LEFT$(a1$, 1)) ELSE a2% = 0
IF (LEN(a1$) > 0) THEN a2$ = RIGHT$(a1$, LEN(a1$) - 1) ELSE a2$ = ""
SELECT CASE a2%
    CASE 1
    COLOR 15
    c.print "Procedure > " + a2$
    procno% = procno% + 1
    Proc.names(procno%) = a2$
    Proc.address(procno%) = size&
    COLOR 13
    CASE 2
    COLOR 14
    c.print "## " + a2$
    Comment.names(procno%) = a2$
    COLOR 13
    CASE 3
    COLOR 3
    PRINT "Label :::: "; a2$
    lablno% = lablno% + 1
    Label.names(lablno%) = c.nospc$(a2$)
    Label.address(lablno%) = size&
    COLOR 13
    CASE 4
    IF (LEFT$(a2$, 1) <> CHR$(0)) THEN Process% = 1
    a1& = ASC(MID$(a2$, 2, 1))
    PRINT count&; "::"; a1&; "b |";
    LOCATE , 15
    PRINT RIGHT$(a2$, LEN(a2$) - 2)
    count& = count& + 1
    size& = size& + a1&
    IF (LEFT$(a2$, 1) <> CHR$(0)) THEN
        LOCATE , 15
        PRINT SPACE$(ASC(LEFT$(a2$, 1)));
        c.print "^ Assembly Error"
        k$ = INPUT$(1)
    END IF
    CASE ELSE
    END SELECT
LOOP
CLOSE #1
PRINT
PRINT
COLOR 15
c.print "Checking Complete."
IF (Process% = 1) THEN
c.print "Errors Found !!" + SPACE$(10)
SYSTEM
END IF
'=> Read file   = sourcefile$
'=> Result file = compiled$

'I input the compiled file here
count& = 0
IF (cmd$ = "") THEN INPUT "Result Extension"; fl2$ ELSE fl2$ = c.stringword$(cmd$, LEN(cmd$))
compiled$ = fl1$ + "." + fl2$
IF (cmd$ <> "") THEN PRINT "Extension asked = "; fl2$

PRINT
PRINT
COLOR 14
c.print "Transferring Program to DEBUG.COM . . . "

OPEN "I", #1, sourcefile$
OPEN "O", #2, "zzzzzzzz.ini"    'Output File
PRINT #2, "a 100"
PRINT
PRINT
COLOR 13
DO UNTIL EOF(1)
LINE INPUT #1, a1$
a1$ = a.getcom$(a1$, 1)
IF (LEN(a1$) > 0) THEN a2% = ASC(LEFT$(a1$, 1)) ELSE a2% = 0
IF (LEN(a1$) > 0) THEN a2$ = RIGHT$(a1$, LEN(a1$) - 1) ELSE a2$ = ""
SELECT CASE a2%
    CASE 1
    COLOR 15
    c.print "Procedure > " + a2$
    COLOR 13
    CASE 2
    COLOR 14
    c.print "## " + a2$
    COLOR 13
    CASE 3
    COLOR 3
    PRINT "Label :::: "; a2$
    COLOR 13
    CASE 4
    IF (LEFT$(a2$, 1) <> CHR$(0)) THEN Process% = 1
    a1& = ASC(MID$(a2$, 2, 1))
    a3$ = RIGHT$(a2$, LEN(a2$) - 2)
    PRINT count&; "::"; a1&; "b |";
    LOCATE , 15
    PRINT a3$
    PRINT #2, a3$
    count& = count& + 1
    CASE ELSE
    END SELECT
LOOP
CLOSE #1
PRINT
PRINT
COLOR 15
CLOSE #1
c.print "Checking Complete."
PRINT #2, ""
PRINT #2, ""
PRINT #2, "r ip"
PRINT #2, "100"
PRINT #2, "r cx"
PRINT #2, RTRIM$(LTRIM$(HEX$(size&)))
PRINT #2, "n " + compiled$
PRINT #2, "w"
PRINT #2, "q"
PRINT #2, ""
CLOSE #2

SHELL "debug <zzzzzzzz.ini >check.ini"
KILL "zzzzzzzz.ini"

OPEN "O", #1, "proc.ini"
PRINT #1, "PROCEDURE LISTING"
PRINT #1, STRING$(40, "+")
PRINT #1, ""
PRINT #1, ""
PRINT #1, STRING$(40, "-")
FOR i% = 1 TO UBOUND(Proc.names)
PRINT #1, STRING$(20, "^")
PRINT #1, "Procedure Name :"; Proc.names(i%)
PRINT #1, "Procedure Number :"; i%
PRINT #1, "Procedure Comment :"; Comment.names(i%)
PRINT #1, "Procedure Offset :"; Proc.address(i%); " offset"
PRINT #1, STRING$(20, "^")
NEXT
PRINT #1, STRING$(40, "-")
PRINT #1, ""
PRINT #1, ""
PRINT #1, STRING$(40, "*")
PRINT #1, "End of all listings."
PRINT #1, ""
PRINT #1, "Developed by: qbasic40"
CLOSE #1

COLOR 14
OPEN "I", #1, "check.ini"
DO UNTIL EOF(1)
LINE INPUT #1, k$
IF (INSTR(k$, "^ Error") <> 0) THEN
    c.print "Sorry Error Found!"
    PRINT "The Error may be due to try to make a long jump which is not possible except by JMP instruction."
    PRINT "The try to make a long jump is done when your label is to far from the jump point."
    PRINT "This causes Error."
    PRINT "You can correct it by using this Pseudo-code->"
    PRINT "(Jump instruction) ::label1"
    PRINT "..."
    PRINT "jmp ::label2"
    PRINT "::label1"
    PRINT "JMP ::LABEL ;<-The label to jump"
    PRINT "::label2"
    PRINT "..."
    COLOR 7
    PRINT "Happy Degugging . . ."
    k$ = INPUT$(1)
    CLOSE #1
    SYSTEM
    END IF
LOOP
CLOSE #1

COLOR 5
c.print "Compiled .... Happy Now ...."
COLOR 6
PRINT "Developed by: qbasic40"
PRINT
COLOR 7
PRINT "Press a key"
k$ = INPUT$(1)
SYSTEM

errors:
COLOR 9
c.print "Internal Error"
RESUME NEXT

FUNCTION a.checkcom% (s1$)
fr% = FREEFILE
OPEN "O", #fr%, "zzzzzzzy.ini"
PRINT #fr%, "a 100"
PRINT #fr%, s1$
PRINT #fr%, ""
PRINT #fr%, ""
PRINT #fr%, "q"
CLOSE #fr%
'Now transfer it
SHELL "debug <zzzzzzzy.ini >zzzzzzzx.ini"
OPEN "I", #fr%, "zzzzzzzx.ini"
FOR i% = 1 TO 5
LINE INPUT #fr%, a1$
NEXT
IF (c.nospc$(a1$) = "^Error") THEN a1% = INSTR(a1$, "^") - 10 ELSE a1% = (VAL("&H" + MID$(a1$, 6, 4)) - &H100) * &H100    'Get command size
CLOSE #fr%
KILL "zzzzzzzy.ini"
KILL "zzzzzzzx.ini"
a.checkcom% = a1%
END FUNCTION

FUNCTION a.count% (fl1$, s1$)
'Count
lens% = LEN(s1$)
fr% = FREEFILE
OPEN "I", #fr%, fl1$
DO UNTIL EOF(fr%)
LINE INPUT #fr%, a1$
a1$ = c.nospc$(a1$)
IF LEFT$(a1$, lens%) = s1$ THEN a1% = a1% + 1
LOOP
CLOSE #fr%
a.count% = a1%
END FUNCTION

FUNCTION a.getcom$ (s1$, on1%)
a1$ = c.nospc$(s1$)
IF (LEN(a1$) > 0 AND INSTR(a1$, ";") <> 0) THEN a1$ = LEFT$(a1$, INSTR(a1$, ";") - 1)'Remove Comment
a2$ = c.removetab$(s1$)
IF (LEN(a2$) > 0 AND INSTR(a2$, ";") <> 0) THEN a2$ = LEFT$(a2$, INSTR(a2$, ";") - 1)   'Remove Comment

IF (LEN(a1$) < 2) THEN
ELSEIF LEFT$(a1$, 2) = "=>" THEN
    a2$ = CHR$(1) + RIGHT$(a2$, LEN(a2$) - 2)
ELSEIF LEFT$(a1$, 1) = "#" THEN
    a2$ = CHR$(2) + RIGHT$(a2$, LEN(a2$) - 1)
ELSEIF LEFT$(a1$, 2) = "::" THEN
    a2$ = CHR$(3) + RIGHT$(a2$, LEN(a2$) - 2)
ELSE
    IF (on1% = 0) THEN
    IF (INSTR(a2$, "::") <> 0) THEN
        IF (INSTR(LCASE$(a2$), "near") = 0) THEN
        a2$ = LEFT$(a2$, INSTR(a2$, "::") - 1) + "100"
        ELSE
        a2$ = LEFT$(a2$, INSTR(a2$, "::") - 1) + "500"
        END IF
    END IF
    ELSE
    IF (INSTR(a2$, "::") <> 0) THEN
    a3$ = RIGHT$(a2$, LEN(a2$) - INSTR(a2$, "::") + 1)
    a3$ = a.label$(a3$)
    a2$ = LEFT$(a2$, INSTR(a2$, "::") - 1) + a3$
    a2% = 1
    IF (INSTR(LCASE$(a2$), "jmp") <> 0) THEN a3% = 3 ELSE a3% = 2
    END IF
    END IF
    a1% = a.checkcom%(a2$)
    IF (a2% = 1) THEN a2$ = CHR$(4) + CHR$(0) + CHR$(a3%) + a2$ ELSE a2$ = CHR$(4) + CHR$(a1% AND &HFF) + CHR$(a1% \ &H100) + a2$
END IF
a.getcom$ = a2$
END FUNCTION

FUNCTION a.label$ (s1$)
SHARED Label.names() AS STRING
SHARED Label.address() AS LONG
s2$ = c.nospc$(s1$)
s2$ = RIGHT$(s2$, LEN(s2$) - 2)
FOR i% = 1 TO UBOUND(Label.names)
IF (s2$ = Label.names(i%)) THEN
    ret$ = RTRIM$(LTRIM$(HEX$(Label.address(i%) + &H100)))
    EXIT FOR
END IF
NEXT
a.label$ = ret$
END FUNCTION

FUNCTION c.nospc$ (s$)
FOR i% = 1 TO LEN(s$)
a1$ = MID$(s$, i%, 1)
IF (a1$ <> " " AND a1$ <> CHR$(9) AND a1$ <> CHR$(0)) THEN a2$ = a2$ + a1$
NEXT
c.nospc$ = a2$
END FUNCTION

SUB c.print (s1$)
FOR i% = 1 TO LEN(s1$)
PRINT MID$(s1$, i%, 1);
NEXT
PRINT
END SUB

FUNCTION c.removetab$ (k1$)
b$ = ""
FOR i% = 1 TO LEN(k1$)
a$ = MID$(k1$, i%, 1)
IF (a$ = CHR$(9)) THEN
b$ = b$ + " "
spa% = 1
ELSEIF (a$ = " " AND spa% = 0) THEN
b$ = b$ + " "
spa% = 1
ELSEIF (a$ = " " AND spa% = 1) THEN
ELSE
b$ = b$ + a$
spa% = 0
END IF
NEXT
b$ = LTRIM$(RTRIM$(b$))
c.removetab$ = b$
END FUNCTION

FUNCTION c.stringword$ (s$, ps%)
SHARED CONST.separators AS STRING

b$ = ""
i% = ps%
sep% = 1
char% = 0
'Recieve all separators first
DO
    a1$ = MID$(s$, i%, 1)
    a1% = INSTR(CONST.separators, a1$)
    IF (a1% <> 0) THEN b$ = b$ + a1$ ELSE EXIT DO
    i% = i% + 1
LOOP
'Now recieve the next characters till a separator
DO
    a1$ = MID$(s$, i%, 1)
    a1% = INSTR(CONST.separators, a1$)
    IF (a1% = 0) THEN b$ = b$ + a1$ ELSE EXIT DO
    i% = i% + 1
LOOP
'Now recieve back code

i% = ps% - 1
IF (i% < 1) THEN GOTO c.stringword1
DO
    a1$ = MID$(s$, i%, 1)
    a1% = INSTR(CONST.separators, a1$)
    IF (a1% = 0) THEN b$ = a1$ + b$ ELSE EXIT DO
    i% = i% - 1
    IF (i% < 1) THEN EXIT DO
LOOP
c.stringword1:
c.stringword$ = b$
END FUNCTION

FUNCTION replace$ (s$, r1$, r2$) 'string,string to change,string to replace
l% = LEN(s$) - LEN(r1$) + 1   ' 6(12-7+1)
s% = LEN(r1$)
b$ = ""
i% = 1
DO UNTIL (i% > l%)
k$ = MID$(s$, i%, s%)
IF (k$ = r1$) THEN
b$ = b$ + r2$
i% = i% + s%
ELSE
b$ = b$ + LEFT$(k$, 1)
i% = i% + 1
END IF
LOOP
IF (i% < LEN(s$)) THEN z$ = RIGHT$(s$, LEN(s$) - i% - 1) ELSE z$ = ""
replace$ = b$ + z$
END FUNCTION