(*$S+*) (*$V-*) PROGRAM puffin; CONST maxunit =12; (* maximum number for a pascal unit *) maxdir =105; (* maximum number of entries in a DOS diskette directory *) maxlink =122; (* maximum number of entries in a track sector list *) didleng =30; (* maximum length of a DOS file name *) pidleng =23; (* maximum length of a Pascal file name *) sidleng = 5; (* maximum length of a Pascal file name suffix, e.g. ".TEXT" *) sectsize =256; (* size of a DOS sector *) blocksize=512; pagesize =1024; (* size of a pascal text page *) maxbyte =255; dirtrack =17; (* track number where a DOS directory resides *) firstdirsect=15; (* first sector of a DOS directory *) TYPE byterange =0..maxbyte; sectrange =0..sectsize; dirrange =0..maxdir; linkrange =0..maxlink; unitrange =0..maxunit; blockrange=0..blocksize; pagerange =0..pagesize; sectbuffer =PACKED ARRAY[byterange] OF byterange; blockbuffer=PACKED ARRAY[1..blocksize] OF byterange; pagebuffer =PACKED ARRAY[1..pagesize] OF byterange; link=PACKED RECORD (* used to designate track/sector combinations *) tracknum:byterange; sectnum:byterange; END; tslist=(* track sector list *) RECORD continuation:link; list:PACKED ARRAY[1..maxlink] OF link; END; did=STRING[didleng]; pid=STRING[pidleng]; sid=STRING[sidleng]; dosfilekinds= (* DOS file types *) (volinfo,unknown,dftext,dfinteger,applesoft,binary); pasfilekinds= (* some of the Pascal file types *) (textfile,fotofile,untyped); (* Pascal format for the information contained in a DOS directory entry *) dosdirentry=PACKED RECORD CASE dfkind:dosfilekinds OF volinfo: (* this is volume info *) (dunitnum:unitrange; dnumentries:dirrange); unknown, dftext, dfinteger, applesoft, binary: (file_tsl:link; (* location of file's track-sector list*) locked:BOOLEAN; (* designates whether file is locked *) name:did; sectorcount:byterange); (* number of diskette sectors allocated *) END; dosdirectory=ARRAY[dirrange] OF dosdirentry; VAR dosdir:dosdirectory; (* current working DOS directory *) unitnum:unitrange; ioerror:INTEGER; ch:CHAR; FUNCTION readtrksec(unitnum:unitrange; trksec:link;VAR sb:sectbuffer;VAR ioerror:INTEGER):BOOLEAN; (* reads sector number 'trksec.sectnum' from tracknumber 'trksec.tracknum' on disk drive nunber 'unitnum' *) VAR block:blockbuffer; blocknum,offset:INTEGER; BEGIN WITH trksec DO BEGIN (* compute half-block corresponding to desired sector *) IF (sectnum IN [0,15]) THEN blocknum:=sectnum ELSE blocknum:=15-sectnum; IF (odd(blocknum)) THEN offset:=256 ELSE offset:=0; (* now compte blocknum off set from track 0 *) blocknum:=(blocknum DIV 2)+8*tracknum; END; (* WITH trksec DO *) (*$I-*) unitread(unitnum,block,sizeof(block),blocknum); (*$I+*) ioerror:=ioresult; IF NOT (ioerror=0) THEN readtrksec:=FALSE ELSE BEGIN (* write into sector buffer *) moveleft(block[offset+1],sb,sizeof(sectbuffer)); readtrksec:=TRUE; END; (* IF...THEN...ELSE *) END; FUNCTION writetrksec(unitnum:unitrange; trksec:link;VAR sb:sectbuffer;VAR ioerror:INTEGER):BOOLEAN; VAR blocknum,offset:INTEGER; block:blockbuffer; BEGIN (* see comments for 'readtrksec' *) WITH trksec DO BEGIN (* compute half-block corresponding to desired sector *) IF (sectnum IN [0,15]) THEN blocknum:=sectnum ELSE blocknum:=15-sectnum; IF (odd(blocknum)) THEN offset:=256 ELSE offset:=0; (* now compte blocknum off set from track 0 *) blocknum:=(blocknum DIV 2)+8*tracknum; END; (* WITH trksec DO *) (*$I-*) unitread(unitnum,block,sizeof(block),blocknum); (*$I+*) ioerror:=ioresult; IF NOT (ioerror=0) THEN writetrksec:=FALSE ELSE BEGIN moveleft(sb,block[offset+1],sizeof(sectbuffer)); (*$I-*) unitwrite(unitnum,block,sizeof(block)); (*$I+*) ioerror:=ioresult; writetrksec:=ioerror=0; END; END; FUNCTION searchdir(target:did;VAR index:dirrange):BOOLEAN; VAR found:BOOLEAN; BEGIN found:=FALSE; index:=dosdir[0].dnumentries; WHILE NOT (found OR (index=0)) DO BEGIN found:=target=dosdir[index].name; index:=index-1; END; IF found THEN index:=index+1; searchdir:=found; END; FUNCTION stoi:INTEGER; VAR ch:CHAR; x:INTEGER; BEGIN x:=0; read(ch); WHILE ch IN ['0'..'9'] DO BEGIN x:=10*x+(ord(ch)-ord('0')); read(ch); END; writeln; stoi:=x; END; FUNCTION get_unit_num(VAR unitnum:unitrange):BOOLEAN; VAR un:INTEGER; BEGIN REPEAT writeln; writeln('Enter the unitnum number [4,5,9..12] of the disk drive containing'); writeln('the DOS diskette to be cataloged. Enter 0 to escape.'); writeln; write('>> '); un:=stoi; IF NOT (un IN [0,4,5,9..12]) THEN writeln(chr(7)); UNTIL un IN [0,4,5,9..12]; unitnum:=un; get_unit_num:=(un<>0); END; PROCEDURE capitalize(VAR line:STRING); CONST ordsmla=97; ordsmlz=122; shiftcase=32; VAR index:0..maxbyte; BEGIN FOR index:=1 TO length(line) DO IF line[index] IN [chr(ordsmla)..chr(ordsmlz)] THEN line[index]:=chr(ord(line[index])-shiftcase); END; FUNCTION getpasid(VAR name:pid):BOOLEAN; BEGIN writeln; writeln('Enter the name of the Pascal destination file,'); writeln('or enter <RET> to exit:'); writeln; write('>>'); readln(name); IF (length(name)=0) THEN getpasid:=FALSE ELSE BEGIN capitalize(name); getpasid:=TRUE; END; END; FUNCTION getdosid(VAR name:did):BOOLEAN; BEGIN writeln; writeln('Enter the name of the DOS file to transfer,'); writeln('or enter <RET> to exit:'); writeln; write('>>'); readln(name); IF (length(name)=0) THEN getdosid:=FALSE ELSE BEGIN capitalize(name); getdosid:=TRUE; END; END; PROCEDURE getfiletype(VAR suffix:sid;VAR filetype:pasfilekinds); BEGIN writeln; writeln('Transfer to a:'); writeln; writeln('T)ext file, F)oto file, or D)ata (binary) file?'); writeln; write('>> '); read(keyboard,ch); WHILE NOT (ch IN ['t','f','d','T','F','D']) DO BEGIN write(chr(7));read(keyboard,ch); END; writeln(ch); CASE ch OF 'T','t':BEGIN suffix:='.TEXT';filetype:=textfile; END; 'F','f':BEGIN suffix:='.FOTO';filetype:=fotofile; END; 'D','d':BEGIN suffix:='';filetype:=untyped; END; END; END; PROCEDURE printmenu; CONST cleoln=29; BEGIN gotoxy(0,0); write(chr(cleoln),'C)atalog, D)isplay, T)ransfer, Q)uit?'); END; PROCEDURE readcommand(VAR ch:CHAR); BEGIN read(keyboard,ch); WHILE NOT(ch IN ['C','c','D','d','T','t','Q','q']) DO BEGIN write(chr(7)); read(keyboard,ch); END; writeln; END; PROCEDURE displayentry(de:dosdirentry); BEGIN WITH de DO BEGIN write(name,' ':(didleng-length(name)+1)); CASE dfkind OF dftext:write('text':6); dfinteger:write('int':6); applesoft:write('soft':6); binary:write('bnry':6); unknown:write('unkn':6); END; IF locked THEN write('yes':8) ELSE write('no':8); write(sectorcount:9); writeln(filetsl.tracknum:6,'-',filetsl.sectnum:3); END; END; PROCEDURE displayheader; BEGIN write('File Name'); write('Type':((didleng-length('file name'))+7)); write('Locked':8); write('Sectors':9); writeln('TSL link':10); END; PROCEDURE displaydir; CONST cleos=11; esc=27; maxlines=21; VAR cumsectors:INTEGER; count:dirrange; BEGIN page(output); gotoxy(0,1); cumsectors:=0; IF dosdir[0].dnumentries=0 THEN writeln('The working directory is empty!') ELSE BEGIN displayheader; FOR count:=1 TO dosdir[0].dnumentries DO BEGIN displayentry(dosdir[count]); cumsectors:=cumsectors+dosdir[count].sectorcount; IF (count MOD maxlines)=0 THEN BEGIN write('Type <RET> to continue, <ESC> to stop '); read(keyboard,ch); IF ch=chr(esc) THEN exit(displaydir) ELSE BEGIN gotoxy(0,2);write(chr(cleos)); END; END; END; write(dosdir[0].dnumentries,' files on disk, ',cumsectors,' sectors in use'); END; END; PROCEDURE catalog; CONST nextlink = 1; (* relative byte 1 of directory sector is link to next directory sector *) zerobase =11; (* first byte of file info in a directory sector *) entrylength=35; (* DOS directory entries occupy 35 bytes *) mark =maxbyte; (* directory entries which have been deleted are 'marked' in (relative) byte zero *) maxindex = 7; (* maximum of 7 directory entries in a sector *) space= 32; (* ASCII space *) tilde=126; (* ASCII tilde *) TYPE indexrange=0..maxindex; entrybuffer=PACKED ARRAY[1..entrylength] OF byterange; VAR sectorindex:indexrange; entrybase:byterange; dir_link:link; dir_sector:sectbuffer; nextentry:entrybuffer; entrycount:dirrange; FUNCTION eodir(dirlink:link):BOOLEAN; BEGIN WITH dirlink DO eodir:=(sectnum=0) AND (tracknum=0); END; PROCEDURE fill_dir_entry(VAR de:dosdirentry;VAR eb:entrybuffer); CONST linkoffset = 1; (* relative byte zero for an entry gives the location of its track-sector list *) kindoffset = 3; (* relative byte 2 designates the file type of the entry *) nameoffset = 4; (* relative byte 3 is the beginning of the file name *) countoffset=34; (* relative byte 33 is the sector count (MOD sectsize) for the file *) lockbit =128; (* locked files have the high bit of the file type byte set *) VAR j,kind:byterange; nonblank:0..didleng; BEGIN WITH de DO BEGIN filetsl.tracknum:=eb[linkoffset]; filetsl.sectnum:=eb[linkoffset+1]; kind:=eb[kindoffset]; IF NOT ((kind MOD lockbit) IN [0,1,2,4]) THEN dfkin...
y4r05l4v