PDP-10.its/src/gren/untalk.87

title UNTALK
; Split-screen comm-link program
.insrt Gren; .Midas >
comin=: 1
comout=: 2
char=: 3 ? ttyin=: 3
uname=: 4 ? ttyout=: 4
echoht=: 5 ? ttyech=: 5
textht=: 6 ? ttybao=: 6
width=: 7
echohp=:10
texthp=:11
textvp=:12
bp1=:13
bp2=:14
xchar=:15
rchar=:16
 
untalk: loc 42;
jsr tsint;
loc untalk;
.break 12, [5,,uname]; fetch JCL
move bp2, [440700,,uname]; initialize byte pointers
move bp1, [440600,,uname];
movei 6; only need first six chars
justif: ildb char, bp2;
caige char, 40; entire JCL is spaces and control chars?
.value [asciz /:(Syntax is :UNTALK USER) :KILL /];
cain char, 40; flush leading spaces of JCL
jrst justif;
convrt: cail char, 100; convert ascii to sixbit
andi char, 37;
xori char, 40;
idpb char, bp1;
sojle inull;
ildb char, bp2;
caile char, 40;
jrst convrt;
inull: clear char,
pad: idpb char, bp1; pad uname with spaces
sojg pad;
.open ttyout, [<.uad %tjmor %tjctn>,,'tty];
.lose 1400;
.open ttyech, [<.uad %tjmor %tjctn %tjpp2>,,'tty];
.lose 1400;
.open ttybao, [<.bad %tjmor %tjctn>,,'tty];
.lose 1400;
.open ttyin, [<.uii %tinwt>,,'tty];
.lose 1400;
.call [setz? 'cnsget;
argi ttyin;
val echoht;
val width ((setz))];
.lose 1400;
move textht, echoht;
lsh echoht, -1;
sos echoht;
sos width;
sub textht, echoht;
sos echoht;
sos textht;
.call [setz? sixbit /scml/; set echo area to one line less
argi ttyin; than half the screen height
arg echoht ((setz))];
.lose 1400;
move [-1,,[ascic /TC/]]; clear screen
.iot ttybao,
.iot ttyech, [^P];
.iot ttyech, ["T]; home up
.iot ttyech, [">];
.iot ttyech, [" ];
move bp1, b.init;
jsr listen;
.call usrcom; Is there already an UNTALK to talk with?
tlna;
jrst success; Yes!
.call clihac; No, better ask user to link.
jrst [.call usrhac;
.value [asciz /:(User not logged in)  :KILL /];
.value [asciz /:(User not accepting messages)  :KILL /]];
move [-10.,,[ascic /(You can type while we wait, it will be buffered)/]];
.iot ttybao,
move [-13.,,[ascic /Comm link requested. To accept, type :UNTALK <user>
at DDT./]];
.iot comout,
.close comout,
wait: jsr listen; Let user type while we wait for other
movei 20; UNTALK to appear
.sleep;
.call usrcom;
jrst wait;
success: move [-7,,[ascic /TL(Connection established)
> /]];
.iot ttybao,
.suset [.simas,,[%picli]]; Enable core-link interrupts
comm: jsr listen; Here we are in the main loop
came bp1, b.init; Buffer empty?
.call clicom; No, let's try to send it
jrst exist; Either buffer empty or CLI open failed,
clear xchar,; which does seem to happen a lot.
idpb xchar, bp1; Pad end of message with null
movei xchar, ^C; and EOFs
repeat 5, idpb xchar, bp1;
hrlzi comout, -ttybuf(bp1); Prepare AOBJN pointer to message.
movei bp1, ttybuf;
subm bp1, comout;
hrli bp1, 440700; Reset buffer pointer
.iot comout, comout; Send whatever we have
.close comout,
jrst comm; And go back for more of the same
exist: .call usrcom;
jrst endcom;
.uset comout, [.rustp,,]; UNTALK exists, but is it running?
jumpe [ skipn flag;
jrst doubt;
move [-7,,[ascic /STL(Communication resumed)R/]];
.iot ttybao,
clearm flag;
jrst comm];
skipe flag;
jrst doubt;
move [-13.,,[ascic /STL(Other UNTALK exists but not running; probably ^Zed)R/]];
.iot ttybao,
setom flag;
doubt: .close comout,
.call usrhac; UNTALK exists but HACTRN doesn't?
jrst [ move [-5,,[ascic /TL(User detached) /]];
.iot ttybao,
suicide];
.close comout,
movei 20; Let's take a little nap
.sleep;
jrst comm; All rested now, let's do it again
listen: 0; Good old-fashioned, non-reentrant, stackless subroutine
hrrei -ttybuf-140(bp1); Buffer overflow?
jumpge [.iot ttyech, [^G]; then forget it!
jrst @listen];
.iot ttyin, xchar;
jumpl xchar, @listen; Negative char means no char at all
cain xchar, ^C;
jrst endcom;
caig xchar, ^C;
jrst listen+1;
idpb xchar, bp1; Buffer it
.call getpos;
.lose 1400;
hrrzs echohp;
cain xchar, 177; Rubout?
jrst [ caig echohp, 2; Yes, but anything to rub out?
jrst listen+1;
.iot ttyech, [^P]; Yes, erase backwards
.iot ttyech, ["X];
jrst listen+1];
cain xchar, ^M;
jrst enewln;
cain xchar, ^H;
jrst [ caig echohp, 2;
jrst listen+1;
jrst echo];
cain xchar, ^U; Kill current line, like QMAIL
jrst [.iot ttyech, [^P];
.iot ttyech, ["H];
.iot ttyech, [12];
.iot ttyech, [^P];
.iot ttyech, ["L];
jrst listen+1];
cain xchar, ^P; Don't let turkey type cursor commands
jrst [.iot ttyech, [^P];
.iot ttyech, ["P];
jrst listen+1];
cain xchar, 40;
jrst [ hrrei xchar, -6(width);
camg xchar, echohp;
jrst ecrsup;
.iot ttyech, [40];
jrst listen+1];
camg width, echohp;
jrst erunov;
cain xchar, ^J;
jrst listen+1;
setom crecct;
echo: .iot ttyech, xchar;
jrst listen+1;
erunov: .iot ttyech, xchar;
.iot ttyech, ["-];
ecrsup: sos crecct;
jrst crecpt;
enewln: skipg crecct;
aosge crecct;
jrst listen;
crecpt: .iot ttyech, [^P];
.iot ttyech, ["H];
.iot ttyech, [10];
.iot ttyech, [^P];
.iot ttyech, ["K];
.iot ttyech, [" ]; for terminals without character erase
.iot ttyech, [^P];
.iot ttyech, ["A];
.iot ttyech, [">];
.iot ttyech, [" ];
jrst listen+1;
 
endcom: move [-5,,[ascic /TL(Connection closed) /]];
.iot ttybao,
suicide;
 
crecct: -1; Carriage return count to suppress more than two
crtxct: -1;
flag: 0;
b.init: 440700,,ttybuf;
ttybuf: block 141; input buffer while waiting for CLI open to succeed
combuf: block 143; output buffer to read CLA file into
 
tsint=.-2; Aha!! We have CLI to handle!
 
.open comin, [.bii,,'cla]; Answer the interrupt
.dismi tsint+1; Hey! You lied to me
move comin, [-140,,combuf]; Don't know how much there is,
.iot comin, comin; so read all of it
.close comin,
move bp2, [440700,,combuf+2]; 1st 2 words contain UNAME-JNAME
print: ildb rchar, bp2;
caig rchar, ^C; Don't display EOFs or nulls or those
.dismi tsint+1; funny ^As that seem to get in there
.call getpos;
.lose 1400;
hlrz textvp, texthp;
hrrzs texthp;
cain rchar, ^M;
jrst newlin;
cain rchar, 177; Have to handle rubout at this end, too
jrst [ caig texthp, 2;
jrst print;
.iot ttyout, [^P];
.iot ttyout, ["X];
jrst print];
cain rchar, ^H;
jrst [ caig texthp, 2;
jrst print;
jrst display];
cain rchar, ^U; Kill current line, like QMAIL
L/]];rst [ move rchar, [-1,,[ascii /H
.iot ttybao, rchar;
jrst print];
cain rchar, ^P; Don't let turkey type cursor commands
jrst [.iot ttyout, [^P];
.iot ttyout, ["P];
jrst print];
cain rchar, 40;
jrst [ cail texthp, -6(width);
jrst crsup;
jrst display];
camg width, texthp;
jrst runovr;
cain rchar, ^J;
jrst print;
setom crtxct;
display: .iot ttyout, rchar;
jrst print;
runovr: .iot ttyout, rchar;
.iot ttyout, ["-];
crsup: sos crtxct;
jrst crtxpt;
newlin: skipg crtxct;
aosge crtxct;
jrst print;
crtxpt: move rchar, [-2,,[ascic /K /]];
.iot ttybao, rchar;
camg textht, textvp;
jrst [ move rchar, [-4,,[ascic /AL======TDL> /]];
.iot ttybao, rchar;
jrst print];
move rchar, [-1,,[ascic /A> /]];
.iot ttybao, rchar;
jrst print;
 
clicom: setz? sixbit /open/;
cbitsi .bio;
argi comout;
arg ['cli,,];
arg uname;
arg ['untalk] ((setz));
clihac: setz? sixbit /open/;
cbitsi .bao;
argi comout;
arg ['cli,,];
arg uname;
arg ['hactrn] ((setz));
usrcom: setz? sixbit /open/;
cbitsi 14;
argi comout;
arg ['usr,,];
arg uname;
arg ['untalk] ((setz));
usrhac: setz? sixbit /open/;
cbitsi 14;
argi comout;
arg ['usr,,];
arg uname;
arg ['hactrn] ((setz));
getpos: setz? sixbit /rcpos/;
argi ttyout;
val texthp;
val echohp ((setz));
 
end untalk;