REFJUN1 26 May 2010
Altair BASIC Reformatter

This program takes an Altair BASIC Program, saved in Ascii, as input.
REFJUN1 outputs a version of the input program that is more readable.
Use CRUNCHER on REFJUN1 to get REFORMAT.

Tom Sanderson
www.virtualaltair.com

10 '--------------------------------------------------------------------

 

      BASIC REFORMATTER.

  

 ------------------------------------------------------------------------

 
11 'NOTES: THIS PROGRAM ASSUMES THAT THE INPUT FILE IS A SYNTAX FREE

            ASCII BASIC PROGRAM WITH AT LEAST ONE BLANK AFTER THE LINE

            NUMBER. THE SYSTEM MAY CRASH OR PRINT GARBAGE IF THE INPUT 

            FILE IS NOT ASCII.

  
12 '       THE PROGRAM ASSUMES THE PRINTER IS AT THE TOP OF A PAGE WHEN

            IT IS STARTED.

 

  
13 '       UNLIKE BASIC, COLONS IN A DATA STATEMENT THAT ARE NOT IN 

            QUOTES ARE CONSIDERED AS PART OF THE DATA STATEMENT.

 

  
19 '--------------------------------------------------------------------

  
20 CLEAR 12000

  
30 ON ERROR GOTO 65000      'ERROR HANDLING.

  
40 DEFINT A - Z             'ALL VARIABLES ARE INTEGER.

  
50 PRINT

 :  PRINT "BASIC REFORMATTER"

 :  PRINT

  
60 GOSUB 1000               'INITIALIZE VARIABLES.

  
70 GOSUB 2000               'OPEN FILES.
80 GOSUB 3000               'REFORMAT FILTER.
90 GOSUB 4000               'CLOSE FILES.

  
100 PRINT

 :   PRINT "END OF REFORMATTING"

 :   PRINT

  
110 ON ERROR GOTO 0         'RETURN TO BASIC'S ERROR TRAPPING.

  
120 CLEAR 200               'RESET STRING SPACE.

  
999 END

  
1000 '------------------------------------------------------------------

 

      SUBROUTINE TO INITIALIZE VARIABLES.

 

  
1010 LC = 0            'PRINTER LINE COUNT.
1020 PS = 65           'PHYSICAL PAGE SIZE.
1030 RS = 60           'REPORT PAGE SIZE.
1040 PT = 4            'REPORT PAGE TOP.
1050 LF$ = CHR$(10)    'LINE FEED.
1060 CH$ = "EOS"       'CHARACTER SET TO "EOS" TO FORCE INITIAL READ.
1070 OL$ = ""          'PRINT LINE.
1080 CR$ = CHR$(13)    'CARRIAGE RETURN.
1090 QT$ = CHR$(34)    'QUOTE MARK.
1100 KEY$ = "N"        'KEYWORD FOUND FLAG.
1999 RETURN

  
2000 '------------------------------------------------------------------

 

      SUBROUTINE TO OPEN FILES.

 

  
2010 PRINT

 :    INPUT "ENTER THE INPUT FILE NAME. "; IN$

 :    PRINT

  
2020 AF$ = "Y"
2030 PRINT

 :    INPUT "WAS THIS FILE SAVED WITH THE 'A' OPTION? (ENTER N FOR NO OR 
RETURN FOR YES) "; AF$

 :    PRINT

  
2038 IF AF$ = "NO" THEN

         AF$ = "N"

  
2039 IF AF$ = "YES" THEN

         AF$ = "Y"

  
2040 IF AF$ = "Y" THEN

         GOTO 2050

      ELSE

         IF AF$ <> "N" THEN

            GOTO 2030

  
2045 PRINT

 :    PRINT "SAVE THE FILE USING THE 'A' OPTION AND TRY AGAIN."

 :    PRINT

  
2050 ID = 1       'DEFAULT INPUT DISK DRIVE NUMBER.
2060 INPUT "

 

 ENTER INPUT DISK NUMBER (DEFAULT = 1) "; ID

  
2070 OPEN "I", #1, IN$, ID

  
2080 LPRINT

 :    LPRINT

 :    LPRINT "**** FILE "; IN$; " ON DISK "; ID; "REFORMATTED"

 :    LPRINT

 :    LPRINT

 :    LC = LC + 5

  
