From a35deeeb66ba1a766046c745afa8f26a0a1aa8fc Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 9 Nov 2016 11:29:15 +0100 Subject: [PATCH] Build ARCDEV. --- Makefile | 2 +- README.md | 1 + bin/device/oarcdv.bin | Bin 0 -> 20565 bytes build/build.tcl | 4 + doc/sysdoc/arcdev.format | 84 ++ src/syseng/arcdev.69 | 1962 ++++++++++++++++++++++++++++++++++++++ 6 files changed, 2052 insertions(+), 1 deletion(-) create mode 100755 bin/device/oarcdv.bin create mode 100755 doc/sysdoc/arcdev.format create mode 100755 src/syseng/arcdev.69 diff --git a/Makefile b/Makefile index cd1cc689..f7dd44e9 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ SRC = system syseng sysen1 sysen2 sysnet kshack midas _teco_ rms klh -MINSYS = _ sys sys3 +MINSYS = _ sys sys3 device RAM = bin/boot/ram.262 NSALV = bin/boot/salv.rp06 DSKDMP = bin/boot/dskdmp.rp06 diff --git a/README.md b/README.md index e942c4a6..c98b3365 100644 --- a/README.md +++ b/README.md @@ -40,5 +40,6 @@ from scratch. - ATSIGN DEVICE, load device drivers. - TCTYP and CRTSTY, terminal handling. - PEEK, system monitoring. + - ARCDEV, transparent file system access to archive files. 4. Finally, the whole file system is dumped to tape. diff --git a/bin/device/oarcdv.bin b/bin/device/oarcdv.bin new file mode 100755 index 0000000000000000000000000000000000000000..5c5baa15cd9d70cc51e20b019704cae11a5197ce GIT binary patch literal 20565 zcmc(H3sjxgb>{i+f1g}Hm;2x$3F!x}c!PL@Ue*PH5PBnw#6t)W=q)6nw}p_e#*L-K zt{vNxWTi>Q?sDVCb<)&%v@`Wetu##?#c^#Xqvd!qo<`$oV%Mo2S8$O)4)cBc2d+%j zbh>6{^{(Zk{qM8SKKty~+2{N}KI&CU9Zgj#^|$q5r4`jE6@L^sjg5mi-IxoAkCw{i zQ#jiUoqp7NL@ClaMiaq+bk^dzQ#jXXw^BCZY$J(E%_E(=KuygNe{=zeiA$ToT`N#M zCck+i0h`3~j;VRmqt8u=HmAS|Hlv``E}T|Lqt7X=q44?LE4 z!;&5+S;&X zO+#(HNwdgk*s%G*_Bf@YJD>RZ0cfO&Qa*Ei=!mwR8u{6*N&ashLmYhf)=$$bm4NqY zZg`Zs8e)fZ-hJUO=k2-ygK6y0h|IbTsPX9VwccZt@21eTKH#sZ5<2$&Y!;5g_TxW~ z$+Y!>(^Ez%*Qh8iamEC_9@@aF% zzxmjTav^4iU3vvKLSn;E$_2bKZlI|Rp~)yP&^k{lkH*I0>``jaxfi&b&alS@hsP*H zR@0puN;@{<3~Mf-bV;N!X`NFx%BG%eC8T|2_7Rqq_N}5U0+zO zB-8HPjUcYvsI;!Vg;43r;De~pYGNtX=Q&zuZ2gUnA^g#8bXm5A41rRx1E-ywf zlGE;v&4(|H_<%Py0wqcz#f#C-e?F@0(DW!_l1GUv*DI~F0yB1vtOGyt?23Lmto?d1 z;?^lzE$l!%5^@mI*;sDGEq%0?;$5vMfn5y?Of{kzFcnR(RAC~q0~bY}XGe6%Ba0o; z!=5=%k8;G+0}_j6sX{xWt;xtZNO}%Bj&P^c?&QMM5+!Fc3N0Qr;)};*zY2SjW=Y1` zHg;IM*9=m;Nh22~5LU&B$RicSN;^Z6lfC3DOh@9BN)i$w?mdJKlAMV|AOR+~xWo&~ z>afTghzbp{k*lg9u97I}@E|~n=`kfGYpmwN_h!#TaJDFsdo}cM)p_h}C8xCg;lEMXWZH zICqBg!Wi+#HRtCfP`+jVTp*RpVg8vp8e_xmL+mGU!pt1GzmqtD#I_mE?f)Y2_=_h$ z{r8lw9U4OR_zkpc4*SV8gc{4TIL4riils^hMl3<4iL%T3iQ|ZvwdhSYaq*ZFiz%r4 zax&NxV}QJ3GTl=a6v)pA%2ir4z4a$<%6E!}*XRNoAze}ra-=QaC zhg%e9E2kR$5E4Y&K+GxY$9v)T6RvoyvMFAP1FePK#adEzVTmF|Q) z>Pe7KPdInF_gEt3yB-}>dY0ful0te$!gra$2wQz|=S%!O8Lu=H=FqNpu2x$a2dMRu=@No3AVLf5& z5=erXn6kJICY$4a$kGY<^aSw(W0lgql22vwm`{p37A`|CoJ-G;iK3}tJqv}Co&>+r zy@D%&d_GiT`Xb>+aoOv+CJ^+fC&}SQ8m@j3a8p0jZ+d^R1v*8L=&u=2V&AFUgKe8A zUx7%Ff{FT~Z(#|hK%WR_3mw>IIKhSWplw70my&D)+U-&Lt5qSy3k|Sf^euD{S7}&K z0p6_%i#O>d44iqK{4!-uq(FVF3_U3VftbN$EsEh*E=> zU5Oa89=W!3S+Dety{Po(DRY86vezb%8PoKpnDN9}#V5tRV`}0Y<`ziE+#JO3IW|iS zuMYY9R#U$3lM6R0y^BzhDP#|vW;(q7UH;9SSFKpT=zst3GX1|g>Dc6NjX9L>;)dbQHN?w(h_bjtnIgxRPJjW zmM08uCgH5X$#V(}=$z5Wlx8zT7BmJwVPuF5~m=}(dD^{Im`kd0YfQwvahy_!lNy=43ncv=Dv@yAv^1aE*;6UV# z@|23x%sLAgC5@-K!8!_NxfC?)Fwi(LH7?%JSO?K0Abyk^b)QN&&StPWRe92QJC6Dm zL!3RIxQDy*;@n+jKZ_}%V%V*4%WSYX5qAcx*^v$%26>NdA2uCDvj%NaX~6` zEfO8bujA$j6s|_905u8wQO2S{u7I>V#eenC z%arfEky?n>(u2kceeo2BL_AkHEF+pyy}9*{>qE^5VLJB$&U3B6fEDSXD`=upb8q_) z#vetNOo^$5BBw&l++Lt1(e>!1zrb!-?<}~^d3@s2&72#=xPyXT7mhYr3qFqi@zbwo zP`rskszB5-OT%V7u$QJRjroVza|`Ws_tScK;X!&7IKy@{maJ+qP^F{a$CP4JG24vy z=!>~q(+720)*=&ea*dYNii3!+@#?ID4?{kCnuMTX=WO2(dsZ5&Jy`=ssmFdm+s&89$knjYa)Hw+pIp^x(c2e;%y0I2{h5yIN5n4+mtsmn774Q6 zo$ws^uYIvR-ptQ@npeB_YKUQb){MRmtXFzXU9murMTsx&1V$7$M4kFLQw zIBzMPNgrXtm353=A_N~yIhcugQB-2lmoL(SP#ttNMMp2GmAjV04v>f~rMLH?&+Vjm zttI^nc{Oh@2Rdj0-=HpyVZnQd4=}0BA`=*OsfDT<)3M@Jr88@veR0^5i7He^n4CCF zAXy2v9o0){wP|n$l9ZnC1Tcjd+Q^CbzO{_f9m}nQ_tRsv@jQL?jw^QJ7*$<_gm|vTAsK{eO!h@X;+)Lmn?zmS;l)^*=L4K+jQVj3}mkI43t?N zLV(1KR+Sxp{RriID*9z*{~|LAw@O2&XkV-jh0KCL-j>Y1D}sd$xUe#$X0URO{E{Go zgX?IE9=QmOgUeSbF5idQpC$X+G9DX9(!miK(ao^6Jn||-t4X;gKwH<@Dc>8oB~uM#m2$T&YRtiC=ruC&NG^T`+e>7S7lNdDl2=fdBQCO?g<8HH z!BO0ZMgoEQ>!x-a?qWq$r_(il2*gGGIe~J@_Yp}>N>PhXAi<<6ez^0qoO^@f>; zMlFeNqQxjD$;BaK2}$NS$zF-&lYBGCl4AR8B34-!ZVZ4B`&n`Sw7`rzu|pdsngdUG^I69U!iO{PgHA!=47F z76)-nMo=m5$lF*ni5HFcfR6ET_G6G}2QyJ7w`E!jPTb@pEjR=ttB+*6ju{1_*?;Zq zQ8v4DK<244J;kVHAZAQlTwijE^7SEEddkb{ab5vGM;nhBxuk=~J~DZSbDW{1ET zBTopKdx~u8-ow6sG`QA zf1;dyq7BZGYS_WFXE&Jgk;ia1-v&CDac#xXW;muij%aYHGMF*ne2h~{n;L6TsT^C; zpA9a?YVeEvW7yM`vLE+dti!r_8z8~dKJnoGO`oECEe7JZXykPmCHhR*+0I<7M{a~w z=h!P@=e8;cnkN%QKY)Er2+C=PeD(#hd=tmT$O*N&2a^jV-gMJ5{SnyAiuz`0934~I zCDX==BhYx0-JhOJ`34OO*1^(0l@pyOQ(g>cC1!A5!ty0Jqkk55K8#*_Mu^(I?J=-a zycs`5VtEx_N#&G3ph9p$I=Vbo8+iE+$bOE|y_)WwOK2^-c(_{ zRJ*Oz6+CK5B1VDcajvGayGnTM6}qty?7@p3artdgzT_lMbK>4r-L1J$ahdXc1H{hF zWV%WqnuqIkZkL*isOD=l?p z;xszUdgEf4?_}|aa?n#E%c3Lc^g7;}IDcr;vFt9W51kECzSlD`xiQT0S{ZfHY(wKK{z7gKYvGU`~XxA0lZ^_^#9%l;a8oeV)@j;tJ6}RrL`yR#; zcWu@w-`@Kj%Vtiw+{NrwlzErzKRin%0;e%hTd8jYf)FyUYwQw;TUMR)tfhPbxhXL)EXbM&7g)GB zDTkW4qsDb|AC)@T&P#236*Q?uTc&y&!5(*EKgZ)e%~d>>1VKziq(eFAy)!jJ_ywcS zfHP;)`PJ)C?2!exogSh0ciR((C|?l4j$@Q7Rq0i%356g1`CkbL>dO4!lOCnV48^ZGKlB1(f_Wg&Ol#f*u ze6nYHuMs1g3>X1aSP>Ob1Dw6nyzQRxVxgl{qKzUd+bmj2uqpF%!#MdkigzX|Q~Xb? zKL(9oVefgFT&A4aQP&F7lIF5f zea*rYo4Z_zY7At#B2t-j)ArxJW*JN6%9_h$seIhVDZet}{*KZzQgJAyDed&5T0$9w zR*`ciUj)p&O7Nti*ONA0fCF-5!9T5BLiu{c z*S#pfC{W4$3N=c#kMp)r0(tw>N<~~@;0?g2Q}sLZaV;a4m9n*|u!B|I=fPe=U*3xt zb(r$5#ge#>@*S2#)%1&E?5Jmy_^*S-VB8PIry>2+5e|BByu_6sxk@t4GraXg z*)GWEzBXM^+cU7Nsj`~O=XrkiXQnatxz~(N6o^r#5{i)`FJ;8_M&AdnIZF9~EVRWQN3Jj(ANvZWQ6G}o7Wrp0v{HaPHK|jY9 zH8wjpZl-(%qi`h6$aGq2aAOqDw`}k~aF!3{L?wPo`VQY>@zKGOVM;z`pLZdZbwEBb zV6zKGb~nx%LDONLzdRHE z!bNY#yLuDqjMWJ2=#&tmZq6Bsv_0U z6#rsJRp3=>NiLcj9Bdft4P(uGrSH1qQ2OP=C)Oq=QM@^~8t_JI^l!j#6EG^yVh-ANTx#)ONggoa@Jnev01$$1IRPd-XyI>grgdQm3Nu?5m>} z07V>Vhov^FUX2}^QCb2ddq}K7Me5WIg}?Qh~E_z2i491|!BleYN;g0(paH`7dx= z^%K>QP5AYsE)i%;`hlYaFxv{$pX8!HxU4p_N1*XbzZrd4pekhgU={{?RRv9v$^6v=GfL-+<&pz&9~GlWSnMc`0Z4*{jOp4)qNoj|@# zhfO-i_@&WTD~Yp?x1A^yk*xt=3NgU>_6AKl*Z8+n*GsQ0P_W+YwIwfVHGAD#>T9$) zoYy`6>h43WCbaE==b8j+9X?pbixXw{RWlzE@}Jphj!g(`uQG9t!0`hnZq8P{&3%ek z=a$9E-Xnw(T8EFW%q72tTlK*e((8$A`|n?ShrPzumSVUIA%9+4+i8J(fhC)-aYSuo z*Y>yM>)Z@)@4h|9h+7p%SmDYhU1sFVU#$?;H$+;#moDy-6>0fa_nV|^^k+72l2jA) zF5O)rhG_zn)yc7oBA*Ff{*ZL*BB%c9ov#p=9odlit?R^XfP7zoXXEV;psS6ucpp>s;@;jKU4XHTzpOB*DkA(L}!f(vZl~5^4E*<-^3~N50W-x<;%2Slbe0N96Iy zPip?hcR6;OukF-BVE~26#j96Yh-&w)>C`1z6nV?mt;{B_GZ4RJEB?iKJhJ{zFN(W# zVcPlPM2i9K8zNn|uRA}ufOI9^?PpiniR<-lAD+9HxKdyDy1b3V^^HH-edzazD}zeU z>?ZD1Ks#jyKy5%fz1hj$+JOF`E^2NH=v%gnb3W6OSeYUw>VL2+;lVc2_4{@V9~ATc zEV+2WgG8zQ$;HM-8F3}KICG8Q4kQ-`>jd{sa&fj~b#*YgIJZi0?`85cl_h28dEeB7c7TRWabz$ag>U4^I*|7^qxb z-%q-aeA^3_*ATktJ9>05L}=9a(8i1q05u%>#)i*`b|-zuGY)Vz&EY$4bdpYU`_9zt zssR~rXO=V@gj|8GE1P+ttfdjcg^|)c{@mXAAwo&M;@-1W?9K5O96QUrrOo%QX|H2m z&{lZY&D9u=nh`iud0MzML|*xW+b@(Qs0if#ixlo0Vj4aw6tY`^jy)d zb}C?eSWndQfN@GQ2sHq5hzgzx7$*;fh-(5gq{!q;frP5#9^y6vcf5ztrpVV;e)tTb z&0yC+vge8VeL^o1dXmt~=ww`J-zDlP(su@ozoQ3hT|oWaGD6)zEhN=tkgq0YH~Ur+ z+5^-Y_FW-|$A}u>QUv#FLPv-@8TsP}JB8U9;N3?i-ht>H^|-=Lfmcj;>g7x&84CB5`Wg5LXq@& z_MRZ!H!wE)Dto*9S&8*M#Jvj6iS#M`2mUN)HNh#c(y zt9M9ufY2L+27IMb(kg3pAU)^|kq&_tOza`_0O=SI)`$JeYS%Mxt&af8?j!V=FQ>Qj zAfYF{y*t~xIiiVBGjX4bv<?>SL+|%g;UW#Y4Vc~zoEzxEN zRPzsnTu{LT30%eEh5nPIyYSYNV)PG`%Ad^>dx7ir7!_U=!U-ehdq?-r5H@E={* zPRF*@5|>3>mN$JMo?EspNGO3&4rY5iKq${!cBrq6P<~|npWjL6*v>%Zyd&I9Y-Qd( z?ae8KDkAN_`LRfFm=KF8+fwwdrPE=yzCUPm9Zv9bUV8~4=`Cfij41cl zG!HN#*{cXKwCqEXCvyLZ;bvd$Z|_*;BGd?|?jiPmG4lC=x?6;vCGHHN=ZPC7^i|@9 zIHHZXF+v@Y|M;uZtZnU`ga!$9`&-tZX4Pze!{6SrXn@eK{q0+pF@@Pr_>V4k>>+eA zx!O`e;rii96@7RSQVxP?1-xJr5Dm0?qpt za5HgO2yq{9B=~cinz{)kMZWv?XZUvv4qvjRWuf5a`5H18)DxFZNJivEj{a$!&=o{B z&M~1%|IwwKRyp89HH}GxmPWq(<;E6EF%-($B_7Gwb=Qu_vkG;1@$B=Q15n=)Dm<&{u;h=;X z*b3brqqjR7>gb zZVqwnfP74P&R#&*m?oWlpnLoR>B@nVg4|gFs4zraC3?TkZN@oBh!ukKVfHd@IM4gK z*NS$Xb%&+Hut#|vmgFVD;1T^3zwAtHx*u-ribeygszQ{;MxIo z%ZTlS=5w|mdVANJbcYBXC+<2RlMY_DwtGJL4HGIM^fUmvl}jUvg_FyM; zT*pql-t#4Hct8=C?n~Un#EutpzQpD-!7cP9wiF7^<4bJK7F>oeahoByBwu3tT)}1e z5}hqxR-T|(yv)F*U#fc6O;r8+Eh1%OTpT{57vLRaKV zTyGJ&6v$jJxW$0h3N97UW*J-ROWv9$xHO-4V>=zz)lP`%#nl_>|Ks)pgmw|f!qaud zcdg!P5O>h$t-J?fLU+AK+!{iYfNZItORy2L60-Ze70ap9xH;V6c|3_*7`gbh7jClG z04|%UDXx(?rlz=dLU#ytvUiwJ7r5-8^l{z3YpbRqZ-tmQq0HxPeTdai+%Dg>eO`l{ zD+$s65^4w?A+!{b&q}&sLaZX<&ik(IJt&+X0W?4-NoXL%eLe1(z=qWi0EKrhK5vJY zI*t1hA+9&>D}=Ta`a?oTNVm=BZ5Jm_XbY6@P3NYT(BYd?k;HvC?uU`S|CaPVp*M+R zeUh+`xL*(&ByNDv@yK^JK5>C`W07q?{X3ol6V7?N7q#pKyH} z2r+@U8v_-k?MzqhMS-$i6-;&R4TSQDD+;WeYvQ^Bt@*`=*t;jN{S4DufMH-5us+{)^Ws3#PK-mewnxp z?Cm5@WZq8PCgOGzCz8HR987 zvSd9sFhfPwe`~>GfP%`Gc%Xn*2&%~L9~W%Eh@ckfd-}6qB~FWUe9pw_k!@Wj&f-h- zED4d$<}K@Az{5wb!qK{pQWfGds-t%ejt#t)>OBxbL5)kRZ9jeG4MM3~^}aKRM*Qyr zKsUGqg%o-(jYqEY9*krAN)N}29F+w&L&KcnU-9=0L E-;RAu=l}o! literal 0 HcmV?d00001 diff --git a/build/build.tcl b/build/build.tcl index 7a236e0a..e331ca90 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -172,6 +172,10 @@ respond "*" "purify\033g" respond "Idle" "q" expect ":KILL" +respond "*" ":midas device;jobdev arc_syseng;arcdev\r" +expect ":KILL" +respond "*" ":link device;jobdev ar,device;jobdev arc\r" + respond "*" "\005" respond "sim>" "at tu0 out/output.tape\r" respond "sim>" "c\r" diff --git a/doc/sysdoc/arcdev.format b/doc/sysdoc/arcdev.format new file mode 100755 index 00000000..ece79cb4 --- /dev/null +++ b/doc/sysdoc/arcdev.format @@ -0,0 +1,84 @@ +;Archive device format: + +;The first page of an archive device file is its directory. +;The remaining pages are data. + +;The directory may not even be looked at unless the archive is "locked". +.SEE LOCK,UNLOCK ;Only one ARCDEV can lock a given archive at a time. +;Shuffling the directory should not be done in place, even when it is locked. +;Instead, use DIRGET to make a copy and DIRPUT to store the copy back in. +;When a file is open, the address of its data area is remembered in FILADR. +;The data area of a file never moves, and the file can be open only in one +;direction at a time, so reading or writing the data area requires no interlocking. + +;The format of the archive device directory is approximately that of +;an I.T.S. UFD. The differences are: + +;In the fixed header, word 0 (UDESCP) contains SIXBIT /ARC1!!/ +;Word 1 points to the beginning of the name area, as in UFDs. +;Word 2 points to the end of the data area. +;Word 3 is used to tell when the archive needs to be cleaned +; because it is being touched for the first time since the system came up. +;Word 4 contains what is supposed to be the creation date of the archive. +; Since locking the archive device clobbers the creation date, +; we store it here so we can restore it after clobbering it. +;Word 5 similarly stores the dumped bit. + +;There is nothing analogous to the "descriptors" in a disk UFD. + + ;Random info in UFD +UDESCP==0 ;SIXBIT /ARC1!!/ +UDNAMP==1 ;Address in directory of first filename block. +UDDATP==2 ;Address of first free word past data area of last file. +UDINIT==3 ;Time of startup of last run of system during which this + ;archive was cleaned (ARCCLN). If not same as startup time + ;of this run of the system, we must do ARCCLN. +UDCRDT==4 ;This word holds what ought to be the creation date + ;of the archive device file itself. + ;0 => this archive antedates the UDCRDT word, in which + ;case it gets set from today's date. +UDDMPB==5 ;This is like UDCRDT but stores the dumped bit. + +UDNMIN==10 ;If UDNAMP is less than this, there is no room for another filename block. + +;In each filename block, the UNFN1, UNFN2, UNDATE and UNREF words are +;just as in UFDs. The UNRNDM word is slightly different: + +LUNBLK==5 ;Number of words in each filename block. +UNFN1==0 ;First file name. +UNFN2==1 ;Second file name. +UNRNDM==2 ;All kinds of random info: + ;The RH is the address in the file of the start of the file's data area header. + ;The LH contains these bits: + UNWRIT==4 ;Open for writing. Not actually maintained in the archive, + ;Just reflected to the user when he reads ARC:.FILE. (DIR). + UNCDEL==20 ;Delete this file when it is closed. + UNIGFL==24 ;Bits to ignore file + UNWRDC==301200,, ;Word count of last block mod 2000. + ;This information really lives in UHWCNT, and is just reflected + ;here when the user reads the image directory. +UNDATE==3 ;Date and time file last modified. + UNTIM==2200,, ;Compacted time of creation + UNYMD==222000,, ;Y,M,D of creation + UNMON==270400,, ;Month + UNDAY==220500,, ;Day + UNYRB==330700,, ;Year +UNREF==4 ;Reference date same as left half of undate + UNREFD==222000,, ;Reference date byte pointer + UNAUTH==111100,, ;MFD index of author, all 1=> no directory. + UNBYTE==001100,, ;File byte size and length info. + ;LET S=BITS PER BYTE, C=COUNT OF UNUSED BYTES IN LAST WD + ;400+100xS+C S=1 TO 3 C=0 TO 35. + ;200+20xS+C S=4 TO 7 C=0 TO 8 + ;44+4xS+C S=8 TO 18. C=0 TO 3 + ;44-S S=19. TO 36. C=0 + ;NOTE THAT OLD FILES HAVE UNBYTE=0 => S=36. + + +;The data of a file starts with two words of header information: +UHWCNT==0 ;Total length of the file's data, including header, in words. +UHREFC==1 ;RH: Number of archives using the file, in either direction. + ;LH: -1 if file open for writing. +UHNAMP==2 ;Unused +UHBLEN==3 ;Length of this header; offset to 1st actual data word. + diff --git a/src/syseng/arcdev.69 b/src/syseng/arcdev.69 new file mode 100755 index 00000000..2c0a8043 --- /dev/null +++ b/src/syseng/arcdev.69 @@ -0,0 +1,1962 @@ +;-*-MIDAS-*- + +TITLE BOJ JOB ARCDEV + +VERSIO==.FNAM2 + + +A=1 +B=2 +C=3 +D=4 +E=5 +TT=6 +INT=7 ;FLAG FOR INTERRUPT, -1 INT HAPPENED +Q=10 +J=11 +I=12 +W=13 +H=14 +P=15 +T=16 +U=17 + +CH==,,-1 ;BIT TYPEOUT MODE MASK FOR I/O CHANNEL NAMES. + +CHBOJ==1 +CHDSK==2 +CHSALV==3 + +IOCEOF==8 ;IOCERROR CODE FOR EOF. + +;Temporary until they're predefined in MIDAS. +%CBLOK==2000 ; 4.2 LOCK PAGE IN CORE. +%CBULK==1000 ; 4.1 UNLOCK PAGE (ALLOW SWAP-OUT) + +DEFINE PAUSE + MOVEI TT,10.*30. + .SLEEP TT, +TERMIN + +DEFINE SYSCAL NAME,ARGS + .CALL [ SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] +TERMIN + +LOC 42 + JSR TSINT +SWTLST: 0 ;This is the locked switch list, used to undo AOS's if we are killed. + -CRITLN,CRITTB ;This points to the critical routine table. + +LOC 77 +SIXBIT /ARCDEV/ +RDEVN: BLOCK 3 ;Real filenames of file open in creator's channel on the archive device. +RDIRN: 0 +ACCP: 0 ;Access pointer in open file, as byte # of next byte to transfer. +DIRECTN:0 ;-1 if direction is Output. +CRUNAM: 0 ;creator's uname. +CRJNAM: 0 ;creator's jname. +FILLEN: 0 ;File length, in bytes of size now open in, + ;or -1 => FILLEN, FILBLN and FILBSZ not known. +BYTSIZ: 0 ;Byte size channel is open in. +FILBLN: 0 ;File length, in bytes of size file was written in. +FILBSZ: 0 ;Byte size file was written in. + +;;; From 77 to here is looked at by PEEK. + +AFDEV: 0 ;Real Device (the machine name) and FN2 of the archive file. +AFFN2: 0 ;(the real FN1 and SNAME are in RDEVN and RDIRN). +FILADR: 0 ;Address in core of start of file's data area (actually, start of header). + ;Zero only if no file is open. +DIRFLG: 0 ;-1 => reading the directory rather than a file. +ACCBP: 0 ;byte pointer for I/O to file. Always agrees with ACCP. P-field mustn't be 44 +BYTSWD: 0 ;number of bytes per word in file. +FILRND: 0 ;# of bytes that fit in space allocated to file. + ;bytes past this one exist only on output, when we are extending the file, + ;and they live starting at NEWDAT rather than in the archive. + +OPMODE: 0 ;Mode creator opened us in. +CRDATE: 0 ;Creation date of open file. +REFDAT: 0 ;Reference date of open file. +DATUPD: 0 ;-1 if CRDATE or REFDAT has been set and UNDATE, UNREF need to be updated. +OFILLE: 0 ;Value of FILLEN before we changed it by .IOTing to extend the file. +ORFDAT: 0 ;Old reference date, so RESRDT system call can set it back. +ERCD: 0 ;Error code saved here by some system calls. +ARCCDT: 0 ;Creation date of archive device, saved for first call to LOCK + ;(because at that time the archive device pages aren't mapped yet. + ;-1 after archive is mapped in and we should look in ARCADR+UDCDAT +ARCDMP: 0 ;Dumped bit of archive device, saved over first LOCK, or -1 thereafter. + +RNDM: BLOCK 5 ;Temp storage used for return values of FILBLK. + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +;START HERE. +GO: MOVE P,[-LPDLL-1,,PDL-1] + .SUSET [.SMASK,,[%PIMPV+%PIIOC]] + SYSCAL USRVAR,[%CLIMM,,%JSELF ? ['OPTION] ? 0 ? [TLO %OPOPC\%OPLOK]] + .LOSE %LSSYS + .OPEN CHBOJ,[17,,'BOJ] + .VALUE + SYSCAL RFNAME,[ + 1000,,CHBOJ + 2000,,0 + 2000,,CRUNAM + 2000,,CRJNAM] + JFCL + .CALL JBGT ;What is the name of the archive device and file? + .VALUE + MOVE A,JBCOP + TLNE A,60000 ;IF HE ALREADY PCLSR'D, GIVE UP, SINCE HE WILL GIVE UP ON US + JRST DIE ;SINCE WE DID A JOBGET AND SAW THAT FACT. + ANDI A,-1 ;NOW .VALUE IF OPCODE IS .IOT - SHOULDN'T HAPPEN, + CAIN A,1 ;BUT DID DUE TO A BUG. + .VALUE + SYSCAL OPEN,[ ;OPEN THE ARCHIVE DEVICE FILE WE ARE SUPPOSED TO USE. + [.BII,,CHDSK] + ['DSK,,] + JBCDEV + [SIXBIT />/] + JBCSNM + %CLERR,,B] + PUSHJ P,ARCINI ;Archive file does not exist => maybe create it. + HRROI A,B + .IOT CHDSK,A + CAME B,[SIXBIT/ARC1!!/] ;If the file isn't recognizable as a current-format archive, + JRST OLDARC ;maybe it's an old-format one. Load the old handler. + SYSCAL RFNAME,[%CLIMM,,CHDSK + %CLOUT,,AFDEV ? %CLOUT,,RDEVN ? %CLOUT,,AFFN2 ? %CLOUT,,RDIRN] + .LOSE %LSFIL + SYSCAL RFDATE,[%CLIMM,,CHDSK ? %CLOUT,,ARCCDT] + .LOSE %LSFIL ;Read the arc dev's creation date before we lock it. + SKIPGE ARCCDT ;If file has none, use current date. + SYSCAL RQDATE,[%CLOUT,,ARCCDT] + JFCL + SKIPGE ARCCDT ;Current date not known either => barf. + .LOSE %LSSYS + SYSCAL RDMPBT,[%CLIMM,,CHDSK ? %CLOUT,,ARCDMP] + .LOSE %LSFIL ;Same for file-dumped-bit. + SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,AFDEV ]] + .LOSE %LSSYS + .CLOSE CHDSK, ;Close our input channel + PUSHJ P,LOCK ;Open an output channel instead, + PUSHJ P,MAPARC ;get all the pages. + MOVE A,ARCCDT ;Store what should be the creation date and dumped bit + MOVEM A,ARCADR+UDCRDT ;of the archive itself inside the archive. + MOVE A,ARCDMP + MOVEM A,ARCADR+UDDMPB + SETOM ARCCDT + SETOM ARCDMP + PUSHJ P,ARCDEL ;Delete any files marked "delete when closed" and not open. + .SUSET [.SMSK2,,[1_CHBOJ]] + JRST GOINIT ;Dispatch to JOPEN or JFDEL with dir still locked. + +WRGDIR: SKIPA A,[%ENSIO] +NSDEV: MOVSI A,%ENSDV + JRST NOGO2 + +PKNMTD: MOVSI A,%ENAPK ;If Pack Not Mounted, say so, and die. + JRST NOGO2 + + +FILXST: MOVSI A,%EEXFL ;File already exists error. + JRST NOGO2 + +DIRFUL: SKIPA A,[%EFLDR] +WTDDIE: MOVSI A,%EBDDV ;Wrong type device on initial operation - report and suicide. +NOGO2: MOVEM A,ERRCOD + MOVEI C,20. +NOGO1: .CALL JBGT + .LOSE %LSFIL ;JOBGET ON INITIAL IS NOT SUPPOSED TO FAIL. + MOVE A,JBCOP + TLNE A,%JGCLS ;HE CLOSED US => WE CAN STOP NOW. + JRST DIE + .CALL JBRT3 ;KEEP TRYING TO RETURN THIS ERROR, IN CASE HE PCLSR'S AND COMES BACK. + SOJG C,[MOVEI B,1 ? .SLEEP B, ? JRST NOGO1] + JRST DIE + +;When an archive device file is in an old format, load in the old archive device handler. +OLDARC: .CLOSE CHBOJ, ;Close both channels. + .IOPUS CHBOJ, ;Push them both, so a single .IOPDL will close both. + .IOPUS CHDSK, + .OPEN CHBOJ,['BOJ] ;Then open them again. + .LOSE %LSSYS + SYSCAL OPEN,[[.UII,,CHDSK] ? ['DSK,,] ? ['OARCDV] ? ['BIN,,] ? ['DEVICE]] + .LOSE %LSFIL + MOVE 17,[LOADER,,0] ;Put the loader in the ACS so we can flush all core. + BLT 17,17 + JRST LOADIT + +LOADER: +OFFSET -. + %ENACR,,0 ;"No Core Available" error code. +CRAPIT::.CALL CRAP ;Do JOBRET to give user the "No Core" error code. + ;If the JOBRET succeeds, we go through the .CORE and + ;then the .CALL LOAD must fail, so we'll get here again; + ;but then we will fail and log out. + .LOGOUT +LOADIT::.CORE 0 ;Flush all core so LOAD will get fresh core. + .LOGOUT + .CALL LOAD ;Load up old-format archive device handler. + JRST CRAPIT + .IOT CHDSK,CRAP ;Read in starting address. + .IOPDL ;Close all I/O channels (which we carefully pushed to this end). +CRAP:: SETZ ;.IOT clobbers this word with a jump to the starting address. + SIXBIT \JOBRET\ + %CLIMM,,CHBOJ +LOAD:: SETZ ;1st wor of LOAD call and last word of JOBRET call. + SIXBIT \LOAD\ + %CLIMM,,%JSELF + 401000,,CHDSK +IFG .-20,.ERR LOADING ROUTINE DOESN'T FIT IN ACS. +OFFSET 0 + +;Here to create an archive file if appropriate and necessary. +ARCINI: CAIN B,%ENAFL ;If we couldn't open the file because it was locked, + JRST [ PAUSE ;wait and try again. + JRST ARCIN1] + CAIN B,%ENAPK ;if pack not mounted, + JRST PKNMTD ;say so and die. + HRRZ A,JBCOP + CAIE A,%JOOPN ;Create only if opening a file + JRST NSDEV + MOVE A,JBCWD6 + TRNN A,1 ;for output + JRST NSDEV + TRNE A,100000 ;and not for write-over. + JRST NSDEV + SYSCAL OPEN,[[.BIO,,CHDSK] ? ['DSK,,] ? JBCDEV ? [SIXBIT />/] ? JBCSNM] + JRST NSDEV ;Can't create file => no such device. + PUSHJ P,GETPAG + SETZM DIRCPY ; INITIALIZE THE OUTPUT BLOCK + MOVE A,[DIRCPY,,DIRCPY+1] + BLT A,DIRCPY+1777 + MOVE A,[SIXBIT /ARC1!!/] + MOVEM A,DIRCPY ; IDENTIFY THIS FILE AS LEGITIMATE ARCHIVE. + MOVEI A,2000 ; POINTER TO NAME AREA OFF THE END + MOVEM A,DIRCPY+UDNAMP + MOVEM A,DIRCPY+UDDATP + MOVE A,[-2000,,DIRCPY] + .IOT CHDSK,A + PUSHJ P,RELPAG +ARCIN1: SOS (P) + SOS (P) ;Return to retry the open which originally failed. +CPOPJ: POPJ P, + +;Upon first accessing an archive, clean up after any damage produced +;by a system crash. +ARCCLN: SYSCAL RQDATE,[ + %CLOUT,,A ;Ignore 1st value + %CLOUT,,A] ;2nd value is time of system startup. + .LOSE %LSSYS + JUMPL A,[ PAUSE ;System doesn't know the time => wait + JRST ARCCLN] ;and hope it finds out the time. + CAMN A,UDINIT+ARCADR ;Has this archive been cleaned since the system came up? + POPJ P, ;Yes. + PUSHJ P,ARCCL1 ;No, it's our task. Set all UHREFC's to 0. + MOVEM A,UDINIT+ARCADR ;Assert that this archive has been initialized + POPJ P, ;since the last system crash. + +ARCCL1: MOVE Q,UDNAMP+ARCADR ;Scan through all filename blocks in the directory. + ADDI Q,ARCADR +ARCCL2: CAIN Q,2000+ARCADR + POPJ P, + HRRZ B,UNRNDM(Q) ;Set the UHREFC word of each file to 0. + SETZM UHREFC+ARCADR(B) + ADDI Q,LUNBLK + JRST ARCCL2 + +;Delete all files marked "delete when closed" which aren't open. Dir already locked. +ARCDEL: PUSHJ P,DIRGE1 ;Get a copy of the directory. + MOVE Q,UDNAMP+ARCADR + ADDI Q,ARCADR + SETZ I, ;I is flag saying whether any files had to be deleted. +ARCDE1: CAIN Q,2000+ARCADR + JRST ARCDE3 + MOVE B,UNRNDM(Q) ;Look at each file. + TLNE B,UNCDEL ;If UNCDEL is set + SKIPE UHREFC+ARCADR(B) ;And the ref count is 0, + JRST ARCDE2 + PUSHJ P,QSQSH0 ;delete its filename block. + SETO I, +ARCDE2: ADDI Q,LUNBLK + JRST ARCDE1 + +ARCDE3: JUMPN I,DIRPU1 ;If any files are being deleted, write back the directory. + POPJ P, + +;If no files are open in this archive, and there is at least 1K of garbage, +;rewrite the archive to compress it. +ARCSAL: PUSHJ P,DIRWST + JUMPN C,CPOPJ ;Do nothing if files are open, + CAIGE B,2000 ;of if there isn't much garbage to clean up. + POPJ P, + SYSCAL OPEN,[[.BIO,,CHSALV] ? ['DSK,,] ? ['_ARCSA] ? ['OUTPUT] ? RDIRN] + POPJ P, + MOVE A,[-2000,,ARCADR] + .IOT CHSALV,A ;Write out the old directory, + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000 + %CLIMM,,CHSALV ? %CLIMM,,0] ;then map that page in so we can update it. + JSR CBKLOS +;Now write out the data areas of all files, one by one, +;and make the copy's directory point at them. + MOVE Q,UDNAMP+ARCADR + ADDI Q,ARCADR + MOVEI D,2000 ;D is a running pointer into the copy's data area. +ARCSA1: CAIN Q,2000+ARCADR + JRST ARCSA2 + HRRZ B,UNRNDM(Q) + ADDI B,ARCADR ;Get address of next file's data area. + MOVN C,(B) + HRL B,C ;Get an AOBJN pointer to that data area. + .IOT CHSALV,B ;Write it into the copy. + HRRM D,UNRNDM+DIRCPY-ARCADR(Q) ;Make copy's directory point at it. + SUB D,C ;Advance D to be right for the next file we copy. + ADDI Q,LUNBLK + JRST ARCSA1 + +ARCSA2: MOVEM D,UDDATP+DIRCPY ;Store size of copy's data area into the copy. +;Now the copy is fully written. Replace the old archive device file with it. + SYSCAL RFNAME,[%CLIMM,,CHDSK ? %CLOUT,,A ? %CLOUT,,B ? %CLOUT,,C] + .LOSE %LSFIL + SYSCAL RENMWO,[%CLIMM,,CHSALV ? B ? C] + .LOSE %LSFIL + SYSCAL DELEWO,[%CLIMM,,CHDSK] + .LOSE %LSSYS + .CLOSE CHDSK, + .CLOSE CHSALV, + POPJ P, + +;Compute in B the total number of words used by all files' data areas. +;Return C nonzero if any files in this archive are open. +DIRWST: MOVE Q,UDNAMP+ARCADR + SETZB B,C +DIRWSF: CAIN Q,2000 + JRST DIRWS2 + MOVE A,UNRNDM+ARCADR(Q) + ADD B,UHWCNT+ARCADR(A) + IOR C,UHREFC+ARCADR(A) + ADDI Q,LUNBLK + JRST DIRWSF + +DIRWS2: MOVNS B ;B has number of used words in the data area. + ADD B,UDDATP+ARCADR ;Subtract from total size to get number of wasted words, + SUBI B,2000 ;but don't count the directory as wasted. + POPJ P, + +;Archive device format: + +;The first page of an archive device file is its directory. +;The remaining pages are data. + +;The directory may not even be looked at unless the archive is "locked". +.SEE LOCK,UNLOCK ;Only one ARCDEV can lock a given archive at a time. +;Shuffling the directory should not be done in place, even when it is locked. +;Instead, use DIRGET to make a copy and DIRPUT to store the copy back in. +;When a file is open, the address of its data area is remembered in FILADR. +;The data area of a file never moves, and the file can be open only in one +;direction at a time, so reading or writing the data area requires no interlocking. + +;The format of the archive device directory is approximately that of +;an I.T.S. UFD. The differences are: + +;In the fixed header, word 0 (UDESCP) contains SIXBIT /ARC1!!/ +;Word 1 points to the beginning of the name area, as in UFDs. +;Word 2 points to the end of the data area. +;Word 3 is used to tell when the archive needs to be cleaned +; because it is being touched for the first time since the system came up. +;Word 4 contains what is supposed to be the creation date of the archive. +; Since locking the archive device clobbers the creation date, +; we store it here so we can restore it after clobbering it. +;Word 5 similarly stores the dumped bit. + +;There is nothing analogous to the "descriptors" in a disk UFD. + + ;Random info in UFD +UDESCP==0 ;SIXBIT /ARC1!!/ +UDNAMP==1 ;Address in directory of first filename block. +UDDATP==2 ;Address of first free word past data area of last file. +UDINIT==3 ;Time of startup of last run of system during which this + ;archive was cleaned (ARCCLN). If not same as startup time + ;of this run of the system, we must do ARCCLN. +UDCRDT==4 ;This word holds what ought to be the creation date + ;of the archive device file itself. + ;0 => this archive antedates the UDCRDT word, in which + ;case it gets set from today's date. +UDDMPB==5 ;This is like UDCRDT but stores the dumped bit. + +UDNMIN==10 ;If UDNAMP is less than this, there is no room for another filename block. + +;In each filename block, the UNFN1, UNFN2, UNDATE and UNREF words are +;just as in UFDs. The UNRNDM word is slightly different: + +LUNBLK==5 ;Number of words in each filename block. +UNFN1==0 ;First file name. +UNFN2==1 ;Second file name. +UNRNDM==2 ;All kinds of random info: + ;The RH is the address in the file of the start of the file's data area header. + ;The LH contains these bits: + UNWRIT==4 ;Open for writing. Not actually maintained in the archive, + ;Just reflected to the user when he reads ARC:.FILE. (DIR). + UNCDEL==20 ;Delete this file when it is closed. + UNIGFL==24 ;Bits to ignore file + UNWRDC==301200,, ;Word count of last block mod 2000. + ;This information really lives in UHWCNT, and is just reflected + ;here when the user reads the image directory. +UNDATE==3 ;Date and time file last modified. + UNTIM==2200,, ;Compacted time of creation + UNYMD==222000,, ;Y,M,D of creation + UNMON==270400,, ;Month + UNDAY==220500,, ;Day + UNYRB==330700,, ;Year +UNREF==4 ;Reference date same as left half of undate + UNREFD==222000,, ;Reference date byte pointer + UNAUTH==111100,, ;MFD index of author, all 1=> no directory. + UNBYTE==001100,, ;File byte size and length info. + ;LET S=BITS PER BYTE, C=COUNT OF UNUSED BYTES IN LAST WD + ;400+100xS+C S=1 TO 3 C=0 TO 35. + ;200+20xS+C S=4 TO 7 C=0 TO 8 + ;44+4xS+C S=8 TO 18. C=0 TO 3 + ;44-S S=19. TO 36. C=0 + ;NOTE THAT OLD FILES HAVE UNBYTE=0 => S=36. + + +;The data of a file starts with two words of header information: +UHWCNT==0 ;Total length of the file's data, including header, in words. +UHREFC==1 ;RH: Number of archives using the file, in either direction. + ;LH: -1 if file open for writing. +UHNAMP==2 ;Unused +UHBLEN==3 ;Length of this header; offset to 1st actual data word. + +GOL: SKIPL INT ;THERE ARE NO INTERRUPTS => WAIT QUIETLY. + .HANG +GOLOOP: SETZM INT ;HERE TO SERVICE ANY INTERRUPTS THERE ARE. + .CALL JBGT + JRST GOL +GOINIT: MOVE B,JBCOP + TLNE B,%JGCLS + JRST JCLS + LDB A,[000400,,JBCOP] + TLNE B,%JGFPD ;IF THIS IS A RETRY OF A CALL THAT PCLSR'ED, + JRST RETRY ;GIVE IT THE SAME JOBRET WE TRIED TO GIVE LAST TIME. +RETRYR: SETZM PCLSRD ;WE CAN'T MANAGE TO HANDLE A RETRY AFTER ANYTHING ELSE HAPPENS. + CAILE A,7 + JRST JSYSCL ; HANDLE A .CALL + JRST @DISP(A) + +DISP: JOPEN + JIOT + WTDDIE ;Mlink isn't allowed. + JRESET + JRCH + JACC + JFDELE + JRNMWO + +;HERE WHEN CREATOR GIVES US A SYSTEM CALL AND SAYS IT'S A RETRY. +RETRY: AOSE PCLSRD ;IF WE HADN'T SEEN THE SYSTEM CALL THE FIRST TIME, + JRST RETRYR ;TREAT IT AS NEW. + MOVE B,LJBRTA ;IF WE FINISHED HANDLING IT AND OUR JOBRET FAILED, + JRST -2(B) ;GIVE HIM THE SAME JOBRET AGAIN. + +PCLSR: POP P,LJBRTA ;FOLLOW EVERY JOBRET WITH A PUSHJ P,PCLSR. +PCLSR1: SETOM PCLSRD ;A FAILING JOBRET INDICATES THAT CREATOR WAS PCLSRD AND WE SHOULD + JRST GOLOOP ;EXPECT HIM TO RETRY HIS SYSTEM CALL. + +PCL==PUSHJ P,PCLSR + +LJBRTA: 0 ;2 PLUS ADDRESS OF LAST FAILING JOBRET. +PCLSRD: 0 ;-1 => OUR LAST JOBRET FAILED, SO EXPECT A RESTARTED SYSTEM CALL. + +;Get a page of core at address DIRCPY +GETPAG: SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000 ? %CLIMM,,%JSNEW] + JSR CBKLOS + POPJ P, + +;JSR CBKLOS after a CORBLK which can possibly get NO CORE AVAILABLE. +;If that happens, we sleep and retry. Otherwise, we LOSE. +CBKLOS: 0 + SOS CBKLOS + SOS CBKLOS ;Get address of the CORBLK which failed. + PUSH P,A + .STATUS 0,A + LDB A,[220600,,A] + CAIE A,%ENACR ;If not NO CORE AVAILABLE, pretend we did a .LOSE. + JRST [ POP P,A + SYSCAL LOSE,[ %CLIMM,,%LSSYS ? CBKLOS]] + MOVEI A,300. ;If NO CORE AVAILABLE, wait 10 seconds and return + .SLEEP A, ;to the failing CORBLK to retry it. + JRST @CBKLOS + +;Release the page. +RELPAG: SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000] + .LOSE %LSSYS + POPJ P, + +;Lock the archibve directory and core allocation by opening the file for write-over. +;This also enables us to extend the archive file. +;Also, return in Q the address of the filename block for the file whose +;data header address is in FILADR, if there is one. +;Note: follow a LOCK with a MAPARC, unless you are damned sure +;that you won't reference anything outside the directory. +;Anything which might look at the header for a file other than the one which is open +;might look at a file which was created since your last MAPARC. +LOCK: SYSCAL OPEN,[[100000+.BIO,,CHDSK] ? AFDEV ? RDEVN ? AFFN2 ? RDIRN + %CLERR,,TT] + JRST LOCKWT + SKIPGE Q,ARCCDT + MOVE Q,ARCADR+UDCRDT + SYSCAL SFDATE,[%CLIMM,,CHDSK ? Q] ;Restore the arc dev's creation date + .LOSE %LSFIL ;which was clobbered by the OPEN just done. + SKIPGE Q,ARCDMP + MOVE Q,ARCADR+UDDMPB + SYSCAL SDMPBT,[%CLIMM,,CHDSK ? Q] ;Restore the arc dev's dumped bit + .LOSE %LSFIL ;which was clobbered by the OPEN just done. + SKIPN FILADR + POPJ P, + MOVE Q,ARCADR+UDNAMP + ADDI Q,ARCADR +LOCK1: CAIN Q,ARCADR+2000 + .LOSE ;File no longer has a filename block pointing to it? + HRRZ TT,UNRNDM(Q) + ADDI TT,ARCADR + CAMN TT,FILADR + POPJ P, + ADDI Q,LUNBLK + JRST LOCK1 + +LOCKWT: CAIE TT,%ENAFL + .LOSE + PAUSE + JRST LOCK + +UNLOCK: .CLOSE CHDSK, + POPJ P, + +;Map in the pages of the archive file starting at ARCADR. +;We assume that CHDSK is open. +MAPARC: PUSH P,A + PUSH P,B + PUSH P,C + SYSCAL FILLEN,[%CLIMM,,CHDSK ? %CLOUT,,A] + .LOSE %LSFIL + MOVE C,A + CAILE A,ARCMAX ;Barf if archive file is bigger than address space allocated. + .LOSE + ADDI A,1777 + LSH A,-10. + MOVNS A + HRLZS A + HRRI A,ARCADR/2000 + SETZ B, + SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHDSK ? B ? %CLERR,,ERCD] + JSR CBKLOS + POP P,C + JRST POPBAJ + +;Make a copy of the archive directory in DIRCPY so we can move filename blocks around. +DIRGET: PUSHJ P,LOCK +DIRGE1: PUSHJ P,GETPAG + MOVE TT,[ARCADR,,DIRCPY] + BLT TT,DIRCPY+1777 + POPJ P, + +;Store the updated archive directory from DIRCPY into the archive, carefully. +DIRPUT: PUSHJ P,DIRPU1 + JRST UNLOCK + +;This should really use PGEXCH, whenever that exists. +DIRPU1: MOVE TT,[DIRCPY,,ARCADR] + BLT TT,ARCADR+1777 + JRST RELPAG + +;When the archive device is "written" as it appears to the user, call this +;routine to update the creation date and clear the dumped bit. +;Archive must be locked. +ARCWRT: SYSCAL RQDATE,[%CLOUT,,ARCADR+UDCRDT] + .LOSE %LSSYS + SETZM ARCADR+UDDMPB + SYSCAL SFDATE,[%CLIMM,,CHDSK ? ARCADR+UDCRDT] + .LOSE %LSFIL + SYSCAL SDMPBT,[%CLIMM,,CHDSK ? ARCADR+UDDMPB] + .LOSE %LSFIL + POPJ P, + +;OPEN operation. This is an initial operation, done with no JOB channel open yet, +;so the dir is still locked from the initialization. +JOPEN: LDB W,[410100,,JBCOP] ;0 => INPUT 1 => OUTPUT + MOVEM W,DIRECTN + MOVE A,JBCWD6 ;SAVE OPEN-MODE. + MOVEM A,OPMODE + TRNE A,6 ; SKIP IF CHARACTER MODE + SKIPA A,[44] ; BLOCK OR IMAGE + MOVEI A,7 + MOVEM A,BYTSIZ + MOVEI B,44 + IDIVM B,A + MOVEM A,BYTSWD + HRLZ A,OPMODE ; GET OPEN MODE + TLZ A,777770 ; ISOLATE BASIC OPEN MODES + TLC A,1 ; COMPLEMENT READ/WRITE MODE + TLO A,10 ; MAKE SURE OPPOSITE DIRECTION BIT IS ON + HRRI A,(SIXBIT/BOJ/) + .OPEN CHBOJ,A ; OPEN BOJ IN THE CORRECT MODE + .VALUE + MOVE A,JBCFN1 ; MY KIND OF ARCHIVE + MOVE B,JBCFN2 ; SEE IF HE ASKED FOR DIRECTORY + CAMN A,[SIXBIT/.FILE./] + CAME B,[SIXBIT/(DIR)/] + JRST FILOPN ; NO - GO OPEN THE FILE + SETOM DIRFLG ; SET DIRECTORY OPEN FLAG + MOVE C,OPMODE ; GET OPEN MODE + TRNE C,777771 ; OPEN FOR WRITING? + JRST WRGDIR ; WRONG DIRECTION - LOSE + MOVEM A,RDEVN+1 + MOVEM B,RDEVN+2 + .CALL JBST ;Report file being operated on as .FILE. (DIR) + JFCL + PUSHJ P,DIRGE1 ;Get a copy of the directory. + MOVE A,DIRCPY+UDNAMP + MOVSI C,UNWRIT ;Set the UNWRIT bit in the copy for each file +JOPNC2: CAIL A,2000 ;which is being written now. + JRST JOPNC3 + HRRZ B,UNRNDM+DIRCPY(A) + SKIPGE UHREFC+ARCADR(B) + IORM C,UNRNDM+DIRCPY(A) + MOVE D,UHWCNT+ARCADR(B) + SUBI D,UHBLEN ;Also store the number of words in the last K + DPB D,[UNWRDC,,UNRNDM(B)] ;in the UNWRDC field in the filename block. + ADDI A,LUNBLK + JRST JOPNC2 + +JOPNC3: PUSHJ P,UNLOCK + MOVE A,OPMODE + TRNE A,4 ; ascii or image directory? + JRST [ MOVE A,[004400,,DIRCPY-1] + MOVEM A,ACCBP ;For image directory, just read straight out of our copy. + MOVEI A,2000 + MOVEM A,FILLEN + MOVEM A,FILBLN + MOVEI A,44 + MOVEM A,FILBSZ + JRST OPNWIN] + PUSHJ P,DIRASC ;For ASCII directory, create the text starting at NEWDAT-1 + MOVE A,FILBLN ;Length (in chars) left in FILBLN. + IDIVI A,5 ;Set up for FILCP1. + MOVNS B + ADDI B,5 + CAIN B,5 ;B gets number of free bytes in last word. + SETZ B, + MOVE D,FILBLN + ADDI D,4 + IDIVI D,5 ;D gets number of words. + MOVEI A,7 ;A gets byte size. + MOVEM A,FILBSZ + PUSHJ P,FILCP1 ;Set up FILLEN. + MOVE A,[010700,,NEWDAT-1] + MOVEM A,ACCBP ;and start reading it. +OPNWIN: MOVE A,FILLEN ;keep track of whether we extend the file at all + MOVEM A,OFILLEN ;(whether FILLEN changes). + SETZM ACCP + .CALL JBRT1 + PUSHJ P,IJBRTF + JRST GOLOOP + +IJBRTF: MOVEI A,30. ;IF INITIAL JOBRET FAILS, WAIT A WHILE BEFORE JOBGETING, + .SLEEP A, ;SINCE IF WE JOBGET BEFORE HE RETRIES WE WILL READ A CLOSE + JRST PCLSR ;AND GIVE UP, AND HE WILL DO WHATEVER IT IS TWICE. + + +; FILOPN - Come here to open a sub-file in the archive. +; The archive's directory is still locked from start-up. + +FILOPN: MOVE C,OPMODE ; GET OPEN MODE + TRNE C,1 ; OPEN FOR READING? + JRST OPNWRT ; NO - GO OPEN FOR WRITING + MOVE A,JBCFN1 + MOVE B,JBCFN2 + PUSHJ P,QLOOK ; ATTEMPT A LOOK UP + JRST RDFNF ; FILE NOT FOUND + PUSHJ P,FILCPT ; Compute file length in byte size open in. +FILOP0: HRRZ B,UNRNDM(Q) + ADDI B,ARCADR + MOVEM B,FILADR + MOVEI A,UHREFC(B) + MOVEM A,HRZBLK + MOVEM A,SOSBLK +CRIT1A: AOS UHREFC(B) ; Update file reference count + MOVEI A,SOSBLK +CRIT1B: MOVEM A,SWTLST + SKIPE DIRECTN + HRROS UHREFC(B) ; and whether the file is open for writing. +CRIT2A: MOVEI A,HRZBLK + MOVEM A,SWTLST +CRIT2B: JRST FILOP3 + +;These two blocks form the locked switch list +HRZBLK: 0 ;This word gets the UHREFC word's address. + HRRZS @SOSBLK ;This block undoes the HRROS, if there was one. + +SOSBLK: 0 ;This word gets the UHREFC word's address. + SOS @ ;This block undoes the AOS, if there was one. + +;The critical code table undoes things if we are in the middle of +;setting up the locked switch list. +CRITTB: CRIT1A,,CRIT1B + SOS @SOSBLK ;These can be indirect but can't be indexed! + CRIT2A,,CRIT2B + HRRZS @SOSBLK + CRIT3A,,CRIT3B + SOS @SOSBLK +CRITLN==.-CRITTB + +FILOP3: MOVE A,UNFN1(Q) ; STORE REAL INFO ABOUT THE FILE + MOVEM A,RDEVN+1 + MOVE A,UNFN2(Q) + MOVEM A,RDEVN+2 + .CALL JBST ; GIVE REAL NAMES TO SYS + JFCL + MOVE A,BYTSIZ ; Create B.P. to ILDB the first byte of the file. + LSH A,30 + HRR A,FILADR + ADDI A,UHBLEN-1 + MOVEM A,ACCBP + MOVE A,UNREF(Q) ; REFERENCE DATE + MOVEM A,ORFDAT + HLLZ B,A ; SAVE ISOLATED REFERENCE DATE + MOVE A,OPMODE ; DOES HE WANT REFERENCE DATE UPDATED + TRNE A,10 ; IF 3.4=1 - DON'T CHANGE REFERENCE DATE + JRST FILOP5 + SYSCAL RQDATE,[%CLOUT,,A] ; NOW UPDATE REFERENCE DATE + SETZM A + HLLZS A + CAMN A,B ; HAS REFERENCE DATE CHANGED? + JRST FILOP5 ; NO - DON'T CHANGE THE PAGE + HLLM A,UNREF(Q) ; UPDATE DIRECTORY +FILOP5: MOVE A,UNDATE(Q) + MOVEM A,CRDATE ; Remember the file's dates in our memory + HLLZ A,UNREF(Q) ; so we can return and set them without locking the directory. + MOVEM A,REFDATE + SETZM DATUPD + LDB A,[UNBYTE,,UNREF(Q)] + PUSHJ P,BDEC ; Now remember the file's written byte size + MOVEM B,FILBSZ ; and how many bytes of that size it has. + MOVEI J,44 + IDIV J,B ; J gets # bytes per word. + MOVE D,@FILADR + SUBI D,UHBLEN ; D gets number of words + IMUL D,J ; Convert to bytes. + SUB D,A ; less bytes which are free + MOVEM B,FILBLN ; gives number of bytes, in file byte size. + SKIPE DIRECTN + PUSHJ P,ARCWRT ; Set archive creation date and dumped bit, if writing. + PUSHJ P,UNLOCK + JRST OPNWIN ; DONE - OPEN HAS WON + +; FILE NOT FOUND - CHECK TO SEE IF BECAUSE OPEN FOR WRITING? + +RDFNF: HRLZI A,%ENSFL ; BE PREPARED TO REPORT FNF + ADDI Q,5 ; ON FNF Q POINTS TO ENTRY BEFORE + ; MATCH IF THERE WAS ONE + CAIL Q,ARCADR ; SO SEE IF (Q)+5 IS IN BOUNDS + CAIL Q,ARCADR+2000 + JRST NOGO2 + CAMN A,UNFN1(Q) ; SEE IF THE FILE NAMES MATCH + CAME B,UNFN2(Q) + JRST NOGO2 ; NO - REALLY A FNF + HRLZI A,%ENAFL ; - REPORT FILE LOCKED INSTEAD OF FNF + JRST NOGO2 + +;Compute file's length in bytes of the size it is open for. +;Set up FILLEN and FILRND. Assume that BYTSIZ and BYTSWD are set up. +;Also, return in A and B what BDEC returns (for byte size remembered by file). +FILCPT: LDB A,[UNBYTE,,UNREF(Q)] + PUSHJ P,BDEC ; Extract byte size of file, and # free bytes in last word. + MOVE C,UNRNDM(Q) + MOVE D,UHWCNT+ARCADR(C) ; Get length in words. + SUBI D,UHBLEN +FILCP1: MOVE E,A + IMUL E,B ; Number of free BITS in last word. + MOVE W,D + IMUL W,BYTSWD ; Number of bytes of size file is open in, including WHOLE last word. + MOVEM W,FILRND + IDIV E,BYTSIZ ; Number of free bytes of size open in in last word. + SUB W,E ; File's length in size open in. + MOVEM W,FILLEN + POPJ P, + +;Get in B the byte size of the current file, +;and in A the number of unused bytes in the last word. +;Assume that A contains the UNBYTE field for the file. +.SEE UNBYTE ;Comments there explain this code. +BDEC: TRNN A,400 + JRST BDEC1 + LDB B,[060200,,A] + ANDI A,77 + POPJ P, + +BDEC1: TRNN A,200 + JRST BDEC2 + LDB B,[040300,,A] + ANDI A,17 + POPJ P, + +BDEC2: CAIG A,44 + JRST BDEC3 + SUBI A,44 + LDB B,[020600,,A] + ANDI A,3 + POPJ P, + +BDEC3: MOVEI B,44 + SUB B,A + MOVEI A,0 + POPJ P, + +;Update the UNBYTE fiels of the open file's directory entry +;according to what BYTSIZ and FILLEN and FILRND say. +;Assume that Q points at the file's 5-word directory entry +BENC: MOVE B,BYTSIZ + MOVE A,FILRND + SUB A,FILLEN ;B has byte size, A has # free bytes in last word. + CAIGE B,19. ;Now do a backwards BDEC, producing result in A. + JRST BENC1 + MOVEI A,44 + SUB A,B + JRST BENC9 + +BENC1: CAIGE B,8 + JRST BENC2 + LSH B,2 + ADDI A,44(B) + JRST BENC9 + +BENC2: CAIGE B,4 + JRST BENC3 + LSH B,4 + ADDI A,200(B) + JRST BENC9 + +BENC3: LSH B,6 + ADDI A,400(B) +BENC9: DPB A,[UNBYTE,,UNREF(Q)] + POPJ P, + +; HANDLE OPENS FOR OUTPUT + +; OPNWRT - OPEN FOR WRITE OR WRITE OVER + +OPNWRT: LDB C,[170300,,OPMODE] ; GET EXTRA MODE BITS + CAIE C,1 ; OPEN FOR WRITE-OVER? + JRST OPNOUT ; NO - GO OPEN FOR OUTPUT + PUSHJ P,QLOOK ; DO LOOK TO SEE IF ALREADY EXISTS + JRST RDFNF ; NO - GO SEE WHY + PUSHJ P,FILCPT ; Set up FILLEN and FILRND. + MOVE A,FILLEN + MOVEM A,FILBLN + PUSHJ P,BENC ; So update the file's UNBYTE field in the directory. +OPNWR1: MOVE A,BYTSIZ + MOVEM A,FILBSZ ; Since we are writing, the file's byte size is set to ours. + .CALL GDATE + SETO A, + MOVEM A,UNDATE(Q) + JRST FILOP0 ; GO COMPLETE THE OPEN + +; OPNOUT - OPEN NEW FILE FOR OUTPUT + +OPNOUT: PUSHJ P,QFNG ; FIXUP ">" AND "<" IF ANY + JFCL ; DON'T CARE IF FAIL (DINSRT KNOWS WHAT TO DO) + PUSHJ P,DINSRT ; MAKE NEW DIRECTORY ENTRY + SETZM FILLEN ; A new file's length is 0, in all units. + SETZM FILRND + SETZM FILBLN + SETZM UNREF(Q) + MOVE D,UDDATP+ARCADR ;Create a header with zero data words so things will look OK, + HRRM D,UNRNDM(Q) ;and make filename block point at it. + MOVEI J,3 ;Construct the header in J thru J+2 + SETZB J+1,J+2 + MOVE C,[-3,,J] + PUSHJ P,JFRCIOT ;And output it, using BLT if page already exists. + JUMPG TT,OPNOU1 + SYSCAL FINISH,[%CLIMM,,CHDSK] + .LOSE %LSFIL + PUSHJ P,MAPARC ;maybe that gobbled an additional page, so map all pages again. +OPNOU1: MOVEI A,3 ;Remember that data area is 3 words bigger now. + ADDM A,UDDATP+ARCADR + JRST OPNWR1 + +GDATE: SETZ ; CALL TO GET FUNNY FORMAT DATE + SIXBIT/RQDATE/ + SETZM A + +; DINSRT - ROUTINE TO INSERT A NEW ENTRY INTO A DIRECTORY +; TAKES FILE NAMES IN A AND B. + +DINSRT: PUSH P,A ; SAVE FILE NAMES + PUSH P,B +DINSR1: MOVE TT,UDNAMP+ARCADR + CAIGE TT,UDNMIN + JRST DIRFUL + PUSHJ P,DIRGE1 ; Copy the directory out of the archive (which stays locked). + PUSHJ P,DINSR2 ; In sert an entry in the copy, and store filenames from A, B. + SETZM UNRNDM(Q) ; Initialze random info + .CALL GDATE ; Get current date and time + SETO A, + MOVEM A,UNDATE(Q) ; Store as file creation date, + HLLZM A,UNREF(Q) ; and as file reference date. + PUSHJ P,DIRPU1 ; Write the directory back into the archive. + SUBI Q,DIRCPY-ARCADR +POPBAJ: POP P,B +POPAJ: POP P,A + POPJ P, + +DINSR2: PUSHJ P,QLGLKB ; DO THE LOOKUP + MOVEI J,DIRCPY+2000 ; DIRECTORY EMPTY + MOVE Q,J + MOVEI C,-DIRCPY-5(Q) ; GET INDEX TO NEW NAME AREA SLOT + CAML C,DIRCPY+UDNAMP ; FARTHER BACK THAN POINTER? + JRST DINSR6 ; NO - GO AHEAD + MOVEM C,DIRCPY+UDNAMP ; UPDATE INDEX + JRST DINSR4 ; AND DON'T BLT + +DINSR6: SKIPN -LUNBLK(Q) ; SEE IF ENTRY ZERO OR IF BLT NEEDED + JRST DINSR4 ; MUST HAVE BEEN DELETED - NO BLT + MOVE C,DIRCPY+UDNAMP ; NEED TO BLT - BUILD BLT POINTER + ADDI C,DIRCPY ; GET ADDRESS OF START OF NAME AREA + HRLS C ; PUT IN BOTH HALVES OF C + SUBI C,LUNBLK ; BLT UP ONE NAME BLOCK + BLT C,-LUNBLK-1(Q) ; MAKE ROOM + MOVE C,DIRCPY+UDNAMP ; UPDATE START POINTER + SUBI C,LUNBLK + MOVEM C,DIRCPY+UDNAMP +DINSR4: SUBI Q,LUNBLK ; BACK UP TO EMPTY ENTRY +DINSR5: MOVEM A,UNFN1(Q) ; STORE NEW INFORMATION + MOVEM B,UNFN2(Q) + POPJ P, + +QFNG: SKIPA C,[SETZ] ;GENERATE FILE NAME TO REPLACE < OR > ON WRITE +QLOOK: MOVEI C,0 + PUSH P,J ;Q_FILE # + MOVEI J,ARCADR ;GET POINTER TO SHARED COPY OF DIRECTOYR + MOVEI Q,2000-LUNBLK(J) + ADD J,UDNAMP(J) + CAMN A,[SIXBIT />/] + TLOA J,400000 + CAMN A,[SIXBIT / + CAMN B,[SIXBIT />/] + TLOA J,400000 + CAMN B,[SIXBIT / return non-skip, + JRST QLK3 ;causing File Not Found or File Locked. + MOVE C,UNRNDM(Q) + SKIPL UHREFC+ARCADR(C) + TLNE C,UNCDEL + CAIA + JRST QLK2 ;Found one with no "*" => return skipping. + SUBI Q,LUNBLK + CAML Q,J + JRST QLK1 +QLK3: POP P,C +POPJJ: POP P,J + POPJ P, + +QLK2: AOS -2(P) + JRST QLK3 + +;Look up names containing a > or <. + +QLOOKA: CAME B,[SIXBIT //] + JRST POPJJ ;MUST BE READ RETN FILE NOT FOUND +QLOOK1: PUSH P,D + PUSH P,TT + PUSH P,I + PUSH P,[-1] ;BEST INDEX + PUSH P,[SETZ] ;BEST "NUMERIC" PART + PUSH P,[SETZ] ;BEST ALPHA PART +QLOOK4: CAIGE Q,(J) + JRST QLOOK2 + MOVE D,UNRNDM(Q) + TLNE D,UNIGFL + JUMPGE C,QLOOK3 ;IF CONJURING NAME FOR WRITE, CONSIDER ALL + XCT QLKI1(C) + JRST QLOOK3 + SKIPE TT,@QLKI1+1(C) +QLOOK6: TRNE TT,77 ;RIGHT ADJ + JRST QLOOK5 + LSH TT,-6 + JRST QLOOK6 +QLOOK5: MOVEI I,0 +QLOOK8: LDB D,[600,,TT] + CAIL D,'0 + CAILE D,'9 + JRST QLOOK7 ;NOT A DIGIT +QLOK5B: TRNE I,77 ;RIGHT ADJ LOW NON NUM PART + JRST QLOK5A + LSH I,-6 + JUMPN I,QLOK5B +QLOK5A: TLC TT,400000 ;AVOID CAM LOSSAGE + TLC I,400000 + SKIPGE -2(P) + JRST QLOK5D ;FIRST MATCH + JUMPGE J,QLOK5E ;GET LEAST + CAMGE TT,-1(P) ;GET GREATEST + JRST QLOOK3 + CAME TT,-1(P) + JRST QLOK5D + CAMGE I,(P) + JRST QLOOK3 ;NOT AS GOOD +QLOK5D: HRRZM Q,-2(P) + MOVEM TT,-1(P) + MOVEM I,(P) +QLOOK3: SUBI Q,LUNBLK + JRST QLOOK4 + + +QLOK5E: CAMLE TT,-1(P) + JRST QLOOK3 + CAME TT,-1(P) + JRST QLOK5D + CAMLE I,(P) + JRST QLOOK3 + JRST QLOK5D + +QLOOK7: LSHC TT,-6 ;LOW DIGIT NOT NUMERIC + JUMPN TT,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?) + JUMPL J,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST + MOVNI TT,1 ;GREATEST IF LOOKING FOR LEAST + JRST QLOK5B + +QLOOK2: JUMPL C,QFNG1 ;REALLY WANT TO MAKE F.N.'S FOR WRITE + SUB P,[1,,1] + POP P,C ;BEST "NUMERIC" PART + POP P,Q ;ADR + POP P,I + POP P,TT + POP P,D + JUMPL Q,POPJJ + MOVE A,UNFN1(Q) ;ACTUAL MATCHED FILE NAMES + MOVE B,UNFN2(Q) + POP P,J + AOS (P) + POPJ P, + + +QFNG1: SKIPGE -2(P) + JRST QFNG2 ;NOT FOUND START W/ 1 + MOVE TT,-1(P) + TLC TT,400000 + MOVE I,[600,,TT] +QFNG3: LDB D,I + CAIL D,'0 + CAILE D,'9 + JRST QFNG4 ;REACH END OF NUMERIC FIELD + AOS D + CAILE D,'9 + JRST QFNG5 + DPB D,I +QFNG5A: TLNE TT,770000 + JRST QFNG3A + LSH TT,6 + JRST QFNG5A + +QFNG2: MOVSI TT,(SIXBIT /1/) +QFNG3A: MOVEM TT,A(C) ;STORE INTO A OR B AS APPRO + SUB P,[3,,3] + POP P,I + POP P,TT + POP P,D + JRST POPJJ + + +QFNG5: MOVEI D,'0 + DPB D,I + ADD I,[60000,,] + JUMPL I,QFNG5A + JRST QFNG3 + +QFNG4: TLNN TT,770000 ;SKIP ON ALREADY 6 CHAR NAME + LSH TT,6 + MOVEI D,'1 + DPB D,I + MOVEI D,'0 +QFNG4B: TLNN I,770000 + JRST QFNG5A + IDPB D,I + JRST QFNG4B + +QLKI1: CAME B,UNFN2(Q) + CAME A,UNFN1(Q) + UNFN2(Q) + + +;ROUTINE TO FIND PLACE IN DIRECTORY WHERE A B WOULD GO +;SKIPS ONL IF DIRECTORY CONTAINS AT LEAST ONE FILE +;FOR INSERTION, FILE GOES BEFORE PNTR RETURNED IN J +;RETURNS PNTR IN Q TO BEGINNING OF NAME AREA +;(ONLY WORKS FOR LUNBLK = 5) + +QLGLKB: SKIPA J,[DIRCPY] +QLGLK: MOVEI J,ARCADR + HRRZ Q,UDNAMP(J) + ADDI Q,(J) + CAIL Q,2000(J) + POPJ P, ;DIRECTORY EMPTY + TLC A,(SETZ) + TLC B,(SETZ) + PUSH P,D + PUSH P,E + ADDI J,600 +REPEAT 7,[ + CAMGE J,Q + JRST .+6 + MOVE D,UNFN1(J) + TLC D,(SETZ) + CAMN A,D + JSP E,QLGLE + CAML A,D + ADDI J,<1_<7-.RPCNT>>*LUNBLK + SUBI J,<1_<6-.RPCNT>>*LUNBLK +] + CAMGE J,Q + ADDI J,LUNBLK + CAMGE J,Q + JRST 4,. + MOVE D,UNFN1(J) + TLC D,(SETZ) + CAME A,D + JRST QLGL1 + MOVE D,UNFN2(J) + TLC D,(SETZ) + CAMLE B,D +QLGL2: ADDI J,LUNBLK +QLGL3: TLC A,(SETZ) + TLC B,(SETZ) + POP P,E + POP P,D +POPJ1: AOS (P) + POPJ P, + +QLGL1: CAML A,D + JRST QLGL2 + JRST QLGL3 + +;CALL BY JSP E,QLGLE +QLGLE: MOVE D,UNFN2(J) + TLC D,(SETZ) + CAMN B,D + JRST QLGL3 + CAML B,D + JRST 1(E) + JRST 2(E) + +;REMOVE HOLE FROM NAME AREA AT Q +QSQSH: PUSH P,A + PUSH P,B + PUSHJ P,DIRGE1 + PUSHJ P,QSQSH0 + PUSHJ P,DIRPUT + JRST POPBAJ + +;Note that Q should point into ARCADR, but we operate on DIRCPY. +QSQSH0: MOVEI TT,DIRCPY + MOVE A,UDNAMP(TT) + ADDI A,(TT) + HRRZ C,Q + ADDI C,DIRCPY-ARCADR +QSQSH1: SUBI C,LUNBLK + CAMLE A,C + JRST QSQSH2 + HRLZ B,C + HRRI B,LUNBLK(C) + BLT B,2*LUNBLK-1(C) + JRST QSQSH1 +QSQSH2: +REPEAT LUNBLK,SETZM .RPCNT(A) + SUBI A,-LUNBLK(TT) + HRRZM A,UDNAMP(TT) + POPJ P, + +QBTBLI: 440600,, ;IF GOING TO ILDB + 360600,, + 300600,, + 220600,, + 140600,, + 060600,, + 000600,, + +;Generate an ASCII directory. Write the whole thing as an ASCII string +;starting at NEWDAT. FILBLN gets the number of characters. +DIRASC: MOVE D,[440700,,NEWDAT] + SETZM FILBLN ;initialize vars used for creating the directory string. + MOVE B,AFDEV + PUSHJ P,DIRSI4 ;Output machine name and disk dir which archive resides on. + MOVE B,RDIRN + PUSHJ P,DIRSIX + MOVEI A,40 + PUSHJ P,DIRCHR + MOVE B,RDEVN + PUSHJ P,DIRSIX ;Output archive device name, and archive file's FN2. + MOVEI A,40 + PUSHJ P,DIRCHR + MOVE B,AFFN2 + PUSHJ P,DIRSIX + PUSHJ P,DIRCRL + MOVEI B,[ASCIZ /Free files = /] + PUSHJ P,DIRSTR + MOVE B,ARCADR+UDNAMP + SUBI B,UDNMIN-LUNBLK+1 + IDIVI B,LUNBLK ;Compute # of filename blocks we have room for. + PUSHJ P,DIRDEC + MOVEI B,[ASCIZ /, Wasted Words = /] + PUSHJ P,DIRSTR + PUSHJ P,DIRWST + PUSHJ P,DIRDEC + PUSHJ P,DIRCRL + MOVE Q,ARCADR+UDNAMP + ADDI Q,ARCADR ;Q gets addr of first existing file. +DIRFIL: CAIN Q,ARCADR+2000 + JRST DIRPAD + MOVEI A,40 ;First, a space, or a star for an inaccessible file. + MOVE B,UNRNDM(Q) + SKIPL UHREFC+ARCADR(B) ;File is being written, or + TLNE B,UNIGFL ;is marked for deletion, => + MOVEI A,"* ;mark it with a star. + PUSHJ P,DIRCHR + MOVEI B,[ASCIZ / 0 /] + PUSHJ P,DIRSTR + MOVE B,UNFN1(Q) ;Then come the FN1 + PUSHJ P,DIRSIX + MOVEI A,40 + PUSHJ P,DIRCHR + MOVE B,UNFN2(Q) ;and the FN2. + PUSHJ P,DIRSIX + MOVEI A,40 + PUSHJ P,DIRCHR + MOVE B,UNRNDM(Q) + MOVE B,UHWCNT+ARCADR(B) + ADDI B,1777-UHBLEN + LSH B,-10. + PUSHJ P,DIRDEC ;and then the size in K. + MOVEI B,[ASCIZ / /] ;No archive files are ever dumped, + PUSHJ P,DIRSTR ;so don't mention any dumped-bit. + MOVE A,UNDATE(Q) + PUSH P,D + MOVE D,[440700,,DIRDAT] + PUSHJ P,DATIME"TWDASC ;Convert creation date/time to ASCII + POP P,D + MOVEI B,DIRDAT + PUSHJ P,DIRSTR ;and copy into the directory. + PUSHJ P,DIRCRL ;That's all for this file. + ADDI Q,LUNBLK + JRST DIRFIL + +;Pad the end of an ASCII directory with ^C's. +DIRPAD: MOVE B,D + MOVEI A,^C +REPEAT 5,IDPB A,B + POPJ P, + +;Subroutines for generating ASCII directories. + +;Output the next character of one. +;The character is in A. Stuff it down bp in D and count in FILBLN. +MPVOK3:: +DIRCHR: IDPB A,D + AOS FILBLN + POPJ P, + +;Output the SIXBIT word in B as six characters. +DIRSI4: SKIPA C,[4] ;DIRSI2 outputs only the first four. +DIRSIX: MOVEI C,6 +DIRSI1: SETZ A, + ROTC A,6 + ADDI A,40 + PUSHJ P,DIRCHR + SOJG C,DIRSI1 + POPJ P, + +;Send a CRLF to the ascii directory. +DIRCRL: MOVEI A,^M + PUSHJ P,DIRCHR + MOVEI A,^J + JRST DIRCHR + +;Output ASCIZ string B points at into the ASCII directory. +DIRSTR: HRLI B,440700 +DIRST1: ILDB A,B + JUMPE A,CPOPJ + PUSHJ P,DIRCHR + JRST DIRST1 + +;Print number in B in decimal into the ASCII directory. +DIRDEC: IDIVI B,10. + HRLM C,(P) + SKIPE B + PUSHJ P,DIRDEC + HLRZ A,(P) + ADDI A,"0 + JRST DIRCHR + +DATIME"$$OUT==1 ;Insert the TWDASC routine for converting times to asciz. + +.INSRT SYSENG;DATIME + +DIRDAT: BLOCK 5 ;Buffer for TWDASC to use. + +;Handle .IOT. +JIOT: MOVE A,JBCOP + TLNN A,100000 ;Skip if output IOT + JRST JIOTI + TLNN A,200000 ;Skip if block IOT + JRST JIOTO1 + HLRE D,JBCWD1 ;User's block IOT pointer - get word count. + MOVNS D +;D has number of words we want to write. +JIOTO2: MOVE C,FILRND ;C gets # of bytes that fit in existing space allocated. + SUB C,ACCP ;How many remain past current access pointer? + SKIPN C ;Are we pointing exactly at end of file? + PUSHJ P,JIOTEX ;If so, prepare to extend the file. + JUMPGE C,JIOTO5 ;If this is extending the file, make sure we don't overflow maximum. + MOVEI A,NEWMAX + IMUL A,BYTSWD ;How many bytes is the most we can fit in memory? + MOVE B,NEWLEN + ADD B,C ;How many will we have, of data to extend with, after this? + CAML B,A ;Will it fit? + JRST JIOTDF ;No. Give a "device fill" ioc error. +JIOTO5: SKIPLE C ;Are we extending the file? + CAMLE C,D ;No, we are overwriting it. If whole IOT will fit in existing length, + MOVE C,D ;do it all. Else rewrite existing stuff, then loop around + ;and come through JIOTO2 to xfer the rest and extend the file. + SUB D,C ;# bytes of user's IOT that will be left. + MOVE A,JBCOP + TLNE A,200000 ;Now read the bytes from the user. + JRST JIOTO4 ;using SIOT or block IOT, whichever we can. + MOVE A,C ;SIOT directly into the file's data. +MPVOK1: SYSCAL SIOT,[ 1000,,CHBOJ ? ACCBP ? C] + .VALUE + SUB A,C ;A gets # bytes we got, C # we wanted but didn't get. +JIOTO3: PUSHJ P,UPDACP ;Update access pointer in bytes. Access b.p. already incremented. + JUMPN C,GOLOOP ;Now, if this IOT was pclsr'ed, don't try to do + ;any more for it. If it comes back in we will find out. + JUMPE D,GOLOOP ;If there is more stuff to output, + JRST JIOTO2 ;go read it in and extend the file. + +;Here to xfer from creator in block mode. +JIOTO4: MOVN B,C + HRLZS B + HRR B,ACCBP + AOS B ;Point at first unfilled word, not last filled. +MPVOK2: .IOT CHBOJ,B + HRRZ A,B + SUB A,ACCBP + MOVEI A,-1(A) ;A gets number of words we got. + SUB C,A ;C gets # that we expected but didn't get. + ADDM A,ACCBP + JRST JIOTO3 + +;Here to begin extending the file. Start writing into NEWDAT instead of the file's data. +;Core in NEWDAT is created by MPVs. +JIOTEX: MOVEI A,NEWDAT-1 ;Create 010700,,NEWDAT-1 or 004400,,NEWDAT-1 + HRRM A,ACCBP + POPJ P, + +;Here to decode a unit mode IOT or SIOT. +JIOTO1: TLNE A,%JGSIOT ;Skip if unit IOT. + SKIPA D,JBCWD1 ;Else it's SIOT, get the byte count. + MOVEI D,1 ;Unit IOT, byte count is 1. + JRST JIOTO2 + +;Update our access pointer when we write C(A) bytes. +UPDACP: ADDB A,ACCP + SKIPL FILLEN ;If file length known, + CAMG A,FILLEN ;and writing past end of file, + POPJ P, + MOVEM A,FILLEN ;update the file length. + MOVEM A,FILBLN ;Since we're writing, byte size written and current byte size must be the same. + SUB A,FILRND ;Get how many of the bytes were added above old allocated space. + CAML A,NEWLEN + MOVEM A,NEWLEN ;Store as amount of bytes to extend file by when we close. + POPJ P, + +JIOTDF: SYSCAL JOBIOC,[%CLIMM,,CHBOJ ? %CLIMM,,11] + .LOSE %LSFIL + JRST GOLOOP + +JIOTI: TLNN A,200000 ;SKIP IF BLOCK IOT + JRST JIOTI3 + HLRE C,JBCWD1 ;USER'S BLOCK IOT POINTER - GET WD COUNT. + MOVNS C +;C HAS # BYTES THE USER WANTS IN THIS IOT OR SIOT. +;A HAS JBCOP, EVERYWHERE ON THIS PAGE. DON'T CLOBBER IT! +JIOTI1: MOVE D,FILLEN + SUB D,ACCP ;How many bytes of file remain past current access pointer? + JUMPLE D,JIOTIE + CAML D,C + MOVE D,C ;D gets # of bytes we can give the user. + SUB C,D ;C gets number user wants beyond that (beyond EOF). + TLNN A,200000 + JRST JIOTI4 ;NOW IN UNIT MODE GO XFER THEM WITH SIOT. + MOVNS D + HRLZS D + HRR D,ACCBP ;IN BLOCK MODE, MAKE AOBJN TO WHAT WE WILL GIVE + AOS D + .IOT CHBOJ,D ;GIVE + SKIPGE D ;IF CREATOR DIDN'T TAKE ALL WE OFFERED, HE WAS + SETZ C, ;PCLSRED, SO DON'T TRY TO OFFER ANY MORE. + MOVEI E,-1(D) + SUB E,ACCBP ;NUMBER OF WORDS GIVEN TO CREATOR + ANDI E,-1 + ADDM E,ACCBP +;HERE E HAS # BYTES WE JUST GAVE THE USER. ACCBP HAS BEEN UPDATED, +JIOTI5: ADDM E,ACCP + JUMPN C,JIOTI1 ;NOW, IF CREATOR'S IOT NOT ALL FILLED, GIVE HIM MORE. + JRST GOLOOP + +;Here for unit mode IOT or SIOT to determine amount to transfer. +JIOTI3: TLNE A,%JGSIOT ;SKIP IF UNIT IOT + SKIPA C,JBCWD1 ;SIOT, GET BYTE COUNT + MOVEI C,1 ;IOT, TRANSFER ONE BYTE + JRST JIOTI1 + +;HERE TO GIVE THE CREATOR SOME DATA IN UNIT MODE. +JIOTI4: MOVE E,D + SYSCAL SIOT,[1000,,CHBOJ ? ACCBP ? D] + .VALUE + SUB E,D ;E GETS # BYTES HE TOOK. + SKIPE D ;IF HE DIDN'T TAKE ALL WE OFFERED, HE WAS PCLSRED, + SETZ C, ;SO DON'T TRY TO GIVE HIM ANY MORE. + JRST JIOTI5 + +;Handle attempt to read when at EOF. +JIOTIE: MOVE A,JBCOP + TLNN A,201000 ;SKIP IF BLOCK OR SIOT BIT ON + JRST JIOTI6 ;FOR UNIT-MODE IOTS, RETURN SOMETHING. + .CALL JBRTL ;JUST UNHANG A BLOCK IOT OR SIOT. + PCL + JRST GOLOOP + +JIOTI6: TLNE A,400000 ;EOF, AND USER'S CHANNEL IS UNIT MODE. + JRST JIOTI8 + .IOT CHBOJ,[-1,,^C] ;IF ASCII, INDICATE EOF (CHBOJ IS UNIT MODE) + JRST GOLOOP + +JIOTI8: SYSCAL JOBIOC,[MOVEI CHBOJ ? MOVEI 2] ;IOCERR FOR EOF + JFCL + JRST GOLOOP ;ON UNIT IMAGE CHANNEL + +;The creator closed his channel. +JCLS: SKIPN FILADR ;If a file is open, + JRST JCLS1 + PUSHJ P,JFORCE ;write out any extension data. + JFCL + PUSHJ P,LOCK + PUSHJ P,MAPARC + PUSHJ P,CLSDEL ;Closing a file can delete an existing one. + MOVE B,FILADR + HRRZS UHREFC(B) ;Remove our traces from the reference count + SETZM SWTLST ;and unlock our locks. +CRIT3A: SOS UHREFC(B) +CRIT3B: JRST JCLS2 + +JCLS1: PUSHJ P,LOCK + PUSHJ P,MAPARC +JCLS2: PUSHJ P,ARCDEL ;Delete this file if desired, and it's now no longer open. + PUSHJ P,ARCSAL ;Maybe eliminate wasted space. + PUSHJ P,UNLOCK + JRST DIE + +;When we close a file we were writing, delete any existing file with the same name. +CLSDEL: MOVE B,UNRNDM(Q) + SKIPGE UHREFC+ARCADR(B) + TLNE B,UNCDEL ;(but not if this file is going to be deleted itself). + POPJ P, + MOVE A,UNFN1(Q) ;Get this file's filenames. + MOVE B,UNFN2(Q) + MOVE C,UDNAMP+ARCADR + ADDI C,ARCADR + MOVSI D,UNCDEL +CLSDE1: CAIN C,2000+ARCADR ;Scan through the directory + POPJ P, + CAMN A,UNFN1(C) ;for all files with those names. + CAME B,UNFN2(C) + JRST CLSDE2 + HRRZ TT,UNRNDM(C) ;All files with those names, not being written, + CAME C,Q ;(aside from the one we're closing!) + SKIPGE UHREFC+ARCADR(TT) + JRST CLSDE2 + IORM D,UNRNDM(C) ;Get marked for deletion +CLSDE2: ADDI C,LUNBLK ;(which will be done right away, by ARCDEL, + JRST CLSDE1 ; except for files open for reading). + +JFINISH:PUSHJ P,JFORCE + JRST DVFLERR + JRST JSUCC + +;Extend a file, adding to it the output we have been saving up in NEWDAT +JFORCE: SKIPN DIRECTN ;If we are writing a file, stick it into the directory. + JRST JFRCDT + MOVE B,FILLEN + CAMN B,OFILLEN ;If we have output something since the last time here, + JRST JFRCDT + MOVEM B,OFILLEN + PUSHJ P,LOCK ;Lock the archive and stick the new stuff into it. + PUSHJ P,MAPARC + SKIPN B,NEWLEN ;Do we need to allocate any more words? + JRST JFOR1 ;No => just update # free bytes in last word. + MOVE D,FILADR ;Yes => we must extend the file. + ADD D,UHWCNT(D) + SUBI D,ARCADR + HRRZ A,UNRNDM(Q) + CAMN D,UDDATP+ARCADR ;Is this file the last thing in the archive? + JRST JFRCX ;Yes => we can extend it in place. + MOVN C,@FILADR ;Otherwise we must recopy the old contents at the end. + HRLZS C + HRR C,FILADR ;Write out a copy of the file's old contents. + MOVE D,UDDATP+ARCADR ;Start writing where allocation is being done. + MOVE A,D + PUSHJ P,JFRCIOT ;Simulate .IOT, using BLT on existing pages. + JRST UNLOCK +;A has new value for file's UNRNDM rh. +JFRCX: MOVE J,NEWLEN ;D has updated access pointer. + ADD J,BYTSWD + SUBI J,1 + IDIV J,BYTSWD ;How many WORDS are we growing by? + MOVE C,J + ADD C,D + CAIL C,ARCMAX ;Return non-skip if we will exceed maximum archive device size. + JRST UNLOCK + PUSH P,J + MOVN C,J + HRLZS C ;Write out the data we are extending the file with. + HRRI C,NEWDAT + PUSHJ P,JFRCIOT + .VALUE + MOVEM D,UDDATP+ARCADR ;Advance the data area free pointer over what we just gobbled. + JUMPG TT,JFOR2 ;If we .IOT'ed to make new pages, + SYSCAL FINISH,[%CLIMM,,CHDSK] + .LOSE %LSFIL ;Do a finish, so that pages are all on disk when we unlock. + PUSHJ P,UNLOCK ;Unlock and relock to make all pages be in the disk ufd, + PUSHJ P,LOCK + PUSHJ P,MAPARC ;map those pages in. +;This temporary unlocking can't cause any problems, because the new data area +;is marked as allocated so can't be reused, but no file points at it so nobody can touch it. +;Also, since we have a file open, nobody can salvage the archive, +;and the old file data area can't change since only we have it open. +JFOR2: MOVE B,(P) + ADD B,@FILADR ;Compute new total length in words, including header. + MOVEM B,UHWCNT+ARCADR(A) ;Store as length of file data area. + IMUL B,BYTSWD + MOVEM B,FILRND ;Store # of bytes now allocated to the file. + HRRM A,UNRNDM(Q) ;Store new location of file in directory. + ADDI A,ARCADR + MOVEM A,FILADR ;Store new address of file. + POP P,A ;Flush the core we were using + ADDI A,1777 ;to hold the data we just wrote out. + LSH A,-10. + MOVNS A + HRLZS A + HRRI A,NEWDAT/2000 + SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A] + .LOSE %LSSYS + SETZM NEWLEN +JFOR1: PUSHJ P,BENC ;Update the UNBYTE fiels of the file's directory entry. + JRST JFOR3 + +JFRCDT: SKIPN DATUPD + JRST POPJ1 + PUSHJ P,LOCK +JFOR3: MOVE A,CRDATE ;Update the file's dates stored in the directory, + MOVEM A,UNDATE(Q) + MOVE A,REFDAT + HLLM A,UNREF(Q) + SETZM DATUPD ;and say that they are now up to correct there. + PUSHJ P,UNLOCK ;Unlock the file (close CHDSK). + MOVEI A,ARCADR/2000 + SYSCAL PGWRIT,[A] ;Make sure all pages of archive are up-to-date on disk. + CAIA + AOJA A,.-2 + JRST POPJ1 + +;Extend the archive file by effectively doing .IOT CHDSK,C, with access pointer from D. +;But, to avoid screws, any of the transfer which goes to a page which already exists +;must also be BLT'ed into that page. +;When we return, TT is negative if any new pages were created. +;Clobbers E. Updates D by the number of words transferred. +;Skips unless the archive became full. +JFRCIOT: + PUSH P,B + PUSH P,C + HLRZS C + SUBM D,C + CAIL C,ARCMAX + JRST POPDBJ + .ACCESS CHDSK,D + .IOT CHDSK,C ;First, IOT the whole thing so file length is set right. + POP P,C + HLRE E,C + MOVNS E ;E gets number of words to be transferred. + PUSH P,D + ADDM E,(P) ;Store on the PDL, to be popped, the updated value of D. + MOVE TT,UDDATP+ARCADR + ADDI TT,1777 + TRZ TT,1777 + SUBI TT,(D) ;How many words fit on existing page? + JUMPLE TT,JFRCI1 ;None, starting past the last mapped page, => + ;no need to BLT anything. + CAMGE E,TT + JRST JFRCI2 + MOVE E,TT ;get number of words to transfer, on existing page. + SETO TT, ;If we will make new pages, leave TT negative. +JFRCI2: HRLZ B,C + HRR B,D + ADDI B,ARCADR ;Transfer them with BLT. + ADD D,E + BLT B,ARCADR-1(D) +JFRCI1: AOS -2(P) +POPDBJ: POP P,D +POPBJ: POP P,B + POPJ P, + +NEWLEN: 0 ;# of bytes we are buffering up to add to the end of the file. + +;Handle .ACCESS and .CALL ACCESS +JACCCL: PUSHJ P,JACC0 ;.CALL ACCESS + JRST WTDERR + .CALL JBRT1 + PCL + JRST GOLOOP + +JACC: MOVE A,JBCWD1 ;.ACCESS. + PUSHJ P,JACC0 + JFCL + JRST JSTS + +JACC0: SKIPE DIRFLG ;Can't change access pointer if reading a directory. + POPJ P, + MOVEM A,ACCP ;Set the access pointerk in bytes. + CAMLE A,FILRND ;Set the access byte pointer. + JRST JACC1 + IDIV A,BYTSWD + ADD A,FILADR + MOVEI A,UHBLEN-1(A) ;get address of word before the one containing next byte. +JACC3: MOVE C,BYTSIZ + DPB C,[300600,,A] ;Store the byte size in the byte pointer. + JUMPE B,JACC2 + IBP A ;Advance the appropriate number of bytes past word boundary. + SOJG B,.-1 +JACC2: MOVEM A,ACCBP + JRST POPJ1 + +JACC1: SUB A,FILRND + IDIV A,BYTSWD + MOVEI A,NEWDAT-1(A) + JRST JACC3 + +JRESET: +JSTS: .CALL JBRTL + PCL + JRST GOLOOP + +;Handle .RCHST and .CALL RCHST +JRCH: SYSCAL JOBRET,[ + 1000,,CHBOJ + 1000,,0 + [-5,,RDEVN]] + JFCL + JRST GOLOOP + +JSYSCL: MOVE B,JBCWD1 ;Handle a .CALL. What is its name? + MOVE A,JBCWD5 ;dispatch to it with its 2nd arg in A. + CAMN B,['FILLEN] + JRST JFILLEN + CAMN B,['SFDATE] + JRST JSFDAT + CAMN B,['RFDATE] + JRST JRFDAT + CAME B,[SIXBIT /FORCE/] + CAMN B,[SIXBIT /FINISH/] + JRST JFINISH + CAMN B,[SIXBIT /ACCESS/] + JRST JACCCL + CAMN B,[SIXBIT /RFPNTR/] + JRST JRFPNT + CAMN B,[SIXBIT /SRDATE/] + JRST JSRDAT + CAMN B,[SIXBIT /RRDATE/] + JRST JRRDAT + CAMN B,[SIXBIT /RESRDT/] + JRST JRESRDT + CAMN B,[SIXBIT /DELEWO/] + JRST JDELWO + CAMN B,[SIXBIT /FILBLK/] + JRST JFILBLK +;If the call is onw we don't handle, return "wrong type device". +WTDERR: MOVSI A,%EBDDV ;Return "Wrong Type Device" error. +ERR: MOVEM A,ERRCOD + .CALL JBRT3 + PCL + JRST GOLOOP + +DVFLERR:SKIPA A,[%EFLDV,,] +ILFERR: MOVSI A,%EBDFN ;Return "Illegal Filename" error. + JRST ERR + +;Individual .CALL handlers. + +JRFPNT: HRROI A,ACCP ;RFPNTR. + JRST JSUCC + +JFILLE: MOVE A,[-4,,FILLEN] ;FILLEN. +JSUCC: SKIPE DIRFLG + JRST WTDERR +JCALRT: MOVEM A,JRFDAP +JCALR1: SYSCAL JOBRET,[ 1000,,CHBOJ ? 1000,,1 ? JRFDAP] + PCL ;THE SYSTEM CALL WAS PCLSR'ED AND COMES IN AGAIN. + JRST GOLOOP + +JRFDAP: 0 + +JSFDAT: MOVEM A,CRDATE ;SFDATE. Set our cached date but don't write directory yet. + SETOM DATUPD ;Set flag saying dir must be updated later. + JRST JSUCC + +JRFDAT: HRROI A,CRDATE ;RFDATE. + JRST JSUCC + +JRRDAT: HRROI A,REFDAT ;RRDATE. + JRST JSUCC + +JRESRDT: + MOVE A,ORFDAT ;RESRDT. Restore ref date which was in effect before the open. +JSRDAT: HLLM A,REFDAT ;SRDATE. + SETOM DATUPD + JRST JSUCC + +;Return five words: fn1, fn2, "random", cdate, rdate+byte count. +JFILBLK: + SKIPE DIRFLG + JRST WTDERR + PUSHJ P,LOCK ;Lock the directory. + SKIPN DATUPD + JRST JFILB1 + MOVE A,CRDATE ;If nec., update the file's dates stored in the directory, + MOVEM A,UNDATE(Q) + MOVE A,REFDAT + HLLM A,UNREF(Q) + SETZM DATUPD ;and say that they are now up to correct there. +JFILB1: HRL A,Q ;Copy the 5 words out of the dir, so we can unlock fast. + HRRI A,RNDM + BLT A,RNDM+LUNBLK-1 + PUSHJ P,UNLOCK + MOVE A,[-5,,RNDM] ;Return the values. + JRST JCALRT + +;Rename while open. +JRNMWO: SKIPE JBCWD1 ;make sure that neither filename is zero. + SKIPN JBCWD6 + JRST ILFERR + SKIPE DIRFLG + JRST WTDERR + PUSHJ P,LOCK ;Lock dir, get filename block address in Q. + PUSHJ P,MAPARC + PUSHJ P,JRNM1 + JRST JCALR1 + +JRNM1: PUSHJ P,ARCWRT + PUSH P,UNDATE(Q) ;Don't clobber creation date, etc. + PUSH P,UNRNDM(Q) + PUSH P,UNREF(Q) + PUSHJ P,DIRGE1 ;Make a copy of the directory. + PUSHJ P,QSQSH0 ;Delete the old filename block. + MOVE A,JBCWD1 + MOVE B,JBCWD6 + PUSHJ P,QFNG ;process a > or < appearing in the new filenames. + JFCL + MOVEM A,RDEVN+1 + MOVEM B,RDEVN+2 ;Report changed names to RFNAME system call. + .CALL JBST + .LOSE %LSFIL + PUSHJ P,DINSR2 ;Make a new one at the appropriate place, with the new names. + POP P,UNREF(Q) ;The other three words carry over from the old entry. + POP P,UNRNDM(Q) + POP P,UNDATE(Q) + JRST DIRPUT ;Return to JCALL do do the JOBRET. + +;Rename/delete. +;This is an initial operation, done when there is no JOB channel open yet, +;so the directory is still locked from the initialization. +JFDELE: MOVE A,JBCFN1 + MOVE B,JBCFN2 + CAMN A,['.FILE.] + CAME B,[SIXBIT /(DIR)/] + CAIA + JRST ILFERR + PUSHJ P,QLOOK ; Look for the file we are going to rename or delete. + JRST RDFNF ; Can't find it => report error. + SKIPE JBCWD1 ;Is this delete or rename? + JRST JFDELR ;Rename. + PUSHJ P,ARCWRT + HRRZ B,UNRNDM(Q) ;Delete. + SKIPE UHREFC+ARCADR(B) ;Is file being referred to? If not, + JRST JFDELD + PUSHJ P,DIRGE1 ;we can delete it now. Copy the directory, + PUSHJ P,QSQSH0 ;delete the filename block, + PUSHJ P,DIRPUT ;rewrite the directory. +JFDELW: SYSCAL JOBRET,[%CLIMM,,CHBOJ ? %CLIMM,,1] ;Return success. + PUSHJ P,IJBRTF + JRST JCLS1 ;Commit suicide, since no channel open. Maybe salvage. + +JFDELD: MOVSI C,UNCDEL ;Deleting a file that's being read. + IORM C,UNRNDM(Q) ;Set bit to cause it to be deleted when closed. + JRST JFDELW + +;Rename. Now that the filename block address is in Q, +JFDELR: PUSH P,Q + MOVE A,JBCWD1 + MOVE B,JBCWD6 + CAME B,[SIXBIT />/] + CAMN B,[SIXBIT //] + CAMN A,[SIXBIT /&-2000 ;Address of place to map in the archive pages. +DIRCPY==540000 ;Address of place to put temporary copy of archive directory. +NEWDAT==542000 ;Address of place to put stuff to add to end of file. +NEWMAX==776000-NEWDAT ;Max number of words of extension data we can hold. +ARCMAX==DIRCPY-ARCADR ;Maximum size archive we can handle. + +END GO