github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-01 22:42:26 +00:00
Code Issues Releases Wiki Activity

Extract source files from archives; put them in SYSEN3.

Browse Source 
Remove archive files from alan, cstacy, and sra.
This commit is contained in:
Lars Brinkhoff
2016-12-20 07:59:00 +01:00
committed by Eric Swenson
parent 918cb9e155
commit e954553d3a
11 changed files with 1764 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile
View File

@@ -2,9 +2,9 @@ EMULATOR ?= simh
# The directores listed in SRC, DOC, and BIN are put on the sources tape.
SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \
midas _teco_ emacs emacs1 rms klh syshst sra mrc ksc eak cstacy \
gren bawden _mail_ l lisp liblsp libdoc comlap lspsrc nilcom \
rwk inquir acount gz sys decsys alan ecc
midas _teco_ emacs emacs1 rms klh syshst sra mrc ksc eak gren \
bawden _mail_ l lisp liblsp libdoc comlap lspsrc nilcom rwk \
inquir acount gz sys decsys ecc
DOC = info _info_ sysdoc kshack _teco_ emacs emacs1
BIN = sysbin device emacs _teco_ inquir

20
build/build.tcl
View File

@@ -214,6 +214,8 @@ respond "*" ":print sys2;..new. (udir)\r"
type ":vk\r"
respond "*" ":print sys3;..new. (udir)\r"
type ":vk\r"
respond "*" ":print cstacy;..new. (udir)\r"
type ":vk\r"
respond "*" ":midas sysbin;_.teco.;teco\r"
expect ":KILL"
@@ -350,7 +352,7 @@ respond "*" ":link device;jobdev ar,device;jobdev arc\r"
respond "*" ":midas device;jobdev d_syseng;dskdev\r"
expect ":KILL"
respond "*" ":midas sysbin;_ar1:cstacy;whoj\r"
respond "*" ":midas sysbin;_sysen3;whoj\r"
expect ":KILL"
respond "*" ":link sys1;ts talk,sysbin;whoj bin\r"
type ":vk\r"
@@ -558,7 +560,7 @@ respond "*" ":link sys2;ts chtn,sysbin;chtn bin\r"
respond "*" ":midas sys;ts ttloc_sysen1;ttloc\r"
expect ":KILL"
respond "*" ":midas device;jobdev dp_ar5:alan;dpdev 19\r"
respond "*" ":midas device;jobdev dp_sysen3;dpdev\r"
expect ":KILL"
respond "*" ":midas sys1;ts quote_sysen1;limeri\r"
@@ -747,19 +749,11 @@ respond "*" ":link sys3;ts sned,sys;ts send\r"
# NICNAM
respond "*" ":midas sys2;ts nicnam_ar2:cstacy;nicnam\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "*" ":midas sys2;ts nicnam_sysen3;nicnam\r"
expect ":KILL"
# NICWHO
respond "*" ":midas sys2;ts nicwho_ar2:cstacy;nicwho\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "Use what filename instead?" "dsk:\r"
respond "*" ":midas sys2;ts nicwho_sysen3;nicwho\r"
expect ":KILL"
# reatta
@@ -1006,7 +1000,7 @@ respond "*" ":midas sys2;ts photo_sysen2;photo\r"
expect ":KILL"
# TYPE8
respond "*" ":midas sys;ts type8_sra;ar3:type8\r"
respond "*" ":midas sys;ts type8_sysen3;type8\r"
expect ":KILL"
# HOST

BIN
src/alan/ar5.midas
View File

Binary file not shown.

BIN
src/cstacy/ar1.src1
View File

Binary file not shown.

BIN
src/cstacy/ar2.src2
View File

Binary file not shown.

BIN
src/sra/ar3.gz_mid
View File

Binary file not shown.

693
src/sysen3/dpdev.19 Normal file
View File