2999 RETURN

  
3000 '------------------------------------------------------------------

 

      SUBROUTINE TO FILTER A BASIC PROGRAM SAVED IN ASCII.

 

 
3010 GOSUB 8000     'GET A CHARACTER.

  
3015 IF CH$ = "EOF" THEN GOTO 3999

  
3020 GOSUB 22000    'CHARACTER FILTERS.

  
3030 GOSUB 10000    'PUT A CHARACTER.

  
3040 GOTO 3010      'MAIN FILTER LOOP.

  
3999 RETURN

  
4000 '------------------------------------------------------------------

 

      SUBROUTINE TO CLOSE FILES.

 

  
4010 CLOSE 1         'CLOSE THE INPUT FILE.

  
4020 GOSUB 5000      'SKIP TO THE END OF THE PAGE.

  
4999 RETURN

  
5000 '------------------------------------------------------------------

 

      SUBROUTINE TO SKIP TO THE END OF THE PHYSICAL PAGE.

 

  
5010 FOR I = LC TO PS STEP 1

 :        LPRINT

 :        NEXT I       'SKIP TO THE END OF THE PHYSICAL PAGE.

  
5020 LC = 0           'RESET THE LINE COUNTER.

  
5999 RETURN

  
6000 '------------------------------------------------------------------

 

      SUBROUTINE FOR THE TOP OF THE PAGE TEST.

 

  
6010 IF LC < RS THEN GOTO 6999
6020    GOSUB 5000     'SKIP TO THE END OF THE PHYSICAL PAGE.
6030    GOSUB 7000     'SKIP TO THE TOP OF THE REPORT.

  
6999 RETURN

  
7000 '------------------------------------------------------------------

 

      SUBROUTINE TO SKIP TO THE TOP OF THE REPORT.

 

  
7010 IF LC = PT THEN

         GOTO 7999

      ELSE

         LPRINT

 :       LC = LC + 1

 :       GOTO 7010

  
7999 RETURN

  
8000 '------------------------------------------------------------------

 

      SUBROUTINE TO GET A CHARACTER.

 

  
8010 IF CH$ = "EOS" THEN

         IF EOF(1) THEN

            CH$ = "EOF"

 :          RETURN

      ELSE

         LINE INPUT #1, IR$

 :       GOSUB 11000

  
8020 IF SL = 0 THEN

         CH$ = "EOS"

 :       RETURN

      ELSE

         CH$ = LEFT$(IR$,1)

 :       SL = SL - 1

 :       IF SL > 0 THEN IR$ = RIGHT$(IR$,SL)

 
8999 RETURN

  
9000 '------------------------------------------------------------------

 

       SUBROUTINE TO FILTER ALPHA CHARACTERS.

 

  
9001 GOSUB 14000     'LEADING KEYWORD SEARCH.
9002 GOSUB 15000     'TRAILING KEYWORD SEARCH.

  
9003 RETURN
9004 '------------------------------------------------------------------

 

       SUBROUTINE TO FILTER NON-ALPHA CHARACTERS.

 

  
9005 '------------------------------------------------------------------

 

       CHECK FOR SINGLE QUOTED REMARKS.

 

  
9006 IF CH$ = "'" THEN

         GOSUB 13000

       : RETURN      'SKIP SINGLE QUOTED REMARKS.

 

  
9007 '------------------------------------------------------------------

 

       STRING LITERAL CHECK.

 

  
9008 IF CH$ = QT$ THEN

         GOSUB 12000

      :  RETURN     'SKIP STRING LITERALS.

 

  
9009 '------------------------------------------------------------------

 

       LINE FEED CHECK.

 

  
9010 IF CH$ = LF$ THEN 

         LC = LC + 1

      :  RETURN     'COUNT LINE FEEDS IN THE LINE COUNT.

 

  
9019 '------------------------------------------------------------------

 

       COLON CHECK - MULTIPLE STATEMENTS ON ONE BASIC LINE.

 

  
9020 IF CH$ = ":" THEN

         LPRINT OL$

 :       LC = LC + 1

 :       GOSUB 6000

 :       OL$ = ""

 :       CH$ = ":" + SPACE$(LL - 1)

 :       RETURN

   
