diff --git a/build/basics.tcl b/build/basics.tcl index 0ecfd8ab..07d8d281 100644 --- a/build/basics.tcl +++ b/build/basics.tcl @@ -275,6 +275,12 @@ respond "*" ":link sys2;ts n,sys;ts name\r" respond "*" ":link device;tcp syn117,sys;ts name\r" respond "*" ":link device;chaos name,sys;ts name\r" +# Name Dragon +respond "*" ":link syseng;tvkbd rooms, sysen2;\r" +type ":vk\r" +respond "*" ":midas sysbin;_sysen2;namdrg\r" +expect ":KILL" + respond "*" ":midas device;atsign mldev_sysen2;mldev\r" expect ":KILL" diff --git a/doc/programs.md b/doc/programs.md index 03058d98..c480e738 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -197,6 +197,7 @@ - MUDINQ, Muddle inquirer. - MUNCH, TV-munching square. - NAME, shows logged in users and locations, aka FINGER. +- NAMDRG, free TV display. - NETIME, network time dragon. - NETRFC, serve ARPANET connections. - NEWDEC, DECtape converter. diff --git a/src/channa/rakash.namdrg b/src/channa/rakash.namdrg new file mode 120000 index 00000000..c7fab0d3 --- /dev/null +++ b/src/channa/rakash.namdrg @@ -0,0 +1 @@ +sysbin/namdrg.bin \ No newline at end of file diff --git a/src/sysen2/namdrg.148 b/src/sysen2/namdrg.148 new file mode 100755 index 00000000..8dabdab7 --- /dev/null +++ b/src/sysen2/namdrg.148 @@ -0,0 +1,2139 @@ + +;-*-MIDAS-*- + +TITLE NAME DRAGON +versio==.fnam2 + +a=1 +b=2 +c=3 +d=4 +e=5 +t=6 +tt=7 + +l=10 +n=11 + f=l ;logout times stuff + g=n ;.. +v=12 ;uuo handler +w=13 +u=14 ;user index +i=15 ;random index +x=16 ;int old +p=17 ;pdl ptr + + +ls1c==1 ;channel for LSR1 file. +tyoc==2 ;terminal output channel +tybc==3 ;tty block output +dkic==4 ;channel for reading from disk +rlch==7 ;reload channel +ptch==12 ;picture channel +utyic==13 +utyoc==14 +usrich==15 ;opening up server telnets + +ubpfj==10 ;mode bit for USR open to prevent reowning + +;random byte pointers + +$opcod==331100 ;op code in instruction +$acfld==270400 ;accumulator field +$ixfld==220400 ;idx field + +$ercod==220600 ;error code for .status + +dmneli==10000 ;dmnbf type word indicating login +dmnelo==20000 ;dmnbf type word indicating logout + +ifndef maxdoz,maxdoz==5*60.*60. ;run at least every five minutes +ifndef nredis,nredis==30.*30. ;don't redisplay more often than 30 secs + +cior==16 + + +define syscal name,args + .call [ setz ? sixbit/name/ ? args ((setz))] +termin + +;the memory map for this crock + +;pages 0 - ; the program + +;pages usrpag - c(ls2lpg)-1 LSRTAB REF file and HOSTS2 file + +;pages c(ls2lpg) - hiporg-1; dynamically allocated space + +;pages hiporg - ; absolute its pages + +;pages tvporg - ; tv buffer pages + +;page ttlpag - TTLOC file + +itspgs==400000/2000 ;# ITS pages to map in +tvpgs==10 ;# pages in tv buffer (not including console reg) + +hiporg==400-itspgs-tvpgs-1 ;page # of a origin of high pages +abscor=hiporg*2000 +tvporg==hiporg+itspgs ;page # of origin of tv buffer + +tvorg==tvporg*2000 ;origin of tv buffer in our address space +tvend=*2000+1777 ;last wd in buffer: b/w bit and frame start # +ttlpag==400-1 + +;random facts about the pdp-11 + +ifndef tv11,tv11==0 ;# of pdp-11 hassling ttys +ifndef maxkbd,maxkbd==100 ;maximum # of keyboards +mapmsk==574377776000 ;$t; in ddt types out 10-11 interface map entry + +ifndef maxtty,maxtty==100 ;max # tty's we can handle. +ifndef nontty,nontty==40 ;max # lisp machines + +loc 41 + pushj p,uuoh +loc 70 +forty: 0 + jsr ilopr + -lintblk,,intblk + +loc 100 + +pat: patch": block 100 + +intblk: p ;our pdl ptr. + + %piioc ;ioc errors + 0 + -1#%pipdl#%pimpv ;defer everything but mpv and pdl + -1 + ioc + + %pipdl ;pdl overflow + 0 + -1#%pimpv ;defer everthing but mpv + -1 + pov + + %pimpv ;memory protect errors + 0 + -1 ;defer everthing + -1 + mpv + + %pirlt ;timer interrupt + 0 + %pirlt ;defer self and all i/o + -1 + timint ;timer comes last because it's asynchronous. + +lintblk=.-intblk + + +dmnbsz: 0 ;size (in words) of dmnbf +dmnbp: 0 ;our dmnbf ptr +logcnt: 0 ;our login-logout count +tcmxh: 0 ;line length of our tty. +tcmxv: 0 ;screen height of our tty. +nusers: 0 ;# of users we mentioned this time. +sysid: 0 ;holds current ITS version syms are good for +debug: 0 ;non-zero means run on user's tty instead of T52 +nlstty: 0 ;number of last sty-type tty (plus one). +nl11ty: 0 ;number of last tv tty (plus one). +kbdflg: 0 ;address in our address space of table in pdp11 + ;containing keyboard and tv numbers of the tv ttys. +beglen: 48. ;# of chars taken up by all but the "console location" field + +;define stuff needed to get system symbols +define syms list + irps sym,,[list] + squoze 0,sym +sym: 0 +termin +termin + + + ;abscor(u) +usrxtb: syms [uname:xuname:jname:ttytbl:utmptr:suppro:iochnm:] +lusrtb==.-usrxtb + + ;abscor(i) +ixtbl: syms [ttysts:stysts:ttytyp:ttitm:dmnbf:imsoc3:imsoc4:imphtn:] +lixtbl==.-ixtbl + + ;system addresss +sysadr: syms [time:shutdn:dmnbd:tt11p:] +lsysad==.-sysadr + + ;constant syms +cnstb: syms [nct:nfstty:nsttys:nf11ty:n11tys:lublk:impus:dmnsz:dmnbel:niochn:netdui:netdbo:] +lcnstb==.-cnstb + + +evaler: move e,(p) ;pick up two arguments + addi e,2 + exch e,(p) + move c,1(e) ;aobjn ptr to syms to define + move d,0(e) ;value to add into symbol's value +evalup: move b,(c) ;get squoze for sym + .eval b, ;get addr for it + tdza b,b ;undefined means make all zero + add b,d ;otherwise merge addr into it + aobjp c,evaldn + movem b,(c) ;store in right place + aobjn c,evalup ;back for all +evaldn: popj p, + +init: setz a, + .call [setz + sixbit /corblk/ + 0,,[%cbred,,0] + 0,,[-1] + 0,,[-itspgs,,hiporg] + 0,,[%jsabs] + 400000,,a] + .value 0 + pushj p,evaler + abscor(u) + -lusrtb,,usrxtb + pushj p,evaler + abscor(i) + -lixtbl,,ixtbl + pushj p,evaler + abscor + -lsysad,,sysadr + pushj p,evaler + 0 + -lcnstb,,cnstb + + move a,dmnsz ;size of demon buffer + imul a,dmnbel + movem a,dmnbsz + move a,nfstty ;want # of last sty + add a,nsttys + movem a,nlstty ;store it (note symbol not an its one) + move a,nf11ty ;ditto for pdp11 tv's + add a,n11tys + movem a,nl11ty ;store (note symbol not an its one) + move a,nct + caile a,maxtty + jsr die + pushj p,gttys + popj p, + +name: .close 1, ;close the channel we were loaded on + move p,[-lpdl,,pdl-1] + .suset [.roption,,a] + tlo a,%opint+%opliv+%opopc + .suset [.soption,,a] + move a,[squoze 0,nf11ty] + .eval a, + .value + caie a,52 + .value ;TTY # of console free display changed + .suset [.s40addr,,[forty]] + .suset [.roption,,a] + skipe debug + setz a, + tlne a,optddt + .value [asciz/5 /] ;manual start. + .suset [.smask,,[%pirlt+%piioc+%pipdl+%pimpv]] + skipn debug + jrst name1 + .open tyoc,[%tjmor+%tjctn+%tjdis+.uao,,'tty] ;Don't do continuation lines + .lose %lssys + .open tybc,[%tjmor+%tjctn+%tjdis+.bao,,'tty] + .value + jrst name2 + +name1: .open tyoc,[%tjmor+%tjctn+%tjdis+.uao,,'t52] ;char unit out, disp. mode, no continuation lns + .value + .open tybc,[%tjmor+%tjctn+%tjdis+.bao,,'t52] + .value +name2: .call [ setz ? 'cnsget ? 1000,,tyoc ? 2000,,tcmxv ? 2000,,tcmxh + 2000,,a ? 2000,,a ? setzm a] + .value + .call [setz ? 'sstatu ? repeat 5,[ ? 2000,,a ] ? setzm a] + jsr die + exch a,mname + .rsysi b, ;get version number of i.t.s. + exch b,sysid + camn a,mname + came b,sysid ;skip if same as the one syms were int'ld with + pushj p,init ;else must re-initialize + pushj p,LS2MAP ;map in LSR1 + pushj p,clrpts ;clear user name ptrs + skipl @tt11p ;wait for TV 11 to come up + .hang + pushj p,map11 + move a,@dmnbd ;find our initial dmnbf ptr + movem a,logcnt + idiv a,dmnsz + imul b,dmnbel + movem b,dmnbp + jrst lk1 + +;put all logged in users in our tables +lookup: move a,[400000,,[0]] + .realt a, ;stop the timer + jfcl + movei a,1.*30. + .sleep a, +lk1: move a,[440700,,screen] + movem a,sptr + hrlz i,nct ;length of its tty tables (# of ttys) + movn i,i ;as aobjn. + setz x, ;count of users to display + skipl @tt11p ;check if 11 has died + jrst 11upw ;it did, wait for it to be revived + +loklup: move u,@ttysts ;get status wd for this tty + setzm unmtab(i) + tlnn u,%tscns ;being used as a console? + jrst lokcnt ;no, disregard + hrres u ;flush lh + jumpl u,lokcnt + hrrz a,i ;get tty # + caml a,nfstty ;is it a psuedo? + caml a,nlstty + jrst gotdat ;we have all info in u + sub a,nfstty ;tis a sty...find sty # + exch i,a ;use i for sty index temporarily + move u,@stysts ;get sty info (i.e. who has this sty open) + exch a,i ;restore i + move a,@uname ;get uname and + move b,@jname ;jname of controlling procedure. + movem a,auxtb1(i) + movem b,auxtb2(i) + movem u,svrjob(i) + hrrei n,-1 ;if job isn't a server, n will have -1. + skipl @suppro ;to be a server, must be top level + jrst gotsvx + came b,['stelnt] ;and jname must be stelnt, netrfc, telser, or rfc + camn b,['netrfc] + jrst gotsv1 + hlrz a,b + caie a,'log + camn b,['telser] + jrst gotsv1 + jrst gotsvx + + ;hack network server - simply make i not be -1 +gotsv1: movei n,1 +gotsvx: movem n,ttytab(i) ;n has host number if server, else -1. + hrrz u,@ttysts ;restore u +gotdat: jumpe u,lokcnt ;don't mention system job. + move a,@utmptr ;record info in tables + move a,abscor(a) + movem a,jtmtab(i) + move a,@jname + movem a,jnmtab(i) + skipa a,u ;find idx no of top level job +gotda1: move u,b + skipl b,@suppro + jrst gotda1 ;loop till find -1, which means job is top level + move b,@uname ;get UNAME and XUNAME from top level job. + movem b,unmtab(i) + move b,@xuname + movem b,xuntab(i) + aos x ;count of users to display +lokcnt: aobjn i,loklup + +;falls through + +;drops in + +;Get data from Lisp machines. We use a Chaosnet simple-transaction with contact +;name FINGER. The first line of the response is the user ID, the second is +;the console location, the third is the idle time (as a string). + +;Look through the host table to find all the Lisp machines. +;Contact them eight at a time using all 16 I/O channels. +lmfing: .iopush tyoc, + .iopush tybc, + .iopush ls1c, + movsi a,-nontty ;Forget all Chaos net users +lmfng0: setzm unmtab+maxtty(a) + setzm lmfree(a) + aobjn a,lmfng0 + setz c, ;C has index into LMADRS. + movei b,hslmai +lmfin2: move a,b ;Each word of table is an ASCIZ string. Get address. + skipn (a) + jrst lmfin3 + push p,b + push p,c + pushj p,netwrk"hstlook ;Look it up as a host name. + setz a, + pop p,c + pop p,b + skipn a ;If we found one, + aoja b,lmfin2 + movem a,lmadrs(c) ;store it in LMADRS. + addi c,1 + caile c,nontty ;Complain if LMADRS gets full. + .value + aoja b,lmfin2 + +lmfin3: setzm nextlm + .rdtime t, ;Get starting time. Use at most 20 seconds for whole thing. + addi t,20.*30. + movem t,chstim' ;Time to stop + ;Now start 8 RFC's + movei a,16 +lmstr4: pushj p,lmrfc + subi a,2 + jumpge a,lmstr4 + ;Collect results +lmstr6: movei a,16 ;Scan all the channels +lmstr7: pushj p,chsin1 + subi a,2 + jumpge a,lmstr7 + movsi a,-8 ;See if any channels still active + skipge chsidx(a) + aobjn a,.-1 + jumpge a,lmstr9 + .rdtime t, ;Yes, timed-out anyway? + caml t,chstim + jrst lmstr9 + movei t,60. ;No, delay 2 seconds and try again + .sleep t, + jrst lmstr6 + +lmstr9: movsi a,-20 ;Close channels and return +lmstr8: .call [ setz ? sixbit/close/ ? setzi (a) ] + jfcl + aobjn a,lmstr8 + .iopop ls1c, + .iopop tybc, + .iopop tyoc, + jrst putout + + ;Lisp machines associated with AI. +hslmai: irps x,,lm1 lm2 lm3 lm4 lm5 lm6 lm7 lm8 lm9 lm15 lm16 lm18 lm19 lm20 lm22 lm23 + asciz /x/ + termin + 0 + +;Enter an RFC to next Lisp machine on channel in A. +;Uses AC's a,b,t,tt +lmrfc: move t,a ;mark channel free + lsh t,-1 + setom chsidx(t) + move tt,nextlm ;Find next machine + caige tt,nontty + skipn b,lmadrs(tt) + popj p, + aos nextlm + movem tt,chsidx(t) + .rdtime tt, + movem tt,chsstm(t) + dpb b,[$cpkda+lmpkt] ;send RFC to this guy + movei tt,%corfc + dpb tt,[$cpkop+lmpkt] + movei tt,.length/FINGER/ + dpb tt,[$cpknb+lmpkt] + move tt,[.byte 8 ? "F ? "I ? "N ? "G] + movem tt,%cpkdt+lmpkt + move tt,[.byte 8 ? "E ? "R] + movem tt,%cpkdt+1+lmpkt + .call [ setz ? 'CHAOSO ? movei (a) ? setzi 1(a) ] + jrst [ setom chsidx(t) ? popj p, ] ;probably device full + .call [ setz ? 'PKTIOT ? movei 1(a) ? setzi lmpkt ] + jsr die + popj p, ;pick up answer later + +;Call here to check status of channel-pair in a +chsin1: ;set c to index into lisp-machine tables + move tt,a + lsh tt,-1 + skipge c,chsidx(tt) + popj p, ;channel not in use + .call [ setz ? 'WHYINT ? movei (a) ? movem b ? movem b ? setzm b ] + jsr die + hlrzs b ;number of input packets + jumpe b,chsin9 ;none yet + .call [ setz ? 'PKTIOT ? movei (a) ? setzi lmpkt ] ;Get the packet + jsr die + ldb tt,[$cpkop+lmpkt] + caie tt,%coans + jrst lmrfc ;Some lossage, ignore this machine + ;First line is UNAME in ascii + move b,[440800,,%cpkdt+lmpkt] + movei d,0 + move tt,[440600,,d] +chsin2: ildb t,b + cain t,215 + jrst chsin3 + caige t,140 + subi t,40 + tlne tt,770000 + idpb t,tt + jrst chsin2 + +chsin3: movem d,unmtab+maxtty(c) + movem d,xuntab+maxtty(c) + push p,a + move a,lmadrs(c) ;Use name of machine as jname + pushj p,netwrk"hstsix + .value + movem a,jnmtab+maxtty(c) + pop p,a + ;Second line is console location in ascii + move e,lmdoc(c) + movei d,10*5-1 ;max characters +chsin4: ildb t,b + cain t,215 + jrst chsin5 + idpb t,e + sojg d,chsin4 + ildb t,b + caie t,215 + jrst .-2 +chsin5: movei t,0 ;make sure string is terminated + idpb t,e + ;Third line is idle time as a string + movei e,jtmtab+maxtty(c) + hrli e,440700 + setzm (e) ;make sure string is terminated + movei d,4 +chsin6: ildb t,b + cain t,215 + jrst chsin7 + idpb t,e + sojg d,chsin6 +chsin7: skipn unmtab+maxtty(c) ;anyone logged-in there? + setom lmfree(c) ;no, mark as free + jrst lmrfc ;find another guy + +chsin9: .rdtime t, + sub t,chsstm(tt) + caige t,4*30. + popj p, + jrst lmrfc ;timed out, give up on this guy + +;Clear the screen and print initial messages +putout: movsi i,-maxtty-nontty ;aobjn ptr to all ttys + iot tyoc,[asciz /C/] + move d,@shutdn ;get system var saying if/when sys is scheduled to die. + jumpl d,die2 + jumpe d,putou3 ;not scheduled to go down. + sub d,@time + idivi d,30. ;it is; d gets # seconds till then. + .rlpdt a, ;get # seconds from start of year to now. + add a,d ;get # seconds from start of year till sys goes down. + idivi a,24.*60.*60. ;remainder is # seconds since midnight. + iot [asciz /ITS GOING DOWN AT /] + prt b + iot [asciz/ +/] + pushj p,gdwnml + pushj p,pdwnml + skipa +putou3: setzm dwnmlp ;Not going down, discard any previous down mail pointer + jumpn x,putou1 ;possibility of no users... + iot tyoc,[asciz /No users +/] + jrst finish + +putou1: iot [asciz / +-User- -Full Name- Jobnam Idle TTY -Console Location- +/] + setzm nusers +ptolup: move a,xuntab(i) + skipn unmtab(i) ;don't mention a tty which has no logged in tree. + jrst ptocnt + aos nusers + pushj p,unmout ;print info about user (eg his name) + pushj p,jnmout ;just job name for now + pushj p,ttyout ;info about tty +ptocn9: chr [^M] ;new line + chr [^J] +ptocnt: aobjn i,ptolup + +finish: iot [asciz / +System up time = /] + move c,@time + idivi c,30. ;system up time in seconds + prh c + iot [asciz / Last updated at /] + .rlpdt c, + idivi c,24.*60.*60. + prt d + pushj p,xgpsts ;display xgp status + typi ^M ;followed by crlf + movsi c,-nontty ;See if any Lisp machines free + skipn lmfree(c) + aobjn c,.-1 + jumpge c,[ iot [asciz /No free Lisp machines/] + jrst finisd ] + iot [asciz /Free Lisp machines: /] + movei e,5 ;e controls number per line + jrst finis1 + +finis0: skipn lmfree(c) + jrst finis4 + iot [asciz /, /] + sojg e,finis1 + iot [asciz/ + /] + movei e,6 +finis1: move b,jnmtab+maxtty(c) ;Give machine name and room number +finis2: movei a,0 + lshc a,6 + typi 40(a) + jumpn b,finis2 + typi 40 + move b,lmdoc(c) +finis3: ildb a,b + caie a,40 + jumpn a,[ typi (a) + jrst finis3 ] +finis4: aobjn c,finis0 +finisd: typi ^M ;end with crlf + movei a,2*30. ;sleep 2 seconds so output + .sleep a, ;is high priority + pushj p,ttyfrc ;send out tty buffer and flush it. + .call [setz ? sixbit /rcpos/ ? movei tyoc ? setzm cposav'] + jsr reload ;save cursor position for draw routine + pushj p,bdays ;output birthdays known. + .rlpdtm c, ;c gets seconds since beginning of year + idivi c,24.*60.*60. ;d gets seconds since beginning of day + idivi d,60.*60. ;d gets hour since midnight + exch d,chour + came d,chour + jrst [ pushj p,rpic ;read in a new picture every hour + pushj p,clrpts + pushj p,bdyupd ;and crunch new birthdays. + jrst .+1 ] + .call [ setz ? 'rfname ? movei ls1c ;See if need new inquir data base + movem a ? movem b ? setzm c ] + .lose %lssys + hlrzs c ;RH(C) := First three characters of FN2 + skipe c + cain c,'OLD + pushj p,ls2map ;Not open, OLD, or OLDOLD => get new + movei a,2*30. ;sigh, sleep for 2 sec since FLUSH loses on TV. + .sleep a, + pushj p,draw + + +;the reason for sleeping for short intervals of time is to make sure +;that "not in operation" appears, and the demon is logged out, +;no more than slpt1/30 sec after its is down. if demon doesn't log out, +;a salvage will be necessary because shared pages will still have their +;tut entries aos'd. + skipe @shutdn + jrst die1 ;it will die soon - check frequently for whether it's down yet. + movei x,nredis ;its won't die son - just wait the whole interval at once. + .sleep x, + move a,[600000,,[maxdoz]] + .realt a, + jfcl + move a,logcnt ;our count of the no. of logins and logouts +nap1: camn a,@dmnbd ;their count +hang1: .hang + pushj p,dmngbl + aosn updtfl + jrst lookup + jrst nap1 + +dmngbl: move a,logcnt + camn a,@dmnbd + popj p, +nap0: move i,dmnbp + caml i,dmnbsz + setz i, + pushj p,lotprc ;process logout times stuff + addi i,1 ;entry+1 is type word + move a,@dmnbf + tlnn a,dmneli+dmnelo + jrst nap2 + addi i,2 ;entry+3 is jname + move a,@dmnbf + camn a,[sixbit /hactrn/] + setom updtfl' ;will need to update +nap2: subi i,3 ;this entry wasn't human, ignore it + add i,dmnbel ;move ptr to next entry + aos a,logcnt + movem i,dmnbp ;store the updated ptr + came a,@dmnbd + jrst nap0 + skipn lotupk + popj p, + movns lotupk + jrst lotprc + +die1: move a,[600000,,[maxdoz/2]] + .realt a, ;don't forget to update the listing if there is time + jfcl + skiple @shutdn ;wait for the system to actually go down +hang2: .hang + skipl @shutdn + jrst lookup ;someone revived the system + +die2: .iot tyoc,[^P] ;come here on determining I.T.S. is down. + .iot tyoc,["C] + move a,[440600,,mname] +die3: ildb b,a + addi b,40 + .iot tyoc,b + caie b,40 + jrst die3 + move a,[-6,,[ascic /ITS not in operation as of /]] + .iot tybc,a + .rlpdt c, + idivi c,24.*60.*60. + prt d + .iot tyoc,[^M] + pushj p,gdwnml ;read and print reason for sys down + pushj p,pdwnml + setom lotupk ;do final logout times update + pushj p,dmngbl + jsr die + +die: 0 + .logout + .value + +;print reason for system down + +gdwnml: skipe dwnmlp + popj p, ;already got it, don't try again sys might have deleted file + move d,[dwnml,,dwnml+1] + setzm dwnml + blt d,dwnmz-1 + setzm dwnmlp + .open dkic,[.bai,,'sys + sixbit /down/ + sixbit /mail/] + popj p, + move d,[dwnml-dwnmz,,dwnml] + .iot dkic,d + hrloi d,-dwnml-1(d) + eqvi d,dwnml + movem d,dwnmlp + popj p, + +pdwnml: skipl @shutdn + jrst [ iot dwnml + chr [^M] + popj p,] + move d,dwnmlp + .iot tybc,d ;can't use regular buffering frob + .iot tyoc,[^M] + popj p, + +rpic: aos a,cpict ;increment the picture no. + pushj p,cvnfn ;get sixbit of picture no. + .call [ setz + sixbit /open/ ;open new picture file + [.bii,,ptch] + [sixbit /dsk/] + [sixbit /nampic/] + a + setz [sixbit /channa/]] + jrst rp1 + .call [ setz ;find length of picture file + sixbit /fillen/ + 1000,,ptch + setzm a ] + .value + caile a,455.*18. ;picture larger than our buffer? + movei a,455.*18. ;yes, only read in first part + movem a,pictl ;set length for later + movsi a,-1(a) ;get .iot block mode arg + eqvi a,-pictur-1 ;... + .iot ptch,a ;read in file + .close ptch, + popj p, +rp1: move a,cpict + cain a,1 + popj p, + setzm cpict + jrst rpic + +draw: move b,nusers + move a,cposav ;get cursor position saved before birthday hacking. + hlrzs a ;vertical pos in left half + camg a,b ;vpos less than number of users printed => + popj p, ; we wrapped around, so don't draw picture. + caml b,tcmxv ;# of users exceeds screen height => we wrapped around. + popj p, + addi a,1 ;start pictur on next line + imuli a,12.*18. ;multiply to get word offset in tv buffer + movei a,tvorg(a) ;get ptr to place to start picture + hrli a,pictur ;make a BLT ptr + move b,pictl ;make ptr to last word to write in buffer + addi b,-1(a) ;... + caile b,tvend-1 ;if beyond end of buffer then truncate + movei b,tvend-1 ;... + blt a,(b) ;draw picture + popj p, + +cvnfn: move c,[440600,,a] +cvnfn1: idivi a,10. ;convert a no. to sixbit + jumpe a,cv1 + push p,b + pushj p,cvnfn1 + pop p,b +cv1: movei b,20(b) + idpb b,c + popj p, + +unmout: move a,unmtab(i) ;get uname + move b,a + pushj p,type6 ;type out the sixbit + chr [40] ;one tab + exch b,ttyunm(i) + move c,ttynmp(i) ;use stored name ptr if any + move a,grpchr(i) ;and stored group char + move d,relchr(i) ;along with stored relatio char + came b,ttyunm(i) + pushj p,useek ; not same. look for this uname in dir, copy fullname down ptr in c. + movem a,grpchr(i) + cain a,0 + movei a,"- ;use this if no group char specified. + movem d,relchr(i) + cain d,0 + movei d,40 ;just space if no relation char. +;If relation is X, then this is an X-user, so we want to inform the world +;even if the group is A, L, or *. + cain d,"X + jrst prxusr + cain a,"A ;ignore this since namdrg only runs on AI. + jrst praiur + caie a,"L + cain a,"* ;also ignore +; jrst praiur ;print relation also for everybody but A, L, and *. +; jrst prxusr +praiur: movei a,40 + movei d,40 +prxusr: chr a + chr d + chr [40] + setz d, + movei b,22. + jrst typcnt ;type string c points to. + ;return...are now at 8+24 th col. + ;c has b.p. to where we stopped in printing the full name. + +;look for uname in XUNTAB(I). Permute fullname and copy it down +;the b.p. supplied in C. +;A will have the "group designation char" if there is one. +;B gets the core address of the entry, which will be valid only until the next useek. +;If the user has no entry, B gets 0. +;D gets "relation character" if there is one. +useek: move b,[ascii / /] ;Init the ttynmp tring in case we don't find an entry. + movem b,(c) + move b,[ascii / ???/] + movem b,1(c) + move b,xuntab(i) + hlre a,b ;b gets xuname, or ______ for non-logged-in users. + aosn a + seto b, +useek1: movei a,ls1c ;a gets channel LSR1 is open on. + pushj p,lsrtns"lsrunm ;search LSR1 for the uname. + jrst usearl ;not found => return standard stuff. + movei a,lsrtns"i$name + pushj p,lsrtns"lsritm ;get pointer to full name item. + jrst usearl ;every entry ought to have one. + push p,b + move b,c + pushj p,lsrtns"lsrnam ;permute fullname into lastname last order, + jsr die ;copying into the ttynmp string. + pop p,b + movei a,lsrtns"i$grp ;now get the "Group" item, + pushj p,lsrtns"lsritm + setz a, + ildb a,a ;and extract its 1st character. +;The below can't (?) happen. +; cain a,^M +; setz a, ;for a null entry return 0. + push p,a ;save it so we can get the "Relation." into D. + movei a,lsrtns"i$rel + pushj p,lsrtns"lsritm + setz a, + ildb a,a + move d,a + pop p,a ;restore group to a. + popj p, + +;here if user has no entry or entry has no fullname. +;We come here if user has no fullname but does have group, so +;that's why the free console says something different for +;those people than does :name. Feature? +usearl: setzb a,b + setz d, + popj p, + +typcon: idpb a,sptr +typcnt: sojl b,[popj p,] ;this routine takes pointer in c,limit in b. + ildb a,c ;get char + cail a,40 ;control chr is delimiter + jrst typcon +padlup: chr [40] + sojl b,[popj p,];output blanks up to limit + jrst padlup + +;jnmout: chr [^I] ;one tab +jnmout: chr [40] ;one space + move a,jnmtab(i) + jrst type6 ;type out 6bit name of job + +;print out all info about tty - how long idle, what tty number, and where it is. +ttyout: chr [40] + hrrei a,-maxtty(i) + jumpl a,ttyoun ;jump if not lisp machine + movei c,jtmtab(i) ;yes, idle time is in ascii + hrli c,440700 ;count chars, wants to fit in 4-column field + movei a,4 +ttyol1: ildb b,c + skipe b + soja a,ttyol1 + jumpe a,ttyol3 +ttyol2: chr [40] ;put leading spaces + sojg a,ttyol2 +ttyol3: movei a,jtmtab(i) + pushj p,typ7ta + movei a,5 +ttyol4: chr [40] + sojg a,ttyol4 + move a,lmdoc-maxtty(i) ;Console location + jrst type7u + +ttyoun: move a,@time + sub a,@ttitm ;- time of last input on this tty. + idivi a,30.*60. ;get time in minutes tty has been idle. + jumpe a,[iot [asciz / /] + jrst ttyou1] ;it's been a very short time + caige a,60. + jrst [ chr [40] + chr [40] + pushj p,dectyp ;< 1 hr - say how many minutes + jrst ttyou1] + idivi a,60. + cail a,10. + jrst [ iot [asciz /*:**/] + jrst ttyou1] ;a very long time. + addi a,"0 + idpb a,sptr + chr [":] + idivi b,10. + addi b,"0 + addi c,"0 + idpb b,sptr + idpb c,sptr +ttyou1: move a,jtmtab(i) + jumpn a,[chr [40] + jrst ttyou2] + chr [".] +ttyou2: hrrz b,i ;get tty number. + chr ["T] + ldb a,[030300,,b] + addi a,"0 + idpb a,sptr ;and print it as "T" followed by 2 digits. + ldb a,[000300,,b] + addi a,"0 + idpb a,sptr + chr [40] + move tt,tcmxh ;init horizontal position info + sub tt,beglen + caml b,nfstty ;a sty? + caml b,nlstty + caia ;no! skip. + jrst hstout ;yes! assumption is net caller. + caml b,nf11ty ;a pdp11 tv? + camle b,nl11ty + jrst nrmtty ;nope, 'normal' tty. + +;here if its a tv + +tv: pushj p,ttchk ;Look for TTLOC info + caia + jrst [ push p,a ; Save the bp for later + push p,b ; Save the TTY number + ildb b,a ; Check out the first character + cain b,33 ; Magic escape? + jrst [ pop p,b ? sub p,[1,,1] ? jrst type7u] + pop p,b ; Recover the TTY number + pop p,a ; and use the whole thing + jrst type7u] ;Use it + .call [ setz ;have tty no, get kbd no. + sixbit /tvwher/ + movei 400000(b) + setzm a ] + .value + cain a,377 + jrst [ iot [asciz /Not connected/] + popj p, ] + cail a,0 + cail a,maxkbd + jrst [iot [asciz / ?? TV-11 garbaged!/] + popj p,] + push p,a ;save for later + pushj p,octhak + ior a,['kbd00] + lsh a,6 +; pushj p,type6 + pop p,b ;kbd again + move a,kbddoc(b) + hrli a,440700 + pushj p,type7t ;output appropriate stuff + popj p, + +;;; This looks in the SYSBIN;TTLOC DATA file (which was mapped in at the +;;; start) and if there is an entry for that user on that terminal, it +;;; uses the entry instead of the entry from SYSENG;TTYTYP (FILE) +;;; (which was gobbled at initialization time). +;;; The format of the TTLOC DATA file is: +;;; For each TTY, there is a block of 21 words, the first word is +;;; the UNAME of the person on the line, and the rest is an ASCIZ string. +;;; If the UNAME doesn't correspond to who's on the line now, +;;; the entry is cleared and ignored. + +;;; B is the TTY number +ttsize==21 + +ttchk: push p,b ;save the real B for later + push p,c + move c,b + imuli b,ttsize ;get offset in TTLOC table + addi b,ttlpag*2000 ;make absolute + move a,unmtab(c) ;get the UNAME that's on this TTY + skipe 1(b) ;if there's no data in the entry + came a,(b) ; Or there's a new person there + jrst ttchk0 ; Clear out the entry + movei a,1(b) ;yes, return ptr to the ASCIZ string + hrli a,440700 ;make it a Byte Pointer + pop p,c + pop p,b ;restore the real TTY # +popj1: aos (p) ;skip return + popj p, + +ttchk0: setzm (b) ;clear out the entry + pop p,c + pop p,b ;Nope, get back the real B + popj p, + +;here for ordinary vegetable patch tty + +nrmtty: pushj p,ttchk ;check the TTLOC database for interesting info + jrst nrmtt0 + push p,a ;remember our TTYLOC + push p,b ;save the TTY number, we need an AC + ildb b,a ;fetch the first char + cain b,33 ;Magic escape? + jrst [ pop p,b ? sub p,[1,,1] ? jrst type7u] ;just type the rest + pop p,b ;recover the TTY number + syscal TTYVAR,[ %climm,,%jsnum(b) ? %climm,,'TYP ? %clout,,a] + movei a,0 + trne a,%tydil ;Is this a dialup? + jrst [ movei a,[asciz /Dialup: /] ;Tell about it + pushj p,type7v + jrst .+1] + pop p,a ;recall our TTYLOC + jrst type7u ;type it out + +nrmtt0: move a,ttydoc(b) ;No TTLOC info, use the default + jrst type7u + +;here when a guy is loggen in on a sty. If it's a network STY, print host name. +hstout: pushj p,ttchk ;Check for TTLOC info + seto a, ;none + move b,ttytab(i) ;get host # + jumpl b,styout ;harumph, non-net sty...go hack it + push p,a ;Save TTLOC info + .call [ setz + sixbit/open/ + [ubpfj+.bii,,usrich] + [sixbit/usr/] + auxtb1(i) + setz auxtb2(i) ] ;open up the server + jrst hstou0 ;gone + syscal usrmem,[%climm,,usrich ? %climm,,100 ? %clout,,a] + jrst hstou0 + came a,['TERMID] + jrst hstou0 + movei a,101 + move b,[-ltlinf,,telinf] ;get cruft +hstou2: syscal usrmem,[%climm,,usrich ? a ? %clout,,(b)] + jrst hstou0 + aos a + aobjn b,hstou2 + +;; 3 cases: (1) We have a console ID from TTLOC. +;; Print the canonicalized host-name which we were given, a +;; colon, and the console ID. If it's a TIP, print the port #. +;; (2) We have a console ID from TELSER. Print it. +;; (3) We have no console ID, print Net site and the host name. +;; In this case we print the port number for TIP's + + move a,(p) ;get the TTLOC info + camn a,[-1] ;if there's no TTLOC info + skipe termid ; and if TELSER doesn't know where this TTY is + caia + jrst hstou3 ; Then we go print the host full name +;This misfeature sucks -- Moon +; camn a,[-1] ;No TTYLOC info? +; jrst hstoyz ; Don't MPV looking at its first char! +; ildb b,a ;Check out the first character +; cain b,33 ;Magic escape? +; jrst [ pop p,b ; Yes, discared the saved byte pointer +; pushj p,type7u ; and use the incremented one, discarding escape +; jrst hstou4] ; on with the show. +hstoyz: pushj p,prthsc ;Print abbreviated host name and optional TIP port number + movei a,[asciz/: /] + pushj p,type7v +hstoy0: pop p,a ;recover our special info + camn a,[-1] ;unless there's none + movei a,termid ;in which case use the TELSER info + pushj p,type7v ;Type terminal name + jrst hstou4 + +;Print host name and TIP number + +;This entry used when putting host name before a colon. Try to abbreviate it. +;Specifically, change MIT-x to x, LISP-MACHINE-x to LMx, SU-AI to SAIL. +;We could change PLASMA to nothing at all (not even colon) but I don't really +;think that's so great (Moon). +prthsc: push p,b + move a,[440700,,hstnam] ;Scan name supplied by server + irpc ch,,[MIT-] + ildb b,a + caie b,"ch + jrst prthc1 + termin + pop p,b + pushj p,type7u ;MIT- host, just show part after MIT- + jrst prths1 + +prthc1: move b,hstnam + camn b,[ascii/SU-AI/] + jrst [ movei a,[asciz/SAIL/] + pop p,b + jrst prths0 ] + push p,c + push p,d + move a,[440700,,hstnam] + move b,[440700,,[asciz/LISP-MACHINE-/]] +prthc2: ildb c,b + jumpe c,[typi "L + typi "M + subi tt,2 + pop p,d + pop p,c + pop p,b + pushj p,type7u + jrst prths1 ] + ildb d,a + camn c,d + jrst prthc2 + pop p,d + pop p,c + pop p,b ;No known abbreviation, print full official name +prthst: movei a,hstnam +prths0: pushj p,type7v ;type host name gotten out of server +prths1: skipn a,tipnum + popj p, ;Not a TIP + subi tt,2 ;Port number is at least a # and a digit + cail a,10 ;Subtract additional 1 for each of up to 3 octal digits + subi tt,1 + cail a,100 + subi tt,1 + jumple tt,cpopj ;And exit if no room on line + typi "# ;port # prefix + jrst octtyo + +;No terminal ID, print net site mumble mumble +hstou3: pop p,a ;Flush TTLOC info from stack + movei a,[asciz/Net site /] + pushj p,type7v + pushj p,prthst +hstou4: .close usrich, + ldb a,[netwrk"nw$byt,,fhost] ;For Public Relations, if was via Chaos net, + cain a,netwrk"nw%chs ; say so + caig tt,8 ; but only if there is room on the line + jrst hstou5 + movei a,[asciz/ (Chaos)/] + pushj p,type7v +hstou5: popj p, + +;Here if couldn't get info from server job, treat as non-network STY +hstou0: .close usrich, + pop p,a + jrst styout + +styout: move a,auxtb2(i) ;check for deamon + camn a,['hactrn] ;only if it is a hactrn + jrst styou1 +styou2: iot [asciz /U=/] + move a,auxtb1(i) ;get uname of controlling proc + pushj p,type6 ;out it go + iot [asciz / J=/] + move a,auxtb2(i) ;and then the jname + pushj p,type6 + popj p, + +styou1: push p,i + addi i,auxtb1-xuntab ;check if daemon is listed in usrnam + pushj p,useek + pop p,i + jumpe b,styou2 ;if has no LSR1 entry, it is no demon. + move b,tcmxh + sub b,beglen +styou3: ildb a,c + caige a,40 + popj p, + idpb a,sptr + sojg b,styou3 + popj p, + +;2 position octal or decimal print of number in a. Leading 0 replaced by space. +octtyp: idivi a,10 + caia +dectyp: idivi a,10. + addi a,"0 + cain a,"0 + movei a,40 + idpb a,sptr + addi b,"0 + idpb b,sptr + popj p, + +;Type 3 digits of octal, without zero suppression. +octt3: idivi a,10 + hrlm b,(p) + pushj p,octt2 + jrst octt1 + +;Type 2 digits of octal, without zero suppression. +octt2: idivi a,10 + addi a,"0 + idpb a,sptr + addi b,"0 + idpb b,sptr + popj p, + +;Type as many digits as needed to print number in a in octal. +octtyo: idivi a,10 + hrlm b,(p) + skipe a + pushj p,octtyo +octt1: hlrz b,(p) + addi b,"0 + idpb b,sptr + popj p, + +;print asciz string <- b.p. in a, printing no more than -beglen chars. +type7v: hrli a,440700 + jrst type7u + +typ7ta: hrli a,440700 +type7t: move tt,tcmxh + sub tt,beglen +type7u: ildb b,a + jumpe b,cpopj + idpb b,sptr + sojg tt,type7u + popj p, + + ;these routines are intended to snarf up all birthdays from LSR data + ;once per day, and output them during regular updates. + ; messy, hairy, and not recommended for casual reading. +bdyupd: push p,a + push p,b + push p,c + push p,d + push p,e + .call [setz ? 'rqdate ? setzm a] ;get dsk format date + jsr reload + ldb b,[220500,,a] ;get day of month + movem b,cday + ldb b,[270400,,a] ;get month (1 = Jan) + movem b,cmonth + setom nbdys' ;clear cnt of bdays found. + move e,lsrtns"datfpg + lsh e,10. ;e gets address (in LSR1, not core) of 1st (next) entry. +bdyu2: move b,e + movei a,ls1c + pushj p,lsrtns"lsrget ;make sure next entry is in core, get core address in b. + jsr die + hlrz a,(b) ;advance e to point at the following entry. + jumpe a,bdyu95 ;entry length is 0 => eof! + add e,a + movei a,lsrtns"i$brth + pushj p,lsrtns"lsritm ;get the birthday item. + jrst bdyu2 ;didn't find it? look at next entry. + + ;found a b-day. must now parse. ugh! + push p,b ;save core addr of entry, so we can get other items. + move b,a + move c,[440700,,d] + setz d, +repeat 3,[ildb a,b + caig a,40 + jrst bdyu9 + cail a,"a + caile a,"z + caia + subi a,40 ;make uppercase + idpb a,c +] + move c,monptr ;get aobjn thru months. +bdyu4: camn d,montab(c) + jrst bdyu5 ;aha. rh of C now has month #. + aobjn c,bdyu4 + jrst bdyu9 ;no match, no month found. + +bdyu5: hrrzs c + came c,cmonth + jrst bdyu9 ;sigh, not current month. +bdyu6: ildb a,b + caile a,40 + jrst bdyu6 + caie a,40 + jrst bdyu9 + + ildb a,b + cain a,40 + jrst .-2 + cail a,"0 + caile a,"9 + jrst bdyu9 + movei c,-"0(a) + ildb a,b + cail a,"0 + caile a,"9 + caia + jrst [ imuli c,10. + addi c,-"0(a) + jrst .+1] + came c,cday + jrst bdyu9 + + ; egad, this IS his/her/its birthday! One last check. + move b,(p) + movei a,lsrtns"i$grp + pushj p,lsrtns"lsritm + jrst bdyu8 ;no group char, go ahead. + ildb a,a ;get the group char. + caie a,0 ;if no GR, do not show. + cain a,"@ ; + jrst bdyu9 ;don't show aliases. + caie a,"U + cain a,"T + jrst bdyu9 ;also ignore MACSYMA users or random tourist/guest. + caie a,40 + cain a,"O ;also ignore non-humans (lusers who don't understand "0") + jrst bdyu9 +bdyu8: move a,1(b) ;get the two words which must contain the whole uname. + move b,2(b) + aos d,nbdys + move c,d ;store them in the next bdyunm table entry (2 wds per entry). + add c,d + movem a,bdyunm(c) + movem b,bdyunm+1(c) +bdyu9: pop p,b + move d,nbdys + cail d,bdymax + jrst bdyu95 ;stop if this was last allowed. + hlrz a,(b) + add b,a + hlrz a,(b) + jumpn a,bdyu2 + +;here after scanning entire LSR1 file for people born today. +bdyu95: setzm bdyptr + setzm bdyn1 + setzm bdyn2 + skipl d,nbdys + jrst [ addi d,1 + cain d,1 + setom bdyn1 + cain d,2 + setom bdyn2 + movn d,d + hrlzs d + movem d,bdyptr ;store aobjn ptr for table. + jrst .+1] + pop p,e + pop p,d + pop p,c + pop p,b + pop p,a + popj p, + +monptr: -12.,,1 +montab: 0 + irp m,,[JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC] + asciz /m/ + termin + + ; call this when want to print out birthday people. + +bdays: skipn b,bdyptr + popj p, + iot [asciz /Happy Birthday to/] + +bdays2: move a,b ;get addr of start of ascciz string holding next uname. + addi a,bdyunm(b) + trne b,-1 ;first time through, don't print spacer. + jrst [ skipn bdyn2 ;print spacing comma. but if only 2 bdys, don't. + typi ", + jrst .+1] + typi 40 + hlrz c,b + cain c,-1 ;last bday? + jrst [ skipn bdyn1 ;yes, print "and", unless only one bday. + iot [asciz /and /] + jrst .+1] + pushj p,type7 + aobjn b,bdays2 + pushj p,ttyfrc ;force out tty buffer. + popj p, + +bdymax==15. ;max # bdays we can know about. +bdyn1: 0 ;-1 when only one bday. +bdyn2: 0 ;-1 when only 2 bdays. +bdyptr: 0 ;has AOBJN ptr into table. +bdyunm: block bdymax*2 ;table of UNAMES of people having birthday today. + ;Each uname is an ASCIZ string, taking up 2 words. + +crlf: asciz / +/ + + ;rtn to type only up to a ctl char. +type7: hrli a,440700 + movem a,ty7ptr' + caia +type8: typi (a) + ildb a,ty7ptr + cail a,40 + jrst type8 + popj p, + +LS2FLN: SETZ ? 'FILLEN ? MOVEI DKIC ? SETZM A + +LS2CBK: SETZ ? 'CORBLK + MOVEI %CBRED ;Read-Only. + MOVEI %JSELF ;into self + A ;as specified + SETZI DKIC ;from file open on channel. + +;Map in the inquir data base (INQUIR;LSR1 >) +;Also the TTLOC data base (SYSBIN;TTLOC DATA) + +LS2MAP: PUSH P,A + PUSH P,B + MOVEI A,LS1C + MOVE B,[USRPAG-HIPORG,,USRPAG] ;this block of pages is available for use. + PUSHJ P,LSRTNS"LSRMAP ;map in LSR1 - index tables and some data pages. + JSR DIE + HRRZ A,B + MOVEI B,DKIC + PUSHJ P,NETWRK"HSTMAP ;Map in the HOSTS2 file. + JSR DIE + MOVEM A,LS2LPG ;save # of first page free after LSR data. + .CALL [ SETZ ? SIXBIT/OPEN/ ? [.BII,,DKIC] + [SIXBIT/DSK/] ? [SIXBIT/TTLOC/] ? [SIXBIT/DATA/] ? SETZ [SIXBIT /SYSBIN/]] + JRST [ ;If TTLOC DATA not found, just put a zero page + .CALL [ SETZ ? 'CORBLK ? MOVEI 0 ? MOVEI %JSELF ? SETZI TTLPAG ] + .LOSE %LSSYS + .CALL [ SETZ ? 'CORBLK ? MOVEI %CBNDW ? MOVEI %JSELF ? MOVEI TTLPAG + SETZI %JSNEW ] + .LOSE %LSSYS + JRST POPBAJ ] + .CALL [ SETZ ? 'CORBLK ? MOVEI %CBNDW ? MOVEI %JSELF ? MOVEI TTLPAG ? SETZI DKIC] + .LOSE %LSSYS + .CLOSE DKIC, +POPBAJ: POP P,B + POP P,A + POPJ P, + +LS2LPG: 0 ; # of page first free after LSR data + +.INSRT SYSENG;LSRTNS +.INSRT SYSTEM;CHSDEF + +$$HSTMAP==1 ;Request various of NETWRK's routines. +$$SYMLOOK==1 +$$HOSTNM==1 +$$HSTSIX==1 +$$CHAOS==1 ;Not actually needed, prevents Fascist error message +.INSRT SYSENG;NETWRK + +type6: push p,b + push p,c + move b,[440600,,a] +ty1: ildb c,b + addi c,40 ;convert 6bit to ascii + idpb c,sptr + came b,[600,,a] ;bp will be this after typing six characters + jrst ty1 + pop p,c + pop p,b + popj p, + +octhak: movei b,0 + lshc a,-3 ;uses b reg also + lsh a,3 ;effect of lsh's is to separate the octal digits by 3 + lshc a,3. ;and align them on right +cpopj: popj p, + + +clrpts: push p,a + movsi a,-maxtty-nontty +clrpt2: setzm ttyunm(a) ;clear name ptr so unmout will re-search. + aobjn a,clrpt2 + pop p,a + popj p, + + +map11: move a,[-tvpgs,,tvporg] + setz b, + .call [setz + sixbit /corblk/ + 1000,,%cbred+%cbndw + 1000,,%jself + a + 1000,,%jstvb + setz b] + jsr die + .call [ setz ;energize system wholine + sixbit /wholin/ + movei tyoc + setzi 4 ] + jsr die + .call [ setz ;get video input sw # into a + sixbit /tvwher/ + 1000,,tyoc + movem b + setzm a ] + jsr die + lsh a,20. ;move into bits 3.4-4.1 + tlo a,37000 ;ALU fcn code for MOVEM'ing + .suset [.stvcreg,,a] ;put in console reg so we've got that buffer + .suset [.smara,,[0]] ;clear the MAR in case already set. + setzm tvend ;clear complement bit and reset scroll reg! + .suset [.smara,,[7,,tvend]] ;set .MAR break so any reference to scroll reg + ;will be caught (something has been garbaging this + ;location randomly) + tlz a,2000 ;get 34000 = ALU fcn code for IORMing into memory + .suset [.stvcreg,,a] ;put in console reg + popj p, + +gttys: .call [ setz + sixbit /open/ + [.bai,,dkic] + [sixbit /dsk/] + [sixbit /ttytyp/] + [sixbit />/] + setz ['syseng]] + jsr die + move c,[-5000,,ttyfil] + .iot dkic,c + skipl c + jsr die ;syseng;ttytyp is too big! + .close dkic, + move a,[440700,,ttyfil] +gttys0: ildb b,a +gttys1: caie b,0 + cain b,^C ;at eof? + jsr die ;yes! no entry in ttytyp for this machine! + caie b,"; ;maybe we've found an entry. + jrst gttys0 + ildb b,a + caie b,"; ;an entry has three semicolons, a space, and a machine name. + jrst gttys1 + ildb b,a + caie b,"; + jrst gttys1 + ildb b,a + caie b,40 + jrst gttys1 + move d,mname ;found the semi's and space; now see if machine name is ours. +gttys2: ildb b,a + caie b,40 + cain b,^M + jrst gttys3 + andi b,77 + xori b,40 + rot d,6 + xori d,(b) + trnn d,77 + jrst gttys2 + ldb b,a + jrst gttys1 + +gttys3: jumpn d,gttys1 + subi b,ttyfil ;the garbage before it. + sub c,b ;c still had .iot pointer, -> after what was read. + movsi b,(a) + hrri b,ttyfil + blt b,-1(c) + hrri a,ttyfil ;make a -> same byte, where it has been blt'ed to. +;now find the individual strings in the ttytyp file entry, and put b.p.'s +;to them in the ttydoc table. also replace the crlf's ending them by 0's +;so the ascii typeout routine will work on them. + move c,[-maxtty,,ttydoc] +gttys4: ildb b,a + caie b,0 ;eof => no more strings. + cain b,^C + jrst gttys5 + caie b,"; + jrst gttys4 ;find next documentation string. + ildb b,a + cain b,"; ;2 semi's in a row => start of next entry + jrst gttys5 ;meaning end of this one. + caie b,"T ;comment doesn't start with "Tnm " => ignore it. + jrst gttys4 + ildb b,a + cail b,"0 + caile b,"9 + jrst gttys4 + ildb b,a ;don't bother testing the 3rd char for digithood, + ildb b,a + caie b,40 ;but check 4th for blankness. + jrst gttys4 + movem a,(c) ;remember the byte pointer to the string. + caia +gttys6: ildb b,a ;find the end of this string, + caie b,^M + jrst gttys6 + setz b, + dpb b,a ;and put a ^@ there to stop type7x's printing. + aobjn c,gttys4 + .value ;too many tty's in ttytyp?!? + +gttys5: popj p, + +timint: push p,a + hrrz a,-1(p) ;check address running at + caie a,hang1 + cain a,hang2 + jrst [ pop p,a + .call [setz ? sixbit /dismis/ ? p ? setz [lookup]]] + move a,[600000,,[5*60.]] + .realt a, + pop p,a ;running, interrupt will go off again + .call [setz ? sixbit/dismis/ ? setz p] + +ilopr: 0 ;here for UUO returned from the system + skipe forty ;when TV11 crashes, TEN11 sometimes make us execute zero + jsr reload + sos ilopr + skipn @ilopr ;was instruction supposed to be executed actually zero? + jrst [ aos ilopr + jsr reload ] +11upw: .suset [.soption,,[,,]] ;no, wait for 11 to come back up + skipge @shutdn + .logout + skipl @tt11p + .hang + .suset [.soption,,[,,]] + pushj p,map11 ;free TV buffer # could have changed! + jrst lookup ;then restart program + +ioc: push p,a ;i/o channel error. + hrrz a,-1(p) ;If it came in the middle of doing output to logout times file, + caie a,iocok1 ;wait 10 seconds and try again. + cain a,iocok2 + jrst iocok + caie a,iocok3 + cain a,iocok4 + jrst iocok + jsr reload + +iocok: movei a,10.*60. + .sleep a, + pop p,a + .call [setz ? 'dismis ? setz p] + .lose %lssys + +pov: jsr reload ;pdl overflow + +mpv: jsr reload ;memory protect error + + +reload: 0 + .value ;later more stuff here + +uuoh: ldb v,[$opcode,,40] + skipe v + caile v,nuuo + .value + jrst @uuotab-1(v) + + +define uuodef name,handlr +if1 [ +ifndef nuuo,nuuo==0 +nuuo==nuuo+1 +name!nuuo_27. +] + handlr +termin + +uuotab: + uuodef iot=,u.iot + uuodef prh=,u.prh + uuodef prt=,u.prt + uuodef chr=,u.chr + uuodef typi=,u.chri + +u.chri: move v,40 + idpb v,sptr + popj p, + +u.chr: move v,@40 ;store a char in output buffer + idpb v,sptr + popj p, + + +u.iot: hrrz v,40 ;block mode output + hrli v,440700 ;set up byte pointer (addr in a as arg.) + movem v,t7 ;store so don't need extra acc +u.i1: ildb v,t7 ;get char + jumpe v,cpopj ;stop when zero char reached (^@) + cain v,^C + popj p, + idpb v,sptr ;store in large buffer for later block IOTing + jrst u.i1 + +u.prt: move v,@40 + push p,c + push p,w + movei c,2 + idivi v,24.*60.*60. + move v,w + jrst at3 + +u.prh: move v,@40 ;print argument as time + push p,c + push p,w + jumpn v,at1 + movei c,5 ;time zero should print as "0:00" + jrst at3 +at1: setz c, +at2: camge v,timtb(c) + aoja c,at2 +at3: idiv v,timtb(c) + addi v,"0 + skipge @shutdn ;temp. kludge! + jrst [ .iot tyoc,v + jrst .+2] + idpb v,sptr + move v,w + trnn c,1 + aoja c,at3 + cail c,7 + jrst at4 + skipge @shutdn + jrst [ .iot tyoc,[":] + aoja c,at3] + push p,w + movei w,": + idpb w,sptr + pop p,w + aoja c,at3 +at4: pop p,w + pop p,c + popj p, + +define ptime units + tdiv*10. + tdiv +tdiv==tdiv/units +termin + +tdiv==24.*60.*60. + +timtb: ptime 24. + ptime 60. + ptime 60. + ptime 1. + +ttyfrc: push p,a + push p,b + move a,[440700,,screen] ;get initial ptr + move b,sptr ;and current ptr + pushj p,u7pdif ;find difference + jumple a,ttyfr9 ;don't output if nothing there + move b,[440700,,screen] ;else do... + .call [setz ? sixbit /SIOT/ + movei tyoc ? b ? setz a] ;send it out + jsr reload + .call [setz ? sixbit /finish/ ? setzi tyoc] + jsr reload ;make sure it goes out. +ttyfr9: move a,[440700,,screen] + movem a,sptr ;reset pointer. + pop p,b + pop p,a + popj p, + +U7PDIF: PUSH P,B + PUSH P,C + LDB C,[360300,,A] ;get low 3 bits of p (4,5,6,7,0,1) + MOVEI A,(A) ;get rh + IMULI A,5 + ADD A,U7BPTB(C) ;add in proper # chars as indicated by p + LDB C,[360300,,B] + MOVEI B,(B) + IMULI B,5 + ADD B,U7BPTB(C) ;both ptrs now in 'canonical' form (# chs from 0) + SUBM B,A ;get diff B-A into A + POP P,C + POP P,B + POPJ P, ;and return that. + + ; # chs in wd p (index is lower 3 bits) +U7BPTB: 4 ;10 + 5 ;01 + 0 + 0 + 0 ;44 + 1 ;35 + 2 ;26 + 3 ;17 + +QUIT.==.VALUE +SIGN==400000 + +lotprc: irps r,,[a b c d e t tt i f g] + push p,r + termin + + skiple lotupk + jrst [ pushj p,ltupd0 ? jrst lotprz ] + + addi i,1 ;entry+1 is type word + move a,@dmnbf + tlnn a,dmnelo + jrst lotprz + addi i,1 ;entry+2 is uname + move a,@dmnbf + addi i,1 ;entry+3 is jname + move i,@dmnbf + pushj p,rcdlot +lotprz: irps r,,[g f i tt t e d c b a] + pop p,r + termin + popj p, + +;following routines taken from pfthmg dragon + +RCDLOT: ;"RECORD LOGOUT" + MOVE B,LOTPT + MOVEM A,LOTBUF(B) ;STASH UNAME FOR LOGOUT TIMES FILE + CAMN I,['HACTRN] ;BUT ONLY FOR HACTRN'S (REAL USERS) + AOS I,LOTPT + .RTIME A, + SUBI A,LOTUPI + SKIPG LOTUPK + CAML A,LOTUPT + JRST LOTUPD + CAIGE I,LOTBSZ/2 ;DECIDE IF FILE SHOULD BE UPDATED NOW + POPJ P, +LOTUPD: ADDI A,LOTUPI + MOVEM A,LOTUPT +LTUPD0: ;ROUTINE TO UPDATE THE LOGOUT TIMES FILE + ;NOTE - TIMES ONLY ACCURATE TO WITHIN 5 MINUTES (LOTUPI) + ;DUE TO THE FACT THAT .RDATIME IS POSTPONED TO HERE + + SETZB C,D ;BEGIN BY CANONICALIZING +LOTUP1: MOVE B,LOTBUF(C) ;C GET PTR, D PUT PTR + MOVEI A,0 + LSHC A,6 ;BRING IN NEXT CHAR + TDNE B,[505050505050] ;any good ones left? + JRST .-2 ;IF SO, LOOP + TLNE A,770000 ;then left adjust + JRST .+4 + LSH A,6 + JUMPN A,.-3 + AOJA C,LOTUP2 ;IF NO GOOD CHARS, SKIP IT + TLC A,SIGN ;CHANGE HIGH BIT FOR SORT + MOVEM A,LOTBUF(D) + ADDI C,1 + ADDI D,1 +LOTUP2: CAMGE C,LOTPT + JRST LOTUP1 + MOVEM D,LOTPT ;-> LAST + 1 + + ;NOW SORT + +LOTSRT: CAIGE D,2 ;MORE THAN ONE LEFT? + JRST LOTUP3 ;NO, SORTED + MOVEI C,0 ;YES, DO ANOTHER SORT PASS +LOTSR0: MOVE A,LOTBUF(C) ;THIS ASSUMES ARRAY IS SMALL + CAMLE A,LOTBUF+1(C) + JRST [ EXCH A,LOTBUF+1(C) + MOVEM A,LOTBUF(C) + JRST LOTSR1 ] + CAMN A,LOTBUF+1(C) + JRST [ MOVEI A,LOTBUF(C) ;DUPLICATION - BLT DOWN + HRLI A,1(A) + SOSG D,LOTPT + QUIT. ;DON'T SMASH WORLD TO FLINDERS + BLT A,LOTBUF-1(D) + JRST LOTSRT ;RESTART SORT FROM BEGINNING + ] ;BECAUSE CAN LOSE OTHERWISE +LOTSR1: CAIGE C,-2(D) + AOJA C,LOTSR0 + SOJA D,LOTSRT + +LOTUP3: MOVE D,LOTPT ;FIX SIGN BITS + MOVSI A,SIGN + XORM A,LOTBUF-1(D) + SOJG D,.-1 + + ; INITIALIZE DATE & TIME IN LOT ENTRY + + .RDATIM A, ;A := HHMMSS, B := YYMMDD + ROT B,12. ;B := MMDDYY + MOVE G,[350700,,LOTNEW+1] ;-> DATE + PUSH P,A + PUSHJ P,SIXPUT + POP P,B + PUSHJ P,SIXPUT + + ;MERGE WITH PREVIOUS LOGOUT TIMES FILE + + MOVEI D,0 ;D -> WHICH ENTRY + PUSHJ P,LOTFILL ;FILL LOTNEW + .SUSET [.RSNAME,,LOTSNM'] + .SUSET [.SSNAME,,['CHANNA]] + .OPEN UTYOC,LOTOPO + PUSHJ P,RETRY + .OPEN UTYIC,LOTOPN ;OPEN INPUT FILE + JRST LOTEOF ;NO FILE => IMMEDIATE EOF + JRST LOTUP5 + +;PUSHJ P,RETRY to wait 10 seconds and retry the previous instruction. +RETRY: MOVEI D,10.*30. + .SLEEP D, + POP P,D + JRST -2(P) + + ;LOGOUT TIMES FILE MERGE +LOTUP5: MOVE T,[-5,,LOTOLD] ;GET ENTRY FROM FILE +IOCOK4: .IOT UTYIC,T + JUMPL T,LOTEOF ;NOT WHOLE ENTRY => EOF +LOTUP4: MOVE A,LOTOLD ;QUICK COMPARE + LSH A,-1 + SUB A,LOTCMP + JUMPG A,LOTUP6 ;LOTNEW GOES FIRST + JUMPL A,LOTUP7 ;LOTOLD GOES FIRST + LDB A,[350700,,LOTOLD+1];HMM, CHECK 6'TH CHAR + LDB B,[350700,,LOTNEW+1] + CAMLE B,A + JRST LOTUP7 ;LOTOLD GOES FIRST + CAMN B,A + SETOM LOTFLG' ;HMM, LOTNEW REPLACES LOTOLD +LOTUP6: MOVE T,[-5,,LOTNEW] +IOCOK1: .IOT UTYOC,T + PUSHJ P,LOTFILL + AOSE LOTFLG + JRST LOTUP4 + JRST LOTUP5 ;LOTOLD REPLACED, REFRESH IT + +LOTUP7: MOVE T,[-5,,LOTOLD] +IOCOK2: .IOT UTYOC,T + JRST LOTUP5 + +LOTEOF: MOVSI A,SIGN-1 ;PUT OUT REST OF LOTNEW + CAME A,LOTCMP + JRST LOTEO1 + .CLOSE UTYIC, ;DONE + .CALL LOTRN ;INSTALL NEW VERSION + QUIT. + .CLOSE UTYOC, + .SUSET [.SSNAME,,LOTSNM'] + SETZM LOTPT + POPJ P, + +LOTEO1: MOVE T,[-5,,LOTNEW] +IOCOK3: .IOT UTYOC,T + PUSHJ P,LOTFILL + JRST LOTEOF + +SIXPUT: MOVEI F,6 ;SIXBIT IN B, B.P. IN G, SKIP EVERY 2 +SIXPU0: MOVEI A,0 + LSHC A,6 + ADDI A,40' + IDPB A,G + TRNE F,1 ;F ODD IMPLIES SKIP + IBP G + SOJG F,SIXPU0 + POPJ P, + +LOTFILL:MOVE F,[440600,,LOTBUF(D)] ;D= ENTRY NO TO + MOVE G,[440700,,LOTNEW] ; FILL LOTNEW.UNAME FROM + CAML D,LOTPT ;ANY MORE ENTRIES? + JRST LOTFL1 ;NO, MARK "EOF" +LOTFL0: ILDB A,F + ADDI A,40' + IDPB A,G + TLNE F,770000 + JRST LOTFL0 + MOVE A,LOTNEW ;SET UP COMPARE WORD + LSH A,-1 + AOSA D ;AND INCREMENT D TO NEXT ENTRY + +LOTFL1: MOVSI A,SIGN-1 ;MAKE DUMMY ENTRY + MOVEM A,LOTCMP' + POPJ P, + + ;LOGOUT TIMES ENTRY BUFFERS + +LOTOLD: BLOCK 5 ;READ OLD ONES HERE + +LOTNEW: ASCII\UNAME MM/DD/YY HH:MM:SS +\ +IFN .-LOTNEW-5, .ERR LOTNEW LOSES + +;Routine to print brief XGP status +;Clobbers all ACs. + +xgpsts: .open usrich,[ubpfj+.bii,,'USR ? sixbit/xgp/ ? sixbit/xgpspl/] + popj p, + .access usrich,[75] ;read abortf, maintp, idlep + move d,[-3,,a] ;a - abortf - -1 if pdp11 gronked or abort req + .iot usrich,d ;b - maintp - -1 if in maintenance mode + .access usrich,[70] ;c - idlep - 0 running, -1 idle, >0 error code + hrroi e,d + .iot usrich,e ;d - cuname - uname of request currently printing + .close usrich, + jumpe b,xgpst1 + iot [asciz\ XGP: Maintenance mode\] + popj p, + +xgpst1: jumpge a,xgpst2 + iot [asciz\ XGP: Aborting/11 down\] + popj p, + +xgpst2: jumpge c,xgpst3 + iot [asciz\ XGP: Idle\] + popj p, + +xgpst3: jumpg c,xgpst5 + iot [asciz\ XGP: Printing for \] +xgpst4: setz c, ;Name of user whose file is being printed + lshc c,6 + typi 40(c) + jumpn d,xgpst4 + popj p, + +xgpst5: iot [asciz\ XGP: \] + movei a,[asciz\strange error condition\] + trne c,200 + movei a,[asciz\paper low\] + trne c,20 + movei a,[asciz\fuser cold\] + trne c,10 + movei a,[asciz\filament cold (paper jam)\] + trne c,40 + movei a,[asciz\paper jam\] + trne c,4 + movei a,[asciz\web or paper out\] + iot (a) + popj p, + +define tvkbd num,name/ + loc kbddoc+num +ifse [name],,[asciz /???/] +ifsn [name],,[asciz /name/] +termin + +ttydoc: block maxtty + +kbddoc: + +.insrt syseng;tvkbd rooms + +loc kbddoc+maxkbd + +mname: 0 ;sixbit name of running machine + 0 ;to insure end of the machine name + + +lpdl==100 +pdl: block lpdl ;push down list + +lotbsz==30. +lotbuf: block lotbsz ;here put unames to go in logout times +lotupt: 0 ;time LOGOUT TIMES file last written +lotupi==30.*60.*5. ;update at least every five minutes +lotupk: 0 ;force update flag for shutdown (kludgey -1,+1, see code) +lotpt: 0 +lotopn: .bai,,'DSK ? sixbit/logouttimes/ +lotopo: .bao,,'DSK ? sixbit/_drgn_times/ +lotrn: setz ? 'RENMWO ? movei utyoc ? move lotopn+1 ? setz lotopn+2 + +dwnmlp: 0 ;if non-zero is aobjn pointer to down mail +dwnml: block 40 ;read sys:down mail into this block if nec. +dwnmz: 0 ;fence for type7 +t7: 0 ;holds b.p. in type7 + +cday: 0 ;current day, for use by birthday matching. +cmonth: 0 ;current month, for same. +chour: -1 ;current hour, when it changes so does picture +cpict: 0 ;no. of current picture +pictl: 0 ;length of current picture + +;The following is copied from location 101 in a TELSER +telinf:: +termid: block 8 ;if non-zero, an asciz terminal name +hstnam: block 8 ;if non-zero, the name of the host in asciz +tipnum: 0 ;if non-zero, port number on tip +fhost: 0 ;foreign host connected to +hstsix: 0 ;sixbit name of host + ;end of stuff looked at by name. +ltlinf==.-telinf + + +strfre: 440700,,strstg +strstg: block 20 ;useek stores the permuted fullname here. + +;these vectors contain 1 elt each per user found. +ttytab: block maxtty ;for a sty, has host#, or -1 if not connected to Arpanet +svrjob: block maxtty ;job no. of server associated with sty +unmtab: block maxtty+nontty ;uname of this user. +xuntab: block maxtty+nontty ;xuname of this user's tree's top. +jnmtab: block maxtty+nontty ;jname of job with tty. +jtmtab: block maxtty+nontty ;usrrce word for tree (ascii idle time for Lisp machine) +auxtb1: block maxtty ;if under sty belonging to non-stelnt job, + ;this is uname of that job. +auxtb2: block maxtty ;and this is the jname. +ttyunm: block maxtty+nontty ;name of loser logged in on this tty +ttynmp: ;address of saved copy of full name of user. + repeat maxtty+nontty,440700,,ttystr+ttystl*.rpcnt +grpchr: block maxtty+nontty ;holds group designation char for said loser (0 if none) +relchr: block maxtty+nontty ;holds relation designation char. 0 if none. +ttystl==10. +ttystr: block ttystl* ;storage for fullname strings. Preallocated per tty. + +;Table of Lisp machines. +lmadrs: block nontty ;Chaos net address, 0 if table entry not used +lmdoc: repeat nontty, 440700,,lmdcfl+<.rpcnt*10> ;Address of console-location documentation +lmdcfl: block 10*nontty ;Console-location documentation stored here +lmfree: block nontty ;-1 if responds but no one logged in +nextlm: 0 ;Index of next machine to be connected to +chsidx: repeat 10,-1 ;-1 not in use, else index in lmadrs of guy connected to +chsstm: block 10 ;time transaction started +.vector lmpkt(%cpmxw) + +sptr: 0 ;byte ptr into output buffer +screen: block 95.*37./5+1 ;space for output to be stored till block IOT +ttyfil: block 1000 +pictur: block 455.*18. ;area reserved for picture + +constants +variables + + ;top end of core: start of USRNAM file. +usrpag==<.+1777>/2000 +usrfil==usrpag*2000 +LS2ORG==USRFIL +end name