@@ -0,0 +1,693 @@
;;;-*-Midas-*-
TITLE Dissociated Press Device
a=1
b=2
c=3
d=4
e=5
f=6
t=10 ;T & TT saved by interrupts
tt=11
ct=16
p=17
call=pushj p,
return=popj p,
jcall==jrst
save=push p,
rest=pop p,
dsk==d
boj==b
tty==t
%fojb==1_17. ;We have a superior, so act as an OJB handler.
;;Next 4 are the open mode. Must be kept in order!
%fnrf==1_16. ;Don't set the reference date.
%fimg==1_15. ;Image, not ascii.
%fblk==1_14. ;Block, not unit.
%fout==1_13. ;Output, not input.
%fdir==1_12. ;Luser asked for a directory listing.
%fval==1_11. ;BOJ interrupts clear this "valid" bit.
%fiot==1_10. ;Luser last seen in an IOT.
%fsio==1_9 ;Luser last seen in a SIOT.
%fhak==1_8 ;For directory hack.
define syscall name,args
.call [setz ? sixbit "name" ? args(400000)]
termin
ifndef reprtp, reprtp==0
define report &msg&
ifn reprtp,[
call [ call $report
.length msg
ascii msg]]
termin
define error &msg&
call [ call $error
.length msg
ascii msg]
termin
pdllen==100.
.vector pdl(pdllen)
go: move p,[-pdllen,,pdl-1]
goinit: setzb ct,0 ;Clear position and flags.
move tt,[-4,,[ .roption,,a
.rsuppr,,b
.runame,,uname
.rxuname,,xuname
]]
.suset tt
tlo a,%opint\%opopc
jumpl b,goset
tlo a,%opojb
tro %fojb
syscall open,[[%tjdis\.uao,,tty] ? [sixbit "tty"]]
.lose %lssys
tlne a,%opddt
.value [asciz ""]
report "Greetings!"
goset: move tt,[-3,,[ .soption,,a
.s40addr,,[forty]
.smsk2,,[1_boj]
]]
.suset tt
jrst begin
.vector args(12.) ;Args returned by JOBCAL go here.
begin: syscall open,[[10\.bio,,boj] ? [sixbit "boj"]]
done ;he went away?
move tt,[-12.,,args]
syscall jobcal,[movei boj ? tt ? movem t]
done ;he went away?
tlne t,60000 ;close? (Huh?)
done
jrst @.+1(t)
open ;.open
opndie ;.iot
mlink ;mlink
opndie ;.reset
opndie ;.rchst
opndie ;.access
fdele ;.fdele (delete or rename)
opndie ;.fdele (renmwo)
opndie ;.call
mlink: report "Make link"
syscall mlink,[%clerr,,a ? [sixbit "dsk"]
args+1 ? args+2 ? args+3
args+0 ? args+5 ? args+6]
jrst opnerr
onesho: .call jbrt
done ;perhaps he gave up
done
fdele: skipe args+0
jrst rename
report "Delete"
syscall delete,[%clerr,,a ? [sixbit "dsk"]
args+1 ? args+2 ? args+3]
jrst opnerr
jrst oneshot
rename: report "Rename"
syscall rename,[%clerr,,a ? [sixbit "dsk"]
args+1 ? args+2 ? args+3
args+0 ? args+5]
jrst opnerr
jrst oneshot
opndie: error "Unexpected opcode from initial JOBCAL"
;;;Come here with error code in A.
opnerr: report "Open error"
hrlz a,a
syscall jobret,[movei boj ? a]
done ;perhaps he punted
done
.vector fname(4) ;filename
.scalar flen ;It's length in 7-bit bytes, corrected for
;^C lossage.
.scalar fccct ;Just how many ^C's were there?
.scalar fobyt ;Byte size file was written with.
.scalar folen ;Files length in those bytes.
open: move tt,args+5 ;get open mode
trne tt,777760 ;don't support other funny bits
jrst [movei a,%ensmd ? jrst opnerr]
dpb tt,[.bp %fnrf\%fblk\%fimg\%fout,0] ;set it in flags
move tt,args+4 ;save filename
movem tt,fname
move tt,[args+1,,fname+1]
blt tt,fname+3
move a,fname+1
move b,fname+2
camn a,[sixbit ".file."] ;Check for magic names.
came b,[sixbit "(dir)"]
skipa
tro %fdir
camn a,[sixbit "m.f.d."]
came b,[sixbit "(file)"]
skipa
tro %fdir
trne %fdir ;We don't support image mode directories
trnn %fimg\%fout ; or output to directories.
skipa
jrst [movei a,%ensmd ? jrst opnerr]
trnn %fout
jrst iopen ;open for input
oopen: movei a,%ensio ;open for output
jrst opnerr ;We don't do output yet.
iopen: move tt,[.uai,,dsk]
tlne %fnrf ;Respect reference date if so requested.
tlo tt,%donrf
syscall open,[%clerr,,a ? tt ? [sixbit "dsk"]
fname+1 ? fname+2 ? fname+3]
jrst opnerr
syscall rfname,[%clerr,,ercode ? movei dsk ? movem tt
movem fname+1 ? movem fname+2 ? movem fname+3]
call lssys ;I don't know about this...
trne %fdir ;Can't take length of a directory.
jrst noflln
syscall fillen,[%clerr,,ercode ? movei dsk ? movem flen
movem tt ? movem fobyt ? movem folen]
call lssys
setzm fccct
move t,fobyt
cain t,7 ;If it was written in 7-bit bytes, length
jrst noflln ; must be OK.
move t,flen
jumpe t,noflln ;Can't argue with a 0 length file.
move t,flen
subi t,4 ;check out last 4 characters.
.access dsk,t
repeat 4,[
.iot dsk,t
cain t,3
aosa fccct
setzm fccct]
movn t,fccct
addm t,flen
noflln: ldb tt,[.bp %fimg\%fblk\%fout,0]
lsh tt,6
addi tt,22
syscall jobsts,[%clerr,,ercode ? movei boj ? tt
fname ? fname+1 ? fname+2 ? fname+3]
call lssys
syscall rfname,[movei boj ? movem tt ? movem juname ? movem jjname]
jfcl ;it was only for debugging.
trnn %fimg\%fblk
jrst [ ;;If user is using .UAI mode, then we MUST revert to .UAO
;;because otherwise there is no place to remember which
;;character in a word he has read!
syscall open,[[10\.uao,,boj] ? [sixbit "boj"]]
done ;he gave up?
jrst .+1]
.call jbrt
done ;He gave up?
call outinit ;Gotcha! Can't punt as easily now...
trnn %fdir
jrst dp
dirlp: .iot dsk,a ;What a pain directories are!
jumpl a,outeof
cail a,"A
caile a,"Z
jrst [cail a,"a
caile a,"z
trz %fhak
jrst dirupc]
troe %fhak
addi a,"a-"A
dirupc: call out
jrst dirlp
.scalar corlen ;Length adjusted to fit in our address space.
dp: skipn t,flen ;Zero length files are a pain.
jrst outeof
movem t,corlen
subi t,1
idivi t,5*2000
addi t,1
caig t,400-fpage ;Grabbing infinite core?
jrst dpnurk ;Nope.
move t,[<1000000-fbase>*5] ;That's fucking big!
movem t,corlen
movei t,400-fpage
dpnurk: imul t,[-1,,0]
hrri t,fpage
.access dsk,[0]
syscall corblk,[%clerr,,ercode ? movei %cbndr
movei %jself ? t
movei dsk]
call lssys
move c,flen
call rndinit ;Initialize random number generator.
call rndpos
dplp: movei tt,20.
call rndnum ;Between 5 and 24. characters in a run.
addi tt,5
move t,c ;Where will that put us?
sub t,tt
jumple t,dpdone ;Beyond the end? then finish up.
sub c,tt ;New count.
hrrei d,-3(tt) ;Keep count in d. Zap all but three.
charlp: jsp t,inwrap
call out
sojg d,charlp
jsp t,inwrap
move d,a
call out
jsp t,inwrap
move e,a
call out
jsp t,inwrap
move f,a
call out
call rndpos
srchlp: ildb a,inbp
came a,d
sojg b,srchlp
came a,d
jrst [jsp t,wrap ? jrst srchlp]
sosg b
jsp t,wrap
save b
save inbp
jsp t,inwrap
came a,e
jrst nope
jsp t,inwrap
came a,f
jrst nope
rest (p)
rest (p)
jrst dplp
nope: rest inbp
rest b
jrst srchlp
dpdone: jumpe c,outeof
jsp t,inwrap
call out
soja c,dpdone
.scalar inbp
rndpos: move tt,corlen
call rndnum
move b,corlen
sub b,tt
move t,tt
idivi t,5
move tt,(tt)[440700,,fbase ? 350700,,fbase ? 260700,,fbase
170700,,fbase ? 100700,,fbase]
add tt,t
movem tt,inbp
return
inwrap: ildb a,inbp
sojg b,(t)
wrap: move tt,[440700,,fbase]
movem tt,inbp
move b,corlen
jrst (t)
rndnum: save tt
call random
tlz t,400000
rest tt
idiv t,tt
return
buflen=100.
.vector outbuf(buflen)
.scalar outbp,outct
;;;Call here to output character in A.
out: idpb a,outbp
sosle outct
return
call stuf
;;;Call here to initialize output.
outini: move tt,[440700,,outbuf]
movem tt,outbp
movei tt,buflen*5
movem tt,outct
return
;;;Jump hear at EOF.
outeof: movei a,buflen*5
sub a,outct
jrst eof
;;;Call this routine whenever the output buffer is full.
stuf: save a
trnn %fimg\%fblk
jrst stuf7
report "Stuffing..."
move a,[-buflen,,outbuf]
add ct,[400000,,buflen] ;Sign bit means that A contains a
;correction to the position.
.iot boj,a
tlz ct,400000
rest a
return
stuf7: report "Stuffing in 7 bit mode..."
movei a,buflen*5
add ct,[400000,,buflen*5] ;Sign bit means that A contains a
;correction to the position.
move tt,[440700,,outbuf]
syscall siot,[%clerr,,ercode ? movei boj ? tt ? a]
call lssys
tlz ct,400000
rest a
return
;;;Jump here at end of file. A should contain the number of characters
;;;left over in the output buffer.
eof: trnn %fimg\%fblk
jrst eof7
report "EOF"
idivi a,5
move tt,[ascii ""]
dpb tt,(b)[4400,,outbuf(a) ? 3500,,outbuf(a) ? 2600,,outbuf(a)
1700,,outbuf(a) ? 1000,,outbuf(a)]
skipe b
aos a
move b,a
hlri b,400000
imul a,[-1,,0]
hrri a,outbuf
add ct,b
.iot boj,a
tlz ct,400000
jrst eoflp
eof7: report "EOF7"
move b,a
hrli b,400000
add ct,b
move tt,[440700,,outbuf]
syscall siot,[%clerr,,ercode ? movei boj ? tt ? a]
call lssys
tlz ct,400000
eoflp: trne %fval ;Do we understand the situation?
.hang ;Yep, twiddle thumbs.
tro %fval ;Set valid flag.
trnn %fiot\%fsio ;Luser last seen in IOT or SIOT?
jrst eoflp ;Nope. That was fast!
move a,iot.ct
tlzn a,400000
jrst gotct
hlre b,iot.a
trnn %fimg\%fblk
movn b,iot.a
add a,b
gotct: subm ct,a ;We have given him C(A) words since then.
hlre b,args+0
trnn %fblk
movn b,args+0
add a,b
jumpe a,eoflp ;Which is just what he wanted!
trnn %fsio ;SIOT and block mode just return.
trne %fblk
jrst wakeup
trne %fimg ;.UII gets %piioc if you IOT beyond eof
jrst ioceof
trnn %fval ;Last chance to back out loser!
jrst eoflp
;;Suppose he pclsrs and does a SIOT? He gets a ^C.
.iot boj,[-1,,3]
jrst eoflp
ioceof: trnn %fval ;Last chance to back out loser!
jrst eoflp
;;Suppose he pclsrs and does a SIOT? He gets an error anyway.
syscall jobioc,[%clerr,,ercode ? movei boj ? movei 2]
call lssys ;suppose he goes away?
jrst eoflp
wakeup: .call jbrt
jrst eoflp
jrst eoflp
rndlen==71. ;Canonical random number generator.
rndoff==35.
.vector rnd(rndlen)
.scalar rnd1,rnd2
;;;Returns a random number in T. This algorithm is a known winner.
random: sosge t,rnd1
jrst [movei t,rndlen-1 ? movem t,rnd1 ? jrst .+1]
sosge tt,rnd2
jrst [movei tt,rndlen-1 ? movem tt,rnd2 ? jrst .+1]
move t,rnd(t)
addb t,rnd(tt)
return
;;;Call here to initialize random number generator.
rndini: save a
movei a,rndoff-1
movem a,rnd2
movei a,rndlen-1
movem a,rnd1
move tt,[171622221402]
rndilp: move t,tt ;This initialization algorithm is stolen
muli t,3125. ; from MacLisp. There is no reason to
div t,[377777777741] ; believe that IT is particularly good.
tlcn a,400000
jrst [hrlm tt,rnd(a) ? jrst rndilp]
hrrm tt,rnd(a)
sojge a,rndilp
rest a
return
intacs==t_6+2 ;T and TT saved
tsint: intacs,,p
0 ? 1_boj ? 0 ? 1_boj ? bojint
tsintl==.-tsint
bojint: move tt,[-12.,,args]
syscall jobcal,[movei boj ? tt ? movem t]
jrst disint
tlne t,60000 ;time to close up shop!
done
trz %fiot\%fsio\%fval
jrst @.+1(t)
caldie ;.open
iot ;.iot
caldie ;mlink
reset ;.reset
rchst ;.rchst
cantdo ;.access
caldie ;.fdele (delete or rename)
cantdo ;.fdele (renmwo)
docall ;.call
.scalar iot.a,iot.ct ;save position at last IOT
iot: report "IOT"
tlnn t,%jgsio ;Is this IOT or SIOT?
troa %fiot
tro %fsio
movem a,iot.a ;record position
movem ct,iot.ct
disint: syscall dismis,[%clerr,,ercode ? %clbit,,intacs ? p]
call lssys
reset: report "RESET"
.call jbrt
jrst disint
jrst disint
docall: move t,args+0
camn t,[sixbit "fillen"]
jrst fillen
camn t,[sixbit "rfdate"]
jrst rfdate
camn t,[sixbit "lnkedp"]
jrst lnkedp
report ".CALL" ;stump
move tt,args+0
trne %fojb
call 6type
cantdo: movei tt,%ebddv
report "Wrong type device"
calerr: hrlz tt,tt
syscal jobret,[movei boj ? tt]
jrst disint
jrst disint
caldie: error "Unexpected opcode from JOBCAL on open channel"
.vector vals(12.) ;JOBRET values typically found here
jbrt: setz ;Common JOBRET call.
sixbit "jobret" ;Skips, returns no values.
movei boj
setzi 1
jbrtv: setz ;Another common JOBRET call.
sixbit "jobret" ;Skips, aobjn pointer to values in TT.
movei boj
movei 1
setz tt
rchst: report "RCHST"
move tt,[fname,,vals]
blt tt,vals+3
hrrei tt,-1
movem tt,vals+4
move tt,[-5,,vals]
.call jbrtv
jrst disint
jrst disint
rfdate: report "RFDATE"
trne %fdir ;Guess what doesn't have a reference date...
jrst cantdo
syscall rfdate,[%clerr,,ercode ? movei dsk ? movem vals+0]
call lssys
calrt1: move tt,[-1,,vals]
.call jbrtv
jrst disint
jrst disint
lnkedp: report "LNKEDP"
setzm vals+0 ;We are never a link.
jrst calrt1
fillen: report "FILLEN"
trne %fdir ;Directories don't have a length...
jrst cantdo
move t,flen
trnn %fimg\%fblk
jrst filen7
idivi t,5
skipe tt
aos t
skipa tt,[36.]
filen7: movei tt,7
movem t,vals+0
movem tt,vals+1
move t,fobyt
movem t,vals+2
move t,folen
movem t,vals+3
move tt,[-4,,vals]
.call jbrtv
jrst disint
jrst disint
$repor: trne %fojb
jrst repor1
rest (p)
return
repor1: exch t,(p)
call msg
rest t
return
.scalar ercode,losepc
lssys: exch t,(p)
subi t,2
movem t,losepc
movei t,%lssys
addm t,ercode
rest t
trnn %fojb
call crash
syscall lose,[ercode ? losepc]
.lose %lssys
$error: trnn %fojb
call crash
exch t,(p)
call msg
rest t
rest losepc
sos losepc
syscall lose,[movei 0 ? losepc]
.lose %lssys
msg: save tt
move tt,(t)
movei t,1(t)
hrli t,440700
.iot tty,[^p]
.iot tty,["A]
syscall siot,[movei tty ? t ? tt]
.lose %lssys
.iot tty,[^p]
.iot tty,["A]
rest tt
return
6type: jumpe tt,[.iot tty,["*] ? return]
save t
6typel: setzi t,
lshc t,6
addi t,40
.iot tty,t
jumpn tt,6typel
rest t
return
$done: report "Done."
.logout ;Only die if toplevel
.close dsk,
jfcl
.hang
done==call $done
.scalar crashx,uname,xuname,jjname,juname
;;;AAAIIIIEEEEE!!!!!!
crash: save 0 ;PDUMP misses the flags...
syscall open,[[.uio,,dsk] ? [sixbit "dsk"]
[sixbit "dpdev"] ? uname ? [sixbit "crash"]]
.logout 1, ;Well foo!
setz crashx
syscall pdump,[movei %jself ? movei dsk ? crashx]
.logout 1, ;???
.iot dsk,[jrst crashr]
.iot dsk,[jrst crashr]
.logout 1,
crashr: rest 0
syscall open,[[%tjdis\.uao,,tty] ? [sixbit "tty"]]
.lose %lssys
return
cnstnts:
constants
variables
forty: 0
0
-tsintl,,tsint
fpage==:<<.-1>_-12>+1
fbase=:fpage_12
end go

226
src/sysen3/nicnam.31 Normal file
View File

@@ -0,0 +1,226 @@
;-*- Mode: Midas -*-
TITLE NICNAME - Look up someone in the ARPAnet directory
;CStacy, 2/1/84
SUBTTL Basic definitions
;;; Registers.
X=0 ;Super temporary register.
A=1 ;General registers.
B=2
C=3
D=4
E=5
BP=6 ;Byte pointer.
CHAR=7 ;Character being manipulated.
T=10 ;Temporary
TT=11 ;Temporary+1.
OC==12 ;OUT register.
U1==13 ;4 UUO Registers.
U2==14
U3==15
U4==16
P=17 ;Stack pointer.
;;; I/O Channels
DSKI==12 ;Disk input for host table.
NETI=13 ;Network input.
NETO=14 ;Network output.
TTYO=15 ;TTY typeout.
TTYI=16 ;TTY typein.
NICNAM==43. ;NICNAME TCP server port.
;;; Macros and output routines.
$$OUT==1
.INSRT KSC;MACROS >
.INSRT KSC;IVORY >
.INSRT KSC;OUT >
SUBTTL Interrupt Handler and various returns
POPJ1: AOS (P) ;Skip
CPOPJ: RET ;Return
SYSLOS::
AUTPSY: 0 ;Fatal error JSR here.
DEATH: SKIPE DEBUG ;Come here to log out.
.VALUE [0]
.LOGOUT 1,
TMPLOC 42,{-TSINTL,,TSINT} ;New style interrupts.
INTACS==T_6+7 ;T,TT, and OUT registers preserved.
TSINT: INTACS,,P
0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT
0 ? 1_TTYO ? 0 ? 0 ? MORINT
TSINTL==:.-TSINT
;;; Interrupt dismissal
INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P]
JSR SYSLOS
;;; Console interrupts.
CHRINT: MOVEI T,TTYI ;INTERRUPT CHAR.
.ITYIC T,
JRST INTRET
CAIE T,^S
CAIN T,^G
JRST [.RESET TTYO,
SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI]
.LOSE %LSSYS
JRST FLSIT1]
JRST INTRET
MORINT: OUT(TTYO,("--More--")) ;MORE BREAK.
SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T]
.LOSE %LSFIL
CAIE T,40
CAIN T,177
.IOT TTYI,T
CAIE T,40
JRST FLSIT
OUT(TTYO,("A"))
JRST INTRET
FLSIT: OUT(TTYO,("Flushed"))
FLSIT1: JRST DEATH ;means we are done.
SUBTTL Main program
GO: MOVE P,[-PDLLEN,,PDL-1] ;Init the stack.
MOVEI A,LSTPAG
MOVEM A,FREPAG ;Remember where unallocated core is.
SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL RFNAME,[%CLIMM,,TTYO ? %CLOUT,,B]
.LOSE %LSFIL ;Get truename of TTY.
CAMN B,['TTY,,] ;If device not "TTY"
JRST [ SETOM TRITTY ; must have been translated.
SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL TTYSET,[ %CLIMM,,TTYI
[222222,,222222]
[230222,,220222]]
NOP ; Failure just means no interrupts.
JRST .+1 ]
GO1: .SUSET [.ROPTION,,A] ;Read job option bits.
TLO A,%OPINT\%OPOPC ;Turn on winning-PC and new interrupts.
.SUSET [.SOPTION,,A] ;Set option bits.
.SUSET [.SMASK,,[%PIPDL]] ;PDL overflows are fatal (sure, why not?)
SKIPN TRITTY
.SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]] ;Arm TTY interrupts.
OUT(TTYO,OPEN(UC$IOT))
OUT(,CH(TTYO)) ;Open typeout display as default device.
TLNN A,OPTCMD ;If user forgot JCL
JRST [ OUT(,("AUsage is :NICNAME <ident>.
Do :NICNAME ? for help."))
JRST DEATH ]
.BREAK 12,[..RJCL,,JCLBUF] ;Slurp JCL into buffer.
SETZ A, ;Count characters of JCL.
MOVE BP,[440700,,JCLBUF]
GETJCL: ILDB CHAR,BP
JUMPE CHAR, ENDJCL ;A ^@ ends JCL.
CAIN CHAR,^M ;So do these...
JRST ENDJCL
CAIN CHAR,^_
JRST ENDJCL
CAIN CHAR,^C
JRST ENDJCL
AOS A
JRST GETJCL
ENDJCL: MOVEM A,JCLLEN ;Remember how long tiz.
LOOKUP: MOVEI B,DSKI ;Find the NIC's Internet host address.
MOVE A,FREPAG ;Find free page to use.
CALL NETWRK"HSTMAP ;Map in the host table.
JSR AUTPSY
HRRZM A,FREPAG
AOS FREPAG ;Remember where next free page is.
MOVE A,[440700,,[ASCIZ /SRI-NIC/]]
CALL NETWRK"HSTLOO ;There's only one NICNAME server...
JSR AUTPSY
MOVEM A,SRINIC ;Remember the address.
CONECT: MOVEI A,NETI
MOVEI B,NETO
SYSCAL TCPOPN,[ A ? B ? [-1] ? %CLIMM,,NICNAM ? SRINIC ]
JSR NETLUZ
NETHANG 900.,B,%NSRFS,[%NSOPN,%NSRFN] ;Wait until established.
JSR NETLUZ
OUT(NETO,OPEN(UC$IOT)) ;Open network output channel.
COMAND: HRRZI B,JCLBUF
HRL B,JCLLEN
OUT(NETO,TC(B),EOL) ;Send the JCL to the server.
OUT(NETO,FRC) ; Ensure buffer forced out
SYSCAL FINISH,[%CLIMM,,NETO] ; Wait for transmission ACK
JSR AUTPSY
ANSWR: .IOT NETI,A ;Get character.
JUMPL A,DEATH ;If EOF, channel closed.
.IOT TTYO,A ;Print it on our console.
JRST ANSWR ;Not the most efficient thing...
;;; JSR here for network errors.
;;; NETLUZ, expects (input) channel number in A.
;;; Network errors are fatal and are handled in the standard fashion.
NETLUZ: 0
CALL NETWRK"ANALYZ
JSR AUTPSY
JRST DEATH
PUTCHR: .IOT TTYO,T
RET
SUBTTL Storage
PDLLEN==64. ;Stack length.
LSRPGS==220. ;Number of pages reserved for LSR1.
JCLBFL==10. ;Number of words for JCL buffer.
PDL: BLOCK PDLLEN ;The stack.
DEBUG: 0 ;-1 iff debugging.
JCLBUF: BLOCK JCLBFL ;JCL buffer.
JCLLEN: 0 ;Length of JCL.
TRITTY: 0 ;-1 iff TTY input translated
FREPAG: 0 ;Page number of next free page.
SRINIC: 0 ;Host address of SRI-NIC.
CONSTANTS
VARIABLES
VARCHK
;;; Include network hacking routines:
$$HST3==1
$$HSTMAP==1 ;HOSTS3 file.
$$ARPA==1 ;Hack the ARPA Internet.
$$TCP==1 ;Use TCP/IP.
$$HOSTNM==1 ;Host name file lookup routines.
$$SYMLOOK==1 ;table lookup routine.
$$ANALYZE==1 ;Network Error Analysis Routine
.INSRT SYSENG;NETWRK >
CONSTANTS
VARIABLES
LSTPAG==<.+1777>/2000
END GO

226
src/sysen3/nicwho.30 Normal file
View File

@@ -0,0 +1,226 @@
;-*- Mode: Midas -*-
TITLE NICWHO - Look up someone in the ARPAnet directory
;CStacy, 2/1/84
SUBTTL Basic definitions
;;; Registers.
X=0 ;Super temporary register.
A=1 ;General registers.
B=2
C=3
D=4
E=5
BP=6 ;Byte pointer.
CHAR=7 ;Character being manipulated.
T=10 ;Temporary
TT=11 ;Temporary+1.
OC==12 ;OUT register.
U1==13 ;4 UUO Registers.
U2==14
U3==15
U4==16
P=17 ;Stack pointer.
;;; I/O Channels
DSKI==12 ;Disk input for host table.
NETI=13 ;Network input.
NETO=14 ;Network output.
TTYO=15 ;TTY typeout.
TTYI=16 ;TTY typein.
NICNAM==43. ;NICNAME TCP server port.
;;; Macros and output routines.
$$OUT==1
.INSRT KSC;MACROS >
.INSRT KSC;IVORY >
.INSRT KSC;OUT >
SUBTTL Interrupt Handler and various returns
POPJ1: AOS (P) ;Skip
CPOPJ: RET ;Return
SYSLOS::
AUTPSY: 0 ;Fatal error JSR here.
DEATH: SKIPE DEBUG ;Come here to log out.
.VALUE [0]
.LOGOUT 1,
TMPLOC 42,{-TSINTL,,TSINT} ;New style interrupts.
INTACS==T_6+7 ;T,TT, and OUT registers preserved.
TSINT: INTACS,,P
0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT
0 ? 1_TTYO ? 0 ? 0 ? MORINT
TSINTL==:.-TSINT
;;; Interrupt dismissal
INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P]
JSR SYSLOS
;;; Console interrupts.
CHRINT: MOVEI T,TTYI ;INTERRUPT CHAR.
.ITYIC T,
JRST INTRET
CAIE T,^S
CAIN T,^G
JRST [.RESET TTYO,
SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI]
.LOSE %LSSYS
JRST FLSIT1]
JRST INTRET
MORINT: OUT(TTYO,("--More--")) ;MORE BREAK.
SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T]
.LOSE %LSFIL
CAIE T,40
CAIN T,177
.IOT TTYI,T
CAIE T,40
JRST FLSIT
OUT(TTYO,("A"))
JRST INTRET
FLSIT: OUT(TTYO,("Flushed"))
FLSIT1: JRST DEATH ;means we are done.
SUBTTL Main program
GO: MOVE P,[-PDLLEN,,PDL-1] ;Init the stack.
MOVEI A,LSTPAG
MOVEM A,FREPAG ;Remember where unallocated core is.
SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL RFNAME,[%CLIMM,,TTYO ? %CLOUT,,B]
.LOSE %LSFIL ;Get truename of TTY.
CAMN B,['TTY,,] ;If device not "TTY"
JRST [ SETOM TRITTY ; must have been translated.
SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL TTYSET,[ %CLIMM,,TTYI
[222222,,222222]
[230222,,220222]]
NOP ; Failure just means no interrupts.
JRST .+1 ]
GO1: .SUSET [.ROPTION,,A] ;Read job option bits.
TLO A,%OPINT\%OPOPC ;Turn on winning-PC and new interrupts.
.SUSET [.SOPTION,,A] ;Set option bits.
.SUSET [.SMASK,,[%PIPDL]] ;PDL overflows are fatal (sure, why not?)
SKIPN TRITTY
.SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]] ;Arm TTY interrupts.
OUT(TTYO,OPEN(UC$IOT))
OUT(,CH(TTYO)) ;Open typeout display as default device.
TLNN A,OPTCMD ;If user forgot JCL
JRST [ OUT(,("AUsage is :NICWHO <ident>.
Do :NICWHO ? for help."))
JRST DEATH ]
.BREAK 12,[..RJCL,,JCLBUF] ;Slurp JCL into buffer.
SETZ A, ;Count characters of JCL.
MOVE BP,[440700,,JCLBUF]
GETJCL: ILDB CHAR,BP
JUMPE CHAR, ENDJCL ;A ^@ ends JCL.
CAIN CHAR,^M ;So do these...
JRST ENDJCL
CAIN CHAR,^_
JRST ENDJCL
CAIN CHAR,^C
JRST ENDJCL
AOS A
JRST GETJCL
ENDJCL: MOVEM A,JCLLEN ;Remember how long tiz.
LOOKUP: MOVEI B,DSKI ;Find the NIC's Internet host address.
MOVE A,FREPAG ;Find free page to use.
CALL NETWRK"HSTMAP ;Map in the host table.
JSR AUTPSY
HRRZM A,FREPAG
AOS FREPAG ;Remember where next free page is.
MOVE A,[440700,,[ASCIZ /SRI-NIC/]]
CALL NETWRK"HSTLOO ;There's only one NICNAME server...
JSR AUTPSY
MOVEM A,SRINIC ;Remember the address.
CONECT: MOVEI A,NETI
MOVEI B,NETO
SYSCAL TCPOPN,[ A ? B ? [-1] ? %CLIMM,,NICNAM ? SRINIC ]
JSR NETLUZ
NETHANG 900.,B,%NSRFS,[%NSOPN,%NSRFN] ;Wait until established.
JSR NETLUZ
OUT(NETO,OPEN(UC$IOT)) ;Open network output channel.
COMAND: HRRZI B,JCLBUF
HRL B,JCLLEN
OUT(NETO,TC(B),EOL) ;Send the JCL to the server.
OUT(NETO,FRC) ; Ensure buffer forced out
SYSCAL FINISH,[%CLIMM,,NETO] ; Wait for transmission ACK
JSR AUTPSY
ANSWR: .IOT NETI,A ;Get character.
JUMPL A,DEATH ;If EOF, channel closed.
.IOT TTYO,A ;Print it on our console.
JRST ANSWR ;Not the most efficient thing...
;;; JSR here for network errors.
;;; NETLUZ, expects (input) channel number in A.
;;; Network errors are fatal and are handled in the standard fashion.
NETLUZ: 0
CALL NETWRK"ANALYZ
JSR AUTPSY
JRST DEATH
PUTCHR: .IOT TTYO,T
RET
SUBTTL Storage
PDLLEN==64. ;Stack length.
LSRPGS==220. ;Number of pages reserved for LSR1.
JCLBFL==10. ;Number of words for JCL buffer.
PDL: BLOCK PDLLEN ;The stack.
DEBUG: 0 ;-1 iff debugging.
JCLBUF: BLOCK JCLBFL ;JCL buffer.
JCLLEN: 0 ;Length of JCL.
TRITTY: 0 ;-1 iff TTY input translated
FREPAG: 0 ;Page number of next free page.
SRINIC: 0 ;Host address of SRI-NIC.
CONSTANTS
VARIABLES
VARCHK
;;; Include network hacking routines:
$$HST3==1
$$HSTMAP==1 ;HOSTS3 file.
$$ARPA==1 ;Hack the ARPA Internet.
$$TCP==1 ;Use TCP/IP.
$$HOSTNM==1 ;Host name file lookup routines.
$$SYMLOOK==1 ;table lookup routine.
$$ANALYZE==1 ;Network Error Analysis Routine
.INSRT SYSENG;NETWRK >
CONSTANTS
VARIABLES
LSTPAG==<.+1777>/2000
END GO

190
src/sysen3/type8.2 Normal file
View File

@@ -0,0 +1,190 @@
;-*- Midas -*- GZ@MIT-MC, November, 1983
TITLE TYPE8 Type an 8-bit file
T1==1
T2==2
T3==3
T4==4
A=5
B=6 ;Current input byte
C=7 ;Number of bits left in file.
D=10
E=11
IntAC=16
P=17
inch==1
outch==2
tyoch==3
tyich==4
call=<pushj p,>
return=<popj p,>
pdllen==40
.vector pdl(pdllen)
Jclbuf: block 40
^C_35
IDev: sixbit/DSK/
IFn1: 0
IFn2: sixbit/>/
ISnm: 0
define syscal op,args
.call [setz ? sixbit/op/ ? args ((setz))]
termin
tsiot: setz
sixbit/SIOT/
%Climm,,tyoch
T2
T1 ((setz))
define type &string
movei T1,<.length string>
move T2,[440700,,[ascii string]]
.call tsiot
.Lose %LsSys
termin
Tsint: loc 42
-Tsintl,,Tsint
loc Tsint
P
0 ? 1_tyich ? 0 ? <1_tyich>\<1_outch> ? Flush
0 ? 1_outch ? 0 ? 0 ? More
Tsintl==.-Tsint
Flush: movei IntAC,tyich
.ityic IntAC,
jrst intret
caie IntAC,^G
cain IntAC,^S
jrst flush1
intret: syscal dismis,[p]
.Lose %LsSys
flush1: .reset tyoch,
syscal ttyfls,[%clbit,,1 ? %climm,,tyich]
.Lose %LsSys
.iot tyoch,IntAC
Jrst Die
More: push p,T1
push p,T2
type "--More--"
syscal iot,[%clbit,,%tipek ? %climm,,tyich ? %clout,,IntAc]
.Lose %LsFil
caie IntAc,40
cain IntAc,177
.iot tyich,IntAc
caie IntAc,40
jrst [type "Flushed"
jrst Die]
type "A"
pop p,T2
pop p,T1
jrst intret
RSIXTP: return
$$RFN==1
.insrt dsk:syseng;rfn >
FType: move T1,IDev
call 6Type
.iot tyoch,[":]
move T1,ISnm
call 6Type
.iot tyoch,[";]
move T1,IFn1
call 6Type
.iot tyoch,[40]
move T1,IFn2
6Type: setz T2,
rotc T1,6
addi T2,40
.iot tyoch,T2
jumpn T1,6Type
return
Begin: move p,[-pdllen,,pdl-1]
syscal open,[%clbit,,.uao\%tjdis ? %climm,,tyoch ? [sixbit/TTY/]]
.Lose %LsFil
.suset [-2,,[.rHsname,,ISnm ? .rXuname,,IFn1]]
.break 12,[..rJCL,,Jclbuf]
skipn Jclbuf
jrst Help
ldb T1,[261600,,Jclbuf]
cain T1,<ascii/?î/>_-26
jrst Help
movei B,IDev
move D,[440700,,Jclbuf]
call RFN"rfn
syscal open,[%clbit,,.uii ? %climm,,inch ? IDev ? IFn1 ? IFn2 ? ISnm]
jrst [type "A"
call FType
type " - file not found."
jrst Die]
syscal fillen,[%climm,,inch ? %clout,,C]
.Lose %LsFil
jumpe C,Die
.iot inch,T1 ;Flush COM header if any
camn T1,[sixbit/DSK8/]
sosa C
.access inch,[0]
; .suset [.rMemt,,T1]
; movei T2,FBuf(C)
; camg T2,T1
; jrst Snarf
; movei T1,1777(T2)
; trz T1,1777
; .suset [.sMemt,,T1]
;Snarf: move T1,[004400,,FBuf]
; move T2,C
; syscal siot,[%climm,,inch ? T1 ? T2]
; .Lose %LsFil
; .close inch,
syscal open,[%clbit,,.uao ? %climm,,outch ? [sixbit/TTY/]]
.Lose %LsFil
syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit /TTY/]]
.Lose %LsFil
; syscal ttyset,[%climm,,tyich ? [424242,,424242] ? [434242,,424242]]
syscal ttyset,[%climm,,tyich ? [222222,,222222] ? [230222,,220222]]
.Lose %LsSys
.suset [-2,,[.sOption,,[optint,,] ? .sMSK2,,[<1_tyich>\<1_outch>]]]
; move B,[441000,,FBuf]
; imuli C,4
;outp: sojl C,Die
; ildb T1,B
; cain T1,^Z
; jrst Die
; .iot outch,T1
; jrst outp
outp: sojl C,Die
.iot inch,A
move B,[441000,,A]
outp1: ildb T1,B
cain T1,^Z
jrst Die
.iot outch,T1
tlne B,700000
jrst outp1
jrst outp
Help: type "A:TYPE8 input file
Types an ascii file encoded in 8-bit bytes. Stops at first ^Z."
Die: .break 16,120000
VARIAB
junk: CONSTA
FBuf: 0
end begin

419
src/sysen3/whoj.26 Normal file
View File

@@ -0,0 +1,419 @@
;-*- Mode: MIDAS -*-
TITLE Users on ITS (crock, crock)
;;; This is a little MLDEV crock to keep me less annoyed until the
;;; ITS RSSER stuff gets converted. It takes JCL, which should be
;;; the name of an ITS machine. ---CStacy
;Registers.
X=0 ;Super temporary register.
A=1 ;General
B=2 ;Purpose.
C=3
D=4
E=5
J=6 ;JNAME.
T=7 ;Temporary.
TT=10 ;Temporary, T+1.
CHAR=11 ;Character being manipulated.
BP=12 ;Byte pointer.
P=17 ;Stack pointer.
PDLLEN==32. ;Stack length.
;Channels.
DSKI=14 ;Mldev input.
TTYO=15 ;Typeout.
TTYI=16 ;Typein (for **MORE** and ^G, ^S).
;Buffer size.
BUFLEN=600.
BUFSIZ=5*BUFLEN
;System call.
DEFINE SYSCAL OP,ARGS
.CALL [SETZ ? SIXBIT/OP/ ? ARGS ((SETZ))]
TERMIN
;Type out an ascii string.
DEFINE TYPE CH,&STRING
MOVEI T,<.LENGTH STRING>
MOVE TT,[440700,,[ASCII STRING]]
SYSCAL SIOT,[%CLIMM,,CH ? TT ? T]
.LOSE %LSFIL
TERMIN
;;; Uppercase a character
DEFINE UPPER CHR
CAIL CHR,141
CAILE CHR,172
CAIA
SUBI CHR,40
TERMIN
;;; Print a column.
DEFINE PRINT COLS
MOVSI A,-COLS
SETO X,
PUSHJ P,PRTCOL
TERMIN
;;; Skip a column.
DEFINE SKIP COLS
MOVSI A,-COLS
SETZ X,
PUSHJ P,PRTCOL
TERMIN
;;; Print a line.
DEFINE OUTLIN
SETO X,
PUSHJ P,PRTLIN
TERMIN
;;; Skip a line.
DEFINE FLUSH
SETZ X,
PUSHJ P,PRTLIN
TERMIN
;;; Print out or skip a column from BP.
;;; Width as AOBJN in A.
PRTCOL: ILDB CHAR,BP
CAIN CHAR,^L ;Formfeed ends buffer,
JRST DONE
CAIN CHAR,^C
JRST DONE
CAIN CHAR,^M ;Cariage return ends column.
JRST [ ILDB CHAR,BP
POPJ P, ]
SKIPE X
.IOT TTYO,CHAR
AOBJN A,PRTCOL
POPJ P,
;;; Print out or skip a line from BP.
PRTLIN: ILDB CHAR,BP
CAIN CHAR,^L
JRST DONE
CAIN CHAR,^C
JRST DONE
SKIPE X
.IOT TTYO,CHAR
CAIE CHAR,^J
JRST PRTLIN
POPJ P,
;;;Data
PDL: BLOCK PDLLEN ;The stack.
TCMXH: 0 ;Horizontal screen size.
NUSERS: 0 ;Unames printed this line in :USERS.
JCL: BLOCK 20 ;(Just need two chars.)
DEVTAB: ASCIZ /MC/,[ASCIZ /MCTTY:.FILE. (DIR)/]
ASCIZ /AI/,[ASCIZ /AITTY:.FILE. (DIR)/]
ASCIZ /MX/,[ASCIZ /MXTTY:.FILE. (DIR)/]
ASCIZ /MD/,[ASCIZ /MDTTY:.FILE. (DIR)/]
ASCIZ /ML/,[ASCIZ /MLTTY:.FILE. (DIR)/]
; ASCIZ /DM/,[ASCIZ /DMTTY:.FILE. (DIR)/]
NDEVS==.-DEVTAB
LCLDEV: [ASCIZ /TTY:.FILE. (DIR)/]
SAVEBP: 0
TOTRY: BLOCK 4 ;List of files to read.
LOOPER: 0
MANY: 0
MACNAM: 0 ;ASCII name of this machine.
LINES: 0 ;Number of lines in buffer.
BUFFER: BLOCK BUFLEN+1 ;The buffer.
FORTY: 0
0
-TSINTL,,TSINT
INTACS==T_6+2 ;T and TT saved on interrupt.
TSINT: INTACS,,P
0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT
0 ? 1_TTYO ? 0 ? 0 ? MORINT
TSINTL==:.-TSINT
CHRINT: MOVEI T,TTYI
.ITYIC T,
JRST INTRET
CAIE T,^S
CAIN T,^G
JRST [.RESET TTYO,
SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI]
.LOSE %LSSYS
JRST FLSIT1]
INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P]
.LOSE %LSSYS
MORINT: TYPE TTYO,/--More--/
SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T]
.LOSE %LSFIL
CAIE T,40
CAIN T,177
.IOT TTYI,T
CAIE T,40
JRST FLSIT
TYPE TTYO,/A/
JRST INTRET
FLSIT: TYPE TTYO,/Flushed/
FLSIT1: .SUSET [.ROPTION,,T]
TLNN T,%OPBRK
JRST DEATH
.BREAK 16,164000
JRST DEATH
GO: MOVE P,[-PDLLEN,,PDL]
SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL CNSGET,[%CLIMM,,TTYO ? %CLOUT,,X ? %CLOUT,,TCMXH]
.LOSE %LSFIL
SYSCAL TTYSET,[%CLIMM,,TTYI ? [222222,,222222] ? [230222,,220222]]
.LOSE %LSFIL
.SUSET [.ROPTION,,A]
.SUSET [.RXJNAME,,J] ;Find out jname.
CAMN J,[SIXBIT /TALK/]
JRST [ TYPE TTYO,/ANetwork comlinks are unimplemented.
To talk to someone on the same machine, use "^_C USER"./
JRST DEATH ]
TLO A,%OPINT\%OPOPC
.SUSET [.S40ADDR,,[20,,FORTY]]
.SUSET [.SOPTION,,A]
.SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]]
SYSCAL SSTATU,[ REPEAT 5, %CLOUT,, X ?
%CLOUT,,A]
.LOSE %LSFIL
MOVE BP,[440700,,MACNAM]
MOVE B,[440600,,A]
ILDB CHAR,B
ADDI CHAR,40
IDPB CHAR,BP
ILDB CHAR,B
ADDI CHAR,40
IDPB CHAR,BP ;ITS name now stored in Ascii.
GETJCL: .BREAK 12,[..RJCL,,JCL] ;Read JCL.
SKIPN JCL ;If no JCL given
JRST [ MOVE A,LCLDEV ;Use the local machine.
MOVEM A,TOTRY
JRST DOMAC ]
PARSE: MOVE BP,[440700,,JCL] ;Crockishly parse the JCL.
MOVSI E,-NDEVS ;AOBJN loop for user tokens looked at.
PARSE1: PUSHJ P,PARSE2 ;Parse another TOTRY entry.
JRST PARSE9 ; If no more JCL, quit parsing.
AOBJN E,PARSE1 ;Parse up to 4 hosts.
PARSE9: HRRZ E,E ;See how many entries parsed.
CAILE E,1 ;If more than one
SETOM MANY ; remember we need labeling.
JRST DOMAC ;Now go read tty dirs off machines.
;;; Parse from BP, putting entry in TOTRY table.
;;; Skip return unless end of JCL
PARSE2: MOVEM BP,SAVEBP
MOVSI A,-NDEVS ;AOBJN loop for machines.
PARSE3: MOVE BP,SAVEBP ;Use the original BP.
PUSHJ P,JCLHAK ;Get char from input.
POPJ P,
CAIN CHAR,"* ;A "*" MEANS show all four machines.
JRST [ MOVSI A,-NDEVS ; Try all machines...
HRRZ D,DEVTAB(A)
MOVEM D,TOTRY(A)
AOBJN A,.-2 ; Loop for all machines.
SETOM MANY
JRST DOMAC ] ; Dont look at other JCL.
HRLZI B,440700 ;Make Bp to a machine name.
HRR B,DEVTAB(A)
ILDB C,B ;Get char of machine name,
CAME C,CHAR ;Match?
JRST PARSE4 ; No - punt this machine.
PUSHJ P,JCLHAK ;Yes - get second char from input.
POPJ P,
ILDB C,B ;Get char of machine name,
CAMN C,CHAR ;Match?
JRST [ HRRZ D,DEVTAB(A) ; Yes - Have found a machine.
MOVEM D,TOTRY(E) ; Remember its TTY: directory string.
JRST POPJ1] ; And skip-return with modified BP.
PARSE4: AOBJN A,PARSE3 ;Try the next machine.
TYPE TTYO,/AUnknown ITS name specified./
JRST DEATH
;;; Get next JCL char from BP. Skip-returns if wins.
JCLHAK: ILDB CHAR,BP
JUMPE CHAR,CPOPJ ;^@
CAIN CHAR,40 ;SPACE.
JRST JCLHAK
CAIN CHAR,3 ;^C.
POPJ P,
CAIN CHAR,37 ;^_.
POPJ P,
CAIN CHAR,15 ;^M.
POPJ P,
UPPER CHAR
JFCL
POPJ1: AOS (P)
CPOPJ: POPJ P,
DOMAC: MOVSI A,-NDEVS ;AOBJN pointer to filename addresses.
MLOPN: MOVEM A,LOOPER
HRRZ BP,TOTRY(A)
JUMPE BP,DEATH ;Empty address means end of table.
HRLI BP,440700
SKIPN MANY ;If only one machine
JRST MLOPN1 ; dont bother labeling it.
TYPE TTYO,/A
[MIT-/
ILDB CHAR,BP
.IOT TTYO,CHAR
ILDB CHAR,BP
.IOT TTYO,CHAR
TYPE TTYO,/]A/
HRLI BP,440700
MLOPN1: PUSHJ P, HAKLCL ;Fix up local machine spec if needed.
SETZM BUFFER
MOVE T,[BUFFER,,BUFFER+1]
BLT T,BUFFER+BUFLEN-1 ;Clear out the previous contents.
SYSCAL SOPEN,[%CLBIT,,.UAI ? %CLIMM,,DSKI ? BP]
JRST [ TYPE TTYO,"Unable to reach foreign host with TCP/MLDEV."
JRST DONE ]
MOVE T,[440700,,BUFFER]
MOVEI TT,BUFSIZ
SYSCAL SIOT,[%CLIMM,,DSKI ? T ? TT] ;Slurp in TTY list.
.LOSE %LSFIL
.CLOSE DSKI,
CNTLNS: MOVE BP,[440700,,BUFFER] ;Count number of LINES in buffer.
SETZ A,
CNTLN1: ILDB CHAR,BP
CAIN CHAR,^L
JRST LIST
CAIN CHAR,^J
AOS A
JRST CNTLN1
LIST: SUBI A,2 ;First, last lines have a ^J too.
MOVEM A,LINES ;Save away count.
MOVE BP,[440700,,BUFFER] ;Get BP to buffer.
ILDB CHAR,BP ;Gobble leading
; .IOT TTYO,CHAR ;Ker
ILDB CHAR,BP
; .IOT TTYO,CHAR ;Chink.
CAMN J,[SIXBIT /WHOM/] ;WHOM prints it all.
JRST WHOM
CAME J,[SIXBIT /WHO/] ;WHO prints one column.
CAMN J,[SIXBIT /W/]
JRST WHO
CAME J,[SIXBIT /WW/] ;WHOJ prints two columns.
CAMN J,[SIXBIT /WHOJ/]
JRST WHOJ
CAME J,[SIXBIT /USERS/] ;U is very brief.
CAMN J,[SIXBIT /U/] ;U is very brief.
JRST USERS
JRST DEATH ;Gee, how did we get invoked?
WHOM: SETO X,
WHOM1: PUSHJ P,PRTLIN ;Print every single line.
JRST WHOM1
WHOJ: FLUSH ;Skip first line.
MOVE B,LINES
SUBI B,1 ;Not printing first or last
JUMPE B,DONE
WHOJ1: PRINT 4. ;Print the Tnn.
PRINT 6. ;Print the UNAME.
PRINT 7. ;Print the JNAME.
.IOT TTYO,[^M]
.IOT TTYO,[^J]
FLUSH ;Skip to the end of the line.
SOJN B,WHOJ1
JRST DONE
WHO: FLUSH
MOVE B,LINES
SUBI B,1 ;Not printing first or last
JUMPE B,DONE
WHO1: PRINT 4. ;Print the Tnn.
PRINT 6. ;Print the UNAME.
FLUSH ;Skip to the end of the line.
.IOT TTYO,[^M]
.IOT TTYO,[^J]
SOJN B,WHO1
JRST DONE
USERS: SETZM NUSERS
USERS1: FLUSH ;Next user; skip line.
ILDB CHAR,BP
CAIE CHAR,"T ;If this is not a TTY number
JRST USERS1 ; skip this user, maybe done.
AOS NUSERS ;Count user we're printing.
MOVE T,NUSERS ;Get number of users this line.
IMULI T,9. ;See how wide we are so far.
CAMGE T,TCMXH ;If there is enuf room for uname.
JRST USERS2 ; go print it.
.IOT TTYO,[^M] ;Else go to next line.
.IOT TTYO,[^J]
SETZM NUSERS ;Restart count.
USERS2: ILDB CHAR,BP
ILDB CHAR,BP ;Gobble number and space.
ILDB CHAR,BP
USERS3: ILDB CHAR,BP
CAIN CHAR,^L ;If end of buffer
JRST DONE ; all done.
CAIN CHAR,40 ;If end of uname
JRST [ .IOT TTYO,[^I]
JRST USERS1 ]
.IOT TTYO,CHAR
JRST USERS3 ;Else finish printing uname.
DONE: MOVE A,LOOPER ;Recover AOBJN pointer.
AOBJN A,MLOPN
DEATH: .CLOSE TTYO,
.CLOSE TTYI,
.CLOSE DSKI,
.LOGOUT 1,
;;; This is in case luser explicitly specifies his own machine.
;;; BP has pointer to name we want to open on.
HAKLCL: MOVE B,[440700,,MACNAM]
HAKLC1: ILDB CHAR,BP
ILDB C,B
CAME CHAR,C
JRST HAKLC9
ILDB CHAR,BP
ILDB C,B
CAME CHAR,C
JRST HAKLC9
HRRZ BP,LCLDEV
HAKLC9: HRLI BP,440700
POPJ P,
CONSTANTLY
VARIABLE
END GO