From 075a54f85400a364258ece7e442288a32a29375e Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Sun, 18 Dec 2016 20:54:05 +0100 Subject: [PATCH] Add UNTALK source code. --- src/gren/_midas.2 | 60 +++++++++ src/gren/untalk.87 | 307 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 367 insertions(+) create mode 100755 src/gren/_midas.2 create mode 100755 src/gren/untalk.87 diff --git a/src/gren/_midas.2 b/src/gren/_midas.2 new file mode 100755 index 00000000..0fec6167 --- /dev/null +++ b/src/gren/_midas.2 @@ -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]; + .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, + + diff --git a/src/gren/untalk.87 b/src/gren/untalk.87 new file mode 100755 index 00000000..3ad9df45 --- /dev/null +++ b/src/gren/untalk.87 @@ -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 +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; +