💾 Archived View for mirrors.apple2.org.za › archive › ground.icaen.uiowa.edu › Srcs › puffin.txt captured on 2024-06-16 at 14:27:58.
⬅️ Previous capture (2023-01-29)
-=-=-=-=-=-=-
(*$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 dfkind:=unknown
ELSE CASE (kind MOD lockbit) OF
0:dfkind:=dftext;
1:dfkind:=dfinteger;
2:dfkind:=applesoft;
4:dfkind:=binary;
END;
IF ((kind DIV lockbit)=1) THEN locked:=TRUE
ELSE locked:=FALSE;
FOR j:=0 TO (didleng-1) DO
BEGIN
(* set the high bit low to get true ASCII *)
eb[nameoffset+j]:=eb[nameoffset+j] MOD 128;
(* eliminate any weird characters *)
IF NOT (eb[nameoffset+j] IN [space..tilde]) THEN eb[nameoffset+j]:=space;
END;
(* find the leftmost trailing blank in the name field *)
nonblank:=-scan(-didleng,<>' ',eb[nameoffset+didleng-1]);
(* non_blank=0 if and only if no trailing blanks *)
(* initialize the length of 'name' *)
(*$R-*)
name[0]:=chr(didleng-nonblank);
(*$R+*)
(* finally move in the name *)
moveleft(eb[nameoffset],name[1],length(name));
sectorcount:=eb[countoffset];
END; (* WITH de DO *)
END; (* filldirentry *)
FUNCTION eodirsector(VAR index:indexrange;
VAR dirsector:sectbuffer;VAR entrybase:byterange):BOOLEAN;
VAR
nofile:BOOLEAN;
BEGIN
nofile:=TRUE;
WHILE (nofile AND (index<maxindex)) DO
BEGIN
index:=index+1;
entrybase:=zerobase+(index-1)*entrylength;
nofile:=(dirsector[entrybase] IN [0,mark]);
END;
eodirsector:=nofile;
END;
BEGIN (* catalog *)
page(output);
IF NOT getunitnum(unitnum) THEN exit(catalog);
WITH dir_link DO
BEGIN
tracknum:=dirtrack;
sectnum:=firstdirsect;
END;
entrycount:=0;
WHILE NOT eodir(dir_link) DO
BEGIN
IF NOT readtrksec(unitnum,dir_link,dir_sector,ioerror)
THEN BEGIN writeln('ioerror ',ioerror,' reading directory');
exit(catalog);
END
ELSE BEGIN
sectorindex:=0;
WHILE NOT eodirsector(sectorindex,dir_sector,entrybase) DO
BEGIN
moveleft(dir_sector[entrybase],nextentry,entrylength);
entrycount:=entrycount+1;
filldirentry(dosdir[entrycount],nextentry);
END;
END; (*IF...THEN...ELSE *)
WITH dir_link DO
BEGIN
tracknum:=dir_sector[nextlink];
sectnum:=dir_sector[nextlink+1];
END;
END;
WITH dosdir[0] DO
BEGIN
dnumentries:=entrycount;
dunitnum:=unitnum;
END;
displaydir;
END; (* catalog *)
(*$I DPTH2.1:TRANSFER.TEXT*)
PROCEDURE transfer;
TYPE
ffile=FILE;
VAR
dosname :did;
pasname :pid;
suffix :sid;
dirindex :dirrange;
linkindex :linkrange;
nextlink,
nextnode :link;
nextsector :sectbuffer;
currentnode:tslist;
ioerror :INTEGER;
pasfile :ffile;
primpage,
sparepage :pagebuffer;
pagepntr,
sparepntr :pagerange;
relblock :INTEGER;
filetype :pasfilekinds;
fotoflag :BOOLEAN; (* flag for shifts of size 'binaryoffset' *)
PROCEDURE abortxfer(ioerror:INTEGER);
BEGIN
writeln;
writeln('IO ERROR ',ioerror);
writeln('EXITING TRANSFER');
(*$I-*)
close(pasfile,purge);
(*$I+*)
exit(transfer);
END;
FUNCTION openfile(name:pid;VAR f:ffile;VAR ioerror:INTEGER):BOOLEAN;
BEGIN
(*$I-*)
rewrite(f,name);
ioerror:=ioresult;
(*$I+*)
openfile:=ioerror=0;
END;
FUNCTION eolist(next:link):BOOLEAN;
BEGIN
WITH next DO
eolist:=((tracknum=0) AND (sectnum=0));
END;
FUNCTION get_node(location:link;VAR listdata:tslist):BOOLEAN;
CONST
contoffset= 1; (* beginning of continuation link *)
contleng = 2; (* length of continuation info *)
listoffset= 12; (* beginning of list of track sector links *)
listleng =244; (* length of list data *)
VAR
sb:sectbuffer;
i:linkrange;
BEGIN
IF NOT (readtrksec(dosdir[0].dunitnum,location,sb,ioerror)) THEN get_node:=FALSE
ELSE WITH listdata DO
BEGIN
continuation.tracknum:=sb[contoffset];
continuation.sectnum:=sb[contoffset+1];
FOR i:=1 TO maxlink DO
BEGIN
list[i].tracknum:=sb[listoffset+(i-1)*contleng];
list[i].sectnum:=sb[listoffset+(i-1)*contleng+1];
END;
get_node:=TRUE;
END;
END;
FUNCTION eonode(VAR linkindex:linkrange;VAR tslink:link):BOOLEAN;
VAR
emptysector:BOOLEAN;
BEGIN
emptysector:=TRUE;
WHILE ((linkindex<maxlink) AND emptysector) DO
BEGIN
linkindex:=linkindex+1;
WITH currentnode.list[linkindex] DO
emptysector:=(tracknum=0) AND (sectnum=0)
END;
IF NOT emptysector THEN tslink:=currentnode.list[linkindex];
eonode:=emptysector;
END;
PROCEDURE writeblocks(VAR pb:pagebuffer;pbpntr:pagerange;
blockcount:INTEGER;VAR relblock:INTEGER);
BEGIN
(******* note: pbpntr should be divisible by blocksize upon entry *)
(*$I-*)
pbpntr:=pbpntr-(blockcount*blocksize)+1;
IF (blockwrite(pasfile,pb[pbpntr],blockcount,relblock)=blockcount)
THEN relblock:=relblock+blockcount
(*$I+*)
ELSE abortxfer(ioerror);
END;
PROCEDURE stuff(VAR s:sectbuffer;VAR p:pagebuffer;
VAR pagepntr:pagerange;filetype:pasfilekinds);
PROCEDURE stufftext;
CONST
hibit=128;
asciicr=13; (* ASCII carriage return *)
space=32; (* ASCII space *)
tilde=126; (* ASCII tilde *)
VAR
lengindex,nextnull:sectrange;
leadindex,lagindex:pagerange;
cr,null:CHAR;
primfull,endofspare:BOOLEAN;
BEGIN
(* zero the high bits to get true ASCII *)
FOR lengindex:=0 TO maxbyte DO
BEGIN
(* zero the high bit of s[lengindex] *)
s[lengindex]:=s[lengindex] MOD hibit;
(* eliminate weird characters by setting to null *)
IF NOT (s[lengindex] IN [space..tilde,asciicr]) THEN s[lengindex]:=0;
END;
(* squeeze out the middle null characters *)
null:=chr(0);
lengindex:=sectsize;
nextnull:=scan(lengindex,=null,s);
WHILE (nextnull<lengindex) DO
BEGIN
moveleft(s[nextnull+1],s[nextnull],lengindex-nextnull-1);
lengindex:=lengindex-1;
nextnull:=scan(lengindex,=null,s);
END;
moveleft(s,sparepage[sparepntr+1],lengindex);
sparepntr:=sparepntr+lengindex;
endofspare:=FALSE;
primfull:=FALSE;
lagindex:=0;
cr:=chr(asciicr);
WHILE NOT (endofspare OR primfull) DO BEGIN
leadindex:=scan((sparepntr-lagindex),=cr,sparepage[lagindex+1]);
IF (leadindex=(sparepntr-lagindex)) THEN endofspare:=TRUE
ELSE IF ((leadindex+pagepntr+1) > pagesize) THEN primfull:=TRUE
ELSE BEGIN
moveleft(sparepage[lagindex+1],primpage[pagepntr+1],leadindex+1);
pagepntr:=pagepntr+leadindex+1;
lagindex:=lagindex+leadindex+1;
endofspare:=(lagindex=sparepntr);
END;
END;
IF primfull THEN pagepntr:=pagesize;
moveleft(sparepage[lagindex+1],sparepage,sparepntr-lagindex);
sparepntr:=sparepntr-lagindex;
END;(* stufftext *)
PROCEDURE stuffoto;
CONST
fotoffset=4; (* four bytes of DOS address junk in the first sector *)
BEGIN
IF fotoflag (* first foto sector *)
THEN BEGIN
moveleft(s[fotoffset],primpage,sectsize-fotoffset);
pagepntr:=sectsize-fotoffset;
fotoflag:=FALSE;
END
ELSE BEGIN
moveleft(sparepage,primpage[pagepntr+1],sparepntr);
pagepntr:=sparepntr+pagepntr;
sparepntr:=0;
IF ((pagepntr+sectsize) <= pagesize) (* i.e., enough room for a sector *)
THEN BEGIN
moveleft(s,primpage[pagepntr+1],sectsize);
pagepntr:=pagepntr+sectsize;
END
ELSE BEGIN
(* move as much as possible into the primary page *)
moveleft(s,primpage[pagepntr+1],pagesize-pagepntr);
(* move the rest into the spare page *)
(* begin by updating sparepntr *)
sparepntr:=sectsize-(pagesize-pagepntr);
moveleft(s[pagesize-pagepntr],sparepage,sparepntr);
(* update pagepntr to end of page *)
pagepntr:=pagesize;
END;
END;
END;
BEGIN
IF (filetype=textfile) THEN stufftext
ELSE IF (filetype=fotofile) THEN stuffoto
ELSE BEGIN
moveleft(s,p[pagepntr+1],sectsize);
pagepntr:=pagepntr+sectsize;
END;
END;
BEGIN
page(output);
IF NOT (getdosid(dosname)) THEN exit(transfer);
WHILE NOT (searchdir(dosname,dirindex)) DO
BEGIN
writeln;
writeln(dosname,' not in current dosdir');
IF NOT (getdosid(dosname)) THEN exit(transfer);
END;
writeln;
displayheader;
displayentry(dosdir[dirindex]);
nextnode:=dosdir[dirindex].file_tsl;
getfiletype(suffix,filetype);
IF NOT (getpasid(pasname)) THEN exit(transfer);
WHILE NOT (openfile(concat(pasname,suffix),pasfile,ioerror)) DO
BEGIN
writeln;
writeln('IO error ',ioerror,' opening ',concat(pasname,suffix));
IF NOT (getpasid(pasname)) THEN exit(transfer);
END;
(* initalize the page buffers and associated pointers *)
fillchar(primpage,pagesize,chr(0));
fillchar(sparepage,pagesize,chr(0));
pagepntr:=0;
sparepntr:=0;
relblock:=0;
IF (filetype=fotofile) THEN fotoflag:=TRUE
ELSE IF (filetype=textfile) THEN
(* write two header blocks of nulls *)
BEGIN
relblock:=blockwrite(pasfile,primpage,1,relblock)+relblock;
relblock:=blockwrite(pasfile,primpage,1,relblock)+relblock;
END;
WHILE NOT eolist(nextnode) DO
IF NOT (get_node(nextnode,currentnode)) THEN abortxfer(ioerror)
ELSE BEGIN
linkindex:=0;
WHILE NOT eonode(linkindex,nextlink) DO
IF NOT (readtrksec(dosdir[0].dunitnum,nextlink,nextsector,ioerror))
THEN abortxfer(ioerror)
ELSE BEGIN
stuff(nextsector,primpage,pagepntr,filetype);
IF (pagepntr=pagesize) THEN
BEGIN
writeblocks(primpage,pagepntr,2,relblock);
pagepntr:=0;
fillchar(primpage,pagesize,chr(0));
END;
END;
nextnode:=currentnode.continuation;
END;
(* pick up anything in the spare page *)
moveleft(sparepage,primpage[pagepntr+1],sparepntr);
pagepntr:=pagepntr+sparepntr;
(* if page is partially full it needs to be written *)
IF (pagepntr>0) THEN (* note: pagepntr<pagesize will be true here *)
BEGIN
pagepntr:=blocksize*(1+(pagepntr DIV blocksize));
writeblocks(primpage,pagepntr,(pagepntr DIV blocksize),relblock);
END;
IF ((filetype=textfile) AND odd(relblock)) THEN
BEGIN
fillchar(primpage,pagesize,chr(0));
relblock:=blockwrite(pasfile,primpage,1,relblock)+relblock;
END;
writeln;
writeln(dosname,' transferred to ',concat(pasname,suffix));
writeln(relblock,' blocks transferred');
close(pasfile,lock);
END;
BEGIN
WITH dosdir[0] DO
BEGIN dfkind:=volinfo; dnumentries:=0; dunitnum:=0; END;
page(output);
gotoxy(0,5);
writeln('Welcome to PUFFIN!');
REPEAT
printmenu;
readcommand(ch);
CASE ch OF
'c','C':catalog;
'd','D':displaydir;
't','T':transfer;
END;
UNTIL ch IN ['Q','q'];
END.