1 files changed, 187 insertions, 0 deletions
diff --git a/app/baisy/2.2.1-schulis/src/dir.dos b/app/baisy/2.2.1-schulis/src/dir.dos
new file mode 100644
index 0000000..fd348a1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dir.dos
@@ -0,0 +1,187 @@
+PACKET dirDEFINES opendir,insertdirentry,deletedirentry,initdirds,fileinfo,
+formatdir,dirlist,fileexists,subdirexists,allfiles,allsubdirs:LET 
+maxdirentrys=1000;INITFLAG VAR dirblockdsused:=FALSE ;DATASPACE VAR 
+dirblockds;BOUND STRUCT (ALIGN dummy,ROW 64REAL daten)VAR dirblock;REAL VAR 
+lastreaddirblockno;PROC initdirblockio:lastreaddirblockno:=-1.0;IF NOT 
+initialized(dirblockdsused)THEN dirblockds:=nilspace;dirblock:=dirblockdsFI .
+END PROC initdirblockio;PROC readdirblock(REAL CONST blocknr):IF 
+lastreaddirblockno<>blocknrTHEN lastreaddirblockno:=-1.0;
+readdiskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknrFI .END PROC readdirblock;PROC writedirblock(REAL CONST blocknr):
+writediskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknr.END PROC writedirblock;PROC writedirblock:IF lastreaddirblockno<0.0
+THEN errorstop("Lesefehler")FI ;writedirblock(lastreaddirblockno)END PROC 
+writedirblock;PROC getdirentry(TEXT VAR entrybuffer,INT CONST blockentryno):
+entrybuffer:=32*".";INT CONST replaceoffset:=4*blockentryno;replace(
+entrybuffer,1,dirblock.daten[replaceoffset+1]);replace(entrybuffer,2,dirblock
+.daten[replaceoffset+2]);replace(entrybuffer,3,dirblock.daten[replaceoffset+3
+]);replace(entrybuffer,4,dirblock.daten[replaceoffset+4]).END PROC 
+getdirentry;PROC putdirentry(TEXT CONST entrybuffer,INT CONST blockentryno):
+INT CONST offset:=4*blockentryno;dirblock.daten[offset+1]:=entrybufferRSUB 1;
+dirblock.daten[offset+2]:=entrybufferRSUB 2;dirblock.daten[offset+3]:=
+entrybufferRSUB 3;dirblock.daten[offset+4]:=entrybufferRSUB 4.END PROC 
+putdirentry;LET DIRPOS =REAL ;DIRPOS PROC dirpos(REAL CONST blocknr,INT 
+CONST entrynr):blocknr*16.0+real(entrynr).END PROC dirpos;REAL PROC blockno(
+DIRPOS CONST p):floor(p/16.0)END PROC blockno;INT PROC entryno(DIRPOS CONST p
+):int(pMOD 16.0)END PROC entryno;PROC incr(DIRPOS VAR p):pINCR 1.0.END PROC 
+incr;LET FREELIST =STRUCT (ROW maxdirentrysDIRPOS stack,INT stacktop,DIRPOS 
+beginoffreearea,endofdir,REAL dirroot);PROC initfreelist(FREELIST VAR flist,
+REAL CONST root):flist.stacktop:=0;flist.beginoffreearea:=dirpos(9.0e99,0);
+flist.endofdir:=dirpos(-1.0,0);flist.dirroot:=root.END PROC initfreelist;
+PROC store(FREELIST VAR flist,DIRPOS CONST freepos):flist.stacktopINCR 1;
+flist.stack[flist.stacktop]:=freepos.END PROC store;PROC storebeginoffreearea
+(FREELIST VAR flist,DIRPOS CONST begin):flist.beginoffreearea:=beginEND PROC 
+storebeginoffreearea;PROC storeendofdir(FREELIST VAR flist,DIRPOS CONST end):
+flist.endofdir:=endEND PROC storeendofdir;DIRPOS PROC freedirpos(FREELIST 
+VAR flist):enablestop;DIRPOS VAR result;IF flist.stacktop>0THEN popELIF NOT 
+freeareaemptyTHEN firstoffreeareaELIF expansionallowededTHEN 
+allocatenewdircluster;result:=freedirpos(flist)ELSE errorstop(
+"Directory voll")FI ;result.pop:result:=flist.stack[flist.stacktop];flist.
+stacktopDECR 1.freeareaempty:flist.beginoffreearea>flist.endofdir.
+firstoffreearea:result:=flist.beginoffreearea;incr(flist.beginoffreearea).
+expansionalloweded:flist.dirroot>=2.0.allocatenewdircluster:REAL CONST 
+newdircluster:=availablefatentry;REAL VAR lastentryno;
+searchlastentrynooffatchain;fatentry(newdircluster,lastfatchainentry);
+fatentry(lastentryno,newdircluster);writefat;storebeginoffreearea(flist,
+dirpos(firstnewblock,0));storeendofdir(flist,dirpos(lastnewblock,15));
+initnewdircluster.searchlastentrynooffatchain:lastentryno:=flist.dirroot;
+WHILE NOT islastfatchainentry(fatentry(lastentryno))REP lastentryno:=fatentry
+(lastentryno)PER .firstnewblock:beginofcluster(newdircluster).lastnewblock:
+beginofcluster(newdircluster)+real(sectorspercluster-1).initnewdircluster:
+TEXT CONST emptydirentry:=32*"�";INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(
+emptydirentry,i)PER ;disablestop;REAL VAR blockno:=firstnewblock;WHILE 
+blockno<=lastnewblockREP writedirblock(blockno)PER .END PROC freedirpos;LET 
+FILEENTRY =STRUCT (TEXT dateandtime,REAL size,firstcluster,DIRPOS dirpos),
+FILELIST =STRUCT (THESAURUS thes,ROW maxdirentrysFILEENTRY entry);PROC 
+initfilelist(FILELIST VAR flist):flist.thes:=emptythesaurus.END PROC 
+initfilelist;PROC storefileentry(FILELIST VAR flist,TEXT CONST entrytext,
+DIRPOS CONST position):INT VAR entryindex;insert(flist.thes,filename,
+entryindex);storefileentry(flist.entry[entryindex],entrytext,position).
+filename:TEXT CONST namepre:=compress(subtext(entrytext,1,8)),namepost:=
+compress(subtext(entrytext,9,11));IF namepost<>""THEN namepre+"."+namepost
+ELSE namepreFI .END PROC storefileentry;PROC storefileentry(FILEENTRY VAR 
+fentry,TEXT CONST entrytext,DIRPOS CONST position):fentry.firstcluster:=real(
+entrytextISUB 14);fentry.dateandtime:=dosdate+"  "+dostime;fentry.size:=dint(
+entrytextISUB 15,entrytextISUB 16);fentry.dirpos:=position.dosdate:day+"."+
+month+"."+year.day:text2(code(entrytextSUB 25)MOD 32).month:text2(code(
+entrytextSUB 25)DIV 32+8*(code(entrytextSUB 26)MOD 2)).year:text(80+code(
+entrytextSUB 26)DIV 2,2).dostime:hour+":"+minute.hour:text2(code(entrytext
+SUB 24)DIV 8).minute:text2(code(entrytextSUB 23)DIV 32+8*(code(entrytextSUB 
+24)MOD 8)).END PROC storefileentry;TEXT PROC text2(INT CONST intvalue):IF 
+intvalue<10THEN "0"+text(intvalue)ELSE text(intvalue)FI .END PROC text2;
+DIRPOS PROC fileentrypos(FILELIST CONST flist,TEXT CONST filename):INT CONST 
+linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;flist.entry[linkindex].dirpos.
+END PROC fileentrypos;PROC delete(FILELIST VAR flist,TEXT CONST filename):
+INT VAR dummy;delete(flist.thes,filename,dummy).END PROC delete;PROC fileinfo
+(FILELIST CONST flist,TEXT CONST filename,REAL VAR firstclusterno,storage):
+INT CONST linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;firstclusterno:=flist.entry[
+linkindex].firstcluster;storage:=flist.entry[linkindex].sizeEND PROC fileinfo
+;BOOL PROC contains(FILELIST VAR flist,TEXT CONST filename):flist.thes
+CONTAINS filenameEND PROC contains;PROC list(FILE VAR f,FILELIST CONST flist)
+:INT VAR index:=0;TEXT VAR name;get(flist.thes,name,index);WHILE index>0REP 
+listfile;get(flist.thes,name,index)PER .listfile:write(f,centeredname);write(
+f,"  ");write(f,text(flist.entry[index].size,11,0));write(f,
+" Bytes belegt      ");write(f,flist.entry[index].dateandtime);write(f,
+"  +++  ");write(f,text(flist.entry[index].firstcluster));line(f).
+centeredname:INT VAR pointpos:=pos(name,".");IF pointpos>0THEN namepre+"."+
+namepostELSE text(name,12)FI .namepre:text(subtext(name,1,pointpos-1),8).
+namepost:text(subtext(name,pointpos+1,pointpos+4),3).END PROC list;LET 
+DIRENTRY =REAL ,DIRLIST =STRUCT (THESAURUS thes,ROW maxdirentrysDIRENTRY 
+entry);PROC initdirlist(DIRLIST VAR dlist):dlist.thes:=emptythesaurus.END 
+PROC initdirlist;PROC storesubdirentry(DIRLIST VAR dlist,TEXT CONST entrytext
+):INT VAR entryindex;insert(dlist.thes,subdirname,entryindex);dlist.entry[
+entryindex]:=real(entrytextISUB 14).subdirname:TEXT CONST namepre:=compress(
+subtext(entrytext,1,8)),namepost:=compress(subtext(entrytext,9,11));IF 
+namepost<>""THEN namepre+"."+namepostELSE namepreFI .END PROC 
+storesubdirentry;REAL PROC firstclusterofsubdir(DIRLIST CONST dlist,TEXT 
+CONST name):INT CONST linkindex:=link(dlist.thes,name);IF linkindex=0THEN 
+errorstop("Das Unterverzeichnis """+name+""" gibt es nicht")FI ;dlist.entry[
+linkindex].END PROC firstclusterofsubdir;BOOL PROC contains(DIRLIST CONST 
+dlist,TEXT CONST subdirname):dlist.thesCONTAINS subdirnameEND PROC contains;
+PROC list(FILE VAR f,DIRLIST CONST dlist):INT VAR index:=0;TEXT VAR name;get(
+dlist.thes,name,index);WHILE index>0REP listdir;get(dlist.thes,name,index)
+PER .listdir:write(f,centeredname);write(f,"   <DIR>");write(f,"  +++  ");
+write(f,text(dlist.entry[index]));line(f).centeredname:INT VAR pointpos:=pos(
+name,".");IF pointpos>0THEN namepre+"."+namepostELSE text(name,12)FI .namepre
+:text(subtext(name,1,pointpos-1),8).namepost:text(subtext(name,pointpos+1,
+pointpos+4),3).END PROC list;LET DIR =BOUND STRUCT (FILELIST filelist,
+DIRLIST dirlist,FREELIST freelist,TEXT path);DIR VAR dir;DATASPACE VAR dirds;
+INITFLAG VAR dirdsused:=FALSE ;PROC opendir(TEXT CONST pathstring):
+initdirblockio;initdirds;dir.path:=pathstring;loadmaindir;TEXT VAR restpath:=
+pathstring;WHILE restpath<>""REP TEXT CONST subdirname:=nextsubdirname(
+restpath);loadsubdirPER .loadmaindir:initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,0.0);storeendofdir(dir.freelist,dirpos
+(lastmaindirsector,15));BOOL VAR waslastdirsector:=FALSE ;REAL VAR blockno:=
+firstmaindirsector;INT VAR i;FOR iFROM 1UPTO dirsectorsREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+firstmaindirsector:real(beginofdir).lastmaindirsector:real(beginofdir+
+dirsectors-1).loadsubdir:REAL VAR clusterno:=firstclusterofsubdir(dir.dirlist
+,subdirname);waslastdirsector:=FALSE ;initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,clusterno);WHILE NOT 
+islastfatchainentry(clusterno)REP loadsubdirentrysofcluster;clusterno:=
+fatentry(clusterno)UNTIL waslastdirsectorPER .loadsubdirentrysofcluster:
+storeendofdir(dir.freelist,dirpos(lastblocknoofcluster,15));blockno:=
+beginofcluster(clusterno);FOR iFROM 1UPTO sectorsperclusterREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+lastblocknoofcluster:beginofcluster(clusterno)+real(sectorspercluster-1).END 
+PROC opendir;PROC loaddirblock(REAL CONST blockno,BOOL VAR waslastblock):
+waslastblock:=FALSE ;readdirblock(blockno);INT VAR entryno;TEXT VAR entry;
+FOR entrynoFROM 0UPTO 15REP getdirentry(entry,entryno);processentryUNTIL 
+waslastblockPER .processentry:SELECT pos("�.�",entrySUB 1)OF CASE 1:
+endofdirsearchCASE 2:CASE 3:freeentryOTHERWISE 
+volumelabelorfileentryorsubdirentryEND SELECT .endofdirsearch:waslastblock:=
+TRUE ;storebeginoffreearea(dir.freelist,dirpos(blockno,entryno)).freeentry:
+store(dir.freelist,dirpos(blockno,entryno)).
+volumelabelorfileentryorsubdirentry:INT CONST byte11:=code(entrySUB 12);IF (
+byte11AND 8)>0THEN ELIF (byte11AND 16)>0THEN subdirentryELSE fileentryFI .
+subdirentry:storesubdirentry(dir.dirlist,entry).fileentry:storefileentry(dir.
+filelist,entry,dirpos(blockno,entryno)).END PROC loaddirblock;TEXT PROC 
+nextsubdirname(TEXT VAR pathstring):TEXT VAR subdirname;IF (pathstringSUB 1)
+<>"\"THEN errorstop("ungültige Pfadbezeichnung")FI ;INT CONST backslashpos:=
+pos(pathstring,"\",2);IF backslashpos=0THEN subdirname:=subtext(pathstring,2)
+;pathstring:=""ELSE subdirname:=subtext(pathstring,2,backslashpos-1);
+pathstring:=subtext(pathstring,backslashpos)FI ;dosname(subdirname,readmodus)
+.END PROC nextsubdirname;PROC initdirds:IF initialized(dirdsused)THEN forget(
+dirds)FI ;dirds:=nilspace;dir:=dirds.END PROC initdirds;PROC insertdirentry(
+TEXT CONST name,REAL CONST startcluster,storage):DIRPOS CONST inspos:=
+freedirpos(dir.freelist);TEXT CONST entrystring:=entryname+" "+(10*"�")+
+dostime+dosdate+entrystartcluster+entrystorage;writeentryondisk;
+writeentryindirds.entryname:INT CONST pointpos:=pos(name,".");IF pointpos>0
+THEN subtext(name,1,pointpos-1)+(9-pointpos)*" "+subtext(name,pointpos+1)+(3-
+LENGTH name+pointpos)*" "ELSE name+(11-LENGTH name)*" "FI .dostime:TEXT 
+CONST akttime:=timeofday(clock(1));code((minuteMOD 8)*32)+code(8*hour+minute
+DIV 8).hour:int(subtext(akttime,1,2)).minute:int(subtext(akttime,4,5)).
+dosdate:TEXT CONST aktdate:=date(clock(1));code(32*(monthMOD 8)+day)+code((
+year-80)*2+monthDIV 8).day:int(subtext(aktdate,1,2)).month:int(subtext(
+aktdate,4,5)).year:int(subtext(aktdate,7,8)).entrystartcluster:TEXT VAR 
+buffer2:="12";replace(buffer2,1,lowword(startcluster));buffer2.entrystorage:
+TEXT VAR buffer4:="1234";replace(buffer4,1,lowword(storage));replace(buffer4,
+2,highword(storage));buffer4.writeentryondisk:readdirblock(blockno(inspos));
+putdirentry(entrystring,entryno(inspos));writedirblock.writeentryindirds:
+storefileentry(dir.filelist,entrystring,inspos).END PROC insertdirentry;PROC 
+deletedirentry(TEXT CONST name):TEXT VAR entry;DIRPOS CONST delpos:=
+fileentrypos(dir.filelist,name);readdirblock(blockno(delpos));getdirentry(
+entry,entryno(delpos));putdirentry("�"+subtext(entry,2,32),entryno(delpos));
+writedirblock;delete(dir.filelist,name);store(dir.freelist,delpos).END PROC 
+deletedirentry;PROC formatdir:initdirblockio;initdirds;buildemptydirblock;
+REAL VAR blockno:=real(beginofdir);disablestop;FOR iFROM 1UPTO dirsectorsREP 
+writedirblock(blockno);blocknoINCR 1.0PER ;enablestop;dir.path:="";
+initfilelist(dir.filelist);initdirlist(dir.dirlist);initfreelist(dir.freelist
+,0.0);storebeginoffreearea(dir.freelist,dirpos(real(beginofdir),0));
+storeendofdir(dir.freelist,dirpos(lastmaindirsector,15)).buildemptydirblock:
+INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(32*"�",i)PER .lastmaindirsector:
+real(beginofdir+dirsectors-1).END PROC formatdir;PROC fileinfo(TEXT CONST 
+filename,REAL VAR startcluster,size):fileinfo(dir.filelist,filename,
+startcluster,size)END PROC fileinfo;THESAURUS PROC allfiles:THESAURUS VAR t:=
+dir.filelist.thes;tEND PROC allfiles;THESAURUS PROC allsubdirs:dir.dirlist.
+thesEND PROC allsubdirs;BOOL PROC fileexists(TEXT CONST filename):contains(
+dir.filelist,filename)END PROC fileexists;BOOL PROC subdirexists(TEXT CONST 
+subdirname):contains(dir.dirlist,subdirname)END PROC subdirexists;PROC 
+dirlist(DATASPACE VAR ds):openlistfile;headline(listfile,listfilehead);list(
+listfile,dir.filelist);list(listfile,dir.dirlist).openlistfile:forget(ds);ds
+:=nilspace;FILE VAR listfile:=sequentialfile(output,ds);putline(listfile,"").
+listfilehead:"DOS"+pathstring.pathstring:IF dir.path<>""THEN "     PATH: "+
+dir.pathELSE ""FI .END PROC dirlist;END PACKET dir;
+