5 REM "D:BINSTNBI.BAS
10 REM VERSION 1.4
100 GOSUB 32100
200 DIM LOC$(1),FILENAME$(15),FILENAM2$(15),VAR$(31),T$(117),A$(9),H$(16),F$(15)
300 PRINT CHR$(125)
400 ? "This program will take a binary program from memory or disk and write"
500 ? "it to disk as data statements in a listed BASIC file."
600 ? "Is the ML in memory or on disk"
700 ? "disk M or D";:INPUT LOC$
800 IF LOC$(1,1)="M" THEN GOTO 1100
900 IF LOC$(1,1)="D" THEN GOTO 3800
1000 STOP 
1100 ? "What is the starting location in DEC";:INPUT START
1200 ? "What is the ending location in DEC":INPUT DEN
1300 GOSUB 3400
1400 NUMBYT=DEN-START+1:IF NUMBYT<1 THEN STOP 
1500 OPEN #3,8,0,"FILENAME$"
1600 TRAP 3200
1700 LINLEN=79:MPT=0:REM TOTAL # OF BYTES
1800 REM POIN IS # OF BYTES IN LINE
1900 REM assemble line ---------------------------------------------------
2000 T$=""
2100 T$=STR$(LINE):T$(LEN(T$)+1)=" ":T$(LEN(T$)+1)=VAR$:T$(LEN(T$)+1)="= ":T$(LEN(T$),LEN(T$))=CHR$(34)
2200 POIN=LEN(T$)+1
2300 REM one byte loop
2400 T$(POIN)=CHR$(PEEK(START+MPT))
2500 MPT=MPT+1:POIN=POIN+1
2600 IF MPT>DEN THEN T$(POIN)=CHR$(155):GOTO 3100
2700 IF POIN=LINLEN+1 THEN T$(POIN)=CHR$(155):LINE=LINE+INT:GOTO 2900
2800 GOTO 2400:REM next byte
2900 PRINT #3;T$
3000 GOTO 2000:REM next line
3100 PRINT #3;T$
3200 CLOSE #3:PRINT "error - ";PEEK(195)
3300 END 
3400 ? "ENTER STARTING LINE NUMBER AND INTERVAL SEPERATED BY A COMMA":INPUT LINE,INT
3500 ? "Enter the name of the string variable (including the $)":INPUT VAR$
3600 ? "Enter the filename you wish to write to (include Dx:)":INPUT FILENAME$
3700 RETURN 
3800 GOSUB 3400
3900 ? "Enter the filename you wish to read from (include Dx:)":INPUT FILENAM2$
3950 F$=FILENAM2$:FOR J=1 TO 3:IF F$(1,1)<>":" THEN F$=F$(2):NEXT J
3951 F$=F$(2)
4000 ? CHR$(125):POSITION 2,5
4050 TRAP 5900
4100 OPEN #3,8,0,FILENAME$
4200 OPEN #1,4,0,FILENAM2$
4400 GET #1,A:IF A<>255 THEN ? "not a binary file":GOTO 9100
4500 GET #1,A:IF A<>255 THEN ? "not a binary file":GOTO 9100
4600 GOTO 5500
4700 REM ADDR SUB ---------------------       
4800 FOR J=1 TO 2:GET #1,A:U1=A:GET #1,A:U1=U1+A*256
4900 IF J=1 THEN UMLP=U1:? :? "Segment start  $";:N=U1:GOSUB 9630:? A$
5000 IF J=2 THEN UEND=U1:? "Segment end    $";:N=U1:GOSUB 9630:? A$
5100 NEXT J
5200 ? "Segment length  ";UEND-UMLP+1;" bytes"
5300 RETURN 
5400 REM ------------------------------                                       
5500 MPT=0:TRAP 6000:GOSUB 4800
5700 MP2=USR(ADR(COUNT$),UMLP,UEND):MPT=MPT+MP2:IF PEEK(195)<>0 THEN GOSUB 6000
5800 GOSUB 4800:GOTO 5700
5900 CLOSE #1:CLOSE #3:? "ERROR ";PEEK(195);" AT ";PEEK(186)+256*PEEK(187):STOP 
6000 IF PEEK(195)<>136 THEN 8600
6100 PRINT MPT;" BYTES":CLOSE #1:OPEN #1,4,0,FILENAM2$
6200 REM 
6300 TRAP 8600
6400 GET #1,A:GET #1,A:REM get rid of 2 header bytes in file
6500 UMLP=2:UEND=1:REM Make sure line 6000 gosubs
6600 LINLEN=79
6700 REM POIN IS # OF BYTES IN LINE
6800 REM assemble line ---------------------------------------------------
6900 T$="":T$=STR$(LINE):T$(LEN(T$)+1)=" DIM ":T$(LEN(T$)+1)=VAR$:T$(LEN(T$)+1)="(":T$(LEN(T$)+1)=STR$(MPT)
7000 T$(LEN(T$)+1)="):REM ":T$(LEN(T$)+1)=F$:? T$:? #3;T$:LINE=LINE+INT
7100 V=0:Q=0:RT=0
7200 T$=""
7300 T$=STR$(LINE):T$(LEN(T$)+1)=" ":T$(LEN(T$)+1)=VAR$:T$(LEN(T$)+1)="(":T$(LEN(T$)+1)=STR$(V+1)
7400 T$(LEN(T$)+1)=")= ":T$(LEN(T$),LEN(T$))=CHR$(34)
7500 POIN=LEN(T$)+1
7600 REM one byte loop
7700 IF UMLP>UEND THEN GOSUB 4800
7800 GET #1,A:UMLP=UMLP+1
7900 IF  NOT (A=34 OR A=155) THEN T$(POIN)=CHR$(A)
7910 AA=A:IF AA>122 OR AA<32 THEN AA=35
7920 ? CHR$(AA);
7940 V=V+1
7950 IF A=34 OR A=155 THEN GOSUB 10000
7960 IF A=34 OR A=155 THEN GOTO 7200
8000 POIN=POIN+1
8200 IF POIN=LINLEN+1 THEN GOSUB 9300:LINE=LINE+INT:GOTO 8400
8300 GOTO 7700:REM next byte
8400 PRINT #3;T$
8500 GOTO 7200:REM next line
8600 IF PEEK(195)<>136 THEN ? :? "ERR=";PEEK(195);" IN LINE ";PEEK(186)+256*PEEK(187):STOP 
8700 GOSUB 9300
8800 ? :? :? 
8900 PRINT #3;T$
9000 ? :? :? :? Q;" Quotation marks":? RT;" Return characters"
9100 PRINT "error - ";PEEK(195);:IF PEEK(195)=136 THEN ? "  EOF No Error"
9200 END 
9290 REM End Line Subroutine
9300 T$(POIN)=CHR$(34):T$(POIN+1)=CHR$(155)
9400 RETURN 
9600 REM DEC TO HEX SUBROUTINE
9610 REM N IS DEC IN
9620 REM A$ IS HEX OUT
9630 JJ=9
9640 A$="         "
9650 H$="0123456789ABCDEF"
9660 R=(N/16-INT(N/16))*16
9670 A$(JJ,JJ)=H$(R+1):REM Rest of H$ should fall off
9680 N=INT(N/16)
9690 JJ=JJ-1
9700 IF N>=1 THEN 9660
9710 REM ADJUST A$
9720 FOR JJ=1 TO 9
9730 IF A$(1,1)=" " THEN A$=A$(2)
9740 NEXT JJ
9750 IF (LEN(A$))/2=INT((LEN(A$))/2+1.0E-03) THEN 9780
9760 H$(1)="0":H$(2)=A$:A$=H$
9780 REM *** END ADJUST
9800 RETURN 
9900 REM QUOTE AND RETURN SUBROUTINE
10000 IF A=34 THEN Q=Q+1
10010 IF A=155 THEN RT=RT+1
10100 REM END LINE
10200 GOSUB 9300
10300 PRINT #3;T$
10400 REM NEW LINE
10500 LINE=LINE+INT
10600 T$=""
10700 T$=STR$(LINE)
10800 T$(LEN(T$)+1)=" "
10900 T$(LEN(T$)+1)=VAR$
10910 T$(LEN(T$)+1)="(LEN("
10920 T$(LEN(T$)+1)=VAR$
10930 T$(LEN(T$)+1)=")+1)=CHR$("
11000 T$(LEN(T$)+1)=STR$(A)
11100 T$(LEN(T$)+1)=")"
11200 PRINT #3;T$
11300 LINE=LINE+INT
11500 RETURN 
32100 DIM COUNT$(65)
32101 COUNT$(1)="hhhhh ԩ բ V0 "
32102 COUNT$(63)="`"
32103 RETURN 
