mirror of
https://github.com/PDP-10/its.git
synced 2026-03-01 09:40:56 +00:00
1213 lines
23 KiB
Plaintext
Executable File
1213 lines
23 KiB
Plaintext
Executable File
.title Command Processor
|
||
.sbttl Command Processor
|
||
|
||
;;; ;;; General info:
|
||
;;; ;;; One of cruftiest command processors I have ever seen,
|
||
;;; ;;; but then again, I was never very good at user
|
||
;;; ;;; interfaces. This should be completly reimplemented.
|
||
|
||
dsect < ;;; command processor variables
|
||
$cpevn:: .blkw 1 ;event word
|
||
%cptyi==100000
|
||
%cptyo==040000
|
||
%cphsi==020000
|
||
%cphso==010000
|
||
%cpmsg==004000 ;needed for shout command
|
||
$cpevs:: .blkw 1 ;saved event word
|
||
$cpcon:: .blkw 1 ;continuation for terminal input
|
||
$cptyi:: .blkw 1 ;terminal input channel
|
||
$cptyo:: .blkw 1 ;terminal output channel
|
||
$cphsi:: .blkw 1 ;host input channel
|
||
$cphso:: .blkw 1 ;host output channel
|
||
$cphoc:: .blkw 1 ;host output continuation
|
||
$cphic:: .blkw 1 ;host input continuation
|
||
$cptnm:: .blkw 1 ;telnet modes
|
||
%tniac==377
|
||
%tnsb==372 ;subnegotiation begin
|
||
%tnse==360 ;subnegotiation end
|
||
%tnwil==251.
|
||
%tnwnt==252.
|
||
%tndo==253.
|
||
%tndnt==254.
|
||
%tnip==244.
|
||
%tntbn==0 ;Transmit binary
|
||
%tneco==1 ;ECHO
|
||
%tnsga==3 ;suppress go ahead
|
||
%tntmk==6 ;timing mark
|
||
%tnloc==23. ;terminal location negotiation
|
||
.tntbn==00. ;LSH amount for transmit binary
|
||
.tneco==04. ;LSH amount for echo
|
||
.tnsga==08. ;LSH amount for Suppress Go Ahead
|
||
.tnfwa==01 ;what the foreign host wants to do
|
||
.tnfdo==02 ;what the foreign host is doing
|
||
.tnlwa==04 ;what local wants to do
|
||
.tnldo==10 ;what local is doing
|
||
$cptnc:: .blkw 1 ;telnet from connection continuation
|
||
$cphsm:: .blkw 1 ;mode of the host input channel
|
||
l$cpbf==40 ;size of temp buffers
|
||
$cphsb:: .blkb l$cpbf ;host input buffer
|
||
$cphsp:: .blkw 1 ;pointer into buffer
|
||
$cphsc:: .blkw 1 ;count of characters in the host input buffer
|
||
$cpoct:: .blkw 1 ;octal number accumulated
|
||
$cpdec:: .blkw 1 ;decimal number accumulated
|
||
$cpnum:: .blkw 1 ;0 <==> no number
|
||
>,l$cp
|
||
|
||
|
||
$insrt hosts
|
||
|
||
cp$cp: .regs #l$cp
|
||
.uall
|
||
if cs,<.logout>
|
||
mov r0,r5 ;keep it in r5
|
||
push #-1 ;my tty
|
||
.regs #opntty,sp
|
||
.open
|
||
if cs,<.logout>
|
||
pop *
|
||
movb #md%sup,$clmod(r1) ;set supdup mode on output
|
||
bis #%clnhg,$clmod(r0) ;no hang on tty input
|
||
mov r0,$cptyi(r5) ;tyi
|
||
mov r1,$cptyo(r5) ;tyo
|
||
mov #$cphsb,$cphsp(r5) ;offset to host input buffer
|
||
add r5,$cphsp(r5) ;now really point to it
|
||
.regs $cptyi(r5),#chnevr,#%cptyi,r5
|
||
add #$cpevn,r3
|
||
.ioctl
|
||
.regs $cptyo(r5),#chnevx,#%cptyo
|
||
.ioctl ;r3 still set to $cpevn(r5)
|
||
call cpistr ;send initial string
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl <.asciz <%tdclr>/ MINITS Reloaded or Restarted/<%tdcrl>>
|
||
.soutz
|
||
call cp$cl2 ;close the host (or at least fake it)
|
||
call cp$pro ;prompt
|
||
loop <
|
||
.if df shoutp
|
||
bit #%cpmsg, $cpevn(r5) ; Message waiting?
|
||
if ne,<
|
||
call cp$msg
|
||
>
|
||
.endc
|
||
lock 7
|
||
mov $cpevn(r5),$cpevs(r5) ;save event flag
|
||
if eq,<
|
||
unlock
|
||
.regs #hng.ne,#zero,r5
|
||
add #$cpevn,r2
|
||
.hang
|
||
rptl
|
||
>
|
||
clr $cpevn(r5)
|
||
unlock
|
||
loop <
|
||
.regs $cptyi(r5)
|
||
.bin
|
||
bit #%clnhh,$clmod(r0) ;no hang happen?
|
||
if eq,<
|
||
call @$cpcon(r5)
|
||
rptl
|
||
> >
|
||
call cp$htb ;do host to buffer
|
||
call cp$btt ;do buffer to tty
|
||
rptl
|
||
>
|
||
|
||
cp$btt: mov $cphsc(r5),r2 ;get count
|
||
if ne,<
|
||
.regs $cptyo(r5),$cphsp(r5) ;tty output and pointer
|
||
push $clmod(r0) ;save modes
|
||
movb $cphsm(r5),$clmod(r0) ;mode for the host
|
||
bis #%clnhg,$clmod(r0) ;don't hang
|
||
call @$cphic(r5) ;call the host input continuation
|
||
if cs,<bpt>
|
||
pop $clmod(r0) ;restore modes
|
||
mov r2,$cphsc(r5) ;set number of characters still in buffer
|
||
if ne,<
|
||
mov $cphsp(r5),r3
|
||
loop < ;move the characters down
|
||
movb (r1)+,(r3)+
|
||
sorl r2
|
||
>
|
||
>
|
||
>
|
||
return
|
||
|
||
cp$htb: mov $cphsi(r5),r0 ;get host input channel
|
||
if ne,<
|
||
.regs ,$cphsp(r5),#l$cpbf,$cphsc(r5)
|
||
add r3,r1 ;point to end of buffer
|
||
mov r2,$cphsc(r5) ;expect a full buffer
|
||
sub r3,r2 ;number of characters to try and read
|
||
bis #%clnhg,$clmod(r0) ;don't hang on input
|
||
.sin
|
||
if cs,<
|
||
cmp r2,$cphsc(r5) ;any data?
|
||
if eq,<
|
||
clr $cphsc(r5) ;no
|
||
call cp$clh ;close the host
|
||
jcall cp$pro
|
||
>
|
||
>
|
||
sub r2,$cphsc(r5) ;didn't read some
|
||
>
|
||
return
|
||
|
||
cp$clh: push #0
|
||
mov $cphso(r5),r0
|
||
if ne,<
|
||
clr $cphso(r5)
|
||
.close
|
||
inc (sp)
|
||
>
|
||
mov $cphsi(r5),r0
|
||
if ne,<
|
||
clr $cphsi(r5)
|
||
.close
|
||
inc (sp)
|
||
>
|
||
.regs $cptyo(r5)
|
||
tst (sp)+
|
||
if ne,<mov #100$,r1> ;close it
|
||
else <mov #110$,r1> ;already closed
|
||
.soutz
|
||
cp$cl2=.
|
||
mov #cp$cm1,$cpcon(r5) ;continuation routine for terminal input
|
||
mov #cp$bel,$cphoc(r5) ;host output does nothing
|
||
return
|
||
|
||
100$: .asciz <%tdcrl>/[Host connection closed.]/<%tdcrl>
|
||
110$: .asciz <%tdcrl>/[Connection already closed.]/<%tdcrl>
|
||
.even
|
||
|
||
cp$bel: .regs $cptyo(r5),#%tdbel ;ring the bell
|
||
.bout
|
||
return
|
||
|
||
cp$eco: push r0,r1
|
||
.regs $cptyo(r5),6(sp)
|
||
cmpb r1,#40
|
||
if lt,<
|
||
.if ge system-12 ;EECS hacks
|
||
.if le system-14
|
||
;
|
||
; Hack to avoid lossage caused by MINITS interacting
|
||
; with certain terminals (such as DEC VT52, Zenith Z19)
|
||
; which insist on sending ^S when their input buffer
|
||
; is full. Otherwise, MINITS echoes ~30 characters for
|
||
; every ^S received, resulting in an argument over who
|
||
; has the last word.
|
||
cmpb r1,#23 ;^S
|
||
if eq,<jcall cp$sil> ;don't echo anything, just return
|
||
; also shrug off ^Q, to avoid continuous flaming loop
|
||
cmpb r1,#21 ;^Q
|
||
if eq,<jcall cp$sil> ;don't echo anything, just return
|
||
.endc
|
||
.endc
|
||
movb #'^,r1
|
||
.bout
|
||
movb 6(sp),r1
|
||
add #'@,r1
|
||
>
|
||
.bout
|
||
cp$sil: pop r1,r0 ;clean up stack and return
|
||
return
|
||
|
||
cp$wti: ;wait for character input
|
||
pop $cpcon(r5)
|
||
return
|
||
cp$lfn: ;logically finished with command
|
||
call cp$wti ;wait for input and fall through
|
||
cp$tyi: mov r1,r2
|
||
bic #mask7,r2
|
||
cmp r2,#%acom
|
||
if eq,<jcall cp$com>
|
||
jcall @$cphoc(r5) ;output the character to the host
|
||
|
||
cp$hic: .sout
|
||
return
|
||
|
||
cp$hso: ;standard routine to output to a host
|
||
mov $cphso(r5),r0
|
||
if ne,<
|
||
.bout
|
||
if cs,<
|
||
call cp$clh ;close the host channels
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl <.asciz <%tdcrl><%tdcrl>/Host connection gone./<%tdcrl><%tdcrl>>
|
||
.soutz
|
||
call cp$pro
|
||
> >
|
||
return
|
||
|
||
cp$com: call cp$wti
|
||
call cp$lfn
|
||
bic #mask7,r1 ;completely 7-ascii now
|
||
push r1
|
||
call upcase
|
||
pop r2
|
||
cmpb r2,#%acom
|
||
if eq,<jcall @$cphoc(r5)> ;output to host
|
||
cmpb r2,#14
|
||
if eq,<jcall cp$ff>
|
||
.if df shoutp
|
||
cmpb r2,#22 ;^R
|
||
if eq,<jcall maint>
|
||
.endc
|
||
.if df wereok
|
||
cmpb r2,#26 ;^V
|
||
if eq,<jcall where>
|
||
.endc
|
||
cmpb r2,#'?
|
||
if eq,<
|
||
.regs $cptyo(r5),#help2
|
||
.soutz
|
||
return
|
||
>
|
||
cmpb r2,#21 ;^Q is "quote"
|
||
if eq,<
|
||
mov #34,r1 ;send an unquoted ^\
|
||
jcall cp$hso>
|
||
cmpb r2,#'B
|
||
if eq,<jcall sndbrk>
|
||
cmpb r2,#'H
|
||
if eq,<jcall sndhlp>
|
||
cmpb r2,#'L ;[Gumby]
|
||
if eq,<
|
||
mov #300,r1 ;send command flag
|
||
call cp$hso
|
||
mov #301,r1 ;send logout command
|
||
call cp$hso
|
||
;; if other end ignores this (e.g. twenex), then don't lose
|
||
return
|
||
>
|
||
cmpb r2,#'K
|
||
if eq,<
|
||
call cp$clh
|
||
jcall cp$pro
|
||
>
|
||
call cp$bel ;bad command
|
||
return
|
||
|
||
cp$pro: push r0,r1
|
||
.regs $cptyo(r5),#prmpt1
|
||
.soutz
|
||
pop r1,r0
|
||
clr $cpnum(r5) ;no number yet
|
||
clr $cpoct(r5)
|
||
clr $cpdec(r5)
|
||
return
|
||
|
||
prmpt1: .ascii <%tdcrl>
|
||
%host%
|
||
.ascii / MINITS - Type ? for help. >/
|
||
.byte 0
|
||
.even
|
||
|
||
cp$cm1: bic #mask7,r1 ;completely 7-ascii now
|
||
push r1
|
||
call upcase
|
||
call cp$eco
|
||
pop r2
|
||
cmpb r2,#14 ;^L
|
||
if eq,<
|
||
call cp$ff
|
||
jcall cp$pro
|
||
>
|
||
.if df shoutp
|
||
cmpb r2,#22 ;^R
|
||
if eq,<jcall maint>
|
||
.endc
|
||
cmpb r2,#24 ;^T
|
||
if eq,<
|
||
call cpttyp
|
||
jcall cp$pro
|
||
>
|
||
.if df wereok
|
||
cmpb r2,#26 ;^V
|
||
if eq,<jcall where>
|
||
.endc
|
||
cmpb r2,#32 ;^Z
|
||
if eq,<jcall hakcon>
|
||
.if ge system-12 ;EECS hacks
|
||
.if le system-14
|
||
cmpb r2,#34 ;^\
|
||
if eq,<return> ;don't feep
|
||
cmpb r2,#23 ;^S
|
||
if eq,<return> ;don't feep
|
||
cmpb r2,#21 ;^Q
|
||
if eq,<return> ;don't feep
|
||
.endc
|
||
.endc
|
||
cmpb r2,#'S
|
||
if eq,<jcall hakcon>
|
||
cmpb r2,#'?
|
||
if eq,<
|
||
call cpistr
|
||
.regs $cptyo(r5),#help1
|
||
.soutz
|
||
jcall cp$pro
|
||
>
|
||
.if nz natk
|
||
cmpb r2,#'D
|
||
if eq,<jcall atkcon>
|
||
.endc
|
||
cmpb r2,#'F
|
||
if eq,<jcall rfinger>
|
||
.if ge system-60
|
||
.if le system-74
|
||
.if ne system-71
|
||
cmpb r2,#'G
|
||
if eq,<jcall gtkcon>
|
||
.endc
|
||
.endc
|
||
.endc
|
||
cmpb r2,#'T
|
||
if eq,<jcall telnet>
|
||
cmpb r2,#'U
|
||
if eq,<jcall ttylnk>
|
||
cmpb r2,#'W ;[pao]
|
||
if eq,<jcall weather> ;[pao]
|
||
.if df mveok
|
||
cmpb r2,#'M ;[pao]
|
||
if eq,<jcall movies> ;[pao]
|
||
.endc
|
||
.if df nwsflg
|
||
cmpb r2,#'N ;[gumby]
|
||
if eq,<jcall news> ;[gumby]
|
||
.endc
|
||
.if df lispm
|
||
cmpb r2,#6 ;^F lists lispms
|
||
if eq,<jcall lmfree> ;[gumby]
|
||
.endc
|
||
cmpb r2,#'0
|
||
if ge,<
|
||
cmpb r2,#'9
|
||
if le,<jcall 100$>
|
||
>
|
||
call cp$bel ;bad command - ring the bell
|
||
jcall cp$pro ;prompt
|
||
|
||
|
||
|
||
100$: ;collect a number
|
||
mov #-1,$cpnum(r5)
|
||
sub #'0,r2
|
||
mov $cpdec(r5),r3
|
||
mul #10.,r3
|
||
add r2,r3
|
||
mov r3,$cpdec(r5)
|
||
asl $cpoct(r5)
|
||
asl $cpoct(r5)
|
||
asl $cpoct(r5)
|
||
add r2,$cpoct(r5)
|
||
call cp$wti ;wait for input
|
||
jcall cp$cm1 ;keep collecting
|
||
|
||
cp$ff: .regs $cptyo(r5),#%tdclr ;clear the screen
|
||
.bout
|
||
return
|
||
|
||
sndbrk: mov #%txtop+'B,r1
|
||
jcall @$cphoc(r5) ;output to the host
|
||
|
||
sndhlp: mov #%txtop+'H,r1
|
||
jcall @$cphoc(r5)
|
||
|
||
cpistr: .cnsget ;get terminal charactistics
|
||
if cs,<halt>
|
||
mov r0,r1 ;into r1
|
||
.regs $cptyo(r5),ttyist(r1) ;get tty and initial string
|
||
.soutz ;send the initial string
|
||
return
|
||
|
||
help1:
|
||
.ascii <%tdclr>
|
||
.ascii /This PDP-11 is /
|
||
%host% ;ascii format (not asciz)
|
||
.byte <%tdcrl>
|
||
.ascii /To connect to a machine, type <number><protocol>/<%tdcrl>
|
||
.ascii /where <number> is an octal chaosnet host number, or one of:/<%tdcrl>
|
||
comdoc
|
||
.ascii /and <protocol> is one of:/<%tdcrl>
|
||
; (rearranged to save screen space, hope nobody minds) [alw]
|
||
.ascii / S - SUPDUP T - TELNET F - Finger/<%tdcrl>
|
||
.ascii / U - TTYLINK (perhaps Unix only) W - Weather information/<%tdcrl>
|
||
.if df mveok
|
||
.ascii / M - Movie information/<%tdcrl> ;[pao]
|
||
.endc
|
||
.if df nwsflg
|
||
.ascii / N - News headlines/<%tdcrl> ;[gumby]
|
||
.endc
|
||
.if df lispm
|
||
.ascii / ^F - Finger lispms. Arg means find free machines./<%tdcrl>
|
||
.endc
|
||
.if nz natk
|
||
.ascii / <n>D DIRECT to:/<%tdcrl>
|
||
atkhlp
|
||
.endc
|
||
.if ge system-60
|
||
.if le system-74
|
||
.if ne system-71
|
||
.byte <%tdcrl>
|
||
.ascii /<number> G chooses from/<%tdcrl>
|
||
.ascii / 0 Prime 1 Scicards/<%tdcrl>
|
||
.endc
|
||
.endc
|
||
.endc
|
||
help2:
|
||
; extra crlf removed, c-\ ? help explained [alw]
|
||
.ascii /Commands when connected (c-\ ? gets this help):/<%tdcrl>
|
||
.ascii / c-\ K closes the current connection/<%tdcrl>
|
||
.ascii / c-\ c-\ sends a c-\/<%tdcrl>
|
||
.ascii / c-\ B sends a break/<%tdcrl>
|
||
.ascii / c-\ L sends the SUPDUP Logout command/<%tdcrl>
|
||
.ascii / c-\ H sends the SUPDUP Help character/<%tdcrl>
|
||
.ascii / c-\ c-L clears the screen (use just c-L when not connected)/<%tdcrl>
|
||
.byte 0
|
||
.even
|
||
|
||
cpttyp: .cnsget
|
||
mov $cpdec(r5),r1
|
||
|
||
.if nz 0 ; This is stupid -- Gumby and KLTOZ
|
||
.if nz system-35 ; don't restrict the choices if 7B.
|
||
loop < ;hack to avoid complete lossage
|
||
cmp r1,#1 ;vt52 allowed
|
||
exitl eq
|
||
cmp r1,#6 ;and AAA allowed
|
||
exitl eq
|
||
return
|
||
>
|
||
.endc
|
||
.endc
|
||
cmp r1,#<20$-10$>/2
|
||
if lt,<
|
||
asl r1
|
||
push r0,10$(r1)
|
||
call tctyp
|
||
>
|
||
return
|
||
;; This table is so stupid -- why doesn't the loser just type the TCTYP code??
|
||
; 0 1 2 3 4 5 6 7 8 9
|
||
10$: .word t.prt,t.v52,t.t61,t.h19,t.v00,t.v32,t.aaa,t.c08,t.hds,t.baa
|
||
20$:
|
||
|
||
|
||
conokp: tst $cphso(r5)
|
||
if eq,<
|
||
tst $cphsi(r5)
|
||
if eq,<
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl < .asciz <%tdclr>/ Trying.../ >
|
||
.soutz
|
||
call cp$lfn
|
||
return
|
||
>
|
||
>
|
||
pop * ;flush return address
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl <
|
||
.byte %TDCRL
|
||
.ascii /[Please close previous host connection first (with c-\ K).]/
|
||
.byte %TDCRL,0
|
||
.even
|
||
>
|
||
.soutz
|
||
return
|
||
|
||
;;; SUPDUP initial block
|
||
|
||
dsect <
|
||
.blkb 6 ;-n,,0
|
||
.blkb 6 ;tctyp
|
||
$spopt:: .blkb 6 ;ttyopt
|
||
%spcbs==5
|
||
%tpcbs==40 ;fifth byte, bit 40
|
||
$spmxv:: .blkb 6 ;vertical
|
||
$spmxh:: .blkb 6 ;horizontal
|
||
$sprol:: .blkb 6 ;ttyrol
|
||
$spsmt:: .blkb 6 ;smarts
|
||
$spisp:: .blkb 6 ;ispeed
|
||
$sposp:: .blkb 6 ;ospeed
|
||
>,l$spdp
|
||
|
||
hakcon: call conokp
|
||
mov $cpdec(r5),r0
|
||
asl r0
|
||
cmp r0,#l$hstlst
|
||
if lo,<mov hstlst(r0),r0>
|
||
else <mov $cpoct(r5),r0>
|
||
push #1,(pc)+
|
||
.string <SUPDUP>
|
||
push r0
|
||
.regs #opncha,sp
|
||
.open
|
||
if cs,<
|
||
pop *,*,*
|
||
return
|
||
>
|
||
pop *,*,*
|
||
movb #md%sup,$clmod(r0) ;supdup in from the network
|
||
movb #md%raw,$clmod(r1) ;raw out to the network
|
||
mov #md%sup,$cphsm(r5) ;save remember host mode
|
||
mov r0,$cphsi(r5) ;save input channel
|
||
mov r1,$cphso(r5) ;save output channel
|
||
mov #suptyo,$cphoc(r5) ;host output continuation is supdup tyo
|
||
mov #cp$hic,$cphic(r5) ;standard host input continuation
|
||
.regs ,#chnevr,#%cphsi,r5 ;r0 still has channel
|
||
add #$cpevn,r3 ;point to even word
|
||
.ioctl ;set event receive bits
|
||
if cs,<bpt>
|
||
push #l$spdp
|
||
call fsmall
|
||
call fsmclr
|
||
pop r4
|
||
if eq,<halt>
|
||
.cnsget
|
||
if cs,<halt>
|
||
mov r0,r1
|
||
.regs $cptyo(r5),ttyist(r1)
|
||
.soutz ;send the initial string
|
||
|
||
.cnsget
|
||
mov #77+<77_8>,(r4)
|
||
mov #<100-<l$spdp/6-1>>,2(r4) ;-n,,0
|
||
movb #7,6+5(r4) ;tctyp = 7 (software)
|
||
|
||
mov ttyop1(r0),$spopt+0(r4)
|
||
mov ttyop2(r0),$spopt+2(r4)
|
||
mov ttyop3(r0),$spopt+4(r4)
|
||
bisb #%tpcbs,$spopt+%spcbs(r4) ;turn on C-\ hacking
|
||
|
||
mov ttysm1(r0),$spsmt+0(r4)
|
||
mov ttysm2(r0),$spsmt+2(r4)
|
||
mov ttysm3(r0),$spsmt+4(r4)
|
||
|
||
movb ttymxv(r0),r1
|
||
mov #$spmxv,r2
|
||
call 10$
|
||
|
||
movb ttymxh(r0),r1
|
||
dec r1 ;SUPDUP is really one less!!
|
||
mov #$spmxh,r2
|
||
call 10$
|
||
|
||
movb ttyrol(r0),$sprol+5(r4)
|
||
|
||
mov ttyspd(r0),r1
|
||
mov #$spisp,r2
|
||
call 10$
|
||
mov $spisp+2(r4),$sposp+2(r4)
|
||
mov $spisp+4(r4),$sposp+4(r4)
|
||
|
||
mov r0,r3 ;save tty in r3
|
||
mov $cphso(r5),r0
|
||
mov r4,r1
|
||
mov #l$spdp,r2
|
||
.sout
|
||
if cs,<halt>
|
||
|
||
push r4
|
||
call fsmfre
|
||
|
||
mov #300,r1
|
||
.bout
|
||
mov #302,r1
|
||
.bout
|
||
mov ttyloc(r3),r1
|
||
.soutz
|
||
clr r1
|
||
.bout
|
||
|
||
return
|
||
|
||
10$: push r4
|
||
add r2,r4
|
||
cmp r1,#-1
|
||
if eq,<movb #20,(r4)>
|
||
else <
|
||
add #6,r4
|
||
loop <
|
||
mov r1,r2
|
||
bic #mask6,r2
|
||
movb r2,-(r4)
|
||
ash #-6,r1
|
||
bic #mask10,r1 ;only low 10 bits are valid now
|
||
tst r1
|
||
rptl ne
|
||
> >
|
||
pop r4
|
||
return
|
||
|
||
tcon: .string <PRIME>
|
||
.word 22401
|
||
.string <SCICARDS>
|
||
.word 22401
|
||
l$tcon==.-tcon
|
||
|
||
gtkcon: call conokp
|
||
mov $cpdec(r5),r0
|
||
asl r0
|
||
asl r0
|
||
cmp r0,#l$tcon
|
||
if his,<
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl <.asciz <%tdcrl>/[Numeric argument does not specify a known path.]/<%tdcrl>>
|
||
.soutz
|
||
return
|
||
>
|
||
push #2,tcon(r0),tcon+2(r0)
|
||
br ttyln2
|
||
|
||
|
||
.if nz natk
|
||
atkcon:
|
||
call conokp
|
||
mov $cpdec(r5),r1
|
||
cmp r1,#natk
|
||
if lt,<
|
||
asl r1
|
||
add #atktab,r1
|
||
clr r0
|
||
loop <
|
||
cmp r0,#ntty*2
|
||
exitl ge
|
||
cmp ttyity(r0),r1
|
||
if eq,<
|
||
mov ttyrdv(r0),r2
|
||
tst $ttipt(r2)
|
||
if eq,<
|
||
push r0
|
||
.regs #opntty,sp
|
||
.open
|
||
if cs,<bpt>
|
||
pop *
|
||
jcall ttyln3
|
||
>
|
||
>
|
||
add #2,r0
|
||
rptl
|
||
>
|
||
>
|
||
call cp$cl2
|
||
.regs $cptyo(r5),(pc)+
|
||
.litrl <.asciz <%tdcrl>/[No free lines.]/<%tdcrl>>
|
||
jcall cp$pro
|
||
|
||
atktab: atktyp
|
||
.endc
|
||
|
||
|
||
ttylnk:
|
||
call conokp
|
||
mov $cpdec(r5),r0
|
||
asl r0
|
||
cmp r0,#l$hstlst
|
||
if lo,<mov hstlst(r0),r0>
|
||
else <mov $cpoct(r5),r0>
|
||
push #1,(pc)+
|
||
.string <TTYLINK>
|
||
push r0
|
||
ttyln2: .regs #opncha,sp
|
||
.open
|
||
if cs,<
|
||
pop *,*,*
|
||
call cp$cl2
|
||
jcall cp$pro
|
||
>
|
||
pop *,*,*
|
||
ttyln3: movb #md%asc,$clmod(r0) ;ascii input from the network
|
||
movb #md%asc,$clmod(r1) ;ascii out to the network
|
||
mov #md%asc,$cphsm(r5) ;remember host mode
|
||
mov r0,$cphsi(r5) ;save input channel
|
||
mov r1,$cphso(r5) ;save output channel
|
||
mov #ttltyo,$cphoc(r5) ;host output continuation to save meta bit
|
||
mov #cp$hic,$cphic(r5) ;standard host input continuation
|
||
.regs ,#chnevr,#%cphsi,r5 ;r0 still has channel
|
||
add #$cpevn,r3 ;point to even word
|
||
.ioctl ;set event receive bits
|
||
|
||
return
|
||
|
||
ttltyo: cmp r1,#%txtop+'B ;break?
|
||
if eq,<
|
||
.regs $cphso(r5),#ttybrk
|
||
.ioctl
|
||
return
|
||
>
|
||
bit #%txctl,r1
|
||
if ne,<bic #mask5-%txmta,r1>
|
||
bit #%txmta,r1
|
||
if ne,<bis #200,r1>
|
||
bic #mask8,r1
|
||
jcall cp$hso ;send the character
|
||
|
||
.if df shoutp ;assemble shout command
|
||
|
||
maint: cmp $cpdec(r5), #84 ; Moby shout command
|
||
if ne,<return>
|
||
movb #15, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
movb #12, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
.regs $cptyo(r5), (pc)+
|
||
.litrl <
|
||
.ascii /Enter message (terminate with C-\):/
|
||
.byte 0
|
||
>
|
||
.soutz
|
||
clr r4
|
||
|
||
loop <
|
||
call cp$wti
|
||
bic #mask7, r1
|
||
cmpb r1, #%acom
|
||
if eq,<exitl>
|
||
.regs $cptyo(r5)
|
||
.bout
|
||
movb r1, messag(r4)
|
||
inc r4
|
||
rptl
|
||
>
|
||
|
||
inc r4
|
||
mov #%tdcrl, messag(r4)
|
||
incb r4
|
||
mov #%tdcrl, messag(r4)
|
||
inc r4
|
||
mov #0, messag(r4)
|
||
|
||
mov #ulink, r1
|
||
loop <
|
||
cmp (r1), #ulink
|
||
exitl eq
|
||
mov (r1), r1
|
||
mov usrvrs(r1), r2
|
||
tst r2
|
||
rptl eq
|
||
cmp usripc(r1), #cp$cp
|
||
rptl ne
|
||
bis #4000, $cpevn(r2)
|
||
rptl
|
||
|
||
>
|
||
|
||
|
||
call cp$cl2
|
||
call cp$pro ;prompt
|
||
|
||
return
|
||
cp$msg: .regs $cptyo(r5), #msgs
|
||
.soutz
|
||
return
|
||
|
||
msgs: .byte %tdcrl, %tdcrl, 7, 7, 7, 7
|
||
messag: .blkb 132
|
||
|
||
.endc ;end shout command
|
||
|
||
.if df wereok
|
||
|
||
where: movb #15, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
movb #12, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
mov #ulink,r1
|
||
loop <
|
||
|
||
cmp (r1), #ulink
|
||
exitl eq
|
||
mov (r1), r1
|
||
mov usrvrs(r1), r2
|
||
tst r2
|
||
rptl eq
|
||
cmp usripc(r1), #cp$cp
|
||
rptl ne
|
||
tst $cphso(r2)
|
||
if eq,<
|
||
tst $cphsi(r2)
|
||
if eq,<rptl>>
|
||
mov usrtty(r1), r4
|
||
push r1,r2
|
||
.regs $cptyo(r5), ttyilo(r4)
|
||
.soutz
|
||
movb #15, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
movb #12, r1
|
||
.regs $cptyo(r5), r1
|
||
.bout
|
||
pop r2,r1
|
||
rptl
|
||
>
|
||
return
|
||
|
||
.endc
|
||
|
||
;;;[pao]
|
||
weather:
|
||
call conokp
|
||
mov #013045,r0 ;mit-hermes
|
||
push #1,(pc)+
|
||
.string <WTHRSTAT> ;The right way to get weather -cjl
|
||
br rfing0
|
||
|
||
.if df mveok
|
||
movies:
|
||
call conokp
|
||
mov #05542,r0 ; mit-ee
|
||
push #1,(pc)+
|
||
.string <LSC>
|
||
br rfing0
|
||
.endc
|
||
;;;[pao]
|
||
|
||
;;; [gumby] get news headlines from MC
|
||
.if df nwsflg
|
||
news:
|
||
call conokp
|
||
mov #03131,r0 ; MC gets them from DB
|
||
push #1,(pc)+
|
||
.string <NEWS>
|
||
br rfing0
|
||
.endc
|
||
|
||
.if df lispm ;[gumby] ^F means finger lispms; arg means free
|
||
lmfree:
|
||
call conokp
|
||
mov $cpnum(r5),r0
|
||
cmpb r0,#0 ;SKIPE @$CPNUM(R5) is so much easier!
|
||
beq lmfre0
|
||
push #1,(pc)+
|
||
.string <NAME .FREE>
|
||
br lmfre1
|
||
lmfre0: push #1,(pc)+
|
||
.string <NAME>
|
||
lmfre1: mov #013065,r0
|
||
br rfing0
|
||
.endc
|
||
|
||
rfinger:
|
||
call conokp
|
||
mov $cpdec(r5),r0
|
||
asl r0
|
||
cmp r0,#l$hstlst
|
||
if lo,<mov hstlst(r0),r0>
|
||
else <mov $cpoct(r5),r0>
|
||
push #1,(pc)+
|
||
.string <NAME>
|
||
rfing0: push r0
|
||
.regs #opncha,sp
|
||
.open
|
||
if cs,<
|
||
pop *,*,*
|
||
call cp$cl2
|
||
jcall cp$pro
|
||
>
|
||
pop *,*,*
|
||
movb #md%lsp,$clmod(r0)
|
||
mov r0,$cphsi(r5)
|
||
mov r1,r0 ;xmit channel in r0
|
||
.close ;and close, it, not allowed to xmit to it
|
||
mov #md%lsp,$cphsm(r5) ;mode is LISP for this host
|
||
mov #cp$hic,$cphic(r5) ;standard host input continuation
|
||
.regs $cphsi(r5),#chnevr,#%cphsi,r5 ;channel, command, bits, pointer
|
||
add #$cpevn,r3 ;point to event word
|
||
.ioctl ;set event receive bits
|
||
.regs $cptyo(r5),#%tdcrl
|
||
.bout
|
||
|
||
return
|
||
|
||
%cbs==<'\>-<'@>
|
||
suptyo: bit #mask7,r1 ;is it 7-bit already
|
||
if eq,< ;yup
|
||
cmp r1,#%cbs ;is it C-\
|
||
if eq,<call cp$hso> ;output it to quote itself
|
||
jcall cp$hso ;output the 7-bit character
|
||
>
|
||
push r1
|
||
mov #%cbs,r1
|
||
call cp$hso
|
||
mov (sp),r1
|
||
asl r1
|
||
swab r1
|
||
bic #mask5,r1
|
||
bis #100,r1
|
||
call cp$hso
|
||
pop r1
|
||
bic #mask7,r1
|
||
jcall cp$hso
|
||
|
||
telnet: call conokp
|
||
mov $cpdec(r5),r0
|
||
asl r0
|
||
cmp r0,#l$hstlst
|
||
if lo,<mov hstlst(r0),r0>
|
||
else <mov $cpoct(r5),r0>
|
||
push #1,(pc)+
|
||
.string <TELNET>
|
||
push r0
|
||
.regs #opncha,sp
|
||
.open
|
||
if cs,<
|
||
pop *,*,*
|
||
call cp$cl2
|
||
jcall cp$pro
|
||
>
|
||
pop *,*,*
|
||
movb #md%asc,$clmod(r0) ;ascii input from the network
|
||
movb #md%asc,$clmod(r1) ;ascii out to the network
|
||
mov #md%asc,$cphsm(r5) ;remember host mode
|
||
mov r0,$cphsi(r5) ;save input channel
|
||
mov r1,$cphso(r5) ;save output channel
|
||
mov #teltyo,$cphoc(r5) ;host ouput continuation is telnet tyo
|
||
mov #telhsi,$cphic(r5) ;host input continuation
|
||
.regs ,#chnevr,#%cphsi,r5 ;r0 still has channel
|
||
add #$cpevn,r3 ;point to even word
|
||
.ioctl ;set event receive bits
|
||
if cs,<bpt>
|
||
.regs $cphso(r5),(pc)+
|
||
.litrl <
|
||
.byte %tniac,%tndo,%tnsga ;request it suppress go ahead
|
||
.byte %tniac,%tndo,%tneco ;request remote echo
|
||
.byte %tniac,%tnwil,%tnloc ;will do terminal location
|
||
.even
|
||
>
|
||
.regs ,,#3+3+3
|
||
.sout
|
||
mov #<.tnfwa_.tneco>+<.tnfwa_.tnsga>,$cptnm(r5)
|
||
return
|
||
|
||
teltyo: cmp r1,#%txtop+'B
|
||
if eq,< ;also do IAC DMK when we do INS hacking
|
||
.irp char,<%tniac,%tnip>
|
||
movb #char,r1
|
||
call cp$hso
|
||
.endm
|
||
return
|
||
>
|
||
bit #%txctl,r1
|
||
if ne,<bic #mask5-%txmta,r1>
|
||
bit #%txmta,r1
|
||
if ne,<bis #200,r1>
|
||
bic #mask8,r1
|
||
tstb r1
|
||
if pl,<
|
||
bit #<.tnfdo_.tneco>,$cptnm(r5)
|
||
if eq,<
|
||
.regs $cptyo(r5)
|
||
push $clmod(r0)
|
||
mov $cphsm(r5),$clmod(r0)
|
||
.bout
|
||
pop $clmod(r0)
|
||
> >
|
||
cmpb r1,#%tniac
|
||
if eq,<call cp$hso> ;if IAC, quote it
|
||
call cp$hso ;output the character
|
||
cmpb r1,#15 ;is it a RETURN?
|
||
if eq,< ;yup, maybe send LINEFEED
|
||
bit #<.tnldo_.tntbn>,$cptnm(r5) ;should I transmit binary?
|
||
if eq,< ;no, so should send LINEFEED
|
||
movb #12,r1 ;now do a LINEFEED
|
||
br teltyo ;and do it
|
||
> >
|
||
return
|
||
|
||
telhsi: ;r0 is terminal output
|
||
;r1 is pointer
|
||
;r2 is count
|
||
push r3
|
||
loop <
|
||
tst r2
|
||
exitl eq ;finished if no more characters
|
||
tst $cptnc(r5) ;is there a telnet continuation?
|
||
if eq,< ;if not, scan for an IAC
|
||
mov r2,r3
|
||
clr r2
|
||
push r1
|
||
loop <
|
||
cmpb (r1)+,#%tniac
|
||
exitl eq
|
||
inc r2
|
||
sorl r3
|
||
>
|
||
pop r1 ;get pointer back
|
||
.sout ;output some characters
|
||
tst r2
|
||
if ne,<
|
||
add r3,r2
|
||
exitl
|
||
>
|
||
mov r3,r2
|
||
exitl eq
|
||
mov #teliac,$cptnc(r5) ;set the telnet continuation
|
||
>
|
||
push r1
|
||
loop <
|
||
tst $cptnc(r5)
|
||
exitl eq
|
||
movb @(sp),r1
|
||
inc (sp)
|
||
call @$cptnc(r5)
|
||
sorl r2
|
||
>
|
||
pop r1
|
||
rptl
|
||
>
|
||
pop r3
|
||
return
|
||
|
||
|
||
telwti: pop $cptnc(r5) ;save contination
|
||
return
|
||
tellfn: clr $cptnc(r5) ;logically finished, no continuation
|
||
return
|
||
|
||
teliac: cmpb r1,#%tniac
|
||
if ne,<bpt> ;oops
|
||
call telwti ;wait for a character
|
||
.irp what,<wil,wnt,do,dnt>
|
||
cmpb r1,#%tn'what
|
||
if eq,<jcall tel'what>
|
||
.endm
|
||
cmpb r1,#%tniac
|
||
if eq,<.bout> ;send character if iac
|
||
jcall tellfn ;not recognized
|
||
|
||
telwil: call telwti
|
||
loop <
|
||
cmpb r1,#%tneco
|
||
if eq,<
|
||
bit #.tnfwa_.tneco,$cptnm(r5) ;negotiation in progress?
|
||
if eq,<call telsdo> ;send a do
|
||
bis #<.tnfwa+.tnfdo>_.tneco,$cptnm(r5) ;remember modes
|
||
exitl
|
||
>
|
||
cmpb r1,#%tnsga
|
||
exitl eq ;fine with me
|
||
cmpb r1,#%tntbn
|
||
if eq,<
|
||
call telsdo ;send a do
|
||
bis #<.tnfwa+.tnfdo>_.tntbn,$cptnm(r5)
|
||
exitl
|
||
>
|
||
|
||
call telsdnt ;whatever it is, don't do it
|
||
>
|
||
jcall tellfn ;logically finished
|
||
|
||
telwnt: call telwti
|
||
loop <
|
||
cmpb r1,#%tneco
|
||
if eq,<
|
||
bit #.tnfwa_.tneco,$cptnm(r5)
|
||
if ne,<call telsdnt> ;send back a don't
|
||
bic #<.tnfwa+.tnfdo>_.tneco,$cptnm(r5)
|
||
exitl
|
||
>
|
||
cmpb r1,#%tntbn
|
||
if eq,<
|
||
call telsdnt ;send back a don't
|
||
bic #<.tnfwa+.tnfdo>_.tntbn,$cptnm(r5)
|
||
exitl
|
||
>
|
||
>
|
||
jcall tellfn
|
||
|
||
teldo: call telwti
|
||
loop <
|
||
cmpb r1,#%tnsga
|
||
if eq,<
|
||
bis #.tnldo_.tnsga,$cptnm(r5)
|
||
exitl
|
||
>
|
||
cmpb r1,#%tntbn
|
||
if eq,<
|
||
call telswil
|
||
bis #<.tnlwa+.tnldo>_.tntbn,$cptnm(r5)
|
||
exitl
|
||
>
|
||
cmpb r1,#%tntmk
|
||
if eq,<
|
||
call telswil
|
||
exitl
|
||
>
|
||
cmpb r1,#%tnloc ;terminal location
|
||
if eq,<
|
||
call tnsloc ;send the location
|
||
exitl
|
||
>
|
||
|
||
call telswnt ;whatever it is, I won't do it
|
||
>
|
||
jcall tellfn
|
||
|
||
teldnt: call telwti
|
||
loop <
|
||
cmpb r1,#%tntbn
|
||
if eq,<
|
||
call telswnt
|
||
bic #<.tnlwa+.tnldo>_.tntbn,$cptnm(r5)
|
||
exitl
|
||
>
|
||
>
|
||
jcall tellfn
|
||
|
||
loop <
|
||
telsdo: push #%tndo
|
||
exitl
|
||
telsdnt:
|
||
push #%tndnt
|
||
exitl
|
||
telswil:
|
||
push #%tnwil
|
||
exitl
|
||
telswnt:
|
||
push #%tnwnt
|
||
>
|
||
push r0,r1
|
||
movb #%tniac,r1
|
||
call cp$hso
|
||
mov 4(sp),r1
|
||
call cp$hso
|
||
pop r1
|
||
call cp$hso
|
||
pop r0,*
|
||
return
|
||
|
||
tnsloc: ;send terminal location
|
||
push r0,r1,r2
|
||
mov $cphso(r5),r0
|
||
if ne,<
|
||
mov #10$,r1
|
||
mov #3,r2
|
||
.sout
|
||
push r0
|
||
.cnsget
|
||
mov ttyloc(r0),r1
|
||
pop r0
|
||
.soutz
|
||
mov #20$,r1
|
||
mov #2,r2
|
||
.sout
|
||
>
|
||
pop r2,r1,r0
|
||
return
|
||
|
||
10$: .byte %tniac,%tnsb,%tnloc
|
||
20$: .byte %tniac,%tnse
|
||
.even
|
||
|
||
;;; local modes:
|
||
;;; mode:midas
|
||
;;; auto fill mode:
|
||
;;; fill column:75
|
||
;;; comment column:32
|
||
;;; end:
|