REM File: Program Deadcde2 for Dndbbs Version v5.0a Release r2.0 Tweak t5.0a

REM Deadcode analyzer v1.3a for dndbbs subs

REM $INCLUDE: 'io9.inc'

' declare functions
FUNCTION Form$(Var#)
 Form$=Format$(Var#,"#,##0;;"+Chr$(34)+"zero"+Chr$(34))
END FUNCTION

ON ERROR GOTO Error.Routine

DIM subroutines(1 TO 1024) AS STRING
DIM variable(1 TO 1024) AS INTEGER
DIM subnames(1 TO 128) AS STRING

COLOR 15, 0
PRINT "Deadcode Subs analyzer v1.3a for Dndbbs."
COLOR 14, 0
PRINT "Press any key to start:";
LOCATE ,,1
WHILE INKEY$ = Nul
   Gosub TimeSlice
WEND
PRINT
' get analyze type
looptype = False
COLOR 15, 0
PRINT "Enter analyze type: (1)prompt (2)continuous: ";
LOCATE ,,1
DO
   Var$ = Nul
   WHILE Var$ = Nul
      Var$ = INKEY$
      Gosub TimeSlice
   WEND
   IF Var$ = "1" THEN
      Print "1"
      looptype = 1
      EXIT DO
   END IF
   IF Var$ = "2" THEN
      Print "2"
      looptype = 2
      EXIT DO
   END IF
LOOP
' get sub names
IF Command$ <> "" Then
   FileSpec$ = Command$
Else
   FileSpec$ = "cmd*.bas"
Endif
FileName$ = DIR$(FileSpec$)
WHILE LEN(FileName$)
   subcount = subcount + 1
   subnames(subcount) = FileName$
   FileName$ = DIR$
WEND
' sort sub names
FOR Sort1 = 1 TO subcount
   FOR Sort2 = Sort1 + 1 TO subcount
      IF subnames(Sort1) > subnames(Sort2) THEN
         SWAP subnames(Sort1), subnames(Sort2)
      END IF
   NEXT
NEXT
' process subs
flagtotals = False
NextSub = False
DO
   NextSub = NextSub + 1
   LastSub = NextSub
   subs = 1
   programname$ = subnames(NextSub)
   IF NextSub < subcount THEN
      IF LEFT$(subnames(NextSub), 6) = LEFT$(subnames(NextSub + 1), 6) THEN
         NextSub = NextSub + 1
         subs = 2
      END IF
   END IF
   IF NextSub < subcount THEN
      IF LEFT$(subnames(NextSub), 6) = LEFT$(subnames(NextSub + 1), 6) THEN
         NextSub = NextSub + 1
         subs = 3
      END IF
   END IF
   IF NextSub < subcount THEN
      IF LEFT$(subnames(NextSub), 6) = LEFT$(subnames(NextSub + 1), 6) THEN
         NextSub = NextSub + 1
         subs = 4
      END IF
   END IF
   IF NextSub > subcount THEN
      EXIT DO
   END IF
   FOR Var1 = 1 TO 1024
      subroutines(Var1) = Nul
      variable(Var1) = False
   NEXT
   routinecount = False
   FOR Var1 = 1 TO subs
      programname$ = subnames(LastSub + Var1 - 1)
      CLOSE
      OPEN programname$ FOR INPUT AS #1
      WHILE NOT EOF(1)
         LINE INPUT #1, programline$
         programline$ = LTRIM$(programline$)
         programline$ = LCASE$(programline$)
         IF LEFT$(programline$, 4) = "sub " THEN
            programline$ = MID$(programline$, 5)
            programline$ = LTRIM$(programline$)
            IF INSTR(programline$, "(") THEN
               programline$ = LEFT$(programline$, INSTR(programline$, "(") - 1)
            END IF
            IF INSTR(programline$, "'") THEN
               programline$ = LEFT$(programline$, INSTR(programline$, "'") - 1)
            END IF
            programline$ = RTRIM$(programline$)
            lineexists = True
            IF routinecount > False THEN
               FOR arraycount = routinecount TO 1024
                  IF RTRIM$(subroutines(arraycount)) = Nul THEN
                     EXIT FOR
                  END IF
                  IF RTRIM$(subroutines(arraycount)) = programline$ THEN
                     lineexists = False
                     EXIT FOR
                  END IF
               NEXT
            END IF
            IF lineexists THEN
               routinecount = routinecount + 1
               subroutines(routinecount) = programline$
            END IF
         END IF
      WEND
   NEXT
   COLOR 15, 0
   VarQ$ = Lcase$(programname$)
   VarQ$ = Left$(VarQ$,Instr(VarQ$,".")-1)
   Mid$(VarQ$,1,1) = Ucase$(Mid$(VarQ$,1,1))
   PRINT VarQ$; ": ";
   VarQ$ = Form$(Cdbl(routinecount)) + " unique subroutine"
   IF routinecount>1 Then
      VarQ$=VarQ$+"s"
   END IF
   VarQ$=VarQ$+"."
   PRINT VarQ$
   totalunique = totalunique + routinecount
   FOR Var1 = 1 TO subs
      programname$ = subnames(LastSub + Var1 - 1)
      CLOSE
      OPEN programname$ FOR INPUT AS #1
      COLOR 14, 0
      PRINT programname$; " ";
      WHILE NOT EOF(1)
         LINE INPUT #1, programline$
         programline$ = LTRIM$(programline$)
         programline$ = LCASE$(programline$)
         IF LEFT$(programline$, 5) = "call " THEN
            programline$ = MID$(programline$, 6)
            programline$ = LTRIM$(programline$)
            IF INSTR(programline$, "(") THEN
               programline$ = LEFT$(programline$, INSTR(programline$, "(") - 1)
            END IF
            IF INSTR(programline$, "'") THEN
               programline$ = LEFT$(programline$, INSTR(programline$, "'") - 1)
            END IF
            programline$ = RTRIM$(programline$)
            lineexists = False
            FOR arraycount = 1 TO routinecount
               IF RTRIM$(subroutines(arraycount)) = programline$ THEN
                  lineexists = True
                  EXIT FOR
               END IF
            NEXT
            IF lineexists THEN
               variable(arraycount) = variable(arraycount) + 1
            END IF
         END IF
      WEND
   NEXT
   PRINT
   flag = False
   FOR count = 1 TO routinecount
      IF variable(count) = False THEN
         COLOR 15, 0
         PRINT subroutines(count); " is deadcode."
         flag = True
         flagtotals = True
      END IF
   NEXT
   IF flag = False THEN
      COLOR 15, 0
      PRINT "No deadcode found."
   END IF
   IF INKEY$ = CHR$(27) THEN
      EXIT DO
   END IF
   IF flag = True OR looptype = 1 THEN
      COLOR 14, 0
      PRINT "More(y/n):";
      LOCATE ,,1
      DO
         Var$ = Nul
         WHILE Var$ = Nul
            Var$ = INKEY$
            Gosub TimeSlice
         WEND
         SELECT CASE LCASE$(Var$)
         CASE "n"
            COLOR 7, 0
            PRINT
            END
         CASE "y"
            PRINT
            EXIT DO
         CASE CHR$(13)
            PRINT
            EXIT DO
         CASE CHR$(32)
            PRINT
            EXIT DO
         END SELECT
      LOOP
   END IF
   Gosub TimeSlice
LOOP
IF flagtotals = False THEN
   COLOR 15, 0
   PRINT "No deadcode found in any subprograms."
END IF
COLOR 15, 0
PRINT "Total unique subroutines: ";
PRINT Form$(Cdbl(totalunique)); " in: ";
PRINT Form$(Cdbl(subcount)); " programs."
COLOR 7, 0
END

TimeSlice:
 InregsX.AX=&H1680
 InregsX.BX=&H0000
 Call InterruptX(&H2F,InregsX,OutregsX)
 Return

Error.Routine:
PRINT "Error"; ERR; "file "; programname$
END
