turbobasic/1998/3RD-PA.RTY/REMLINE.BAS

   1 '
   2 '   Microsoft RemLine - Line Number Removal Utility
   3 '   Copyright (C) Microsoft Corporation 1985-1990
   4 '
   5 '   REMLINE.BAS is a program to remove line numbers from Microsoft Basic
   6 '   Programs. It removes only those line numbers that are not the object
   7 '   of one of the following statements: GOSUB, RETURN, GOTO, THEN, ELSE,
   8 '   RESUME, RESTORE, or RUN.
   9 '
  10 '   When REMLINE is run, it will ask for the name of the file to be
  11 '   processed and the name of the file or device to receive the
  12 '   reformatted output. If no extension is given, .BAS is assumed (except
  13 '   for output devices). If filenames are not given, REMLINE prompts for
  14 '   file names. If both filenames are the same, REMLINE saves the original
  15 '   file with the extension .BAK.
  16 '
  17 '   REMLINE makes several assumptions about the program:
  18 '
  19 '     1. It must be correct syntactically, and must run in BASICA or
  20 '        GW-BASIC interpreter.
  21 '     2. There is a 400 line limit. To process larger files, change
  22 '        MaxLines constant.
  23 '     3. The first number encountered on a line is considered a line
  24 '        number; thus some continuation lines (in a compiler-specific
  25 '        construction) may not be handled correctly.
  26 '     4. REMLINE can handle simple statements that test the ERL function
  27 '        using  relational operators such as =, <, and >. For example,
  28 '        the following statement is handled correctly:
  29 '
  30 '             IF ERL = 100 THEN END
  31 '
  32 '        Line 100 is not removed from the source code. However, more
  33 '        complex expressions that contain the +, -, AND, OR, XOR, EQV,
  34 '        MOD, or IMP operators may not be handled correctly. For example,
  35 '        in the following statement REMLINE does not recognize line 105
  36 '        as a referenced line number and removes it from the source code:
  37 '
  38 '             IF ERL + 5 = 105 THEN END
  39 '
  40 '   If you do not like the way REMLINE formats its output, you can modify
  41 '   the output lines in SUB GenOutFile. An example is shown in comments.
  42 DEFINT A-Z
  43
  44 ' Function and Subprocedure declarations
  45 DECLARE FUNCTION GetToken$ (Search$, Delim$)
  46 DECLARE FUNCTION StrSpn% (InString$, Separator$)
  47 DECLARE FUNCTION StrBrk% (InString$, Separator$)
  48 DECLARE FUNCTION IsDigit% (Char$)
  49 DECLARE SUB GetFileNames ()
  50 DECLARE SUB BuildTable ()
  51 DECLARE SUB GenOutFile ()
  52 DECLARE SUB InitKeyTable ()
  53
  54 ' Global and constant data
  55 CONST TRUE = -1
  56 CONST false = 0
  57 CONST MaxLines = 400
  58
  59 DIM SHARED LineTable!(MaxLines)
  60 DIM SHARED LineCount
  61 DIM SHARED Seps$, InputFile$, OutputFile$, TmpFile$
  62
  63 ' Keyword search data
  64 CONST KeyWordCount = 9
  65 DIM SHARED KeyWordTable$(KeyWordCount)
  66
  67 KeyData:
  68    DATA THEN, ELSE, GOSUB, GOTO, RESUME, RETURN, RESTORE, RUN, ERL, ""
  69
  70 ' Start of module-level program code
  71    Seps$ = " ,:=<>()" + CHR$(9)
  72    InitKeyTable
  73    GetFileNames
  74    ON ERROR GOTO FileErr1
  75    OPEN InputFile$ FOR INPUT AS 1
  76    ON ERROR GOTO 0
  77    COLOR 7: PRINT "Working"; : COLOR 23: PRINT " . . .": COLOR 7: PRINT
  78    BuildTable
  79    CLOSE #1
  80    OPEN InputFile$ FOR INPUT AS 1
  81    ON ERROR GOTO FileErr2
  82    OPEN OutputFile$ FOR OUTPUT AS 2
  83    ON ERROR GOTO 0
  84    GenOutFile
  85    CLOSE #1, #2
  86    IF OutputFile$ <> "CON" THEN CLS
  87
  88 END
  89
  90 FileErr1:
  91    CLS
  92    PRINT "      Invalid file name": PRINT
  93    INPUT "      New input file name (ENTER to terminate): ", InputFile$
  94    IF InputFile$ = "" THEN END
  95 FileErr2:
  96    INPUT "      Output file name (ENTER to print to screen) :", OutputFile$
  97    PRINT
  98    IF (OutputFile$ = "") THEN OutputFile$ = "CON"
  99    IF TmpFile$ = "" THEN
 100       RESUME
 101    ELSE
 102       TmpFile$ = ""
 103       RESUME NEXT
 104    END IF
 105
 106 '
 107 ' BuildTable:
 108 '   Examines the entire text file looking for line numbers that are
 109 '   the object of GOTO, GOSUB, etc. As each is found, it is entered
 110 '   into a table of line numbers. The table is used during a second
 111 '   pass (see GenOutFile), when all line numbers not in the list
 112 '   are removed.
 113 ' Input:
 114 '   Uses globals KeyWordTable$, KeyWordCount, and Seps$
 115 ' Output:
 116 '   Modifies LineTable! and LineCount
 117 '
 118 SUB BuildTable STATIC
 119
 120    DO WHILE NOT EOF(1)
 121       ' Get line and first token
 122       LINE INPUT #1, InLin$
 123       Token$ = GetToken$(InLin$, Seps$)
 124       DO WHILE (Token$ <> "")
 125          FOR KeyIndex = 1 TO KeyWordCount
 126             ' See if token is keyword
 127             IF (KeyWordTable$(KeyIndex) = UCASE$(Token$)) THEN
 128                ' Get possible line number after keyword
 129                Token$ = GetToken$("", Seps$)
 130                ' Check each token to see if it is a line number
 131                ' (the LOOP is necessary for the multiple numbers
 132                ' of ON GOSUB or ON GOTO). A non-numeric token will
 133                ' terminate search.
 134                DO WHILE (IsDigit(LEFT$(Token$, 1)))
 135                   LineCount = LineCount + 1
 136                   LineTable!(LineCount) = VAL(Token$)
 137                   Token$ = GetToken$("", Seps$)
 138                   IF Token$ <> "" THEN KeyIndex = 0
 139                LOOP
 140             END IF
 141          NEXT KeyIndex
 142          ' Get next token
 143          Token$ = GetToken$("", Seps$)
 144       LOOP
 145    LOOP
 146
 147 END SUB
 148
 149 '
 150 ' GenOutFile:
 151 '  Generates an output file with unreferenced line numbers removed.
 152 ' Input:
 153 '  Uses globals LineTable!, LineCount, and Seps$
 154 ' Output:
 155 '  Processed file
 156 '
 157 SUB GenOutFile STATIC
 158
 159    ' Speed up by eliminating comma and colon (can't separate first token)
 160    Sep$ = " " + CHR$(9)
 161    DO WHILE NOT EOF(1)
 162       LINE INPUT #1, InLin$
 163       IF (InLin$ <> "") THEN
 164          ' Get first token and process if it is a line number
 165          Token$ = GetToken$(InLin$, Sep$)
 166          IF IsDigit(LEFT$(Token$, 1)) THEN
 167             LineNumber! = VAL(Token$)
 168             FoundNumber = false
 169             ' See if line number is in table of referenced line numbers
 170             FOR index = 1 TO LineCount
 171                IF (LineNumber! = LineTable!(index)) THEN
 172                   FoundNumber = TRUE
 173                END IF
 174             NEXT index
 175             ' Modify line strings
 176             IF (NOT FoundNumber) THEN
 177                Token$ = SPACE$(LEN(Token$))
 178                MID$(InLin$, StrSpn(InLin$, Sep$), LEN(Token$)) = Token$
 179             END IF
 180
 181             ' You can replace the previous lines with your own
 182             ' code to reformat output. For example, try these lines:
 183
 184             'TmpPos1 = StrSpn(InLin$, Sep$) + LEN(Token$)
 185             'TmpPos2 = TmpPos1 + StrSpn(MID$(InLin$, TmpPos1), Sep$)
 186             '
 187             'IF FoundNumber THEN
 188             '   InLin$ = LEFT$(InLin$, TmpPos1 - 1) + CHR$(9) + MID$(InLin$, TmpPos2)
 189             'ELSE
 190             '   InLin$ = CHR$(9) + MID$(InLin$, TmpPos2)
 191             'END IF
 192
 193          END IF
 194       END IF
 195       ' Print line to file or console (PRINT is faster than console device)
 196       IF OutputFile$ = "CON" THEN
 197          PRINT InLin$
 198       ELSE
 199          PRINT #2, InLin$
 200       END IF
 201    LOOP
 202
 203 END SUB
 204
 205 '
 206 ' GetFileNames:
 207 '  Gets a file name by prompting the user.
 208 ' Input:
 209 '  User input
 210 ' Output:
 211 '  Defines InputFiles$ and OutputFiles$
 212 '
 213 SUB GetFileNames STATIC
 214
 215     CLS
 216     PRINT " Microsoft RemLine: Line Number Removal Utility"
 217     PRINT "       (.BAS assumed if no extension given)"
 218     PRINT
 219     INPUT "      Input file name (ENTER to terminate): ", InputFile$
 220     IF InputFile$ = "" THEN END
 221     INPUT "      Output file name (ENTER to print to screen): ", OutputFile$
 222     PRINT
 223     IF (OutputFile$ = "") THEN OutputFile$ = "CON"
 224
 225    IF INSTR(InputFile$, ".") = 0 THEN
 226       InputFile$ = InputFile$ + ".BAS"
 227    END IF
 228
 229    IF INSTR(OutputFile$, ".") = 0 THEN
 230       SELECT CASE OutputFile$
 231          CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"
 232             EXIT SUB
 233          CASE ELSE
 234             OutputFile$ = OutputFile$ + ".BAS"
 235       END SELECT
 236    END IF
 237
 238    DO WHILE InputFile$ = OutputFile$
 239       TmpFile$ = LEFT$(InputFile$, INSTR(InputFile$, ".")) + "BAK"
 240       ON ERROR GOTO FileErr1
 241       NAME InputFile$ AS TmpFile$
 242       ON ERROR GOTO 0
 243       IF TmpFile$ <> "" THEN InputFile$ = TmpFile$
 244    LOOP
 245
 246 END SUB
 247
 248 '
 249 ' GetToken$:
 250 '  Extracts tokens from a string. A token is a word that is surrounded
 251 '  by separators, such as spaces or commas. Tokens are extracted and
 252 '  analyzed when parsing sentences or commands. To use the GetToken$
 253 '  function, pass the string to be parsed on the first call, then pass
 254 '  a null string on subsequent calls until the function returns a null
 255 '  to indicate that the entire string has been parsed.
 256 ' Input:
 257 '  Search$ = string to search
 258 '  Delim$  = String of separators
 259 ' Output:
 260 '  GetToken$ = next token
 261 '
 262 FUNCTION GetToken$ (Search$, Delim$) STATIC
 263
 264    ' Note that SaveStr$ and BegPos must be static from call to call
 265    ' (other variables are only static for efficiency).
 266    ' If first call, make a copy of the string
 267    IF (Search$ <> "") THEN
 268       BegPos = 1
 269       SaveStr$ = Search$
 270    END IF
 271
 272    ' Find the start of the next token
 273    NewPos = StrSpn(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)
 274    IF NewPos THEN
 275       ' Set position to start of token
 276       BegPos = NewPos + BegPos - 1
 277    ELSE
 278       ' If no new token, quit and return null
 279       GetToken$ = ""
 280       EXIT FUNCTION
 281    END IF
 282
 283    ' Find end of token
 284    NewPos = StrBrk(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)
 285    IF NewPos THEN
 286       ' Set position to end of token
 287       NewPos = BegPos + NewPos - 1
 288    ELSE
 289       ' If no end of token, return set to end a value
 290       NewPos = LEN(SaveStr$) + 1
 291    END IF
 292    ' Cut token out of search string
 293    GetToken$ = MID$(SaveStr$, BegPos, NewPos - BegPos)
 294    ' Set new starting position
 295    BegPos = NewPos
 296
 297 END FUNCTION
 298
 299 '
 300 ' InitKeyTable:
 301 '  Initializes a keyword table. Keywords must be recognized so that
 302 '  line numbers can be distinguished from numeric constants.
 303 ' Input:
 304 '  Uses KeyData
 305 ' Output:
 306 '  Modifies global array KeyWordTable$
 307 '
 308 SUB InitKeyTable STATIC
 309
 310    RESTORE KeyData
 311    FOR Count = 1 TO KeyWordCount
 312       READ KeyWord$
 313       KeyWordTable$(Count) = KeyWord$
 314    NEXT
 315
 316 END SUB
 317
 318 '
 319 ' IsDigit:
 320 '  Returns true if character passed is a decimal digit. Since any
 321 '  Basic token starting with a digit is a number, the function only
 322 '  needs to check the first digit. Doesn't check for negative numbers,
 323 '  but that's not needed here.
 324 ' Input:
 325 '  Char$ - initial character of string to check
 326 ' Output:
 327 '  IsDigit - true if within 0 - 9
 328 '
 329 FUNCTION IsDigit (Char$) STATIC
 330
 331    IF (Char$ = "") THEN
 332       IsDigit = false
 333    ELSE
 334       CharAsc = ASC(Char$)
 335       IsDigit = (CharAsc >= ASC("0")) AND (CharAsc <= ASC("9"))
 336    END IF
 337
 338 END FUNCTION
 339
 340 '
 341 ' StrBrk:
 342 '  Searches InString$ to find the first character from among those in
 343 '  Separator$. Returns the index of that character. This function can
 344 '  be used to find the end of a token.
 345 ' Input:
 346 '  InString$ = string to search
 347 '  Separator$ = characters to search for
 348 ' Output:
 349 '  StrBrk = index to first match in InString$ or 0 if none match
 350 '
 351 FUNCTION StrBrk (InString$, Separator$) STATIC
 352
 353    Ln = LEN(InString$)
 354    BegPos = 1
 355    ' Look for end of token (first character that is a delimiter).
 356    DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) = 0
 357       IF BegPos > Ln THEN
 358          StrBrk = 0
 359          EXIT FUNCTION
 360       ELSE
 361          BegPos = BegPos + 1
 362       END IF
 363    LOOP
 364    StrBrk = BegPos
 365
 366 END FUNCTION
 367
 368 '
 369 ' StrSpn:
 370 '  Searches InString$ to find the first character that is not one of
 371 '  those in Separator$. Returns the index of that character. This
 372 '  function can be used to find the start of a token.
 373 ' Input:
 374 '  InString$ = string to search
 375 '  Separator$ = characters to search for
 376 ' Output:
 377 '  StrSpn = index to first nonmatch in InString$ or 0 if all match
 378 '
 379 FUNCTION StrSpn% (InString$, Separator$) STATIC
 380
 381    Ln = LEN(InString$)
 382    BegPos = 1
 383    ' Look for start of a token (character that isn't a delimiter).
 384    DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1))
 385       IF BegPos > Ln THEN
 386          StrSpn = 0
 387          EXIT FUNCTION
 388       ELSE
 389          BegPos = BegPos + 1
 390       END IF
 391    LOOP
 392    StrSpn = BegPos
 393
 394 END FUNCTION
 395