9025 '------------------------------------------------------------------

 

       CHARACTER CHECK.

 

  
9030 IF CH$ = "+" THEN

         CH$ = " + "

 :       RETURN

  
9040 IF CH$ = ";" THEN

         CH$ = "; "

 :       RETURN

  
9050 IF CH$ = "," THEN

         CH$ = ", "

 :       RETURN

  
9060 IF CH$ = "-" THEN

         CH$ = " - "

 :       RETURN

  
9065 '------------------------------------------------------------------

 

       RELATIONAL CHECK.

 

  
9070 NC$ = LEFT$(IR$, 1)     'GET THE LOOK AHEAD CHARACTER.

  
9080 IF CH$ = "=" THEN

         OL$ = OL$ + " " + CH$

 :       CH$ = " "

 

 :       IF (NC$ = ">")

         OR (NC$ = "<")  THEN

            GOSUB 8000

         :  OL$ = OL$ + CH$

         :  CH$ = " "

         ELSE

            RETURN

 :       RETURN

  
9090 IF CH$ = "<" THEN

         OL$ = OL$ + " " + CH$

 :       CH$ = " "

 

 :       IF (NC$ = ">")

         OR (NC$ = "=") THEN

            GOSUB 8000

         :  OL$ = OL$ + CH$

         :  CH$ = " "

         ELSE

            RETURN

 :       RETURN

  
9100 IF CH$ = ">" THEN

         OL$ = OL$ + " " + CH$

 :       CH$ = " "

 :       IF NC$ = "=" THEN

            GOSUB 8000

         :  OL$ = OL$ + CH$

         :  CH$ = " "

         ELSE

            RETURN

 :       RETURN

  
9999 RETURN

  
10000 '-----------------------------------------------------------------

 

       SUBROUTINE TO PUT A CHARACTER.

 

  
10010 IF CH$ <> "EOS" THEN

          OL$ = OL$ + CH$

       ELSE

          LPRINT OL$

       :  LC = LC + 1

       :  GOSUB 6000

       :  OL$ = ""

   
10999 RETURN

  
11000 '-----------------------------------------------------------------

 

       SUBROUTINE TO GET AND MEASURE THE LINE NUMBER + THE NEXT BLANK.

 

  
11001 OUT 8, 15

  
11002 SL = LEN(IR$)

  
11010 REM   THIS ROUTINE ASSUMES THAT THERE IS A BLANK AFTER THE LINE

             NUMBER.

  
11015 IF IR$ = "" THEN

          RETURN

  
11020 LN$ = LEFT$(IR$, INSTR(IR$, " "))
11030 LL = LEN(LN$)
11040 OL$ = OL$ + LN$
11050 SL = SL - LL
11060 IR$ = RIGHT$(IR$, SL)

  
11999 RETURN
12000 '-----------------------------------------------------------------

 

       SUBROUTINE TO SKIP STRING LITERALS.

 

  
12010 OL$ = OL$ + CH$   'ADD CHARACTER TO OUTPUT LINE.
12020 GOSUB 8000        'GET ANOTHER CHARACTER.
12030 IF CH$ = "EOS" THEN

          ERROR(100)

 :        RETURN         'UNMATCHED QUOTE.

  
12040 IF CH$ <> QT$ THEN

          GOTO 12010

  
12999 RETURN
13000 '-----------------------------------------------------------------

 

       SUBROUTINE TO SKIP TO THE END OF THE STATEMENT.

 

  
13010 OL$ = OL$ + CH$   'ADD THE CHARACTER TO THE OUTPUT LINE.
13020 GOSUB 8000        'GET ANOTHER CHARACTER.
13030 IF CH$ <> "EOS" THEN

          GOTO 13010

  
13999 RETURN
14000 '-----------------------------------------------------------------

 

       SUBROUTINE FOR THE LEADING KEYWORD SEARCH.

 

  
14010 IF SL < 2 THEN

          RETURN

  
14020 IF (CH$ + LEFT$(IR$,2)) = "REM" THEN

          GOSUB 13000     'SKIP TO THE STATEMENT'S END.

  
14030 IF SL < 3 THEN

          RETURN

  
