From c81af351150315f1ba13b9c92c40ec18d15be0c4 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sun, 27 Nov 2016 17:38:51 -0800 Subject: [PATCH] Added mail support (COMSAT, MAIL, RMAIL, DQ device). --- Makefile | 2 +- README.md | 9 +- bin/emacs/[rmai].146 | Bin 0 -> 29435 bytes build/build.tcl | 42 + doc/_info_/qmail.info | 148 + doc/info/mail.12 | 250 + src/_mail_/names.2006 | 150 + src/emacs1/rmaill.8 | 37 + src/ksc/ivory.12 | 79 + src/ksc/nlists.124 | 1312 +++++ src/ksc/qmail.614 | 4801 ++++++++++++++++ src/sysnet/comsat.583 | 11864 ++++++++++++++++++++++++++++++++++++++++ src/sysnet/dqxdev.41 | 699 +++ src/sysnet/netrts.355 | 2225 ++++++++ src/sysnet/netsnd.62 | 489 ++ src/sysnet/resolv.34 | 456 ++ 16 files changed, 22559 insertions(+), 4 deletions(-) create mode 100644 bin/emacs/[rmai].146 create mode 100644 doc/_info_/qmail.info create mode 100644 doc/info/mail.12 create mode 100644 src/_mail_/names.2006 create mode 100755 src/emacs1/rmaill.8 create mode 100644 src/ksc/ivory.12 create mode 100644 src/ksc/nlists.124 create mode 100644 src/ksc/qmail.614 create mode 100644 src/sysnet/comsat.583 create mode 100644 src/sysnet/dqxdev.41 create mode 100644 src/sysnet/netrts.355 create mode 100644 src/sysnet/netsnd.62 create mode 100644 src/sysnet/resolv.34 diff --git a/Makefile b/Makefile index 2a64fc3f..1b2712a8 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ EMULATOR ?= simh -SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden +SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_ DOC = info _info_ sysdoc kshack _teco_ emacs emacs1 MINSYS = _ sys sys2 sys3 device emacs _teco_ sysbin inquir diff --git a/README.md b/README.md index e46fd220..32e57797 100644 --- a/README.md +++ b/README.md @@ -94,6 +94,10 @@ from scratch. - TTLOC, Advertises physical location of logged in users - SRCCOM, Compares/merges source files, compares binary files - DDTDOC, interactive DDT documentation. + - COMSAT, Mail server + - MAIL, Mail sending client + - RMAIL, Mail reading client + - DQ Device, for doing hostname resolutions. Used by COMSAT. 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. @@ -110,9 +114,8 @@ Currently, basic TCP network support is in the build, in addition to both a TELNET/SUPDUP server, and both TELNET and SUPDUP clients. Additionally, both an FTP server and client are included. Chaosnet TELNET and FTP (CHTN and CFTP), but this requires support and configuration -in the emulator to actually use. - -Other network services will appear in subsequent releases. +in the emulator to actually use. SMTP mail inbound and outbound is included, +as well as local mail delivery. The KLH10 dskdmp.ini file has an IP address (192.168.1.100) and gateway IP address (192.168.0.45) configured for the ITS system. The IP address diff --git a/bin/emacs/[rmai].146 b/bin/emacs/[rmai].146 new file mode 100644 index 0000000000000000000000000000000000000000..f250a8bf4539e519935041a414835df2a92d3657 GIT binary patch literal 29435 zcmeHwYiuJ~cAmOn@2qNergwVcamyw3me?~*vBj$9LyvB%TP=!YQKa|~UoEvbEe|CX zB~DYMnxv+u$LqEO!w&2X;v|lf*omFTdXYG`fo$vqaTbPu7>VHoPT(YtVFY;?HuA$k zX5t@4U<5|;efL%si=w92LH-2D47N+B&b@W(-gD3Up5lJ*>80PAm{6|OLsRp2=FQUF z)ciuA9#%qTF+3AeO<#Jx6rT1gQ=%;}zfcP+W-08;g@C*kEQMqFxl(w3VeWDGaVQW_ zG)?=>k0hY)<}z_xxJ*4H?&kpczMHtmxTrUY`&C@DZzJw~KsUdi zxZlC;?CZom!|k`fLfrqvW#${eO@0fY*&|#gzYQ1dkBH-nu4jq6jmumAkhtr(h<8k8 zi2Dt;a)ECh5VCNY{cb{iTw=UT{%KrhxYLtAjDGKMyC;8wPc#Yr3@(C8CVvq)v7$-N ze)b31`kTOABf%zr7trhmp+8{1FA@4*xLo^DT$I;<)A%+;#YMbVA$6zx#F1dKl|#uV zDuC906%DVE;=%7@KN9inFA(BP!yUG6;WqXS;<)^4B#!cHxFjDC;;hoIvfoFzyh)~h z^$ISTuM>I)mzAf4xXFTJU)=_@@n_Ka)tGpet>1%7l1%gJri&xN;`7Aq;Sve6->(C* zo)O2X<<1Cwh=$@X1Ny>cKzT0k3sbmk>cqVzAmTV(i3_+m%f;PuabE$H|8IPjOt`7z z@&ztNKD+PYe#^z3xj3?@==bsG9o%a-TpV{sjQ1KjNA@#ZT$j)v#yKa{W@^3Qzcas#E~TV3UL~4 zAKoU8x781bi{eru{a&Z!<-bCl322Mcc>QnSHh)CiBV3AqinxD@OX=r`YXd4$DZKt) zahp?#<1`9ChRYSo(blWDT)E1Azf9aRTYrhTcW~JxpI&(kNWA099pX;dx{iiT&gDuD zm#uFnM6rMPhlJk4rEr%J<$R0#c4fdPINd8Ra1mVcMec`K(HA*`Eeh-xrvc@DhR{u1 zwiXG6aLIp;P>ij=Mu^I-SRzE-Dc<|V9YFcp#E~OpD`_B~AUPY{_%~j~r9{Q^hM)l# z_{Iz_6>h*A9CVMDHz>{aSm zi=uY5PDo=bM?QQ++z-0ABA^D@_9|6hg>=5!!fjTJ*T-#^OSnpzeqZ}@6B9SIaz38P zX>ULD-t0h2xGj729~$1xdEkHtzU6`EJ#f$i>mJzfz_&ec$ODHxaKr;gJ@A4DUi83A z9(dUU-|@hAJ@ASLzVCq_c;L7PUiZKW51jPCrUy=Y;EV^(df-hDob$kW4_xrTMGw5? zflD5^?13vDxaxsx9(daW?|9%x9(dOS?|Il}?}7Jb&3hB~-Xy#?N$-v6y-9m-HoP}k z?@i8ollR^fy*Fj=jhET?cDyaS-kZAj=CSwYy&r?`p_#4Dp_Xj)kF|<*+UPX~-QHgy zKHq4ywe_=R)9U?2_daj+`;8+@bl5t>GqS^vvP0Qwc6%p{fp%;)4z1o_5;!53x}GnV zQ@Z}+LsX)Ba?-$yD}!FEb0o%-GMwrRtlnQ6c1(R}9h?m;t#~?UbvymPJZ#ByT7y=j z-TKJ-t3%{gqt~~z4KV}H>nc{;Iv8m7^nYU5zcRoq^hUeeu{6B8_Z+(XUaC+nKU)1O z6BF)|s#eGPP>=*l#WPX#sdWxpM^=B(YCdtR%+46*(HLfT46`>TPNsyL1+kE6y_%ihj-uibG}eH`_89Q7U?S*fNj zG$c@uPOHb9KwXbuZLRF->@h7c1x{yI8%qNN_3pNen3=zMzG2kZc;4gDHUj`jS#NjI0vN+!76HT}>Uf;BIKu=ckscl+;u{o~URKtzI9dUe&`3Azx0> z!)CouEY&hqRawKcU*;gO3@-JV8C2dnO%=3HqCM|pU`(^ z74zP#c(I;{R}&kvN^I?(GMk7OiUq)#MOB%#r;4tnsE$mUVphuORJHm@^%cxYDzQ=Mk==j zf}?*a>Px4i=H`5O!rY05;T^ees_!_}wEO7&53W2;zEeJQgVQ!&(@nW=?J_R@k9wV(8Q)`4>b6?aCF$*efo> zSJrZ^j->`x)LL}vYNsio!n3KnTNlM)Kut4FaP z3pqny*TDq7^!hyhWVzF8IkO`8QV&PaPzqTcGEq2reLZWzJcs9^oTE){U)#U-I&rToOgU_?3Hn^ z9FCip6*ac9I=Z#vll9%mV!6tc9=>?RDH_y5B|r1VBo?ku{cAZT6eNYU znK#fcM_X*)Y-0QCAw?=CP$mdQmRz-+Ri^*d<%v+R+5bpw_V>GIokR7Rax!;foZQrq z*+4#|FY^dCr+|^6kAl1NVRsBAJy$Y};vBpgsYjA{LS!yfDB&WG;jr-H#wO+k% zysv~~=R^hEzY09anlwpPF_;Ahq1EfV*$g#iroR~zQ5n?3pn;;6rCPw=jY`4!H*^|p zmy!4e4DoWgLTW}ImGq<<`0Yy*7f|9Z%;jD15BVi&^NX`Kn_c=E93;4`B%kGSvTaaa z!VIOmq_Yx=>({^JD`dW;`pb?PqTJ7s{DJgcb2FjHu0U>zO>uTw?%R1mRHlFZ|7t1B z1G&qvxzFKP=dV4ZPo2CTe%bW(oM2Vxcu7iay^VJY)83~h|Ak8v@P2F?H#GXp|HU*F zGGRi0io;_9P^2}Rg-s0DY@D?RFp{657MwjEc7?5+idAObj6h7AN7Met5yjRn^afte zNxwl#%giEJU4|fi9C#OS`c0{Ud(CBFrIp49mgwSmC(sG8d#NNmyH#igIHXWc+x!Dh zV`DRHJ|He%OlHhXN*I#y_rSWujP*Hp1{pBnhw6MJ@F_Aah9z4mVRJ<~SR%ksk(P*z zVuZDIb}9AYz{1dnnjM~UkNySDW5#Fnf4b~xh~jzuGL5LsoDV@)UY-6Pg44f$d15N| zF2gsoo-{MLl+aM1&oFe`D~{5?hE>YIU>zPryqZGP29z6XjP$450Y4JXBG8?)lYPW> z8gsr)XG;}oXJw-b)sl@>Zp?(#KRpFa9ZOCX z!k1|nTAP~*2f*h}k;JrLj$&5i+JWEAX3!C8b|#EzA;5cA&0!X$upzi#={nu++2c1QK<(IP6Wzpanc&D=v={iCU!iahMIlr;JDj3pwwr>=6$c-r3al3L%9lD zQZV#6<{yUxwRMSIOU2XMkLPqc>2^`Ziu(+*Yamt6i;U z_0LYMpw{Yq(0yWQgJVk`Jsj941dXFctD`+@4UV-2*~sd(4zxz^2vBEWAc+v)@Ad{b zeZVjxMsux}5^8qcEJWElZ9lhaB~~}Py=RRc zbW=>5c{3CQaS22oEAn7PNBe;lE1QYsXjIYlD!u1sx83eOgV{cA^+mv=>yVVFT(5LaA`jg0sGpzz+{)VZH=!BL!s?!}U8@ z_NTH1{f^eH8jgv`YYEL^G$;$ni<*VB6i%h&QXF6JC5%QxGgO)*l&(dTQbcZKgc}** zMgqc4y?iI_OuEz_;a+5Y=D-iv`n z8OUeI#V_T`n4VKS1e2DEgn?E|N0lrhtr@kdu6&L!U$yTOBliptfmpMfwKeCCbVDK{ zOIcFWp%#Q7hVd>#kS?n$N*QUkNOG-tIf&R~Qhl-twaf^zz?WtUW>HsH%uR$Yv7n~T zhY>ECn@OYrD#0s?3a`}&Z2Cb5^v-ST3~GYvW;hhoqj5bP0*B>57MYu%J$oq?ve)?D z94CAM6&+r|rleXI$vty`NIT>*iW(^+vjwgu<*@;?&{5S)p_W1-^@W=69>Re~Foi^N zXV7SqAp{ExwINy&lS7mZQ;}Ys)Rm9og-sRmbA8IJ?3FVGB*&1@x%!Cwge3FTM}B1q zd5HPzQ)}K1#;^-PzY+Wj$ekop+@GH^9A%?vka}`G3(J}{T zNLs@eWkwr*)YZoja~1ik#!;_vdQ6YJb<)DgHWwtw9m_<(u2*!K<&5AjS9Red7igD_ zZWqynuTYERBh)^wO`R=U)LuyN!dKf633rhz7bMkb*q9%7lG^ai6qTtkvpQoKah0hg zzj75~nWg;*-Hb+;4LurKM(_akx~1kir5(Zy@+WPw_6=@9z(~jHh|>`YVV&R8n%t9 zOxP&1=r*g+N`&eQ^~DelA413!B7JGd3=Wf#yDLh#(PWZflA?ChmZ{uWa~~?F-P0kZ zQb?81TJykebtaOtJ7;dC8@+uLMZkk`9naCptRhPkt5lG+z_?fxhNb9-Con1}P^iT5 z{-*CpkIWqg-VL=E5B%YV9*+8~mL66kJuLUbrBM4xEVHD|l~GNROz9jBMtLa!&dEXs zvx-;|NSa8*t|--F4BAFdg3pkhp++rIjqXH1xd;a-ZdEhIf;JQ303oQ|n7K|RrYBcJ zIpyAP?U>0z#PC@M&3&Ib>z{=a3sp6Dg$fB&>p(U41I%-7Ce6(n&VGU;MAgG*QL-pf zG$}ozm!d0@a3FteQSs6^mnkQ*vram@58uO`F^5rB0qDt4ZYkjp=myR>+%9uyDMQVoQ$XDg7@I=3s!*n( zw%f@wi4ink7HTgYaOHwl9lj#tQ^iy8vUEoOv1*2>ov`$;l zw}_iX3KL8M)>sE`V7BN3$Uf6Rx^sXtj?+`P(bnNecOIRge=4KIYt@ZnIfmAqS|OfK zspb-WZf|_7C;+W zMMiu@XUHc~nVX6e4yUTg%4Q5YK9e(6MB;sw$`fa18<|3i2Xsrxyc$3VRn3E}2z=f( z3#mQCRZakey#5rNztj}n(in87S*PqKHW+GWq3xY~yG(Yd%2Ox!FThwbC$k1u^~)lJ zuoF^t&j7vv`0^a;`Y}*PnYyTl5}W?#mnLFxxrCuLZU4MV|D5MN!ap}+Z*5Z}uB+)q zuX>cn54+h7#^%t%3RJMvn6V1=3)IUMX9KU~Q$^JFqwUy{WM$X_x#X?A#c)2x56&&x+@9mjFV zct8xE@efXTrm$T&$pnXDZYw1f>JSPdXj00=Xlg-Em)Rv(O6Q$+((jq{_>UwDz z6nr^z$QXTLWWO<0?ze8%tL0h&iA3bs#M&f(jU0(0%6GhUo-*E$xn6wdqoJS^HIw## zX0LnV!1AvhFi`|c3ry-^N%!*c(2A-oEgShQ_y|i-bs|uOyO%Y$g#&hd&6mmnh66wo zt;0lb+ino=WAHC>@CI^pk)l3-VFk^r!rg&~rKs)L&JtZA1{_QHXvqlUf|$itFl7bp zm{61xf;g6z-_5`oSk~M{V~-DVZF2ypgjap9{+=mFDrced{uVuAeJwSd321ot4evWpRS)%oZOorTos zsSM9w*R$_{OIN2qd2x9n+~o0Yw}%oO7#mxSouNFphtk^Ho2_$H4P_pmwdkSSywpc*{y>W(s zOXu9bE69`HyLU%(!#LzddDgjNkLjO>nKSaTpvy^zJ%Bn=1cSxWVIG!X$KRxXGX0M( zF|ml?7e*mkzat3usYjE>+~P3(D332k(~r*r?<-I5_^j?Bs-LmK7L^9s3_?SlA(DS8 zqOKP5MJ=WIG~zpQb1lpVs(!a|mSfD09y(0_yVoYndZkiD@SaBbmr-9vvTix6G6XDE zHxltmO5NVA<1~=xGfvhVCT9Wv?kGrAp*$#-390_6n}|RF;#6Sj=7Iq6c649?5$qvm zk1q1YkezsgAUGm=**8%Rgq#7NF&6Mp7TS$U%2#-N2Lp?yaP5w$p2)_~qAZ|BBwtC> z3x*%QjicWCsQAK?)`@~U?#K6Q=6#v#S_2A|E(;>A)sg7(<(v*Cyh!@AzSJG~!bWWg zgY%5qQKPUw;x2{}VwE=(oQ$xn;Vu`3$`(u+H7ljNh$56Ei~^lyCpa#3-DbE!G%4o}TY0j!t?Yzy z=@9a4m@(t8&?bOYbz4@J0cOO7f*d>K@}bIQ6VV_NT8zdwT_A%1$afdLN0AA{6D=uW8wS)K}m2oS;1E*EoBk@GTUKF`?1XGuP)^MC+sGRr z2^2Ku!wY0EvJyCj8^Ch`v;u@x+b)x5{LE+GM7RnY0~09o5b!kbt{|si?=CAE!cb|< zv99feV>zXCCx!rFE)+x>Ga3oplF;1%u<#&|?<6A%<`si7id{K3DBOokbmq+92If`E58m&5d~w=8d14QHm;-m#z4uJ;naMI^$Q6r-I;rQXFEWB0Vf+h5m-A} zZ>W&pL*X5~&ERz%%T+>1T!&Sqd2Qk>tbj6zXlXH@hJzpJMsp$t^fTNcCv+JJa!=+< z#=juXsuDSXf%&~}l{L4~dahoruh)~xe()pP6o~kSrHQDV=&AuEU7c@J;Lge9za`Hq z(7|caHZAK^ONv_x+ms(Oe2UDDvau6d&!$5e1{*-Mqh&irA|(pN4O+$eYgb~- z23g9zc66eNY*S3VHAjeh#eEdX`&eISwr7`7wPRj}q-zW;!G`^huV`0re`QVWfdg|& zvwzY!fPqGmu(<>$qj^7+Phd#=jb~JF2oX6%-xj=#2iXEI(jZR;?@VAy$@p>!lIvs zunAAs5fOBc!bj2fLFbv=Wfd*QPmrYTDs8U2g#AsSX5c_+k+D{l{r9JT%Vug6lBeosJzXz{ zYH$tBx`~Lq@<@fFy%UGl-&x-j;ew`a^6&xspb$ce>h_F^m1bctm}G!meH;14WJX|d zi;OT2C&MVDJ#z>p9wI(^?1Dr@1^qx|xcR+NwPe9kEDX45Di zmDLCVrbo~@!iFp=X<+T+cpAwoQF96P3ZV&y%tuDR+%b_}tz^u2B7sB<1pS5SJ*>~7 z*pXE*YjMy;g5;XDIK%Df_mtV()~r%_{f#$*S8%y~<>M=$8EcRP$*|r_@>4b(_A}B! zODzrRuySt4L=go}`b%m3`fd2eb{$FTfwMGUDvwMa_QiZG7Z%RLQ2TD+0WrGn=lw29 zbrD(>b6e;s*GxL4M5HLrzp-s3940fftUBp6NjBuYk;sqjn44lQq<_+R{VJ4>91jb3 zP5q}7_}oE(4-5G=Gr63~x^@YnjNvItqFq1MS>$;34%}+j$>QwCE?<&)JRDMsw8lsd zZ$=Hw%q)P`aCgUBq2h!{-D1jdmwu(_!(^q#93q0am*lHvt_|zEMds3*u|g3FsR;$>U88AS^EylTM04!C!j}`9d zjT#VVFl3OX{~mH=hOvc@J8*pu9ie86WfiHx^s6!MhNiwZzWTfF0bT8S2AV=F2Q|ug z-aXz@BCn&NTE#lSS-u+)jE#>ta!B7+fY{i42?;R}YP<39BTzxTi4Pc@|KPQHZm=`> zM5VH~v4t?F3I~@rdHd#E0?4}y7~4rVR+2LBXzLcUSk#bdp8f{t5{H3b9?c>l)X2wi z_G8CY0g=v2;Y1y$0?bB1sxQc)VF!?ra@cZMRY&Znl)HJ08a$;+3{X&ziqyEH1b2iQ zbF08SeW5Kpl@Y`0Ksm;+jAhs|`h>_Lv}joI1oiPq@yoCkiVVLWAea|lq)8@b!LHsz zY|beEwAaN+?1_O-o+~z!J9QuJZuiu{=U){KR(Qa#8ZM|a!fzZ@v>eKg@TIQ?W7%)* zqpr*;LlVh_XU7PiKd^dkL5W=vW8izLinh0=A+>;!yE z9Gsn;wV4HMh-#c5t6eaV{W&$>Axf$`NT#&}ZYqZ-Whp6bW z%U}%Tv)&^&9mC8ZKv1C9&Ohv(v>??;&= zcA-5uL4|@-g=yfkLM#vywu{Bw27JnZ2K$BH4+cb0BdX72#thqM;CqORyBdF&Em>5m zaYi;xZHO3H!dS{*|{-@c7O z6E|t!I%;*qricx;oQEYB$mHD!v5;hwweMW{NH1p<-2W4jXTNdqgymz#PjQ|IG(-)z z)^0#_B<#-B_y_F5+UN_LF?o<_gl7bI3ooAUv*+YY0WSE!=C%GQPC%O|73_;&7%+aC zFQVGhC^=F?h}uvN!}OoT8J~36v1*;*I20LB)C`KoeBN$HYQ1aqDVgGF3}z^(__7*y z#Tcp=?XD{J70hSXlnH6;4=9jlorB{>=g2xV{xRR>d@%zt$D@u`I_t{{G>e#1enS8O zqBgU7k~_A0s3#GN;eHMmWZ?5!aP`3fzGl&$9e1%}&Qubh3?UHGZVQTJJr=J(+`ACZ z?kTF4D_Wv$HF|a*13yAj(d6s)#rIz1UH)JKSf@{ohc5;AioWr+i+b8SfkJ074`e*C zX8y{9*5ttiDA;d7{^SZM75vbG!#nK$$p;e?39ZU=ORCV0vshWA=upg1I@aei13@F| zQYs&;zlHB%gyKEqZ!~nUO<1O69c(;Fht>CRQ0}~rxSl0B+^MN^D*_uBo^_ z&5sxoPj)~NjN5Q~{DN5SMLpz5Sn#VEo3@YwFw?DhX%0WgP z@f(WmZA!Bt@GP2@RVWZ5WCReva^=z{$x&)P}1TISw2nDvHZrc zi$cX~1gZOwa_HgKK00C+o&)r9Nn?qdVtsgEol+4&8!<$Ol4j|s!%RK5cmXKntRXaF z*+Mq@L1Af7nI~SxCm~5l=(qdbpaw&#$=o#v+iyIl1ZdB@XV8(B@#B|3SQfqNw%(BJ zY$!N~Z?-<9?ctafYK_62)l{NrQ#wd%C>4o@@1ZG*{8l+-Hyg?}cm4p&z;iuoaMtVe zg~7#hEht(Dh%GrnCBSy}EPD=^`_EqD&xLFsQ#sK{ad?~2g4%QHMu!jfEvW@g+bvLJ z&^43-ceV|V#8(_-1#(BTdxqKaNQBaIs69hTSYK$0GiZDWo{)qi+dK;)l$;V&_Msa+ zHP#sQxV6ut5pI=K1m?I74GN*-UN=xn0@_LcCf(f^PEzMN&SaiRxyII7Fm%w|tqzWC zq|iSjf3r9o#1Qhr;#_I8g+a0H8^&+9U_+pGXw_|^*jh(8E*~`7XF@G`)*$P|f1g`l zac#8FUOnkpxZ@~s`VqR|GS?3wLm(5?>tfCg;jrOIh`V4RJtdXQoO5uqN%n)18U!Sd zp0F-WvV*3FwK-anKv2WC2#2Ge90G}EAkV3SfT3jQGeJxaP%jtM4sF|G4@y1kFj)Vz zJNRd#tK{Z0UE`8UN!kV&+_~jCO+l?7_*)#J$>XvI;@f6r^pI@MGL8)G6b1O*L)3%^ zgk_X01|kXNH#|DqbmwZDf9xLDAcgVZ04krwpy1qNXixla@T_%U8Th#bxVJ)rXl0Vg zDwK?Ci;W+;g60iyu#kP19V8pcPqh0nMUipqC)Etwg!ja{k zLN*}WjW+0Bm`sD#oP*cZGnAzL5gxe0`CODd>h?60N&EXN*U9N?M_mes^Vx^+u0&8{ zD78t)KSI$w9VBOBwxeVyk0$9J*{$c?Cya^-3jYWk4LvqV{}f699vG)S<~b_slk2^f z)$DT{pftDWUxO|}FrHJg?DtclN^J-;1?L7f`+H5yI4WTmjKY)Vs@332oWVPICQCJj1}b0q8Y%SdgB5Cy$sB5u(EtNNy2(IH=xPnWu65*0 z8+*rP1sRkj7I!)WiJuj+r_@ovUAMydP&)tw07hVl_A8(9vs@Q zwcYuk?P%Mse3vm9hU2`!2Vxs3I8^VV9Fvv;x_`7wP*`)h*?0>~s+_r8b^4;tN5TYi zyM{K{P*%{D979KdJ0x6X83&0qAZ~yQ#5k$v#0!voJ5J79gNBYx6Alx@OSw`i47-Q( z_lQv^^l8g+v-Zl9g6Mr3cM)_$Xk_6$>;S_LY`Dwb!nfSZVXk(}f_)Luy`h+p{YLNL zn6!hCG@Kw$*&cEsv{MUqLJ&vOe1?z96(Q_UghY@`!wzESpu))CVbBEWJq zWL;H)c2T>j02W++C#1VM2{N#(XLOcO`Ba#eu)B&$n6yopm zcK|K>A>%i`1p}r&9Q5!dp&PJ}tRl(OY*}qE;!qJgk15s06YOq2UfHDjpv*^` zJ8ATvXmESAZ~#+=Q-1(jNSonDf1zSaaM;{_5l=sl9Y9*#(`muesV~1+@+{my;hU#( zIOOSlfDa5H9S7Z0NHN|HU5#=#PwxnN4`(`PF?}~Q<>)*z4|F~TO(o}{pGebj$k7RK z29N=agik@Go}hyQ&PRGp>I^(ABL_acFft+U{GBoihje#5JyCNLpfeZ7o;aiNe#m!* z_EU6gWzNTaFN_bEB200RU_?8_k64m6;=6Y^L6Q$)KuHX#Ua}IP1X=hd0lA{4x;JEXF6@Z$XA)AFBBYts3=# z5K!Ts!J@Q2XdRv*2(*<0=16vRI)T0WbO;#HVb)?Qb|3(?D0LPZ?T4X>X`maLkC8KV zmQJ4V*$j;#gyRJc(;Z!8M|Wb%!tZ8cOymPZC{4$Rq6O|3Nfz5?aToAwE5(Kg;^2VN zii2;EGR9A4>GtfMC4r?tN++?Uh;WQbSGqKyD^$f1Vq)=;rOYIr3wH4O40G=vAnhjJ z3D5YV5(S1GRMa$BLVP>=M^+E9e?v+LHXECX0zfh8V&4 z*PrJv-paGi(O;;=uUSca$c4f#6mg-b3oW?Nq6;m#(6S5NaiO~|H19&X3*B;|+b$Gv zp*a@{y3no*?X3;L^bmaDf-5dmRU87iCqT~1_wsJ9z4wOT!y&lgf^U1UWf!|wcfq$k zaNNZfTxc)rf~@NS2s3+)ZTnu~noLZ%CqTxf4+2tIbfA@c1Z zSaF-TU1)E(w7uLATXex9W-mnJ{H*tevq`wUhZ|6Ko?Dkc)pk=PK<%?F1^%gIR^}Mo zr!y`z7&kT&j+ ziIHEIcF`jEP;9AX^rzUrspPgJ<70=;|B-Ik2|YtzcV#YZUke`IMsmH&?{{OwES z-aFCYHT`L%`DWxS`ZRhoyteW*>T9FIZxt0{>+7%_>QnrtbK@X vf%&Hq{x1G!|9wV*&nWO21wNy|XB7C10-sUfGYWi0fzK%L83q3Tq`?0M3vOw7 literal 0 HcmV?d00001 diff --git a/build/build.tcl b/build/build.tcl index fddd9a04..c95deefe 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -436,6 +436,48 @@ expect ":KILL" respond "*" ":midas sys;ts srccom_sysen2;srccom\r" expect ":KILL" +respond "*" ":midas .mail.;comsat_sysnet;comsat\r" +expect ":KILL" + +respond "*" ":midas device;jobdev dq_sysnet;dqxdev\r" +expect ":KILL" + +respond "*" "comsat\033j" +respond "*" "\033l.mail.;comsat bin\r" +respond "*" "bughst/<<192.\033_24.>+<168.\033_16.>+<1.\033_8.>+100.>\r" +type "domgat/<<192.\033_24.>+<168.\033_16.>+<0.\033_8.>+45.>\r" +type "tcpgat/<<192.\033_24.>+<168.\033_16.>+<0.\033_8.>+45.>\r" +type "debug/0\r" +type "xvers/0\r" +type "purify\033g" +respond ":PDUMP DSK:.MAIL.;COMSAT LAUNCH" "\r" + +respond "*" ":kill\r" +respond "*" ":job comsat\r" +respond "*" ":load .mail.;comsat launch\r" +respond "*" "debug/-1\r" +type "mfinit\033g" + +respond "*" ":link emacs;rmail \021:ej,emacs;\[rmai\] >\r" + +respond "*" ":midas sys1;ts rmail_emacs1;rmaill\r" +expect ":KILL" + +respond "*" ":link channa;rakash cnavrl,.mail.;comsat launch\r" +respond "*" ":link dragon;hourly cnavrl,.mail.;comsat launch\r" + +respond "*" ":midas sysbin;qmail_ksc;qmail\r" +respond "PWORD version (Y or N)? " "Y\r" +expect ":KILL" + +respond "*" ":link sys;ts mail,sysbin;qmail bin\r" +respond "*" ":link sys;ts qmail,sysbin;qmail bin\r" +respond "*" ":link sys;ts qsend,sysbin;qmail bin\r" +respond "*" ":link sys1;ts bug,sysbin;qmail bin\r" +respond "*" ":link sys;ts m,sys;ts mail\r" +respond "*" ":link sys2;ts featur,sys;ts qmail\r" +respond "*" ":link .info.;mail info,.info.;qmail info\r" + respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" respond "*" $emulator_escape diff --git a/doc/_info_/qmail.info b/doc/_info_/qmail.info new file mode 100644 index 00000000..09884088 --- /dev/null +++ b/doc/_info_/qmail.info @@ -0,0 +1,148 @@ + QMAIL gist: + +:QMAIL name@site,name2@site2,... + ^C + + QMAIL details: + Qmail sends messages to people over +the network or locally; the "Q" is for "queue" as it +always operates by queueing mail to a special +independent program which does the actual sending. +It can be used as something of an adulterated DDT ":MAIL" command +as shown above (":QMAIL FOO MESSAGE^C will work), +but is much more useful when one knows the +magic character... i.e., alt-mode. + + (alt-mode) followed by: + ?- lists commands. + T- To: ,,... i.e. add to mailing list. + U- Un-to: ,... uh, take him off mailing list. + '*' works as either a name or site. Alone, flushes all. + S- Subject: specify a subject line. Null line deletes. + F- From: this command is unnecessary unless your UNAME + is not the real you. + A- Append at end of message text. + Q- Quit, as in :KILL + +----------------------------------------------- +Keyboard notes: + ^G: stops typeout + ^L: re-displays mailing list and text. + ^Q: quote next char. + CR: safe reply to most any input request. + RUBOUT: is moderately clever. + ALT-MODE: command invocation, echoes as a ">" prompt. + + (on TV's) +META & TOP: will quote and TOPify, respectively. +----------------------------------------------- + +OTHER COMMANDS: + + /- Slashification switch complement. When on, characters will + be converted to lowercase unless preceded by a slash, + just as in TECO. Useful for entering lower case on + uppercase terminals such as Datapoints. + L- List the mailing list. Useful for non-displays. + Z- Zap, i.e. clear message buffer (but preserve mailing list) +^C- Sends message but restarts Qmail instead of quitting. + Note this is ^C, not just plain ^C. + + W- Write containing message text. Useful if Edit-escape + (see below) is too kludgy for you or doesn't work. + I- Insert Just like Append. + Y- Yank in as message text, anything already in message + buffer will be flushed. + G- Get Starts reading data as if it came from the + console; information in the file will simply be added to + whatever already exists. Commands can be given. PUT + will write a file which GET understands. + P- Put out which contains all info necessary to recreate + the entire message. + + E- Edit Escape to TECO. + This writes a file named _MAIL_ _EDIT_ on the + directory the user's sname points to, and valrets a + ":TECO _MAIL_ _EDIT_" to DDT. In most cases, + barring invalid system names and cranky TECO INIT's, this + kludge will get the message thus far into a TECO + buffer, where the user can then edit + to his heart's content. When QMAIL is + proceeded (not restarted!) it will try to read that + file back into its own buffer, so after + TECO'ing the message one should write it + back where it came from. (EWEE) Some time in the + future this will be replaced by a more + winning invocation; until then, good luck. + + R Receipt-switch complement. Default (off) means + you will be mailed a receipt for only those + messages which could not be sent immediately. + If enabled, receipts will always be given. + This dates from days of unreliable service. + + V Variant force. Default variety of message is ITS for + solely intra-ITS mail, TENEX for mail with one or + more non-ITS recipients. This command will force + format to whichever you specify. (CR restores the + default) + +============================================================ +Syntax of a "name" or recipient + + The general format is , @, or +%. (From TIPs, % is easier to type). +All reasonable host nicknames (and unique fractions thereof) +should be recognized. Let me know if your favorite +names aren't there. + There are two special "name" formats with +special effects. One is "sticky site"; giving +a host specification (i.e., "@site") alone will +make that host apply to all subsequent names which +have no host spec, but only until another host +spec is found. If this is another sticky site, +the default host is now this new sticky site, +otherwise it reverts to the local site regardless +of the unsticking host spec. The idea is to +be able to specify a site and follow it with the +names of all recipients at that site; e.g. + + @sail, foo1,foo2, foo3, bar @ ml,friend + sends to FOO1, FOO2, and FOO3 at Stanford, + BAR at Mathlab, and FRIEND locally. + + The second special format is "(filename)" +where the file is taken to contain a string of +names in the same format as might be typed in; +that is, a distribution list. The world is +actually pushed and popped, so distribution +lists can include the names of other lists, to +a depth of 7 or so. E.G. + +@ai,larry,curly,moe,(klh;people list),oof + sends to 3 people at MIT-AI, to all the + recipients listed in "klh;people list", + and OOF locally. +____________________________________________ +____________________________________________ +ADDENDUM + + Also, there is a job (disowned, variously named +after some communications satellite or another) which +does the actual mailing, and enables +network mail to be "sent" irregardless of +remote host status; the satellite simply waits until +the destination comes alive. If it is running, +mail should be delivered within a minute; QMAIL +writes the message instantly to a file and exits, but +the satellite may take a while to notice +the file. Note that this scheme is painless for +messages to many recipients, to dead foreign hosts, +and to large mail files (such as SYS). +If the satellite is not orbiting (or otherwise screwed) +mail will take longer, i.e. until it is restarted +or fixed, but will eventually arrive. +(neither crash, glitch, nor parity etc...) + +All bugs, suggestions, etc to KLH @ AI. + \ No newline at end of file diff --git a/doc/info/mail.12 b/doc/info/mail.12 new file mode 100644 index 00000000..d95e99ab --- /dev/null +++ b/doc/info/mail.12 @@ -0,0 +1,250 @@ +This is a first try at creating a new-style info file for QMAIL ORDER. +Now it's a second try. Make that a third try. + +File: MAIL Node: Top Up: (DIR) Next: Keyboard + +MAIL is a program for sending mail to users on this machine, or any +machine on the Arpa or Chaos nets. You can send mail to any known +user, or to a "mailing list" of users, such as people responsible for +maintaining a certain program. Here is the general format for mail: + + :mail user1@site, user2@site, usern@site + + ^C + +To aid TIP users, mail will accept a percent sign instead of an atsign +in site descriptions. If the atsign and the site are not present, they +are assumed to be the present site. + +The next node tells you about features of mail you'll use to type +in your message text. + +* Menu: + +* Keyboard:: Notes on using MAIL from the keyboard. + +* Commands:: Escape to more advanced commands. + +* Edit:: How to escape into EMACS with your mail. + +* Syntax:: The exact syntax of mail recipients. + +* Internals:: A brief explanation of how the mailing system works + behind the scenes. + +* Announcements: (SYSMSG) + How to read and send system-wide messages, and the + difference between system and bboard messages. + +* RMAIL: (RMAIL) + RMAIL is a program for reading, editing, and replying + to mail. + +* Babyl: (Babyl) + Babyl is, like RMail, an EMACS mail subsystem. It + differs from RMail in some respects. In particular, + it will run on TENEX and TWENEX. + +File: MAIL Node: BUG Up: (DIR) Next: Top + +How to complain about program bugs: + + :BUG program + ^C + +BUG is really the same program as MAIL, except that instead of giving +the name of a user, you give the name of a program. The message is +sent to the maintainers of that program - that is, whoever has elected +to receive complaints about it. Doing :BUG program is +equivalent to doing :MAIL BUG-program . + +Here is an example: + + :bug info + Msg: + The description of what bug does is unclear. + ^C + +If there is no mailing list on the current machine for the program you +are sending a BUG about, your message will go to BUG-RANDOM-PROGRAM, a +mailing list of people who are generally knowledgable about the system +and who will try to fix your bug or redirect your problem to the +appropriate person. + +The next node tells about the MAIL program in general. +Most of what it says works for :BUG as well. + +File: MAIL Node: QSEND Next: Top Up: (DIR) + +How to send a message to people logged in at other sites: + +:QSEND name1@site1, name2@site2,... + ^C + +QSEND is really the same program as MAIL, but it is used to send +messages to a person the way the DDT command :SEND does. The +difference is that QSEND can send messages to users logged in at any +site on the ARPAnet. If the person qsent to is not logged in at the +time the message arrives at the site, the message is turned into mail +for him or her. + +:S is short for :QSEND, not for :SEND. + +The next node tells about the MAIL program in general. Most of what +it says works for :QSEND as well. + +File: MAIL, Node: Keyboard, Previous: Top, Up: Top, Next: Commands + +After MAIL prints out "Msg:" you can just start typing the text you +want to send. Use rubout to delete the charcter you just typed, ^W to +delete the last word, and ^U to delete the last line. If you are on an +AI Knight TV, you can type Meta-Rubout (just as in EMACS) to delete +the last word. + +When you're through sending the message, type ^C. If you decide you +didn't want to send the message anyway, you can type altmode Q, or ^Z +and then :KILL. + +Here's a summary of what various control characters do in MAIL: + + ^G: stops typeout + ^L: re-displays mailing list and text. + ^Q: quote next character (altmode or control-character). + ^R: redisplay current line. + ^W: backward delete word. + ^U: delete current line. + ^D: same as altmode. + CR: safe reply to most any input request. + RUBOUT: is moderately clever. + ALT-MODE: command invocation, echoes as a ">" prompt. + + (on AI TVs) +META & TOP: will quote and TOPify, respectively. +META-RUBOUT is the same as ^W. + +The next node describes other commands which you can execute after +typing an altmode. + +File: MAIL, Node: Commands, Previous: Keyboard, Up: Top, Next: Edit + +When you type an alt-mode to MAIL, it responds to a single-charactar +command. Below is a list of the commands and a short description of +what they do. For more information on a particular command, run +the MAIL program and type ?. + +H Help , describes given command. +T To , adds them to mailing list. +C CC , just like "TO" except the recipients get listed + with a CC: header. +U Un-to , removes from mailing list. * works. +S Subject for the mail, one line (null line deletes). +F From . Unnecessary unless UNAME wrong. +E Edit escape to EMACS. ^X^C returns to MAIL program. + *Note Edit: Edit. +N Name for recipient list, header shows this and not real list. +L List the mailing list. +W Write message text to . +A Append to message text. +I Insert (exactly like Append). +Y Yank in, replacing message text. + +G Get from data as if typed from console. + Starts reading data as if it came from the console; + information in the file will simply be added to whatever + already exists. can include commands. +P Put to a GET-able description of message. +Z Zaps message buffer, and gives you an empty one. + Careful -- doesn't require confirmation. + +M Mode switching (mail, send, notification, etc). +V Variant force, specify type of header to use. + Default variety of message is ITS for solely intra-ITS mail, + TENEX for mail with one or more non-ITS recipients. This + command will force format to whichever you specify. (CR + restores the default). +R Receipt mode select - All, Queued, or Failed. + Default (off) means you will be mailed a receipt for only + those messages which could not be sent immediately. If + enabled, receipts will always be given. This dates from days + of unreliable service. + +/ Slash switch complement (ON = case conversion like TECO). + When on, characters will be converted to lowercase unless + preceded by a slash, just as in TECO. Useful for entering + lower case on terminals such as Datapoints. + +X (* msgs only) Xpiration date in days. +1 (* msgs only) 1st filename for .MSGS.; file. +2 (* msgs only) 2nd filename for .MSGS.; file. +(For more information on system and bboard messages see + *Note Announcements: (SYSMSG). ) + +Q Quit Asks for confirmation. + +File: MAIL, Node: Edit, Previous: Commands, Up: Top, Next: Syntax + +Type altmode-E to MAIL to escape to EMACS. ^X^C returns to the MAIL +program. + +An inferior EMACS is created, and the current message text loaded into +it for editing. One may normally exit from EMACS, and have the +current buffer loaded back as the new message text, by typing ^X ^C. +(Executing FSEXIT or typing ^C in non-^R-mode will also return). ^K +(valret) as a bare-TECO command will be completely ignored!! ^Z will +safely interrupt MAIL. + +File: MAIL, Node: Syntax, Previous: Edit, Up: Top, Next: Internals + +Syntax of a "name" or recipient + +The general format is , @, or %. (From +TIPs, % is easier to type). All reasonable host nicknames (and unique +fractions thereof) should be recognized. Complain to BUG-MAIL if your +favorite names aren't there. + +Certain names are recognized specially by mail. They begin with an +asterisk, and go the the "Bulletin Boards" of various systems. + *Note Announcements: (SYSMSG). + +There is a special format of name referred to as "sticky site"; giving +a host specification (i.e., "@site") alone will make that host apply +to all subsequent names which have no host spec, but only until +another host spec is found. If this is another sticky site, the +default host is now this new sticky site, otherwise it reverts to the +local site regardless of the unsticking host spec. The idea is to be +able to specify a site and follow it with the names of all recipients +at that site; e.g., mail addressed to + @sail, foo1,foo2, foo3, bar@ml,friend + goes to FOO1, FOO2, and FOO3 at Stanford, BAR at Mathlab, and + FRIEND at the local host. + +When sending to a Comsat site (AI, ML, or MC), you may use special +formats such as (BUG program-name) which reports a bug in a program, +(FILE [dir;name1 name2]) which appends to the specified file, and +(@FILE [dir;name1 name2]), which reads a mailing list from the file +and mails to the people in it. + +File: MAIL Node: Internals, Previous: Syntax Up: Top + +There is a job (disowned, variously named after some communications +satellite or another) which does the actual mailing, and enables +network mail to be "sent" irregardless of remote host status; the +satellite simply waits until the destination comes alive. If this +program is not running, MAIL will try to start it (a rare occurrence +hopefully); in any case mail should be delivered within 10 seconds for +local messages. What happens is that MAIL writes the message to a +disk file and exits, and the alerted satellite gobbles it up for +sending. Note that this scheme is painless for large messages, +messages to many recipients, to dead foreign hosts, and to large mail +files (such as SYS). If the satellite is not orbiting (or otherwise +screwed) mail will take longer, i.e. until it is restarted or fixed, +but will eventually arrive. (neither crash, glitch, nor parity +error will stay this untiring....) + +For information on the internal operation of announcements (system and +bulletin-board messages) see *Note Announcements:(SYSMSG). + +Send bugs, suggestions, etc. to BUG-MAIL@AI. + \ No newline at end of file diff --git a/src/_mail_/names.2006 b/src/_mail_/names.2006 new file mode 100644 index 00000000..3ec1c0e4 --- /dev/null +++ b/src/_mail_/names.2006 @@ -0,0 +1,150 @@ +;;; -*- Fundamental -*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; This file belongs on MD. DO NOT COPY TO OTHER MACHINES!! +;;; +;;; The format of this file is documented in .MAIL.;NAMES INFO. +;;; You should read that before modifying it. Also, there are +;;; restrictions on tourists creating mailing lists; see +;;; AI:ACOUNT;TURIST POLICY. +;;; +;;; If you DO mung this file, after writing it out look for a file +;;; called "NNAMED ERRnnn" or "NAMED ERRnnn" to appear, where nnn is +;;; the same version number you wrote. This file will tell you if you +;;; won or not, hopefully with explanations if it didn't. If this +;;; report file DOESN'T appear, either the mailer isn't around, or is +;;; busy, or is falling down in flames. (Congratulations!) +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Try to use only domain-style host names. +; (Except for specially known ITS hosts.) + + +;;; Various special sacred lists - don't mung these! + +(SYS-OPERATING-TROUBLE (EQV-LIST EJS)) +(MAGIC-DRAGON-KEEPER (EQV-LIST EJS)) + +; Mail maintenance stuff. Do not fuck with this. +(BUG-MAIL (EQV-LIST BUG-QMAIL)) +(BUG-MAILER (EQV-LIST BUG-QMAIL)) +(BUG-QMAIL (EQV-LIST BUG-MAIL-AND-POSTMASTER EJS + [KSC;MAIL BUGS])) +(BUG-MAIL-AND-POSTMASTER (EQV-LIST EJS)) +(POSTMASTER (EQV-LIST BUG-MAIL-AND-POSTMASTER)) +(MAIL-DIR-MAINT (EQV-LIST EJS)) +(MAIL-MAINTAINERS (EQV-LIST ([.MAIL.;FAILED STUFF] (R-OPTION FAST-APPEND)))) +(COMSAT (EQV-LIST MAIL-MAINTAINERS)) +(DEAD-MAIL-RECEIPTS (EQV-LIST [NUL:])) ; out for dead msgs +;; See message about this in mc:.mail.;names: +(NET-ORIGIN (EQV-LIST ; ([.MAIL.;FAILED NETORG] (R-OPTION FAST-APPEND)) + MAIL-MAINTAINERS)) + + +; Inquire database daemon. These are needed in order to update +; the database! +(UPDATE-ITS-INQUIR (EQV-LIST + ;;UPDATE-INQUIR@NX + ;; UPDATE-INQUIR@AI UPDATE-INQUIR@MC + ;; UPDATE-INQUIR@ML + ;;UPDATE-INQUIR@MD + UPDATE-INQUIR@ES + )) +(UPDATE-INQUIR (EQV-LIST ([INQUIRE;INQUPD RECORD] (R-OPTION APPEND)) + [INQUIR;.UPD1. >] + (PGM [INQUIR;INQUPD BIN] + (R-PGM-MNTNR BUG-INQUIR) + (R-PGM-DISOWN 6)))) +(UPDATE-INQUIR-LOSSAGE (EQV-LIST [NUL:INQUIR;INQUPD BARFS])) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Here is the stuff for *MSG message hackery. Any name beginning with "*" +;;; is by default of type *MSG, and will be given a *MSG-style header unless +;;; otherwise forced. +;;; All *MSG-type recipients will appear in the DISTRIB field, unless +;;; they have the NOTDIST option. Any attempt to actually send the message +;;; to a *MSG-type rcpt will throw away the name itself and send instead +;;; to the file [DSK:.MSGS.;1 2] where 1 and 2 default to *MSG and > unless +;;; explicitly specified via MSG-FN1 and MSG-FN2. + +;; The entry for "*" is the only one which varies in the NAMES file for +;; each site. +(* (R-OPTION NOTDIST) (EQV-LIST *ES)) +;; *msg mailing lists -- see .MAIL.;BBOARD INFO for accepted policy on +;; which list to use for what purpose. +;(*MIT (R-OPTION NOTDIST) +; (EQV-LIST *MAC *CIPG *DSPG *INFOODS *LIDS *PFC *XV *AMT *RANDOMS)) +;(*MAC (R-OPTION NOTDIST) +; (EQV-LIST *ITS *HX *LCS-UVAX *MLSITE *REAGAN *THEORY *WH)) +(*TENS (R-OPTION NOTDIST) (EQV-LIST *ITS)) +(*ITS (R-OPTION NOTDIST) (EQV-LIST + ES + ;;*NX + ;; *AI *MC + ;; *MD *ML + )) +;; BBOARD goes most everywhere but is not shown by :MSGS by default +;(BBOARD (EQV-LIST (*BBOARD))) +;(*BBOARD (EQV-LIST *MSGS-TO-ITSES +; (*REAGAN (R-OPTION NOTDIST)) (*WH-BBOARD (R-OPTION NOTDIST)) +; (*HX (R-OPTION NOTDIST)) (*LCS-UVAX (R-OPTION NOTDIST)) +; (*MLSITE (R-OPTION NOTDIST)) +; (*THEORY-BBOARD (R-OPTION NOTDIST)) +; (*AMT (R-OPTION NOTDIST)) +; (*EDDIE (R-OPTION NOTDIST)) +; (*INFOODS (R-OPTION NOTDIST)) +; (*LIDS (R-OPTION NOTDIST)) +; (*PFC (R-OPTION NOTDIST)) +; (*RANDOMS (R-OPTION NOTDIST)))) + +;; Hosts that can receive *msgs +;;(*NX (EQV-LIST *MSGS-TO-ITSES)) +;; (*AI (EQV-LIST *MSGS-TO-ITSES)) +;; (*MC (EQV-LIST *MSGS-TO-ITSES)) +;; (*ML (EQV-LIST *MSGS-TO-ITSES)) +;;(*MD (EQV-LIST *MSGS-TO-ITSES)) +(*ES (EQV-LIST *MSGS-TO-ITSES)) +(*MSGS-TO-ITSES (R-OPTION NOTDIST) ; This just makes above 4 simpler. + (EQV-LIST + ;;(*MSG-SINK@NX (R-OPTION NOTDIST)) + ;; (*MSG-SINK@AI (R-OPTION NOTDIST)) + ;; (*MSG-SINK@MC (R-OPTION NOTDIST)) + ;; (*MSG-SINK@ML (R-OPTION NOTDIST)) + ;; (*MSG-SINK@MD (R-OPTION NOTDIST)) + (*MSG-SINK@ES (R-OPTION NOTDIST)) + )) +; This is final "sink". Mailer converts to filename specially. +(*MSG-SINK (R-OPTION NOTDIST)) + +; Messages addressed to a BUG-type recipient that doesn't exist are +; vectored to (BUG RANDOM-PROGRAM) instead, at a host address patched +; into COMSAT at location BUGHST. + +(BUG-RANDOM-PROGRAM (EQV-LIST EJS)) + + +;; The remaining names are not necessary to the operation of ITS but +;; are generally useful, I suppose. + +; Plausible generic contact names. +(NETWORK-LIAISON (EQV-LIST EJS)) +(LIASON (EQV-LIST NETWORK-LIAISON)) +(LIAISON (EQV-LIST NETWORK-LIAISON)) +(ACTION (EQV-LIST NETWORK-LIAISON)) + +; Personal lists and stuff. + +(EJS (EQV-LIST [EJS;EJS MAIL])) ; Avoid clash with INQUIR mail address + +(INFO-EJS10 (EQV-LIST + ([EJS;EJS10 ARCHIV] (R-OPTION FAST-APPEND)) ; Msg log + (@FILE [EJS;EJS10 PEOPLE]) ; Distrib list + )) + +(ACCOUNTS-NOTIFICATION (EQV-LIST EJS)) +(USER-ACCOUNTS (EQV-LIST EJS)) +(ACCOUNTS-HELD-REFUSED (EQV-LIST EJS)) +(USER-ACCOUNTS-ARCHIVE (EQV-LIST EJS)) +(PASSWORD-SYSTEM (EQV-LIST EJS)) +(BUGGY-PWORD (EQV-LIST EJS)) diff --git a/src/emacs1/rmaill.8 b/src/emacs1/rmaill.8 new file mode 100755 index 00000000..73e4a714 --- /dev/null +++ b/src/emacs1/rmaill.8 @@ -0,0 +1,37 @@ +; -*- MIDAS -*- + + TITLE RMAIL LOADER + +;Assemble this into SYS1; TS RMAIL. +;Runs SYS2;TS EMACS with jcl of "2,MM RMAIL" and whatever JCL you gave it. +;The "2," causes it to kill itself if exited with Q but not if exited +;temporarily with ^X. Also have to save and restore Q9 which it smashes somewhere. +;Only works under DDT. + +A=1 +B=2 +C=3 +D=4 +E=5 +P=17 + +VAL: ASCII / :JCL / ;10 characters +JCL: ASCII /[9 2,MM RMAIL/ ;15 characters +JCL1: BLOCK 200 ;Original JCL here + +GO: .BREAK 12,[5,,JCL1] ;Get jcl + MOVE A,[440700,,JCL1] ;Find end of it +FEND: ILDB C,A + CAIE C,^C + CAIN C,^M + JRST FENDD + JUMPN C,FEND +FENDD: MOVEI C," + DPB C,A + MOVE B,[440700,,[ASCIZ /]9ī:LOAD DSK:SYS2;TS EMACSī:GOī/]] +PLOAD: ILDB C,B + IDPB C,A + JUMPN C,PLOAD + .VALUE VAL + + END GO diff --git a/src/ksc/ivory.12 b/src/ksc/ivory.12 new file mode 100644 index 00000000..759f27c6 --- /dev/null +++ b/src/ksc/ivory.12 @@ -0,0 +1,79 @@ +comment | +Definitions for purifying and relocating variables into +impure low core. BVAR and EVAR should bracket each group of +variables, which by definition are impure. LVAR may be used +for single-line variable definitions. + +PURPGB specifies page no. beginning pure code; +VARBEG specifies loc beginning variable (impure) code. Note that + PURPGB is a page number, while VARBEG is a location. + +VARCHK is a macro which should be called at the end of the program to +ensure that pure and impure storage areas do not overlap, and to +put MIDAS variables (foo', .scalar foo, etc) in the impure area. +It may be called more than at various places throughout the program, +and each time will define PURPGE to be the first page unused by pure core. + +TMPLOC ,{text} will assemble specified text at and restore +the loc counter automatically. + +To purify, use something like: + MOVE A,[,,purpgb] + .CALL [SETZ ? 'CORBLK ? 1000,,%CBNDR + 1000,,%JSELF ? A ? SETZI %JSELF] +| + +ifndef purpgb, purpgb==1 ; 1st pure page normally 1; single impure at 0. +ifndef varbeg, varbeg==100 ; Variables normally start at location 100 + + ; Initialize internal syms for B/EVAR +%%pbeg==2000*purpgb ; Loc of 1st pure wd +%%pend==%%pbeg ; Used to remember pure loc while assembling variables. +%%vend==varbeg ; Current first unused loc for vars +%%vflg==0 ; 1 when assembling into var area, 0 otherwise. +loc %%pbeg ; Start assembling into pure! + +define bvar +ifn %%vflg,.err BVAR inside BVAR! +.m"%%vflg==1 +.m"%%pend==. +loc %%vend +termin + +define evar +ife %%vflg,.err EVAR without BVAR! +.m"%%vflg==0 +.m"%%vend==. +loc %%pend +termin + +define lvar -line +bvar +line +evar +termin + +ifndef tmploc,{ +define tmploc val,?arg +%%%tlc==. +loc val +arg +loc %%%tlc +termin } + +define errmac a,b,c,d,e,f +.err a!b!c!d!e!f +termin + +define varchk +lvar variables ; Do this first; LVAR will set %%PEND properly +.m"purpge==<%%pend+1777>/2000 +ifg varbeg-%%pbeg,{ifl .-varbeg,{ + errmac [Pure overflow! ]\<.-varbeg>,[ words needed, increase VARBEG to ]\.,[?] + } +} +ifle varbeg-%%pbeg,{ifl %%pbeg-%%vend,{ + errmac [Impure overflow! ]\<%%vend-%%pbeg>,[ words needed, increase PURPGB to ]\<<1777+%%vend>/2000>,[?] + } +} +termin diff --git a/src/ksc/nlists.124 b/src/ksc/nlists.124 new file mode 100644 index 00000000..5f4e2c0a --- /dev/null +++ b/src/ksc/nlists.124 @@ -0,0 +1,1312 @@ +;;;-*-MIDAS-*- + +SUBTTL HAIRY LIST HANDLING UUO'S - description +IFN 0,[ +New List-area storage format: + +One list entity, or LSE, requires 3 separate UUO areas, termed +the HDR, LA, and SA, for storage respectively of Header information, +List structures, and Strings. The SA is simply an amorphous buffer +for string storage, and the HDR contains various addressing and +management information. (See "Contents of HDR".) + List structures are composed of linked List Nodes, or +LN's. $LNSIZ is an assembly parameter defining the # words per LN, +currently 2; this is constant for ALL LN's, which can be of 3 types: +value, list, and string. +_______________________________________________ +|Res |Data|Res | Attrib | | +|srvd|type|srvd| type | CDR ---------|------> next LN (cdr=0 if last) +| 0 | 7 | 0 | 777 | 777777 | +|_____________________________________________| +| | +| Data Word | +|_____________________________________________| + + The "Data type" field indicates which of these 3 types the LN is, +and affects only the interpretation of the LN's data word. It can +be considered syntactic information about the structure of the data, +as opposed to the Attrib-type field which is a "name" for it +and is purely semantic. The 3 types are defined below, one to a flag bit: +] + ; LN type flags & field definitions +%LTVAL==10000 ; data is a Value +%LTLST==20000 ; data is a List-Pointer +%LTSTR==40000 ; data is a String-Pointer +%LTMSK==70000 ; mask for Data-type field. +%LAMSK==777 ; mask for Attrib-type field. + ; BP LH for Attribute field. +$LAFLD==(.BP <%LAMSK,,0>,) +$LTFLD==(.BP <%LTMSK,,0>,) +$LNSIZ==2 ; LN's are 2 words. + +IFN 0,[ + A "Value" type LN (VLN) simply treats the data word as 36 bits of data. +For a List-Pointer LN (LLN), the data word is a List Pointer or LP +which points to another list of LN's. For a String-Pointer LN (SLN), the +data word is an string pointer (SPT) in ASCNT format, relative to the SA. +That is, the LH contains a char count, and the RH is the relative address +of the string in the SA area. This has the restriction that such strings +must begin on a word boundary. + LP's are, of course, relative to the beginning of the LA; this +allows fast shifting and loading, at some expense in addressing time. +The first LN in the LA (i.e. at LP address 0) is always zeroed, +to prevent LP's of 0 from doing anything. Initialized and deleted +LN's are kept on a Freelist, which will link all unused LN's as long +as no trees are accidentally left dangling. +] + +;PRINT VERSION NUMBER +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ included in this assembly. +/ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;; ;;;;;;;;; +;;;;;;;; CONTENTS OF HDR: ;;;;;;;;; +;;;;;;;; HDR Area Definitions and initial Address-table ;;;;;;;;; + +UHDRDF: + OFFSET -. ; So symbolic addresses are defined relative to beginning + ; of HDR, starting at 0. +$LHBEG::REPEAT 20,[%%IDX==.RPCNT + REPEAT $LNSIZ, (%%IDX)+.RPCNT + ] ; First of all comes addressing table for LA access. + ; (See explanation, "LA Addressing") +$LHLTB==.-$LHBEG ; This is resultant length of above table. +$LHARP:: 0 ; Stores addr of ARBLK (ie ARPT) for this (HDR) area. + +$LLFRE:: 0 ; +$LLLST:: 0 ; Main List pointer. +$LLFRL:: 0 ; Freelist pointer. +$LLFRC:: 0 ; Freelist count. <# free LN's> +$LSFRE:: 0 ; = <# words used> +$LSGC:: 0 ; <# of wds SA uses which are garbage> + 0 ? 0 ? 0 ? 0 ? 0 ; Spare words for easier expansion. + +$LLAR:: BLOCK $ARSIZ ; LA ARBLK, with various auxiliary defs + $LLLOC==$LLAR+$ARLOC ; abs location of LA + $LLWPT==$LLAR+$ARWPT ; abs write ptr + $LLRPT==$LLAR+$ARRPT ; abs read ptr + $LLLEN==$LLAR+$ARLEN ; area length + $LLCHL==$LLAR+$ARCHL ; # chs left to write in (if type %ARTCH) + $LLTOP==$LLAR+$ARTOP ; area lastaddr+1 (loc+len) + +$LSAR:: BLOCK $ARSIZ ; SA ARBLK, exactly as for LA. + $LSLOC==$LSAR+$ARLOC ; abs location of SA + $LSWPT==$LSAR+$ARWPT ; etc. + $LSRPT==$LSAR+$ARRPT + $LSLEN==$LSAR+$ARLEN + $LSCHL==$LSAR+$ARCHL + $LSTOP==$LSAR+$ARTOP + + 0 ? 0 ? 0 ? 0 ; More spare words. + + ; Any other assembled HDR defs must come before $LHEND! + +$LHEND:: ; Highest used. Can expand HDR area dynamically above this. +$LHSIZ:: ; Minimum size required for HDR area. + + OFFSET 0 ;Back to normal LOC + +IFN 0,[ + LA Addressing: + + The REPEAT's at $LHBEG represent an addressing table for use with the +LISTAR macro. To "directly" address a location in the LA, AC L must be +loaded with the address of the HDR, i.e. the $ARLOC entry for that area. One +can then reference anything in the HDR with constructs like +ADD A,$LSLOC(L). However, to address a list structure, one must have +the LP in a register (say C) and use MOVE A,LISTAR(C). The idea +is to treat LISTAR as equivalent to the absolute address of the LA. +What it actually expands to is @(L)+<$LNSIZ*C>. Thus, it indirectly +addresses location $LNSIZ*C of the table, which contains (C)LADDR. +The use of $LNSIZ*20 entries allows references such as LISTAR(C)+1, +etc. to win, as long as the additional increment is less than $LNSIZ. +(unfortunately due to macro difficulties one can't say the more +usual LISTAR+1(C). ) +] +; Special macro to simulate start addr of current LA. +;note that one must say LISTAR(X)+1 instead of LISTAR+1(X), +;and an index reg must always be present! Better than +;nothing though. + +DEFINE LISTAR ?IDX +@$LNSIZ*IDX(L)TERMIN + + +IFN 0,[ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;; ;;;;;;;; +;;;;;;;; Disk Storage of LSE's ;;;;;;;; + +A list entity is stored on disk in a "List Block" of the following +format. Any number of such List Blocks can be kept in a single file, +since all information is relative to the LB or its internal +HDR, LA, etc blocks. Since disk storage implies that formats +must be adhered to in order to read previously written data, a +version numbering scheme is included so that new versions can +be introduced without destroying the ability to read data written +in old formats. The point at which conversion takes place is +in LSEIN, where the disk data is actually read; user routines +should never have to know what the version number actually is. + +--------------------------------- +0: <# words in total blk> +1: +2: ,, +3: +4: <# wds in HDR blck> +5: <# wds in LA block> +6: <# wds in SA block> + + + +rel loc of HDR block: + + ; Immediately follows HDR + ; " " LA + + +-------------------------------- + + The contents of the HDR, LA, and SA blocks are exactly as +they exist in core, and they can be written out directly. However, +on readin some HDR-block parameters are of necessity reinitialized, +such as the LA addressing table and the ARBLKs for the LA and SA. +Those which are invariant and meaningful are: + $LLFRE - rel addr of first free LA word + $LSFRE - rel addr of first free SA word + $LLFRL - Freelist pointer + $LLFRC - Freelist count + $LLLST - Main list pointer + $LSGC - # of garbage words in SA + + The can be anything which belongs +in the block somehow, and is meant to allow for easy addition of +new features, but it must all fit within the block bounds as specified by +word 0. +] ;end of IFN 0 + + +SUBTTL LNCOPY - LN Copier. + +; LNCOPY AC,[[addr of LSE] ? SETZ [lp]] +; General-purpose LN copier. The given LSE address (HDR loc) +; specifies the "X-LSE" which the LP points into, and the list +; pointed to is completely (CDR and all) copied into the L-LSE, with +; pointer left in AC. (Note: If the specified LSE's are in fact one +; and the same, "pure" strings are used for fast copying.) +; +; LNCOPY AC,[[addr of LSE] ? [lp]] +; Without the SETZ, acts just like above, but copies only the +; single LN pointed to, ignoring its CDR. + +UUODEF LNCOPY:,ULCOPY +ULCOPY: MOVE U3,U40 ;get addr of 2-wd block + SKIPE U4,(U3) ;get addr to LSE-address + SKIPN U4,@U4 ;if addr and LSE-address both non-zero, get it. + MOVE U4,L ;else use L. + EXCH U4,L ; Reference X-LSE + HRRZ U1,@1(U3) ; to get LP. + CAML U1,$LLLEN(L) ; Check range + JSR AUTPSY + JUMPE U1,ULCOP1 ; Empty list +IFSVU2, PUSH P,U2 + MOVE U2,LISTAR(U1) ; And get first wd of LN. + SKIPL 1(U3) ; Now if sign bit (SETZ) was set, that's it. + HLLZS U2 ; else must flush CDR, for single-LN copy. + MOVE U3,LISTAR(U1)+1 ; 2nd wd of LN. + EXCH U4,L ; restore LSE pointers + PUSHJ P,LNPOP ; Get a free LN to copy into. + PUSH P,U1 ; and save LP, because ULCPY doesn't! + PUSHJ P,ULCPY2 ; copy it. Special entry needed to allow single-LN hack. + LDB U2,UACFLD + POP P,(U2) ; restore LP to list directly into result AC. +IFSVU2, POP P,U2 + UUOXRT + +ULCOP1: LDB U1,UACFLD + SETZM (U1) + UUOXRT + +; ULCPY - List Copier. Given LP in U1, copies and leaves new LP in U1. Thinks it is +; supposed to copy from X-LSE to L-LSE, specified by U4 and L +; respectively. If c(L) = c(U4) then string LN's are copied directly +; with no re-writing of the string. Clobbers everything but U4. + +ULCPY: MOVE U2,U1 + PUSHJ P,LNPOP ; U1 = new LP, U2 = source X-LP + PUSH P,U1 + PUSHJ P,ULCPY1 + POP P,U1 ; restore LP to new list. + POPJ P, + + ; Workhorse for ULCPY. This routine takes LP in U1 to destination + ; LN, LP in U2 to source LN for copying. Is able to iterate on + ; CDR to copy list because it need not worry about saving U1, which + ; is up to the caller! +ULCPY1: PUSH P,U1 + MOVE U1,U2 ; get X-LP out of U2. + EXCH U4,L ;To read from X-LSE, put right thing in L. + MOVE U2,LISTAR(U1) ;Get first wd of LN in X-LSE + MOVE U3,LISTAR(U1)+1 ;and second. + EXCH U4,L ;now restore LSE pointers. + POP P,U1 ; restore new LP. +ULCPY2: TLNE U2,%LTLST ;list? (note - entry pt for LNCOPY UUO.) + JRST [ PUSHAE P,[U1,U2] + HRRZ U1,U3 + TRNE U1,-1 ; Skip if LP = 0 + PUSHJ P,ULCPY ;recurse, copy list. + MOVE U3,U1 ;get returned LP + POPAE P,[U2,U1] + JRST ULCPY6] ;and go store it as value. + TLNE U2,%LTSTR + JRST ULCPY8 ;if string, go to special rtn. + + ;consider it a value. +ULCPY6: MOVEM U3,LISTAR(U1)+1 ;store value + HLLZM U2,LISTAR(U1) ;store LH only (don't have CDR yet) + TRNN U2,-1 ; If CDR non-existent, + POPJ P, ; then all done! + + ; Iterate on CDR. + MOVE U3,U1 ; Save new-LP temporarily + PUSHJ P,LNPOP ; get LP to be its CDR + HRRM U1,LISTAR(U3) ; and store CDR in the LN! + JRST ULCPY1 ; U1 = new LP, U2 = source LP, go copy. + + + ;copy string. auxiliary part of ULCPY. U2 and U3 have wds 1 & 2 + ;of LN to be copied. U1 has LP to free LN to copy into. Copies + ;string only if LSE's different, and puts new SPT in U3 as value. + ;Mustn't clobber U1, U2, or U4! +ULCPY8: CAMN L,U4 + JRST ULCPY6 ;if LSE's same, just use same SPT. + PUSHAE P,[U2] ;else must actually re-write string... ugh. + MOVE U2,U3 ;get original SPT in better place + HLRZ U3,U2 ;get char count. + ADDI U3,4 + PUSH P,U4 + IDIVI U3,5 ;find # words necessary for string. + POP P,U4 + ADD U3,$LSFRE(L) ;get what will be new $LSFRE ptr. + CAML U3,$LSLEN(L) ;compare new count with length of area, and + JRST [ PUSHAE P,[U1,U3] + SUB U3,$LSLEN(L) ;gobble more room if need be. Find how much + MOVEM U3,ARUNIT ;and set up + MOVEI U1,$LSAR(L) ; GIVE IT THE ARPT + PUSHJ P,UABUMP ;and get the room. + POPAE P,[U3,U1] + JRST .+1] + ADD U3,$LSLOC(L) ;get absolute end+1 for BLT. + ADD U2,$LSLOC(U4) ;get abs source address for original SPT. + PUSH P,U4 + HRRZ U4,$LSFRE(L) + ADD U4,$LSLOC(L) ;get abs destination address in RH. + HRL U4,U2 ;and stuff abs source addr in LH. + BLT U4,-1(U3) ;xfer the words! + POP P,U4 + SUB U3,$LSLOC(L) ;make end relative again + EXCH U3,$LSFRE(L) ;and store as new first-free ptr (swap with old) + HLL U3,U2 ;stuff char count in to form new SPT. + POPAE P,[U2] + JRST ULCPY6 ;done with string copy! + +SUBTTL List String Comparision UUO's - SLNE, SLNEA, USLNE, USLNEA + +; SLNE AC,[slp] AC must also hold a SLP (LP to a string LN). +; The two strings are compared, and the UUO skips if they're equal. +; Fails to skip if strings are different, of different lengths, or +; if a LN is not string type. +; USLNE AC,[slp] same, but forces both to upper case during compare. +; SLNEA AC,[ASCNT [string]] +; USLNEA AC,[ASCNT [string]] See below. + + +UUODEF SLNE:,UQSTRE +UUODEF USLNE:,UQUSTR + +LVAR UQSTRF: 0 ; Flag set when comparing with uppercase force. +LVAR UQSTRC: 0 ; cnt to loop on + +UQSTRE: SETZM UQSTRF ;clear flag (no uppercase force) + SKIPA +UQUSTR: SETOM UQSTRF ;set flag for uppercase forcing + LDB U1,UACFLD + MOVE U1,(U1) ;get acc = ptr +IFSVU2, PUSH P,U2 + MOVE U2,@U40 ;get addr = ptr + MOVE U3,LISTAR(U1) + MOVE U4,LISTAR(U2) + TLNN U3,%LTSTR ;be sure type is string + JRST UQSTR9 ;lose + TLNN U4,%LTSTR + JRST UQSTR9 ;ditto + MOVE U3,LISTAR(U1)+1 ;get string vals (# cnt,,addr) + MOVE U4,LISTAR(U2)+1 + ADD U3,$LSLOC(L) ;make abs. + ADD U4,$LSLOC(L) +UQSTR4: HLRZ U1,U3 + HLRZ U2,U4 ;try comparing cnts first + CAME U1,U2 + JRST UQSTR9 ;can't be eq if different lengths! + MOVEM U1,UQSTRC ;store cnt to loop on + HRLI U3,440700 + HRLI U4,440700 +UQSTR5: SOSGE UQSTRC + JRST UQSTR7 ;through, we've won! + ILDB U1,U3 + ILDB U2,U4 + CAIN U1,(U2) ;skip if fail + JRST UQSTR5 + SKIPN UQSTRF ;failed, but skip to try uppercase if flag set + JRST UQSTR9 + XORI U1,(U2) ; Get XOR of the chars... + CAIE U1,40 ; Same char but different case? + JRST UQSTR9 ; Definitely not same char. + CAIL U2,"A ; Aha, win if one char is A-Z or a-z. + CAILE U2,"z ; First test for A-z. + JRST UQSTR9 ; Outside range, so no case folding. + CAIG U2,"Z ; Within A-z, is it inside A-Z? + JRST UQSTR5 ; Yes, win! + CAIL U2,"a ; Hmm, within a-z? + JRST UQSTR5 ; Yes, win! + ; Bah, between Z-a! Fall thru to fail. +UQSTR9: +IFSVU2, POP P,U2 + UUOXRT ;return w/o skipping + +UQSTR7: +IFSVU2, POP P,U2 + AOS UUORPC + UUOXRT ; won, skip + + +; SLNEA AC,[ASCNT [string]] AC must contain a SLP, as for (U)SLNE; +; however, comparision is done with the specified string. The advantage +; is that a template string need not be stored in a list-area. +; USLNEA AC,[ASCNT [string]] Same, but uppercase compare. + +UUODEF SLNEA:,ULSTR +UUODEF USLNEA:,ULUSTR + +ULSTR: SETZM UQSTRF + CAIA +ULUSTR: SETOM UQSTRF ;uppercase compare + LDB U1,UACFLD + MOVE U1,(U1) ;get ptr +IFSVU2, PUSH P,U2 + MOVE U2,LISTAR(U1) + TLNN U2,%LTSTR ; String type? + JRST UQSTR9 ; No, fail. + MOVE U3,LISTAR(U1)+1 ;get stringval + ADD U3,$LSLOC(L) ;make abs + MOVE U4,@U40 ;get literal stringval(already abs) + JRST UQSTR4 ;jump into normal routine. + +SUBTTL Wonderful Super LN-Creation UUO - MAKELN !! + +; MAKELN AC,[ ,,[[list-ptr]] Make a LN according to args, +; ,,[[LN-value]]] and leave LP to it in AC. +; +; The nesting of brackets may be confusing, but is less so in practice; +; using the RH to point at a full @(X)E address field allows arguments to +; be indexed and indirected to, and thus list-area addresses can be given. +; - an arbitrary value to be put into the ATTRIB field of the LN. +; list-ptr - will be inserted in RH of the LN, i.e. what list-ptr points to +; becomes the CDR of that LN. +; - tells the routine what type of LN it is (value, list, string) and +; how to gobble the given LN-value. The defined types are: +; %LTVAL - type VAL, stores LN-val as the value of LN (2nd word). +; %LTLST - type LIST, stores LN-val as a ptr to a list. +; %LTSTR - type STRING, takes LN-val as being ASCNT /string/ and stores. +; %LTBPT - type STRING, takes LN-val as <# chars>,,[b.p. to string] +; %LTSAR - type STRING, takes LN-val as an ARPT and forms a LN string +; value from the text in that area. +; %LTSAO - type STRING, makes string of everything accumulated on +; regular output UUO's since a SAOBEG. If a +; non-zero value is furnished, it is interpreted +; as an instruction to XCT, and the resulting +; output is used for the string; no SAOBEG is needed. +; Output must be on the "standard output"; the OUT +; package must be used. + +%LTBPT==1 ; This flag is for MAKELN only. (see above) +%LTSAR==2 ; Ditto. +%LTSAO==4 ; Ditto. + +; The right thing is done when various fields are left zero, e.g. saying +; MAKELN A,[A$RHST,,0 is legal and produces a VAL-type LN with attribute of +; %LTVAL,,0] A$RHST. Its CDR is 0 and its value is 0, because +; neither arg is accessible. + +UUODEF MAKELN,UMAKEL + +UMAKEL: MOVE U4,U40 +IFSVU2, PUSH P,U2 + MOVE U3,(U4) ; Get lh,,[loc-of-cdr-ptr] + MOVE U4,1(U4) ; Get type,,[loc-of-val] + TRNE U3,-1 ; Keep cdr nil if already is + HRR U3,@(U3) ; else get cdr ptr. + TRNN U4,-1 ;ditto for loc-of-val + SKIPA U2,[0] ;substitute 0 if no address. + MOVE U2,@(U4) ;else get val. + TLNN U4,%LTSTR+%LTBPT+%LTSAR+%LTSAO ;skip if type is string + JRST USTOQ7 ;isn't string. store value/list + + TLZ U3,%LTMSK ;clear all type bits + TLO U3,%LTSTR ;force type to string + EXCH U3,U4 ;save 1st wd in u4 + TLNE U3,%LTSAO ;type store accumulated SA output? + JRST USTOQ3 + TLNE U3,%LTBPT ;is type=byte ptr to string? + JRST [ MOVE U3,(U2) + JRST USTOQ5] ;yes, get the byte ptr + TLNE U3,%LTSAR ;type = string area? + JRST [ MOVE U3,$ARLOC(U2) ;U2 has ARPT. Get abs location of area + HRLI U3,440700 + PUSH P,U1 + MOVE U1,$ARWPT(U2) ; Get write ptr, + SUBI U1,(U3) ; Make it relative to beg, + MULI U1,5 ; and do bp hack + ADD U2,UADBP7(U1) ; to get char count in U2. + POP P,U1 + JRST USTOQ6] + HRRZ U3,U2 ;no, just form a 440700,,addr + HRLI U3,440700 +USTOQ5: HLRZ U2,U2 ;count in rh +USTOQ6: MOVEM U3,OUT"UBMPSP ;kludgery necessary to ensure ptr correct + PUSHJ P,LNPOP ;even if LNPOP bumps areas. get ptr in U1 to free LN. + HRLZ U3,U2 ;form SPT beforehand... get count + HRR U3,$LSFRE(L) ;and rel addr. + PUSH P,U3 ;and save SPT. + MOVE U3,OUT"UBMPSP ;restore source BP. + PUSHJ P,USSTRG ;do it + POP P,LISTAR(U1)+1 ;Done, now store SPT computed previously, + MOVEM U4,LISTAR(U1) ;and finally 1st wd of LN. + JRST USTOQ9 ;last thing to do: return LP in AC. + +USTOQ7: HLLZ U4,U4 ;get type,,0 + IOR U3,U4 ;put type flag into 1st LN lh + PUSHJ P,LNPOP ;if not, get one. + MOVEM U3,LISTAR(U1) ;store 1st LN wd + MOVEM U2,LISTAR(U1)+1 ;store 2nd +USTOQ9: LDB U2,UACFLD ;get # acc (again) + MOVEM U1,(U2) ;return ptr in it. +IFSVU2, POP P,U2 + UUOXRT + + ; Make SLN of stuff between $LSFRE addr and $LSWPT write pointer. + ; (i.e. it's already been output there) + ; U4 contains word to store in 1st wd of LN, otherwise everything + ; clobberable. +USTOQ3: +IFN $$OUT,[ + JUMPE U2,USTOQ4 ; If no value given, assume closing-up. + + ; Special hack! Value given for %LTSAO is instruction to XCT. + ; It should output on the standard output channel... + ; Could reference SAOCH if necessary, but should be avoided. +IFE $$UCAL,PUSH P,UUORPC + PUSHAE P,[U40,OC,U4,U2] ; Note U2 last!! Don't need U1,U3. + OUT(,CH(SAOCH),OPEN(UC$SAO)) ; Open SAOCH, make std output. + XCT (P) ; Execute the frob! Might be UUO. + POPAE P,[U2,U4,OC,U40] +IFE $$UCAL,POP P,UUORPC + ; Then drop through to finalize! +USTOQ4: +] + MOVE U1,$LSWPT(L) ; Get write ptr + SUB U1,$LSLOC(L) ; Make rel to start of SA + MOVE U3,$LSFRE(L) ; Get rel addr of start of free stuff, + SUBI U1,(U3) ; and BP rel to this. + MULI U1,5 ; Now do BP hack + ADD U2,UADBP7(U1) ; to get # chars used. + HRL U2,U3 ; Now use it to make reversed SPT + PUSHJ P,LNPOP ; Get a free LN, + MOVEM U4,LISTAR(U1) ; and store 1st and + MOVSM U2,LISTAR(U1)+1 ; 2nd words in it. (Note halves swapped!) + + MOVEI U2,4(U2) ; Now get # chars + 4 + IDIVI U2,5 ; Find # wds used, + ADDB U2,$LSFRE(L) ; and bump addr of first free loc. + SUB U2,$LSLEN(L) ; Make sure we didn't overrun anything - + CAILE U2,0 ; (note this gives neg of # wds free) + JSR AUTPSY ; First free greater than length means illegal loc writ! + IMULI U2,5 + MOVEM U2,$LSCHL(L) ;store new -cnt of chars left. + JRST USTOQ9 ;done + + + ; USSTRG - auxiliary rtn for MAKELN. given + ;LN ptr in U1, chr cnt in U2, byte ptr in U3, does the actual + ;write of string into SA. Clobbers U2, U3. + +USSTRG: JUMPE U2,APOPJ + PUSHAE P,[U1,U4] + MOVEM U3,OUT"UBMPSP ;store BP in convenient place for auto-adjust. + MOVE U4,U2 ;and store cnt in AC out of way. + ADDI U2,4 + IDIVI U2,5 ;find # words string will need. + PUSH P,U2 ;save + ADD U2,$LSFRE(L) ;add current relative write addr. + SUB U2,$LSLEN(L) ;check bounds by subtracting area length. + JUMPGE U2,[MOVEM U2,ARUNIT ;oops! need more core! Indicate this much. + MOVEI U1,$LSAR(L) ;and give ARPT to string area. + PUSHJ P,UABUMP ;get um. + JRST .+1] + MOVE U3,OUT"UBMPSP ;restore (possibly bumped) BP. + MOVE U2,$LSFRE(L) + ADD U2,$LSLOC(L) ;get abs ptr to start. + HRLI U2,440700 ;make BP. + ILDB U1,U3 ;get char + IDPB U1,U2 ;dep. + SOJG U4,.-2 ;fast. + + POP P,U2 ;get back # wds newly occupied. + ADDM U2,$LSFRE(L) ;and cnt of wds used. + POPAE P,[U4,U1] ;return + POPJ P, + + +; SAOBEG CH, - Initializes for standard UUO output into SA area, +; given channel # output will occur on. The %LTSAO type +; bit in MAKELN will form a string LN of accumulated output. +; Sets OC to CH as current channel. + +UUODFA SAOBEG,USABG +USABG: MOVE U1,$LSFRE(L) + ADD U1,$LSLOC(L) ;get abs start addr + HRLI U1,440700 ;form BP + MOVEM U1,$LSWPT(L) ;and set up new write ptr for area. + HRRZS U1 + SUB U1,$LSTOP(L) ;get -<# wds left> + IMULI U1,5 + MOVEM U1,$LSCHL(L) ;store as $ARCHL for SA. +;; LDB U2,UACFLD ;now ready to open indicated channel. Get it. +;; MOVE U1,[OUTOPN [$UCUAR,,$LSAR(L)]] ;get instr with right args. +;; DPB U2,[$ACFLD,,U1] +;;IFE $$UCAL,PUSH P,UUORPC ; Save return addr, since using UUO within UUO! +;; XCT U1 ; Do the OUTOPN! +;;IFE $$UCAL,POP P,UUORPC + LDB U1,UACFLD ; Get channel # + OUT(,CH((U1)),OPEN(UC$UAR,$LSAR(L))) ; Open channel into area + UUOXRT ; Return + +SUBTTL List Searching UUO's - FINDA and FINDAL + +; FINDA AC,[,,[[list-ptr]]] +; Searches list pointed to by list-ptr for a LN containing the +; given attribute type, and if one is found immediately skips with ptr +; to it in AC. Else doesn't skip and AC is meaningless. +; FINDA AC,[%HSIGN ,,[[list-ptr]] +; []] +; As a special case, this form will search for the attribute type +; which has a string-value matching (exactly) the given string. LN's +; which have the right attrib type but wrong data type (non-string) +; will obviously not match. + +UUODEF FINDA:,UFINDA + +UFINDA: SKIPGE U3,@U40 ; Get c(e)= $attr,,[loc] + JRST UFNDA3 ; If sign bit set, hack special string-search. + HRRZ U1,@(U3) ; Get c(loc)=ptr to first node + CAML U1,$LLLEN(L) ; Check validity + JSR AUTPSY + HLRZ U3,U3 ; Put attrib in rh + JUMPE U1,UUORTL ; Now enter loop, unless first pointer zero! +IFSVU2, PUSH P,U2 +UFNDA0: LDB U2,[$LAFLD,,LISTAR(U1)] ; Get attrib of LN pointed to + CAIN U2,(U3) ; Equal to one we want? + JRST UFNDA9 ; Yes, jump out. +UFNDA1: HRRZ U1,LISTAR(U1) ; No, get CDR and continue, + JUMPN U1,UFNDA0 ; as long as list still exists. +IFSVU2, POP P,U2 + UUOXRT ; Sigh, never found. + + + ; Sign bit is set, search for attrib with matching string. +UFNDA3: HRRZ U1,@(U3) ; Get c(Loc) = LP to first node + JUMPE U1,UUORTL ; Stop right here if first pointer zero... + HLRZS U3 ; Get attrib type into RH + TRZ U3,%HSIGN ; Ensuring that the sign bit is cleared! + MOVE U4,U40 +IFSVU2, PUSH P,U2 + PUSH P,@1(U4) ; Get ASCNT ptr to string, onto stack. +UFNDA4: LDB U2,[$LAFLD,,LISTAR(U1)] ;get attrib of LN pointed to + CAIN U2,(U3) ; equal to one we want? + JRST UFNDA6 ; Yes, jump out. +UFNDA5: HRRZ U1,LISTAR(U1) ; No, get CDR and continue, + JUMPN U1,UFNDA4 ; as long as list still exists. + SUB P,[1,,1] +IFSVU2, POP P,U2 + UUOXRT ; Sigh, never found. + + ; Found right attrib, now see if string matches... +UFNDA6: MOVE U2,LISTAR(U1) ; Get word for testing... + TLNN U2,%LTSTR ; Skip if string, + JRST UFNDA5 ; else obviously not a match. + HLRZ U2,LISTAR(U1)+1 ; Get cnt of SPT for attrib name. + HLRZ U4,(P) ; and cnt for string being sought. + CAME U2,U4 ; String lengths equal? + JRST UFNDA5 ; Nope, keep looking. + + MOVE U2,LISTAR(U1)+1 ; Aha, counts equal, test contents. Get whole SPT + ADD U2,$LSLOC(L) ; Make absolute + MOVE U4,(P) ; Get whole ascnt ptr for test string. + PUSH P,U3 +UFNDA7: JUMPL U4,UFNDA8 ; See if any left to test. + TLNN U4,-1 ; Check both neg. and 0 + JRST UFNDA8 ; and jump if all done... + MOVE U3,(U2) ; get a word to test + CAME U3,(U4) ; Match against template string. + JRST [ POP P,U3 ; No match. + JRST UFNDA5] + ADD U4,[-5,,1] ; Else bump down char cnt and increment index. + AOJA U2,UFNDA7 ; and get another word. + + ; Aha, found right attrib with matching string! +UFNDA8: SUB P,[2,,2] ; Flush both saved U3 and ASCNT template. + + ; Found attrib. +UFNDA9: LDB U2,UACFLD ; Get result acc + MOVEM U1,(U2) ; Store ptr. +IFSVU2, POP P,U2 + AOS UUORPC ; Skip on return + UUOXRT + + +DEFINE FNDSTR AC,PTRLOC,ATTRIB,STRING +FINDA AC,[%HSIGN+ATTRIB,,[PTRLOC] + LITSTR [STRING]] +TERMIN + +IFN 0,[ +; FINDAL AC,[,,[[list-ptr]]] +; Like FINDA above, but searches through the entire tree pointed to. + +UUODEF FINDAL,UFNDAL + +UFNDAL: MOVE U4,@U40 ;get c(e)= $attr,,[loc] + HRRZ U1,@(U4) ;get c(loc)=ptr to first node + HLRZ U4,U4 ;put attrib in rh + + ;ptr in u1, attrib searched for in u4. + SETZM UFNRT' ;clear loc where result stored + PUSHJ P,UFND ;get um recursively. + SKIPG U1,UFNRT ;get result into u1 if found + UUOXRT ;no. blah. + LDB U2,UACFLD ;aha! must store + MOVEM U1,(U2) ;in uuo acc + AOS UUORPC ;and skip + UUOXRT + +UFND: TRNN U1,-1 ;skip unless rh=0 + POPJ P, + MOVE U3,LISTAR(U1) + LDB U2,[$LAFLD,,U3] ;get attrib of LN pointed to + CAIN U2,(U4) ;equal to one we want? + JRST [ HRRZM U1,UFNRT + POPJ P,] ;if so, store tr and return + TLNN U3,%LTLST ;still hope if list + JRST [ HRRZ U1,U3 + JRST UFND] ;nope + PUSH P,U3 + HRRZ U1,LISTAR(U1)+1 ;get ptr to list + PUSHJ P,UFND + POP P,U3 + SKIPLE UFNRT ;skip unless found something + POPJ P, ;if found, return + HRRZ U1,U3 ;nope, try cdr. + JRST UFND +] + +SUBTTL Randomness - LNAPP, OUTLS, NREVERSE + +; LNAPP [[list-lp A] ? [list-lp-B]] +; Appends the list B points to onto the end of the list A points to. +; Simply stuffs list-lp-B in as the CDR of the last item in list A. + +UUODFE LNAPP:,UAPND + +UAPND: MOVE U4,U40 ; Get addr of 2-wd arg block + HRRZ U3,@(U4) ; Get LP to base list (appended to) + HRRZ U1,@1(U4) ; Get LP to list being appended. + CAMGE U1,$LLLEN(L) ; Check both + CAML U3,$LLLEN(L) + JSR AUTPSY + JUMPE U3,[HRRM U1,@(U4) ; If nil base list, store LP B in place + UUOXRT] ; LP A would occupy. +UAPND1: MOVEI U4,(U3) ; Loop to find end of list A. + HRRZ U3,LISTAR(U4) + JUMPN U3,UAPND1 + HRRM U1,LISTAR(U4) ; Found end, smash CDR to point at list B. + UUOXRT + +; NREVERSE LP, Reverses the LNs in the list by bashing the CDR +; pointers, and returns the LP to the thus reversed +; list in AC. Analogous to the LISP function, of course. + +UUODFA NREVERSE:,UNREV +UNREV: +IFSVU2, LDB U1,UACFLD ? SKIPN U1,(U1) ; Get our argument, an LP. +.ELSE LDB U2,UACFLD ? SKIPN U1,(U2) + UUOXRT ; If nothing there, just ignore. + HRRZ U3,LISTAR(U1) ; Initialize the loop + HLLZS LISTAR(U1) ; Special case: zero out this CDR. +UNREV1: HRRZ U4,LISTAR(U3) ; Loop, in which U1 is an LP to a + HRRM U1,LISTAR(U3) ; LN in the list, and U3 an LP + MOVE U1,U3 ; to the immediately next node. + SKIPE U3,U4 ; If that was zero, all done. + JRST UNREV1 +IFSVU2, LDB U3,UACFLD ? MOVEM U1,(U3) +.ELSE MOVEM U1,(U2) ; Store back result in the AC. + UUOXRT + +SUBTTL Free-list Manipulation Primitives - LNPOP and friends. + + ; LNPOP - called when want a free LN from list area. + ;Returns ptr in U1 to a free LN. + +LNPOP: SKIPG U1,$LLFRL(L) ; Get LP to a free LN. + JRST LNPOP2 ; none there? Must get new freelist. + SOSGE $LLFRC(L) ; Got one, bump count down... + JSR AUTPSY ; and fulfill its sole purpose in life. + MOVE U1,LISTAR(U1) ; Won. Get CDR to next free LN + EXCH U1,$LLFRL(L) ; and make it new freelist ptr. + RET ; Return previous ptr to free LN. + + ; Freelist ptr is nil, must create more free LN's. +LNPOP2: SKIPE $LLFRC(L) ; Consistency check... + JSR AUTPSY ; count should have zeroed out!! + + MOVE U1,$LLFRE(L) ; Get # wds actually used in LA area. + SUB U1,$LLLEN(L) ; Subtract total length, to get -# wds avail. + ADDI U1,100*$LNSIZ ; Gobble at least 100 new ones at a time. + CAIG U1,0 ; If need to get more core, skip. + JRST LNPOP3 ; Else needn't expand, just use extra room. + MOVEM U1,ARUNIT + MOVEI U1,$LLAR(L) ; Set up ARPT for UABUMP. + PUSHJ P,UABUMP ; Expand LA. +LNPOP3: SETZM $LLFRL(L) ; Make SURE current freelist is nil. + PUSHJ P,LNINIT ; Now munch extra core onto freelist! + SKIPN $LLFRL(L) ; Make sure something now on freelist. + JSR AUTPSY ; Ugh?? + CALRET LNPOP ; Now go back and get a LN. + + +; LNINIT - looks at "extra" core between $LLFRE and actual end of LA area, +; and makes freelist LN's out of it. Updates $LLFRE, $LLFRL, and $LLFRC. + +LNINIT: PUSHAE P,[U1,U2,U3] + MOVE U1,$LLLEN(L) ; Get total # wds in area, + MOVE U3,$LLFRE(L) ; and rel addr of 1st free wd in area. + SUB U1,U3 ; Find # wds extra by subtracting # used. + IDIVI U1,$LNSIZ ; Get # LN's possible within this space. + JUMPE U1,LNINI9 ; If can't snarf any, quit immediately. + ADDM U1,$LLFRC(L) ; Can make some! Update count now. + + MOVNS U1 + HRLZS U1 ; Make AOBJN of + HRRI U1,(U3) ; -<# LN's to make>,, +LNINI1: MOVEI U2,$LNSIZ(U1) ; Get ptr to next LN + MOVEM U2,LISTAR(U1) ; Insert ptr in current LN + ADDI U1,$LNSIZ-1 ; Bump ptr + AOBJN U1,LNINI1 + + HRRZM U1,$LLFRE(L) ; First unused LP => first unused addr. + SUBI U1,$LNSIZ ; Point to last LN + MOVE U2,$LLFRL(L) ; Get current freelist ptr + HRRZM U2,LISTAR(U1) ; Store its ptr in last LN of new list. + MOVEM U3,$LLFRL(L) ; And set freelist ptr to 1st new LN. +LNINI9: POPAE P,[U3,U2,U1] + POPJ P, + +SUBTTL More Freelist manipulators - LNDEL UUO, LNFREE + +; LNDEL AC,[] +; There are 3 cases depending on presence or absence of AC and E. +; When either is present, their contents must be LP's; the general +; semantics are that AC indicates a single LN for the flushing +; operation, whereas c(E) indicates a list. +; +; (0) LNDEL - Error. +; (1) LNDEL AC, - The indicated LN only is flushed (not its CDR). +; (2) LNDEL [] - As above, but CDR is flushed also, hence +; this is "list-flush". +; (3) LNDEL AC,[] - Only LN indicated by AC is flushed from list +; indicated by c(E). It is a fatal error if +; the LN is not in fact found on the list! +; +; Whenever E is specified, the LP to resulting list is stored back in +; c(E). Since for case 3 the LP pointing to deleted LN is changed to +; point to the next LN, c(E) will be modified if c(E)=c(AC). +; Case 2 will clear c(E). + + +UUODEF LNDEL:,ULNDEL +ULNDEL: MOVE U3,U40 ; Get instruction +IFSVU2, PUSH P,U2 + LDB U2,[$ACFLD,,U3] ; Get AC # + JUMPE U2,[TRNN U3,-1 ; If no AC, make sure E exists. + JSR AUTPSY ; It doesn't?? + HRRZ U1,(U3) ; It does, get LP to start of list, + HLLZS (U3) ; zap RH of c(E) before actually flushing, and + PUSHJ P,LNFREE ; Flush it, +IFSVU2, POP P,U2 + UUOXRT] ; and return. + HRRZ U1,(U2) ; Get c(AC) + TRNN U3,-1 ; Is E = 0? + JRST ULNDL8 ; If so, go flush only this LN. + MOVE U2,(U3) ; No, get c(E) = LP to first node of list LN is on. + CAIN U1,(U2) ; Special first test... LPs same? + JRST [ MOVE U2,LISTAR(U2) ; Yes! replace c(E) by CDR of doomed LN. + HRRM U2,(U3) ; Like so. + JRST ULNDL8] ; And go flush doomed LN. +ULNDL4: MOVE U3,U2 ; Search list. Save LP to previous LN. + MOVE U2,LISTAR(U3) ; Get LP to next LN. + TRNN U2,-1 ; If it's 0, + JSR AUTPSY ; then the LN wasn't on the list!! Lose. + CAIE U1,(U2) ; This it? + JRST ULNDL4 ; No, continue search. + + MOVE U2,LISTAR(U2) ; Aha, found it! Get CDR of doomed LN, + HRRM U2,LISTAR(U3) ; and put it in previous LN. +ULNDL8: HLLZS LISTAR(U1) ; Now kill LN's CDR to isolate it. + PUSHJ P,LNFREE ; And delete it. +IFSVU2, POP P,U2 + UUOXRT + + +; LNFREE - hairy routine to track down everything pointed to by +; a LN and flush it into freelist. +; Takes ptr in U1 to first node; LH must be zero! +; Clobbers U1, U2, U3. + +LNFREE: JUMPE U1,[POPJ P,] ; Do nothing if LP = 0. +LNFRE1: CAML U1,$LLLEN(L) ; Safety check to make sure LP within bounds. + JSR AUTPSY + MOVE U2,LISTAR(U1) ; Get 1st wd of LN (CDR in RH) + TLNN U2,%LTLST ; Is data a list? + JRST LNFRE5 ; No, continue + + ; Flush list + PUSH P,U1 + HRRZ U1,LISTAR(U1)+1 ; Put list ptr in as arg + PUSHJ P,LNFREE ; to a recursion! + POP P,U1 + JRST LNFRE8 ; Now go flush node like a value. + +LNFRE5: TLNN U2,%LTSTR ; Data a string? + JRST LNFRE8 ; No, must be Value. + + ; String...bleah + HLRZ U2,LISTAR(U1)+1 ; Get char cnt + ADDI U2,4 + IDIVI U2,5 ; Get # wds being flushed. + ADDM U2,$LSGC(L) ; Add to # wds garbage in string area. + + ; Value. flush current LN and go after its CDR +LNFRE8: MOVE U2,$LLFRL(L) ; Get freelist ptr + EXCH U2,LISTAR(U1) ; Cons LN on freelist by making CDR = old list + HRRZM U1,$LLFRL(L) ; and pointing freelist at freed LN. + AOS $LLFRC(L) ; Increment cnt of # free for checking. + SETZM LISTAR(U1)+1 ; Zap data wd just for neatness. + TRNN U2,-1 ; Now see if anything in old CDR... + POPJ P, ; Nope, can return! + MOVEI U1,(U2) ; Else must put into U1 + JRST LNFRE1 ; and go flush it. + +SUBTTL LSEGC - LSE garbage collection (compactor) + +; There are several possible screws one can hit while trying to +; GC a LSE. At the moment, this code assumes that there is +; only one well-ordered list in the LSE, which $LLLST points to, +; and that there are no "pure strings". +; "Well-ordered" means no circular lists and only one pointer +; to any single LN. +; One feature is that the entire HDR is copied except for those +; parameters which are address dependent. This preserves any +; idiosyncratic HDR info. + +; L - Specifies LSE to compact. +; On return, L will address new LSE. The ARBLK which LSE is based in +; will likewise be updated. + +LSGEC: PUSHAE P,[A,B,C] + SKIPE C,$LHARP(L) ; Get ARPT pointing at this LSE. + SKIPN $AROPN(C) ; Who knows? Just in case. + JSR AUTPSY + MOVEI A,LGCAR + CALL LSEOPN ; Create a minimal LSE. + + ; Now copy extra HDR words over... + MOVE B,$ARLEN(C) ; Find length of source HDR + SUBI B,$LHSIZ ; Find how many extra wds + CAIGE B, + JSR AUTPSY ; Must not be less! + JUMPG B,[UAREXP B,LGCAR ; Expand by additional # of wds. + HRLZ A,$ARLOC(C) + HRR A,$ARLOC+LGCAR ; Get ,, + ADD A,[$LHSIZ,,$LHSIZ] + ADDI B,(A) ; Get last addr+1 + BLT A,-1(B) ; Move the extra stuff. + JRST .+1] + + ; Now simply copy the whole thing... + MOVE B,L ; Save LSE pointer + MOVE L,$ARLOC+LGCAR ; and make new LSE current. + LNCOPY B,[B ? SETZ $LLLST(L)] ; Copy whole list! + MOVEM B,$LLLST(L) ; Store LP as pointer to whole list in new LSE. + + ; Now move new LSE HDR ARBLK stuff into old ARBLK. + UARPUSH LGCAR ; Push LSE on stack + UARPOP (C) ; Pop back to final location, closing old LSE! + + POPAE P,[C,B,A] + RET + +LVAR LGCAR: BLOCK $ARSIZ + +SUBTTL LSEOPN, LSEIN, LSEOUT - Initialization and I/O rtns for LSE's. + +; LSEOPX - Create a fresh LSE +; A - ARPT to use for HDR area. MOVE L,$ARLOC(A) will make LSE current. +; B - address of a 3-wd block, specifying initial sizes for LSE. +; B -> [size for HDR] ? [size for LA] ? [size for SA] +; Addrs can be any ACs except A or B. +; LSEOPN - As above, but B is defaulted to minimums. + +.SCALAR LSESZS(3) ; Temps for area sizes +LSESZD: $LHSIZ ? 100 ? 100 ; Default sizes. + +LSEOPN: PUSH P,B + SETZ B, + CALL LSEOPX + PJRST POPBJ + +LSEOPX: PUSHAE P,[L,A] ; ARPT is (P) + CAIN B, + MOVEI B,[0 ? 0 ? 0] ; Use defaults. + PUSH P,B + MOVSI A,-3 +LSEOP3: SKIPE B,(B) ; Get addr of HDR size + MOVE B,@B ; Get size for HDR + CAMGE B,LSESZD(A) + MOVE B,LSESZD(A) ; Force above minimal value. + MOVEM B,LSESZS(A) + AOS B,(P) + AOBJN A,LSEOP3 + POP P,B + MOVE A,(P) + + UAROPN [%ARTLH,,(A) ; Open HDR area, using ARPT in A. + LSESZS+0] ; Flag indicates HDR. + MOVE L,$ARLOC(A) ; Set up address. + HRRZM A,$LHARP(L) ; Now store HDR's ARPT in HDR itself! + MOVE A,L + HRLI A,UHDRDF ; Set up BLT ptr from initial HDR block + BLT A,(L)$LHEND-1 ; to created one, and zap things up! + + ; Initialize LA. + UAROPN [%ARTLA,,$LLAR(L) ; ARPT is in HDR... flag says LA-type, + LSESZS+1] ; causing initialization of LA address table. + + ; OK, can now access LA! + MOVSI A,-$LNSIZ + SETZM LISTAR(A) ; Set first LN to 0. + AOBJN A,.-1 + MOVEI A,$LNSIZ + MOVEM A,$LLFRE(L) ; Indicate first LN is "used". + PUSHJ P,LNINIT ; Init freelist starting right after zero'd LN. + + ; Now initialize SA. + UAROPN [%ARTZM+%ARTCH,,$LSAR(L) ; Open SA, ARBLK is in HDR too. + LSESZS+2] + + POPAE P,[A,L] + POPJ P, ; All done! + + + ; Disk-Block (DB) index definitions +BVAR +ULSDBH: OFFSET -. ; Buffer for reading in disk-block header. +DB$LEN::0 ; DB length +DB$ID:: 0 ; DB identifier (SIXBIT) +DB$VER::0 ; DB flags,,version +DB$HLC::0 ; Loc of HDR relative to start of DB (DB$LEN) +DB$HDR::0 ; # wds in HDR block +DB$LA:: 0 ; # wds in LA block +DB$SA:: 0 ; # wds in SA block +DB$SIZ:: ; Size of a disk-block header. + OFFSET 0 +EVAR + +ULSEID: SIXBIT /LSEID0/ ; LSE ID word contents. +DB$V1==:1 ; Version 1 symbol. + +; LSEIN - Routine taking ARPT in A, .ACCESS pointer in B on opened +; DKIC channel. Reads in a LSE from specified point in +; file, using given ARBLK for the HDR area. If B negative, +; reads from current point on DKIC. +; Skips unless IOC error or bad format. + +LSEIN: PUSHAE P,[A,B,C,D,L] + JUMPL B,[SYSCAL RFPNTR,[CIMM DKIC ? CRET B] ; if B neg, find current ptr. + JSR AUTPSY + JRST LSEIN0] + .ACCESS DKIC,B ; If B specified, set ACCESS ptr to it. +LSEIN0: MOVEM B,ULSIPT ; Save initial .ACCESS ptr. + MOVE C,[-DB$SIZ,,ULSDBH] + XCTIOC [.IOT DKIC,C] ; Get disk header of DB into ULSDBH. + JRST LSEIN9 ; Jump if lost + MOVE D,ULSEID + CAMN D,ULSDBH+DB$ID ; Does DB have right identifier? + JRST LSEI20 ; Yes, go handle normal case. + JRST LSEIN9 ; No ID word, must be garbaged +IFN 0,[ ; No ID word. For now, assume old-style format. + MOVE D,ULSDBH+1 ; Get <# wds in HDR>,, + PUSH P,ULSDBH+2 ; Get <# wds in LA> + PUSH P,ULSDBH+3 ; Get <# wds in SA> + HRRZM D,ULSDBH+DB$HLC ; Store stuff in right places. + HLRZM D,ULSDBH+DB$HDR + POP P,ULSDBH+DB$SA + POP P,ULSDBH+DB$LA + SETZM ULSDBH+DB$VER ; Zero out version # and flags. + JRST LSEI22 ; Skip over version # check. +]; end IFN 0 + + ; Do normal-style new format readin. +LSEI20: HRRZ D,ULSDBH+DB$VER ; Get version # + CAIE D,DB$V1 ; V1 is only thing we hack now. + JRST LSEIN9 ; Lost badly. +LSEI22: ADD B,ULSDBH+DB$HLC ; Find absolute disk addr of HDR block. + .ACCESS DKIC,B ; Point there. + MOVE C,ULSDBH+DB$HDR ; Get size of HDR block. + UAROPN [%ARTLH,,(A) ? C] ; Open HDR area with that size. + IMUL C,[-1,,0] ; Now set up block mode pointer... + HRR C,$ARLOC(A) ; Addr to snarf into. + XCTIOC [.IOT DKIC,C] ; Get HDR + JRST LSEIN9 ; Jump if lost. + MOVE L,$ARLOC(A) ; Get beg addr again, to set up L index + SKIPE ULSDBH+DB$VER ; Hacking old-format? + JRST LSEI30 ; No, can continue normally. + + ; Must convert old-fmt HDR to new. Just push everything that + ; needs preserving, and pop back to right places. Note that + ; push/pop lists are reversed relative to each other. + HLRZ C,53(L) ; Get cnt from old $LLFRL = <#>,, + HRRZ D,53(L) ; Get LP + PUSHAE P,[C,D,52(L),54(L),66(L),67(L)] ; Save old stuffs. + MOVEI D,$LHEND-70 ; Find # wds must expand by. + UAREXP D,(A) ; Expand the HDR area; may bump. + MOVE L,$ARLOC(A) ; Make sure L points to right place. + MOVE D,$ARTOP(A) ; Find addr of last wd + 1 + HRROI C,-<1+$LHEND-70>(D) ; Set up a "PDL ptr" to last data wd. + SUBI D,$LHEND(L) ; Get # wds to move. + POP C,<$LHEND-70>(C) ; Move to end of HDR area, + SOJG D,.-1 ; until all non-assembled stuff gone. + POPAE P,[$LSGC(L),$LSFRE(L),$LLLST(L),$LLFRE(L),$LLFRL(L),$LLFRC(L)] + +LSEI30: MOVEM A,$LHARP(L) ; and store ARPT within HDR. + SETZM $LLAR(L)+$AROPN ; Clear "OPEN" flags for LA and SA ARBLKs, + SETZM $LSAR(L)+$AROPN ; to avoid attempt by UAROPN to "close" them! + UAROPN [%ARTLA,,$LLAR(L) ; Open LA area (Note size). + ULSDBH+DB$LA] ; This inits all LA addressing info too. + MOVN C,ULSDBH+DB$LA + HRLZS C + HRR C,$LLLOC(L) ; Set up block mode ptr -,, + XCTIOC [.IOT DKIC,C] ; (LA immediately follows HDR) + JRST LSEIN9 ; Jump if lost. + UAROPN [%ARTZM+%ARTCH,,$LSAR(L) ; Open SA area, as for LA. + ULSDBH+DB$SA] + MOVN C,ULSDBH+DB$SA + HRLZS C + HRR C,$LSLOC(L) ; And read in as for LA. + XCTIOC [.IOT DKIC,C] ; (SA immediately follows LA) + JRST LSEIN9 ; Jump if lost. + + + + ; Readin all done. Point .ACCESS ptr to immediately after DB. +LSEI85: MOVE B,ULSIPT ; Get back original dsk addr + ADD B,ULSDBH ; Add in tot # wds in block. + .ACCESS DKIC,B ; Set to right after it. + + AOS -5(P) ; Won, skip return. +LSEIN9: POPAE P,[L,D,C,B,A] + POPJ P, + +LVAR ULSIPT: 0 ; Initial .ACCESS ptr for LSEIN +LVAR ULSOPT: 0 ; Initial .ACCESS ptr for LSEOUT + + +; LSEOUT - Routine similar to LSEIN, A has ARPT to a LSE HDR, +; B has either an .ACCESS pointer or -1, meaning use current. +; Writes out LSE block on DKOC channel. +; Returns in A the original .ACCESS pntr, in B # words written. + +LSEOUT: PUSHAE P,[C,L] + MOVE L,$ARLOC(A) ; Set up L + JUMPL B,[SYSCAL RFPNTR,[CIMM DKOC ? CRET B] + JSR AUTPSY + JRST .+2] + .ACCESS DKOC,B + MOVEM B,ULSOPT ; Save .ACCESS ptr + MOVEI C,DB$SIZ + MOVEM C,ULSDBH+DB$LEN ; Initialize cumulative total of # wds in blk. + MOVE C,$ARLEN(A) ; Find length of HDR area + MOVEM C,ULSDBH+DB$HDR ; Store, and + ADDM C,ULSDBH+DB$LEN ; add to cumulative sum. + MOVE C,$LLLEN(L) ; Find length of LA area + MOVEM C,ULSDBH+DB$LA ; ditto ditto + ADDM C,ULSDBH+DB$LEN + MOVE C,$LSLEN(L) ; Find length of SA + MOVEM C,ULSDBH+DB$SA + ADDM C,ULSDBH+DB$LEN ; Now finish cumulative total of # wds in blk! + + MOVEI C,DB$SIZ ; Start HDR immediately after the DB header. + MOVEM C,ULSDBH+DB$HLC + MOVE C,ULSEID ; Set up ID word + MOVEM C,ULSDBH+DB$ID + MOVEI C,DB$V1 ; and version # + MOVEM C,ULSDBH+DB$VER + + MOVE C,[-DB$SIZ,,ULSDBH] + .IOT DKOC,C ; Out goes the header! + + ; Now output HDR, LA, SA areas. + IRP LENX,,[DB$HDR,DB$LA,DB$SA]LOC,,[L,$LLLOC(L),$LSLOC(L)] + MOVN C,ULSDBH+LENX ; Get -length of area + HRLZS C ; Put in LH for ptr + HRR C,LOC ; Point to start of area + .IOT DKOC,C ; Out it goes! + TERMIN + + MOVE A,ULSOPT ; Return original .ACCESS ptr + MOVE B,ULSDBH+DB$LEN ; And # wds written out. + POPAE P,[L,C] + POPJ P, + subttl LSE debugging aids + +; Debugging aids for list stuff... + +DEBEG: JSR DEBSAV + .VALUE [ASCIZ /: Ready /] +DEBEND: JSR DEBRST + .VALUE [ASCIZ /: Reset /] + +LVAR DEBSAV: 0 ? JRST DEBSV0 ; jump to pure +LVAR DEBCHP: 0 ;-1 if channel already opened by user. + +DEBSV0: PUSHAE P,[U40] +IFE $$UCAL,PUSH P,UUORPC + MOVEM 17,DEBACS+17 + MOVEI 17,DEBACS + BLT 17,DEBACS+16 ; Save ACs + MOVE 17,DEBACS+17 + SKIPN DEBCHP + JRST [ .OPEN DBC,[.UAO,,'TTY] + .VALUE + OUT(DBC,OPEN(UC$IOT)) + JRST .+1 ] + JRST @DEBSAV + +LVAR DEBRST: 0 ? JRST DEBRS0 ; jump to pure + +DEBRS0: SKIPN DEBCHP + .CLOSE DBC, + MOVSI 17,DEBACS + BLT 17,17 +IFE $$UCAL,POP P,UUORPC + POPAE P,[U40] + JRST @DEBRST + +BVAR +DEBACS: BLOCK 20 +DEBAR: BLOCK $ARSIZ ; Area block, in case debug rtns want to use an area. +EVAR + + ; DEBPRF - Print out a file (LSE-block). + ; Argument, in DEBFIL, is the address of file block +LVAR DEBFIL: 0 ; Must have addr of FN1/FN2 +DEBPRF: JSR DEBSAV + SKIPN A,DEBFIL + JRST DEBPLX ; If nothing, simply return. + .IOPUSH DKIC, + SYSCAL OPEN,[[.BII,,DKIC] ? (A) ? 1(A) ? 2(A) ? 3(A)] + JRST [ OUT(DBC,("Couldn't open "),6F((A)),SP,6F(1(A))) + JRST DEBPFX] + MOVEI A,DEBAR + SETZ B, + PUSHJ P,LSEIN ; Read in. + .VALUE + MOVE L,$ARLOC+DEBAR + MOVE A,$LLLST(L) + PUSHJ P,DEBPL ; Print out main list. + UARCLS DEBAR +DEBPFX: .IOPOP DKIC, + JSR DEBRST + POPJ P, + +; DEBLSE - Print out a LSE. Uses current LSE as indicated by L. +; Outputs on DBC. DEBPRL same, but uses LP in DEBLP instead +; of $LLLST(L). + +DEBLSE: SETOM DEBLP +DEBPRL: JSR DEBSAV + SETZM DEBLEV + SKIPGE A,DEBLP + MOVE A,$LLLST(L) + PUSHJ P,DEBPL +DEBPLX: JSR DEBRST ; $G here if DEBPRL loses during printout. + POPJ P, + +LVAR DEBLP: 0 ; LP to list to print. If negative, uses $LLLST(L). +LVAR DEBLEV: 0 ; Level of recursion (indent) + +DEBPL: OUT(,CH(DBC),O(A),TAB) + MOVE B,DEBLEV + SOJGE B,[OUT(,(" ")) + JRST .] + MOVE C,LISTAR(A) ; Get 1st wd + OUT(,HV(C),SP) + TLNE C,%LTLST + OUTCAL(,("List ")) + TLNE C,%LTVAL + OUTCAL(,("Val ")) + TLNE C,%LTSTR + OUTCAL(,("Str ")) + LDB B,[$LAFLD,,LISTAR(A)] ; Get attrib # + OUT(,O(B),SP,TC(ATTRTB(B)),EOL,TAB) + MOVE B,DEBLEV + SOJGE B,[OUT(,(" ")) + JRST .] + TLNE C,%LTSTR + JRST [ OUT(,HV(LISTAR(A)+1),(| "|),TLS(A),C("")) + JRST DEBPL5] + TLNE C,%LTVAL + JRST [ OUT(,O(LISTAR(A)+1)) + JRST DEBPL5] + OUT(,HV(LISTAR(A)+1)) + +DEBPL5: OUT(,EOL) + TLNN C,%LTLST + JRST DEBPL6 ;not a list... + PUSH P,A + AOS DEBLEV + HRRZ A,LISTAR(A)+1 + PUSHJ P,DEBPL ; Print out its list. + SOS DEBLEV + POP P,A + +DEBPL6: MOVE C,LISTAR(A) + TRNN C,-1 + POPJ P, + OUT(,EOL) ; Do the CDR + HRRZ A,C + JRST DEBPL + + \ No newline at end of file diff --git a/src/ksc/qmail.614 b/src/ksc/qmail.614 new file mode 100644 index 00000000..81d222bc --- /dev/null +++ b/src/ksc/qmail.614 @@ -0,0 +1,4801 @@ +;;; -*- Mode:MIDAS -*- + +.SYMTAB 8001.,8001. + +TITLE QMAIL + ; User interface to COMSAT + ; Written/maintained by KLH @ MIT-AI +.MLLIT==1 + +;If QMAIL is assembled with the PWORD switch on, the Editor +;escape command and the Write file command are disabled, and +;the pure binary will get dumped in SYS;TS PWMAIL. + +IF1 [ +printx /PWORD version (Y or N)? / +.ttymac foo + irpnc 0,1,1,bar,,foo + ifse bar,Y,[$$PWORD==1] + ifse bar,y,[$$PWORD==1] + ifse bar,N,[$$PWORD==0] + ifse bar,n,[$$PWORD==0] + termin +termin +] + +F=0 ; Flags +A=1 ; A-E utility registers, saved over procedure calls +B=A+1 ; whenever not taking or returning args. +C=B+1 +D=C+1 +E=D+1 ;5 +TC=6 ;index to command currently being processed +OC=7 ; Current Output Channel index, used by OUT package. +R=10 ;index to a recipient +I=11 ;used by interrupt handler + +SP=12 ;string PDL stack +U1=13 ; OUT and UUO Handler regs +U2=14 ; " +U3=15 ; " +U4=16 ; " +P=17 ;standard PDL reg + + ;I-O channel assignments + TYIC==1 ; TTY input + TYOC==2 ; Normal TTY output + TYOSC==3 ; TTY output channel for possible slashified output. + DTYOC==4 ; TTY display output channel, for cursor control codes. + DKIC==5 ; usual DSK input + DKOC==6 ; usual DSK output + ERRCHN==7 ; channel for ERR device (used by $$OERR) + USRI==10 ; inferior I/O chans + USRO==11 + + ; "Soft" UUO channels + MSGC==15 ; UUO chan for depositing message text + TMPC==16 ; Temporary chan for random things. + DMC==17 ;kludge channel to write MUDDLE strings + +; Right half flags, generally local + +%dcrlf==400000 ;used in disk-input translate to help chop lf off cr-lf. +%AZGOT==200000 ; in GETRS, "got something" and stored it. +%AZERR==100000 ; " error of some sort in input string. +%IMPV== 40000 ;indicates to int handler that a MPV is from reading inferior. +%RNAM== 20000 ; in GETOBJ, found name string +%RNLIT==10000 ; " found "name" string, ie a literal +%RHST== 4000 ; " found @host string +%RFILE==2000 ; " found (file-spec) string +%TMP== 1000 ;temporary flag for various things +%BUGMG==400 ;when set, means we're sending bug or featur type message. +%ONCE== 200 ;used as once-thru flag by IPNUM. +%OLNTY==100 ; in OLNTYP, to distinguish between typing anew and redisplaying for rubout +%BUGNM==40 ;when set, means name of program hasn't been gobbled yet(for bug/featur) +;==20 +%DSALL==10 ; Set when MSGGET upon entry should show all attribs thus far +%MSG==4 ;set when at least one *-style recipient exists. +%MSGJ==2 ;when set, means program is a qmsg or msg. +%RQUOT==1 ;msggt1; indicates ^Q-quote to be rubbed out + +%RALLT==%RNAM+%RNLIT+%RHST+%RFILE ;all possible getobj objects + +; Left half flags, generally global + +%NOTYO==400000 ; When set, TTY output is suppressed. +%JCL== 200000 ; JCL was specified by superior. +%NOECH==100000 ; Set to read next TTY character without echoing. +%JCLM== 40000 ; Found JCL message text. +%UNSIL==20000 ; Un-silence TTY output as soon as feasible. +%GOCGT==10000 ; get another command instead of message text. +%NOSND==4000 ; When set, MSGSND will refuse to send message. +%SLSHC==2000 ;Next char needs slash conversion of UC->lc, as in teco +%NEWMD==1000 ; "New mode" is default. This is set when JNAME=NMAIL +;==400 +%PGMRN==200 ;tells int handler that inferior ints should be expected +%HADCM==100 ;zero until first command given, 1 thereafter. +%PREVL==40 ;tells last-line-finder whether to find previous line if current nil. +%QUOTE==20 ;ttyin; next char should be quoted. +%MQUOT==10 ;when set, comsat should quote msg text and not form header. +%TYPAH==4 ; Indicates type-ahead exists on startup. Used only to suppress "Msg:". +%HADRB==2 ; Zero until first rubout seen, 1 thereafter. +;=1 + + ; Random bit definitions +%TIDIS==4000 ; bit in .OPEN to recognize ^P display codes on output. + + ; Various byte-pointer fields + $ERRCD==220600 ;error code from .status word + $OPCOD==331100 ;op-code of instruction + $ACFLD==270400 ;ac field of instr. + $XFLD== 220400 ;index field of instr. + + + +.INSRT KSC;MACROS > +.INSRT KSC;IVORY > + $$OTIM==1 ; Include time-output rtns + $$OERR==1 ; Include sys-err output + $$OHST==1 ; Include hostname output + UAREAS==1 ;assemble area hackery uuos. + USTRGS==1 ;assemble string hackery +;; No longer necessary! +;; OC==:U2 ; Must define this register (U2 only one OK to reuse) +.INSRT KSC;OUT > +.INSRT KSC;NUUOS > +.INSRT SYSENG;DATIME > +.INSRT KSC;NFNPAR > + + $$HST3==1 ; Let's all use HOSTS3 now! + $$ARPA==1 ; For arpa net + $$CHAOS==1 + $$HOSTNM==1 ; hostname lookup rtns + $$SYMLOOK==1 + $$OWNHST==1 ; include ONWHST rtn. + T=:U3 ; smashable acs for NETWRK (must not be U2!) + TT=:U4 +.INSRT SYSENG;NETWRK > + +HN$DM==:+<6>+<1_16.> ; MIT-DM site # in new canonical fmt +HN$ML==:+<6>+<3_16.> ; MIT-ML site # in ditto + + ; Various minor macros +DEFINE CURSOR CHAR + CALL [PUSH P,[CHAR] ? JRST CUROUT] +TERMIN +CUROUT: EXCH A,(P) + OUT(DTYOC,C(^P),C((A))) + PJRST POPAJ + +DEFINE TYPE STRING + UTYPE [ASCNT [STRING]] +TERMIN +DEFINE TYPECR STRING + UTYPE [ASCNT [STRING +]] +TERMIN +UUODFE UTYPE:,UTYPX +UTYPX: OUT(TYOC,TC(@U40)) + UUOXRT + +BVAR +PAT: +PATCH: BLOCK 200 + +PDLLEN==200 ;big pdl! +PDL: -PDLLEN,,PDL + BLOCK PDLLEN +EVAR + +PPCBAJ: POP P,C +POPBAJ: POP P,B +POPAJ: POP P,A +APOPJ: POPJ P, +POPAJ1: POP P,A +POPJ1: AOS (P) + POPJ P, +POPCJ1: AOS -1(P) +POPCJ: POP P,C + POPJ P, +popcbj: pop p,c +POPBJ: pop p,b +CPOPJ: popj p, + +BVAR +JUNK: 0 ;random useless writes +OWNHST: 0 ;# of our own site (filled in at init by NETWRK's OWNHST rtn) +OWNNAM: 0 ;holds addr of asciz string which is name of own site +DEBUG: 0 ; -1 for debugging. Effects currently very minor. +AUTPSY: ; UUO rtns want this. +DEATH: 0 + JRST DEATH0 +EVAR + +DEATH0: SKIPE DEBUG + .VALUE + .VALUE [ASCIZ : Error! Loading syms... + 'VERSIO/ +SDEATH/ +: Please report via :BUG MAIL or contact system wizard. +] + JRST .-1 + +PRGNAM: .FNAM1 ; For debug purposes. +VERSIO: .FNAM2 + SUBTTL Interrupt handler + +TMPLOC 42,{JSR TSINT} ; Vector to handle ints. + +LVAR TSINT: 0 ? 0 ? JRST TSINT0 ; jump to pure. + +TSINT0: SKIPL I,TSINT ;skip if 2nd wd int, get int wd in i + JRST TS1WD ;1st wd int. + TLNE F,%PGMRN + JRST [ TDNN I,INFBIT + JRST .+1 + JRST TSINT5] ;inferior job interrupt! + MOVEI I,TYIC + .ITYIC I, + .DISMIS TSINT+1 ;no char? + TLNE F,%QUOTE ;quote this char? + .DISMIS TSINT+1 ;ignore int. if so. + trne i,%txmta+%txtop ;must check TV bits. META or TOP set? + .dismis tsint+1 ;yes, so quote it. + trz i,%txsft+%txsfl ;no, must cvt TV bits. flush shift and shift lock + trze i,%txctl ;flush cntrl, and + trz i,140 ;cntrl-ify if necessary. + +TINTI: CAIN I,^S + JRST TYINT1 ;halt output + CAIN I,^G + JRST TYINT2 ;halt everything + .DISMIS TSINT+1 ;nothing special, return. + + ; ^S - silence output. +TYINT1: .RESET TYOC, ;flush buffer + .RESET TYIC, ;might as well flush ^S and following stuff. + HRRZ I,TSINT+1 ; Find addr interrupted from +;**** KLUDGE! Ought not refer to UUO package address... + CAIN I,OUT"UOS.I2 ; If same as UUO SIOT addr, + JRST [ CAIE U2,TYOC ; and on a TTY output channel, + CAIN U2,DTYOC + CAIA ; then skip to hack PC. + JRST .+1 + AOS TSINT+1 ; Bump past .CALL + AOS TSINT+1 ; and past failure return. + JRST .+1] + TLNE F,%NOTYO ;quiet flag already set? + .DISMIS TSINT+1 ;don't reset if so. + TLO F,%NOTYO+%UNSIL ;set flags to silence, and un-silence later. + PUSHAE P,[U40,U1,U2,U3,U4] ;may have int'd out of UUO handler... +IFE $$UCAL,PUSH P,UUORPC +IFN U2-OC,PUSH P,OC + OUT(TYOC,OPEN(UC$XCT,[JFCL])) ;make TTY output do nothing. + OUT(DTYOC,OPEN(UC$XCT,[JFCL])) +IFN U2-OC,POP P,OC +IFE $$UCAL,POP P,UUORPC + POPAE P,[U4,U3,U2,U1,U40] ;restore UUO vars. + .DISMIS TSINT+1 ;return. + + ; ^G - halt activities immediately and get command. +TYINT2: .RESET TYOC, + .RESET TYIC, + .IOT TYOC,[^G] ;ding bell. + MOVE P,PDL + MOVE SP,SPDLPT ;reset both PDL's + PUSHJ P,INPFLS ;flush input stream stack and restore TTY I/O. + .DISMIS [COMGET] ;go get a command. + + ; Inferior interrupt (TECO) +TSINT5: .SUSET [.SIDF2,,INFBIT] + .DISMIS [PGMR60] + +TS1WD: TRNN I,%PIMPV ;MPV interrupt? + .VALUE + TRNN F,%IMPV ;is it expected from inferior reading? + .VALUE + .DISMIS MPVRET + +LVAR MPVRET: 0 ;holds loc to return to if MPV hit while reading inferior. + + SUBTTL Initialization + +IFE $$PWORD,[ +PURIFY: MOVE A,[,,PURPGB] + SYSCAL CORBLK,[CIMM %CBNDR ? CIMM %JSELF ? A ? CIMM %JSELF] + .LOSE + .VALUE [ASCIZ /:PDUMP SYSBIN;QMAIL BIN/] +] + +IFN $$PWORD,[ +PURIFY: MOVE A,[,,PURPGB] + SYSCAL CORBLK,[CIMM %CBNDR ? CIMM %JSELF ? A ? CIMM %JSELF] + .LOSE + .VALUE [ASCIZ /:PDUMP SYS;TS PWMAIL/] +] + + +START: MOVE P,PDL ; Init PDL ptr + MOVE SP,SPDLPT ; String PDL + SETZM INPDP ; Input source PDL + SETZ F, ;clear all flags + SETZM N2DARY ;indicate not known to be secondary + .SUSET [.ROPTION,,A] ;get option bits + SETZM DDTFLG' + TLNE A,OPTDDT ;is superior DDT? + SETOM DDTFLG ;yes, set flag. + TLO A,OPTLOK ;enable locks hackery + .SUSET [.SOPTION,,A] ;losing read/write since no ".sioption" + SETO A, + PUSHJ P,SETINP ;set input stream from TTY. + MOVE A,[-3,,[ + .SMSK2,,[1_TYIC] ;enable ints for tty input channel + .SDF2,,[1_TYIC] ;but defer them for moment + .SPICLR,,[-1]]] ;and enable all ints. + .SUSET A ;do it + + .OPEN TYIC,[%TIFUL+.UAI,,'TTY] ; Now open our TTY! (with bucky bits) + .VALUE + .OPEN TYOC,[.UIO,,'TTY] ; open here for output also. + .value + .CALL TTGET ; And immediately get TYST bits, + .VALUE + MOVE A,DTYST1 ; clobbering to desired values (MP echo etc) + MOVE B,DTYST2 + TLO C,%TSCLE ; and make ^L's non-special in echoing. + .CALL TTSET ; ZAP! Switch from PI to MP echo here! + .VALUE + SYSCAL LISTEN,[CIMM TYIC ? CRET A] ; Was there any typeahead? + .VALUE + CAIE A,0 ; Check... + TLO F,%TYPAH ; Uh-oh, type-ahead exists. Set flag for no "Msg:". + + ; Now open other output chans + .OPEN DTYOC,[%TIDIS+.UIO,,'TTY] ;for possible display-mode output (esp ^P A) + .VALUE + .OPEN TYOSC,[.UIO,,'TTY] ;for possibly-slashified output + .VALUE + .CALL TTINFO ; Now get more detailed terminal info. + .VALUE + MOVE A,HORSIZ + MOVEM A,TTYWID + SETZM TTYDIS' ; Clear all word-type flags for TTY. + SETZM TTYERS' + SETZM TTYHDX' + SETZM TTYSAI' + MOVE A,TTYOPT ;get bit flags + TLNE A,%TOHDX ;tty is half duplex? + JRST [ SETOM TTYHDX ; Set flag if HDX. + .CALL TTGET + .VALUE + TDZ A,[606060,,606060] ;clear all echo bits if so. + TDZ B,[606060,,606060] + .CALL TTSET ; Now reset to non-echo. + .VALUE + JRST GO3] + TLNE A,%TOMVU ;tty can move cursor up? (i.e. display?) + SETOM TTYDIS ;tty is display, set switch + TLNN A,%TOERS ;tty can erase selectively? + TLNN A,%TOOVR ; If not, still win if can't overprint. + SETOM TTYERS ;(that crock is for sake of castrated displays, + ; ie glass tty's) + TLNE A,%TOSA1 ; Set up for sail char set? + SETOM TTYSAI ;yup + +GO3: OUT(TYOC,OPEN(UC$IOT)) ; set up UUO chan for normal TTY output + OUT(DTYOC,OPEN(UC$IOT)) ; and another for display-mode TTY output. + OUT(TYOSC,OPEN(UC$TRN,[TYOC])) ;set up TYOSC chan as translating into TYOC. + + + MOVE A,[-4,,[ + .RUNAME,,LUNAME' ;get uname + .RXUNAME,,XUNAME' ;and xuname + .RSNAME,,LSNAME' ;and sname + .RXJNAME,,JNAME']] ;names, names, names! + .SUSET A + MOVE A,LUNAME + CAMN A,XUNAME ;if UNAME = XUNAME, + SETZM XUNAME ;zero xuname. + MOVE A,JNAME + TRZ F,%BUGMG+%BUGNM+%MSG+%MSGJ + + ; Now determine if we are manifestation of + ;bug or featur or msg... (or qbug, qfeatu, qmsg) + ; if MSG, then set %MSGJ flag -- later on in initialization, flag will + ; force * into rcpt table, and any addition or deletion of + ;rcpts in main program will check to see if flag needs changing. + + CAME A,[SIXBIT /QFEATU/] + CAMN A,[SIXBIT /FEATUR/] + TRO F,%BUGMG\%BUGNM + CAME A,[SIXBIT /BUG/] + CAMN A,[SIXBIT /QBUG/] + TRO F,%BUGMG\%BUGNM + CAME A,[SIXBIT /QMSG/] + CAMN A,[SIXBIT /MSG/] + TRO F,%MSGJ +; CAME A,[SIXBIT /NBUG/] +; CAMN A,[SIXBIT /NMAIL/] +; TLO F,%NEWMD ; Set if default sending mode is "new". + CAMN A,[SIXBIT /S/] + JRST .+3 ; hack same as for QSEND. + CAME A,[SIXBIT /QSEND/] + CAMN A,[SIXBIT /SEND/] + JRST [SETOM SORMSW ; If a QSEND, set switches to send, + SETZM SENDSW ; and mail if fail. + JRST .+1] + + MOVE A,LSNAME + MOVEM A,TECDIR ;initialize various filename blocks with SNAME + MOVEM A,RFDIR + MOVEM A,MFDIR + + MOVEI A,HSTPAG + PUSHJ P,NETINI ;Get host name table in high core + + MOVE A,[NETWRK"NW%ARP] ;using arpanet as default, + PUSHJ P,NETWRK"OWNHST ;get our host # + JRST [ MOVE A,[NETWRK"NW%CHS] + PUSHJ P,NETWRK"OWNHST + .VALUE + JRST .+1 ] + MOVEM A,OWNHST ;store + setzm dmsw' +IFN 0,[ ;DM runs a normal COMSAT now. + CAMN A,[HN$DM] ;are we on DM machine? + setom dmsw ;yes, set switch! +] + PUSHJ P,GHNAME ;get ptr to asciz string + MOVEM A,OWNNAM + + UARINIT ARPAGS ;initialize area hackery + STRINIT ;and strings + + UAROPN [%ARTCH+%ARTZM,,MSGAR ? [2000]] + OUT(MSGC,OPEN(UC$UAR,MSGAR)) ;and msg channel + + SETZM MSGFN1 + PUSHJ P,RTINIT ;initialize RCP tables + SETZM RCPNUM ; # of rcpts + SETZM MDSNUM ; # of MSG distribution sites + TRNE F,%MSGJ ; MSG program? + JRST [ PUSHJ P,ASTRSK ;get "*" into RCPNAM + MOVE R,RCPNUM ;insert rcpt name into tables + MOVEI A,RCPNAM + PUSHJ P,SRCPN + MOVE A,OWNHST + MOVEM A,@TRCPH ;and site + MOVSI A,R%MSG + MOVEM A,@TRCPF ;and flags + AOS RCPNUM ;certify inserted. + AOS MDSNUM + TRO F,%MSG ;indicate * rcpt exists. + JRST .+1] + + TLZ F,%JCL+%JCLM ;clear jcl-related flags + AOSE JCLATE ;ate jcl already? + JRST NOJCL ;yes(this can happen on restart) + .SUSET [.ROPTION,,A] ;jcl waiting for us? + TLNN A,OPTCMD + JRST NOJCL ;no. + + setz b, +jclglp: addi b,50. ;# wds to add + uaropn [%ARTZM+%ARTCH,,JCLAR ;open area with at least that many wds + B] + move c,JCLAR+$ARLOC ;get beg addr + hrli c,5 ;compose .break arg (5 tells ddt to give jcl) + MOVE D,JCLAR+$ARTOP ;get end+1 addr + setom -1(d) ;make last wd non-z so don't exceed bounds of area + .break 12,c ;get jcl into area + skipe -2(d) ;was jcl written up to last wd? + jrst [ uarcls jclar + jrst jclglp] ;yes, close area and try again with more allocation. + MOVE A,$ARLOC+JCLAR ;get beg addr, as arg to + PUSHJ P,LASCIZ ;find how long the JCL is. + JUMPLE A,NOJCL ; If nothing there, well,... + MOVE C,A ; save length for later. + PTSKIP A,$ARWPT+JCLAR ;and set write ptr to true end-of-string. + MOVE B,$ARLEN+JCLAR + IMULI B,5 ;get total # chars in area + SUB B,A ;find # remaining after JCL. + MOVNM B,$ARCHL+JCLAR ;and set countdown, all done now... + + ; Check to see if "?" was first thing typed in JCL. + MOVE B,$ARRPT+JCLAR ; Borrow read ptr +JCLGL5: ILDB A,B + CAIN A,"? + JRST GOHLP ; Aha, go provide help. + CAIE A,40 + CAIN A,^I + CAIA + JRST JCLGL6 ; Nope, parse JCL normally. + SOJG C,JCLGL5 + JRST NOJCL + +JCLGL6: MOVEI A,JCLAR ;Get ARPT for area of JCL input, + PUSHJ P,SETINP ;and set input stream to that. + MOVEI A,%TIJCL ;with one slight modification. + CALL SETTIX + TLO F,%JCL ; Now, can indicate JCL given & available! + + MOVEI TC,%CTT ; Now set up to execute "To:" command, + JRST COMXCT ; and go get recipients first thing. + +NOJCL: SKIPE TTYDIS + PUSHJ P,ZAP ;Clear screen if display. + MOVEI TC,%CTT +NOJCL8: .SUSET [.SADF2,,[1_TYIC]] ;ready to go, undefer any input interrupts. + JRST COMXCT + + ; Jump here when initial inspection of JCL reveals "?" as first + ; non-blank char in string. +GOHLP: SKIPE TTYDIS + PUSHJ P,ZAP + + MOVE A,HTMAIL + TRNE F,%BUGMG + MOVE A,HTBUG + TRNE F,%MSGJ + MOVE A,HTMSG ; Help for :MSG + + FWRITE TYOC,[TC,A,TC,HTGNRL] + MOVEI TC,%CTH + JRST NOJCL8 + +HTMAIL: ASCNT [ +For bulk documentation about the MAIL program, read the file +INFO;MAIL > either as a text file or with the INFO program. +] +HTGNRL: ASCNT [ The most important thing to remember about the MAIL +program is that (or ) is a "command escape". +For example, typing and "H" invokes the "Help" command; to save +trouble let's go there directly... +] + +HTBUG: ASCNT [ +:BUG and :FEATURE are variants of the MAIL program. +The correct syntax is: + :BUG ,,... + ^C +You should probably type Q to quit out, and try again; +or you can stay in, and ask for more info below. +] + +HTMSG: ASCNT [ +:MSG is a variant of the MAIL program. +The correct syntax is: + :MSG ^C +But you are strongly advised to use the regular MAIL program, sending the +message to "*" (for local system), or "*ITS" (for all ITS systems). +] + + +LVAR JCLATE: -1 ;-1 if haven't eaten jcl, 0 if have. never reset. + SUBTTL Command dispatch + +COMGET: TLO F,%HADCM ;indicate at least one command requested since startup. + SETZM HLPSW' ;Set toggle for going to COMGT5 every 2 blunders. +COMGT1: SKIPL A,TYILCH ;If next input char is to be something already read, + JRST [ CAIN A,33 ;then check to see if it's the altmode that invoked us! + SETOM TYILCH ;If so, zap it since already in COMGET and don't need... + JRST .+1] ;continue. + PUSHJ P,TTYLOC + MOVE A,HORPOS ;get current horiz position + CAILE A,1 ;don't start new line if is only char on line. + OUTCAL(TYOC,EOL) + OUT(TYOC,RABR) + TLO F,%NOECH ;suppress MP echo for single char. + PUSHJ P,TTYINU ;get uppercase char, unquoted. + CAIN A,33 ;esc? + JRST COMGT1 ;humor him. + MOVSI B,-NCMDS ;aobjn thru command table + CAME A,CMTCHR(B) ;compare + AOBJN B,.-1 + JUMPGE B,COMGT7 ; Didn't find? + MOVEI TC,(B) ; Found, set that up as current command! + + ; Execute command indexed by TC. JRST'd to. +COMXCT: MOVE B,CMTRTN(TC) ;get instr to xct + TLNN B,777740 ;if no instruction, is just an address, + IOR B,[PUSHJ P,] ;so must put default instr in. + TLZ F,%GOCGT + XCT B ; Do command. + TLZE F,%GOCGT ; Does rtn want another command done? + JRST COMGET ; Loop back if so, else + JRST MSGGET ; Settle down to collect msg text. + + + ; Didn't find command. Complain maybe. +COMGT7: SETCMB B,HLPSW ;didn't find - flip switch + .RESET TYIC, ;and reset input buffer + SKIPN TTYHDX + OUTCAL(TYOC,C((A))) ;echo if necessary + TYPE [?] ;and ding bell. + SKIPE B + TYPE [ Type ? for help.] + JRST COMGT1 ;and try again. + + +; Command definition macro. The dummies stand for the following: +; L - ASCII char value invoking this command. +; FLAG - Symbol (if any) for index value of this command. +; ROUT - Instruction to execute for command. If address-only, +; then a PUSHJ P, is done to that address. +; PROMPT- Prompt string (if any) to use when command requests a line of input. +; DESC - Brief one-line desc (if any) of command, for HELP * printout. +; HELP - Multi-line help text for HELP printout. + +DEFINE CMD L,FLAG,ROUT,PROMPT,DESC,HELP +IF1 [IFSN [FLAG][] FLAG==NCMDS + ASCNT [PROMPT] + ASCNT [DESC] + ASCNT [HELP] +LOC .-2 +] +IF2 [ ROUT +%%S==. +LOC CMTCHR+NCMDS ? L +LOC CMTPRM+NCMDS ? ASCNT [PROMPT] +LOC CMTDSC+NCMDS ? ASCNT [DESC] +LOC CMTHLP+NCMDS ? ASCNT [HELP] +LOC %%S +] +NCMDS==NCMDS+1 +TERMIN + + ; Commands should be defined in the order best suited to + ; sequentially listing their DESC strings. +CMTRTN: NCMDS==0 + +CMD "?,%CTQUE,COMQUE +CMD "H,%CTH,COMH,,[Help , describes given command.] +CMD "T,%CTT,COMT,[To: ][To , adds them to mailing list.][ + Any number of recipients may be specified, separated by +commas and terminated by a . Each recipient must be in +the format or @. + @ can be replaced by " at ". + - Can be (1) Enough of a host (nick)name to render it unique, + (2) An octal #, or (3) a decimal # followed by a period. + If no is specified, the local host is assumed. + - Can be (1) Any string without blanks, commas, etc. + (2) A string enclosed within quotes, e.g. "" + (3) A filename enclosed within square brackets.] + +CMD "C,%CTC,COMT,[CC: ][CC , just like "TO"][ + The message will be sent to the given recipients, but +they will be listed in the header as "CC: " instead of +"TO: ". Request help for "T" to see recipient format.] + +CMD "U,%CTU,COMT,[Un-to: ][Un-to , removes from mailing list. * works.][ + The specified recipients will be removed from the +list of rcpts thus far. Request help for "T" to see recipient +format; there are 3 special cases for "Un-to": *, @*, +and *@. In each case "*" is a wild-card default, so +that for example "*" alone flushes all current recipients.] + +CMD "S,%CTS,COMS,[Subject: ][Subject. Specify a subject line (null line deletes)][] + +CMD "F,%CTF,COMF,[From: ][From . Unnecessary unless UNAME wrong.][ + This should be used only when what you are logged in as +is misleading, and you want to ensure the recipients (and the mailer) +know who is really sending the message. The given string will be +inserted as "FROM: " and the mailer will report to that name +any problems encountered.] + +IFE $$PWORD,[ +CMD "N,%CTN,COMN,[Name for rcpt list: ][Name for recipient list, header shows this and not real list.][ + If a non-null string is given, the header of the message +sent will show "TO: " rather than listing each recipient +individually, which is useful for large lists. Any CC's will still +be shown as usual, however.] +] + +CMD "L,%CTL,COML,,[List the mailing list][ + Mainly useful for printing only the current list of recipients, +rather than the entire message as ^L would do.] + +IFE $$PWORD,[ +CMD "W,%CTW,COMW,[Write text to file: ][Write message text to ][ + The message text will be written out exactly as it is.] +] + +CMD "A,%CTA,COMA,[Append file: ][Append to message text.][ + The given file will be copied verbatim onto the end of current +message text.] + +CMD "I,%CTI,COMI,[Insert file: ][Insert (exactly like Append)][ + This is merely a somewhat misleading synonym for the "A" +or "Append" command.] + +CMD "Y,%CTY,COMY,[Yank in file: ][Yank in, replacing message text.][ + Flushes current message text, and reads in specified file to replace +it. Same as "Zap" then "Append".] + +CMD "G,%CTG,COMG,[Get execution file: ][Get from data as if typed from console.][ + Reads specified file as if it were TTY input; commands can +be given preceded by an .] + +IFE $$PWORD,[ +CMD "P,%CTP,COMP,[Put execution file: ][Put to a GET-able description of message.][ + Tries to write out all message information to specified file, +so that the current state of the world can be restored simply by starting +a new MAIL and "Get"ing the file.] +] + +CMD "Z,%CTZ,COMZ,,[Zaps message buffer.][ + Flushes all current message text.] + +IFE $$PWORD,[ +CMD "E,%CTE,COME,,[Edit escape to EMACS. ^X^C returns to MAIL pgm.][ + An inferior EMACS is created, and the current message text +loaded into it for editing. One may normally exit from EMACS, and have the +current buffer loaded back as the new message text, by typing ^X ^C, +or by executing FSEXIT or typing ^C in non-^R-mode. ^K as a bare-TECO +command will be completely ignored!! ^Z will safely interrupt MAIL.] +] + +CMD "M,%CTM,COMM,,[Mode switching (mail, send, notification, etc)][ + With this command one can specify the "mailing mode", +whether to "mail" or "send"; a "send" corresponds to :SEND and +prints a message on the recipient's TTY but does not leave mail. +If SEND is selected, there is the further option of mailing as +well, or mailing only if the SEND fails, or never mailing. +If MAIL is selected, one can specify whether the recipient should +be notified (by a small SEND) or not. The default mode is to mail, +with notification.] + +CMD "V,%CTV,COMV,,[Variant force, specify type of header to use.][ + This allows one to specify the header of the message, +by saying whether to use ITS, Network, or RFC733 style in the header +composition, or to use no header at all - i.e. to "quote" the +message text. In the latter case one has the option of +inserting a rudimentary header (of either style) into the +message-text buffer, for editing purposes.] + +CMD "/,%CTSLS,COMSLS,,[Slash switch complement (ON = case conversion like TECO)][ + When switch is ON, characters preceded by a slash will be +forced to uppercase, and all others forced to lowercase. This allows +losing uppercase-only TTY's like the KSR-33 to send nicer messages, +and to specify recipients for sites such as Multics which distinguish +between upper/lower case in user names.] + +CMD "R,%CTR,COMR,,[Receipt mode select - All, Queued, or Failed.][ + The mailer normally only notifies you (a "receipt") of +recipients for which the message failed or was queued; this is the +"queued" mode. Selecting "All" will notify you of successful messages +as well (useful for ensuring that something was actually sent, or that +the mailer is alive), and "Failed" will only return receipts for those +which failed (handy when being plagued by "queued" receipts).] + +CMD "X,%CTX,COMX,[Xpires in (# days): ][(* msgs only) Xpiration date in days.][ + The message will be flushed from .MSGS. (i.e. removed +from the system bulletin board) after the given # of days. If none +is specified, 7 (one week) is used as default.] + +CMD "1,%CT1,COMMF1,[First filename for this *-MSG: ][(* msgs only) 1st filename for .MSGS.;][ + This must always be specified so as to furnish a first filename +under which to store the current *-MSG on the .MSGS. directory; this +is usually a topic name. The second filename +will default to ">" as is usually convenient. If one really +wants to specify both the FN1 and the FN2, the "2" command should +be used also to furnish a FN2.] + +CMD "2,%CT2,COMMF2,[Second filename for this MSG: ][(* msgs only) 2nd filename for .MSGS.;][ + If you don't know what this is about, don't use it.] + +CMD "Q,%CTQ,COMQ,,[Quit][ + Die, exit, commit suicide, :KILL, etc. etc. +Does NOT mail anything - kills job immediately.] + +IFE $$PWORD,[ +CMD ^T,%CT.T,COM.T,[TECO job to read (UNAME JNAME):][][ + Not intended to be a user command. The given filename is +treated as being the U/JNAME of a TECO job, and an attempt is +made to read its current buffer in "GET" mode. The TECO +must have been halted via a ^C or FSEXIT, not a ^K or ^Z. +If you don't understand this, leave it alone and it won't bother you.] +] + +CMD ^X,%CT.X,COM.X,,,[ + This is purely a hack which kills the MAIL job (like $Quit) +when followed by a period, thus resembling DDT's $^X. command.] + +IFE $$PWORD,[ +CMD ^A,%CT.A,COMATR,[Attribute:][][ + This is an experimental command, which allows the +specification of an arbitrary "attribute" in the request +file given to the mailer. This is another one of the +things to avoid unless you already know what it does.] +] + + ; The following are also "commands" of a sort but + ; have deliberately been left undocumented, since + ; the user should not really be aware of them. +CMD ^C,%CT.C,COMSND ; Sends, just like ^C in text. +CMD ^E,%CT.E,COMXS ; Experimental-send, for debugging. +CMD ^N,%CT.N,COMNXS ; "New" send, for new-version COMSAT. +CMD ^L,%CT.L,COM.L ; ^L - clear and redisplay. +CMD ^M,%CTCR,APOPJ ; CR - go back +CMD 177,%CTRUB,APOPJ ; Rubout - also go back + +CMTCHR: BLOCK NCMDS ;table for +CMTPRM: BLOCK NCMDS ;table for ptrs to ASCNT prompt strings +CMTHLP: BLOCK NCMDS ;table for ptrs to ASCNT help strings +CMTDSC: BLOCK NCMDS ; Table for ASCNT desc strings + +COMFLS: TYPE [] ; Return pt to echo command-flush +COMFL1: TYPE [ XXX] ; " when already echoed. +COMFLR: TLO F,%GOCGT ; " when no typeout needed. + POPJ P, + +CONSTANTS ; To help avoid literal table gronkage. + +SUBTTL Help stuffs. + +COMQUE: TYPE [? ">" indicates you are in command mode, entered by typing + or . MAIL commands are all single characters; to list +them, give the 'H' (for HELP) command, and type "?" at it. +] + JRST COMFLR + + +COMH: TYPE [Help for (command or ?):] + PUSHJ P,TTYINU + CAIN A,"? ; Did loser do it? + JRST COMH50 ; Yep, spew out the blurb. + CAIN A,^D + PJRST COMFL1 ; Hmm, flush. + CAIE A,177 ; If rubout, + CAIN A,33 ; or escape, + PJRST COMFLR ; then return immediately to command loop. + CAIN A,^M ; If CR, then ignore helping, + POPJ P, ; return sanely, & go collect message. + + ; Hmm, looks like real command. Try intelligent description. + MOVSI B,-NCMDS + CAME A,CMTCHR(B) ; Try to find its index + AOBJN B,.-1 + JUMPGE B,[TYPECR [ No such command, try again.] + JRST COMH] + MOVEI A,(B) ; Aha, found it. + PUSHJ P,CMDHLP ; Print out its help. + PJRST COMFLR ; Return to command loop. + +COMH50: PUSHJ P,KLEAR + TYPE [ + Welcome to the wonderful world of MAIL. + ^S stops typeout. ^C sends message and quits. + ^D flushes current command, ^G is last-resort interrupt. + ^L redisplays, ^R retypes the current line, ^U deletes it. + DEL (rubout) deletes char, ^W deletes word. +Command mode is entered with or ; a or +exits. The command list: +] + MOVSI C,-NCMDS +COMH52: HLRZ B,CMTDSC(C) ; See if any chars in desc string for command... + JUMPE B,COMH53 + FWRITE TYOC,[[ ],TI,@CMTCHR(C),[ ],TC,CMTDSC(C),[ +]] +COMH53: AOBJN C,COMH52 + TYPE [More in the file INFO;MAIL > +] + PJRST COMFLR ; Return to command loop. + + +; CMDHLP - Given command index in A, prints out available help about +; that command. +CMDHLP: PUSH P,B + HLRZ B,CMTDSC(A) ; Get # chars for desc string in LH. + JUMPE B,[TYPE [ Sorry, no help here yet.] + JRST CMDHL9] + FWRITE TYOC,[[ Help for "],TI,@CMTCHR(A),[" - +],TC,CMTDSC(A),TC,CMTHLP(A)] +CMDHL9: OUT(TYOC,EOL) + TLNN F,%HADCM ; Has any command been given yet? + TYPECR [(Note: or is command escape)] + POP P,B + POPJ P, + + SUBTTL Set variety of header + +STRNAM HEDTYP ; Holds string defining header type + +COMV: TYPE [Variety of header, (I)ts/(N)etwork/(R)FC733/(Q)uoted:] +COMV1: TLO F,%NOECH + SETZ B, + PUSHJ P,TTYINU ;get uppercase unquoted char w/o echo + CAIN A,^D + JRST COMFLS ;Beat hasty exit. + cain a,"Q + jrst comv30 ;go hack quoted header! + CAIE A,177 + CAIN A,^M + SETOB A,B ;Wants default....indicate thusly and hack "char". + CAIN A,"I + MOVEI B,1 + CAIN A,"T + MOVEI B,2 + CAIN A,"N + MOVEI B,3 + CAIN A,"R + MOVEI B,4 + MOVE C,(B)+1+[ + [ASCIZ /Default/] ;index of -1 + [ASCIZ /?/] ; 0 - None of above, ding and try again. + [ASCIZ /ITS/] + [ASCIZ /Tenex/] + [ASCIZ /Network/] + [ASCIZ /RFC733/]] + OUT(TYOC,TZ((C))) + JUMPE B,COMV1 ;Try-again jump. + BCONC ;else some char was found, store it and + MOVE C,(B)+1+[ + [ASCIZ //] ; null string for default + [ 0 ] ; This should never be ref'd + [ASCIZ /ITS/] + [ASCIZ /NET/] + [ASCIZ /NET/] + [ASCIZ /RFC733/]] + OUT(STRC,TZ((C))) + ECONC HEDTYP ; Store string. + POPJ P, ;return. + + +COMV30: type [Quote msg buffer. +Form header of (I)TS, (N)etwork, (CR)nothing:] +COMV20: SETZ B, + TLO F,%NOECH + PUSHJ P,TTYINU ;GET CHAR + CAIN A,^D + JRST COMFLS ; Flush command. + cain a,177 ;rubout? + jrst comv1 + cain a,"I + MOVEI B,1 + cain a,"T + MOVEI B,2 + CAIN A,"N + MOVEI B,3 + CAIN A,^M + MOVEI B,4 + JUMPLE B,[TYPE [?] + jrst comv20] ;none of these, beep and recycle + + ;use existing msg or whatever he forms. + MAKSTR HEDTYP,[[NULL]] ; Set header force string. + MOVE C,(B)[ 0 + [ASCIZ /ITS header formed/] + [asciz /Tenex header formed/] + [asciz /Network header formed/] + [asciz /Quoting msg buffer as is./]] + OUT(TYOC,TZ((C)),EOL) + CAIN B,4 + JRST COMV90 + uaropn [%ARTZM+%ARTCH,,TMPAR ;open new area + [0]] + OUT(MSGC,OPEN(UC$UAR,TMPAR)) ;and reopen msgc chan into it + SKIPN A,XUNAME + MOVE A,LUNAME + JRST @.(B) + COMV50 + COMV60 + COMV60 + + ; ITS header. +COMV50: FWRITE MSGC,[6F,A,[@],TZ,@OWNNAM,[ ],WAI,,] + hrrz b,subjec + caile b, ;if have a subj line, + jrst [ fwrite msgc,[[ Re: ],ts,subjec] ;write it. + jrst .+1] + OUT(MSGC,EOL) + pushj p,toput +COMV55: fwrite msgc,[ta,msgar] ;add on old msg. + uarcls msgar ;now close old area + MOVE A,[TMPAR,,MSGAR] + BLT A,MSGAR+$ARSIZ-1 ;make new area the msg area. + SETZM $AROPN+TMPAR ;say old ARBLK is closed. + OUT(MSGC,OPEN(UC$UAR,MSGAR)) ;reopen MSGC chan into new MSGAR. +COMV90: tlo f,%mquot + POPJ P, + + ;form Network header +comv60: fwrite msgc,[[Date: ],wbi,,[ +From: ],6f,A,[ at ],tz,@ownnam,[ +]] + pushj p,toput + hrrz b,subjec + caile b,0 + jrst [fwrite msgc,[[Subject: ],ts,subjec,[ +]] + jrst .+1] + OUT(MSGC,EOL) + JRST COMV55 + +TOPUT: PUSHAE P,[A,TTYWID] + MOVEI A,72. + MOVEM A,TTYWID ;use standard TTY width. + HRRZ A,RLSNAM + JUMPN A,[FWRITE MSGC,[[To: ],TS,RLSNAM,[ +]] + JRST TOPU5] + PUSHJ P,TPUT + OUT(MSGC,TS(TOLINS)) +TOPU5: PUSHJ P,CPUT + OUT(MSGC,TS(TOLINS)) + POPAE P,[TTYWID,A] + POPJ P, + +STRNAM TOLINS + ;routine to form "to:" lines from what is currently in rcpt tables. + ; Leaves string output in TOLINS. + +TPUT: PUSH P,D + SETZ D, + JRST TOPUT0 +CPUT: PUSH P,D + MOVEI D,1 +TOPUT0: PUSHAE P,[A,B,C,E,R] +TOPUT1: MOVE R,RCPNUM + JUMPE R,[SETZM TOLINS ? JRST TOPUT9] + BCONC + IMUL R,[-1,,0] + SETZ E, ;zero cnt of chars on line + caia +TOPUT2: aobjp R,toput8 ;get index to rcpt + MOVE A,@TRCPF ;get flags + TLNE A,R%CC ;is rcpt a CC? + JRST @(D)[TOPUT2 ;yes, ignore if want 0 = "to"s. + TOPUT3] ;yes, got one. + JRST @(D)[TOPUT3 ; a TO. reverse jumpings. + TOPUT2] +toput3: move c,@trcph ;get site + move a,c + pushj p,ghname ;addr of name of dest site into a + push p,a + pushj p,lasciz ;find length + HLRZ B,@TRCPN ;get <# chars> in rcpt name + addi a,4(b) ;find # chrs hostname+#chars rcptname plus " at " + pop p,b ;get addr of asciz for site name + MOVE C,@TRCPN + ADD C,TRSTTB ;and abs ascnt ptr to rcpt name + + ADDI a,6 ;for the ", " and " at " + ADDI E,(a) ;add total for item into total for line + CAILE E,(a) ;skip if nothing was on line(regardless of size) + CAML E,TTYWID ;don't skip if already something and total now too big + JRST [CAILE E,(a) ;skip again if nothing was on line + OUTCAL(STRC,EOL) + CAIN D, + OUTCAL(STRC,("To: ")) + CAIE D, + OUTCAL(STRC,("cc: ")) + MOVEI E,2(a) ;4 chars of "to: " less two chars of ", " + JRST TOPUT4] ;if starting line, output name regardles of length + FWRITE STRC,[[, ]] +TOPUT4: FWRITE STRC,[TC,C,[ at ],TZ,(B)] + JRST TOPUT2 ;get another item + + ;items all gone. +TOPUT8: CAILE E,0 ;if anything was on line, + OUTCAL(STRC,EOL) ;crlf it. + ECONC TOLINS +TOPUT9: POPAE P,[R,E,C,B,A,D] + POPJ P, + + +; Addr in A to asciz string, returns in A the # chars in string. +; String must obviously start on word boundary. +; Faster than LBPASZ (8 instrs/loop and no ILDB'ing). +LASCIZ: PUSHAE P,[B,C] + MOVE C,A + TDCA A,A ;clear A and skip +LASCZ1: ADDI A,5 + MOVE B,(C) + TLNN B,774000 ;test 1st char + JRST LASCZ7 ;null, done. + TLNN B,3760 ;test 2nd char + AOJA A,LASCZ7 ;null, add 1 and done. + TDNN B,[17,,700000] + JRST LASCZ6 ;go add 2, done. + TRNN B,77400 + AOJA A,LASCZ6 ;add 3 + TRNE B,376 + AOJA C,LASCZ1 ;Not ended yet; increment address and add 5 at top. + ADDI A,4 ;ended, add 4. + JRST LASCZ7 +LASCZ6: ADDI A,2 +LASCZ7: POP P,C + POP P,B + POPJ P, + +; Like LASCIZ, but works for any byte ptr in A. +LBPASZ: PUSHAE P,[B,C] + SETZ B, + ILDB C,A + CAIE C,0 + AOJA B,.-2 + MOVE A,B + POPAE P,[C,B] + POPJ P, + SUBTTL Set mailing mode +COMM: TYPE [Mode: (M)ail, (S)end, default: ] +COMM1: PUSHJ P,TTYINU + CAIN A,177 ;rubout? + POPJ P, ;ignore command if so + CAIN A,^M ;default? + JRST [ SETZM SENDSW + SETZM MAILSW + SETZM SORMSW + TYPECR [Mail and normal notify] + POPJ P,] + CAIN A,"M + JRST COMM20 + CAIN A,"S + JRST COMM10 + CAIN A,^D + JRST COMFL1 + TYPE [?] ;Bad char + JRST COMM1 + + ;Send. +COMM10: SETZM SENDSW ;send, mail if failed. + SETOM SORMSW + TYPE [end. +Mail too? (Y)es, (N)o, only if can't SEND:] +COMM15: PUSHJ P,TTYINU + CAIN A,^D + JRST COMFL1 + CAIN A,^M + JRST [ TYPECR [Send, and mail if can't.] + POPJ P,] + OUT(TYOC,EOL) + CAIN A,"N + JRST [ SETCMM SENDSW + TYPECR [Send, and never mail.] + POPJ P,] + CAIN A,"Y + JRST [ MOVEI A,1 + MOVEM A,SENDSW + TYPECR [Send, and mail too.] + POPJ P,] + OUT(TYOC,C(^G),C("?)) + JRST COMM15 + + ; Mail +COMM20: SETZM SENDSW + SETZM MAILSW + SETZM SORMSW + TYPE [ail. +Notify recipient? (Y)es, (N)o, default: ] + PUSHJ P,TTYINU + CAIN A,^D + JRST COMFL1 + CAIE A,^M + OUTCAL(TYOC,EOL) + CAIN A,"Y + JRST [ MOVEI A,1 + MOVEM A,MAILSW + TYPECR [Mail, and notify if possible.] + POPJ P,] + CAIN A,"N + JRST [ SETOM MAILSW + TYPECR [Mail, and don't notify.] + POPJ P,] + TYPECR [Default - notify if rcpt wants.] + POPJ P, + +BVAR +SENDSW: 0 ; -1 send, don't mail. 0 send, mail if fail. 1 send + mail. +MAILSW: 0 ; -1 mail, never notify. 0 mail normally. 1 mail + try hard to notify. +SORMSW: 0 ; 0 mailing, -1 sending. +EVAR + SUBTTL Random small commands + + ; ^L during command invoke. +COM.L: SKIPE TTYDIS ; no-op if not display. + PUSHJ P,MOSDIS ; Display "most" of data. + JRST COMFLR ; Return to command loop. + + ; / - complement slashification for upper/lower case. +COMSLS: TLZ F,%SLSHC + SETCMB A,SLSHFY + type [/ Case conversion ] + SKIPN SLSHFY + OUTCAL(TYOC,("OFF")) + SKIPE SLSHFY + OUTCAL(TYOC,("ON")) + OUT(TYOC,EOL) + SKIPN SLSHFY ;re-open slash-output chan in right mode. + OUTCAL(TYOSC,OPEN(UC$TRN,[TYOC])) ; Normal mode == TYOC + SKIPE SLSHFY + OUTCAL(TYOSC,OPEN(UC$XCT,[CALL SLSTYO])) ; Slashify mode! + POPJ P, + +LVAR SLSHFY: 0 ;when set, hack slashification. + + ; XCT routine for slashification UUO channel. +SLSTYO: TLNE F,%NOTYO ;ok to output? + POPJ P, ;nope, nop. + CAIN U1,177 ;rubout? + JRST [ .IOT TYOC,["^] + .IOT TYOC,["?] + POPJ P,] + CAIL U1,"A + CAILE U1,"Z + CAIA + .IOT TYOC,["/] + .IOT TYOC,U1 ;finally output! + POPJ P, + + + ; ^E - Experimental Send of message, using xper version of COMSAT. +COMXS: TYPE [Experimental-send.] + SKIPE DEBUG ; If debugging, we know what we're doing, + JRST COMXS7 ; So don't pester debugger. + TYPE [ WARNING - this is a debugging command only! +Are you SURE?] + PUSHJ P,TTYINU ; Get reply + CAIE A,"Y ; Proceed only if "Y" + JRST [ TYPECR [ Flushed.] + POPJ P,] + TYPECR [ Very well...] +COMXS7: SETOM SNDVRS ; Set sending version to -1 + JRST MSGSND ; And go send message. + + ; ^N - Like ^X but sends to "New" operational mailer + ; and requires no confirmation. +COMNXS: TYPE [^New-send!] + SETZM SNDVRS + AOS SNDVRS ; Set sending variation to 1 + JRST MSGSND + + ; ^C - Like ^C during text collection, sends message. +COMSND: TYPE [^Cend!] + SETZM SNDVRS ; Always use vanilla type. + JRST MSGSND ;go send msg + + ; "From:" spec +COMF: MOVEI A,FRMNAM ;address of string to store line in. + JRST LINSTO + + ; "Subject:" spec +COMS: MOVEI A,SUBJEC + JRST LINSTO + + ; "Attribute:" experimental spec. +COMATR: MOVEI A,ATTRIB ; Addr of string to store into. + PJRST LINSTO +STRNAM ATTRIB ; String holding arbitrary attribute text. + + ; "Name for recipient list:" +COMN: MOVEI A,RLSNAM ;drop thru to get line. + +LINSTO: PUSHJ P,GETLIN ;get line for whatever wants it. + PJRST COMFLR ; Command was flushed. + HRLI A,LINPUT ;form BLT, ,, + MOVE B,A + BLT A,1(B) ;xfer 2 wds of string descriptor. + POPJ P, + + ; 1st MSG filename +COMMF1: TDCA B,B ;clear B and skip +COMMF2: MOVEI B,1 + PUSHJ P,GETLIN + PJRST COMFLR ; Flushed?? + MOVEI A,LINPUT + PUSHJ P,STRIM ;make sure it's trimmed. + PUSHJ P,CVTS6F ;convert string to a 6bit word + CAIN A,0 ;if nothing there, use default. + MOVE A,MFNDEF(B) + MOVEM A,MSGFN1(B) + POPJ P, + +MFNDEF: SIXBIT /MSG/ ; default FN1, FN2 for *-style msg. +MFNDF2: SIXBIT />/ +BVAR +MSGFN1: 0 ; FN1 for *-style message. +MSGFN2: 0 ; FN2 for ditto +EXPTIM: 0 ; Expiration time for *MSG, in days (default 7) +EVAR + ; Xpiration date for MSGs, in days. +COMX: PUSHJ P,GETLIN ;get # of days to expire in + POPJ P, + MOVEI A,LINPUT + PUSHJ P,IPNUM ;try to parse as decimal number. + SETZ A, + JUMPLE A,[MOVEI A,7 + MOVEM A,EXPTIM + TYPE [Default: ] + PUSHJ P,EXPDIS + POPJ P,] + CAILE A,365. + MOVEI A,365. ;nothing longer than 1 year. + MOVEM A,EXPTIM ;store + POPJ P, + + ;convert string (ptr in A) to 6bit word in A +CVTS6F: PUSHAE P,[B,C,D,E] + HRRZ D,(A) ;get cnt + CAILE D,6 + MOVEI D,6 ;limit to 6 + MOVE E,1(A) ;and bp + SETZ A, + MOVE C,[440600,,A] + JRST CVTS63 +CVTS62: ILDB B,E + CAIL B,"a + CAILE B,"z + SKIPA + SUBI B,40 + SUBI B,40 + IDPB B,C +CVTS63: SOJGE D,CVTS62 + POPAE P,[E,D,C,B] + POPJ P, + + ;takes ptr in A to string, clobbers so that leading/trailing blanks flushed. +STRIM: PUSHAE P,[B,C,D,E] + HRRZ D,(A) + JUMPE D,STRIM9 + MOVE E,1(A) ;get cnt and bp for string. +STRIM1: MOVE C,E ;save so don't have to D7BPT it. + ILDB B,E + CAIN B,40 + JRST [ SOJG D,STRIM1 + JRST STRIM8] ;all blanks. + MOVEM C,1(A) ;store trimmed start ptr (perhaps same as original) + PTSKIP D,C ;increment ptr by # chars remaining +STRIM2: LDB B,C + CAIN B,40 + JRST [ D7BPT C + SOJG D,STRIM2 + JRST STRIM8] ;all blanks and first loop missed?? +STRIM8: HRRM D,(A) ;store new cnt back. +STRIM9: POPAE P,[E,D,C,B] + POPJ P, + + + ; Receipt switch complement +LVAR RGSTRD: 0 ; Holds address of string specifying type of + ; "registration" if any. +COMRHT: ASCNT [ +A - You will be notified when message is sent (includes Q,F). +Q - " only if message queued (Default, includes F). +F - " only if message fails. +] +COMR: TYPE [Receipt mode - (A)ll, (Q)ueued, (F)ailed:] +COMR10: TLO F,%NOECH + PUSHJ P,TTYINU ; Get answer + CAIN A,"? + JRST [ FWRITE TYOC,[[?],TC,COMRHT] + JRST COMR] + CAIN A,^M + JRST [ FWRITE TYOC,[[Default - ]] + MOVEI A,"Q + JRST .+1] + CAIN A,"A + JRST [ FWRITE TYOC,[[All]] + MOVEI B,[ASCSTR [A]] + JRST COMR70] + CAIN A,"Q + JRST [ FWRITE TYOC,[[Queue]] + SETZ B, ; This is default, so... + JRST COMR70] + CAIN A,"F + JRST [ FWRITE TYOC,[[Failed]] + MOVEI B,[ASCSTR [F]] + JRST COMR70] + FWRITE TYOC,[[?]] + JRST COMR10 + +COMR70: MOVEM B,RGSTRD ; Store resulting ptr to string. + OUT(TYOC,EOL) + POPJ P, + + + ; QUIT - Die! +COMQ: PUSHJ P,INPFLS ; Make sure everything flushed, so + TYPE [Quit. Are you sure?] ; User sees this msg. + TLO F,%NOECH ; Don't echo this char + PUSHJ P,TTYINU + CAIE A,"Y + CAIN A,^M ; Here, a CR is ok for confirm too. + JRST COMQ5 + TYPE [ No] + POPJ P, + +COMQ5: TYPE [ Yes] +COMQ9: .BREAK 16,140000 ; Type ":KILL" on return to DDT, don't reset TTY input. + + ; For handling $^X. killing. +COM.X: TYPE [^X] + PUSHJ P,TTYINU + CAIN A,". + JRST COMQ9 ; If proper sequence, kill w/o further ado. + PUSHJ P,INPFLS + TYPE [??] + POPJ P, + + ; Zap message-text buffer +COMZ: TYPECR [Zap!] ; Drop thru and return. + +ZAPMSG: UARCLS MSGAR + UAROPN [%ARTZM+%ARTCH,,MSGAR ? [2000]] + OUT(MSGC,OPEN(UC$UAR,MSGAR)) + POPJ P, + + ; L - List recipients. Like ^L on displays. +COML: SKIPE TTYDIS ;don't bother to complete command + TYPECR [List] ;unless non-display. + PJRST RCPDIS ; Display and return. + SUBTTL Read/write messge text files + + ; Yank file, Append file, and Insert file. +COMY: TDCA D,D ;clear D and skip. D is yank indicator. +COMA: +COMI: SETO D, ; this flag purely to avoid yank-style input. +COMI01: MOVEI A,DKIOPN + MOVE B,[MFDEV,,DKIDEV] + PUSHJ P,FILSET + POPJ P, + CAIN D,0 ;skip unless yanking. + PUSHJ P,ZAPMSG ;zap buffer if yanking. + MOVEI A,DKIDEV + PUSHJ P,FILADD + fwrite tyoc,[[(],N9,NCHAPP,[ Chars read.)]] + POPJ P, + + ; Write text file +comw: out(msgc,PTV(a)) ;get # chars written so far + jumpg a,comw10 ;yup, something there. + TYPECR [Write to file:] + PUSHJ P,ERRBEG + TYPECR [No message text, Write-File command ignored!] + PJRST ERREND + +comw10: MOVEI A,WRTOPN ; set up addr of .CALL blk + MOVE B,[WRTDEF,,WRTDEV] + .SUSET [.RSNAME,,WRTDEF+1] ; set default dir to current SNAME + PUSHJ P,FILSET ; read in a file spec and open. + POPJ P, ; doesn't really want anything. + OUT(DKOC,OPEN(UC$IOT)) + FWRITE DKOC,[TA,MSGAR] ;writing text file. + .close dkoc, + POPJ P, + + ; P - Put out execution file so a GET will restore world. + +COMP: MOVEI A,WRTOPN ; set up addr of .CALL blk + MOVE B,[WRTDEF,,WRTDEV] + .SUSET [.RSNAME,,WRTDEF+1] ; set default dir to current SNAME + PUSHJ P,FILSET ; read in a file spec and open. + POPJ P, ; doesn't really want anything. + OUT(DKOC,OPEN(UC$IOT)) + + fwrite dkoc,[[F]] + hrrz b,frmnam ;FROM spec exists? + JUMPLE B,[SKIPN A,XUNAME + MOVE A,LUNAME + OUT(DKOC,6F(A)) + jrst comw55] + FWRITE DKOC,[TS,FRMNAM] +comw55: OUT(DKOC,EOL) + SKIPN A,MSGFN1 + JRST COMW56 + FWRITE DKOC,[[1],6F,A] + OUT(DKOC,EOL) +COMW56: SKIPN A,EXPTIM + JRST COMW57 + FWRITE DKOC,[[X],N9,A] + OUT(DKOC,EOL) +COMW57: HRRZ B,SUBJEC + JUMPLE B,COMW60 ;jump if subj text nil + fwrite dkoc,[[S],TS,SUBJEC,[ +]] + +comw60: FWRITE DKOC,[[],TS,HEDTYP,[ +]] ; Write out string specifying header type. + +comw65: move R,rcpnum + soj R, +comw70: skipn C,@TRCPF ;get flags + jrst comw75 ;null + tlne c,r%cc + outcal(dkoc,(/C"/)) + tlnn c,r%cc + outcal(dkoc,(/T"/)) + MOVE A,@TRCPN + ADD A,TRSTTB ;get abs ascnt ptr to name + fwrite dkoc,[TC,A,["@]] + MOVE A,@TRCPH ;get site + camn a,[-1] + move a,ownhst + fwrite dkoc,[HST,A,[ +]] ;output site +comw75: sojge R,comw70 + + FWRITE DKOC,[TA,MSGAR] ;finally write out msg text + .close dkoc, ;note that lossage possible with inclusion of + POPJ P, ;chars like alt, ^d, ^c in text. + + +wrtopn: setz ? sixbit /open/ ? [.UAO,,dkoc] ? wrtdev + wrtfn1 ? wrtfn2 ? setz wrtdir +BVAR +WRTDEV: 0 +WRTDIR: 0 +wrtfn1: 0 +wrtfn2: 0 + +wrtdef: SIXBIT /DSK/ ? 0 + sixbit /msgtxt/ ? sixbit />/ +EVAR + +DKIOPN: SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC] ; standard input open + DKIDEV ? DKIFN1 ? DKIFN2 ? SETZ DKIDIR + +BVAR +MFDEV: 'DSK,,0 +MFDIR: 0 +MFFN1: 0 +MFFN2: SIXBIT />/ + +DKIDEV: 0 +DKIDIR: 0 +DKIFN1: 0 +DKIFN2: 0 +EVAR + + ; "GET" - exec file readin. +comg: MOVEI A,DKIOPN + MOVE B,[MFDEV,,DKIDEV] + PUSHJ P,FILSET + POPJ P, + + PUSHJ P,TXFIN ; slurp up text file open on channel. returns area in A + PJRST SETINP ;use area # as argument to set input stream from. + + + ; ^T command, takes filename and assumes it is USR:UNM JNM of a + ; TECO from which to gobble buffer. +COM.T: MOVEI A,USROPN + MOVE B,[USRDEF,,USRDEV] + PUSHJ P,FILSET ;get filespec + POPJ P, + ;aha, opened the filespec (inferior)! + SETZ A, ; Say to create area... + PUSHJ P,TECIN ;gobble the TECO's buffer into an area. + JRST COM.T5 + PUSHJ P,SETINP ;set input stream to read from this. +COM.T5: HLRZ A,USRDEV + CAIN A,'USR ;now must close channel... check before .UCLOSE'ing + .UCLOSE USRI, ;since this will bomb if there is no inferior! + .CLOSE USRI, + POPJ P, + +USROPN: SETZ ? SIXBIT /OPEN/ ? [.BII,,USRI] ? USRDEV + USRFN1 ? USRFN2 ? SETZ USRDIR + +BVAR +USRDEF: SIXBIT /USR/ + 0 + 0 + SIXBIT /TECO/ +USRDEV: 0 +USRDIR: 0 +USRFN1: 0 +USRFN2: 0 +EVAR + +COME: + + + + TYPE [Edit Escape! +] + .SUSET [.RHSNAM,,TPDIRS] ; Try HSNAME;TS * first. + .SUSET [.RXUNAM,,A] ; get for hsname;xuname MAILT + SYSCAL OPEN,[[.BII,,DKIC] ? TECPGM ? A ? TPFN2S ? TPDIRS] + CAIA + JRST COME07 + MOVSI A,-NTPDIR ; and try several dirs +COME04: MOVSI C,-NTPFN2 ; also try several FN2's. +COME05: MOVE B,TPFN2S(C) + MOVEM B,TECPGM+3 ; Store as FN2 for "TS " + MOVE B,TPDIRS(A) + MOVEM B,TECPGM+1 + SYSCAL OPEN,[[.BII,,DKIC] ? TECPGM ? TECPGM+2 ? TECPGM+3 ? TECPGM+1] + JRST [ AOBJN C,COME05 + AOBJN A,COME04 + PUSHJ P,ERRFLS + MOVEI A,TECPGM + PUSHJ P,FILERR ; Complain if can't open any. + PJRST COMFLR] + +COME07: out(msgc,PTV(c)) ;get # chars in msg-chnl area + JUMPLE C,COME20 ;if nothing in message text, don't bother with file. + .SUSET [.RSNAME,,TECDIR] + .CALL OXFOPN ;try first thing. + CAIA + JRST COME10 + MOVE A,[SIXBIT /COMMON/] + MOVEM A,TECDIR + .SUSET [.RUNAME,,TECFN1] + .CALL OXFOPN + JRST [ PUSHJ P,ERRFLS + MOVEI A,TECDEV + PUSHJ P,FILERR + PJRST COMFLR] + +COME10: OUT(DKOC,OPEN(UC$IOT),TA(MSGAR)) ;write out text + .CLOSE DKOC, + + OUT(TMPC,OPEN(UC$BPT,[440700,,TECJCL])) + FWRITE TMPC,[6F,TECDIR,[;],6F,TECFN1,[ ],6F,TECFN2,[ +]] + OUT(TMPC,PTV(B)) + HRLZ B,B + HRRI B,TECJCL ;make ascnt ptr to JCL for teco. + CAIA +COME20: SETZ B, ;come here to just run w/o JCL. + MOVE A,[SIXBIT /MAILT/] ; Use this as XJNAME. + PUSHJ P,PGMRUN + JRST COME80 + + MOVEI A,TMPAR + PUSHJ P,TECIN ;slurp up buffer from TECO into area in A + JRST COME80 ;failed... perhaps MPV. + UARCLS MSGAR ;flush old message text, + MOVE B,A ;save ARPT + HRLZS A + HRRI A,MSGAR + BLT A,MSGAR+$ARSIZ-1 ;make new area the message area, + SETZM $AROPN(B) + OUT(MSGC,OPEN(UC$UAR,MSGAR)) ;and point MSGC channel at it. + PUSHJ P,PGMKIL ;now kill the inferior. + TDCA A,A ;here, all won. +COME80: SETO A, ;here, something lost. Don't zap screen. + SYSCAL DELETE,[TECDEV ? TECFN1 ? TECFN2 ? TECDIR] + JFCL + JUMPN A,APOPJ + SKIPE TTYDIS + TRO F,%DSALL ; Set flag to display everything upon entering MSGGET. + POPJ P, + +BVAR +TECPGM: SIXBIT /DSK/ + 0 ; Filled in from TPDIRS. + SIXBIT /TS/ + 0 ; Filled in from TPFN2S. + +TPDIRS: 0 ; Filled by HSNAME. + SIXBIT /SYS/ + SIXBIT /SYS1/ + SIXBIT /SYS2/ + SIXBIT /SYS/ ; So error message reports this dir. + NTPDIR==.-TPDIRS +EVAR + +TPFN2S: SIXBIT /MAILT/ ; Names to try for "TS " + SIXBIT /EDIT/ + SIXBIT /EMACS/ + SIXBIT /TECO/ + NTPFN2==.-TPFN2S + +BVAR +TECJCL: BLOCK 10.*3 + +TECDEV: SIXBIT /DSK/ +TECDIR: 0 +TECFN1: SIXBIT /_MAIL_/ +TECFN2: SIXBIT /_EDIT_/ +EVAR + +OXFOPN: SETZ ? SIXBIT /OPEN/ ? [.UAO,,DKOC] ? TECDEV + TECFN1 ? TECFN2 ? SETZ TECDIR + + ; PGMRUN - run an inferior. B has address of ASCIZ string for JCL, + ; A points to FILBLK of pgm to run for entry pt PGMRNF, + ; else DKIC must already be open for input and A should hold + ; desired XJNAME. + ; Skips if terminates normally, + ; doesn't skip if abnormal termination. In either case caling + ; routine must call PGMKIL to flush it. + +PGMRNF: PUSHAE P,[A,B,C,D,E] ; + SETZM PGMJOB' ;not yet created inferior + .CALL TXFOPN + JRST [ PUSHJ P,ERRFLS + PUSHJ P,FILERR ;couldn't open file? + JRST PGMR80] + MOVE D,2(A) ; For XJNAME, get FN1 of file using + CAMN D,[SIXBIT /TS/] ;and use that unless it's TS. + MOVE D,3(A) ;in which case use FN2 instead. + JRST PGMR01 + +PGMRUN: PUSHAE P,[A,B,C,D,E] + SETZM PGMJOB' + MOVE D,A ; Use given XJNAME. +PGMR01: MOVEM B,PGMJCP' + + ; now try to create inferior... + + MOVE B,D ; Save desired XJNAME in B. +PGMR10: SYSCAL OPEN,[[UBPFJ+.BII,,USRI] ? ['USR,,0] ? [0] ? D ? CERR C] + JRST [ CAIE C,4 ;if didn't exist, OK to open for real. + JRST PGMR80 ;foo? lost with strange error? + JRST PGMR30] + .UCLOSE USRI, ;hmph, it already exists. flush it. + AOS D ;"AOS" the jname in D (for now, really do AOS!) + JRST PGMR10 ;try again + +PGMR30: SYSCAL OPEN,[[.BIO,,USRO] ? ['USR,,0] ? [0] ? D ? CERR C] + JRST [ CAIN C,12 ;was specified job somehow created meanwhile? + JRST PGMR10 + CAIN C,6 ;no slots available? + JRST PGMR10 + .VALUE] ;none of these, fail. + SETOM PGMJOB ;indicate inferior created. + SYSCAL OPEN,[[.BII,,USRI] ? ['USR,,0] ? [0] ? D ? CERR C] + .VALUE + .USET USRI,[.SXJNAME,,B] ; Set XJNAME to desired value. + + ;load the program from file + SYSCAL LOAD,[CIMM USRI ? CIMM DKIC] + JRST [ PUSHJ P,ERRFLS + TYPE [Can't load pgm file - ] + PUSHJ P,ERRDOC + OUT(TYOC,EOL) + JRST PGMR80] + HRROI A,PGMSTA' + .IOT DKIC,A ;get starting address + .CLOSE DKIC, ;no further need for dsk chan + .USET USRI,[.SUPC,,PGMSTA] ;set inferior's starting address + .USET USRI,[.RINTB,,INFBIT] ;find interrupt bit for this inferior + SETZM PGMJCL' ; Assume no JCL availalbe until proven otherwise + SKIPN PGMJCP ; Skip if JCL string given. + JRST PGMR37 ; Nope, nothing there. + HLRZ A,PGMJCP ; get char cnt + IDIVI A,5 ;get # wds + CAIE B,0 + AOJ A, + CAIN A, + JRST PGMR37 ;if nothing in message text, no JCL. + MOVEM A,PGMTXL' + MOVEM B,PGMTXR' ;save # full wds and # remaining chars in last. + SETOM PGMJCL' ;indicate JCL available + .USET USRI,[.SOPTION,,[OPTCMD,,]] ;tell it JCL is available +PGMR37: TLO F,%PGMRN ;tell int. handler to handle the ints, and + .SUSET [.SIMSK2,,INFBIT] ;enable ints from inferior + + .ATTY USRI, ;give it the TTY. + .VALUE ;hmm, sould be able to! +PGMR40: .USET USRI,[.SUSTP,,[0]] ;start it! + .SUSET [.SADF2,,INFBIT] ;clear defer bit + JFCL + .HANG + JRST PGMR75 ;if somehow get here, exit... + + ;dismiss to here upon inferior interrupt! +PGMR60: .USET USRI,[.RPIRQC,,C] + TRNE C,%PIC.Z ;inferior executed ctl-Z? + JRST [ .USET USRI,[.SAPIRQ,,[%PIC.Z]] ;clear it + .DTTY + JFCL + .SUSET [.SIPIRQ,,[%PIC.Z]] ;set for self! + .ATTY USRI, + JFCL + JRST PGMR40] ;when continued, continue TECO. + TRNN C,%PIBRK ;inferior executed a .BREAK? + JRST [ TRNN C,%PIVAL ; a .VALUE? + JRST PGMR75 ;something else, kill. + .USET USRI,[.RUPC,,C] + SUBI C,1 + .ACCESS USRI,C + HRROI D,A + .IOT USRI,D + CAMN A,[.VALUE] + JRST PGMR75 ;a .VALUE 0. + .USET USRI,[.SAPIRQC,,[%PIVAL]] + JRST PGMR40] ;ignore it... (gulp) + .USET USRI,[.SAPIRQC,,[%PIBRK]] ;turn off the interrupt for inferior + .USET USRI,[.RUPC,,C] ;decipher .BREAK. find PC + SUBI C,1 ;back up to instr executed + .ACCESS USRI,C ;set to that + HRROI D,A + .IOT USRI,D ;read instr. into A + LDB B,[$ACFLD,,A] + CAIE B,12 ;request-info type .BREAK? + JRST [ CAIN B,16 ;type asking for death? + JRST PGMR85 ;yes, return with skip... successful termination! + JRST PGMR75] ;nope, die noisily. + .ACCESS USRI,A ;point to address field of .break + HRROI D,A + .IOT USRI,D ;get the command word + LDB B,[221100,,A] ;see what type + CAIE B,5 ;JCL related? + JRST [ CAIE B,11 ;nope, ugh + CAIN B,12 ; XUNAME or XJNAME? + CAIA + JRST PGMR40 ;nope. but ignore it. + JUMPL A,[.ACCESS USRI,A + HRROI D,A + .IOT USRI,D + CAIN B,11 + .USET USRI,[.SXUNAME,,A] + CAIN B,12 + .USET USRI,[.SXJNAME,,A] + JRST PGMR40] + .ACCESS USRO,A + CAIN B,11 + .USET USRI,[.RXUNAME,,A] + CAIN B,12 + .USET USRI,[.RXJNAME,,A] + HRROI D,A + .IOT USRO,D + JRST PGMR40] + JUMPL A,[SETZM PGMJCL ;if type=write, indicate JCL no longer avail. + .USET USRI,[.ROPTION,,A] + TLZ A,OPTCMD + .USET USRI,[.SOPTION,,A] + JRST PGMR40] + SKIPN PGMJCL ;if JCL not avail, ignore request to read. + JRST PGMR40 + + ;now write JCL into place specified by RH of A. + MOVE B,PGMTXL + MOVNI B,-1(B) ; - (whole wds) + HRLZ B,B + HRR B,PGMJCP + .ACCESS USRI,A + .ACCESS USRO,A + JUMPGE B,PGMR66 ;if there was only 1 wd to write, can skip loop +PGMR64: HRROI D,C + .IOT USRI,D ;read to ensure zero + JUMPN C,PGMR40 + MOVE C,(B) ;if zero, get string word + HRROI A,C + .IOT USRO,A ;and write into inf. + AOBJN B,PGMR64 + ;write out last wd of JCL. +PGMR66: HRROI D,C + .IOT USRI,D + JUMPN C,PGMR40 + MOVE A,PGMTXR ;get # of chars which remained in last wd + MOVE C,(B) + TDZ C,REMMSK(A) ;mask them off + HRROI A,C + .IOT USRO,A ;and write last wd. + ;that's all-- no need to write terminating zero wd since wd is already + ;zero if such writing is possible! + JRST PGMR40 + + ;come here to kill job for some reason. +PGMR75: .DTTY + JFCL + PUSHJ P,PGMKIL + JRST PGMR80 + + ;Bad condition of some sort during startup. try to complain by + ;sending message. ASCNT ptr in A to text. +PGMR80: .DTTY + JFCL + .CLOSE DKIC, + SKIPE PGMJOB ;skip if never opened job. + .UCLOSE USRI, ;else flush it. + JRST PGMR90 + +PGMR85: .DTTY + JFCL + AOS -5(P) +PGMR90: TLZ F,%PGMRN + POPAE P,[E,D,C,B,A] + POPJ P, + + ;here, kill job quietly. +PGMKIL: .UCLOSE USRI, ;die. + .SUSET [.SAIFPIR,,INFBIT] + SETZM PGMJOB + POPJ P, + +LVAR INFBIT: 0 ;holds interrupt bit for inferior + +REMMSK: 0 + 3777,,-1 ; 1 char in wd, mask out last 4 + 17,,-1 ; 2, zap last 3 + 77777 ; last 2 + 377 ; last 1 + + ;default file blk for pgm running +PGFDEF: SIXBIT /DSK/ + SIXBIT /SYS/ + SIXBIT /TS/ + SIXBIT /FOO/ +BVAR +PGFDEV: 0 +PGFDIR: 0 +PGFFN1: 0 +PGFFN2: 0 +EVAR + +OPNPGM: SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC] ? PGFDEV + PGFFN1 ? PGFFN2 ? SETZ PGFDIR + +UBPFJ==10 ;fail with 4 if no such job exists anywhere. +OPNJB0: SETZ ? SIXBIT /OPEN/ ? [UBPFJ+.BII,,USRI] ? ['USR,,0] + [0] ? A ? SETZ CERR C + + ; TECIN - given USRI inferior channel to a TECO, crunches the buffer + ; block pointed to by AC 2 and reads contents into area specified + ; by an ARPT in A. Returns ARPT in A also (creates new if A was + ; zero to begin with) + +TECIN: PUSHAE P,[B,C] + MOVE C,A ; Save ARPT in C. + MOVEI A,TECIN9 + MOVEM A,MPVRET ;set loc to return to if MPV happens. + TRO F,%IMPV ;set inferior MPV flag + .ACCESS USRI,[2] ;reference AC 2 + HRROI A,B + .IOT USRI,A ;get addr of buffer block into C + .ACCESS USRI,B + MOVE A,[-7,,T%BEG] ;set up ptr to gobble 7 wds + .IOT USRI,A ;get buffer block + TRZ F,%IMPV ;clear flag. rest is up to INFSGT. + + UAROPN C,[%ARTZM+%ARTCH,,(C) ? [200]] ;create area of token size. + MOVE A,T%XTRC + MOVE B,T%GPT ;set up for absolute conversion. + CAMG B,T%BEGV ;adjust for gap, + ADDM A,T%BEGV ;if necessary. + CAMG B,T%ZV + ADDM A,T%ZV ;now have absolute virtual buffer boundaries. + + MOVE A,T%BEGV ;get start of buffer + MOVE B,T%ZV ;and end. + CAMGE A,T%GPT ;see if gap exists in middle. GPT greater than beg? + CAMG B,T%GPT ;and less than end? + JRST TECIN5 ;no, buffer is integral! + MOVE B,T%GPT ;yes, gap is in middle of buffer. get end of first blk. + PUSHJ P,INFSGT ;get it. + JRST TECIN9 + MOVE A,T%GPT + ADD A,T%XTRC ;get end of gap as start of 2nd block. + MOVE B,T%ZV ;and get end of 2nd block. + +TECIN5: PUSHJ P,INFSGT ;get final block. + JRST TECIN9 + MOVE A,C ;return ARPT to area. + AOS -2(P) +TECIN8: POPAE P,[C,B] + POPJ P, + +TECIN9: PUSHJ P,ERRFLS + TYPECR [Hit MPV while trying to read TECO buffer!] + JRST TECIN8 + +BVAR + ; 7 word TECO buffer block. All but T%XTRC are character addresses. + ; BEGV, PT, ZV and Z are relative and need XTRC added if .GE. GPT. +T%BEG: 0 ; start of buffer +T%BEGV: 0 ; lower buffer bound +T%PT: 0 ; pointer +T%GPT: 0 ; start of gap +T%ZV: 0 ; upper buffer bound +T%Z: 0 ; top of buffer +T%XTRC: 0 ; # of chars in gap +EVAR + +INFSGT: PUSHAE P,[A,B,C,D,E] + SUB B,A ;get cnt of chars + JUMPLE B,INFSG7 + EXCH A,B + MOVEI D,INFSG9 + MOVEM D,MPVRET + OUT(TMPC,OPEN(UC$UAR,(C))) ;open temp chan into specified area. + MOVE D,A ;move char cnt elsewhere + IDIVI B,5 ;find # wds and remainder + MOVEM B,IFSLOC + MOVEM C,IFSREM ;save + HRL B,IFSBPS(C) ;make bp + HRRZ C,B ;store RH for ref. + HRRI B,E +INFSG2: .ACCESS USRI,C ;get at wd. + HRROI A,E + TRO F,%IMPV + .IOT USRI,A ;get wd into E + TRZ F,%IMPV +INFSG3: ILDB A,B ;get char + OUT(TMPC,C((A))) + SOJLE D,INFSG7 ;stop when done + TLNE B,760000 ;P = 01 means next char is in next wd. + JRST INFSG3 + HRLI B,440700 + AOJA C,INFSG2 +INFSG7: AOS -5(P) +INFSG9: POPAE P,[E,D,C,B,A] + POPJ P, + +BVAR +IFSLOC: 0 +IFSREM: 0 +EVAR +IFSBPS: 440700 ; 0 chars in wd. + 350700 + 260700 + 170700 ; 3 chars + 100700 ; 4 + + SUBTTL File primitives + + ; Given addr in A of .CALL block, default file specs in B, + ; and command type in TC, reads a line as file spec and opens it. + ; Skips when finally successful, doesn't skip if aborted with null spec. +FILSET: PUSHAE P,[C,D] + MOVE C,A + SETO D, +FILST1: PUSHJ P,GETLIN ; get a file spec + JRST FILST9 ; flushed, nothing there. + HRRZ A,LINPUT + JUMPE A,FILST9 ; no-skip return if null spec. + MOVEI A,LINPUT + PUSHJ P,FILPAR ; B already has default filespecs. + .CALL (C) ; now try to open with given .CALL block. + CAIA + JRST FILST8 ; won, skip on return. + ;failed. Must re-try. + AOSN D ; Set flag, and if first time + PUSHJ P,ERRBEG ; then enter error mode. + HRRZ A,B ; Get address of file block as arg to + PUSHJ P,FILERR ; type out failing filespec and error message. + JRST FILST1 ; go try again. + +FILST8: AOS -2(P) ; skip on return... +FILST9: CAIL D, ; Skip if not in error mode. + PUSHJ P,ERREND ; Else terminate it. + POPAE P,[D,C] + POPJ P, + + +;given addr of 4-wd file block in a, types out fn and err-msg for +;last failed call. +FILERR: PUSHJ P,FILTYP + TYPE [ - ] + PUSHJ P,ERRDOC + OUT(TYOC,EOL) + POPJ P, + + +ERRDOC: OUT(TYOC,ERR) ;get report for last failure. + RET + +;types out fname in 4-wd blk pointed to by a. +FILTYP: FWRITE TYOC,[6F,(A),[:],6F,1(A),[;],6f,2(a),[ ],6f,3(a)] + POPJ P, + + +FILADD: PUSHAE P,[A,B] + PUSHJ P,TXFIN + out(msgc,PTV(b)) ;save current # chars + FWRITE MSGC,[TA,(A)] ; write into msg area + UARCLS (A) ;now close temp area + out(msgc,PTV(a)) ;get new cnt + sub a,b ;find how much added + MOVEM A,NCHAPP ;and save # chars appended + POPAE P,[B,A] ;win return + POPJ P, +LVAR NCHAPP: 0 ;holds # chars appended by last FILADD call + +; gets text file into area, returns area # in a. +TXFGET: PUSHJ P,FILGET ;try to get file (ptr in a to filblk) + POPJ P, ;couldn't get?? + AOSA (P) ;got it! skip on return (and skip right now) +TXFIN: PUSHJ P,FILIN + UARTYP [%ARTCH,,(A)] ;got it. convert to text area. + POPJ P, + +FILGET: .CALL TXFOPN ;open specified file (ptr in a to fil blk) + popj p, ;failed + AOS (P) ; aha, won. go slurp up. + ; drops thru... + + ; returns ARPT in A. +FILIN: SETZ A, + PUSH P,B + MOVE B,[DKIC,,FGTDEV] + .RCHST B, ;get channel status for possible later ref. + SYSCAL FILLEN,[CIMM DKIC ? CRET B ? CERR OPNERR] + JRST [ MOVE B,OPNERR ; Failed? Should only happen if + CAIE B,34 ; error = wrong type dev. + .value + MOVEI B,400 ; If no length available, use 1/4 page + JRST .+1] + ADDI B,1 ;add 1 so .IOT ptr won't count out completely + UAROPN A,[%ARTZM,,(A) ? B] + MOVN B,B ;neg + HRLZ B,B ;for .iot ptr + HRR B,$ARLOC(A) ;get addr to store it...starting addr of area +FILGT5: .IOT DKIC,B ;grab + HRRZM B,$ARWPT(A) ;set write ptr for area. + JUMPGE B,[MOVEI B,400 ; If counted completely out, + UAREXP B,(A) ; expand and get more. + HRRZ B,$ARWPT(A) + HRLI B,-400 + JRST FILGT5] + .CLOSE DKIC, + POP P,B + POPJ P, + +LVAR OPNERR: 0 +LVAR FGTDEV: BLOCK 10 ; for .RCHST channel status + +TXFOPN: SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC] + (a) ;dev + 2(A) ;fn1 + 3(a) ;fn2 + SETZ 1(a) ;sname + + +; a - addr of string +; b - [default file block],,[result file block] + +FILPAR: PUSHAE P,[A,B,C,D,E] + HRRZ E,B ;get result addr + BLT B,3(E) ;zap default values into result block + PUSHJ P,FNPARD ;parse string as filename + CAIE A, + MOVEM A,(E) ;device + CAIE B, + MOVEM B,1(E) ;dir + CAIE C, + MOVEM C,2(E) ;fn1 + CAIE D, + MOVEM D,3(E) ;fn2 + POPAE P,[E,D,C,B,A] + POPJ P, + SUBTTL Line input for commands + +BVAR +RINDSK: 0 ; -1 if input from dsk and must ignore crlf's, etc. +RINEOF: 0 ; -1 when nothing left to read. +RINLCH: -1 ; holds char to re-read if any. +EVAR + +RINIT: SETZM RINEOF + SETOM RINLCH + SETZM RINDSK + POPJ P, + +RIN: SKIPGE RINEOF ; return w/o skip if nothing left to read + POPJ P, + SKIPL A,RINLCH ;if should re-read last char (or whatever), + JRST [ SETOM RINLCH + JRST RIN2] ;use it. + HRRZ A,LINRED ;get char cnt for string + SOJL A,RIN3 ;EOF if no more + HRRM A,LINRED ;OK, store new cnt back + ILDB A,LINRED+1 ;and get char from string. +RIN2: SKIPE RINDSK + JRST [ CAIE A,^L ;DSK input? check for random things. + CAIN A,^M ;substitute "," for ^L and CR + MOVEI A,", + CAIE A,0 + CAIN A,^J ;ignore null and ^J completely. + JRST RIN + JRST .+1] + AOS (P) + CAIE A,^I + CAIN A,40 + POPJ P, + AOSA (P) +RIN3: SETOM RINEOF + POPJ P, + + +STRNAM LINRED ;string for holding line input while munching on it. +STRNAM LINPUT ;string to hold input for tty line getter +LVAR LTRMCH: 0 ;on return, holds char terminating line (-1 if aborted) + +GETLIN: PUSHAE P,[A,B,C] +GETLN0: OUT(TYOC,TC(CMTPRM(TC))) ;output prompt blurb + BCONC ;start a string +GETLN1: PUSHJ P,TTYIN + TLNE F,%SLSHC + JRST GETLN1 ;if slashifying, ignore slash and get its arg. +GETLN4: MOVE B,A + ANDI B,177 ;get 7-bit form (unquoted) + CAIN A,177 ;rubout? + JRST [ MOVE C,UCNCST+1 ;get ptr to start of string thus far + PTRDIF C,USTRAR+$ARWPT ;and compare with write ptr for it + JUMPE C,GETLN1 ;and jump if nothing was written + LDB A,USTRAR+$ARWPT ;else get last char + D7BPT A,USTRAR+$ARWPT ;and decrement write ptr + PUSHJ P,RUBN ;rub it out on terminal. + JRST GETLN1] + CAIN B,177 ;quoted rubout? + OUTCAL(TYOC,C(177)) ;must echo it because normally echo is off. + + TRNE A,%TXQTE ;^q-quote? + JRST [ SKIPN TTYERS ;if display, hack rubout of ^q + JRST [D7BPT USTRAR+$ARWPT ? JRST .+1] ;else just pop ^q off. + PUSH P,A ; save flagged char + MOVE A,B + PUSHJ P,RUBN ;rub it out (was echoed) + LDB A,USTRAR+$ARWPT ;get the ^Q + D7BPT USTRAR+$ARWPT ;and decrement ptr + PUSHJ P,RUBN ;and rub that out + POP P,A ;now restore char + OUT(TYOC,C((B))) ;and echo it again + JRST .+1] ;and continue. + + CAIN A,"? ; Wants help? + JRST [ MOVE C,UCNCST+1 ; Get ptr to start of string thus far. + PTRDIF C,USTRAR+$ARWPT ; Compare with current write ptr + JUMPN C,.+1 ; And continue if this ? isn't 1st char. + MOVEI A,(TC) + PUSHJ P,CMDHLP ; Aha. type help for command. + JRST GETLN0] + CAIN A,^D ;flush this command (line)? + JRST [ TYPE [ XXX] + SETZM LINPUT ;make string null. + SETOM LTRMCH ;and EOL char nil. + TLO F,%GOCGT ;indicate should ask for another command, + JRST GETLN9] ;and return without skipping. + CAIN A,^H ;Backspace: user is mistaken. + JRST [ CURSOR "A + TYPE [Use Rubout, not Backspace, to erase a character.] + OUT(TYOC,EOL) + JRST GTLN21] + CAIN A,^L + JRST GETLN2 ;go clear screen... + CAIN A,^R ;retype line? + JRST GTLN21 + CAIN A,^W ; Rubout word? + JRST GTLRWD + CAIN A,^U ;erase line? + JRST [ OUT(TYOC,EOL) ;start over if so. + JRST GETLN0] + CAIN A,33 + JRST [ TLO F,%GOCGT ;if ALT terminated, set flag to enter command loop. + JRST GETLN6] ;hack non-CR terminator + CAIE A,^_ + CAIN A,^C ;ditto + JRST GETLN6 + + CAIN B,^M ;cr? return if so + JRST GETLN5 + CAIN B,^J ;lf? ditto + JRST GETLN5 + + OUT(STRC,C((A))) ;store char in string + JRST GETLN1 ;go get more chars + +;Retypr all input so far. +GETLN2: ECONC LINPUT + SKIPE TTYDIS ;if printing, only retype current line. + PUSHJ P,MOSDIS ;clear and display everything but msg text. + SKIPN TTYDIS + OUTCAL(TYOC,EOL) + OUT(TYOC,TC(CMTPRM(TC))) ; Re-type prompt + OUT(TYOSC,TS(LINPUT)) ; Re-type input + BCONC LINPUT + JRST GETLN1 + +;Retype current line only. +GTLN21: PUSHJ P,GTLNDS + JRST GETLN1 + +GETLN5: SKIPA A,[^M] ; here for CR or LF. +GETLN6: MOVEM A,TYILCH ; save terminating char to force later readin. +GETLN7: MOVEM A,LTRMCH ; always save for inspection if desired. + ECONC LINPUT ; Terminate string. + MOVE A,[LINPUT,,LINRED] + BLT A,LINRED+1 ; transfer string descriptor. + +GETLN8: AOS -3(P) +GETLN9: POPAE P,[C,B,A] + POPJ P, + + ; Rubout Word +GTLRWD: SKIPE TTYERS ; If display, + PUSHJ P,RUBN1 ; Rubout the "^W" + MOVE C,UCNCST+1 ; Kludge - ptr to stat of string thus far + PTRDIF C,USTRAR+$ARWPT ; Find # chars in string + JUMPE C,GETLN1 + MOVE A,C + MOVE B,USTRAR+$ARWPT ; Set up for call + PUSHJ P,RUBWCT ; Find how many chars to erase + JUMPE B,GETLN1 +GTLRW3: LDB A,USTRAR+$ARWPT ; Loop - get last char + D7BPT USTRAR+$ARWPT ; Bump ptr down + SKIPE TTYERS ; If display, + PUSHJ P,RUBN1 ; rub char out. + SOJG B,GTLRW3 + SKIPN TTYERS ; Now, if printing, + OUTCAL(TYOC,C("_)) ; Echo a "_". + JRST GETLN1 ; Back to collection loop... + + + ; (Re-)Display line thus far +GTLNDS: ECONC LINPUT ;Save string thus far (so can't clobber and can typeout) + SKIPN TTYERS ; If can't erase line, + OUTCAL(TYOC,EOL) ; Settle for CRLF. + SKIPE TTYERS ; If CAN, then + JRST [ CURSOR "H ; proceed to do so gleefully! + OUT(DTYOC,C(8.)) ; Position cursor at left margin + CURSOR "L ; And clear line! + JRST .+1] + OUT(TYOC,TC(CMTPRM(TC))) ; Output prompt + OUT(TYOSC,TS(LINPUT)) ; and output string + BCONC LINPUT ;start collecting again with current string. + POPJ P, + +constants + SUBTTL Parse single object off recipient spec line + +STRNAM RNAM +STRNAM RHST +STRNAM JCLM ;JCL message stored here if any + + ;only used by dkic open if %rfile set +BVAR +RFDEV: 'DSK,,0 ;device +RFDIR: 0 ;directory +RFFN1: 0 ;fn1 +RFFN2: SIXBIT />/ ;fn2 +EVAR + +; getobj - Uses RIN as input source and skips if +;it successfully finds an object in input stream. no skip +;means input terminated before an object was found. +;General syntax is: +; <..>[<..><@ or %><..>]<..> +;where <..> is any number (including 0) of spaces or tabs, and +; is end of input, comma, or (if input is a +; jcl line), + +;types of objects are: +; 1) name returns rlen,rnpt; sets %rnam +; 2) host returns rhlen,rhpt;sets %rhst +; 3) name&host returns all of above +; 4) file returns rlen,rnpt; sets %rfile +; 5) other nothing yet + +GETOBJ: PUSH P,A ;don't mung a until get to %badbl test! + PUSH P,B + TLNE F,%HADCM ; If we've seen an explicit command, + TRZ F,%BUGNM ; make sure bugname crock turned off. + TRZ F,%RALLT ;clear all flags that might be set later + SETZM RNAM + SETZM RHST ;zap strings + BCONC ;begin a string + + ;flush blanks to get 1st text char of obj. +GTOBJ1: PUSHJ P,RIN ;get char + JRST GTOLOS ;none left? lose, no skip + JRST GTOBJ1 ;flush blank/tab + + ;ah! test first char for special meaning +GTOBJ2: CAIN A,"( ;start of structured recipient list? + JRST GTOLST ;yup + CAIN A,"" ;start of literal string? + JRST GTOSTR + CAIE A,"[ ;start of recipient-filename string? + CAIN A,"{ + JRST GTOFIL + + ;no special meaning, enter loop to collect text +GTOBJ3: +; CAIE A,"% + CAIN A,"@ ;start of a host spec? + JRST [TRNN F,%BUGNM ;off to collect host text. + JRST GTOBH ;(if not collecting bug pgm name) + JRST .+1] + CAIN A,", ;comma? + JRST [ ECONC RNAM ;hurray, end of name text and object! + JRST GTOWIN] + TRO F,%RNAM ;oh well. make sure name flag set. + OUT(STRC,C((A))) ;store char + PUSHJ P,RIN ;get another + JRST [ ECONC RNAM + JRST GTOWIN] ;end of input! + JRST GTOBJ6 ;hmm, blank/tab. must check further + JRST GTOBJ3 ;normal char, go stuff in or stop + + ;blank/tab terminated name spec.; illegal unless + ;next non-blank is terminator or start of a host spec. +GTOBJ6: ECONC RNAM ;save string +GTOBJ7: PUSHJ P,RIN ;get another char. + JRST GTOWIN ;ah, terminates...legal win. + JRST GTOBJ7 ;another blank, flush + + ;non-blank char found, test to see if it makes things legal + CAIN A,", ;comma? + JRST GTOWIN ;yep, terminated, win. + TRNE F,%BUGNM ;also check + JRST GTOBAD ;so that space halts a pgm-name. + TRNE F,%RALLT#<%RNAM+%RNLIT> ;about to test @/%; skip if a name spec. + JRST GTOBAD ;no - illegal to add host spec to anything but name spec. + TRNE F,%RHST ;also stop if + JRST GTOBAD ;already gobbled a host spec. +; CAIE A,"% + CAIN A,"@ ;ah, name spec; is legal to add host spec. + JRST GTOBH ;and one exists! + CAIE A,"A ; Not % or @, but check for "at". + CAIN A,"a + CAIA ; Aha, starts with "A". Worth checking farther. + JRST GTOBAD ; Nope, give up on him. + PUSHAE P,[A,RINEOF,LINRED,LINRED+1] ; Save input state + PUSHJ P,RIN + JRST GTOBJ9 ; Ugh if EOF + JRST GTOBJ9 ; Also ugh if space + CAIE A,"T + CAIN A,"t ; AT? + CAIA ; Yes, go check for space... + JRST GTOBJ9 ; Nice try. + PUSHJ P,RIN + JRST GTOBJ9 + CAIA ; If space, found " at "! Skip. + JRST GTOBJ9 ; Nope, restore. + ; Found " at " after name, do some checking... + SKIPN TIXTAB+%TIJCL ; Try to see if hacking JCL... + JRST GTOBJ8 ; no, safe to assume "@". + SKIPN RINDSK ; REALLY from JCL? + TLNE F,%HADCM ; and no command given yet? + JRST GTOBJ8 ; No to one of above, not JCL - safe. + ; " at " seen in JCL, must make sure not part of msg. + PUSHJ P,ERRBEG + ECONC RNAM + FWRITE TYOC,[[Ambiguity; does "],TS,RNAM,[ AT ..." +mean "],TS,RNAM,[@..."?]] + TLO F,%NOECH ; Suppress echo for next char + PUSHJ P,TTYINU ; Get answer + BCONC RNAM ; Before branching off, restore stuff. + CAIE A,^M + CAIN A,"Y + JRST [TYPECR [Yes] ; Yes, process as "@". + PUSHJ P,ERROK + JRST GTOBJ8] + TYPECR [No - "AT" taken as msg text.] + PUSHJ P,ERROK + JRST GTOBJ9 + +GTOBJ8: SUB P,[4,,4] ; Hurray, found " at "! Forget about restoring state + JRST GTOBH ; And go hack hostname. +GTOBJ9: POPAE P,[LINRED+1,LINRED,RINEOF,A] + + ; Drop thru to GTOBAD. User has blundered syntactically, + ; unless this is jcl input, in which case we've found start of msg. +GTOBAD: SKIPE TIXTAB+%TIJCL ;if input is from JCL, + JRST [ SKIPN RINDSK ; REALLY from JCL... + TLNE F,%HADCM ;and no command has been given yet, skip! + JRST .+1 ;else can't be JCL message. + MOVEM A,RINLCH ;store char so it's first read by next RIN. + JRST GTOBM] ;it's the message! go copy rest and win. + OUT(STRC,("/ ")) ; Hmm, assume loser wants space in name! + JRST GTOBJ3 ; Use previously read char to continue... + +GTOWIN: TRNE F,%BUGNM ;skip hack unless bug/feature crock on + JRST [ TRZ F,%RALLT ;if so, make it a name, period. + TRO F,%RNAM + JRST .+1] ;this is so stuff like "@"->"bug-@" wins. + AOS -2(P) +GTOLOS: POPAE P,[B,A] ;Losing return pt. + POPJ P, + + + ;here when jcl input and message found. +GTOBM: TLO F,%JCLM ;set flag + BCONC + CAIA +GTOBM1: OUTCAL(STRC,C((A))) + PUSHJ P,RIN + JRST [ ECONC JCLM + JRST GTOWIN] + JRST GTOBM1 ;loop all the way to end. + JRST GTOBM1 ;(rin returns to 3 places) + + + ;here when start of host spec is detected (ie, one of @ or %) +GTOBH: TRO F,%RHST ;set flag to indicate existence of host spec + MOVEM A,RHCHR' ;save for possible typeout + ECONC RNAM ;save name string + BCONC ;and begin host string. +GTOBH1: PUSHJ P,RIN ;get char--must flush blanks. + JRST GTOBH4 ;terminated, win though nothing in spec. (getrs will catch) + JRST GTOBH1 ;blank/tab, flush. + + ;start collecting +GTOBH2: CAIN A,", ;terminate successfully on comma + JRST GTOBH4 + OUT(STRC,C((A))) + PUSHJ P,RIN + JRST GTOBH4 ;terminated, won. + JRST [ ECONC RHST ;found blank/tab, go do standard checking. + JRST GTOBJ7] + JRST GTOBH2 ;normal char,check + store +GTOBH4: ECONC RHST ;save host string + JRST GTOWIN + + ;here when start of name spec is [ or {. + ;means everything up to matching right-bkt is taken + ;like literal, + ;but includes brckets which mean recipient-filename. + +GTOFIL: TRO F,%RNLIT+%RNAM + OUT(STRC,C((A))) ;save the left bracket + CAIN A,"[ + MOVEI B,"] ;gobble up to right bracket. + CAIN A,"{ + MOVEI B,"} ; Search for right style bracket. + PUSHJ P,GTOLIT + JRST GTOFL7 ;unterminated, lose. + OUT(STRC,C((B))) + JRST GTOBJ6 ;save string & look for comma. + +GTOFL7: ECONC RNAM + PUSHJ P,ERRBEG + TYPE [Recipient file spec doesn't terminate =>] + OUT(TYOC,TS(RNAM)) + PUSHJ P,ERREND + JRST GTOLOS + + ;here when start of name spec is quote mark (")-- + ;means everything up to next quote is a literal string. + +GTOSTR: TRO F,%RNLIT+%RNAM ;set appropriate flags + MOVEI B,"" ;gobble up to next quotemark + PUSHJ P,GTOLIT + JRST GTOST7 ;unterminated. + JRST GTOBJ6 ;aha, ended. store & check comma etc + +GTOST7: ECONC RNAM + PUSHJ P,ERRBEG + TYPE [Literal doesn't terminate=>] + OUT(TYOC,C(""),TS(RNAM)) ;type a quotemark + ;and follow with string thus far. + PUSHJ P,ERREND + JRST GTOLOS + + + ; Here when rcpt is a structured list. (begins with "(" ) + ; Routine here is VERY simple and will not even begin to + ; handle the hairier cases. +GTOLST: TRO F,%RNLIT+%RNAM + MOVEI B,1 ; Begin nesting count. +GTOL1: OUT(STRC,C((A))) + PUSHJ P,RIN + JRST GTOL7 ; Lost, no more chars + JFCL + CAIN A,"( + AOJA B,GTOL1 ; One more level + CAIE A,") + JRST GTOL1 + SOJG B,GTOL1 ; One less level, fall thru when 0 + OUT(STRC,C((A))) + JRST GTOBJ6 ; Win! + +GTOL7: ECONC RNAM + PUSHJ P,ERRBEG + TYPE [Rcpt List spec doesn't terminate=>] + OUT(TYOC,TS(RNAM)) + PUSHJ P,ERREND + JRST GTOLOS + + ;subroutine to gobble chars until terminating char found. + ;skips unless hit EOF before finding char. +GTOLIT: PUSHJ P,RIN + POPJ P, ;input terminated, non-skip return. + JFCL + CAIN A,(B) ;matches specified terminator? + JRST POPJ1 ;yes, win. + OUT(STRC,C((A))) ;not yet, store. + JRST GTOLIT + + + + ;type out everything in analyzing buffer, as part of err msg. +OBTYPE: PUSH P,A + PUSH P,B + TRNE F,%RNLIT ;is name spec a literal? + OUTCAL(TYOC,C("")) + TRNE F,%RFILE ;is name spec a file? + OUTCAL(TYOC,LPAR) + OUT(TYOC,TS(RNAM)) + TRNE F,%RNLIT ;add appropriate close if any + OUTCAL(TYOC,C("")) + TRNE F,%RFILE + OUTCAL(TYOC,RPAR) + TRNE F,%RHST ;now do host spec if any + JRST [ OUT(TYOC,C(@RHCHR),TS(RHST)) + JRST .+1] + POP P,B + POP P,A + POPJ P, + +OBTYCR: PUSHJ P,OBTYPE + OUT(TYOC,EOL) + POPJ P, + SUBTTL Recipient handling commands, recipient parser + + ; "To:" spec (Variants like CC and Un-to also come here) +COMT: PUSHJ P,GETLIN + POPJ P, + TRZ F,%AZGOT+%AZERR ;clear flags getrs returns + PUSHJ P,RINIT ;set up RIN routine. + PUSHJ P,GETRS ;munch the line. + TRNE F,%AZERR ;error happened? If so, + JRST COMT ;try again under aegis of same command. + POPJ P, ; No error, return. + + +; GETRS - takes input from RIN and hacks recipient specifications. +;Function affected by command in question (as indicated by TC) + +LVAR RHSTIC: 0 ;"sticky" host spec..given to names w/no host spec + +GETRS: TRZ F,%AZGOT+%AZERR ;zero flags + SETOM RHSTIC ;reset sticky host + PUSHAE P,[A,B,C,D,E] + SETZM JCLM ;clear JCL message string + +GETRS0: SKIPE JCLM ;jcl message from last pass? + JRST GTRM ;yes, go mung it and return. +GTRMR: PUSHJ P,GETOBJ ;get an object. + JRST GETRSF ;all gone, all done. + + ;vector out to appropriate routine + TRNN F,%RALLT ;anything there? + JRST GETRS0 ;nothing! + MOVE A,[RNAM,,RCPNAM] + BLT A,RCPNAM+1 ;copy string descriptor. + TRNE F,%RHST + JRST [ MOVE A,[RHST,,RHSTR] + BLT A,RHSTR+1 ;ditto for host spec + MOVE A,RHCHR + MOVEM C,GTHCHR' + JRST .+1] + TRNE F,%RFILE + JRST GTRF ;go process file spec + TRNE F,%RNAM + JRST GTRN ;process name (may have host spec) + TRNE F,%RHST + JRST GTRH ;go process sticky host spec(no name) + JSR AUTPSY + +GETRSF: POPAE P,[E,D,C,B,A] + POPJ P, + + ;process jcl message line. +GTRM: HRRZ D,JCLM ;get cnt of string + JUMPLE D,GETRSF ;return if nothing there. + TRNN F,%MSGJ ;hacking qmsg or msg? + JRST [ OUT(MSGC,TS(JCLM)) ;no, insert into msg area. + MOVE A,LTRMCH ;get line terminating char + CAIN A,^M ;if it was CR, then + OUTCAL(MSGC,EOL) ;add a CRLF, else leave as is. + JRST GETRSF] + MOVE A,[JCLM,,SUBJEC] ;MSG-style. Copy into SUBJEC string. + BLT A,SUBJEC+1 + JRST GETRSF + +GTRN: HRRZ A,RCPNAM ;get length of name string + JUMPE A,GETRS0 ;ignore null specs. + MOVE R,RCPNUM ;get index to free table slot + CAML R,TRSIZE ;compare w/max # slots + PUSHJ P,RTEXP ;if index too high, expand tables to win. + MOVEI A,-1 + MOVEM A,@TRCPF ;clear flag but make word non-zero + SETZM @TRCPN ;might as well clear this too. + SETOM @TRCPH ;.. + CAIN TC,%CTU ;deleting? + JRST GTRN1 ;skip all the munging fuss + CAIN TC,%CTC ;cc adding? + JRST [ MOVSI A,R%CC + IORM A,@TRCPF ;set flag for CC + JRST .+1] + + TRZE F,%BUGNM ;hacking :bug or :featur name? + JRST [ MAKSTR RCPNAM,[[BUG-],TS,RCPNAM] + JRST GTRN1] + TRNE F,%MSGJ ;hacking msgs? If so, see if JCL rcpt is really FN1. + JRST [ SKIPN TIXTAB+%TIJCL ;if gobbling JCL, + JRST .+1 + SKIPE MSGFN1 ;see if already have FN1 for MSG + JRST .+1 ;don't mung if we do + TRNE F,%RHST ;nor if name has a host spec. + JRST [ MOVE A,[SIXBIT /MSG/] + MOVEM A,MSGFN1 + JRST GTRN1] + MOVEI A,RCPNAM + PUSHJ P,CVTS6F ;else convert name and store as FN1. + MOVEM A,MSGFN1 + JRST GETRS0] + + TRNE F,%RHST ;if host was specified, end of special checks. + JRST GTRN1 + MOVE B,RCPNAM+1 ;else check for "*" thingies... get bp + ILDB A,B ;get 1st char + CAIE A,"* ;is it...? + JRST [ ;nope + IRPC CH,,BBOARD + TRZ A,40 + CAIE A,"CH + JRST GTRN1 ;not BBOARD either + ILDB A,B + TERMIN + JRST .+1 ] + ;here, have MSG distribution name. + SETOM RHSTIC ;no stickiness for MSG distrib names! + MOVSI A,R%MSG + IORM A,@TRCPF ;set flag for MSG destination. + HRRZ A,RCPNAM ;get char cnt + CAIN A,1 ; one char? + PUSHJ P,ASTRSK ;go put "*" in RCPNAM + + ; nice normal name.... +GTRN1: MOVEI A,RCPNAM + PUSHJ P,SRCPN ;stuff rcpt name string into table slot idx'd by R + + ;now see about site to send to. + TRNE F,%RHST ;was host specified? + JRST GTRH ;yes, go figure it out. + SKIPGE A,RHSTIC ;none specified, hence use sticky host. + MOVE A,OWNHST ;furnish own host if rhstic=-1 + JRST GTRH2 ;sneak into gtrh. + + ; put "*" in RCPNAM +ASTRSK: .CALL [SETZ ? 'SSTATU + REPEAT 5, 2000,,JUNK + SETZM MACHNM] ;get local 6bit name (AI,ML...) + JSR AUTPSY + MAKSTR RCPNAM,[[*],6F,MACHNM] + POPJ P, + +LVAR MACHNM: 0 ;for ASTRSK, holds 6bit machine name. + +GTRH: HRRZ C,RHSTR ;get # chars in host spec + CAIG C, + JRST [ PUSHJ P,ERRBEG + TYPE [Null host spec: ] + SETOM RHSTIC ;reset sticky host whenever error happens + PUSHJ P,OBTYCR ;type out what there is of object + PUSHJ P,ERREND + JRST GETRS0] ;go get another object + + CAIN TC,%CTU ;if deleting, + JRST [ HRRZ B,RHSTR ;then check for "@*". + CAIE B,1 ;length = 1? + JRST .+1 + MOVE B,RHSTR+1 ;get bp + ILDB B,B + CAIE B,"* + JRST .+1 + SETO A, ;is *, indicate thusly and skip hostname search. + JRST GTRH2] + MOVEI A,RHSTR + PUSHJ P,IPNUM8 ;convert string if possible (base 8 unless periodified) + CAIA ;couldn't, try interpreting as name string + JRST [PUSHJ P,GHFLAG ;see if exists in table + JRST [SETO A, ? JRST GTRH9] ;nope + JRST GTRH15] ;ah, it's there. + MOVEI A,RHSTR ;addr to host string is arg for + PUSHJ P,HANLYZ ;magic host name grinder! + JRST GTRH9 ;error, couldn't find! +GTRH15: TLNN B,NETWRK"STFSRV ;skip if status is server + JRST GTRH10 ;hmmm, not a server. ask if sure. +GTRH17: TRNN F,%RNAM+%RNLIT ;skip if name specified + JRST [ MOVEM A,RHSTIC + JRST GETRS0] ;ah, sticky spec. do it and that's all. + SETOM RHSTIC ;anything else resets the sticky host. + +GTRH2: MOVEM A,@TRCPH ;store host # (gtrn enters here if %rhst=0) + CAIN TC,%CTU ;deleting? + JRST GTRH3 ;yes. go delete. + PUSHJ P,GTRXM ;no. find a match for this new rcp. + SKIPA ;no match? + JUMPGE A,[ ;found exact match. + PUSH P,R + MOVE B,@TRCPF ; Get new flags + MOVE R,A + HLLM B,@TRCPF ; Store in existing instance of rcpt, + POP P,R ; which serves to set CC-ness right... + JRST GETRS0] + AOS RCPNUM ;to 1st now-free loc, and officially enter rcp with aos! + MOVE A,@TRCPF ;want to see if just stored a *MSG + TLNE A,R%MSG + JRST [ AOS MDSNUM ;for MSG distribution site name. + TRO F,%MSG + JRST .+1] + TRO F,%AZGOT + JRST GETRS0 ;loop back for more. + + +GTRH9: PUSHJ P,ERRBEG + CAMN A,[-1] + JRST [ TYPE [No such site known: "] + FWRITE TYOC,[TS,RHSTR,[" +]] + PUSHJ P,ERREND + JRST GETRS0] + CAMN A,[-2] + JRST [ TYPE [I don't know how to mail to the non-Arpanet site: "] + FWRITE TYOC,[TS,RHSTR,[" +]] + PUSHJ P,ERREND + JRST GETRS0] + HLRZ B,A ; Addr of 1st NAMES entry + MOVEI C,(A) ; addr of last + SUBI C,(B) ; Find # of ambiguous names + CAIG C,1 ; If only 2 names, (THIS DEPENDS ON ENTRYLENGTH = 1!) + SKIPA C,[ASCNT [,]] ; then separator is simple comma. + MOVE C,[ASCNT [,...,]] ; else imply lots. (could use #??) + MOVE B,NETWRK"NMRNAM(B) ; Get addr in file of ASCIZ name string + ADD B,NETWRK"HSTADR ; Make abs + MOVE A,NETWRK"NMRNAM(A) ; addr in file of last entry's name string + ADD A,NETWRK"HSTADR ; abs + FWRITE TYOC,[[Ambiguous site spec. "],TS,RHSTR,["=>{],TZ,(B),TC,C,TZ,(A),[} +]] + PUSHJ P,ERREND + JRST GETRS0 + +;here, site exists but is not a server. +GTRH10: CAIN TC,%CTU ;are we deleting instead of adding? + JRST GTRH17 ;yes, no need for warning. + PUSHJ P,ERRBEG + FWRITE TYOC,[[Warning! This is not a server site: ],TS,RCPNAM,[ @ ],HST,A,[ +Are you SURE you want to send there? ]] + MOVE B,A ;save site # + PUSHJ P,TTYINU + CAIE A,"Y + JRST [ TYPECR [ Flushing.] + PUSHJ P,ERREND + JRST GETRS0] + TYPECR [ Very well...] + PUSHJ P,ERROK ; Not really an error... + MOVE A,B ;restore flags,,site # + JRST GTRH17 ;continue + + ;here, delete specified rcp or rcpts. +GTRH3: PUSHJ P,GTRXM ;zap first one + CAIA + JRST GTRH30 + PUSHJ P,ERRBEG + JUMPE A,[TYPE [Entry doesn't exist: ] + JRST GTRH29] + TYPE [Entry ambiguous: ] +GTRH29: PUSHJ P,RCTYPE + OUT(TYOC,EOL) + PUSHJ P,ERREND + JRST GETRS0 + +GTRH30: TYPE [Deleted: ] +GTRH31: MOVE R,A + PUSHJ P,RCTYPE ;type out deceased + move c,@TRCPF + TLNE C,R%MSG + SOS MDSNUM + SETZM @TRCPF ;flush the matched slot + SETZM @TRCPN + SETZM @TRCPH + PUSHJ P,GTRXM ;get another + JRST GTRH32 ;when no match, don't scream; we got one already + CAIL R,0 ; If previous match was exact, + JUMPL A,GTRH32 ; then partial matches don't count. + OUT(TYOC,C(",)) ;separate + JRST GTRH31 ;when another match, go zap it. + + ;gc the tables. +GTRH32: TRZ F,%MSG + SKIPLE MDSNUM + TRO F,%MSG ;update %MSG flag as necessary + OUT(TYOC,EOL) ;terminate info + MOVN R,RCPNUM + HRLZ R,R ;R=index to test (aobjn) + PUSH P,E + SETZ E, ;e=index to store at +GTRH4: SKIPN B,@TRCPF ;get flags and ignore if nothing there + JRST GTRH6 + MOVE A,@TRCPN ;something there. get rel ascnt ptr also + PUSH P,@TRCPH ;and get host + EXCH R,E ;use new index + MOVEM A,@TRCPN ;store in new place + MOVEM B,@TRCPF + POP P,@TRCPH + EXCH R,E ;restore aobjn'ing index. + ADDI E,1 ;bump up new index +GTRH6: AOBJN R,GTRH4 ;loop thru all slots + MOVEM E,RCPNUM ;when done, E is new count of entries + POP P,E + JRST GETRS0 ;ah! now, back for another object! + +; gtrxm - takes rcpnum as index of object to match up. skips if +;finds match, leaves index in A; doesn't skip if fails. returns: +; no skip(fail): +; A=> 0 means no match at all +; A=> # means ambiguous, this # is one possibility. +; skip (win): +; A=> # means won exactly +; A=> -1,,# means match is partial, ie existing entry is longer, +; but no ambiguities. +; Note that (sigh) # can be 0. + +.SCALAR RPMSAV + +GTRXM: PUSHAE P,[B,C,R] + SETZM RPMSAV ; Zap saved partial-match index + SKIPN R,RCPNUM ;get index of template entry + JRST GTRXM7 ;nothing to match? + MOVE B,@TRCPN + ADD B,TRSTTB ;abs ascnt ptr + hrli b,440700 + MOVEM B,RMATPT' ;save entry (byte ptr) + MOVE A,@TRCPN + HLREM A,RMATCT' ;save its char cnt + MOVE A,@TRCPH ;and get host # for later storage + CAIN TC,%CTU ;if deleting, must check "*" hack. + JRST [ HLRZ C,@TRCPN + CAIE C,1 ;ah, first check length + JRST .+1 ;nope + ILDB C,B ;one-char. get it... + CAIE C,"* ;well, is it? + JRST .+1 ;nope + SETOM RMATCT + TRNN F,%RHST ;yes, was a host specified? + SETO A, ;if not, make host '*' also. + JRST .+1] + MOVEM A,RMATH' ;store its host # + MOVN R,R + HRLZ R,R ;form aobjn thru whole table + +GTRXM1: SKIPN A,@TRCPF ;anything in this slot? + JRST GTRXM3 ;no, nothing. + MOVE A,@TRCPH ;ah. get its host # + SKIPL RMATH ;skip if we match to any # + CAMN A,RMATH ;test. don't skip if matches. + SKIPA ;if here, match! try char count. + JRST GTRXM3 ;if here, hosts don't match. try another slot + + SKIPGE RMATCT ;do we care about count? + JRST [ MOVEI A,(R) ;no, we match to any name. go and win. + JRST GTRXM8] + + ;now try to match name strings; b=template ptr, c=tmplt cnt, + ;d=suspect ptr, e=suspect cnt. + + PUSH P,R + PUSH P,E + MOVE B,RMATPT ;get template ptr + MOVE C,RMATCT ;template count + HLRZ E,@TRCPN ;suspect count + MOVE D,@TRCPN ;suspect ptr + ADD D,TRSTTB + hrli d,440700 + PUSHJ P,NHMLTX ;see if host is a multics, i.e. case distinction imp't. + CAIA ;no, match with uppercase force. + JRST [PUSHJ P,SMATCL ;blah, yes.. match exactly. + JRST .+2 + JRST .+3] + PUSHJ P,SMATCH ;pow! test them. skips if perfect match. + SKIPA ;failed, a: 0=no match, 1=d counted out, -1=b counted out. + JRST [POPAE P,[E,R] + MOVEI A,(R) + JRST GTRXM8] ;go win. + POPAE P,[E,R] ;fail. restore and try one last hunch. + JUMPGE A,GTRXM3 ;if no match or d counted out, lose. but if + ;b counted out, we can partially win if nothing else matches at all. + SKIPE RPMSAV ; Already a partial match? + JRST [ HRRZM R,RPMSAV ; Yes, indicate ambiguous. + JRST GTRXM3] ; and continue search. + HRROM R,RPMSAV ; No, store index indicating unique so far. + +GTRXM3: AOBJN R,GTRXM1 ;whole thing loops here. + +GTRXM7: SKIPGE A,RPMSAV ; See if any partial matches were found. +GTRXM8: AOS -3(P) + POPAE P,[R,C,B] + POPJ P, + + +;smatch - takes b= byte ptr, c= cnt for b, +; d= byte ptr, e= cnt for d, and returns matching result in a: +;skips if perfect match +;doesn't skip if not perfect match, +; a= 0 no match at all +; a= 1 d counted out +; a=-1 b counted out + +SMATCL: SETZM SMUPSW' ;set switch for no uppercase force + CAIA +SMATCH: SETOM SMUPSW ;set switch to use uppercase force + PUSHAE P,[B,C,D,E] +SMACH1: SOJL C,[JUMPE E,SMACHW ;won if both count out at same time + SETO A, ;b counted out. + JRST SMACHL] + SOJL E,[MOVEI A,1 ;d counted out. + JRST SMACHL] + ILDB A,B ;get chr from b + MOVEM A,SMTSAV' ;put in comparison store(not enuf accs) + ILDB A,D ;get chr from d + CAMN A,SMTSAV ;compare + JRST SMACH1 ;match, keep looping. + SKIPN SMUPSW ;skip if forcing to uppercase + JRST SMACH3 ;else lose completely + CAIL A,"a + CAILE A,"z + CAIA + SUBI A,40 ;force to upper + EXCH A,SMTSAV + CAIL A,"a + CAILE A,"z + CAIA + SUBI A,40 + CAMN A,SMTSAV + JRST SMACH1 ;aha, they match now! + +SMACH3: TDCA A,A ;lose. zero A and skip +SMACHW: AOS -4(P) ;won +SMACHL: POPAE P,[E,D,C,B] ;lost. + POPJ P, + +DKICH: SETZ ? SIXBIT /OPEN/ ? [0,,DKIC] ? DKIDEV ;char input + DKIFN1 ? DKIFN2 ? SETZ DKIDIR + +STRNAM TMPGFS ;temp string to hold file spec + +GTRF: MOVE A,[RNAM,,TMPGFS] + BLT A,TMPGFS+1 ;copy descriptor + MOVEI A,TMPGFS + MOVE B,[RFDEV,,DKIDEV] + PUSHJ P,FILPAR ;parse filename + SOSGE IOPCNT ;see if iopdl slot still open. + JRST [ PUSHJ P,ERRFLS + TYPECR [File distribution lists nested too deep!] + JRST GETRS0] + .IOPUSH DKIC, ;push current dkic channel + MOVEI A,DKIDEV ;point to filblk for call etc. + .CALL TXFOPN ;open again for new file (char mode) + JRST [ PUSHJ P,ERRFLS + PUSHJ P,FILERR ;open failed. find why and report. + TRO F,%AZERR + JRST GETRS0] + PUSHJ P,TXFIN ;pull in the text + + PUSHAE P,[RINEOF,RINLCH,RINDSK,RHSTIC] + SETOM RINLCH + SETZM RINEOF + SETOM RINDSK ;indicate CRLF's should be flushed. + SETOM RHSTIC + PUSHAE SP,[LINRED,LINRED+1] + MAKSTR LINRED,[TA,(A)] ;make string out of input text! + UARCLS (A) + + MOVE A,F ;get flags + ANDI A,%AZGOT+%AZERR + PUSH P,A ;these flags are to be iored in afterwards + MOVE A,F ;get flags again + ANDI A,%RALLT ;these flags are to be jammed in afterwards + PUSH P,A + + PUSHJ P,GETRS ;recurse! (or recurve?) + + .IOPOP DKIC, + AOS IOPCNT ;indicate one more slot free + POP P,A ;get jam-in flag values. + ANDCMI F,%RALLT ;clobber existing bits + IOR F,A ;push bit values in. + POP P,A ;get ior-in flag values + IOR F,A ;or them in. + + POPAE SP,[LINRED+1,LINRED] + POPAE P,[RHSTIC,RINDSK,RINLCH,RINEOF] + JRST GETRS0 + +LVAR IOPCNT: 7 ; IO channel PDL count. + SUBTTL Main text collection loop + +MSGGET: TRNE F,%MSG ;hacking *-msg? + TLZ F,%JCLM ;if so, prevent "Msg:" suppress. + TLNN F,%JCLM ;are we handling JCL message or was one inserted? + JRST MSGT10 ; Nope, skip over special case cruft. + TLNE F,%HADCM ; yes, was command given in the JCL? + JRST [ TLZ F,%JCLM ; Command was given, clear flag. + JRST MSGT10] + SKIPE TIXTAB+%TIJCL ;no command within JCL, but text existed, so SKIP header + SKIPN T.DCNT ;and clear flag unless still have JCL to read. + TLZ F,%JCLM + JRST MSGGT1 ; and bypass "Msg:" etc. prompt. + + ; Do a "Msg:" or "Continue msg:" prompt. +MSGT10: SKIPN T.DCNT ; See if current input source has dried up... + SKIPL TYILCH ; i.e. if counted out and no remaining char... + CAIA + PUSHJ P,POPINP ; then pop input now to make sure header will come out. + TRNN F,%MSG ;in MSG? + JRST MSGT15 ; Nope, skip random info. + + ; Ensure *-MSG's required info exists. + SKIPN TIXTAB+%TITTY + JRST MSGT15 ;skip if not using TTY. + TLZ F,%JCLM ;prevent "Msg:" suppress. + SETO TC, + SKIPN EXPTIM ; Have expiration date? + MOVEI TC,%CTX ; If not, set up to get it. + HRRZ B,SUBJEC ; Have subject? + CAIG B,0 + MOVEI TC,%CTS + SKIPN MSGFN1 ; Have FN1 for .MSGS. file? + MOVEI TC,%CT1 + JUMPGE TC,COMXCT ; If anything missing, go get it. + +MSGT15: TLZE F,%TYPAH ; Was there typeahead? (Flag cleared here) + JRST [ OUT(TYOC,PTV(A)) ; Yes, have we output anything since pgm started? + JUMPE A,MSGT30 ; Jump directly into loop if haven't. + JRST .+1] ; Else we have, and cursor has been moved. Do usual. + OUT(MSGC,PTV(A)) ; Find # chars in buffer thus far. + TRZE F,%DSALL ; Flag set requesting complete display? + JRST [ PUSHJ P,ALLDIS ; If so, do it and go directly to text collect. + JRST MSGT20] + JUMPLE A,[PUSHJ P,MSGDIS ; If nothing in buffer, just say "Msg:" + JRST MSGT20] + PUSHJ P,MSGHED ;yes, say 'continue' & retype last line +MSGT20: JUMPG A,MSGGT1 ; Now if something was in buffer, go into collect loop +MSGT21: TRZ F,%RQUOT ; Else enter check for first char. + PUSHJ P,TTYIN ; Get it... + CAIE A,"? ; If not a simple "?", + JRST MSGT31 ; then nothing special, enter main loop. + TYPE [ Enter message text, terminated by a ^C to send +the message. The following special characters exist: +^L to retype entire message. +^R to retype current line, +^U to delete it. +RUBOUT to delete last char. +^W to delete last word. + for command escape. ? gives more help. +Msg: +] + JRST MSGT21 ; Back into first-char loop... + +MSGT30: +MSGGT1: TRZ F,%RQUOT ;clear special ^q-rubout flag + PUSHJ P,TTYIN +MSGT31: TLNE F,%SLSHC + JRST .-2 ;if slashifying, ignore and go get cvtd char + MOVE B,A ;in case of tv chars + ANDI B,177 ;b will have '7-bit' unquoted char. + CAIN B,177 ;see if quoted rubout + JRST [ TRNE A,%TXQTE+%TXTOP ;if quoted by whatever means + OUTCAL(TYOC,C(177)) ;then echo it. + JRST .+1] + TRNE A,%TXQTE ;^q-quoted? + JRST [ TRO F,%RQUOT ;indicate special rubouting + EXCH A,B + SKIPE TTYERS + PUSHJ P,RUBN1 ;do display rubout of quoted char + EXCH A,B + PUSHJ P,RUBM ;flush the ^q from buffer (and rub out if can) + SKIPE TTYERS + OUTCAL(TYOC,C((B))) ;echo quoted char again + JRST .+1] + CAIN A,^L + JRST [PUSHJ P,ALLDIS ? JRST MSGGT1] + +MSGGT2: CAIE A,^C ;can quote this! + CAIN A,^_ ;ditto + JRST [SETZ A, ; Send, normally. + TLNE F,%NEWMD ; In "use-new-mailer" mode? + MOVEI A,1 ; Yes, use New mode! + MOVEM A,SNDVRS ; Set mode + JRST MSGSND] ; and go send message. + + CAIN A,177 ;rubout? + JRST [ PUSHJ P,RUBM + JRST MSGGT1] + CAIN A,^W ; Rubout word? + JRST MSGT60 + CAIN A,177+%TXMTA ; Meta-rubout? + JRST MSGT62 ; Yes, also rubout word. + CAIN A,^H + JRST [ CURSOR "A + TYPE [Use Rubout, not Backspace, to erase a character.] + OUT(TYOC,EOL) + PUSHJ P,FNDOLN ;If line is empty, that's all. + JUMPE B,MSGGT1 + PUSHJ P,PLNTYR ;Otherwise, retype it. + JRST MSGGT1] + CAIN A,^R ;retype line? + JRST [ PUSHJ P,PLNTYR + JRST MSGGT1] + CAIN A,^U ;delete line? + JRST MSGGT4 + + CAIN A,^D ;abort text collection? + JRST [ TYPE [ XXX] + JRST COMGET] + CAIN A,33 ;esc? (can quote this) + JRST COMGET ;go get command. + CAIN A,^J ;Turn unquoted LF into CR. + JRST [ CURSOR "H + OUT(DTYOC,C(8.)) + MOVEI A,^M + MOVEI B,^M + JRST .+1] + out(msgc,C((a))) ;finally deposit in text area + CAIE B,^M + JRST MSGGT1 + out(msgc,C(^J)) ;add LF if CR seen. + JRST MSGGT1 + +MSGGT4: PUSHJ P,FNDPLN ;find start of this line or previous + ;following 3 lines are ill-advised munging of the ARBLK, + ;but kludge is certainly fast. + MOVEM A,MSGAR+$ARWPT ;store returned ptr as write ptr... line is zapped. + MOVNS B ;negate count of chars backed up over. + ADDM B,$ARCHL+MSGAR ;and update cnt of chars left in area!! + SKIPN TTYERS + JRST [ TYPECR [_] ;if hardcopy, simply echo "_". + JRST MSGGT1] + CURSOR "H + OUT(DTYOC,C(8.)) ;position cursor at beg of line +MSGGT5: CURSOR "L ;and erase line + SOJL C,MSGGT1 + CURSOR "U ;and move up for each LF being erased. + JRST MSGGT5 + + ; Rubout word. +MSGT60: SKIPN TTYERS ; Display? + JRST MSGT62 ; No, skip rubout of ^W. + PUSHJ P,RUBN1 ; Rub out the "^W" or whatever. + SKIPE TTYSAI ; crock - If sail echo, + PUSHJ P,RUBN1 ; rubout once more since RUBN1 thought it was 1 position. +MSGT62: PUSHJ P,RUBWRD ; Now rubout word. + JRST MSGGT1 + + SUBTTL Write message file for satellite + +LVAR SNDVRS: 0 ; Holds sending version. + ; 0 normal, 1 "New operational" mailer, -1 Experimental. + +MSGSND: SKIPG RCPNUM ;make sure someone to send to + JRST [ PUSHJ P,ERRFLS + TYPECR [No recipients!] + SETZM SNDVRS ; Clear version. + MOVEI TC,%CTT + JRST COMXCT] ;go get someone + TRNN F,%MSG ; If hacking *-MSG, ensure necessary info there. + JRST MSND10 + SETO TC, + SKIPN EXPTIM ; Have expiration date? + MOVEI TC,%CTX ; If not, set up to get it. + HRRZ B,SUBJEC ; Have subject? + CAIG B,0 + MOVEI TC,%CTS + SKIPN MSGFN1 ; Have FN1 for .MSGS. file? + MOVEI TC,%CT1 + JUMPGE TC,COMXCT ; If anything missing, go get it. + +MSND10: hrrz a,frmnam + caig a, ;specified his (sender's) name? + JRST [ MOVE A,LUNAME ;no, check to see if logged-in or not + TLC A,-1 + TLNE A,-1 ;if lh= -1 then not logged in, skip + JRST .+1 + PUSHJ P,ERRFLS + TYPECR [What is your real login name?] + SETZM SNDVRS + MOVEI TC,%CTF + JRST COMXCT] ;go ask for sender's name + + ; Very last test... ^C being suppressed? + TLNE F,%NOSND + JRST [ PUSHJ P,INPFLS + CURSOR "A + TYPECR [Note: Encountered send-message command (^C), but ignoring +due to previous errors.] + JRST MSGGET] ; Back to collection loop. + + .suset [.samsk2,,[1_tyic]] ;disable typein ints (no more possible) + UAROPN [%ARTZM+%ARTCH,,TMPAR ? [100]] ;open an area + OUT(DKOC,OPEN(UC$UAR,TMPAR)) ;open uuo channel into area + skipe dmsw + jrst dmsnd ;if on DM, go to special rtn. + + FWRITE DKOC,[[FROM-JOB:],6F,JNAME,[ +SENT-BY:],6F,LUNAME,[ +]] + + ;decide what type header to ask for, if any + ;(comsat default is tenex unless msg is within its systems) + SETZ A, +;Next 2 lines commented out 8/2/79 by Moon. Comsat will generate the correct header +;for ITS *MSG-SINK rcpts. This serves only to send the wrong header to random +;network BBoard rcpts. +; TRNE F,%MSG ; If *-msg, +; MOVEI A,[ASCSTR [ITS]] ; Always try to use ITS header. + SKIPGE SORMSW ; Check for QSEND'ing... + SKIPE SENDSW ; Skip if correct switches. + CAIA ; Nope, not QSEND'ing (?) + MOVEI A,[ASCSTR [ITS]] ; Force to ITS if so. + HRRZ B,HEDTYP ; All bets off if explicitly forced. + CAIE B,0 + MOVEI A,HEDTYP ; If explicitly forced... + JUMPE A,MSGSN6 ; Skip forcing if nothing to force. + FWRITE DKOC,[[HEADER-FORCE:],TS,(A),[ +]] + +MSGSN6: SKIPN A,RGSTRD ; If special type receipts wanted... + JRST MGSN61 + FWRITE DKOC,[[REGISTERED:],TS,(A),[ +]] +MGSN61: hrrz a,frmnam ;and claimed name if any given + JUMPN A,[fwrite dkoc,[[CLAIMED-FROM:],TS,FRMNAM,[ +]] + JRST MGSN62] + SKIPE XUNAME ;if no "from", hack xuname if exists. + JRST [FWRITE DKOC,[[CLAIMED-FROM:],6F,XUNAME,[ +]] + JRST MGSN62] + +mgsn62: TRNN F,%MSG + JRST MSGO1 + ;if %MSG set... comsat will default these if unspecified. + FWRITE DKOC,[[EXPIRES:],OCT,EXPTIM,[ +MSG-FN1:],6F,MSGFN1,[ +]] + SKIPN MSGFN2 + JRST MSGO1 + FWRITE DKOC,[[MSG-FN2:],6F,MSGFN2,[ +]] + +MSGO1: HRRZ B,SUBJEC ;subject line? + JUMPE B,MSGO2 ;no, go ahead to rcpts + + ;subject out + FWRITE DKOC,[[SUBJECT:],TS,SUBJEC,[ +]] + + ;recipients out +MSGO2: hrrz b,rlsnam + JUMPN B,[fwrite dkoc,[[RCPT-LIST-NAME:],TS,RLSNAM,[ +]] + JRST .+1] + MOVN R,RCPNUM + HRLZS R +MSGSN3: SKIPN C,@TRCPF ;get and check entry + JRST MSGSN4 ;null, nothing in this slot + FWRITE DKOC,[[TO:]] + MOVE A,@TRCPH ;get host # + CAMN A,[-1] + MOVE A,OWNHST ;if -1, local host. + FWRITE DKOC,[OCT,A] + + MOVE A,@TRCPN + ADD A,TRSTTB ;get abs ascnt ptr + tlne c,r%cc ;set option if cc. + OUTCAL(DKOC,C("C)) + SKIPN SORMSW + JRST MGSN35 + SKIPGE SENDSW + OUTCAL(DKOC,C("-)) + SKIPLE SENDSW + OUTCAL(DKOC,C("+)) + OUT(DKOC,C("S)) + JRST MGSN37 +MGSN35: SKIPGE MAILSW + OUTCAL(DKOC,C("-)) + SKIPLE SENDSW + OUTCAL(DKOC,C("+)) + OUT(DKOC,C("M)) + +MGSN37: OUT(DKOC,C(""),TC(A),EOL) +MSGSN4: AOBJN R,MSGSN3 + + + ; Arbitrary attrib if any. +MSGSN7: HRRZ A,ATTRIB ; Attrib string specified? + JUMPN A,[FWRITE DKOC,[[ATTRIBUTE:],TS,ATTRIB,[ +]] + JRST .+1] + + ; Now output text. + out(msgc,PTV(b)) + FWRITE DKOC,[[TEXT;],oct,b,[ +],TA,MSGAR,[ +]] ; Add null line to avoid possible EOF padding hassles. + + MOVE A,SNDVRS + MOVE A,1(A)+[SIXBIT /XMAIL/ ; -1 exper + SIXBIT /MAIL/ + SIXBIT /NMAIL/] ; 1 New. + MOVEM A,DKOFN1 ; Set that as FN1 to use. + MOVEI A,DKODEV + +MSND90: SYSCAL OPEN,[[.UAO,,DKOC] ? (A) ; Write out to temp FNM + [SIXBIT /_MAIL_/] + [SIXBIT /OUTPUT/] ? 1(A)] + JRST MSND95 ; Error?! + OUT(DKOC,OPEN(UC$IOT),TA(TMPAR)) + SYSCAL RENMWO,[CIMM DKOC ? 2(A) ? 3(A)] + JRST MSND95 ; Error?! + .CLOSE DKOC, + + ; Now see if mailer demon should be started. + SYSCAL SSTATU,[CRET A ? CRET B] ;get sysdbg switch. + JSR DEATH + JUMPN B,DONE ;if debugging, don't try to activate mailer! + SKIPN DMSW + PUSHJ P,SATELC ;check satellite and start if necessary + SKIPE DMSW + PUSHJ P,DMDEMC ; Kick COMSYS if on DM. +DONE: .BREAK 16,124000 ;die quietly without :inpush + + +MSND95: PUSHJ P,ERRFLS + PUSHJ P,ERRDOC + TYPE [ +Error while trying to write message for COMSAT! +Try ^C again or use alt-P command to save message for later...] + JRST MSGGET + + +BVAR +DKODEV: SIXBIT /DSK/ +DKODIR: SIXBIT /.MAIL./ +DKOFN1: 0 ; Either MAIL or XMAIL or NMAIL. +DKOFN2: SIXBIT />/ +EVAR + SUBTTL Special DM message-file writer + +DMSND: OUT(DMC,OPEN(UC$XCT,[PUSHJ P,DMOUT])) ; Open MUDDLE-string output chan. + SETZM DMRTSW + PUSHJ P,DMRSN ; Output people to go in "TO" field. + setom dmrtsw + MOVNS dmrtsw + PUSHJ P,DMRSN ; Output names to actually send to. + SETOM DMRTSW + PUSHJ P,DMRSN ; Output names to go in CC field. + +DMSND2: FWRITE DKOC,[["FROM" "]] + hrrz a,frmnam + caile a, + JRST [ FWRITE DMC,[TS,FRMNAM] + JRST DMSND4] + SKIPN A,XUNAME + .SUSET [.RUNAME,,A] + FWRITE DMC,[6F,A] +DMSND4: FWRITE DKOC,[[" +]] + HRRZ A,SUBJEC + CAILE A, + JRST [ FWRITE DKOC,[["SUBJECT" "]] + FWRITE DMC,[TS,SUBJEC] + FWRITE DKOC,[[" +]] + JRST .+1] + FWRITE DKOC,[["TEXT" "]] + FWRITE DMC,[TA,MSGAR] + FWRITE DKOC,[["]] + SKIPN SORMSW + JRST DMSND5 + FWRITE DKOC,[[ +"QSEND" ]] + SKIPGE SENDSW + FWRITE DKOC,[[-1]] + SKIPN SENDSW + FWRITE DKOC,[[0]] + SKIPLE SENDSW + FWRITE DKOC,[[1]] +DMSND5: FWRITE DKOC,[[ +"SCHEDULE" ("SENDING") +]] + MOVEI A,DMODEV + JRST MSND90 ; Go send to indicated filblk. + +DMODEV: SIXBIT /DSK/ + SIXBIT /COMSYS/ + SIXBIT /M/ + SIXBIT />/ + +LVAR DMRTSW: 0 ;0 ALL, 1 TO, -1 CC +LVAR DMSNUM: 0 ; #-1 rcpts each pass + +DMRSN: SETOM DMSNUM + MOVN R,RCPNUM + HRLZS R +DMRSN1: SKIPN C,@TRCPF ;get flags + JRST DMRSN4 + SKIPN DMRTSW + JRST DMRSN3 + SKIPL DMRTSW + JRST [ TLNE C,R%CC + JRST DMRSN4 ; 1 AND CC, IGNORE + JRST DMRSN3] + TLNN C,R%CC + JRST DMRSN4 ;-1 AND TO, IGNORE + + ; Filtered out valid rcpt, output it. +DMRSN3: MOVE C,DMRTSW + AOSG DMSNUM ; If first time, must output initial stuff + JRST [ MOVE A,(C)1+[ASCNT ["CARBON-COPY-TO" (] + ASCNT ["TO" (] + ASCNT ["ACTION-TO" (] ] + OUT(DKOC,TC(A)) + JRST .+1] + OUT(DKOC,SP,C("")) + MOVE A,@TRCPN + ADD A,TRSTTB ;get abs ascnt ptr + OUT(DMC,TC(A)) + OUT(DKOC,C("@)) + MOVE B,@TRCPH ;get host # + CAMN B,[-1] + MOVE B,OWNHST + PUSH P,D + PUSHJ P,NETWRK"HSTSRC + JRST [ POP P,D ? JRST DMRSN4] ;I guess + POP P,D + OUT(DMC,TZ((A))) + OUT(DKOC,C("")) +DMRSN4: AOBJN R,DMRSN1 + SKIPL DMSNUM + FWRITE DKOC,[[) +]] + POPJ P, + + +DMOUT: PUSH P,OC + MOVEI OC,DKOC ; Change to real channel. + CAIE U1,"" ; catch quote mark + CAIN U1,"\ ; or MUDDLE quoting char + JRST [PUSH P,U1 + STDOUT("\) ; and quote either + POP P,U1 + JRST .+1] + STDOUT ; before outputting. + POP P,OC + POPJ P, + +DMDEMC: SYSCAL DEMSIG,['COMSYS] + JFCL + POPJ P, + + SUBTTL Input source routines (TTY and other) + +%TIJCL==0 +%TITTY==1 +%TIDSK==2 +.SCALAR TIX ; Input source index (one of %TI*) +LVAR TIXTAB: 0 ? 0 ? 0 ; Input source check table; one in use is -1, others 0. + +SETTIX: MOVEM A,TIX + SETZM TIXTAB+%TIJCL + SETZM TIXTAB+%TITTY + SETZM TIXTAB+%TIDSK + SETOM TIXTAB(A) + RET + +LVAR TYILCH: -1 ;holds single char to return, if any. + +TTYIN: SKIPL A,TYILCH ;skip unless char exists to "re-read". + JRST [ SETOM TYILCH + POPJ P,] + MOVE A,TIX ; Get current input source index + JRST @.+1(A) ;dispatch according to TIX. + INDSK ;routine for JCL same as INDSK, but TIX provides flag. + TTYIN0 + INDSK + + + ; Input bit setup (including tv-kbd bits) +%TXMPE==400000 ;when set means mp echoing was desired but not done +%TXPIE==200000 ;ditto for pi echoing +%TXQTE==10000 ;personal quote bit for ^q-quoting. + ;rest of bits are TK-TV kbd bits. +%TXTOP==4000 ;top +%TXSFL==2000 ;shift lock (!?) +%TXSFT==1000 ;shift (somewhat useless since ascii letters are shifted anyway) +%TXMTA==400 ;meta +%TXCTL==200 ;cntrl (ascii letter must be munged to get real 7-bit cntrl) + +TTYIN0: TLNE F,%UNSIL ;if flag set requesting un-silence, + JRST [ TLZ F,%NOTYO+%UNSIL ;make it so. + OUT(TYOC,OPEN(UC$IOT)) + OUT(DTYOC,OPEN(UC$IOT)) + JRST .+1] + TLZ F,%NOSND ; Direct TTY input clears suppress-^C flag. + TLZE F,%NOECH ;if suppressing MP echo this once, + JRST [ SYSCAL IOT,[CTLI %TIECH ;read in thusly. Will lose for PI echo. + CIMM TYIC ? CRET A] + JSR AUTPSY + TRZ A,%TXMPE+%TXPIE ;clear any echo bits + JRST TTYIN1] + .IOT TYIC,A + +TTYIN1: TRZ A,%TXSFT+%TXSFL ;flush shift and shift lock + TRNE A,%TXTOP ;top? + JRST [ TLZ F,%QUOTE + TRZ A,%TXMTA+%TXCTL ;zap meta & cntrl + POPJ P,] ;and return "top" code + TRZE A,%TXCTL ;cntrl? + JRST [ SETCA A, ;complement A + TRNE A,177 ;if all these bits 0, char was rubout, leave alone + IORI A,140 ;clobber bits to cntrl it. + SETCA A, ;complement back. + JRST .+1] + TRNE A,%TXMTA ;meta set? + JRST [TLZ F,%QUOTE ? POPJ P,] ;return meta bit flavoring if it's there. + +TTYIN7: TLZE F,%QUOTE ;zero quote flag and skip if was already clear + JRST [ TRO A,%TXMTA+%TXQTE ;quote this char (extra flag is ^q quote) + POPJ P,] + SKIPE SLSHFY + JRST [ TLZE F,%SLSHC ;slash conversion? + JRST [ CAIL A,141 + CAILE A,172 + CAIA + SUBI A,40 ;convert lower to upper + POPJ P,] + CAIL A,101 + CAILE A,132 + CAIA + ADDI A,40 ;convert lower to upper unless slashed. + CAIN A,"/ + TLO F,%SLSHC + JRST .+1] + CAIN A,^Q ;no quote. is this the quoting char? + TLO F,%QUOTE ;set flag if so, and + POPJ P, ;return + + + ; Routine for inputting from an area. +INDSK: TLZ F,%NOECH ; Always clear no-echo flag + SOSGE T.DCNT + jrst INDSK7 ;out of dsk chars. + ildb a,@t.dbpa ;get a char (via $ARRPT) + cain a,^J + jrst [ trzn f,%dcrlf ;if flag was set, skip and clear. + jrst TTYIN7 ;genuine lf. process like normal char. + jrst INDSK] ;flag set, must flush. get another char + cain a,^M + troa f,%dcrlf + trz f,%dcrlf ;for cr, set flag. for everything else, clear. + JRST TTYIN7 + +INDSK7: UARCLS @T.DARP ;free up area used... + PUSHJ P,POPINP ;pop up input stream. + JRST TTYIN ;get a char acc'ding to new input. + +BVAR +t.darp: 0 ;holds ARPT to area having input text. +T.DBPA: 0 ;holds addr of Read ptr of area. Indirected thru. +t.dcnt: -1 ;# of chars in area +EVAR + + ; Sets input stream to source selected by A. This is + ; either an area # to read from, or if -1 the TTY. + ; Actually functions as a PUSH of input. + ; Reading from an area sets %NOTYO to suppress all TTY output. +SETINP: PUSH P,B + SETZM T.OFLG ; Set to whatever + TLNE F,%NOTYO ; %NOTYO's value may be. + SETOM T.OFLG + SKIPN B,INPDP ;get current input PDL ptr + JRST [ PUSHJ P,INPFLS + MOVE B,INPDP + JRST .+1] + PUSHAE B,[T.OFLG,TYILCH,T.DARP,T.DCNT,T.DBPA,TIX] + MOVEM B,INPDP ;store ptr back... + SETOM TYILCH ;clear return-this-char + JUMPL A,[PUSHJ P,SETTYI ;if new source is TTY, use special routine. + JRST POPBJ] ;and return. + movem a,t.darp ;Else area. Store # of area text is in + move b,$ARrpt(a) ;get read ptr to text + ptrdif b,$ARwpt(a) ;get difference with write ptr (# chars) in b + movem b,t.dcnt ;save char cnt + movei a,$ARrpt(a) ;get addr of read ptr + movem a,t.dbpa ;and save for indirecting thru. + MOVEI A,%TIDSK + CALL SETTIX + TLO F,%NOTYO ;suppress TTY output. + SETOM T.OFLG ; setting this not really needed here. + OUT(TYOC,OPEN(UC$XCT,[JFCL])) ;make TTY output do nothing. + OUT(DTYOC,OPEN(UC$XCT,[JFCL])) + POP P,B + POPJ P, + + ; This routine POP's input stream back. +POPINP: PUSH P,A + SKIPE A,INPDP ;if nothing to pop, + CAMG A,INPDPS ; or at stack bottom, + PJRST INPFL1 ; reinitialize. Note A on PDL! + POPAE A,[TIX,T.DBPA,T.DCNT,T.DARP,TYILCH,T.OFLG] + MOVEM A,INPDP + MOVE A,TIX + CALL SETTIX + SKIPN T.OFLG ; Make sure t.oflg and %notyo agree, + JRST [ TLZN F,%NOTYO ; and reset TYOC as necessary. + JRST POPIN2 + OUT(TYOC,OPEN(UC$IOT)) + OUT(DTYOC,OPEN(UC$IOT)) + JRST POPIN2] + TLOE F,%NOTYO + JRST POPIN2 + OUT(TYOC,OPEN(UC$XCT,[JFCL])) ;make TTY output do nothing. + OUT(DTYOC,OPEN(UC$XCT,[JFCL])) +POPIN2: SKIPE TIXTAB+%TITTY + .SUSET [.SADF2,,[1_TYIC]] ; One more thing... allow ints for TTY + POP P,A + POPJ P, + +; INPFLS - Flushes input source stack and resets to TTY I/O + +INPFLS: PUSH P,A +INPFL1: MOVE A,INPDPS + MOVEM A,INPDP + POP P,A + PJRST SETTYI + + ; Little rtn to set up various things for TTY input. +SETTYI: PUSH P,A + MOVEI A,%TITTY ;set proper input stream index + CALL SETTIX + POP P,A + TLZ F,%NOTYO+%NOECH ;and allow output, & clear no-echo flag. + SETZM T.OFLG + OUT(TYOC,OPEN(UC$IOT)) + OUT(DTYOC,OPEN(UC$IOT)) + SETOM T.DCNT ;and zap count for any checks. + SETOM TYILCH ; And clear any re-reading + .SUSET [.SADF2,,[1_TYIC]] ;and allow any pending ints. + POPJ P, + +LVAR T.OFLG: 0 ; Set to %NOTYO for push/pop use + + +INPDLN==7*6 ;enough room on input PDL to hold 7 levels. +BVAR +INPDP: 0 ;holds current input PDL ptr. +INPDPS: -INPDLN,,INPDL-1 +INPDL: BLOCK INPDLN +EVAR + SUBTTL Error auxiliary routines + +; ERRFLS - Does a INPFLS to flush input source stack completely; +; for use when no point in continuing to gobble input. + +ERRFLS: SETZM N2DARY + SKIPN TIXTAB+%TITTY + SETOM N2DARY + PUSHJ P,INPFLS ; Flush input stack, reset to TTY I/O + .RESET TYIC, ; and clear anything in input buffer. +ERRFL2: CURSOR "A ; Get newline + SKIPE N2DARY + TYPE [MAIL error - ] + SKIPN N2DARY + TYPE [Error; ] + POPJ P, + +; ERRBEG - Pushes input stack and enables TTY I/O for duration of +; error reporting, until a ERREND call is made. If ERREND +; is not called, INPFLS should be. After ERREND, input +; will continue as before. + +ERRBEG: PUSH P,A + SETZM N2DARY + SKIPN TIXTAB+%TITTY + SETOM N2DARY + SETO A, ; Set to TTY + PUSHJ P,SETINP ; Push on + POP P,A + TLO F,%NOSND ; Suppress ^C unless direct TTY input happens. + PJRST ERRFL2 ; Type start of err message. + +; ERREND - Restores world after ERRBEG and random reporting done. +; ERROK - Similar but clears %NOSND rather than setting, to allow +; later ^C to send message. Implies wasn't really error. + +ERROK: TLZA F,%NOSND ; Wasn't really error, or was corrected. +ERREND: TLO F,%NOSND ; Make SURE this flag set (some err rtns do + ; direct TTY input which clears it) + PJRST POPINP ; Simply pop input stack back... + + SUBTTL TTY-relevant routines +KLEAR: SKIPE TTYDIS + PJRST ZAP ;clear screen if display + OUT(TYOC,EOL) ;else just kerchunk. + POPJ P, + +ZAP: CURSOR "C + POPJ P, + +;returns input char from tty in a. set up as a +;routine mainly to handle tv codes, but also to +;allow translation of tty input to disk file. + + ;returns upper-case 7-bit char. +TTYINU: PUSHJ P,TTYIN + ANDI A,177 + CAIL A,"a + CAILE A,"z + POPJ P, + SUBI A,40 + POPJ P, + + + ; Routine to get current cursor position and set HORPOS, VERPOS accordingly. +TTYLOC: PUSH P,A + SYSCAL RCPOS,[CIMM TYOC ? CRET A] + JSR AUTPSY + HRRZM A,HORPOS ;Set hor, ver positions to what should be. + HLRZM A,VERPOS + POP P,A + POPJ P, + + +DTYST1: 424242,,424242 ;"normal" - for all groups here, echo at mp level, + ;ascii output, activate, don't interrupt. +DTYST2: 434242,,420242 ;^g,^s = normal except these INTERRUPT! + ;lf, tab = normal + ; = normal + ;cr = normal + ;rubout = normal but NO ECHO + ;space,bs = normal + +TTGET: SETZ ? 'TTYGET ? 1000,,TYIC ? 2000,,A ? 2000,,B ? SETZM C +TTSET: SETZ ? 'TTYSET ? 1000,,TYIC ? A ? B ? SETZ C + +LVAR TTYWID: 0 ; TTY width used by TOPUT. Inited to HORSIZ. +TTINFO: SETZ ? 'CNSGET ? 1000,,TYIC + 2000,,VERSIZ' + 2000,,HORSIZ' + 2000,,TCTYP' + 2000,,TTYCOM' + 2000,,TTYOPT' + SETZM TTYTYP' + SUBTTL Rubout handling + +; RUBM - rub out last char in MSGAR, removing it from buffer and erasing +; it from screen (or retyping if not display). +; Erasing the LF in a CRLF erases the CR too. + +RUBM: PUSH P,A + out(msgc,PTV(a)) ;anything to rubout? + JUMPLE A,POPAJ + CAIA +RUBM0: PUSH P,A + TLON F,%HADRB ; Indicate rubout seen, skip if already set. + JRST [ SKIPE TTYERS ; First rubout! + PUSHJ P,PLNTYR ; If possible, retype line for prettiness. + JRST .+1] + LDB A,MSGAR+$ARWPT ;get char being rubbed out + D7BPT MSGAR+$ARWPT ;decrement pointer + SOS $ARCHL+MSGAR ;add to cnt of chars room. + SKIPN TTYERS ;OK to try erasing? + JRST [ TRNE F,%RQUOT ; no, on printing term. If ^Q-quote, + JRST POPAJ ; do nothing. + CAIE A,^J ; was it LF? + JRST [ OUT(TYOC,C((A))) ; No, just echo + JRST POPAJ] ; and return. + PUSHJ P,RUBMCR ; Hmm, see if there's a CR to rubout too. + OUTCAL(TYOC,C(^M)) ; Yes, output CRLF for kerchunk. + OUT(TYOC,C(^J)) ; Else just LF. + JRST POPAJ] + + ; Hmmm, display...reposition cursor.(ahhhhhggggg!!!) + CAIN A,^J ;erased char a lf? move up if so + JRST [ CURSOR "U + PUSHJ P,RUBMCR ; See if last char now CR... + JRST RUBM2 ; If so, "erase" it too. + JRST POPAJ] + CAIE A,^M ;a cr? (if so must retype previous line) + CAIN A,^H ;or backspace? (ditto) + JRST RUBM2 + CAIN A,^I ;tab? + JRST RUBM2 + PUSHJ P,RUBN1 ;reasonable char. go rub out. + POP P,A + POPJ P, +RUBM2: PUSHJ P,OLNTYR ;retype previous line. + JRST POPAJ + + ; Auxiliary for RUBM, skips if last char in buffer is not CR. + ; else removes from buffer and doesn't skip. +RUBMCR: OUT(MSGC,PTV(A)) ; make sure more to rubout... + JUMPLE A,POPJ1 ; before tasting it. + LDB A,$ARWPT+MSGAR ; See if char before the LF + CAIE A,^M ; is a CR? + JRST POPJ1 + D7BPT $ARWPT+MSGAR ; Yup, take it out. + SOS $ARCHL+MSGAR + POPJ P, ; Non-skip to hack cursor. + + + + ; Rubout routine for GETLIN. +RUBN: TLON F,%HADRB ; If first rubout, + SKIPN TTYERS ; and display, + CAIA + PJRST GTLNDS ; Then re-display whole command line & return. + SKIPN TTYERS ;OK to try erasing? + JRST [ OUT(TYOSC,C((A))) ;if merely hardcopy, then echo back. + POPJ P,] +RUBN1: PUSHJ P,TTYLOC + PUSHJ P,RUBX ;move backward and kill char. + SKIPE SLSHFY + JRST [ CAIL A,101 + CAILE A,132 ;uppercase? + JRST .+1 ;no + PJRST RUBX] ;if uppercase, erase slash + CAIN A,177 + JRST RUBN2 + CAIL A,40 ;skip if cntrl + POPJ P, + CAIN A,33 ;esc is single-pos + POPJ P, + SKIPE TTYSAI ;skip if not one-char cntrls + POPJ P, +RUBN2: PJRST RUBX ;back and kill the ^ + + ; A smart form of ^P X. +RUBX: CURSOR "B ;first move back. + SOSL HORPOS + JRST [ CURSOR "K + POPJ P,] ;if not past edge, things are easy. + PUSH P,HORSIZ + POP P,HORPOS + SOS HORSIZ +; CURSOR "B ; must move back again to avoid stupid "!". +; CURSOR "U ;must move up to allow for auto-crlf. + SOSL VERPOS + JRST RUBX5 + PUSH P,VERSIZ + POP P,VERPOS + SOS VERPOS +RUBX5: CURSOR "L ;kill rest of line (both char and "!"). + POPJ P, + + +;retype current line in msg area + +PLNTYP: TROA F,%OLNTY +PLNTYR: TRZ F,%OLNTY + TLO F,%PREVL + JRST LNTY +OLNTYP: TROA F,%OLNTY +OLNTYR: TRZ F,%OLNTY ;means hack lf reposition since rubbing out. + TLZ F,%PREVL +LNTY: PUSHAE P,[A,B,C] + SKIPN TTYERS ;skip if OK to try clearing line + JRST [ CURSOR "A ;No. position on new line if necessary. + JRST OLNTY2] ;and skip display hacking. + CURSOR "H + OUT(DTYOC,C(8.)) ;set cursor to left margin + CURSOR "L ;clear line +OLNTY2: out(msgc,PTV(b)) + JUMPLE B,PPCBAJ ;make sure something to type out + PUSHJ P,FNDLN ;returns ptr to beg. of line cursor should be on + JUMPE B,PPCBAJ + TRNE F,%OLNTY + JRST OLNTY1 ;skip LF reposition if typing anew. + JUMPE C,OLNTY1 ;returns in c the # lf's seen, jump if none. + skipn ttyers + jrst olnty1 ;also skip reposition if can't do it. +OLNTY3: CURSOR "U ;move up + CURSOR "L ;and clear line + SOJG C,OLNTY3 ;for each lf seen. +OLNTY1: ILDB C,A + OUT(TYOSC,C((C))) + SOJG B,OLNTY1 + JRST PPCBAJ + + +;searches backward for a cr, and positions ptr +;such that an ildb gets 1st char of the line after the cr. ie, +;tries to ignore lf's. won't go past beg of area. +;returns ptr in a, returns in b the # of chars in line. (ie +;# chars it moved backwards over, not # chars to next cr) +;in c leaves # lf's passed over (not counting crlf that ends search) + +FNDPLN: TLOA F,%PREVL +FNDOLN: TLZ F,%PREVL +FNDLN: push p,d + PUSH P,E + MOVE A,MSGAR+$ARWPT + SETZB B,C ;zero cnt + out(msgc,PTV(E)) + CAIG E, + JRST POPEDJ +FNDOL1: LDB E,A ;get char + CAIN E,^M ;cr? + JRST [ TLNE F,%PREVL ;yep! is switch set? + CAILE B,1 ;and char cnt 1 (lf) or less? + JRST FNDOL2 ;nope, mission ended. + JRST .+1] ;switch set and current line is nil, find previous. + + CAIN E,^J ;lf? + AOJ C, ;incr cnt of bypassed lf's + AOJ B, ;no, bypass it. incrment count of bypassed chars. + D7BPT A ;decrement ptr in a + HRRZ E,A ;test addr. + CAMGE E,MSGAR+$ARLOC ;ok if addr is same or greater + JRST [ MOVE A,MSGAR+$ARLOC + hrli a,440700 + JRST FNDOL2] ;hmmm, nope, must reset. + JRST FNDOL1 + +FNDOL2: MOVE E,A ;ah, terminated. is char following terminator a lf? + ILDB E,E ;get it + CAIE E,^J + JRST POPEDJ ;nope, things are all set. + IBP A ;yes, a lf. readjust pointer + SOJ B, ;and bump count down + SOJ C, ;for both +POPEDJ: pop p,E + POP P,D + POPJ P, + + +; Rubout Word routines + +; RUBWRD - for calling by MSGGET when necessary to rub out a +; word. Does it the obvious painful way... but works. + +RUBWRD: PUSHAE P,[A,B] + OUT(MSGC,PTV(A)) + JUMPLE A,POPBAJ + MOVE B,MSGAR+$ARWPT + PUSHJ P,RUBWCT ; Get # chars to flush + JUMPLE B,POPBAJ + SKIPN TTYERS + JRST RUBWD5 ; Jump if not display. + PUSHJ P,RUBM0 ; Erase one char + SOJG B,.-1 ; And so forth + JRST POPBAJ + +RUBWD5: OUT(TYOC,C("_)) ; If not display, simply echo "_" + MOVNS B ; Negate cnt + PTSKIP B,MSGAR+$ARWPT ; Adjust write ptr + ADDM B,MSGAR+$ARCHL ; and # chars free (neg) + JRST POPBAJ + + +; RUBWCT - Given BP in B to end of string, length in A, returns +; in B the # chars to delete for performing rubout-word function. +; kludged to actually return # times to call RUBM0, if display. +; This "fixes" problem of CRLF being single char to RUBM. + +RUBWCT: JUMPLE A,APOPJ + PUSHAE P,[C,D] + MOVN D,A + HRLZS D ; Set up AOBJN + SETZ C, ; Clear flag +RUBWC2: LDB A,B ; Get last char +RUBCW3: PUSHJ P,RUBWCL ; Skip if NOT word-class char + SKIPA C,[-1] ; Found word-class char, set flag... + JUMPN C,RUBWC6 ; If not wordclass and flag set, stop! +RUBWC5: D7BPT B ; Else continue searching back. + CAIN A,^J ; If last char LF, + AOBJN D,[LDB A,B ; do special check for CRLF + CAIE A,^M + JRST RUBCW3 ; Not a CRLF, continue normally. + SKIPE TTYERS ; Ah, a CRLF. Display? + HRRI D,-1(D) ; yes, account for display rubout hack. + JRST RUBWC5] + AOBJN D,RUBWC2 ; Get another, unless all gone. +RUBWC6: HRRE B,D ; Isolate count of chars to flush. + POPAE P,[D,C] + POPJ P, + + ; Check for char being in "word-class" - letter or digit. +RUBWCL: CAIL A,"0 + CAILE A,"9 + CAIA + POPJ P, ; In, return. + CAIL A,"A + CAILE A,"Z + CAIA + POPJ P, + CAIL A,"a + CAILE A,"z + AOS (P) ; Not in word-class, skip on return. + POPJ P, + + + SUBTTL Access to Recipient tables + + ; Initialize rcpt tables +RTINIT: MOVEI U1,10. ;start out with 10. rcpts + PUSHJ P,CORGET + HRRM U2,TRCPN ;store addr for indirecting thru + MOVEM U1,TRSIZE ;save size + MOVEI U1,10. + PUSHJ P,CORGET ;another one. + HRRM U2,TRCPF ;ditto + CAMGE U1,TRSIZE ;must use whichever size is smallest + MOVEM U1,TRSIZE ;so neither bound is exceeded + MOVEI U1,10. + PUSHJ P,CORGET ;another one. + HRRM U2,TRCPH ;ditto + CAMGE U1,TRSIZE ;must use whichever size is smallest + MOVEM U1,TRSIZE ;so neither bound is exceeded + MOVEI U1,100. ;assume 10 chars/rcpt + PUSHJ P,CORGET + MOVEM U2,TRSTTB ;store start + MOVEM U1,TRSTRL ;and length + SETZM TRSTPT ;and zero rel write ptr + POPJ P, + + ; Ensures that index R points to valid slots, i.e. call when + ; c(R) .GE. c(TRSIZE) - expands the RCPN, RCPF, and RCPH blocks to win for + ;at least that value of R. +RTEXP: MOVEI U1,30.(R) ;get more (plus some, to minimize calls) + SUB U1,TRSIZE + CAIG U1, + POPJ P, ;foo, called when R was really OK. + PUSH P,U1 ;save for next call + HRRZ U2,TRCPN + PUSHJ P,COREXP ;expand block + HRRM U2,TRCPN + MOVEM U1,TRSIZE ;store new (?) addr and size + MOVE U1,(P) ;get increment again + HRRZ U2,TRCPH + PUSHJ P,COREXP + HRRM U2,TRCPH + CAMGE U1,TRSIZE + MOVEM U1,TRSIZE ;as for RTINIT + POP P,U1 ;get increment again + HRRZ U2,TRCPF + PUSHJ P,COREXP + HRRM U2,TRCPF + CAMGE U1,TRSIZE + MOVEM U1,TRSIZE ;as for RTINIT + POPJ P, + + + ;sets indexed rcpt name to string pointed to by A +SRCPN: PUSH P,B + PUSH P,C + HRRZ B,(A) ;get cnt of string + ADDI B,4 + IDIVI B,5 ;find # wds needed + ADD B,TRSTPT ;add to write ptr + MOVE C,B ;save + SUB B,TRSTRL ;will string fit? + JUMPL B,SRCPN3 ;if fits,don't need to expand + MOVEI U1,40(B) ;else get that many wds plus a few more. + MOVE U2,TRSTTB + PUSHJ P,COREXP ;get more core. + MOVEM U2,TRSTTB + MOVEM U1,TRSTRL ;save new (?) address and length + +SRCPN3: MOVE B,TRSTPT ;get current write ptr + HRL B,(A) ;and cnt of string + MOVEM B,@TRCPN ;store rel ascnt ptr + HRLI B,440700 + ADD B,TRSTTB ;make abs bp + OUT(TMPC,OPEN(UC$BPT,B),TS((A))) ;output string into block + MOVEM C,TRSTPT ;store updated write ptr + POP P,C + POP P,B + POPJ P, + + +BVAR +TRSIZE: 0 ;# wds in each of RCPF, RCPH, and RCPNMS. +TRCPF: (R) ;RH points to beg of RCPF data block. + ;each entry in RCPHF is ,, +TRCPH: (R) ;RH points to beg of RCPH data block. + ;each entry in RCPH is a host number. +TRCPN: (R) ;RH points to beg of RCPNMS data block. + ;each entry is <# chars>,, + ;where string begins +TRSTTB: 0 ;address of RSTRTB block +TRSTRL: 0 ;# wds in it +TRSTPT: 0 ;relative write ptr into block +EVAR + SUBTTL Redisplay routines + + ; Type out rcpt specified by R +RCTYPE: PUSH P,A + PUSH P,B + HLRZ A,@TRCPN ;get char count + CAIN A,-1 ;check for "any" spec + JRST [ OUT(TYOC,C("*)) + JRST RCTYP2] ;type * and skip + MOVE A,@TRCPN + ADD A,TRSTTB ;get abs ascnt ptr + OUT(TYOSC,TC(A)) +RCTYP2: MOVE A,@TRCPF + TLNE A,R%MSG + JRST POPBAJ ;ignore " at " if rcpt is a MSG destination. + TYPE [ at ] + MOVE A,@TRCPH ;get site # + CAMN A,[-1] ;check for "any" spec + JRST [ OUT(TYOC,C("*)) + JRST POPBAJ] + FWRITE TYOC,[HST,A] ;type out name of host. + POP P,B + POP P,A + POPJ P, + +ALLDIS: PUSHJ P,MOSDIS + PJRST MSGDIS + +MOSDIS: PUSHJ P,KLEAR + pushj p,frmdis + PUSHJ P,RCPDIS + TRNE F,%MSG + PUSHJ P,FN1DIS + PUSHJ P,SBJDIS + TRNE F,%MSG + PUSHJ P,EXPDIS + POPJ P, + +EXPDIS: FWRITE TYOC,[[Expires in ],N9,EXPTIM,[ days +]] + POPJ P, + + +FN1DIS: TYPE [.MSGS.;] + SKIPN MSGFN1 + TYPE [ - ] + SKIPE MSGFN1 + OUTCAL(TYOC,6F(MSGFN1)) + OUT(TYOC,SP) + SKIPE MSGFN2 + OUTCAL(TYOC,6F(MSGFN2)) + SKIPN MSGFN2 + OUTCAL(TYOC,6F(MFNDF2)) ;default MSG FN2 if none specified. + OUT(TYOC,EOL) + POPJ P, + +frmdis: PUSH P,A + hrrz a,frmnam + caig a, ;from spec? + JRST POPAJ + TYPE [From: ] + movei a,frmnam + PJRST MSGDS1 + +SBJDIS: PUSH P,A + HRRZ A,SUBJEC + CAIG A, ;subject line? + JRST POPAJ ;no + TYPE [Subj: ] + movei a,subjec +MSGDS1: FWRITE TYOSC,[TS,(A),[ +]] + POP P,A + POPJ P, + +RCPDIS: PUSH P,A + HRRZ A,RLSNAM + JUMPG A,[TYPE [ TO: ] + OUT(TYOSC,TS(RLSNAM)) + OUT(TYOC,EOL) + JRST .+1] + PUSHJ P,TPUT + OUT(TYOC,TS(TOLINS)) + HRRZ A,TOLINS ;if there wasn't anything to type out, + CAIN A,0 + TYPECR [To: (nil)] ;then indicate no rcpts. + PUSHJ P,CPUT + OUT(TYOC,TS(TOLINS)) + POP P,A + POPJ P, + + +MSGHED: CURSOR "A ;start on new line. + TYPE [Continue msg: +] + PUSHJ P,OLNTYP ;retype current line + POPJ P, + +MSGDIS: CURSOR "A ;start on new line if not on edge + TYPE [Msg: +] + FWRITE TYOSC,[TA,MSGAR] + POPJ P, + SUBTTL Host name muncher + +;Map the host table file SYSBIN;HOSTS1 > into core. +;A should contain the page number to start it at. Gets advanced to next free. + +NETINI: PUSH P,B + MOVEI B,DKIC + PUSHJ P,NETWRK"HSTMAP + JSR AUTPSY + POP P,B + POPJ P, + +;Given host number in A, return flags in B. no skip if doesn't exist. + +GHFLAG: PUSH P,A ; mustn't clobber number itself! + PUSH P,D + MOVE B,A + PUSHJ P,NETWRK"HSTSRC + JRST GHFLG1 + MOVE B,NETWRK"STLFLG(D) ; Get flags + AOS -2(P) +GHFLG1: POP P,D + POP P,A + POPJ P, + +;Given host number in A, return pointer to asciz name in A, 0 if doesn't exist. + +GHNAME: PUSHAE P,[B,D] + MOVE B,A + PUSHJ P,NETWRK"HSTSRC + TDZA A,A + HRRZS A + POPAE P,[D,B] + POPJ P, + + +; "NHMLTX" - routine skips if host in A is a Multics. + +NHMLTX: PUSHAE P,[A,B,D] ;save ACs clobbered by HSTSRC + MOVE B,A + PUSHJ P,NETWRK"HSTSRC ;find out about this host + JRST NHMLT9 ;unknown host presumed not to be a Multics + HLRZ D,NETWRK"STLSYS(D) ;pointer to system name + ADD D,NETWRK"HSTADR ;relocate + MOVE A,[ASCII/MULTI/] + MOVE B,[ASCII/CS/] + CAMN A,(D) + CAME B,1(D) + CAIA + AOS -3(P) ;It's a Multics; skip return +NHMLT9: POPAE P,[D,B,A] + POPJ P, + +;server-oriented host-name search. +; [This routine is slightly different from the one in Comsat] +;if skips: +; a/ # of site found +; b/ flags +;if doesn't skip: +; a= -1 ;host not found, whether server or anything else. +; a= -2 ;found but not on accessible network +; a= ptr,,ptr ;ambiguous server sites, 2 ptrs returned as examples. +; ;These are abs addresses of Name table entries. +; Takes in A the address of string to look up. + +HANLYZ: PUSHAE P,[C,D,E] +;I think there is still a KA10 running ITS in Sweden, so we can't use ADJBP +; HRRZ C,(A) ; length of name +; ADJBP C,1(A) ; byte pointer to last char of name + HRRZ D,(A) ; length of name + SKIPA C,1(A) ; byte pointer to first char of name + IBP C ; increment to last char of name + SOJGE D,.-1 + ILDB D,C ; temporarily terminate the asciz string + PUSH P,D + MOVEI D,0 + DPB D,C + PUSH P,C + MOVE A,1(A) ; byte pointer to name + PUSHJ P,NETWRK"HSTLOOK ; hunt for it + JRST HANLY2 ; ambiguous or failed, check. + PUSHJ P,GHFLAG + JSR AUTPSY + AOS -5(P) +HANLY9: POP P,C ; put back the first char after name + POP P,D + DPB D,C + POPAE P,[E,D,C] + POPJ P, + +HANLY2: JUMPE B,[SETO A, ; Not found at all. + JRST HANLY9] + TLNE B,-1 + SKIPA A,B ; Ambiguous, return first,,last + MOVNI A,2 ; Inaccessible, return -2 + JRST HANLY9 + +ifn 0,[ ;This is a bunch of bullshit. NETWRK works. +; [This routine differs from COMSAT's NETRTS one in that if a single host +; is found and returned, its flags are also returned in B. The string +; argument is also given differently.] +;server-oriented host-name search. +;algorithm: look for match of 1st, 2nd, etc. chars; if +;both count out exactly, found it. if table name counts out, +;keep looking. if other name counts out, consider it a +;match, look for other matches, and win if no more. if +;more, lose (ambiguous) +;if skips: +; a/ # of site found +;if doesn't skip: +; a= -1 ;host not found, whether server or anything else. +; a= -2 ;found but not on accessible network +; a= ptr,,ptr ;ambiguous server sites, 2 ptrs returned as examples. +; ;These are abs addresses of NAME table entries. +;if name matches both a server and non-server site, it is held non-ambiguous and +;the server site selected. if the only matches are multiple non-server sites, +;the first one found is returned with a skip. (ugh). + +; Can't use NETWRK routine here because they lazily depend on word-justified +; uppercasified zeroed-out ASCIZ comparison. Sigh... + +; Arg in A - addr of string variable. +; also a successful return provides site flags in B. + +HANLYZ: PUSHAE P,[C,D,E] + HRRZ B,(A) + MOVEM B,NPTSVC' ;save cnt + MOVE B,1(A) + MOVEM B,NPTSAV' ;save ptr to name + + SETZM HFSAV1' ;clear the regs used to store + SETZM HFSAV2' ;matches in. + SETZM HNSSAV' ;(this one is non-server slot) + SKIPN D,NETWRK"HSTADR + JSR AUTPSY + ADD D,NETWRK"NAMPTR(D) ;address NAMES table. Assumes one word entries!! + MOVN E,0(D) ;get number of entries + HRLZS E ;make aobjn pointer + HRRI E,2(D) +HANLZ1: HRRZ D,NETWRK"NMRNAM(E) ;points to ASCIZ name + ADD D,NETWRK"HSTADR + HRLI D,440700 + MOVE C,NPTSAV + MOVE A,NPTSVC ; get cnt + MOVEM A,NPTCNT' +HANL11: ILDB B,D + SOSGE NPTCNT ;decr. char cnt + TDCA A,A ;clear a and skip if none left. + ILDB A,C + JUMPE B,[JUMPN A,HANLZ4 ;site string pau. if our string longer, no match + MOVEI A,(E) ; both counted out, perfect match, use this index. + JRST HANLZ7 ] ;and go win + JUMPE A,HANLZ2 ;partial match if our string counts out first + CAMN A,B + JRST HANL11 + CAIL A,"a ;if chars don't match, try converting + CAILE A,"z ;input string to uppercase. + JRST HANLZ4 ;twas uppercase already + SUBI A,40 + CAMN A,B + JRST HANL11 +HANLZ4: AOBJN E,HANLZ1 + + ;all searching done, no perfect matches, see if partial matches. + SKIPE HFSAV2 ;was an ambiguous server host found? + JRST [ HRLZ A,HFSAV1 ;ambiguous; two or more found. get ptr to first in lh + HRR A,HFSAV2 ;and ptr to second in rh. + JRST HANLZ9] ;loss return. + SKIPE A,HFSAV1 ;was unambiguous server host found? + JRST HANLZ7 ;yes, only one partial match, win + SKIPN A,HNSSAV ;was a non-server site found? (load with value) + JRST HANLZ8 ; Nope, go to loss return. + +HANLZ7: HLRZ E,(A) ; get adr of SITE ent + ADD E,NETWRK"HSTADR + HRRZ B,NETWRK"STRADR(E) ; Get file addr of ADDRESS table entry... + + ; Now decide which of the possible addresses to use. + ; priority is ARPAnet, CHAOSnet, LCSnet, random net. + PUSH P,E + SETOB A,C +HANLC2: ADD B,NETWRK"HSTADR ; Make abs ptr + MOVE D,NETWRK"ADDADR(B) ; Get net address of this entry + NETWRK"GETNET D ; Get net number it's on + MOVEI E,3 + CAME D,(E)[NETWRK"NW%LCS ; Priority in reverse order + NETWRK"NW%CHS + NETWRK"NW%ARP]-1 + SOJG E,.-1 + CAIL C,(E) + JRST HANLC3 + MOVE A,NETWRK"ADDADR(B) ; Aha, save address + MOVEI C,(E) ; and its priority +HANLC3: HRRZ B,NETWRK"ADRCDR(B) ; Check out more net addrs if any + JUMPN B,HANLC2 ; Yep, check next one. + POP P,E + JRST HANL78 ; Done, use highest addr found, in A. + +IFN 0,[ CALL HANLCA ; Check for ARPAnet address. + JRST HANL78 ; Win! + MOVE D,OWNHST ; No arpanet, can we check chaosnet? + CAMN D,[HN$DM] ; If non-DM, yes! (I know this is absurd) + JRST HANL72 + HRRZ B,NETWRK"STRADR(E) ; Try again, + CALL HANLCC ; for chaosnet. + JRST HANL78 ; Win! +] ;ifn 0 + +HANL72: MOVNI A,2 + JRST HANLZ9 ; Nope, not right place after all, lose. + +ifn 0,[ + ; Check out A-net addr +HANLCA: SKIPA D,[NETWRK"NW%ARP] +HANLCC: MOVE D,[NETWRK"NW%CHS] +HANLC2: ADD B,NETWRK"HSTADR + MOVE A,NETWRK"ADDADR(B) ; Get net address of this entry + NETWRK"GETNET C,A ; Get net number... + CAMN C,D ; Right net? + RET ; Yes, win. + HRRZ B,NETWRK"ADRCDR(B) ; Wrong net, see if exists on another one. + JUMPN B,HANLC2 ; Yep, check that. + AOS (P) ; Foo, lost. (loss return!) + RET +] ;ifn 0 + +HANL78: MOVE B,NETWRK"STLFLG(E) ; Also return flags for winner. + AOSA -3(P) ;come here for winnng return +HANLZ8: SETO A, +HANLZ9: POPAE P,[E,D,C] + POPJ P, ;failure return + + ; here when partial match found +HANLZ2: SKIPN HFSAV1 ;skip if already have one partial match + JRST [ HRRZM E,HFSAV1 ; Save table index to first partial match + HLRZ A,(E) ; Get file addr of SITE entry + ADD A,NETWRK"HSTADR + MOVE A,NETWRK"STLFLG(A) ;get flags + TLNE A,NETWRK"STFSRV ;skip if not server + JRST HANLZ4 ;continue, to check for ambiguities + HRRZM E,HNSSAV ;non-server, store entry # here. + SETZM HFSAV1 ;rectify wrong assumption + JRST HANLZ4] ;and continue + ;not first partial match, save if server, ignore if not. + HLRZ A,(E) ; Get file addr of SITE entry + ADD A,NETWRK"HSTADR + MOVE A,NETWRK"STLFLG(A) ;get flags + TLNN A,NETWRK"STFSRV ;skip if server + JRST HANLZ4 ;ignore if non-server + MOVEI B,(E) + CAMN B,HFSAV1 ;test against entry of previously matched name + JRST HANLZ4 ;ignore this finding if already found same host. + CAMN B,HFSAV2 ;if not =, not same as first found. check second. + JRST HANLZ4 ;ignore if this host already listed + MOVEM B,HFSAV2' ;different from both already found, "second-found" host. + JRST HANLZ4 ;continue looking. (may find exact match) +];ifn 0 + +; "ipnum" - takes addr to string in A, +;tries to parse as a number (oct or dec). returns value in a, +;doesn't skip if bad parse. + +IPNUM8: TRZA F,%ONCE ;don't force to decimal. +IPNUM: TRO F,%ONCE ;do! + PUSH P,B + HRRZ B,(A) ;get cnt + MOVE A,1(A) ;and bp + MOVEM A,NUMPNT' ;save ptr to string +IPNUM0: JUMPE B,POPBJ + ILDB A,NUMPNT ;loop to flush leading blanks + CAIE A,40 + CAIN A,^I + SOJA B,IPNUM0 + + TRO F,%TMP ;set flag to negate result + CAIE A,"- + JRST [ TRZ F,%TMP ;unless not negative # + D7BPT NUMPNT ;in which case must decr. bp + JRST .+1] + PUSHAE P,[C,D] + SETZB C,D +IPNUM2: SOJL B,IPNUM6 ;decrement cnt; if count out here, it's octal. + ILDB A,NUMPNT ;get ascii digit + CAIL A,"0 ;check to be sure it's a digit + CAILE A,"9 + JRST IPNUM3 ;foo! non-numeric char. + LSH C,3 ; octal*8 + IMULI D,10. ; decimal*10 + ADDI C,-"0(A) + ADDI D,-"0(A) + JRST IPNUM2 + +IPNUM3: CAIE A,". ;is non-numeric char a decimal pt? + JRST IPNUM5 ;no, go flush blanks/tabs + MOVE C,D ;ah yes, use decimal accumulator. + ;now flush blanks/tabs +IPNUM4: SOJL B,IPNUM6 + ILDB A,NUMPNT +IPNUM5: CAIE A,40 + CAIN A,^I + JRST IPNUM4 + JRST IPNUM7 ;foo, lose again. can't do fractions. + +IPNUM6: TRNE F,%ONCE + SKIPA A,D ;use decimal if flag set. + MOVE A,C + AOS -3(P) + TRNE F,%TMP + MOVN A,A +IPNUM7: POPAE P,[D,C,B] + POPJ P, + + SUBTTL Locks and satellite startup +; ensure that comsat is alive, start it if not. + +SATELC: PUSHJ P,SATEXS ;check for satellite and skip if exists. + CAIA + POPJ P, ;yep it's there, nothing to do. + PUSH P,A + + ;here, must start up comsat. + MOVE A,SNDVRS + XCT 1(A)+[TYPE [ Experimental COMSAT] + TYPE [ Communications satellite] + TYPE [ New COMSAT]] + TYPECR [ apparently dead.] + SKIPL SNDVRS ; If experimental-sending, + SKIPE DEBUG ; or debugging, then ask: + JRST [TYPE [Attempt re-launch?] + PUSHJ P,TTYINU + CAIE A,"Y + JRST POPAJ ; If doesn't want re-launch, just return. + TYPE [ ] ; Aha, go ahead & launch. + JRST .+1] + TYPE [Re-launching, hang on...] + + ; Blast off... + .OPEN USRO,[.UIO,,'USR ? 0 ? SIXBIT /RESTRT/] + JRST [ TYPE [ Can't get launch pad!] + JRST SATEL8] + MOVE A,SNDVRS + MOVE A,(A)SATFTB+1 ; Get proper FN2 to load. + + SYSCAL OPEN,[[.UII,,DKIC] ? SATDEV ? SATFN1 ? A ? SATDIR] + JRST [ TYPE [ Can't get booster for COMSAT!] + JRST SATEL8] + SYSCAL LOAD,[CIMM USRO ? CIMM DKIC] + JRST [ TYPE [ Fizzled on pad!] + JRST SATEL8] + .IOT DKIC,A + .USET USRO,[.SUPC,,A] ;set initial pc from start addr in file. + SYSCAL DISOWN,[CTLI 7 ? CIMM USRO] ;start after disowning, top-level. + JRST [ TYPE [ Can't release satellite!] + JRST SATEL8] + + TYPECR [ now in orbit!] +SATEL9: POP P,A + POPJ P, ;have started it, done. + +SATEL8: TYPECR [ +Fear not, your mail will eventually be transmitted.] + JRST SATEL9 + +BVAR +SATDEV: SIXBIT /DSK/ +SATDIR: SIXBIT /.MAIL./ +SATFN1: SIXBIT /COMSAT/ +SATFN2: 0 +EVAR + +SATFTB: SIXBIT /XPER/ + SIXBIT /LAUNCH/ + SIXBIT /NEW/ + +SATEXS: PUSH P,A + MOVE A,SNDVRS ; Get index to proper FN1 to map. + SYSCAL OPEN,[[.UII,,DKIC] ? SATDEV ;try to get dsk chan to lock-sw file + (A)LCKFTB+1 ? LCKFN2 ? SATDIR] + JRST POPAJ ;failed, assume not there because no comsat. + SYSCAL CORBLK,[CIMM %CBNDW+%CBPUB ; Get public write-access page. + CIMM -1 ;put into self + CIMM LCKPAG ;at highest page + CIMM DKIC] ; Mapping from dsk file. + JSR DEATH ;ugh????? + PUSHJ P,LKINIT ;initialize switches + SKIPL LOCK1 ;see if unique switch is locked; skip if not + AOS -1(P) ;locked, comsat alive! + POP P,A + POPJ P, + +LCKFN2: SIXBIT /UNIQUE/ ; FN2 of locked-switch file. + +LCKFTB: SIXBIT /XLOCK/ ; Table of possible FN1's. + SIXBIT / LOCK/ + SIXBIT /NLOCK/ + +LCKPAG==377 +LSWLOC=LCKPAG*2000 ;loc where switch page starts +LSWREQ=LSWLOC ;init request flag +LSWDON=LSWLOC+1 ;init done flag +LOCK1=LSWLOC+<1*2> ;switch 1 (2 wd block) +LOCK2=LSWLOC+<2*2> ;switch 2 " " " +NLCKSW==2 + +TMPLOC 43,{ 0 ;43 ptr to locked switch list + -LCCBLK,,CCBLK ;44 aobjn ptr to critical routine table for locks +} + +; critical code table pointed to by word 44 ! +CCBLK: LKINI2,,LKINI3 ;for crashing in lkinit + MOVEM A,LSWREQ + LKGRB1,,LKGRB2 ;for crashing in lkgrab + SETOM @A + LKFRE1,,LKFRE1+1 ;for crashing in lkfree + SETOM @A +LCCBLK==.-CCBLK + +;;; initialize lock switches in page +;;; (taken from locks documentation) + +LKINIT: PUSHAE P,[A,B] + MOVEI B,15. ;in case of unknown time, sleep 15 times + .CALL [SETZ ? 'RQDATE ? 2000,,A ? SETZM A] + JSR DEATH + JUMPL A,[SOSGE B + JSR DEATH + MOVEI A,30.*60. ;sleep for 1 min. each try + .SLEEP A, + JRST .-2] ;repeat call to get time sys started + MOVE B,A +LKINI1: EXCH A,LSWREQ ;claim right of initializing (nop if already claimed) +LKINI2: CAMN A,LSWREQ ;did we get it? + JRST LKINI5 ;no, check 2nd word to see if other guy fulfilled duty + + ;got access, we must initialize! lkini2 to lkini3-1 is critical code + + SETOM LOCK1 ;clear the lock(s) + SETOM LOCK2 +LKINI3: MOVEM B,LSWDON ;indicate init done +LKINI9: POPAE P,[B,A] + POPJ P, + +LKINI5: CAMN B,LSWDON ;didn't get init rights, see if other finished it. + JRST LKINI9 ;yes, nothing left to do. + MOVEI A,30. ;no, he's still at it...hang around, he might die. + .SLEEP A, + MOVE A,B + JRST LKINI1 ;try to claim again. + +;;; lkgrab - takes a as addr of switch to swipe at; skips if +;;; successfully grabbed switch for very own, doesn't skip if +;;; it was locked. tries only once!!! + +LKGRAB: AOSE (A) ;try to get it + POPJ P, ;lost + +LKGRB1: PUSH P,B ;got it! now put it on + MOVE B,43 ;locked switch list + HRLI B,(SETOM) + MOVEM B,1(A) + MOVEM A,43 +LKGRB2: POP P,B ; lkgrb1 to lkgrb2-1 is critical code + AOS (P) ;skip, we got it + POPJ P, + +;;; lkfree - takes a as addr of switch to free. +;;; (assumes that same switch is first item on locked switch list) + +LKFREE: PUSH P,B + HRRZ B,1(A) + MOVEM B,43 ;remove from lsw list +LKFRE1: SETOM (A) ;and unlock (lkfre1 is critical instr.) + POP P,B + POPJ P, + + SUBTTL Storage wrapup + +BVAR ; Most all of this stuff is impure. + +N2DARY: 0 ; -1 when known to be secondary routine (invoked by RMAIL or like) + +HORPOS: 0 ;horizontal cursor position. +VERPOS: 0 ;vertical + +MSGAR: BLOCK $ARSIZ ; MSG area. +JCLAR: BLOCK $ARSIZ ; JCL text area +TMPAR: BLOCK $ARSIZ ; Temporary area. + +RCPNUM: 0 ; # of recipients stored in rcplst +CCNUM: 0 ; # of these rcpts which are CC's +MDSNUM: 0 ; # of these rcpts which are MSG distribution sites +r%cc==1 ;lh flag for rcplst, indicates cc +R%MSG==2 ;lh flag indicating rcpt is a MSG psuedo-rcpt. + +STRNAM FRMNAM ;string holding explicit "From" name if any +STRNAM SUBJEC ;string holding subject text +STRNAM RLSNAM ;string holding single name for all of rcpt list. +STRNAM RCPNAM ;string holding rcpt name in GETRS +STRNAM RHSTR ;string holding host spec in GETRS + +SPDLEN==10*2 ;size of string PDL +SPDLPT: -SPDLEN,,SPDL-1 + + ;string variable table. +STRNGS: SBLOCK +SPDL: BLOCK SPDLEN + NSTRS==<.-STRNGS>/2 + +EVAR + +ARPAGS: -NARPGS,,MSGPAG ; Define area for core allocator to hack. + +CONSTANTS ;always have these two in front of following!! +VARCHK ; finalize purification. + +MSGPAG==<.+1777>/2000 ;find # of page to start msg buffer at. +LOC MSGPAG*2000 ;start it there. + +HSTPAG==100 ; Save pgs for host table stuff + +NARPGS==HSTPAG-MSGPAG ; and thus delimit boundaries for core allocator. + +END START diff --git a/src/sysnet/comsat.583 b/src/sysnet/comsat.583 new file mode 100644 index 00000000..676149e0 --- /dev/null +++ b/src/sysnet/comsat.583 @@ -0,0 +1,11864 @@ +;-*- Mode: Midas; Fonts: MEDFNT -*- +SUBTTL Basic symbol defs and insrts +.SYMTAB 5001.,7000. + +;; WARNING: This is the experimental version of COMSAT using the DQ: +;; resolver device. Among other things, this code assumes +;; that RESOLV"HSTADR will -always- return the Chaosnet +;; address of a machine over the Internet address if there +;; is a choice (the alternative is to do twice as many resolves +;; and do string comparisons). Yukko scuz. Should be fixed +;; as soon as somebody has a better method. + +TITLE NEW COMSAT + ; System Communications Satellite + ;(analogy pat. pend.-- running job has various actual sat. names) + + F=0 ; Flags + A=1 ; A-E consecutive utility regs + B=2 ; ( routines save all not used for value returning, + C=3 ; so as to minimize clobberage) + D=4 + E=5 + ;=6 ; Someday... + MF=7 ; Message flags (perhaps flush this) + N=10 ; Index to current net host + L=11 ; Base register into index table for LSE addressing + + OC=12 ; Output Channel - used by OUT package. + U1=13 ; UU UU UU UU OOOOO + U2=14 ; UU UU UU UU OO OO HANDLER + U3=15 ; UU UU UU UU OO OO ACCS + U4=16 ; UUUUU UUUUU OOOOO + + P=17 ; PDL ptr + +; "Hard" channel assignments + LOCKCH==0 ; LOCK device channel for inbox locking + NETD==1 ; Net data channel for ICP and MLFL + NETI==2 ; Net input (telnet) channel + NETO==3 ; Net output(telnet) channel + DKIC==4 ; Disk input + DKOC==5 ; Disk output + SC==6 ; Stats disk output + DMPCH==7 ; Disk output channel for pdump'ing self. + CLIC==10 ; CORE link channel (output only). + ERRCHN==11 ; ERR device channel. + USRI==12 ; Inferior input. + USRO==13 ; Inferior output. + DBC==14 ; Debugging output channel. + LSR1C==15 ; Channel open to LSR1 file. + DQCH==16 ; Channel to DQ: resolver device + +;; UUO "channels" + TMPC==17 ; Temporary UUO chan for short jobs. + ; Is theoreticly a UUO channel only, but in fact + ; is used as a real channel in a few places, sigh. + + SAOCH==20 ; Another UUO channel for output into String LN's. + ; (That's right, channel 20, so don't use elsewhere!) + ; Perhaps merge the two, or better yet introduce + ; DEFCHN, DEFCHX macros?? (Latter for #'s > 17) + + ;LH flag vars +;==1 +;==2 +%QULOS==200 ; Set when flushing messages for bad host from queue +%PGMRN==400 ; Set while running inferior job. +%INCLI==1000 ; Set when inside CLISND (realt flag) +%MSTMD==2000 ; Set when MASTER modified. +%LSRIN==4000 ; Set when LSR full-name data mapped into core. +%SCOPN==10000 ; Set when SC channel open +%MSGMD==20000 ; Set when current MSG-LSE modified +%QMLMD==40000 ; Set when QML modified. +%SCHED==100000 ; Set when scheduler is sleeping; flag for REALT interrupt. +;==200000 ; +%RMLMD==400000 ; Set when RML modified. + + ; RH flag vars +%RBFH==1 +%RNOQC==2 ; in RSND50, indicates sender doesn't want queue-confirm. +%NETDV==4 ; Set by DEVCHK if device name is net-type +%RBHD==10 +%NOTEL==20 ; Used by NOTEW/NOTEL +;==40 +;==100 +%NDATO==200 ; Used by ntout to tell whether outputting on neto or netd +%DSKDV==400 ; Set by DEVCHK if device name is dsk-type +%NOCOM==1000 ; RCPPUT statistics output uses to help avoid extra commas +%TMP==2000 ; Temp flag for various stuffs. +;==4000 +%LMAPN==10000 ; Used by WRTMSG for 'append-msg' flag. +%MAPC==20000 ; To distinguish MAPCA/MAPCAR. +%BRKT==40000 ; LREADR when reading bracketed atom +%LRLIT==100000 ; " when reading quoted string or bracketed atom. +%IOCER==200000 ; Used by XCTIOC uuo +%ILOPR==400000 ; Used by XCTILO uuo + + ; .OPTION user variable bits that COMSAT needs. +%OPALL==%OPINT+%OPOPC+%OPLOK+%OPLKF + ; %OPINT gets new interrupt scheme, and + ; %OPOPC says set interrupted PC properly. + ; %OPLOK gets switch and lock hacking so that only one COMSAT + ; is ever active, and + ; %OPLKF says unlock locks if top-level fatal int. happens, + ; so a new COMSAT can be started to replace previous. + + ; First thing is purification macros... + PURPGB==3 ; Start pure on page 3, have lots of impure. +.INSRT KSC;IVORY > + + ; Define our own error handling macros for PAGSER library. + +DEFINE PAGSER"PSRERR ERRCOD + CALL [ PUSH P,U4 + MOVEI U4,ERRCOD + JSR PAGLUZ ] +TERMIN + +DEFINE PAGSER"CORLUZ + JSR CORLOS +TERMIN + + ; Time manipulating routines +DATIME"$$DSTB==1 ; DST bit in time words +DATIME"$$ABS==1 ; Absolute days/seconds conversions +DATIME"$$OUTT==1 ; Tables for pretty output +DATIME"$$UPTM==1 ; Rtns for system time-in-30'ths conversions +;DATIME"$$OUT==0 ; Don't need output rtns since OUT pkg has em +.INSRT DSK:SYSENG;DATIME > + + ; Routines for hacking hostnames table (formerly NETWRK stuff) +T==:U1 ; Alternate names for smashable ACs. +TT==:U2 ; This is mostly for NETWRK/RESOLV. +IFE U2-OC,.ERR RESOLV temp ACs lose!! + +$$DQ==1 ; Domain interface code in use (mostly for NETRTS) +$$DQRN==1 ; Use RENMWO hack to cut down on resolver overhead +;; These are IFNDEFs for now so that I can play with them without +;; editing the sources every time. +IFNDEF $$DQCH,$$DQCH==1 ; RESOLV is allowed to find Chaosnet addresses +IFNDEF $$DQIN,$$DQIN==1 ; RESOLV is allowed to find Internet addresses +;; $$DQIN should be turned off as soon as the NAMES > files etc can be +;; fixed to use "foo@bar" syntax for everything. +.INSRT SYSNET;RESOLV > + + ; UUO Handler and routines + +ULISTS==1 ; Assemble list hackery UUOS +USCALL==1 ; and special .CALL hackery (ugh) +UAREAS==1 ; Area-hacking UUOS too. +$$OUT==1 ; Ask for winning new OUT package!! +$$OUUO==0 ; Turn off old output UUOs!!! +$$OBUF==1 ; Ask OUT package for buffered-output option. +$$OERR==1 ; and for ERR output type. +$$OHST==1 ; and for host-name output frobs. +$$OTIM==1 ; and for time output items. +$$PDBG==1 ; Include debugging stuff for PAGSER. +$$CHMX==21 ; Need at least this many "channels" for OUT, sigh**2. +.INSRT DSK:KSC;NUUOS > + + ; LSR1 (INQUIR) database package +$$HSNM==1 ; Do assemble HSNAME cruft. +.INSRT DSK:SYSENG;LSRTNS > + +IFNDEF $.ARPA,$.ARPA==0 ; No longer use .ARPA kludge by default + +CONSTANTS ; Dump out any accumulated literals. + + ; Patch area and PDL hackery. +BVAR +PATLEN==100 +PAT: +PATCH: BLOCK PATLEN +PDLLEN==500. +PDL: BLOCK PDLLEN+1 + +JUNK: 0 ;for infinite-sink random writes, as in POP P,JUNK +EVAR + +POPBA1: POP P,B +POPAJ1: POP P,A +POPJ1: AOS (P) +APOPJ: RET + +PPCBAJ: POP P,C +POPBAJ: POP P,B +POPAJ: POP P,A +CPOPJ: RET + +POPDC1: AOSA -2(P) +POPCJ1: AOSA -1(P) +POPDCJ: POP P,D +POPCJ: POP P,C + RET + +PPDCBJ: POP P,D +POPCBJ: POP P,C +POPBJ: POP P,B + RET + +POPBJ1: POP P,B + AOS (P) + RET + + SUBTTL Main Calling Paths + +IFN 0,[ + +MAIN ;top level loop + IRQGET ;get and process an input request (e.g. from QMAIL) + SPCFND ;get all the specifications + IPATTR ;input one attribute (name plus argument as raw text) + PARRCP ;hairiest attribute parsing routine - for recipients + LREADR ;Lispish reader + APRCPT ;Process list structure after it has been read in + EQRCPL ;Recipient parsing routine (used also by NAMES file readin) + RCPEQV ;look up recipient in EQV list (NAMES file) + ;called here only to hack sender's NOQC option (weird) + HPARSE ;parse header if mail from foreign host + MAIL ;takes a message expressed as an LSE and mails it off + RCPEXP ;Expand recipient list (doing eqvs and so forth) + RCPPUT ;Process one rcpt and his attribute list + RCPE ;See if rcpt with same name already on list + RCPOPT ;Get rcpt's options from NAMES file + RCPEQV ;look up rcpt in EQV list (NAMES file) + RXPNAM ;Expand local name not on EQV list (look in INQUIR and so forth) + RXPBUG ;Expand BUG-type rcpt not on EQV list + RXPAFL ;Expand @FILE-type rcpt + RCPEXT ;Shove expansions into the rcpt-list of the message + RCPPUT ;Recursively called here + RCPSRT ;Once all rcpts have been found, sort and remove duplicates + HEADER ;Format the necessary headers + RCPSND ;Send message to all recipients + SNDMSG ;Send message to one recipient + SNDNET ;send over the net + SNDFIL ;simply send to a file + WRTMSG ;actually writes into mail files + SNDBUL ;send to a .MSGS. file + WRTMSG ;write it + SNDNAM ;send to local user + WRTMSG ;actually writes into mail files + SNDPGM ;send to a program (run in inferior) + MAIL ;calls MAIL recursively to report program lossage + MAIL ;calls MAIL recursively if permanent error + QUEUE ;if temporary error, queue the message + REMSND ;send a reminder + MAIL ;calls MAIL to actually send the stuff + QUESND ;try again to send queued messages to a particular host + QSTSND ;subroutine to send one queued message + SNDMSG ;as above + NOTEW ;send positive acknowledge + MAIL + NOTEL ;send negative acknowledge + MAIL +];IFN 0 + SUBTTL Attribute Definitions + +; Macro to define attributes: +; ATTRIB ,:,, + +DEFINE ATTRIB COD,SYMC,*NAME*,IRTN +IF1 [IRPS SYM,,[SYMC] + SYM==COD + TERMIN +IFGE COD-ATRLIM,.ERR Attribute code too large! +IRP N,,[102,103,104] ; List of unused codes. +IFE N-COD,.ERR Using "unused" attribute?! +TERMIN +IFE N,.ERR Using attribute 0?! +] +%%S==. +LOC ATTRTB+COD ? ASCNT [NAME] +LOC ATTRIR+COD ? IRTN +LOC %%S +TERMIN + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ATTRIBUTE DEFINITIONS +;;; +;;; Attributes declared are all "internal" unless an input routine +;;; exists for them. Flags can be stored in the LH of ATTRIR if this +;;; later proves desirable. See doc file for more info. To add an +;;; attribute, first check the list of Unused Codes in the ATTRIB +;;; macro definition to see if there's one to assign. If none, +;;; increment the ATRLIM definition and use its old value. 0 should +;;; never be used as a code!! +;;; +;;; Some of these attributes have read-in dispatch entries for the NAMES file, +;;; and others for "ATTRIBUTE:" in IRQ files. + +ATRLIM==110 ; Current limit for attrib codes. All must be less than this!! + +A$==,,-1 ; For bit-typeout mode +ATTRTB: BLOCK ATRLIM ; Table indexed by , holds ASCNT ptr to name. +ATTRIR: BLOCK ATRLIM ; Table to hold routine addr for xct'ing on input. + + ; General Purpose Attributes +ATTRIB 1,A$ATTR:,|ATTRIBUTE| ; S Name of attribute for succeeding A$AVAL (if any) +ATTRIB 2,A$AVAL:,|ATTRIBVAL| ; * Holds value for preceding A$ATTR +ATTRIB 3,A$XATR:,|X-ATTRIBUTE| ; S Like A$ATTR but used for Net-header attribs. +ATTRIB 4,A$XVAL:,|X-ATTRIBVAL| ; * Like A$AVAL. +ATTRIB 5,A$PREQ:,|SPECIAL-REQ|, APQTL ; L Indicates special (non-mail) processing. +;ATTRIB 6,A$PARG:,|SPECIAL-ARG|, APLST ; L Holds list of args for A$PREQ. + + ; Message Attributes +ATTRIB 10,A$ID:, |MESSAGE-ID| ; S Message ID for message. +ATTRIB 11,A$SNM:, |SENDER|, APSTR ; S sender's name +ATTRIB 12,A$CSN:, |SENT-BY|, APSTR ; S sender's claimed-to-be name. +ATTRIB 107,A$FFM:, |FAKE-FROM|, APSTR ; S sender's name for "From" +ATTRIB 100,A$SNH:,|SENDER-HOST| ; V sender's host (for net mail) +ATTRIB 105,A$SRTP:,|RETURN-PATH|,APSTR ; S SMTP return path spec + ;; this used to be called MAINT-PATH, hence the odd name +ATTRIB 106,A$SMRP:,|ERRORS-TO|,APSTR ; S sender's error return path +ATTRIB 13,A$MTXT:,|TEXT|, APSTR ; S input message-text +ATTRIB 7, A$MTXF:,|TEXT-FLAG| ; V flag saying if ^_ or crlf.crlf in message. +ATTRIB 14,A$MHDR:,|HEADER| ; S Header for message. +ATTRIB 15,A$KHDR:,|KLUDGE-HEADER| ; S Kludge to prevent ITS headers from going out +ATTRIB 16,A$NMH:, |NET-MAIL-HOST| ; V Host # origin of network-input. +ATTRIB 17,A$SBJ:, |SUBJECT|, APSTR ; S Subject if any +ATTRIB 20,A$TIM:, |DATE| ; V Time msg created on dsk +ATTRIB 101,A$UHDR:,|USER-HEADER|,APSTR ; S User-specified header line. +ATTRIB 21,A$HFRC:,|HEADER-FORCE|,APSTR ; S Type of header force if any +ATTRIB 22,A$RLN:, |RCPT-LIST-NAME|,APSTR; S Rcpt list name for "To": +ATTRIB 23,A$XPIR:,|EXPIRES|, APNUM ; V # days until this MSG expires +ATTRIB 24,A$MFN1:,|MSG-FN1|, AP6W ; V Sixbit FN1 for type *MSG. +ATTRIB 25,A$MFN2:,|MSG-FN2|, AP6W ; V Sixbit FN2 for *MSG. +ATTRIB 26,A$CNF:, |CONFIRMATION|,APSTR ; S Confirmation option (ALL, or FAIL only) +ATTRIB 36,A$IDRM:,|ID-REMINDER| ; S Holds ID of parent, when msg generated from reminder +ATTRIB 30,A$TEXP:,|REM-EXPIRES|,APNUM ; V Time or count for Reminder expiration +ATTRIB 31,A$TNXT:,|REM-NEXT|, APNUM ; V Abs time for very next sending of this reminder. +ATTRIB 32,A$TLST:,|REM-SPEC-LIST|,APLST ; L Holds list for 1 reminder time specification. + + ; Remind-time Attributes, stored under a REM-SPEC-LIST. +ATTRIB 33,A$TBAS:,|REM-TIME-BASE|,APNUM ; V Holds time base to start from (optional) +ATTRIB 34,A$TINC:,|REM-TIME-INC|,APNUM ; V Holds repeat-increment specifications. +ATTRIB 35,A$TSPC:,|REM-TIME-SPEC|,APNUM ; V Holds date/time repeat specifications. + + + ; Message Attributes - Recipient nodes +ATTRIB 54,A$RCP:, |RCPT-LIST| ; L Holds active RCPT attribs. +ATTRIB 55,A$RCPF:,|RCPT-LIST-FAIL| ; L ditto but marks as failed. +ATTRIB 56,A$RSNT:,|RCPT-LIST-SENT| ; L ditto but marks as sent. +ATTRIB 27,A$RDON:,|RCPT-LIST-DONE| ; L ditto but marks "done", inactive. + + ; Recipient Attributes +ATTRIB 40,A$RTYP:,|R-TYPE|, APSTR ; S Type of recipient (BUG, PGM, etc) +ATTRIB 41,A$RHST:,|R-HOST|, APHST ; V Destination host # for rcpt +ATTRIB 42,A$RNAM:,|R-NAME|, APSTR ; S Name of rcpt +ATTRIB 43,A$RPSN:,|R-PSEUDO| ; V Existence indicates rcp name is psuedo. +ATTRIB 37,A$RHDR:,|R-HEADER| ; S Rcpt's very own header. +ATTRIB 57,A$RHFC:,|R-HEADER-FORCE|,APSTR; S Header force, for this rcpt. +ATTRIB 44,A$RRES:,|R-RESULT| ; S Result of SNDMSG (failed, queue, sent) +ATTRIB 45,A$RRMG:,|R-RESULT-MSG| ; S Err msg if A$RRES==failed. +ATTRIB 74,A$RFCT:,|R-FAILURE-COUNT| ; V Number of times tried to send and lost +ATTRIB 47,A$RMDS:,|R-MODE-SEND|,APNUM ; V Sending mode (see comments for SENDSW, MAILSW) +ATTRIB 50,A$RMDM:,|R-MODE-MAIL|,APNUM ; V Mailing mode +ATTRIB 51,A$RPMR:,|R-PGM-MNTNR|,APRCPT ; L If type = PGM, specifies maintainer to notify. +ATTRIB 67,A$RPGD:,|R-PGM-DISOWN|,APNUM ; V If type = PGM, control bits for job. +ATTRIB 73,A$RPGU:,|R-PGM-USET|, AP2NUM ; L List holds two values, .USET sym and value. +ATTRIB 52,A$ROPT:,|R-OPTION|, APSTRS ; S Recipient Option name +ATTRIB 53,A$RNK:, |R-NOT-KNOWN| ; V Existence means rcpt not known. +ATTRIB 46,A$RHSN:,|R-HSNAME| ; V Holds 6bit HSNAME of local rcpt without a dir. + + ; Attribs for Scheduler List. +ATTRIB 60,A$S:, |SCHED-ITEM-LIST| ; L List holding schedule requests +ATTRIB 61,A$STIM:,|SCHED-TIME| ; V System time at which to execute. +ATTRIB 62,A$SRTN:,|SCHED-RTN| ; V Routine to execute. +ATTRIB 63,A$SARG:,|SCHED-ARG| ; V Argument for routine. + + ; Attribs for Master List. +ATTRIB 64,A$I:, |MASTER-ITEM-LIST| ; L List holding Message-ID/Disk addr correspondence. +ATTRIB 65,A$IDAD:,|DISK-ADDR| ; V Disk addr of LSE for this message. +ATTRIB 66,A$IDBL:,|DISK-LENGTH| ; V Length of its LSE on disk. + + ; Attribs for Queued Message List. +ATTRIB 70,A$Q:, |QUEUE-SITE-LIST| ; L List holding Site/Message-ID correspondence. +ATTRIB 76,A$QFL:, |QUEUE-FINALIZE-LIST| ; L List holding ID's to finalize. +ATTRIB 71,A$QHST:,|QUEUE-SITE| ; V Site # which following ID's are queued for. +ATTRIB 77,A$QFCT:,|QUEUE-FAILURE-CNT| ; V # times this site failed. + + ; Attribs for Reminder Message List. +ATTRIB 75,A$T:, |REMINDER-LIST| ; L Entry on the RML. + + ; Attribs for EQV list +ATTRIB 72,A$E:, |EQV-LIST|, APEQVL ; L Equivalence list for recipient. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; IARCOD - Given SLP in A to uppercase string, checks to see if it +; matches a non-internal attribute name, and if so skips with +; internal code in RH(B). + +IARCOD: MOVSI B,-ATRLIM + SKIPE ATTRIR(B) ; Skip if internal name (a no-no) + SLNEA A,ATTRTB(B) ; This one is OK, does name match? + AOBJN B,.-2 + CAIGE B,0 ; Don't skipret if counted out. + AOS (P) + RET + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ; Table of known recipient types. +RTYPTB: ASCNT [BUG] + ASCNT [FILE] + ASCNT [NAME] + ASCNT [PGM] + ASCNT [*MSG] + ASCNT [@FILE] +NRTYPS==:.-RTYPTB + + ; Table of sending routines to dispatch on, corresponding to RTYPTB. +SNDRTB: SNDBUG + SNDFIL + SNDNAM + SNDPGM + SNDBUL + SNDAFL +IFN NRTYPS-<.-SNDRTB>,.ERR SNDRTB loses + + ; Message-Result definitions + ; These values are returned by certain routines such as SNDMSG + ; responsible for sending a message. Note that all temporary + ; errors are even (low bit zero), and permanent errors are odd. + ; When an error message is furnished, it should not begin or + ; end with a CRLF; if a CRLF is embedded, a tab should follow it. + ; This is just for prettiness when string is put into a receipt msg. + +MR$WIN==:0 ; Message won, sent to rcpt. This is the only return + ; which is NOT expected to furnish some sort of err msg. + +MR$PER==:1 ; Perm Err for Rcpt. This rcpt failed forever, but + ; can keep trying site for other rcpts. + ; This is most often the result of a 450 reply from remote + ; host, but might also result from rare local errors. + +MR$TER==:2 ; Temp Err for Rcpt, must queue. Can keep trying site for + ; other rcpts. + ; This return happens for such things as "dir full" (local) + ; or "mailbox busy", "job cap exceeded", etc. (remote) + +MR$PEH==:3 ; Perm Err for Host; this host failed forever. + ; Should never happen for local site (!). Will happen for + ; remote sites which have been getting MR$TEH's for too long. + ; Can also be generated "by hand" to flush a queue. + +MR$TEH==:4 ; Temp err for Host; don't bother trying site further at + ; moment. This return can happen if disk space gronked + ; (local) or remote host dies during sending (IOC error, + ; timeout, failed ICP, etc.) + +MR$MAX==:4 ; Max possible MR$ value +MR$TAB==:MR$MAX+1 ; For checking dispatch tables. + +comment | +MR$TEM ? - Temp Err for Msg; implies some temporary error associated with + the message itself, rather than with the host or a specific rcpt. + This might possibly happen for weirdness in a message such as + ^C's or the like, but that is supposed to be circumvented + by MLFL or quoting. May happen for overly long msg text, + if a remote site has a very low length tolerance; in this case + we won't want to keep re-trying for every rcpt!! +MR$PEM ? - Perm Err for Msg; Ditto, but permanent. + Same mumblings as for MR$TEM. + +| + + +SUBTTL Various variables and standard filenames + +;; Hostname strings are 63 words (255. bytes) long, per RFC883. + +BVAR +DEBUG: -1 ;non-z means (mainly) to stop on errors instantly. +XVERS: -1 ; Version type - + ; 0 - Normal operational mailer + ; 1 - "New" mailer, operational but not completely tested. + ;-1 - Experimental mailer, for debugging/development. +OWNHST: 0 ;Our own host address on the network we're really connected to. +OWNHS2: 0 ;Alternate host address to consider local .SEE TCPGAT + ;With domains, we always need this if we are dual-net. Foo. +MYUIND: -1 ;COMSAT's user index, used by SUNAME + +OWNNAM: BLOCK 63 ;holds asciz string which is name of own site +GATNAM: BLOCK 63 ;holds asciz string which is name of TCP relay host +TMPNAM: BLOCK 63 ;holds asciz string which is name of random host + +PRGNAM: .FNAM1 ; FN1, FN2 of source file assembled from. +VERSHN: .FNAM2 + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ; Names for mail directory files + +; SATF "",, - specifies a SIXBIT filename +; which varies depending on whether COMSAT is running as +; the normal, experimental, or new-operational mailer. + +NSTFLS==0 +DEFINE SATF &NORM&,XPER,NEW +%%SLOC==. +IF1 ? [SIXBIT |XPER|],,[SIXBIT |NEW|] ; Goddam constants lossage +IF2 [ SIXBIT NORM + TMPLOC XVARTB+NSTFLS,{%%SLOC,,[SIXBIT |XPER|]} + TMPLOC NXVRTB+NSTFLS,{%%SLOC,,[SIXBIT |NEW|]} +] +NSTFLS==NSTFLS+1 +TERMIN + +SATDEV: SIXBIT /DSK/ ; Satellite Device +SATDIR: SIXBIT /.MAIL./ ; Satellite Directory + ; Directory is .BULK. for bulk mailer + +MSTFN1: SATF " LIST",XLIST,NLIST ; MASTER LSE file +MSTFN2: SIXBIT /MASTER/ +NMSFN1: SATF " LIST",XLIST,NLIST ; FNM to use when GC'ing MSGS. + SIXBIT /NMASTR/ + +QMLFN1: SATF " LIST",XLIST,NLIST ; QML LSE file. +QMLFN2: SIXBIT / QUEUE/ + +RMLFN1: SATF " LIST",XLIST,NLIST ; RML LSE file. +RMLFN2: SIXBIT /REMIND/ + +MSGFN1: SATF " LISTS",XLIST,NLIST ; File of MSG LSEs. +MSGFN2: SIXBIT / MSGS/ +NMGFN1: SATF " LISTS",XLIST,NLIST ; FNM to use when GC'ing MSGS. + SIXBIT / NMSGS/ + +EQAFN1: SATF "NAMES",XNAMES,NNAMES ; ASCII name equivalence/options file +EQAFN2: SIXBIT />/ +EQAFR1: 0 ; Used to hold real translated filenames. +EQAFR2: 0 + +EQRFIL:: ; Holds file blk for compilation-report file. +EQRDEV: 0 +EQRDIR: 0 +EQRFN1: SATF "NAMED",XNAMED,NNAMED +EQRFN2: 0 + +EQVFN1: SATF " LIST",XLIST,NLIST ; Binary name equivalence/options file. +EQVFN2: SIXBIT / EQV/ + +LSRFN1: SIXBIT / FROM/ ; Indicator file left by INQUIR, fresh +LSRFN2: SIXBIT /INQUIR/ ; file means fresh LSR waiting to be gobbled. + +HSTDEV: SIXBIT /DSK/ ; File name of the host tables. + SIXBIT /SYSBIN/ + SIXBIT /HOSTS3/ + SIXBIT />/ + +IRQFN1: SATF "MAIL",XMAIL,NMAIL ; Filename of mail requests. +IRQFN2: SIXBIT // ; note FILO sequence! +IREFN1: SATF "BADREQ",XBADRQ,NBADRQ ; Erroneous input reqs renamed to this. +IREFN2: SIXBIT />/ + +IRRFIL: 0 ? 0 ; Used by RFNAME call to find true input-req FN. +IRRFN1: 0 +IRRFN2: 0 + +IDFN1: SATF " ID",XID,NID ; Name used to obtain unique Message-ID number. +IDFN2: SIXBIT />/ + + ; Names for statistics files +STFN1: SATF "STATS",XSTATS,NSTATS ; Name of actual stats file +STFN2: SIXBIT />/ +STOFN1: SATF "OSTATS",XOSTAT,NOSTAT ; Name for old stats files +STOFN2: SIXBIT />/ + + ; Names for locked switch file (to ensure uniqueness) +LCKFN1: SATF " LOCK",XLOCK,NLOCK +LCKFN2: SIXBIT /UNIQUE/ + +UNMPRF: SIXBIT /COMSAT/ ; Preferred UNAME +JNMPRF: SATF "IV",XPER,NEW ; " JNAME (major version #, sort of) + ; JNAME is BULK for bulk mailer +EVAR + + ; Table of vars to change when running in experimental mode! +XVARTB: BLOCK NSTFLS ; To hold sat filenames which change. + ; Can have other vars here in form + ; ,,[] +NXVARS==:.-XVARTB + + ; Vars to change when running in "New operational" mode! +NXVRTB: BLOCK NSTFLS ; To hold sat filenames which change. + ; Can have other vars here in form + ; ,,[] +NNXVRS==:.-NXVRTB + + +XVRSRT: SKIPN XVERS ; If normal, + RET ; don't change anything. + PUSHAE P,[A,B,C] + MOVE C,[-NXVARS,,XVARTB] + SKIPL XVERS ; Use XVARTB if experimental + MOVE C,[-NNXVRS,,NXVRTB] ; Else use "new operational" vars. +XVRSR1: MOVE A,(C) + HLRZ B,A + MOVE A,(A) ; Get xper. value to use + MOVEM A,(B) ; Store in indicated loc + AOBJN C,XVRSR1 + POPAE P,[C,B,A] + RET + +SUBTTL Initializations for bulk mailer kludge + +.scalar bootxj ; Original XJNAME (for RESET, ugh) + +bulkck: push p,a + .suset [.rxjname,,bootxj] + move a,bootxj + came a,[sixbit /VDNBRG/] + jrst popaj + move a,[sixbit /.BULK./] + movem a,satdir + move a,[sixbit /BULK/] + movem a,jnmprf + ;; need to break local delivery + jrst popaj + +SUBTTL Statistics file routines + + ; Macro to write stats with. (see SCOPN) + ; Generates a