aglover@acorn.co.uk (Alan Glover) (04/20/91)
Posting-number: Volume 01, Info 02
Submitted-by: Alan Glover <aglover@acorn.co.uk>
Archive-name: bootstrap/part02
This is the first of five postings which will culminate with you having a
usable copy of !Extract (a tool to extract multi part postings) and
!SubExtWrk (a working directory for !Extract and it's counterpart !Submit).
Save the data below under the name "Bark". When the need arises to run it
(as detailed in subsequent articles), the command to do so is *BASIC Bark
10REM>Bark
20REM This program will unpack Spark or arc style archives on the BBC
30REM and Archimedes. To produce an archive that can be unpacked using it
40REM you must set arc or Spark to not use squashing.
50REM Although you can use this on the Archie, a much better solution,
60REM is to use !SparkPlug. If you have an Archie, and would like to make
70REM your own archives and manipulate them in style from the desktop,
80REM you need a copy of Spark. This is obtainable for M-#5.99 from:
90REM David Pilling,
100REM P.O. Box 22,
110REM Thornton Cleveleys,
120REM Blackpool.
130REM FY5 1LR.
140REM
150REM You are encouraged to add your own bits to this program and pass it on.
160REM If you do modify it, add your name and details below.
170REM
180REM V0.00 20th September 1989 -- David Pilling
190REM V0.01 25th September 1989 -- Philip Colmer
200REM Changed BASIC V usage to BASIC II
210REM V0.02 21st February 1990 -- Philip Colmer
220REM Improved support for DFS
230REM
240REM
250REM
260REM
270:
280ON ERROR GOTO 310
290*CLOSE
300:
310PRINT"Bark V0.02 February 1990"
320INPUT"Enter name of file to decode:"N$
330:
340Y%=0:X%=OPENIN(N$)
350IFX%=0 PROCABEND("Can't open input file")
360:
370DIM FIX 4
380DIM suffix 4096
390DIM prefix1 4096
400DIM prefix2 4096
410DIM stack 4096
420DIM buf 128
430DIM stamp 18
440DIM name 256
450:
460DIM rmask 9
470rmask?0=0
480rmask?1=1
490rmask?2=3
500rmask?3=7
510rmask?4=15
520rmask?5=31
530rmask?6=63
540rmask?7=127
550rmask?8=255
560:
570R$=""
580level%=0
590DIM L%(32)
600L%(level%)=0
610over%=FALSE
620REPEAT
630PROCRDHDR
640IF earc% AND level%=0 CLOSE#X%:END
650IF over% CLOSE#X%:END
660IF isdir PROCDIR ELSEIF earc% PROCENDDIR ELSE PROCUNPACK
670UNTIL EOF#X% OR over%
680END
690:
700DEFPROCABEND(E$)
710PRINT"Bark has abended because:",E$
720IFX%<>0 CLOSE#X%
730IFY%<>0 CLOSE#Y%
740END
750ENDPROC
760:
770DEFFNword
780FIX?0=BGET#X%
790FIX?1=BGET#X%
800FIX?2=BGET#X%
810FIX?3=BGET#X%
820:=!FIX
830:
840DEFFNdble
850I%=BGET#X%
860I%=I%+&100*BGET#X%
870:=I%
880:
890DEFPROCRDHDR
900I%=BGET#X%
910IF I%<>26 PRINT"Bad Header in:"N$:REPEAT I%=BGET#X%:UNTIL I%=26 OR EOF#X%:IF EOF#X%:over%=TRUE:ENDPROC
920type%=BGET#X% AND &7F
930IF type%=0 earc%=TRUE:ENDPROC ELSE earc%=FALSE
940F$="":T%=TRUE
950FOR I%=1 TO 13
960J%=BGET#X%
970IF J%>32 AND T%:F$=F$+CHR$J% ELSE T%=FALSE
980NEXT
990clen%=FNword
1000date%=FNdble
1010time%=FNdble
1020crc%=FNdble
1030IF type%>1 olen%=FNword ELSE olen%=clen%
1040load%=FNword
1050exec%=FNword
1060attr%=FNword
1070IF type%=2 AND FNTYPE=&DDC isdir=TRUE ELSE isdir=FALSE
1080ENDPROC
1090:
1100DEFFNTYPE
1110IF((load% AND &FFF00000)=&FFF00000) :=(load% AND &FFF00)/256 ELSE :=-1
1120:
1130DEFPROCDIR
1140L%(level%)=LENR$
1150IF LENR$>0 R$=R$+F$ ELSE R$=F$
1160level%=level%+1
1170S$="CDIR "+R$
1180R$=R$+"."
1190PRINT"Creating directory",R$
1200REM filing systems which allow directories are ADFS (8) and Econet (5)
1210IFFNfs=8 ORFNfs=5 OSCLI(S$)
1220ENDPROC
1230:
1240DEFPROCENDDIR
1250level%=level%-1
1260R$=LEFT$(R$,L%(level%))
1270PRINT"Directory:",R$
1280ENDPROC
1290:
1300DEFPROCUNPACK
1310PRINT"Restoring file:",R$+F$
1320Y%=OPENOUT(R$+F$)
1330IF type%=1 OR type%=2 PROCUNSTORE ELSE IF type%=8 PROCUNCRUNCH ELSE IF type%=3 PROCUNPCK ELSE PROCABEND("Can't unpack "+F$)
1340CLOSE#Y%:Y%=0
1350PROCSTAMP
1360ENDPROC
1370:
1380DEFPROCUNSTORE
1390PRINT"Unstoring"
1400FOR I%=1 TO clen%
1410BPUT#Y%,BGET#X%
1420NEXT
1430ENDPROC
1440:
1450DEFPROCUNPCK
1460PRINT"Unpacking"
1470L%=0:C%=0
1480FOR I%=1 TO clen%
1490PROCputc_ncr(BGET#X%)
1500NEXT
1510ENDPROC
1520:
1530DEFFNMAXCODE(n)=2^n-1
1540:
1550DEFPROCputc_ncr(B%)
1560IF C%=1 ELSE 1580
1570IF B%=0:BPUT#Y%,&90:C%=0:ENDPROC ELSE FOR K%=2 TO B%:BPUT#Y%,L%:NEXT:C%=0:ENDPROC
1580IFB%=&90 C%=1:ENDPROC
1590L%=B%:BPUT#Y%,L%
1600ENDPROC
1610:
1620DEFPROCUNCRUNCH
1630PRINT"Uncrunching"
1640C%=0
1650offset=0:size=0:R%=clen%
1660code=FNGETC
1670IF code<>12 PROCABEND("File packed with illegal number of bits")
1680n_bits=9
1690clear_flg=0
1700maxcode=FNMAXCODE(n_bits)
1710FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT
1720FOR code=0 TO 255:suffix?code=code:NEXT
1730free_ent=257
1740oldcode=FNgetcode:finchar=oldcode
1750IF oldcode=-1 ENDPROC
1760PROCputc_ncr(finchar)
1770stackp=stack
1780code=FNgetcode
1790IF code<0 ENDPROC
1800IF code=256:FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT:clear_flg=1:free_ent=256:code=FNgetcode:IF code=-1 ENDPROC
1810incode = code
1820IF code>=free_ent ?stackp=finchar:stackp=stackp+1:code=oldcode
1830IF code>=256 ELSE 1870
1840?stackp=suffix?code:stackp=stackp+1
1850code=prefix1?code+256*prefix2?code
1860GOTO 1830
1870finchar=suffix?code:?stackp=finchar:stackp=stackp+1
1880REPEAT
1890stackp=stackp-1:PROCputc_ncr(?stackp)
1900UNTIL stackp=stack
1910code=free_ent
1920IF code < 4096 ELSE 1970
1930prefix1?code=oldcode
1940prefix2?code=oldcode/256
1950suffix?code=finchar
1960free_ent=code+1
1970oldcode=incode
1980GOTO 1780
1990ENDPROC
2000:
2010DEFFNGETC
2020IF R%>0 R%=R%-1:=BGET#X% ELSE :=-1
2030:
2040DEFFNgetcode
2050LOCAL code
2060bp=buf
2070IF clear_flg>0 OR offset>=size OR free_ent>maxcode ELSE 2180
2080IF free_ent > maxcode ELSE 2110
2090n_bits=n_bits+1
2100IF n_bits=12 maxcode = 4096 ELSE maxcode=FNMAXCODE(n_bits)
2110IF clear_flg>0 n_bits=9:maxcode=FNMAXCODE(n_bits):clear_flg=0
2120FOR size=0 TO n_bits-1
2130code=FNGETC
2140IF code=-1 temp=size:size=n_bits:NEXT ELSE buf?size=code:NEXT
2150IF size=n_bits+1:size=temp:IF size<=0:=-1
2160offset=0
2170size=(size*8)-(n_bits-1)
2180r_off=offset
2190bits=n_bits
2200bp=bp+r_off/8
2210r_off=r_off AND 7
2220code=(?bp/(2^r_off)):bp=bp+1
2230bits=bits-(8-r_off)
2240r_off=8-r_off
2250IF bits>=8 ELSE 2290
2260code=code OR (?bp*(2^r_off)):bp=bp+1
2270r_off=r_off+8
2280bits=bits-8
2290code=code OR ((?bp AND rmask?bits)*(2^r_off))
2300offset=offset+n_bits
2310:=code AND 4095
2320:
2330DEFPROCSTAMP
2340REM modified by Philip Colmer so that it doesn't try to do
2350REM SYS"OS_File"
2360LOCAL A%,X%,Y%
2370!stamp=name
2380stamp!2=load%
2390stamp!6=exec%
2400stamp!14=attr%
2410$name=R$+F$
2420A%=1:X%=stamp MOD256:Y%=stamp DIV256:CALL &FFDD
2430ENDPROC
2440:
2450DEFFNfs
2460A%=0:Y%=0
2470=USR&FFDA AND &FFaglover@acorn.co.uk (Alan Glover) (04/22/91)
Posting-number: Volume 01, Info 02
Submitted-by: Alan Glover <aglover@acorn.co.uk>
Archive-name: bootstrap/part02
** This is a reposting of this article due to bugs found - please discard
the earlier one (which has now been cancelled) and use this instead.
This is the second of five postings which will culminate with you having a
usable copy of !Extract (a tool to extract multi part postings) and
!SubExtWrk (a working directory for !Extract and it's counterpart !Submit).
Save the data below under the name "Bark". When the need arises to run it
(as detailed in subsequent articles), the command to do so is *BASIC Bark
--- CUT ---
10REM>Bark
20REM This program will unpack Spark or arc style archives on the BBC
30REM and Archimedes. To produce an archive that can be unpacked using it
40REM you must set arc or Spark to not use squashing.
50REM Although you can use this on the Archie, a much better solution,
60REM is to use !SparkPlug. If you have an Archie, and would like to make
70REM your own archives and manipulate them in style from the desktop,
80REM you need a copy of Spark. This is obtainable for M-#5.99 from:
90REM David Pilling,
100REM P.O. Box 22,
110REM Thornton Cleveleys,
120REM Blackpool.
130REM FY5 1LR.
140REM
150REM You are encouraged to add your own bits to this program and pass it on.
160REM If you do modify it, add your name and details below.
170REM
180REM V0.00 20th September 1989 -- David Pilling
190REM V0.01 25th September 1989 -- Philip Colmer
200REM Changed BASIC V usage to BASIC II
210REM V0.02 21st February 1990 -- Philip Colmer
220REM Improved support for DFS
230REM V0.03 22nd April 1991 -- Philip Colmer
240REM Fixed bugs in directory handling
250REM
260REM
270:
290*CLOSE
300:
310PRINT"Bark V0.03 April 1991"
320INPUT"Enter name of file to decode:"N$:IFN$="" END
330:
340Y%=0:X%=OPENIN(N$)
350IFX%=0 PROCABEND("Can't open input file")
360:
370DIM FIX 4
380DIM suffix 4096
390DIM prefix1 4096
400DIM prefix2 4096
410DIM stack 4096
420DIM buf 128
430DIM stamp 18
440DIM name 256
450:
460DIM rmask 9
470rmask?0=0
480rmask?1=1
490rmask?2=3
500rmask?3=7
510rmask?4=15
520rmask?5=31
530rmask?6=63
540rmask?7=127
550rmask?8=255
560:
570R$=""
580level%=0
590DIM L%(32)
600L%(level%)=0
610over%=FALSE
620REPEAT
630PROCRDHDR
640IF earc% AND level%=0 CLOSE#X%:END
650IF over% CLOSE#X%:END
660IF isdir PROCDIR ELSEIFearc% PROCENDDIR ELSE PROCUNPACK
670UNTIL EOF#X% OR over%
680END
690:
700DEFPROCABEND(E$)
710PRINT"Bark has abended because:",E$
720IFX%<>0 CLOSE#X%
730IFY%<>0 CLOSE#Y%
740END
750ENDPROC
760:
770DEFFNword
780FIX?0=BGET#X%
790FIX?1=BGET#X%
800FIX?2=BGET#X%
810FIX?3=BGET#X%
820:=!FIX
830:
840DEFFNdble
850I%=BGET#X%
860I%=I%+&100*BGET#X%
870:=I%
880:
890DEFPROCRDHDR
900I%=BGET#X%
910IF I%<>26 PRINT"Bad Header in:"N$:REPEAT I%=BGET#X%:UNTIL I%=26 OR EOF#X%:IF EOF#X%:over%=TRUE:ENDPROC
920type%=BGET#X% AND &7F
930IF type%=0 earc%=TRUE:isdir=FALSE:ENDPROC ELSE earc%=FALSE
940F$="":T%=TRUE
950FOR I%=1 TO 13
960J%=BGET#X%
970IF J%>32 AND T%:F$=F$+CHR$J% ELSE T%=FALSE
980NEXT
990clen%=FNword
1000date%=FNdble
1010time%=FNdble
1020crc%=FNdble
1030IF type%>1 olen%=FNword ELSE olen%=clen%
1040load%=FNword
1050exec%=FNword
1060attr%=FNword
1070IF type%=2 AND FNTYPE=&DDC isdir=TRUE ELSE isdir=FALSE
1080ENDPROC
1090:
1100DEFFNTYPE
1110IF((load% AND &FFF00000)=&FFF00000) :=(load% AND &FFF00)/256 ELSE :=-1
1120:
1130DEFPROCDIR
1140L%(level%)=LENR$
1150IF LENR$>0 R$=R$+F$ ELSE R$=F$
1160level%=level%+1
1170S$="CDIR "+R$
1180R$=R$+"."
1190PRINT"Creating directory",R$
1200REM filing systems which allow directories are
1201REM ADFS (8)
1202REM Econet (5)
1203REM SCSI (26)
1210IFFNfs=8 ORFNfs=5 OR FNfs=26 OSCLI(S$)
1220ENDPROC
1230:
1240DEFPROCENDDIR
1250level%=level%-1
1260R$=LEFT$(R$,L%(level%))
1270IFR$<>"" PRINT"Directory: ",R$
1280ENDPROC
1290:
1300DEFPROCUNPACK
1310PRINT"Restoring file:",R$+F$
1320Y%=OPENOUT(R$+F$)
1330IF type%=1 OR type%=2 PROCUNSTORE ELSE IF type%=8 PROCUNCRUNCH ELSE IF type%=3 PROCUNPCK ELSE PROCABEND("Can't unpack "+F$)
1340CLOSE#Y%:Y%=0
1350PROCSTAMP
1360ENDPROC
1370:
1380DEFPROCUNSTORE
1390PRINT"Unstoring"
1400FOR I%=1 TO clen%
1410BPUT#Y%,BGET#X%
1420NEXT
1430ENDPROC
1440:
1450DEFPROCUNPCK
1460PRINT"Unpacking"
1470L%=0:C%=0
1480FOR I%=1 TO clen%
1490PROCputc_ncr(BGET#X%)
1500NEXT
1510ENDPROC
1520:
1530DEFFNMAXCODE(n)=2^n-1
1540:
1550DEFPROCputc_ncr(B%)
1560IF C%=1 ELSE 1580
1570IF B%=0:BPUT#Y%,&90:C%=0:ENDPROC ELSE FOR K%=2 TO B%:BPUT#Y%,L%:NEXT:C%=0:ENDPROC
1580IFB%=&90 C%=1:ENDPROC
1590L%=B%:BPUT#Y%,L%
1600ENDPROC
1610:
1620DEFPROCUNCRUNCH
1630PRINT"Uncrunching"
1640C%=0
1650offset=0:size=0:R%=clen%
1660code=FNGETC
1670IF code<>12 PROCABEND("File packed with illegal number of bits")
1680n_bits=9
1690clear_flg=0
1700maxcode=FNMAXCODE(n_bits)
1710FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT
1720FOR code=0 TO 255:suffix?code=code:NEXT
1730free_ent=257
1740oldcode=FNgetcode:finchar=oldcode
1750IF oldcode=-1 ENDPROC
1760PROCputc_ncr(finchar)
1770stackp=stack
1780code=FNgetcode
1790IF code<0 ENDPROC
1800IF code=256:FOR I%=0 TO 256:prefix1?I%=0:prefix2?I%=0:NEXT:clear_flg=1:free_ent=256:code=FNgetcode:IF code=-1 ENDPROC
1810incode = code
1820IF code>=free_ent ?stackp=finchar:stackp=stackp+1:code=oldcode
1830IF code>=256 ELSE 1870
1840?stackp=suffix?code:stackp=stackp+1
1850code=prefix1?code+256*prefix2?code
1860GOTO 1830
1870finchar=suffix?code:?stackp=finchar:stackp=stackp+1
1880REPEAT
1890stackp=stackp-1:PROCputc_ncr(?stackp)
1900UNTIL stackp=stack
1910code=free_ent
1920IF code < 4096 ELSE 1970
1930prefix1?code=oldcode
1940prefix2?code=oldcode/256
1950suffix?code=finchar
1960free_ent=code+1
1970oldcode=incode
1980GOTO 1780
1990ENDPROC
2000:
2010DEFFNGETC
2020IF R%>0 R%=R%-1:=BGET#X% ELSE :=-1
2030:
2040DEFFNgetcode
2050LOCAL code
2060bp=buf
2070IF clear_flg>0 OR offset>=size OR free_ent>maxcode ELSE 2180
2080IF free_ent > maxcode ELSE 2110
2090n_bits=n_bits+1
2100IF n_bits=12 maxcode = 4096 ELSE maxcode=FNMAXCODE(n_bits)
2110IF clear_flg>0 n_bits=9:maxcode=FNMAXCODE(n_bits):clear_flg=0
2120FOR size=0 TO n_bits-1
2130code=FNGETC
2140IF code=-1 temp=size:size=n_bits:NEXT ELSE buf?size=code:NEXT
2150IF size=n_bits+1:size=temp:IF size<=0:=-1
2160offset=0
2170size=(size*8)-(n_bits-1)
2180r_off=offset
2190bits=n_bits
2200bp=bp+r_off/8
2210r_off=r_off AND 7
2220code=(?bp/(2^r_off)):bp=bp+1
2230bits=bits-(8-r_off)
2240r_off=8-r_off
2250IF bits>=8 ELSE 2290
2260code=code OR (?bp*(2^r_off)):bp=bp+1
2270r_off=r_off+8
2280bits=bits-8
2290code=code OR ((?bp AND rmask?bits)*(2^r_off))
2300offset=offset+n_bits
2310:=code AND 4095
2320:
2330DEFPROCSTAMP
2340REM modified by Philip Colmer so that it doesn't try to do
2350REM SYS"OS_File"
2360LOCAL A%,X%,Y%
2370!stamp=name
2380stamp!2=load%
2390stamp!6=exec%
2400stamp!14=attr%
2410$name=R$+F$
2420A%=1:X%=stamp MOD256:Y%=stamp DIV256:CALL &FFDD
2430ENDPROC
2440:
2450DEFFNfs
2460A%=0:Y%=0
2470=USR&FFDA AND &FF