14040 T4$ = CH$ + LEFT$(IR$, 3)     'THE LEADING FOUR CHARACTERS.

  
14050 IF T4$ = "THEN" THEN

          OL$ = OL$ + " "

       :  RETURN     'ADD A LEADING BLANK.

  
14060 IF T4$ = "ELSE" THEN

          OL$ = OL$ + " "

       :  RETURN     'ADD A LEADING BLANK.

  
14070 IF T4$ = "DATA" THEN

          GOSUB 13000

       :  RETURN     'SKIP TO THE STATEMENT'S END.

  
14080 IF T4$ = "STEP" THEN

          OL$ = OL$ + " "

       :  RETURN     'ADD A LEADING BLANK.

  
14999 RETURN
15000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR THE TRAILING KEYWORD SEARCH.

 

  
15010 OL = LEN(OL$)

  
15020 IF OL < 1 THEN

          RETURN

  
15030 T2$ = RIGHT$(OL$, 1) + CH$
15040 GOSUB 16000    'TWO CHARACTER KEYWORD CHECK.

  
15045 IF KEY$ = "Y" THEN

          GOTO 15990

  
15050 IF OL < 2 THEN

          RETURN

  
15060 T3$ = RIGHT$(OL$, 2) + CH$
15070 GOSUB 17000     'THREE CHARACTER KEYWORD SEARCH.

  
15075 IF KEY$ = "Y" THEN

          GOTO 15990

  
15080 IF OL < 3 THEN

          RETURN

  
15090 T4$ = RIGHT$(OL$, 3) + CH$
15100 GOSUB 18000     'FOUR CHARACTER KEYWORD SEARCH.

  
15105 IF KEY$ = "Y" THEN

          GOTO 15990

  
15110 IF OL < 4 THEN

          RETURN

  
15120 T5$ = RIGHT$(OL$, 4) + CH$
15130 GOSUB 19000     'FIVE CHARACTER KEYWORD SEARCH.

  
15135 IF KEY$ = "Y" THEN

          GOTO 15990

  
15140 IF OL < 5 THEN

          RETURN

  
15150 T6$ = RIGHT$(OL$, 5) + CH$
15160 GOSUB 20000     'SIX CHARACTER KEYWORD SEARCH.

  
15165 IF KEY$ = "Y" THEN

          GOTO 15990

  
15170 IF OL < 6 THEN

          RETURN

  
15180 T7$ = RIGHT$(OL$, 6) + CH$
15190 GOSUB 21000

  
15195 IF KEY$ = "Y" THEN

          GOTO 15990

  
