mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 21:01:16 +00:00
Add UNTALK source code.
This commit is contained in:
Lars Brinkhoff
committed by
Eric Swenson
Eric Swenson
parent
fb9d299939
commit
075a54f854
60
src/gren/_midas.2
Executable file
60
src/gren/_midas.2
Executable file
@@ -0,0 +1,60 @@
|
||||
;;;; Handy-dandy Midas macros and definitions ;;;;;;;;;;;;;;; The Uncola
|
||||
|
||||
arg==:0 ? .uso=:.uio %tjsio
|
||||
argi=:1000,, ? .bso=:.bio %tjsio
|
||||
val=:2000,, ? .uad=:.uao %tjdis
|
||||
errcod=:3000,, ? .bad=:.bao %tjdis
|
||||
cbits=:4000,, ? .uid=:.uio %tjdis
|
||||
cbitsi=:5000,, ? .bid=:.bio %tjdis
|
||||
|
||||
define syscal name, p0, p1, p2, p3, p4, p5, p6, p7, p10, p11, p12, p13, p14;
|
||||
.call [setz;
|
||||
sixbit name;
|
||||
ifsn [][p0][?p0] ifsn [][p1][?p1] ifsn [][p2][?p2] ifsn [][p3][?p3] ifsn [][p4][?p4] ifsn [][p5][?p5] ifsn [][p6][?p6] ifsn [][p7][?p7] ifsn [][p10][?p10] ifsn [][p11][?p11] ifsn [][p12][?p12] ifsn [][p13][?p13] ifsn [][p14][?p14]((setz))]
|
||||
|
||||
termin
|
||||
|
||||
define salloc length; allocate stack
|
||||
|
||||
ifdef stklen,[ifg <stklen-length>, stklen=length];
|
||||
.else [ .m"stklen=length;
|
||||
.m"sp=:17;
|
||||
.m"call=:pushj sp,
|
||||
.m"return=:popj sp,
|
||||
.m"save=:push sp,
|
||||
.m"restor=:pop sp,
|
||||
.m"jstf=:jumpge sp,; jump if stack full
|
||||
.m"jstnf=:jumpl sp,; jump if stack not full
|
||||
.m"stemp=:camg sp, stack; skip if stack fully popped
|
||||
.m"stnemp=:camle sp, stack; skip if stack not fully popped
|
||||
|
||||
define .m"callno sraddr, eraddr; if stack ovrflw would occur
|
||||
jstnf .+2; then
|
||||
call eraddr; jump to error handler
|
||||
call sraddr; else call subroutine
|
||||
termin
|
||||
|
||||
define .m"retno; return if no stack overpop will occur
|
||||
stemp; else execution drops through
|
||||
return;
|
||||
termin
|
||||
|
||||
define .m"saveno value, eraddr; if stack overflow would occur
|
||||
jstnf .+2; then
|
||||
call eraddr; jump to error handler
|
||||
save value; else push
|
||||
termin
|
||||
|
||||
define .m"restno value, eraddr; pop if stack not empty
|
||||
stnemp;
|
||||
call eraddr;
|
||||
restor value;
|
||||
termin
|
||||
|
||||
move sp, stack ];
|
||||
|
||||
termin
|
||||
|
||||
suicide=:.logout 1,
|
||||
|
||||
|
||||
307
src/gren/untalk.87
Executable file
307
src/gren/untalk.87
Executable file
@@ -0,0 +1,307 @@
|
||||
title UNTALK
|
||||
; Split-screen comm-link program
|
||||
.insrt mc: Uncola; .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
|
||||
jrst [ move rchar, [-1,,[ascii /H
|
||||
L/]];
|
||||
.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 /HK /]];
|
||||
.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;
|
||||
Reference in New Issue
Block a user