2000 REM ...... THIS IS FILE "PACKER.BAS"
2010
2020 !---------------------------------!
2030 ! ALPHABASIC SOURCE CODE PACKER !
2040 !---------------------------------!
2050
2060 !------------------------------------------------------------------------!
2070 ! THIS PROGRAM IS FOR MEMORY HOGS !
2080 ! IT ACCEPTS AS INPUT THE FILE NAME OF ANY BASIC SOURCE PROGRAM !
2090 ! (NORMALLY, A PROGRAM TOO BIG TO COMPILE IN ALPHABASIC), !
2100 ! & CREATES A PACKED (MEMORY-SAVING) VERSION OF IT, !
2110 ! WHILE LEAVING THE ORIGINAL UNTOUCHED (SUITABLE FOR FRAMING !). !
2120 ! !
2130 ! THE PACKED VERSION IS LIKE THE ORIGINAL, EXCEPT THAT !
2140 ! (1) BLANK LINES ARE REMOVED (IF THE USER SO SPECIFIES) !
2150 ! (2) "REM" AND "!" STATEMENTS ARE REPLACED BY BLANK LINES !
2160 ! (OR REMOVED ENTIRELY, IF THE USER SO SPECIFIES) !
2170 ! (3) BLANKS ARE DELETED, EXCEPT IN THE FOLLOWING CASES : !
2180 ! --- WITHIN QUOTES !
2190 ! --- WITHIN THE DATA AREA OF A "DATA" STATEMENT !
2200 ! --- ONE BLANK IS LEFT BEFORE THE FOLLOWING RESERVED WORDS : !
2210 ! "AND" "OR" !
2220 ! "TO" "STEP" !
2230 ! "ELSE" !
2240 ! "MAX" "MIN" !
2250 ! (4) EACH "PRINT" IS CHANGED TO "?", EXCEPT WHEN USED IN LABELS !
2260 ! (5) THE LINE "1NOEXPAND" IS ADDED TO THE PACKED FILE VERSION !
2270 ! (NOTE : AVOID USE OF THE LABEL "PRINT" BY ITSELF) !
2280 ! (6) THE PACKED FILE HAS EXTENSION ".PAK" !
2290 ! !
2300 ! THE PACKED VERSION REQUIRES LESS ROOM TO LOAD, BUT PRODUCES EXACTLY !
2310 ! THE SAME OBJECT (".RUN") CODE. !
2320 !------------------------------------------------------------------------!
2330
2340 REM ...... STRING DEFINITIONS
2350 MAP1 IN$ ,S,6
2360 MAP1 INFNAME$ ,S,10
2370 MAP1 OUTFNAME$,S,10
2380 MAP1 CODE$ ,S,250
2390 MAP1 NCODE$ ,S,250
2400 MAP1 FIRST$ ,S,1
2410 MAP1 DELETE'EMPTY$,S,1
2420 MAP1 DELETE'REMS$ ,S,1
2430
2440 NEW'FILE:
2450 ? "ENTER NAME OF BASIC SOURCE PROGRAM TO BE PACKED (1-6 CHARACTERS) : ";
2460 INPUT "" IN$
2470 INFNAME$=IN$+".BAS"
2480 LOOKUP INFNAME$, THERE
2490 IF(THERE < 0) THEN PRINT "ERROR---RANDOM FILE NAME !" : GO TO NEW'FILE
2500 IF(THERE = 0) THEN PRINT "ERROR---FILE DOESN'T EXIST" : GO TO NEW'FILE
2510 OPEN #1, INFNAME$, INPUT
2520 OUTFNAME$=IN$+".PAK"
2530 OPEN #2, OUTFNAME$, OUTPUT
2540
2550 REM ...... SPECIFY OPTIONS FOR EMPTY & REMARK LINES
2560 DELETE'EMPTY$="N"
2570 INPUT "SHALL BLANK LINES BE DELETED ? ('Y' OR 'N') : ", DELETE'EMPTY$
2580 DELETE'REMS$="N"
2590 INPUT "SHALL REMARK LINES BE DELETED ? ('Y' OR 'N') : ", DELETE'REMS$
2600
2610 REM ...... INITIAL CONDITIONS
2620 NLINE=0
2630 COMMENT=0
2640 PACKED=0
2650 UNPACKED=0
2660 BYTSRC=0
2670 PRINT #2, "1NOEXPAND"
2680 BYTOBJ=11
2690 PRINT
2700 PRINT "I AM NOW PACKING LINE NUMBER :"
2710 PRINT
2720
2730
2740
2750 READ'UNPACKED'LINE:
2760 INPUT LINE #1, CODE$
2770 IF(EOF(1)=1) THEN GO TO FINISH
2780 NLINE=NLINE+1
2790 PACK=0
2800 BYTSRC=BYTSRC+LEN(CODE$)+2
2810 NCODE$=""
2820 L=LEN(CODE$)
2830
2840 STRIP'LINE'NUMBER:
2850 DIGIT$=LEFT$(CODE$,1)
2860 IF(DIGIT$ < "0" OR DIGIT$ > "9") THEN GO TO DISPLAY'LINE'NUMBER
2870 NCODE$=NCODE$+DIGIT$
2880 CODE$=RIGHT$(CODE$,L-1)
2890 L=L-1
2900 GO TO STRIP'LINE'NUMBER
2910
2920 DISPLAY'LINE'NUMBER:
2930 PRINT USING "######", VAL(NCODE$);
2940 IF(NLINE/10=INT(NLINE/10)) THEN PRINT " #"; NLINE
2950
2960 STRIP'LEADING'BLANKS:
2970
2980 REM ...... CHECK FOR A BLANK LINE (ONLY A LINE NUMBER)
2990 IF(L > 0) THEN GO TO NON'EMPTY'LINE
3000 IF(DELETE'EMPTY$="Y") THEN COMMENT=COMMENT+1 : GO TO READ'UNPACKED'LINE
3010 NCODE$=NCODE$+" "
3020 GO TO WRITE'PACKED'LINE
3030
3040 NON'EMPTY'LINE:
3050 FIRST$=LEFT$(CODE$,1)
3060 IF(FIRST$ <> " ") THEN GO TO BEGIN'MAIN'TEXT
3070 CODE$=RIGHT$(CODE$,L-1)
3080 PACK=1
3090 L=L-1
3100 GO TO STRIP'LEADING'BLANKS
3110
3120
3130
3140 BEGIN'MAIN'TEXT:
3150
3160 REM ...... CHECK FOR A REMARK LINE ("REM" OR "!")
3170 IF(INSTR(1,CODE$,"REM")<>1 AND INSTR(1,CODE$,"!")<>1)THEN GO TO P'CHECK
3180 IF(DELETE'REMS$="Y") THEN COMMENT=COMMENT+1 : GO TO READ'UNPACKED'LINE
3190 NCODE$=NCODE$+" "
3200 GO TO WRITE'PACKED'LINE
3210
3220 P'CHECK:
3230 IF(INSTR(1,CODE$,"PRINT") <> 1) THEN GO TO DATA'CHECK
3240 IF(INSTR(1,CODE$,"PRINT'") = 1) THEN GO TO DATA'CHECK
3250 NCODE$=NCODE$+"?"
3260 L=L-5
3270 CODE$=RIGHT$(CODE$,L)
3280 PACK=1
3290 GO TO REST'OF'TEXT'LOOP
3300
3310 DATA'CHECK:
3320 IF(INSTR(1,CODE$,"DATA") <> 1) THEN GO TO REST'OF'TEXT'LOOP
3330 NCODE$=NCODE$+CODE$
3340 GO TO WRITE'PACKED'LINE
3350
3360
3370
3380 REST'OF'TEXT'LOOP:
3390
3400 REM ...... CHECK FOR DOUBLE QUOTE
3410 IF(INSTR(1,CODE$,CHR(34)) <> 1) THEN GO TO EMPTY'CHECK
3420 NCODE$=NCODE$+CHR(34) : L=L-1 : CODE$=RIGHT$(CODE$,L)
3430 REM ...... TRANSFER ALL CHARACTERS UP TO NEXT (CLOSED) DOUBLE QUOTE
3440 M=INSTR(1,CODE$,CHR(34))
3450 IF(M=0) THEN NCODE$=NCODE$+CODE$ : GO TO WRITE'PACKED'LINE
3460 NCODE$=NCODE$+CODE$[1,M]
3470 L=L-M
3480 CODE$=RIGHT$(CODE$,L)
3490
3500 EMPTY'CHECK:
3510 IF(L=0) THEN GO TO WRITE'PACKED'LINE
3520
3530 REM ...... CHECK FOR INTERNAL REMARKS ("REM" OR "!")
3540 IF(INSTR(1,CODE$,"REM")=1) THEN GO TO WRITE'PACKED'LINE
3550 FIRST$=LEFT$(CODE$,1)
3560 IF(FIRST$="!") THEN GO TO WRITE'PACKED'LINE
3570
3580 REM ...... CHECK FOR BLANK
3590 IF(FIRST$ <> " ") THEN GO TO TRANSFER'NEXT'CHARACTER
3600
3610 REM ...... CHECK FOR INTERNAL "PRINT" STATEMENT
3620 IF(INSTR(1,CODE$," PRINT") <> 1) THEN GO TO RESERVED'WORD'CHECK
3630 IF(INSTR(1,CODE$," PRINT'")=1) THEN GO TO RESERVED'WORD'CHECK
3640 NCODE$=NCODE$+"?"
3650 L=L-6
3660 CODE$=RIGHT$(CODE$,L)
3670 PACK=1
3680 GO TO REST'OF'TEXT'LOOP
3690
3700 RESERVED'WORD'CHECK:
3710 IF(INSTR(1,CODE$," ELSE")=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3720 IF(INSTR(1,CODE$," TO" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3730 IF(INSTR(1,CODE$," STEP")=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3740 IF(INSTR(1,CODE$," AND" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3750 IF(INSTR(1,CODE$," OR" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3760 IF(INSTR(1,CODE$," MAX" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3770 IF(INSTR(1,CODE$," MIN" )=1) THEN GO TO TRANSFER'NEXT'CHARACTER
3780 PACK=1 : GO TO STRIP'NEXT'CHARACTER
3790
3800 TRANSFER'NEXT'CHARACTER:
3810 NCODE$=NCODE$+FIRST$
3820
3830 STRIP'NEXT'CHARACTER:
3840 L=L-1
3850 CODE$=RIGHT$(CODE$,L)
3860 GO TO REST'OF'TEXT'LOOP
3870
3880 WRITE'PACKED'LINE:
3890 PRINT #2, NCODE$
3900 BYTOBJ=BYTOBJ+2+LEN(NCODE$)
3910 IF(PACK=0) THEN UNPACKED=UNPACKED+1 ELSE PACKED=PACKED+1
3920 GO TO READ'UNPACKED'LINE
3930
3940 FINISH:
3950 CLOSE #1
3960 CLOSE #2
3970 PRINT
3980 PRINT
3990 PRINT "END OF PACKING ------"
4000 PRINT " FILE "; INFNAME$; " HAS"; BYTSRC; "BYTES IN"; NLINE; "LINES"
4010 PRINT " FILE "; OUTFNAME$; " HAS"; BYTOBJ; "BYTES IN";
4020 PRINT NLINE-COMMENT; "LINES";
4030 PRINT " ("; (1-BYTOBJ/BYTSRC)*100; "% SIZE REDUCTION )"
4040 PRINT " (="; PACKED; "LINES PACKED +"; UNPACKED; "LINES UNCHANGED)"
4050 PRINT
4060
4070
4080
4090 REM ...... END
4100 END