15990 KEY$ = "N"

  
15999 RETURN
16000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR TWO CHARACTER KEYWORD SEARCH.

 

  
16010 IF T2$ = "IF" THEN GOTO 16500
16490 RETURN
16500 CH$ = CH$ + " "
16999 RETURN
17000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR THREE CHARACTER KEYWORD SEARCH.

 

  
17010 IF T3$ = "FOR" THEN GOTO 17500
17020 IF T3$ = "DIM" THEN GOTO 17500
17030 IF T3$ = "AND" THEN GOTO 17500
17040 IF T3$ = "GET" THEN GOTO 17500
17050 IF T3$ = "PUT" THEN GOTO 17500
17060 IF T3$ = "NOT" THEN GOTO 17500
17070 IF T3$ = "LET" THEN GOTO 17500
17080 IF T3$ = "OUT" THEN GOTO 17500
17490 RETURN
17500 CH$ = CH$ + " "
17510 KEY$ = "Y"

  
17999 RETURN
18000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR FOUR CHARACTER KEYWORD SEARCH.

 

  
18010 IF T4$ = "GOTO" THEN GOTO 18500
18020 IF T4$ = "THEN" THEN GOTO 18500
18030 IF T4$ = "ELSE" THEN GOTO 18500
18040 IF T4$ = "STEP" THEN GOTO 18500
18050 IF T4$ = "LOAD" THEN GOTO 18500
18060 IF T4$ = "NEXT" THEN GOTO 18500
18070 IF T4$ = "POKE" THEN GOTO 18500
18080 IF T4$ = "PEEK" THEN GOTO 18500
18090 IF T4$ = "READ" THEN GOTO 18500
18100 IF T4$ = "WAIT" THEN GOTO 18500
18110 IF T4$ = "OPEN" THEN GOTO 18500
18120 IF T4$ = "LINE" THEN GOTO 18500
18130 IF T4$ = "LSET" THEN GOTO 18500
18140 IF T4$ = "RSET" THEN GOTO 18500
18150 IF T4$ = "SWAP" THEN GOTO 18500
18490 RETURN
18500 CH$ = CH$ + " "
18510 KEY$ = "Y"

  
18999 RETURN
19000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR FIVE CHARACTER KEYWORD SEARCH.

 

  
19010 IF T5$ = "CLEAR" THEN GOTO 19500
19020 IF T5$ = "ERROR" THEN GOTO 19500
19030 IF T5$ = "GOSUB" THEN GOTO 19500
19040 IF T5$ = "PRINT" THEN GOTO 19500
19050 IF T5$ = "WIDTH" THEN GOTO 19500
19060 IF T5$ = "CLOSE" THEN GOTO 19500
19070 IF T5$ = "ERASE" THEN GOTO 19500
19080 IF T5$ = "USING" THEN GOTO 19500
19090 IF T5$ = "MOUNT" THEN GOTO 19500
19100 IF T5$ = "INPUT" THEN GOTO 19500
19110 IF T5$ = "FIELD" THEN GOTO 19500
19490 RETURN
19500 CH$ = CH$ + " "
19510 KEY$ = "Y"

  
19999 RETURN
20000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR SIX CHARACTER KEYWORD SEARCH.

 

  
20010 IF T6$ = "LPRINT" THEN GOTO 20500
20020 IF T6$ = "RESUME" THEN GOTO 20500
20030 IF T6$ = "UNLOAD" THEN GOTO 20500
20040 IF T6$ = "DEFDBL" THEN GOTO 20500
20050 IF T6$ = "DEFINT" THEN GOTO 20500
20060 IF T6$ = "DEFSNG" THEN GOTO 20500
20070 IF T6$ = "DEFSTR" THEN GOTO 20500
20490 RETURN
20500 CH$ = CH$ + " "
20510 KEY$ = "Y"

  
20999 RETURN
21000 '-----------------------------------------------------------------

 

        SUBROUTINE FOR SEVEN CHARACTER KEYWORD SEARCH.

 

  
21010 IF T7$ = "CONSOLE" THEN GOTO 21500
21490 RETURN
21500 CH$ = CH$ + " "
21510 KEY$ = "Y"

  
21999 RETURN
22000 '-----------------------------------------------------------------
-

 

       SUBROUTINE - FILTER.

 

  
22010 IF CH$ = " " THEN 

          GOSUB 8000

       :  GOTO 22010     'REMOVE BLANKS.

  
22020 IF ((CH$ < "A") OR (CH$ > "z")

       OR  (CH$ > "Z") AND (CH$ < "a")) THEN

          GOSUB 9004

       ELSE

          GOSUB 9000

  
22999 RETURN
65000 '-----------------------------------------------------------------

 

       SUBROUTINE FOR ERROR HANDLING.

 

  
65010 IF ERR <> 100 THEN

          GOTO 65020

  
65011 PRINT

 :     PRINT "**** UNMATCHED QUOTES IN THE LINE BELOW."

 :     PRINT

  
65012 LPRINT

 :     LPRINT "**** UNMATCHED QUOTES IN THE LINE BELOW."

 :     LPRINT

 :     LC = LC + 3

  
65013 RESUME 12999

  
65020 IF (ERL <> 11020)

       OR (ERR <> 5) THEN

          GOTO 65030

  
65021 PRINT

 :     PRINT "**** NO LINE NUMBER FOUND IN LINE BELOW."

 :     PRINT IR$

 :     PRINT

  
65022 LPRINT

 :     LPRINT "**** NO LINE NUMBER FOUND IN THE LINE BELOW."

 :     LPRINT IR$

 :     LPRINT

 :     LC = LC + 4

  
65023 SL = 0

 :     RESUME 11999

  
65030 REM   NEXT ERROR CHECK.

  
65080 PRINT "

 **** ERROR NUMBER "; ERR; " IN LINE "; ERL

  
65090 RESUME 90 'CLOSE FILES AND END.

  
65099 RETURN

  
OK