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