From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/baisy/2.2.1-schulis/src/get put interface.dos | 103 ++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/src/get put interface.dos (limited to 'app/baisy/2.2.1-schulis/src/get put interface.dos') diff --git a/app/baisy/2.2.1-schulis/src/get put interface.dos b/app/baisy/2.2.1-schulis/src/get put interface.dos new file mode 100644 index 0000000..1e80856 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/get put interface.dos @@ -0,0 +1,103 @@ +PACKET dosgetputDEFINES logmodus,opendosdisk,closedosdisk,accessdosdisk, +openfetchdosfile,closefetchdosfile,catnextfetchdoscluster, +readnextfetchdoscluster,waslastfetchcluster,opensavedosfile, +writenextsavedoscluster,closesavedosfile,erasedosfile,alldosfiles, +alldossubdirs,dosfileexists,doslist,cleardosdisk,formatdosdisk:BOOL VAR +logflag:=FALSE ;PROC logmodus(BOOL CONST status):logflag:=statusEND PROC +logmodus;LET maxclustersize=8192,realspersector=64;LET CLUSTER =BOUND STRUCT +(ALIGN dummy,ROW maxclustersizeREAL clusterrow);CLUSTER VAR cluster; +DATASPACE VAR clusterds;INITFLAG VAR clusterdsused:=FALSE ;TEXT VAR +convertbuffer;INT VAR convertbufferlength;PROC initclusterhandle:IF +initialized(clusterdsused)THEN forget(clusterds)FI ;clusterds:=nilspace; +cluster:=clusterds;convertbuffer:="";convertbufferlength:=0.END PROC +initclusterhandle;PROC catclustertext(REAL CONST clusterno,TEXT VAR +destination,INT CONST to):readdiskcluster(clusterds,2,clusterno); +initconvertbuffer;INT VAR i;FOR iFROM 1UPTO sectorspercluster*realspersector +REP replace(convertbuffer,i,cluster.clusterrow[i])PER ;destinationCAT subtext +(convertbuffer,1,to).initconvertbuffer:IF convertbufferlength5.0.diskchanged: +IF hdversionTHEN FALSE ELSE lastaccesstime:=clock(1);NOT firstfatblockokFI . +END PROC accessdosdisk;REAL VAR nextfetchcluster,fetchrest;PROC +openfetchdosfile(TEXT CONST filename):IF logflagTHEN dump( +"open fetch dos file",filename)FI ;enablestop;accessdosdisk;fileinfo(filename +,nextfetchcluster,fetchrest).END PROC openfetchdosfile;BOOL PROC +waslastfetchcluster:IF logflagTHEN dump("was last fetch cluster","")FI ; +islastfatchainentry(nextfetchcluster)OR fetchrest<=0.0.END PROC +waslastfetchcluster;PROC catnextfetchdoscluster(TEXT VAR buffer):IF logflag +THEN dump("cat next fetch dos cluster","")FI ;enablestop;IF +waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;IF fetchrest< +real(clustersize)THEN catclustertext(nextfetchcluster,buffer,int(fetchrest)); +fetchrest:=0.0ELSE catclustertext(nextfetchcluster,buffer,clustersize); +fetchrestDECR real(clustersize)FI ;lastaccesstime:=clock(1);nextfetchcluster +:=fatentry(nextfetchcluster).END PROC catnextfetchdoscluster;PROC +readnextfetchdoscluster(DATASPACE VAR readds,INT VAR startpage):IF logflag +THEN dump("read next fetch dos cluster",startpage)FI ;enablestop;IF +waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;readdiskcluster( +readds,startpage,nextfetchcluster);lastaccesstime:=clock(1);startpageINCR +sectorspercluster;nextfetchcluster:=fatentry(nextfetchcluster);IF fetchrest< +real(clustersize)THEN fetchrest:=0.0ELSE fetchrestDECR real(clustersize)FI . +END PROC readnextfetchdoscluster;PROC closefetchdosfile:IF logflagTHEN dump( +"close fetch dos file","")FI ;END PROC closefetchdosfile;TEXT VAR savename; +REAL VAR firstsavecluster,lastsavecluster,savesize;PROC opensavedosfile(TEXT +CONST filename):IF logflagTHEN dump("open save dos file",filename)FI ; +enablestop;accessdosdisk;IF fileexists(filename)OR subdirexists(filename) +THEN errorstop("die Datei """+filename+""" gibt es schon")FI ;savename:= +filename;firstsavecluster:=-1.0;savesize:=0.0.END PROC opensavedosfile;PROC +writenextsavedoscluster(TEXT CONST buffer):IF logflagTHEN dump( +"write next save dos cluster","")FI ;enablestop;REAL CONST savecluster:= +availablefatentry;writetexttocluster(savecluster,buffer);lastaccesstime:= +clock(1);savesizeINCR real(LENGTH buffer);IF firstsavecluster<2.0THEN +firstsavecluster:=saveclusterELSE fatentry(lastsavecluster,savecluster)FI ; +fatentry(savecluster,lastfatchainentry);lastsavecluster:=savecluster.END +PROC writenextsavedoscluster;PROC writenextsavedoscluster(DATASPACE CONST +saveds,INT VAR startpage):IF logflagTHEN dump("write next save dos cluster", +startpage)FI ;enablestop;REAL CONST savecluster:=availablefatentry; +writediskcluster(saveds,startpage,savecluster);lastaccesstime:=clock(1); +startpageINCR sectorspercluster;savesizeINCR real(clustersize);IF +firstsavecluster<2.0THEN firstsavecluster:=saveclusterELSE fatentry( +lastsavecluster,savecluster)FI ;fatentry(savecluster,lastfatchainentry); +lastsavecluster:=savecluster.END PROC writenextsavedoscluster;PROC +closesavedosfile:IF logflagTHEN dump("close save dos file","")FI ;enablestop; +IF firstsavecluster<2.0THEN LEAVE closesavedosfileFI ;fatentry( +lastsavecluster,lastfatchainentry);writefat;insertdirentry(savename, +firstsavecluster,savesize);lastaccesstime:=clock(1).END PROC closesavedosfile +;PROC erasedosfile(TEXT CONST filename):IF logflagTHEN dump("erase dos file", +filename)FI ;enablestop;accessdosdisk;REAL VAR firstcluster,size;fileinfo( +filename,firstcluster,size);deletedirentry(filename);erasefatchain( +firstcluster);writefat;lastaccesstime:=clock(1).END PROC erasedosfile; +THESAURUS PROC alldosfiles:IF logflagTHEN dump("all dosfile","")FI ; +enablestop;accessdosdisk;allfiles.END PROC alldosfiles;THESAURUS PROC +alldossubdirs:IF logflagTHEN dump("all subdirs","")FI ;enablestop; +accessdosdisk;allsubdirs.END PROC alldossubdirs;BOOL PROC dosfileexists(TEXT +CONST filename):IF logflagTHEN dump("dos file exists",filename)FI ;enablestop +;accessdosdisk;fileexists(filename).END PROC dosfileexists;PROC doslist( +DATASPACE VAR listds):IF logflagTHEN dump("dos list","")FI ;enablestop; +accessdosdisk;dirlist(listds).END PROC doslist;PROC cleardosdisk:IF logflag +THEN dump("clear dos disk","")FI ;enablestop;IF hdversionTHEN errorstop( +"nicht implementiert")ELSE accessdosdisk;formatdir;formatfat;lastaccesstime:= +clock(1)FI .END PROC cleardosdisk;PROC formatdosdisk(INT CONST formatcode): +IF logflagTHEN dump("format dos disk ("+text(formatcode)+")","")FI ; +enablestop;IF NOT diskopenTHEN errorstop("DOS-Arbeit nicht eröffnet")FI ;IF +hdversionTHEN errorstop("nicht implementiert")ELSE doformatFI .doformat:IF +bpbexists(formatcode)THEN closework;formatarchive(formatcode);openeudisk; +writebpb(formatcode);opendosdisk;formatdir;formatfat;openworkELSE errorstop( +"Format unzulässig")FI ;lastaccesstime:=clock(1).END PROC formatdosdisk;END +PACKET dosgetput; + -- cgit v1.2.3