|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 43776 (0xab00) Types: TextFile Names: »htfilsystem «
└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system └─⟦6a563b143⟧ └─ ⟦this⟧ »htfilsystem «
filsystem. :1: filsystem_parametre. \f message filparm side 1 - 800529/jg/cl; integer fil_op_længde, dbantez,dbantsz,dbanttz, dbmaxtf, dbmaxsf, dbblokt, dbmaxb,dbbidlængde,dbbidmax, dbmaxef; real dbsnavn, dbtnavn; :2: filsystem_initialisering af parametre. \f message filparminit side 1 - 801030/jg; fil_op_længde:= data + 18 <*halvord*>; dbantez:= 1; dbantsz:= 2; dbanttz:= 3; <* >=2 aht. samtidig tilgang*> dbblokt:= 8; dbmaxsf:= 7; dbbidlængde:= 3; dbbidmax:= 5; dbmaxb:= dbmaxsf * dbbidmax; dbmaxef:= 12; dbsnavn:=real<:spoolfil:>; dbtnavn:=real<:tabelfil:>; \f message filparminit side 2 - 801030/jg; <* reserver og check spoolfil og tabelfil *> begin integer s,i,funk,f; zone z(128,1,stderror); integer array tail(1:10); for f:=1,2 do begin open(z,4,string (case f of(dbsnavn,dbtnavn)),0); for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do begin s:=monitor(funk,z,i,tail); if s<>0 then system(9,funk*100+s, case f of(<:<10>spoolfil:>,<:<10>tabelfil:>)); end; case f of begin begin integer antseg; <*spoolfil*> antseg:=dbmaxb * dbbidlængde; if tail(1) < antseg then begin tail(1):=antseg; s:=monitor(44<*change*>,z,i,tail); if s<>0 then system(9,44*100+s,<:<10>spoolfil:>); end; end; begin <*tabelfil*> dbmaxtf:=tail(10); if dbmaxtf<1 or dbmaxtf>1023 then system(9,dbmaxtf,<:<10>tabelfil:>); end end case; close(z,false); end for; end; :3: filclaim \f message filclaim, side 1 - 810202/cl; maxcoru:= maxcoru+6; maxsem:= maxsem+2; maxsemch:= maxsemch+6; :4: filglobal. \f message filglobal side 1 - 790302/jg; integer dbantsf,dbkatsfri, dbantb,dbkatbfri, dbantef,dbkatefri, dbsidstesz,dbsidstetz, dbsegmax, filskrevet,fillæst; integer bs_kats_fri, bs_kate_fri, cs_opret_fil, cs_tilknyt_fil, cs_frigiv_fil, cs_slet_fil, cs_opret_spoolfil, cs_opret_eksternfil; integer array dbkatt(1:dbmaxtf,1:2), dbkats(1:dbmaxsf,1:2), dbkate(1:dbmaxef,1:6), dbkatz(1:dbantez+dbantsz+dbanttz,1:2); boolean array dbkatb(1:dbmaxb); zone array fil(dbantez+dbantsz+dbanttz,128,1,stderror); \f message hentfildim side 1 - 781120/jg; integer procedure hentfildim(fdim); integer array fdim; <*inddata filref i fdim(4),uddata fdim(1:8)*> begin integer ftype,fno,katf,i,s; ftype:=fdim(4) shift (-10); fno:=fdim(4) extract 10; if ftype>3 or ftype=0 or fno=0 then begin s:=1; goto udgang; end; if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then begin s:=1; goto udgang end; <*paramfejl*> katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1)); if katf extract 9 = 0 then begin s:=2; goto udgang end; <*tom indgang*> fdim(1):=katf shift (-9); <*post antal*> fdim(2):=katf extract 9; <*post længde*> fdim(3):=case ftype of( <*seg antal*> dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde, dbkate(fno,2) extract 18); for i:=5 step 1 until 8 do <*externt filnavn*> fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0; s:=0; udgang: hentfildim:=s; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>hentfildim::>,s,<: :>); <*zt*> <*tz*> pfdim(fdim); <*zt*> <*tz*> ud; <*zt*> <*tz*> end; <*zt*> <*-2*> end hentfildim; \f message sætfildim side 1 - 780916/jg; integer procedure sætfildim(fdim); integer array fdim; <*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*> begin integer ftype,fno,katf,s,pl; integer array gdim(1:8); gdim(4):=fdim(4); s:=hentfildim(gdim); if s>0 then goto udgang; fno:=fdim(4) extract 10; ftype:=fdim(4) shift (-10); pl:= fdim(2) extract 12; if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then begin s:=1; <*parameter fejl*> goto udgang end; if fdim(1)>256//pl*fdim(3) then begin s:=1; goto udgang; end; <*segant*> if ftype=3 then begin integer segant; segant:= fdim(3); if segant > dbsegmax then begin s:=4; <*ingen plads*> goto udgang end; \f message sætfildim side 2 - 780916/jg; if segant<>gdim(3) then begin integer i,z,s; array field enavn; integer array tail(1:10); z:=dbkate(fno,2) shift (-19); if z>0 then begin if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*> begin integer array zd(1:20); getzone6(fil(z),zd); if zd(13)>5 and zd(9)>=segant then begin <*dødt segment skal ikke udskrives*> zd(13):=5; setzone6(fil(z),zd) end end end; \f message sætfildim side 3 - 801031/jg; enavn:=8; <*ændr fil størrelse*> i:=1; open(zdummy,0,string gdim.enavn(increase(i)),0); s:=monitor(42,zdummy,0,tail); <*lookup*> if s>0 then fejlreaktion(1,s,<:lookup entry:>,0); tail(1):=segant; s:=monitor(44,zdummy,0,tail); <*change entry*> close(zdummy,false); if s<>0 then begin if s=6 then begin <*ingen plads*> s:=4; goto udgang end else fejlreaktion(1,s,<:change entry:>,0); end; dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18) add segant; \f message sætfildim side 4 - 801013/jg; end; fdim(3):=segant end else if fdim(3)>gdim(3) then begin s:=4; <*altid ingen plads*> goto udgang end else fdim(3):=gdim(3); <*samme længde*> <*postantal,postlængde*> katf:=fdim(1) shift 9 add pl; case ftype of begin dbkatt(fno,1):=katf; dbkats(fno,1):=katf; dbkate(fno,1):=katf end; udgang: sætfildim:=s; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin integer i; <*zt*> <*tz*> write(out,<:<10>sætfildim::>,s,<: :>); <*zt*> <*tz*> for i:=1 step 1 until 3 do gdim(i):=fdim(i); <*zt*> <*tz*> pfdim(gdim); <*zt*> <*tz*> ud; <*zt*> <*tz*> end; <*zt*> <*-2*> end sætfildim; \f message findfilenavn side 1 - 780916/jg; integer procedure findfilenavn(navn); real array navn; begin integer fno; array field enavn; for fno:=1 step 1 until dbmaxef do if dbkate(fno,1) extract 9>0 then <*optaget indgang*> begin enavn:=fno*12+4; if navn(1)=dbkate.enavn(1) and navn(2)=dbkate.enavn(2) then begin findfilenavn:=fno; goto udgang end end; findfilenavn:=0; udgang: end findfilenavn; \f message læsfil side 1 - 781120/jg; integer procedure læsfil(filref,postindex,zoneno); value filref,postindex; integer filref,postindex,zoneno; <*+2*> <*tz*> begin integer i,o,s; <*zt*> <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*> <*-2*> læsfil:=tilgangfil(filref,postindex,zoneno,5); <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>læsfil::>,s,filref,postindex,zoneno, <*zt*> <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*> <*tz*> end; <*zt*> <*tz*> end procedure; <*zt*> <*-2*> \f message skrivfil side 1 - 781120/jg; integer procedure skrivfil(filref,postindex,zoneno); value filref,postindex; integer filref,postindex,zoneno; <*+2*> <*tz*> begin integer i,o,s; <*zt*> <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*> <*-2*> skrivfil:=tilgangfil(filref,postindex,zoneno,6); <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*> <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*> <*tz*> end; <*zt*> <*tz*> end procedure; <*zt*> <*-2*> \f message modiffil side 1 - 781120/jg; integer procedure modiffil(filref,postindex,zoneno); value filref,postindex; integer filref,postindex,zoneno; <*+2*> <*tz*> begin integer i,o,s; <*zt*> <*tz*> i:=fillæst;o:=filskrevet; s:= <*zt*> <*-2*> modiffil:=tilgangfil(filref,postindex,zoneno,7); <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*> <*tz*> <: io::>,fillæst-i,filskrevet-o);ud; <*zt*> <*tz*> end; <*zt*> <*tz*> end procedure; <*zt*> <*-2*> \f message tilgangfil side 1 - 781003/jg; integer procedure tilgangfil(filref,postindex,zoneno,operation); value filref,postindex,operation; integer filref,postindex,zoneno,operation; <*proceduren kaldes fra læsfil,skrivfil og modiffil*> begin integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st; integer array zd(1:20),fdim(1:8); <*hent katalog*> fdim(4):=filref; st:=hentfildim(fdim); if st<>0 then goto udgang; <*parameter fejl eller fil findes ikke*> fno:=filref extract 10; ftype:=filref shift (-10); pl:=fdim(2); katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2)); \f message tilgangfil side 2 - 781003/jg; <*find segment adr og check postindex*> pps:=256//pl; <*poster pr segment*> seg:=(postindex-1)//pps; <*relativt segment*> pr:=(postindex-1) mod pps; <*post relativ til seg*> if postindex <1 then begin <*parameter fejl*> st:=1; goto udgang end; if seg>=fdim(3) then begin <*post findes ikke*> st:=3; goto udgang end; case ftype of begin <*find absolut segment*> <*tabelfil*> seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18); begin <*spoolfil*> integer i,bidno; bidno:=katf extract 12; for i:=seg//dbbidlængde step -1 until 1 do bidno:=dbkatb(bidno) extract 12; seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde end; <*extern fil,seg ok*> end case find abs seg; \f message tilgangfil side 3 - 801030/jg; <*alloker zone*> zno:=katf shift(-19); case ftype of begin begin <*tabelfil*> integer førstetz; førstetz:=dbkatz(dbsidstetz,2); if zno=0 then zno:=førstetz else if dbkatz(zno,1)<>filref then zno:=førstetz else if zno <> førstetz and zno <> dbsidstetz then begin integer z; for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do; dbkatz(z,2):=dbkatz(zno,2); dbkatz(zno,2):=førstetz; dbkatz(dbsidstetz,2):=zno; end; dbsidstetz:=zno end; \f message tilgangfil side 4 - 801030/jg; begin <*spoolfil*> integer p,zslut,z; if zno>0 then begin if dbkatz(zno,1) =filref then goto udgangs end; <*strategi 1*> p:=0; zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*> zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1; for z:=dbantez+dbantsz step -1 until zslut do begin integer zfref; zfref:=dbkatz(z,1); if zfref extract 10=0 then <*fri zone*> begin <*strategi 2*> zno:=z; goto udgangs end else if zfref shift (-10)=2 then begin <*zone tilknyttet spoolfil*> integer q; q:=dbkatz(z,2); <*prioritet*> if q>p then begin <*strategi 3*> p:=q; zno:=z end end; end z; udgangs: if zno> dbantez then dbsidstesz:=zno; end; \f message tilgangfil side 5 - 780916/jg; begin <*extern fil*> integer z; if zno=0 then zno:=1 else if dbkatz(zno,1) = filref then goto udgange; <*strategi 1*> for z:=1 step 1 until dbantez do begin integer zfref; zfref:=dbkatz(z,1); if zfref=0 then <*zone fri*> begin zno:=z; goto udgange end <*strategi 2*> else if zfref shift (-10) =2 then <*spoolfil*> zno:=z; <*strategi 3*> <*else strategi 4-5*> end z; udgange: end end case alloker zone; <*åbn zone*> if zno<=dbantez then begin <*extern zone;spool og tabel zoner altid åbne*> integer zfref; zfref:=dbkatz(zno,1); if zfref<>0 and zfref<>filref and ftype=3 then begin <*luk hvis ny extern fil*> getzone6(fil(zno),zd); if zd(13)>5 then filskrevet:=filskrevet+1; zfref:=0; close(fil(zno),false); end; if zfref=0 then begin <*åbn zone*> array field enavn; integer i; enavn:=4*2; i:=1; open(fil(zno),4,case ftype-1 of(string dbsnavn, string fdim.enavn(increase(i))),0) end end; \f message tilgangfil side 6 - 780916/jg; <*hent segment og sæt zone descriptor*> getzone6(fil(zno),zd); zstate:=zd(13); if zstate=0 or zd(9)<>seg then begin <*positioner*> if zstate>5 then filskrevet:=filskrevet+1; setposition(fil(zno),0,seg); if -,(operation=6 and pr=0) then begin <*læs seg medmindre op er skriv første post*> inrec6(fil(zno),512); fillæst:=fillæst+1 end; zstate:=operation end else <*zstate:=max(operation,zone state)*> if operation>zstate then zstate:=operation; zd(9):=seg; zd(13):=zstate; zd(16):=pl shift 1; zd(14):=zd(19)+pr*zd(16); setzone6(fil(zno),zd); \f message tilgangfil side 7 - 780916/jg; <*opdater kataloger*> katf:=zno shift 19 add (katf extract 19); case ftype of begin dbkatt(fno,2):=katf; dbkats(fno,2):=katf; dbkate(fno,2):=katf end; dbkatz(zno,1):= filref; if ftype=3 then dbkatz(zno,2):=0 else <*if ftype=1 then allerede opd under zoneallokering*> if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*> if zstate=5 then (if pr=pps-1 then 2 else 1) else if zstate=6 and pr=pps-1 then 3 else 0; <*udgang*> udgang: if st=0 then zoneno:=zno else zoneno:=0; <*fejl*> tilgangfil:=st; end tilgangfil; \f message pfilsystem side 1 - 781003/jg; procedure pfilparm(z); zone z; write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>, dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf, <:<10>dbmaxb=:>,dbmaxb,<: dbbidlængde=:>,dbbidlængde,<: dbbidmax=:>, dbbidmax,<:<10>dbmaxef=:>,dbmaxef); procedure pfilglobal(z); zone z; write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri, <:<10>dbantb=:>,dbantb,<: dbkatbfri=:>,dbkatbfri, <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri, <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz, <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst, <:<10>dbsnavn=:>,string dbsnavn,<: dbtnavn=:>,string dbtnavn); procedure pdbkate(z,i); value i; integer i; zone z; begin integer j; array field navn; navn:=i*12+4; j:=1; write(z,<:<10>dbkate(:>,i,<:)=:>, dbkate(i,1) shift (-9), dbkate(i,1) extract 9, dbkate(i,2) shift (-19), dbkate(i,2) shift (-18) extract 1, dbkate(i,2) extract 18, <: :>,string dbkate.navn(increase(j))); end; \f message pfilsystem side 2 - 781003/jg; procedure pdbkats(z,i); value i; integer i; zone z; write(z,<:<10>dbkats(:>,i,<:)=:>, dbkats(i,1) shift (-9), dbkats(i,1) extract 9, dbkats(i,2) shift (-19), dbkats(i,2) shift (-18) extract 1, dbkats(i,2) shift (-12) extract 6, dbkats(i,2) extract 12); procedure pdbkatb(z,i); value i;integer i; zone z; write(z,<:<10>dbkatb(:>,i,<:)=:>, dbkatb(i) extract 12); procedure pdbkatt(z,i); value i; integer i; zone z; write(z,<:<10>dbkatt(:>,i,<:)=:>, dbkatt(i,1) shift (-9), dbkatt(i,1) extract 9, dbkatt(i,2) shift (-19), dbkatt(i,2) shift (-18) extract 1, dbkatt(i,2) extract 18); procedure pdbkatz(z,i); value i; integer i; zone z; write(z,<:<10>dbkatz(:>,i,<:)=:>, dbkatz(i,1),dbkatz(i,2)); \f message pfilsystem side 3 - 781003/jg; procedure pfil(z,i); value i; integer i; zone z; begin integer j,k; array field navn; integer array zd(1:20); navn:=2; k:=1; getzone6(fil(i),zd); write(z,<:<10>fil(:>,i,<:)=:>, zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>, string zd.navn(increase(k))); for j:=6 step 1 until 10 do write(z,zd(j)); write(z,<:<10>:>); for j:=11 step 1 until 20 do write(z,zd(j)); end; procedure pfilsystem(z); zone z; begin integer i; write(z,<:<12>udskrift af variable i filsystem:>); write(z,<:<10><10>filparm::>); pfilparm(z); write(z,<:<10><10>filglobal::>); pfilglobal(z); write(z,<:<10><10>fil: zone descriptor:>); for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i); write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>); for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i); write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>); for i :=1 step 1 until dbmaxef do pdbkate(z,i); write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>); for i:=1 step 1 until dbmaxsf do pdbkats(z,i); write(z,<:<10><10>dbkatb: katbref:>); for i:=1 step 1 until dbmaxb do pdbkatb(z,i); write(z,<:<10><10>dbkatt: pa pl zref dis stot:>); for i:=1 step 1 until dbmaxtf do pdbkatt(z,i); end pfilsystem; \f message pfilsystem side 4 - 781003/jg; procedure pfdim(fdim); integer array fdim; begin integer i; array field navn; i:=1;navn:=8; write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>, string fdim.navn(increase(i))); end pfdim; \f message opretfil side 0 - 810529/cl; procedure opretfil; <* checker parametre og vidresender operation til opret_spoolfil eller opret_eksternfil *> begin integer array field op; integer status,pant,pl,segant,p_nøgle,fno,ftype; procedure skriv_opret_fil(z,omfang); value omfang; zone z; integer omfang; begin write(z,"nl",1,<:+++ opret fil :>); if omfang > 0 then disable begin skriv_coru(z,abs curr_coruno); write(z,"nl",1,<<d>, <:op :>,op,"nl",1, <:status :>,status,"nl",1, <:pant :>,pant,"nl",1, <:pl :>,pl,"nl",1, <:segant :>,segant,"nl",1, <:p-nøgle:>,p_nøgle,"nl",1, <:fno :>,fno,"nl",1, <:ftype :>,ftype,"nl",1, <::>); end; end skriv_opret_fil; \f message opretfil side 1 - 810526/cl; trap(opretfil_trap); <*+2*> <**> disable if testbit28 then <**> skriv_opret_fil(out,0); <*-2*> stack_claim(if cm_test then 200 else 150); <*+2*> <**> if testbit28 then write(out,"nl",1,<:+++ opret fil :>); <*-2*> trin1: waitch(cs_opret_fil,op,true,-1); trin2: <* check parametre *> disable begin ftype:= d.op.data(4) shift (-10); fno:= d.op.data(4) extract 10; if ftype<2 or ftype>3 or fno<>0 then begin status:= 1; <*parameterfejl*> goto returner; end; pant:= d.op.data(1); pl:= d.op.data(2); segant:= d.op.data(3); p_nøgle:= d.op.opkode shift (-12); if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0)) or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then status:= 1 <*parameterfejl *> else if pant>256//pl*segant then status:= 1 else if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then status:= 4 <*ingen plads*> else status:=0; \f message opretfil side 2 - 810526/cl; returner: d.op.data(9):= status; <*+2*> <*tz*> if testbit24 and overvåget and status<>0 then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> <*returner eller vidresend operation*> signalch(if status>0 then d.op.retur else case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil), op,d.op.optype); end; goto trin1; opretfil_trap: disable skriv_opret_fil(zbillede,1); end opretfil; \f message tilknytfil side 0 - 810526/cl; procedure tilknytfil; <* tilknytter ekstern fil og returnerer intern filid *> begin integer array field op; integer status,i,fno,segant,pa,pl,sliceant,s; array field enavn; integer array tail(1:10); procedure skriv_tilknyt_fil(z,omfang); value omfang; zone z; integer omfang; begin write(z,"nl",1,<:+++ tilknyt fil :>); if omfang > 0 then disable begin real array field raf; skriv_coru(z,abs curr_coruno); write(z,"nl",1,<<d>, <:op :>,op,"nl",1, <:status :>,status,"nl",1, <:i :>,i,"nl",1, <:fno :>,fno,"nl",1, <:segant :>,segant,"nl",1, <:pa :>,pa,"nl",1, <:pl :>,pl,"nl",1, <:sliceant:>,sliceant,"nl",1, <:s :>,s,"nl",1, <::>); raf:= 0; write(z,<:tail::>); skriv_hele(z,tail.raf,20,128); write(z,<:ia::>); skriv_hele(z,ia.raf,20,128); end; end skriv_tilknyt_fil; \f message tilknytfil side 1 - 810529/cl; stack_claim(if cm_test then 200 else 150); trap(tilknytfil_trap); <*+2*> <**> if testbit28 then <**> skriv_tilknyt_fil(out,0); <*-2*> trin1: waitch(cs_tilknyt_fil,op,true,-1); trin2: wait(bs_kate_fri); trin3: disable begin <* find ekstern rapportfil *> enavn:= 8; if find_fil_enavn(d.op.data.enavn)>0 then begin status:= 6; <* fil i brug *> goto returner; end; open(zdummy,0,d.op.data.enavn,0); s:= monitor(42)lookup entry:(zdummy,0,tail); if s<>0 then begin if s=3 then status:= 2 <* fil findes ikke *> else if s=6 then status:= 1 <* parameterfejl, navn *> else fejlreaktion(1,s,<:lookup entry:>,0); goto returner; end; if tail(9)<>d.op.data(4) <* contentskey,subno *> then begin status:= 5; <* forkert indhold *> goto returner; end; segant:= tail(1); if segant>db_seg_max then segant:= db_seg_max; pa:= tail(10); pl:= tail(7) extract 12; if pl < 1 or pl > 256 then begin status:= 7; goto returner; end; \f message tilknytfil side 2 - 810529/cl; if pa>256//pl*segant then begin status:= 7; goto returner; end; <* reserver *> s:= monitor(52)create area:(zdummy,0,ia); if s<>0 then begin if s=3 then status:= 2 <* fil findes ikke *> else if s=1 <* areaclaims exeeded *> then begin status:= 4; fejlreaktion(1,s,<:create area:>,1); end else fejlreaktion(1,s,<:create area:>,0); goto returner; end; s:= monitor(8)reserve:(zdummy,0,ia); if s<>0 then begin if s<3 then status:= 6 <* i brug *> else fejlreaktion(1,s,<:reserve:>,0); monitor(64)remove area:(zdummy,0,ia); goto returner; end; tail(7):= 1 shift 12 +pl; <* tilknyttet *> s:= monitor(44)change entry:(zdummy,0,tail); if s<>0 then fejlreaktion(1,s,<:change entry:>,0); <* opdater katalog *> dbantef:= dbantef+1; fno:= dbkatefri; dbkatefri:= dbkate(fno,2); dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *> dbkate(fno,2):= segant; for i:= 5 step 1 until 8 do dbkate(fno,i-2):= d.op.data(i); <* returparametre *> d.op.data(1):= pa; d.op.data(2):= pl; d.op.data(3):= segant; d.op.data(4):= 3 shift 10 +fno; status:= 0; \f message tilknytfil side 3 - 810526/cl; returner: close(zdummy,false); d.op.data(9):= status; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>tilknytfil::>,status,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> signalch(d.op.retur,op,d.op.optype); if dbantef < dbmaxef then signalbin(bs_kate_fri); end; goto trin1; tilknytfil_trap: disable skriv_tilknyt_fil(zbillede,1); end tilknyt_fil; \f message frigivfil side 0 - 810529/cl; procedure frigivfil; <* frigiver en tilknyttet ekstern fil *> begin integer array field op; integer status,fref,ftype,fno,s,i,z; array field enavn; integer array tail(1:10); procedure skriv_frigiv_fil(zud,omfang); value omfang; zone zud; integer omfang; begin write(zud,"nl",1,<:+++ frigiv fil :>); if omfang > 0 then disable begin real array field raf; skriv_coru(zud,abs curr_coruno); write(zud,"nl",1,<<d>, <:op :>,op,"nl",1, <:status:>,status,"nl",1, <:fref :>,fref,"nl",1, <:ftype :>,ftype,"nl",1, <:fno :>,fno,"nl",1, <:s :>,s,"nl",1, <:i :>,i,"nl",1, <:z :>,z,"nl",1, <::>); raf:= 0; write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128); end; end skriv_frigiv_fil; \f message frigivfil side 1 - 810526/cl; stack_claim(if cm_test then 200 else 150); trap(frigivfil_trap); <*+2*> <**> disable if testbit28 then <**> skriv_frigiv_fil(out,0); <*-2*> trin1: waitch(cs_frigiv_fil,op,true,-1); trin2: disable begin <* find fil *> fref:= d.op.data(4); ftype:= fref shift (-10); fno:= fref extract 10; if ftype=0 or ftype>3 or fno=0 then begin status:= 1; goto returner; end; if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then begin status:= 1; goto returner; end; if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1)) extract 9 = 0 then begin status:= 2; <* fil findes ikke *> goto returner; end; if ftype <> 3 then begin status:= 5; goto returner; end; <* frigiv evt. tilknyttet zone og areaprocess *> z:= dbkate(fno,2) shift (-19); if z > 0 then begin if dbkatz(z,1)=fref then begin integer array zd(1:20); getzone6(fil(z),zd); if zd(13)>5 then filskrevet:= filskrevet +1; close(fil(z),true); dbkatz(z,1):= 0; end; end; \f message frigivfil side 2 - 810526/cl; <* opdater tail *> enavn:= fno*12+4; open(zdummy,0,dbkate.enavn,0); s:= monitor(42)lookup entry:(zdummy,0,tail); if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0); tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *> tail(10):=dbkate(fno,1) shift (-9);<* postantal *> s:= monitor(44)change entry:(zdummy,0,tail); if s<>0 then fejlreaktion(1,s,<:change entry:>,0); monitor(64)remove process:(zdummy,0,tail); close(zdummy,true); <* frigiv indgang *> for i:= 1, 3 step 1 until 6 do dbkate(fno,1):= 0; dbkate(fno,2):= dbkatefri; dbkatefri:= fno; dbantef:= dbantef -1; signalbin(bs_kate_fri); d.op.data(4):= 0; <* filref null *> status:= 0; returner: d.op.data(9):= status; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>frigivfil::>,status,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> signalch(d.op.retur,op,d.op.optype); end; goto trin1; frigiv_fil_trap: disable skriv_frigiv_fil(zbillede,1); end frigivfil; \f message sletfil side 0 - 810526/cl; procedure sletfil; <* sletter en spool- eller ekstern fil *> begin integer array field op; integer fref,fno,ftype,status; procedure skriv_slet_fil(z,omfang); value omfang; zone z; integer omfang; begin write(z,"nl",1,<:+++ slet fil :>); if omfang > 0 then disable begin skriv_coru(z,abs curr_coruno); write(z,"nl",1,<<d>, <:op :>,op,"nl",1, <:fref :>,fref,"nl",1, <:fno :>,fno,"nl",1, <:ftype :>,ftype,"nl",1, <:status:>,status,"nl",1, <::>); end; end skriv_slet_fil; \f message sletfil side 1 - 810526/cl; stack_claim(if cm_test then 200 else 150); trap(sletfil_trap); <*+2*> <**> disable if testbit28 then <**> skriv_slet_fil(out,0); <*-2*> trin1: waitch(cs_slet_fil,op,true,-1); trin2: disable begin <* find fil *> fref:= d.op.data(4); ftype:= fref shift (-10); fno:= fref extract 10; if ftype=0 or ftype>3 or fno=0 then begin status:= 1; goto returner; end; if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then begin status:= 1; goto returner; end; if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1)) extract 9 = 0 then begin status:= 2; <* fil findes ikke *> goto returner; end; <* slet spool- eller ekstern fil *> case ftype of begin <* tabelfil - ingen aktion *> ; \f message sletfil side 2 - 810203/cl; <* spoolfil *> begin integer z,bidno,bf,bidant,i; <* hvis tilknyttet så frigiv *> z:= dbkats(fno,2) shift (-19); if z>0 then begin if dbkatz(z,1)=fref then begin integer array zd(1:20); dbkatz(z,1):= 2 shift 10; getzone6(fil(z),zd); <*annuler evt. udskrivning*> if zd(13)>5 then begin zd(13):= 0; setzone6(fil(z),zd); end; end; end; <* frigiv bidder *> bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*> bidant:= dbkats(fno,2) shift (-12) extract 6; for i:= bidant -1 step -1 until 1 do bidno:= dbkatb(bidno) extract 12; dbkatb(bidno):= false add dbkatbfri; dbkatbfri:= bf; dbantb:= dbantb-bidant; <* frigiv indgang *> dbkats(fno,1):= 0; dbkats(fno,2):= dbkatsfri; dbkatsfri:= fno; dbantsf:= dbantsf -1; signalbin(bs_kats_fri); end spoolfil; \f message sletfil side 3 - 810203/cl; <* extern fil *> begin integer i,s,z; real array field enavn; integer array tail(1:10); <* find head and tail *> enavn:= fno*12+4; open(zdummy,0,dbkate.enavn,0); s:= monitor(42)lookup entry:(zdummy,0,tail); if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0); <*frigiv evt. tilknyttet zone og areaprocess*> z:=dbkate(fno,2) shift (-19); if z>0 then begin if dbkatz(z,1)=fref then begin integer array zd(1:20); getzone6(fil(z),zd); if zd(13)>5 then <* udskrivning *> begin <*annuler*> zd(13):= 0; setzone6(fil(z),zd); end; close(fil(z),true); dbkatz(z,1):= 0; end; end; <* fjern entry *> s:= monitor(48)remove entry:(zdummy,0,tail); if s<>0 then fejlreaktion(1,s,<:remove entry:>,0); close(zdummy,true); <* frigiv indgang *> for i:=1, 3 step 1 until 6 do dbkate(fno,i):= 0; dbkate(fno,2):= dbkatefri; dbkatefri:= fno; dbantef:= dbantef -1; signalbin(bs_kate_fri); end eksternfil; end ftype; \f message sletfil side 4 - 810526/cl; status:= 0; if ftype > 1 then d.op.data(4):= 0; <*filref null*> returner: d.op.data(9):= status; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>sletfil::>,status,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> signalch(d.op.retur,op,d.op.optype); end; goto trin1; sletfil_trap: disable skriv_slet_fil(zbillede,1); end sletfil; \f message opretspoolfil side 0 - 810526/cl; procedure opretspoolfil; <* opretter en spoolfil og returnerer intern filid *> begin integer array field op; integer bidantal,fno,i,bs,bidstart; procedure skriv_opret_spoolfil(z,omfang); value omfang; zone z; integer omfang; begin write(z,"nl",1,<:+++ opret spoolfil :>); if omfang > 0 then disable begin skriv_coru(z,abs curr_coruno); write(z,"nl",1,<<d>, <:op :>,op,"nl",1, <:bidantal:>,bidantal,"nl",1, <:fno :>,fno,"nl",1, <:i :>,i,"nl",1, <:bs :>,bs,"nl",1, <:bidstart:>,bidstart,"nl",1, <::>); end; end skriv_opret_spoolfil; \f message opretspoolfil side 1 - 810526/cl; stack_claim(if cm_test then 200 else 150); signalbin(bs_kats_fri); <*initialiseres til åben*> trap(opretspool_trap); <*+2*> <**> disable if testbit28 then <**> skriv_opret_spoolfil(out,0); <*-2*> trin1: waitch(cs_opret_spoolfil,op,true,-1); trin2: bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1; wait(bs_kats_fri); trin3: if bidantal>dbmaxb-dbantb then <*ikke plads,vent*> begin wait(bs_kats_fri); goto trin3; end; disable begin <*alloker bidder*> bs:= bidstart:= dbkatbfri; for i:= bidantal-1 step -1 until 1 do bs:= dbkatb(bs) extract 12; dbkatbfri:= dbkatb(bs) extract 12; dbkatb(bs):= false; <*sidste ref null*> dbantb:= dbantb+bidantal; <*alloker indgang*> fno:= dbkatsfri; dbkatsfri:= dbkats(fno,2); dbantsf:= dbantsf +1; dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add d.op.data(2) extract 9; <*postlængde*> dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*> \f message opretspoolfil side 2 - 810526/cl; <*returner*> d.op.data(3):= bidantal*dbbidlængde; <*segantal*> d.op.data(4):= 2 shift 10 add fno; <*filref*> for i:= 5 step 1 until 8 do <*filnavn null*> d.op.data(i):= 0; d.op.data(9):= 0; <*status ok*> <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>opretfil::>,0,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op:>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> signalch(d.op.retur,op,d.op.optype); if dbantsf<dbmaxsf then signalbin(bs_kats_fri); end; goto trin1; opretspool_trap: disable skriv_opret_spoolfil(zbillede,1); end opretspoolfil; \f message opreteksternfil side 0 - 810526/cl; procedure opreteksternfil; <* opretter og knytter en ekstern fil *> begin integer array field op; integer status,s,i,fno,p_nøgle; integer array tail(1:10),zd(1:20); real r; real array field enavn; procedure skriv_opret_ekstfil(z,omfang); value omfang; zone z; integer omfang; begin write(z,"nl",1,<:+++ opret ekstern fil :>); if omfang > 0 then disable begin real array field raf; skriv_coru(z,abs curr_coruno); write(z,"nl",1,<<d>, <:op :>,op,"nl",1, <:status :>,status,"nl",1, <:s :>,s,"nl",1, <:i :>,i,"nl",1, <:fno :>,fno,"nl",1, <:p-nøgle:>,p_nøgle,"nl",1, <::>); raf:= 0; write(z,<:tail::>); skriv_hele(z,tail.raf,20,128); write(z,<:zd::>); skriv_hele(z,zd.raf,40,28); end; end skriv_opret_ekstfil; \f message opreteksternfil side 1 - 810526/cl; stack_claim(if cm_test then 200 else 150); signalbin(bs_kate_fri); <*initialiseres til åben*> trap(opretekst_trap); <*+2*> <**> disable if testbit28 then <**> skriv_opret_ekstfil(out,0); <*-2*> trin1: waitch(cs_opret_eksternfil,op,true,-1); trin2: wait(bs_kate_fri); trin3: <*opret temporær fil og tilknyt den*> disable begin enavn:= 8; <*opret*> open(zdummy,0,d.op.data.enavn,0); tail(1):= d.op.data(3); <*segant*> tail(2):= 1; tail(6):= systime(7,0,r); <*shortclock*> tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*> tail(8):= 0; tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*> tail(10):= d.op.data(1); <*postantal*> s:= monitor(40)create entry:(zdummy,0,tail); if s<>0 then begin if s=4 <*claims exeeded*> then begin status:= 4; fejlreaktion(1,s,<:create entry:>,1); goto returner; end; if s=3 <*navn ikke unikt*> then begin status:= 6; goto returner; end; fejlreaktion(1,s,<:create entry:>,0); end; \f message opreteksternfil side 2 - 810203/cl; p_nøgle:= d.op.opkode shift (-12); s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail); if s<>0 then begin if s=6 then begin <*claims exeeded*> status:= 4; fejlreaktion(1,s,<:permanent entry:>,1); monitor(48)remove entry:(zdummy,0,tail); goto returner; end else fejlreaktion(1,s,<:permanent entry:>,0); end; <*reserver*> s:= monitor(52)create areaprocess:(zdummy,0,zd); if s<>0 then begin fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0); status:= 4; monitor(48)remove entry:(zdummy,0,zd); goto returner; end; s:= monitor(8)reserve:(zdummy,0,zd); if s<>0 then fejlreaktion(1,s,<:reserve:>,0); <*tilknyt*> dbantef:= dbantef +1; fno:= dbkatefri; dbkatefri:= dbkate(fno,2); dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12); dbkate(fno,2):= tail(1); getzone6(zdummy,zd); for i:= 2 step 1 until 5 do dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*> d.op.data(3):= tail(1); d.op.data(4):= 3 shift 10 +fno; status:= 0; \f message opreteksternfil side 3 - 810526/cl; returner: close(zdummy,false); d.op.data(9):= status; <*+2*> <*tz*> if testbit24 and overvåget then <*zt*> <*tz*> begin <*zt*> <*tz*> write(out,<:<10>opretfil::>,status,<: :>); <*zt*> <*tz*> pfdim(d.op.data); <*zt*> <*tz*> write(out,<: op::>,op,d.op.retur); ud; <*zt*> <*tz*> end; <*zt*> <*-2*> signalch(d.op.retur,op,d.op.optype); if dbantef<dbmaxef then signalbin(bs_kate_fri); end; goto trin1; opretekst_trap: disable skriv_opret_ekstfil(zbillede,1); end opreteksternfil; :5: filinit. \f message fil_init side 1 - 801030/jg; begin integer i,antz,tz,s; real array field raf; filskrevet:=fillæst:=0; <*fil*> dbsegmax:= 2**18-1; tz:=dbantez+dbantsz; antz:=tz+dbanttz; for i:=1 step 1 until dbantez do begin open(fil(i),4,<::>,0); close(fil(i),false) end; for i:=dbantez+1 step 1 until tz do open(fil(i),4,string dbsnavn,0); for i:=tz+1 step 1 until antz do open(fil(i),4,string dbtnavn,0); for i:=1 step 1 until dbantez do <*dbkatz*> dbkatz(i,1):=dbkatz(i,2):=0; for i:=dbantez+1 step 1 until tz do begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end; for i:=tz+1 step 1 until antz do begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end; dbkatz(antz,2):=tz+1; dbsidstetz:=antz; dbsidstesz:=tz; for i:=1 step 1 until dbmaxef do <*dbkate*> begin integer j; for j:=1,3 step 1 until 6 do dbkate(i,j):=0; dbkate(i,2):=i+1; end; dbkate(dbmaxef,2):=0; dbkatefri:=1; dbantef:=0; \f message fil_init side 2 - 801030/jg; for i:= 1 step 1 until dbmaxsf do <*dbkats*> begin dbkats(i,1):=0; dbkats(i,2):=i+1; end; dbkats(dbmaxsf,2):=0; dbkatsfri:=1; dbantsf:=0; for i:=1 step 1 until dbmaxb do <*dbkatb*> dbkatb(i):=false add (i+1); dbkatb(dbmaxb):=false; dbkatbfri:=1; dbantb:=0; raf:=4; for i:=1 step 1 until dbmaxtf do begin inrec6(fil(antz),4); dbkatt.raf(i):=fil(antz,1); end; inrec6(fil(antz),4); if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0); setposition(fil(antz),0,0); end filsystem; \f message fil_init side 3 - 810209/cl; bs_kats_fri:= nextsem; <*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>); <*-3*> bs_kate_fri:= nextsem; <*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>); <*-3*> cs_opret_fil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>); <*-3*> cs_tilknyt_fil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>); <*-3*> cs_frigiv_fil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>); <*-3*> cs_slet_fil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>); <*-3*> cs_opret_spoolfil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>); <*-3*> cs_opret_eksternfil:= nextsemch; <*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>); <*-3*> \f message fil_init side 4 810209/cl; <* initialisering af filsystemcoroutiner *> i:= nextcoru(001,10,true); j:= newactivity(i,0,opretfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> i:= nextcoru(002,10,true); j:= newactivity(i,0,tilknytfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> i:= nextcoru(003,10,true); j:= newactivity(i,0,frigivfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> i:= nextcoru(004,10,true); j:= newactivity(i,0,sletfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> i:= nextcoru(005,10,true); j:= newactivity(i,0,opretspoolfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> i:= nextcoru(006,10,true); j:= newactivity(i,0,opreteksternfil); <*+3*> skriv_newactivity(out,i,j); <*-3*> :6: filsystem: trap pfilsystem(zbillede); :7: filsystem: finale \f message filsystem finale side 1 - 810428/cl; <* lukning af zoner *> write(out,<:lukker filsystem:>); ud; for i:= 1 step 1 until dbantez+dbantsz+dbanttz do close(fil(i),true); ▶EOF◀