home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
kermit11.tar.gz
/
kermit11.tar
/
k11m41.mac
< prev
next >
Wrap
Text File
|
1989-06-13
|
66KB
|
2,427 lines
.title k11m41 kermit i/o for RSX11M/M+ v4.1 and 2.1
.ident /5.0.05/ ; Jerry Hudgins (see below)
; define macros and things we want for KERMIT-11
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
.enabl gbl
; Copyright (C) 1983 1984 1985 1986 Change Software, Inc.
;
;
; This software is furnished under a license and may
; be used and copied only in accordance with the
; terms of such license and with the inclusion of
; the above copyright notice. This software or any
; other copies thereof may not be provided or other-
; wise made available to any other person. No title
; to and ownership of the software is hereby trans-
; ferred.
;
; The information in this software is subject to
; change without notice and should not be construed
; as a commitment by the author.
;
;
.sbttl edits
; 20-Jan-84 09:50:18 BDN Test and fix TTSPEED, SETSPD and BINREAD
;
; 03-Mar-84 Bob Denny 4.2.00 [RBD01]
; Rewrote namcvt(). Eliminated FCS parsing
; in favor of home-brew code which can handle
; the infinite variety of filespecs that may
; crop up when doing DECnet remote file access.
;
; 07-Mar-84 Bob Denny 5.0.00 [Edit trails removed]
; Fair rewrite, particularly of terminal handling.
; Changed within the existing KERMIT-11 architecture,
; which is better suited to RSTS/E (which seems to
; have a lot more terminal & communications options).
; Modes for RSX now allow operation at 9600 baud for
; packet communication. CONNECT is still a problem.
;
; 10-Mar-84 Bob Denny 5.0.01 The method used for CONNECT on RSTS/RSX
; will not work reliably on native RSX at baud rates
; over 1200 on a busy system. The "doconn()" routine
; was rewritten. Now there are 2 separate modules.
; Also, the binrea() function is now used only for
; packet reading, and has been greatly simplified.
;
; 16-mar-84 Brian Nelson
;
; Merged origional K11M41 with Bob Denny's mods.
;
; 11-Dec-85 Robin Miller 5.0.02 Attach the terminal in the TTYINI routine
; (RTM01) so incoming characters are not lost. On a /SLAVE
; terminal, the terminal must be attached so charac-
; ters will be placed in the typeahead buffer.
; Also detach the terminal in the TTYFIN routine.
;
; 11-Dec-85 Robin Miller 5.0.03 Change routine TTPARS to allow device names
; (RTM02) other name XK, TI, or TT for logical names. Also
; check for an error from ALUN$S directive in ASSDEV.
;
; 12-Dec-85 Robin Miller 5.0.04 Change routine ASSDEV to check for logged
; (RTM03) on terminal and to get real device name via GLUN$
; incase we've assigned a logical name.
;
;
; 25-Dec-85 Brian Nelson
; 08-Feb-86 Steve Heflin
; 10-Feb-86 Brian Nelson
; Finish added Steve Heflin's mods for ATOZ in.
;
; 03-Feb-89 Jerry Hudgins 5.0.05
; Moved GETPRV call in ASSDEV to ensure priv's are
; up for SF.SMC; will otherwise crash M+ V4.0. Set
; priv's on in EXIT routine also.
;
;
; RSX11M,M+ and P/OS support.
;
; If this looks like it's a mess, it's because it IS. It gets changed
; a little bit here and there (for the past 2 years), and thus has a
; number of contributions and changes from others, and changes due to
; 'NEW' versions of M+ and MicroRSX (ie, things stop working).
.sbttl macros
.macro moverr val,dst
movb val ,-(sp)
call $mover
movb (sp)+ ,dst
.endm moverr
.iif ndf, r$rsts, r$rsts = 0
.save
.psect CLECTX ,RW,D,GBL,REL,CON
.restore
ef.tmp = 17
ef.tt = 20
ef.tmo = 21
er.tmo == 176 ; for now, timeout
er.nod == 177 ; pseudo error for no data
nodata == er.nod
.library /LB:[1,1]EXEMC.MLB/
.mcall UCBDF$
UCBDF$
.sbttl data areas
.psect $idata rw,d,lcl,rel,con
fu$def::.word 0 ; if rms needs the DNA filled in
; The following defaults can be changed in the TKB command file as in:
;
; GBLPAT=K11PAK:DO$APP:1
; GBLPAT=K11PAK:DO$APP:0
; GBLPAT=K11PAK:DO$APP:0
do$dte::.word 0 ; if NE, force PROCOMM to default
do$app::.word 0 ; if NE, then append to logfiles
do$msg::.word 1 ; if EQ, then don't be verbose at times
do$tra::.word 1 ; if we look in logical name tables
; for an available terminal.
do$alt::.word 1 ; Force SET RSX CON ALT
.psect $idata rw,d,lcl,rel,con
;
; Terminal settings and parameter lists for line setting
;
;
; Add mods from Steve Heflin in (SSH and /41/ comments)
;
; Do not include the TC.TBC in the main GMC or SMC as we will
; not know if we are running on M, M+ or Micro-RSX. TC.TBS is
; not available on M. If built on M, the undefined global for
; TC.TBS won't hurt anything. BDN 20-DEC-1985 10:29
savass: ; Remote line saved attributes
savdlu::.byte TC.DLU,0 ; /{no}REMOTE /41/
.byte TC.SLV,0 ; /{no}SLAVE
.byte TC.BIN,0 ; /{no}READ_PASSALL /45/
.byte TC.NEC,0 ; /{no}ECHO /41/
.byte TC.RAT,0 ; /{no}TYPEAHEAD /41/
.byte TC.8BC,0 ; /{no}EIGHT_BIT /41/
savtbs: .byte TC.TBS,0 ; typeahead buffer size /41/
.byte TC.NBR,0 ; /{no}BROADCAST /41/
diarst = . - savass ; Restore this much for DIAL /45/
savxsp: .byte TC.XSP,0 ; /SPEED:xmt /41/
savrsp: .byte TC.RSP,0 ; /SPEED:rcv /41/
asvlen = .-savass ; /41/
setass: .byte TC.SLV,1 ; /SLAVE=TTnn:
.byte TC.NEC,1 ; /NOECHO /41/
.byte TC.RAT,1 ; /TYPEAHEAD /41/
.byte TC.8BC,1 ; /EIGHT_BIT /41/
settbs: .byte TC.TBS,220. ; typeahead buffer size /41/
.byte TC.NBR,1 ; /NOBROADCAST /41/
astlen = .-setass ; /41/
assdon: .word 0 ; flag remote save/set done
aslspd: ; Assigned line speed block/41/
aslxsp::.byte TC.XSP,0 ; /SPEED:xmt /41/
aslrsp::.byte TC.RSP,0 ; /SPEED:rcv /41/
iopend: .word 0 ; /36/ lun i/o waiting on
savchr: ; Saved line parameters
.byte TC.ACR,0 ; /{NO}WRAP
.byte TC.FDX,0 ; /{NO}FULLDUPLEX
.byte TC.HFF,0 ; /{NO}FORMFEED
.byte TC.HHT,0 ; /{NO}TAB
.byte TC.NEC,0 ; /{NO}ECHO
.byte TC.SLV,0 ; /{NO}SLAVE
.byte TC.SMR,0 ; /{NO}LOWERCASE
.byte TC.WID,0 ; /WIDTH = n
.byte TC.8BC,0 ; /{NO}EIGHTBIT
.byte TC.BIN,0 ; /{NO}RPA (BDN 04-Aug-84)
savlen = .-savchr
savdon: .word 0
;
; Local line buffer for binary reading
;
inilun: .word 0
linbuf: .blkb MAXLNG+<MAXLNG/10> ; /42/ (larger) Buffer itself
.even ; /42/ Safety
maxlin = .-linbuf ; Maximum read length
.even
linptr: .word linbuf ; Scan pointer
icrem: .rept 15. ; # characters remaining
.word 0
.endr
privon: .word 0 ; /41/ Save priv on/off status
ALSIZE == 440
SDBSIZ == 440
$albuf: .blkb ALSIZE ; /51/ Moved from K11DAT
$phnum: .blkb 60
$lnrea::.word RDLIN ; Default for packet reading
; Other r/w data for dialout line set routines /45/
;
.psect rwdata ,rw,d,lcl,rel,con ; read/write data
; Buffers for Autocall modem fix ; /45/
fixti2: .byte TC.DLU,2,TC.ABD,0 ; values we need for a modem /45/
sizti2 = . - fixti2 ; size of buffers for autocall /45/
; Read only code section
.psect $pdata ro,d,lcl,rel,con ; Read-only data
; System Macros used to get/set characteristics for dial out /45/
.mcall qiow$,dir$ ; call in system macroes /45/
ef.rem = 14. ; use remote event flag (14) /45/
set.dlu: qiow$ sf.smc,lun.ti,ef.rem,,,,<fixti2,sizti2> ; /45/
set.chars: qiow$ sf.smc,lun.ti,ef.rem,,,,<diachr,dialen> ; /45/
rest.chars: qiow$ sf.smc,lun.ti,ef.rem,,,,<datchr,datlen> ; /45/
; M+3.0 Carrier loss detection
dtrast: .byte TC.MHU,0
.word carast
dtrclr: .byte TC.MHU,0
.word 0
; Attributes needed to dialout /45/
diachr: .byte TC.BIN,1 ; binary mode to pass CNTR chars /45/
dialen = .-diachr ; - length of dialout char set /45/
; Other r/w data
.psect $pdata ro,d,lcl,rel,con ; Read-only data
datchr: ; Data mode line parameters
.byte TC.ACR,0 ; /NOWRAP
.byte TC.FDX,1 ; /FULLDUPLEX
.byte TC.HFF,1 ; /FORMFEED
.byte TC.HHT,1 ; /TAB
.byte TC.NEC,1 ; /NOECHO
.byte TC.SLV,1 ; /SLAVE
.byte TC.SMR,1 ; /LOWERCASE
.byte TC.WID,200. ; /WIDTH = 200.
.byte TC.8BC,1 ; /EIGHTBIT
.byte TC.BIN,0 ; /NORPA
datlen = . - datchr
ibmmod: .byte tc.bin,1 ; /RPA (need to read XON's)
.sbttl xinit - assign & attach command terminal
.mcall alun$s ,astx$s ,QIOW$S ,SREX$S ,FEAT$S
FE$EXT = 1
.psect $code
; XINIT - Assign and attach the command terminal
;
; This routine assigns and attaches the command terminal (the
; terminal that "ran" this copy of Kermit-11.
; *** N O T E *** Later, this routine should establish a ^C
; AST so that user can abort in-progress file transfers, and
; get Kermit out of server mode without having to send it a
; finish command. I'll wait for Brian to send me his changes
; for graceful transfer abort before I implement this, though.
;
; 23-Dec-85 19:28:43 BDN
;
; For P/OS, M+ v3 and Micro Rsx v3, also do a TLOG (or TRAN) and
; if we we a translation, do an implicit SET LINE. Can be disabled
; by setting DO$TRAN eq to zero.
.enabl lsb
xinit:: call rmsini ; /53/ Setup SST
FEAT$S #FE$EXT ; /56/ See if 4.2 or M+ 3.x
bcc 1$ ; /56/ Ok
mov sp ,rsx32 ; /56/ Set 3.2 flag
SREX$S #1$ ; /56/ See if this is OLD Rsx (3.2)
bcs 1$ ; /56/ Must be old RSX
clr rsx32 ; /56/ 4.0 or later, or M+ 1.0 and later
SREX$S ; /56/ Clear requested exit address
1$: mov #$albuf ,albuff ; /51/ Fill in
mov #$phnum ,phnum ; /51/ Fill in
clrb @phnum ; /51/ Zero it
clr @albuff ; /51/ Init to empty.
mov #$cmdbuf,cmdbuf ; /53/ $CMDBUF defined in K11RMS
mov #$argbuf,argbuf ; /53/ $ARGBUF defined in K11RMS
mov do$tran ,dotran ; /41/ flag for translation
mov do$msg ,infomsg ; /41/ flag for msg displaying
mov do$app ,logapp ; /41/ Append to logfile flag
mov do$dte ,procom ; /50/ Set default for PRO/COMM
message <Linked for RSX11M/M+ and P/OS >
tst #dapsup ; /56/
bne 4$ ; /56/
message <no DAP support> ; /56/
4$: message ; /56/
tst do$alt ; /46/ Force alternate code?
beq 5$ ; /46/ No
mov #xdorsx ,con$ds ; /46/ Yes
5$: mov #xdorsx ,altcon ; /44/
call getsys ; Find out whats running
cmpb r0 ,#SY$MPL ; M+?
bne 10$ ; No
mov sp ,fu$def ; m+, set SY: as def
10$: cmpb r0 ,#sy$pro ; p/os?
bne 20$ ; no
mov sp ,proflg ; yes, flag it
20$: tst dotran ; /41/ look for logical name
beq 30$ ; /41/ no
CALLS trntrm ,<#ttname> ; /41/ see if translation exits
tst r0 ; /41/ did this succeed ?
bne 30$ ; /41/ no
MESSAGE <Logical name translation returned >; /41/ inform the user
print #ttname ; /41/ print the equivalence name
MESSAGE ; /41/
STRCPY #ttdial ,#ttname ; /41/ copy it over here also
clr remote ; /41/ and we are local
br 40$ ; /41/ continue
30$: tst proflg ; /41/ assume default line for P/OS?
beq 40$ ; /41/ not P/OS
mov #poscon ,con$ds ; /44/ Force my connect code for p/os
STRCPY #ttname ,#xk$dev ; /41/ use xk0: device
STRCPY #ttdial ,#xk$dev ; /41/ use xk0: device
clr remote ; and we are local
clr con8bit ; clear bit 7
MESSAGE <Link default set to XK0: for P/OS>,cr ; tell the user
CALLS ttspeed ,<#ttname> ; /54/ Find out current speed
tst r0 ; /54/ Can't faile
beq 40$ ; /54/ It did
MESSAGE <Current speed: > ; /54/ A MESSAGE
DECOUT r0 ; /54/ Simple
MESSAGE ; cr/lf
40$: ALUN$S #LUN.TT,#"TI,#TIUNIT ; Assign command term.
QIOW$S #IO.ATT,#LUN.TT,#EF.TT,,#kbiost; Attach it, also
QIOW$S #SF.SMC,#LUN.TT,,,,,<#echoch,#2>
sub #10 ,sp ; /53/ Get terminal driver support
mov sp ,r2 ; /53/ A buffer
QIOW$S #IO.GTS,#LUN.TT,,,,,<r2,#4>
bcs 50$ ; /53/ Oops
bit #F2.EIO ,2(r2) ; /53/ Extended IO today?
beq 50$ ; /53/ No
mov #eioread,$lnread ; /53/ M+, try IO.EIO for version 3
50$: add #10 ,sp ; /53/ Pop buffer
clr tcdlu ; don't change tc.dlu
call setcc ; enable ^C asts
call inqter ; /45/ No, get the terminal type
mov r0 ,vttype ; /45/ Done
return
.save
.psect $xkdev ,ro,d,lcl,rel,con
echoch: .byte TC.NEC,0
xk$dev::.asciz /XK0:/
.even
.dsabl lsb
.restore
global <altcon, xdorsx ,con$ds ,poscon> ; /44/
global <lun.tt, tiunit>
global <ARGBUF,CMDBUF,$ARGBUF,$CMDBUF> ; /53/
global <DAPSUP,RSX32> ; /56/
inqbuf::mov #200. ,-(sp) ; /42/ Assume M+
call getsys ; /42/ M+ today?
cmpb r0 ,#SY$MPL ; /42/ If so, large buffering
beq 100$ ; /42/ M+
mov #500. ,(sp) ; /42/ Assume P/OS
tst proflg ; /42/ P/OS and XK:?
bne 100$ ; /42/ Yes, return(500)
mov #90. ,(sp) ; /42/ Vanilla RSX11M
100$: mov (sp)+ ,r0 ; /42/ Return buffering available
return ; /42/ for LONG PACKET support.
setcc:: QIOW$S #io.det,#lun.tt,#ef.tt,,#kbiost
QIOW$S #io.ata,#lun.tt,#ef.tt,,#kbiost,,<,0,#ttast>
return
ttast: cmpb (sp) ,#'c&37 ; control C ?
bne 100$ ; no
call cctrap ; yes, call handler to check it
tst iopend ; /36/ Is a QIO pending for packet?
beq 100$ ; /36/ no
QIOW$S #IO.KIL,iopend ; /36/ Yes, force an IO.ABO error
100$: tst (sp)+
astx$s ; and exit from ast service
global <cctrap>
.sbttl ttyini - Save & switch line to data mode
; T T Y I N I
;
; ttyini( %loc device_name ,%val channel_number ,%val ccflag )
;
;
; input: @r5 .asciz string of device name (Ignored on native RSX)
; 2(r5) channel number (LUN)
; 4(r5) mode bits: (Ignored on native RSX)
;
; output: r0 error codes
;
; On RSX, this routine does dynamic switching of terminal from
; interactive mode(s) to data mode(s). The ttysav(), ttyset()
; and noecho() routines are no-ops ...
;
; It is used only for packet communications. The "doconn()" in
; this module handles the setup and restoration of the terminal
; lines for CONNECT modes.
;
; ** Someday, the whole command terminal and communication line handling
; architecture should be smoothed out and simplified, once Brian and
; I get together and compare notes re: native RSX versus emulated RSX,
; and what is required for compatibility without too much pain ...
;
; Added SREX 22-Jun-84 11:15:46 Brian Nelson
;
; Bob Denny
;
.mcall srex$s ,exit$s
ttyini::save <r1>
call getprv ; /41/ May need privs
call ttpars ; Get unit number
bcs 1$
alun$s 2(r5),r1,r0 ; Assign LUN
mov $dsw,r0 ; get the result
bcc 2$ ; oops
1$: jmp 10$ ; Too far to branch
2$: clr r0 ; Make return success
clr savdon ; not saved tt settings yet
cmp 2(r5),#lun.co ; Command terminal (SAFETY)
beq 10$ ; (yes, ignore this)
QIOW$S #io.att,2(r5),#ef.tt ; Attach the terminal. (RTM01)
QIOW$S #sf.gmc,2(r5),#ef.tt,,#kbiost,,<#savchr,#savlen>
mov kbiost,r0
cmpb r0,#IS.SUC ; OK?
bne 10$ ; (no)
mov sp ,savdon ; we have done the save
mov 2(r5) ,inilun ; save this lun (BDN)
srex$s #abort ; in case server aborted (BDN)
tstb handch ; IBM crap (BDN 04-Aug-84)
beq 5$ ; no
QIOW$S #sf.smc,2(r5),#ef.tt,,#kbiost,,<#ibmmod,#2> ;
5$: QIOW$S #sf.smc,2(r5),#ef.tt,,#kbiost,,<#datchr,#datlen>
clr eioinit ;
mov kbiost,r0
cmpb r0,#IS.SUC ; OK?
bne 10$ ; (no)
clr r0 ; Yes - clear r0 = OK
QIOW$S #SF.SMC,2(r5),,,,,<#dtrast,#4> ; Set this up for carrier loss
10$: tst proflg ; if a pro/350, ignore errors
beq 100$ ; not a 350
clr r0 ; a 350, forget about the errors
100$: unsave <r1>
call drpprv ; /41/ No privs wanted now
return
rstsrv::tst inserv
beq 100$
call ..abort
100$: return
..abort:call getprv ; /41/ May need privs turned on
QIOW$S #sf.smc,inilun,#ef.tt,,#kbiost,,<#savchr,#savlen>
call drpprv ; /41/ Don't want privs anymore
return
abort: call ..abort
jmp exit
global <inserv>
; T T Y F I N
;
; ttyfin( %loc device_name ,%val channel_number )
;
;
; input: @r5 .asciz string of device name (Ignored on native RSX)
; 2(r5) channel number (LUN)
;
; No need for ttyrst()
;
ttyfin::call getprv ; /41/ May need privs up now
srex$s ; no more abort handling
cmp 2(r5),#lun.co ; Command terminal?
beq 10$ ; (yes, skip it)
QIOW$S #SF.SMC,2(r5),,,,,<#dtrclr,#4> ; Set this up for carrier loss
QIOW$S #io.det,2(r5),#ef.tt ; Attach the terminal. (RTM01)
tst savdon ; ever save the crap?
beq 10$ ; no, don't reset it
QIOW$S #sf.smc,2(r5),#ef.tt,,,,<#savchr,#savlen>
10$: call drpprv ; /41/ Don't want privs up
clr r0
return
; STUB ROUTINES - Not needed here
;
ttrini::
ttrfin::
ttysav::
ttyset::
ttyrst::
noecho::
echo::
clr r0
return
.sbttl get terminal name
; G T T N A M
;
; input: @r5 address of 8 character buffer for terminal name
; output: .asciz name of terminal
.mcall glun$s
gttnam::save <r1,r2,r3> ; save temps please
mov @r5 ,r3 ; point to output buffer please
sub #20 ,sp ; allocate a buffer for GLUN$S
mov sp ,r2 ; point to it please
glun$s #lun.tt ,r2 ; try it
cmpb @#$DSW ,#is.suc ; did it work ?
bne 90$ ; no, return the error code please
movb g.luna+0(r2),(r3)+ ; get the device name next
movb g.luna+1(r2),(r3)+ ; both bytes of it please
clr r1 ; get the unit number next please
bisb g.lunu(r2),r1 ; simple
clr r0 ; now compute the ascii name
div #10 ,r0 ; simple (in octal please for RSX)
mov r1 ,-(sp) ; save the low order unit number
cmp r0 ,#7 ; unit number > 77 octal ?
blos 10$ ; no
mov r0 ,r1 ; yes, do it again please
clr r0 ; simple
div #10 ,r0 ; and so on
add #'0 ,r0 ; convert to ascii please
movb r0 ,(r3)+ ; get the high part copied
mov r1 ,r0 ; and now put the next digit back
10$: mov (sp)+ ,r1 ; get the low digit back now
add #'0 ,r0 ; convert to ascii
add #'0 ,r1 ; likewise
movb r0 ,(r3)+ ; move the unit number in now
movb r1 ,(r3)+ ; at last ....
movb #': ,(r3)+ ; please insert a colon:
clrb @r3 ; make it .asciz
clr r0 ; no errors
br 100$ ; exit
90$: moverr @#$dsw ,r0 ; get the directive error code
100$: add #20 ,sp ; pop glun$s buffer
unsave <r3,r2,r1>
return
.sbttl Vanilla read from command terminal
; K B R E A D
;
; Read a line from the command terminal (80 characters max)
;
; Input: @r5 Address of 80 character buffer
;
; Output: r0 = 0 if OK, else error code
; r1 = Number of characters if OK, else 0
;
; Echoes a <LF> on completion to counter Dave Cutler's old
; FORTRAN record processing view of the world.
kbread::
QIOW$S #io.rvb,#5,#ef.tt,,#kbiost,,<@r5,#80.>
clr r0 ; assume no errors
mov kbiost+2,r1 ; return bytecount in r1
cmpb kbiost ,#is.suc ; successful read ?
beq 100$ ; yes
clr r1 ; no data please
moverr kbiost ,r0 ; return the error
100$: print #lf1
return
.save
.psect $PDATA ,D
lf1: .byte lf,0
.restore
.sbttl terminal read/write binary mode
; B I N R E A
;
; binread( %val channel_number, %val timeout )
;
;
; input: @r5 channel number
; 2(r5) timeout (if -1, then no wait) (do this for RSX??)
;
; output: r0 error
; r1 character read
;
; This version uses "normal" reading, as KERMIT sends its packets
; ending in its "EOL" character, which we need to be a <CR>. This
; makes reading packets a piece'o cake. We simply buffer lines
; here and scan off characters as needed. Terminal modes have
; been set for reasonably low driver overhead.
;
; No longer used by CONNECT
;
pakrea::
binrea::mov @r5 ,iopend ; /36/ save lun i/o is waiting on
tstb handch ; doing ibm style xon handshaking BDN
beq 5$ ; then we must do single char qios BDN
call xbinrea ; do that and exit BDN
br 100$ ; /36/ exit
5$: save <r2>
mov @r5 ,r2 ; lun to use today
asl r2 ; fix it for word indexing
10$: tst icrem(r2) ; Anything remaining in current line?
bne 40$ ; (yes)
jsr pc ,@$lnread ; Call someone to read data
bcs 50$ ; (read error)
br 10$ ; Try again
40$: clr r1 ; Move next char unsigned ...
bisb @linptr,r1 ; ... into r1
inc linptr ; Advance pointer
dec icrem(r2) ; Decrement # characters remaining
clr r0 ; Success
50$: unsave <r2>
100$: clr iopend ; /36/ i/o no longer pending
return ; Return
;
; RDLIN - Local read routine
;
; Inputs:
; @r5 LUN to read on
; 2(r5) timeout, seconds
;
; Outputs:
; C-bit clear Successful read (something read before timeout)
; icrem = number of characters in this line
; linptr -> 1st character in the line
;
; C-bit set Failed
; R0 = error code
; icrem = 0
.mcall mrkt$s ,wtse$s ,qiow$s
rdlin:
clr icrem(r2) ; Reset buffer counter
mov #linbuf,linptr ; Reset scan pointer
10$: clr r0 ; Assume no timeout
mov 2(r5),r1 ; R1 = timeout in seconds
ble 20$ ; (no timeout)
add #9.,r1 ; Round up to nearest 10 second clicks
div #10.,r0 ; Convert to 10 sec. clicks
20$: tst proflg ; pro/350?
bne 25$ ; yes
tst chario ; force pro/350 style reads today?
bne 25$ ; yes
tstb parity ; /39/ must check if TTDRV may never
beq 24$ ; /39/ see it's <CR> to terminate the
cmpb parity ,#PAR$NO ; /39/ line. Use a read with terminator
beq 24$ ; /39/ QIO if parity is on.
br 25$ ; /41/ IO.RTT did not work
;-/41/ mov #<IO.RTT!TF.RNE!TF.TMO>,r1 ; /39/
;-/41/ QIOW$S r1,@r5,#ef.tt,,#kbiost,,<#linbuf,#maxlin,r0,#tt$trm> ; /39/
;-/41/ br 30$ ; /39/
24$: QIOW$S #<io.rlb!tf.tmo>,@r5,#ef.tt,,#kbiost,,<#linbuf,#maxlin,r0>
br 30$
25$: call getprv ; /41/ May need for SF.GMC call
clr -(sp) ; get the typehead buffer size
mov sp ,r1 ; point to the parameter area
movb #tc.tbf ,@r1 ; we want amount in the buffer
QIOW$S #sf.gmc,@r5,#ef.tt,,,,<r1,#2>
movb 1(r1) ,r1 ; get the typeahead size
bne 26$ ; we have something to get there
inc r1 ; nothing, wait for one character
26$: QIOW$S #<io.ral!tf.tmo!tf.rne>,@r5,#ef.tt,,#kbiost,,<#linbuf,r1,r0>
tst (sp)+ ; pop sf.gmc buffer please
call drpprv ; /41/ Drop privs if need be
30$: movb kbiost ,r0 ; /41/
cmpb r0 ,#IE.DNR ; /45/ Did we drop carrier ?
bne 31$ ; /45/ No
mrkt$s #2,#1,#2 ; /45/ Yes, suspend for 1 second
wtse$s #2 ; /45/ ...
br 40$ ; /45/ Treat as timeout at upper lev
31$: cmpb r0 ,#IS.TMO ; timed out on the read ?
beq 40$ ; yes
cmpb r0 ,#IE.ABO ; /36/ from IO.KIL on control C ast?
beq 40$ ; /36/ yes, treat as a timeout then
cmpb r0 ,#IE.EOF ; /41/ End of file today (control Z)?
beq 80$ ; /41/ Yes, return control Z and 1 byte
cmpb kbiost+1,#33 ; /47/ Was \033 the terminator?
beq 80$ ; /41/ Yes, Again return control Z
cmpb linbuf ,#'Z&37 ; /41/ P/OS style reads and control Z?
beq 80$ ; /41/ Yes, exit
tst r0 ; Some kind of success?
bmi 90$ ; no
mov kbiost+2,icrem(r2) ; Yes, set up number of characters
mov #linbuf,r1 ; R1 --> line buffer
add icrem(r2),r1 ; R1 --> first free byte at end of line
movb kbiost+1,(r1) ; Get possible terminator character
beq 35$ ; (none)
inc icrem(r2) ; Adjust for terminator
35$: clrb (r1) ; Null terminate just for grins
clr r0 ; Clear r0 and C-bit
return ; Finished
40$: movb #er.tmo ,r0 ; return timeout error code
clr icrem(r2) ; just to be safe
sec ; say it failed
return
80$: movb #'Z&37 ,linbuf ; /41/ EOF or Escape sequence, return
mov #1 ,icrem(r2) ; /41/ control Z and char_count == 1
clc ; /41/ success
return ; /41/ exit
90$: clr icrem(r2) ; to be safe
sec ; Error
return ; bye
.sbttl Extended I/O read for M+ and MicroRsx version 3.x
.enabl lsb
; Added 27-Jun-86 13:24:18 Brian Nelson
;
; Now that I finally have an 11/73 running M+, I can do stuff
; like this.
E$MOD1 = 0 ; Modifier word 1
E$MOD2 = 2 ; Modifier word 2
E$BUFF = 4 ; Buffer address
E$LEN = 6 ; Buffer length
E$TMO = 10 ; Timeout (in seconds here)
E$PRM = 12 ; Prompt address
E$PRML = 14 ; Prompt length
E$PRMV = 16 ; Prompt VFC
E$TT = 20 ; Terminator table address
E$TTL = 22 ; Terminator table length
E$DFD = 24 ; Default data address
E$DFDL = 26 ; Default data length
.save ; Save current code psect
.psect rwdata ,d ; New psect
.even ; Insure
eiojnk: .word 0
eiolst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0 ; Itemlist for IO.EIO
eioios: .word 0,0,0,0
eioini: .word 0
eiochr: .byte TC.BIN,0,TC.PTH,0
eiosav: .byte TC.BIN,0,TC.PTH,0
$$eiol = . - eiosav
.restore ; Restore old psect
eiorea::mov r3 ,-(sp) ; Save please
tst eioini ; Need to set chars for EIO?
bne 10$ ; No (reset to zero in TTYINI)
mov sp ,eioini ; Yes, change to /NORPA and /PASTHRU
tstb handch ; Hand shaking in effect?
bne 10$ ; Yes, leave TC.BIN on please
call getprv ; May need privs on
QIOW$S #SF.GMC,(r5),#EF.TT,,,,<#eiosav,#$$EIOL>
QIOW$S #SF.SMC,(r5),#EF.TT,,,,<#eiochr,#$$EIOL>
call drpprv ; Drop them now.
10$: clr ICREM(r2) ; Reset buffer counter
mov #linbuf,linptr ; Reset scan pointer
mov #eiolst ,r3 ; The itemlist
mov 2(r5) ,E$TMO(r3) ; Insert the timeout please
mov #linbuf ,E$BUFF(r3) ; Insert the buffer address next.
mov #maxlin ,E$LEN(r3) ; Insert the buffer size also.
mov #TF.TMO ,E$MOD1(r3) ; Insert desired read modifiers.
tst chario ; Do we read EXACTLY whats in buffer?
bne 15$ ; Yes.
tstb parity ; Is parity on ?
beq 20$ ; No, wait for terminators
cmpb parity ,#PAR$NO ; Well?
beq 20$ ; Ok. Otherwise, read typeahead ONLY
15$: clr E$TMO(r3) ; Yes, later we will not timeout first
bis #TF.RAL ,E$MOD1(r3) ; Also, we want everything AS IS!
;
20$: QIOW$S #IO.EIO!TF.RLB,(r5),#EF.TT,,#eioios,,<#eiolst,#30>
bcs 90$ ; The directive completely died
movb eioios ,r0 ; Get the QIO result.
cmpb r0 ,#IE.IFC ; Did it die because of this
beq 90$ ; Yes, reset to old read mode.
cmpb r0 ,#IE.ABO ; Did the ^C ast routine do IO.KIL
beq 80$ ; Yes, return(TIMEOUT)
cmpb r0 ,#IE.DNR ; Do we lack carrier now?
beq 70$ ; Yes, sleep a moment, return(TMO)
cmpb r0 ,#IE.EOF ; Well, what about END of FILE?
beq 60$ ; Thats it, return a control Z
tst r0 ; Did we get ANY kind of success?
bmi 90$ ; No, reset reader address, redo.
cmpb eioios+1,#33 ; Did we get ESCAPE as terminator?
beq 60$ ; Yes, also treat as control Z
cmpb linbuf ,#'Z&37 ; Does the buffer START with ^Z?
beq 60$ ; Yes, same thing.
cmpb r0 ,#IS.TMO ; Success with a TIMEOUT?
bne 30$ ; No
tst eioios+2 ; Yes, was there ANY data present?
bne 30$ ; There was data, return it please.
tstb E$TMO(r3) ; No data, but did we want only the
bne 80$ ; typeahead that was there? No
mov 2(r5) ,E$TMO(r3) ; Yes, stuff a REAL timeout in.
mov #1 ,E$LEN(r3) ; And only ONE character this time.
bis #TF.RAL ,E$MOD1(r3) ; Insure no waits for terminators.
br 20$ ; Try the read over again now.
;
30$: mov eioios+2,ICREM(r2) ; Return the size of the read now.
mov #linbuf ,r1 ; Get the buffer address
add ICREM(r2),r1 ; And point to the end of it.
movb eioios+1,(r1) ; Get possible terminator character
beq 40$ ; (none)
inc ICREM(r2) ; Adjust for terminator
40$: clrb (r1) ; Null terminate just for grins
clr r0 ; Clear r0 and C-bit
br 100$ ; Exit at last....
;
;
60$: movb #'Z&37 ,linbuf ; Force a control Z to be returned
inc ICREM(r2) ; Return exactly ONE character.
clc ; Successfull
br 100$ ; Exit
;
70$: MRKT$S #2,#1,#2 ; Lost carrier, suspend for a
WTSE$S #2 ; moment and return(TIMEOUT)
; Drop through to timeout
80$: movb #ER.TMO ,r0 ; Return timeout error code
sec ; Say the read failed
br 100$ ; And exit
;
90$: mov #rdlin ,$lnread ; Total failure, switch readers.
call getprv ; May need privs on
QIOW$S #SF.SMC,(r5),#EF.TT,,,,<#eiosav,#$$EIOL>
call drpprv ; Drop them now.
clc ; Force caller to try again.
100$: mov (sp)+ ,r3 ; Restore r3
return
.dsabl lsb
.sbttl BINWRITE(&buffer,size,channel)
; 0(r5) Buffer address
; 2(r5) buffer size
; 4(r5) channel number
; output: r0 error code
; Edit: /40/ 16-Dec-85 14:58:01 BDN Set timer in case line xoffed
.mcall mrkt$s ,cmkt$s ,QIOW$S ,astx$s ; /40/
.enabl lsb ; /40/
pakwri::
binwri::mov 4(r5) ,310$ ; /40/ Registers saved in ASTs?
mrkt$s #ef.tmo,#7,#2,#200$ ; /40/ start 7 second timeout
QIOW$S #io.wal,4(r5),#ef.tt,,#kbiost,,<@r5,2(r5)>
cmpb kbiost ,#IE.ABO ; /41/ Did the timeout occur?
beq 90$ ; /41/ Yes, try again
cmkt$s #ef.tmo,#200$ ; /40/ write ok, cancel timer
br 100$ ; /40/ and exit
90$: QIOW$S #io.wal,4(r5),#ef.tt,,#kbiost,,<@r5,2(r5)> ; /40/
100$: clr r0
return
200$: QIOW$S #IO.KIL,310$ ; /40/ abort the pending I/O
call getprv ; /41/ May need privs up now
QIOW$S #SF.SMC,310$,,,,,<#300$,#2> ; /40/ insure line is XON'ED
call drpprv ; /41/ Don't want privs anymore
tst (sp)+ ; /40/ pop timeout flag and
astx$s ; /40/ exit
.save
.psect $idata rw,d,lcl,rel,con
.even
300$: .byte TC.CTS,0
310$: .word 0
.restore
.dsabl lsb
.sbttl real binary i/o for doing ^X and ^Z things
; X B I N R E A
;
; binread( %val channel_number, %val timeout )
;
;
; XBINREAD is used in Kermit-11 for the DIAL command to read the
; responses from the modem on a character by character basis, and
; also is called once per packet if in local mode to check for
; typeahead in the form of CTRL E, X or Z to implement graceful
; transfer aborts. While this could be done under M/M+ via an un-
; solicited character AST, that won't work for RT11 and RSTS/E.
; Thus the sampling method (XBINREA called by CHKABO).
;
; /38/ Change QIO timed read to untimed with a MARKTIME (MRKT$S)
; to allow better granularity on the timeout interval. If time-
; out occures, do a IO.KIL
;
;
; input: @r5 channel number
; 2(r5) timeout (if -1, then no wait) (do this for RSX??)
;
; output: r0 error
; r1 character read
;
.mcall QIOW$S ,mrkt$s ,cmkt$s ,astx$s
xbinre::save <r2,r3> ; save a register for a friend
clr -(sp) ; allocate a buffer please
mov sp ,r2 ; and point to it now
clr -(sp) ; allocate a buffer for SF.GMC
mov sp ,r3 ; and point to it please
cmp 2(r5) ,#-1 ; get without any wait today ?
bne 20$ ; no, check for timeouts now
movb #tc.tbf ,@r3 ; create a .byte tc.tbf,0
QIOW$S #sf.gmc,@r5,#ef.tt,#50,#kbiost,,<r3,#2>
cmpb kbiost ,#is.suc ; did the read terminal thing work?
bne 90$ ; no
tstb 1(r3) ; any data in the typeahead buffer?
bne 20$ ; yes
movb #nodata ,r0 ; fake a psuedo no data error
br 100$ ; and exit
20$: tst 2(r5) ; /38/ a real timed read ?
ble 30$ ; /38/ no
mov @r5 ,iopend ; /38/ save LUN
mrkt$s #ef.tmo,2(r5),#2,#200$ ; /38/ we really want 1 second chuncks
30$: QIOW$S #io.ral!tf.rne,@r5,#ef.tt,#50,#kbiost,,<r2,#1>
cmkt$s #ef.tmo,#200$ ; /38/ cancel marktime please
clr r1 ; get the character now please
bisb @r2 ,r1 ; copy it with sign extension!
clr r0 ; assume no errors
cmpb #is.suc ,kbiost ; did it work ?
beq 100$ ; yes, exit
cmpb #IE.ABO ,kbiost ; /38/ convert IO.KIL to timeout
beq 40$ ; /38/
cmpb #is.tmo ,kbiost ; timeout
bne 90$ ; no
40$: movb #er.tmo ,r0 ; yes
br 100$ ; bye
90$: moverr kbiost ,r0 ; no, return the error
100$: cmp (sp)+ ,(sp)+ ; pop the 2 buffers please
unsave <r3,r2> ; from DIRECTIVE errors
clr iopend ; /38/
return ; bye
200$: tst (sp)+ ; mark time ast entry
QIOW$S #IO.KIL,iopend,#ef.tt ; kill the i/o
astx$s ; exit
chkabo::CALLS xbinrea ,<#lun.tt,#-1> ; simple read on console terminal
tst r0 ; did it work ok ?
bne 100$ ; no
mov r1 ,r0 ; yes, return ch in r0 please
return
100$: clr r0 ; it failed
return
.sbttl Special routines for command line editor
read1c::clr -(sp)
mov sp ,r0
QIOW$S #IO.RAL!TF.RNE,#5,#EF.TT,,#kbiost,,<r0,#1>
cmpb kbiost ,#IS.SUC
beq 10$
clrb @r0
10$: movb kbiost ,r0
mov (sp)+ ,r0
cmpb r0 ,#CR
bne 100$
mov #LF ,r0
100$: bic #^C377 ,r0
return
wrtall::SAVE <r0,r2> ; Must use IO.WAL for CLE for
mov 2+4(sp) ,r2 ; some versions of RSX11M
STRLEN r2 ; Get the string length.
QIOW$S #IO.WAL,#5,,,,,<r2,r0> ; Dump the string in pass-all mode
UNSAVE <r2,r0> ; Pop register
mov (sp)+ ,(sp) ; Move return address over parameter
return ; Exit
clrcns::QIOW$S #SF.SMC,#5,,,,,<#can,#2>; Simple
return
.save
.psect rwdata ,d
can: .byte TC.TBF,0
.restore
.sbttl normal i/o to the terminal
; S T T Y O U
;
; input: 2(sp) buffer address
; 4(sp) buffer length
; output: 'c' set on error
; 'c' clear on no error
;
;
; L $ T T Y O
;
; l$ttyou( %loc buffer, %val string_length )
;
; input: @r5 buffer address
; 2(r5) buffer length
l$ttyo::
save <r0,r1> ; save temps here please
movb kbiost ,-(sp) ; save old io status
mov 2(r5) ,r0 ; string length
bne 20$ ; length was passed
mov @r5 ,r0 ; no length, assume .asciz
10$: tstb (r0)+ ; move along looking for a null
bne 10$ ; none yet so far
sub @r5 ,r0 ; get the length
dec r0 ; off by one
20$: QIOW$S #io.wvb,#5,#ef.tt,,#kbiost,,<@r5,r0>
cmpb kbiost ,#is.suc ; did it work ?
bne 90$ ; no, exit with carry set
clc ; yes, it worked
br 100$ ; exit
90$: sec ; write failed, set error flag and exit
100$: movb (sp)+ ,kbiost
unsave <r1,r0> ; pop registers that we used
return ; and exit
sttyou::
mov r5 ,-(sp)
mov sp ,r5
add #4 ,r5
call l$ttyo
mov (sp)+ ,r5
return
l$pcrl::MESSAGE
return
.sbttl exit kermit and logout
; Logout a server (LOGOUT:) by requesting ...BYE
; Exit Kermit-11
;
; Steve Heflin's mods added 25-Dec-85 12:46:29 BDN
.mcall exit$s ,rpoi$s ,exst$s; /41/ add EXST$S
.save
.psect $PDATA ,D
bye: .rad50 /...BYE/
.restore
logout::
tst assdon ; ever slave the line?
beq 10$ ; no
call rstass ; /41/ restore more things now
10$: RPOI$S #BYE ; request ...BYE
br exits ; /41/ exit with status please
exit:: tst eioini ; /54/ Extended IO init
beq 10$ ; /54/ No
Call getprv ; /60/ privs on
QIOW$S #SF.SMC,#LUN.AS,#EF.TT,,,,<#eiosav,#$$EIOL>
Call drpprv ; /60/ privs off
10$: tst assdon ; ever slave the line?
beq exits ; no
call rstass ; /41/ restore more things now
exits: mov exstac ,r0 ; /41/ get exit status
bne 20$ ; /41/ something is there to emit
EXIT$S ; /41/ nothing there, exit w/o status
20$: asl r0 ; /41/ shift over 4 bits
asl r0 ; /41/ ...
asl r0 ; /41/ ...
asl r0 ; /41/ ... done
cmp exstal ,#15. ; /41/ Will command file line number
blos 30$ ; /41/ fit into exit status word ?
mov #15. ,exstal ; /41/ No, stuff 15 (10) into it
30$: bisb exstal ,r0 ; /41/ Set bits in from line number
EXST$S r0 ; /41/ Exit with status now
quochk::
clr r0 ; try to see if the logout will work
return
dskuse::
mov @r5 ,r0
copyz #nogu ,r0
return
.save
.psect $PDATA ,D
nogu: .asciz /Can't do space enquiry for RSX/
.even
.restore
.sbttl cantyp cancel typeahead
; C A N T Y P
;
; cantyp(%val channel_number)
;
; input: @r5 device name
; 2(r5) lun
;
;
; Cantyp tries to dump all pending input on a given terminal
; line.
cantyp::
save <r0,r1> ; use r0 to point into xrb
call getprv ; /41/ May need privs now
clr -(sp) ; allocate buffer for SF.SMC
mov sp ,r1 ; point to it please
movb #tc.tbf ,@r1 ; cancel all typeahead please
mov 2(r5) ,r0 ; get the channel number please
asl r0 ; purge internally buffer chars
clr icrem(r0) ; simple
asr r0 ; restore lun
bne 10$ ; ok
mov #5 ,r0
10$: QIOW$S #sf.smc,r0,#ef.tt,,#kbiost,,<r1,#2>
100$: tst (sp)+
call drpprv ; /41/ Don't want privs right now
unsave <r1,r0> ; all done
return ; bye
; T T X O N
;
; input: @r5 device name
; 2(r5) lun
; output: r0 error code (really, it will be zero)
;
;
; TTXON cancels xoff on a line
ttxon:: save <r1,r2> ; use r0 to point into xrb
call getprv ; /41/ May need privs turned on
clr -(sp) ; allocate buffer for SF.SMC
mov sp ,r1 ; point to it please
movb #tc.cts ,@r1 ; cancel all typeahead please
clrb 1(r1) ; zero means to cancel xoff
mov 2(r5) ,r2 ; get the channel number please
bne 10$ ; ok
mov #5 ,r2
10$: QIOW$S #sf.smc,r2,#ef.tmp,,,,<r1,#2>
QIOW$S #io.wal,r2,#ef.tmp,,,,<#xon1,#1>
100$: tst (sp)+
unsave <r2,r1> ; all done
call drpprv ; /41/ Don't want privs anymore
clr r0 ; no errors
return ; bye
.save
.psect $PDATA ,D
xon1: .byte 'Q&37,0
.even
.restore
.sbttl get uic
; G E T U I C
;
; input: nothing
; output: r0 current UIC/PPN of the user
.mcall gtsk$s
getuic::
sub #40 ,sp ; allocate gtsk buffer
mov sp ,r0 ; point to the buffer please
gtsk$s r0 ; simple
mov g.tspc(r0),r0 ; return the uic
add #40 ,sp ; pop the buffer and exit
return
; Drop/Regain privs for M+ v3 and Micro/Rsx V3 /41/
.mcall GIN$S ; /41/ the macro that does such things
drpprv::mov r1 ,-(sp) ; /41/ save a register today
clr r1 ; /41/ say we want to drop it all
br doprv ; /41/ off to common code now
getprv::mov r1 ,-(sp) ; /41/ save a register today
mov #-1.,R1 ; /60/ set bit 0 to request privs
doprv: mov r0 ,-(sp) ; /41/ Lets not trash r0 this time
call getsys ; /41/ insure that it's not virgin 11M
cmpb r0 ,#SY$11M ; /41/ old type 11M today ?
beq 100$ ; /41/ yes, do nothing
tst proflg ; /41/ Also skip for P/OS
bne 100$ ; /41/ P/OS, then exit
tst #GI.SPR ; /41/ if this is not defined then skip
beq 100$ ; /41/ it
mov r1 ,privon ; /41/ Save priv on/off status
GIN$S #GI.SPR,r1 ; /41/ Set the privs up/down now
100$: mov (sp)+ ,r0 ; /41/ Restore R0
mov (sp)+ ,r1 ; /41/ pop a register now
return
.sbttl suspend the job for a while
; S U S P E N
;
; suspend(%val sleep_time)
;
; input: @r5 time to go away for
.mcall mrkt$s ,wtse$s
suspen::
tst @r5 ; nonzero seconds call ?
bne 10$ ; yes
mrkt$s #ef.tt,2(r5),#1 ; no, sleep passed # of ticks
br 20$ ; and now wait for the timeout
10$: mrkt$s #ef.tt,@r5,#2 ; sleep integral # of seconds
20$: wtse$s #ef.tt
return
.sbttl ttypar set parity stuff for kermit
; T T Y P A R
;
; ttypar( %loc terminal name, %val paritycode )
;
; input: @r5 address of terminal name
; 2(r5) parity code
; output: r0 error code
.if ne ,0 ; we are doing it in software as of
.ift ; 28-Mar-84 09:11:18 (BDN)
ttypar::
call ttpars ; get the terminal unit number
bcs 100$ ; oops
100$: movb @#$DSW ,r0 ; get any errors
return
.endc
chkpar::clr r0
return
.enabl lsb
; Inqpar added /53/
Inqpar::SAVE <r1> ; Save this one
clr -(sp) ; Allocate a buffer
call ttpars ; the usual, parse the device name
bcs 90$ ; oops
ALUN$S #LUN.CO,r1,r0 ; assign the terminal please
mov sp ,r1 ; Point to it
movb #TC.PAR ,(r1) ; Want to know about parity
QIOW$S #SF.GMC,#LUN.CO,,,,,<r1,#2>
bcs 90$ ; Oops
movb 1(r1) ,r0
mov sp ,r0 ; Assume parity
tstb 1(r1) ; Is parity set?
bne 100$ ; Yes
90$: clr r0 ; No parity or directive error
100$: tst (sp)+ ; Pop buffer
UNSAVE <r1> ; Restore this one
return ; Exit
GLOBAL <TC.PAR,LUN.CO>
.dsabl lsb
.sbttl hangup a terminal, set dtr on a terminal
; T T Y H A N
;
; ttyhan( %loc terminalname )
;
; input: @r5 address of the terminal name
; output: r0 error code
.mcall ALUN$S ,CMKT$S ,MRKT$S ,QIOW$S
ttyhan::save <r1>
MRKT$S #EF.TMO,#2,#2,#200$ ; /41/ Set a timeout up please
call getprv ; get privs +SSH
tst assdon ; /41/ assign ever done ?
bne 5$ ; /41/ Yes
call ttpars ; /41/ No, likely we are on P/OS
bcs 100$ ; /41/ Parse failed (?)
ALUN$S #LUN.AS,r1,r0 ; /41/ Never assigned, do it now
QIOW$S #IO.ATT,#LUN.AS ; /41/
5$: tstb logstr ; /41/if logoff MESSAGE len > 0 +SSH
beq 10$ ; /41/no +SSH
strlen #logstr ; /41/yes, send logout line +SSH
QIOW$S #IO.WLB,#lun.as,#ef.tt,,,,<#logstr,r0,#53> ;/41/ +SSH
MRKT$S #ef.tt,#2,#2 ; wait 2 seconds +SSH
WTSE$S #ef.tt ; 2 seconds up when ef set +SSH
10$:
QIOW$S #IO.HNG,#lun.as,#ef.tt,#50,#kbiost ; /SSH
tst assdon ; /41/ Ever reach ASSDEV ?
beq 20$ ; /41/ No
QIOW$S #IO.DET,#lun.as ; /41/ Likely P/OS, so detach NOW
20$: call rstass ; restore any old line setting +SSH
CMKT$S #EF.TMO,#200$ ; /41/ Kill the mark time now
moverr kbiost ,r0
unsave <r1>
100$: return
200$: QIOW$S #IO.KIL,#LUN.AS ; /41/ We get here on a timeout
tst (sp)+ ; /41/ Pop EF
ASTX$S ; /41/ Exit from the AST
carast: MESSAGE
MESSAGE <?Carrier lost>,CR
ASTX$S
; raise DTR on a terminal line
;
; T T Y D T R
;
; ttydtr( %loc terminalname )
;
; input: @r5 address of the terminal name
; output: r0 error code
ttydtr::
call ttpars ; the usual, parse the device name
bcs 100$ ; oops
100$: movb @#$DSW ,r0 ; return error code and exit
return ; bye
; For INQDTR, see same in K11E80.MAC (RSTS/E version)
inqdtr::mov #-1 ,r0
return
.sbttl ttspeed get speed for line
; T T S P E E D
;
; input: @r5 name of terminal or address of null for current
; output: r0 current speed
;
.psect $pdata
splst: .word 0 ,50. ,75. ,110. ,134. ,150. ,200.
.word 300. ,600. ,1200. ,1800. ,2000. ,2400. ,3600.
.word 4800. ,7200. ,9600. ,19200. ,38400. ,-1
setlst: .word s.0 ,s.50 ,s.75 ,s.110 ,s.134 ,s.150 ,s.200
.word s.300 ,s.600 ,s.1200 ,s.1800 ,s.2000 ,s.2400 ,s.3600
.word s.4800. ,s.7200 ,s.9600 ,s.19.2 ,s.38.4 ,-1
.psect $code
ttspee::call getprv ; /41/ May need privs turned on
save <r1,r2>
clr -(sp) ; allocate buffer for SF.GMC
clr -(sp)
call ttpars ; parse the terminal device name
bcs 90$ ; error in device name ?
alun$s #lun.co,r1,r0 ; assign the terminal please
mov sp ,r2
movb #tc.xsp ,@r2
movb #tc.rsp ,2(r2)
QIOW$S #sf.gmc,#lun.co,#ef.tt,,#kbiost,,<r2,#4>
movb kbiost ,-(sp)
movb (sp)+ ,kbiost
clr r0 ; assume zero speed
cmpb kbiost ,#is.suc ; did the read speed thing work ?
bne 90$ ; not really
movb 1(r2) ,r2 ; get the speed setting please
clr r1 ; find the index into speed table
10$: cmp setlst(r1),#-1 ; reached the end of table yet ?
beq 90$ ; yes, exit
cmpb setlst(r1),r2 ; a match yet
beq 20$ ; yes
tst (r1)+ ; no, index := index + 2
br 10$ ; next please
20$: mov splst(r1),r0 ; return decimal of the speed
br 100$ ; bye
90$:
100$: cmp (sp)+ ,(sp)+
unsave <r2,r1>
call drpprv ; /41/ Insure privs are turned off
return
.sbttl set the speed of a terminal line
.mcall astx$s ,cmkt$s ,mrkt$s ,QIOW$S
; S E T S P D
;
; setspd(%loc devicename, %val speed)
;
; input: @r5 device name
; 2(r5) speed
; 4(r5) lun
; output: r0 error code, 255 if invalid speed
setspd::save <r1,r2,r3,r4>
call getprv ; /41/ May need privs turned on
mov 2(r5) ,r2 ; the speed
mov 4(r5) ,r4 ; save the lun
call ttpars ; parse the terminal name
bcs 90$ ; oops
clr r3 ; match the passed speed to the
10$: cmp splst(r3),#-1 ; speed desired to get the index
beq 80$ ; end of the table, invalid speed
cmp splst(r3),r2 ; a match yet ?
beq 20$ ; yes
tst (r3)+ ; no, look again please
br 10$ ; next
20$: movb setlst(r3),aslxsp+1 ; /41/ insert the transmitted speed
movb setlst(r3),aslrsp+1 ; /41/ insert the received speed also
mov #aslspd ,r2 ; /41/ pointer to it
alun$s r4,r1,r0 ; assign the terminal please
mrkt$s #ef.tmo,#2,#2,#spdtmo ; in case we can't get the device
QIOW$S #sf.smc,r4,#ef.tt,#50,#kbiost,,<r2,#4>
cmkt$s #ef.tmo,#spdtmo ; we got it ok
clr r0 ; assume success
cmpb kbiost ,#is.suc ; did it work ?
beq 100$ ; yes, exit without error
70$: moverr kbiost ,r0 ; no, return the error and exit
br 100$ ; and exit with the error code
80$: mov #377 ,r0 ; unknown speed
br 100$ ; exit
90$: moverr @#$dsw ,r0 ; error from parse
br 100$
100$: unsave <r4,r3,r2,r1> ; bye
call drpprv ; /41/ Don't want privs on now
return
spdtmo: tst (sp)+ ; remove the event flag number
QIOW$S #io.kil,r4,#ef.tt,#50,#kbiost
movb #ie.abo ,kbiost ; insure that's the error code
astx$s ; exit from this timeout ast
.sbttl ttpars get unit number from ttname
; T T P A R S
;
; ttpars( %loc ttname )
;
; output: r0 unit number or 377 for null string
; r1 device name
ttpars:: ; NEEDS TO BE GLOBAL(RBD)
save <r2,r3> ; parse a device name
clr r1 ; no device name yet
clrb @#$DSW ; set no error as of yet
mov #377 ,r0 ; presume no device name
mov @r5 ,r3 ; get the string address
tstb @r3 ; anything there ?
beq 90$ ; no, error
; cmpb @r3 ,#'X&137 ; i may try this on 350 some day(RTM02)
; beq 10$ ; ok (RTM02)
cmpb @r3 ,#'A&137 ; must be of the format ?Tnnn:
blo 90$ ; ok so far
cmpb @r3 ,#'Z&137 ; must be of the format ?Tnnn:
blos 10$ ; no
cmpb @r3 ,#'A!40 ; must be of the format ?Tnnn:
blo 90$ ; ok so far
cmpb @r3 ,#'Z!40 ; must be of the format ?Tnnn:
bhi 90$ ; no
10$: bisb (r3) ,r1 ; ok, save the first character (RTM02)
swab r1 ; and make a place for the next
cmpb (r3)+ ,#'T&137 ; Is this possibly "TI:" ? (RTM02)
bne 15$ ; If NE, no. (RTM02)
cmpb @r3 ,#'I&137 ; passed 'TI:' ?
beq 105$ ; return unit of 377 then please
cmpb @r3 ,#'I!40 ; passed 'TI:' ?
beq 105$ ; return unit of 377 then please
; cmpb @r3 ,#'K&137 ; XK: (?) (RTM02)
; beq 20$ ; yep (RTM02)
; cmpb @r3 ,#'T&137 ; must be of the format TTnnn: (RTM02)
; beq 20$ ; ok so far (RTM02)
; cmpb @r3 ,#'T!40 ; must be of the format TTnnn: (RTM02)
; bne 90$ ; no (RTM02)
15$: cmpb @r3 ,#'A&137 ; Is this possibly uppercase ? (RTM02)
blo 90$ ; If LO, no. (RTM02)
cmpb @r3 ,#'Z&137 ; Is this really uppercase ? (RTM02)
blos 20$ ; If LOS, yes. (RTM02)
cmpb @r3 ,#'A!40 ; Is this possibly lowercase ? (RTM02)
blo 90$ ; If LO, no. (RTM02)
cmpb @r3 ,#'Z!40 ; Is this really lowercase ? (RTM02)
bhi 90$ ; If HI, no. (RTM02)
20$: bisb (r3)+ ,r1
swab r1 ; have the device name in r1 now
clr r0 ; could use .parse but this is
30$: movb (r3)+ ,r2 ; get the next digit in the string
beq 90$ ; hit end of string
cmpb r2 ,#': ; end of the device name ?
beq 105$ ; yes, exit please
cmpb r2 ,#'0 ; in the range '0'..'7' ?
blo 90$ ; oops
cmpb r2 ,#'7 ; keep checking please
bhi 90$ ; bad device name
asl r0 ; r0 = r0 * 8
asl r0 ; ditto
asl r0 ; and so forth
sub #'0 ,r2 ; convert to binary
add r2 ,r0 ; and sum the digit in please
br 30$ ; next
90$: movb #ie.idu ,@#$dsw ; fake a bad device name and exit
sec ; ok
br 110$ ; bye
105$: clr @#$dsw ; no errors
clc ; success
110$: unsave <r3,r2> ; bye
return
.sbttl assign device
; Fake a device assignment by attaching to a dummy lun. Also
; check for someone else having it via issueing a mark time.
; Thanks to Bob Denny for that one.
;
.mcall alun$s ,astx$s ,cmkt$s ,mrkt$s ,QIOW$S ,wtse$s
assdev::tst proflg ; if this is a pro/350 we don't
beq 1$ ; have to worry about all these
clr r0 ; characteristics.
return ; simply exit
1$: save <r1,r2,r3>
call rstass ; /41/ restore possible previous set
call getprv ; /60/ restore privs again
call ttpars
bcc 5$
jmp 100$
5$: mov r0 ,r3 ; save the unit number please
cmpb r3 ,#377 ; local terminal ?
bne 10$ ; no
alun$s #lun.as,#"TI,#0 ; assign the terminal please
br 20$
10$: alun$s #lun.as,r1,r3 ; assign the terminal please
bcc 12$ ; If CC, device is assigned. (RTM02)
jmp 100$ ; Else, report the error. (RTM02)
12$: sub #20 ,sp ; Allocate a buffer for glun. (RTM03)
mov sp ,r2 ; Set pointer to the buffer. (RTM03)
glun$s #lun.as ,r2 ; Get real name of terminal. (RTM03)
mov g.luna(r2),r1 ; Copy the device name. (RTM03)
movb g.lunu(r2),r3 ; Copy the unit number. (RTM03)
mov g.lucw(r2),r2 ; Copy the device char. word. (BDN53)
add #20 ,sp ; Pop the glun buffer. (RTM03)
bit #DV.F11!DV.COM!DV.MNT,r2; Insure not disk or tape (BDN53)
beq 15$ ; Yes (BDN53)
movb #IE.IDU ,@#$DSW ; No, force an error please (BDN53)
jmp 100$ ; Exit (BDN53)
15$: mov @r5,r0 ; Copy the device name buffer. (RTM03)
call fmtdev ; Format the real device name. (RTM03)
20$: clr r2 ; flag if we timed out (RTM03)
mrkt$s #ef.tmo,#2,#2,#asstmo ; give 2 seconds to do this (RTM03)
QIOW$S #io.att,#lun.as,#ef.tt,,#kbiost
mov r2 ,r0 ; did we ever time out
beq 25$ ; no
jmp 110$ ; yes, return busy device
25$: cmkt$s #ef.tmo,#asstmo ; and cancel the mark time
sub #20 ,sp ; allocate a buffer for glun
mov sp ,r2 ; and a pointer to it
glun$s #lun.tt ,r2 ; get name of the console terminal
cmpb r3 ,#377 ; no unit?
beq 40$ ; yes, must be TI:
cmp g.luna(r2),r1 ; device name of console same as dev?
bne 30$ ; no
cmpb g.lunu(r2),r3 ; unit number the same ?
beq 40$ ; yes
30$: QIOW$S #SF.GMC,#lun.as,#ef.tt,,,,<#savass,#asvlen> ; /41/ more things
QIOW$S #SF.SMC,#lun.as,#ef.tt,,,,<#setass,#astlen> ; /41/ ditto
Call drpprv ; /60/ drop privs now
movb savrsp+1,aslrsp+1 ; /41/ copy to assigned recv speed
movb savxsp+1,aslxsp+1 ; /41/ copy to assigned xmit speed
mov sp ,assdon ; flag we did the set /slave=ttnn:
40$: add #20 ,sp ; pop glun buffer
clr r0
cmpb kbiost ,#is.suc ; did it work
beq 110$ ; yes, return error zero
cmpb kbiost ,#ie.daa ; ignore already attached errors
beq 110$ ; simple to do
moverr kbiost ,r0 ; no, get the error code
br 110$ ; and exit
100$: moverr @#$DSW ,r0
110$: unsave <r3,r2,r1>
return
asstmo: tst (sp)+ ; remove the event flag number
QIOW$S #io.kil,#lun.as,#ef.tt,#50,#kbiost
moverr #ie.daa ,r2 ; get the error code and exit
astx$s ; exit from this timeout ast
rstass: tst assdon ; /41/ If line was ever assigned then
beq 100$ ; /41/ we need to reset the prev line
clr assdon ; /41/ no longer assigned
call getprv ; /41/ insure privs are up
QIOW$S #SF.SMC,#lun.as,#ef.tt,,,,<#savass,#asvlen>
QIOW$S #IO.DET,#lun.as ; /41/ detach it
call drpprv ; /41/ Insure no privs now
100$: return
.sbttl fmtdev - Format the real device name.
;+
;
; fmtdev - Format the real device name.
;
; Inputs:
; R0 = The output buffer.
; R1 = The ASCII device name.
; R3 = The BINARY unit number.
;
; Outputs:
; All registers are preserved.
;
;-
fmtdev: save <r0,r1,r2> ; Save some registers. (RTM03)
swab r1 ; Copy (RTM03)
movb r1,(r0)+ ; the (RTM03)
swab r1 ; device (RTM03)
movb r1,(r0)+ ; name. (RTM03)
mov r3,r1 ; Copy the binary unit number. (RTM03)
clr r2 ; Set for zero supression. (RTM03)
call $cbtmg ; Convert it to octal ASCII. (RTM03)
movb #':,(r0)+ ; Finish the device name. (RTM03)
clrb (r0) ; And terminate with a null. (RTM03)
unsave <r0,r1,r2> ; Restore the registers. (RTM03)
return
.sbttl get date and time
.enabl lc
.mcall gtim$s
ascdat::save
mov @r5 ,r0 ; r0 := caller result addr
sub #16. ,sp ; make room for result
mov sp ,r1 ; result addr for gtim$
gtim$s r1 ; get time and date
mov g.tida(r1),r2 ; r2 := day
jsr pc ,cnvert ; convert and store day
movb #'- ,(r0)+ ; insert dash
mov g.timo(r1),r2 ; r2 := month
asl r2
add g.timo(r1),r2 ; r2 := 3*month
add #mnthtab-3,r2 ; r2 := mnthtab[3*month]@
movb (r2)+ ,(r0)+
movb (r2)+ ,(r0)+ ; store month name
movb (r2)+ ,(r0)+
movb #'- ,(r0)+ ; insert dash
mov @r1 ,r2 ; r2 := year
jsr pc ,cnvert ; convert and store year
movb #40 ,(r0)+ ; final space
clrb @r0
add #16. ,sp
unsave
return
asctim::save
mov @r5 ,r0 ; the desitination
sub #16. ,sp ; make room for result
mov sp ,r1 ; result addr for gtim$
gtim$s r1 ; get time and date
mov #3,r3 ; loop count := 3
add #g.tihr,r1 ; start with hours
1$: mov (r1)+,r2 ; begin loop
jsr pc,cnvert ; convert to ascii and store
dec r3 ; if done
beq 2$ ; then exit loop
movb #':,(r0)+ ; else insert colon
br 1$ ; end loop
2$: clrb @r0
add #16. ,sp
unsave
return
; cnvert: internal procedure to convert
; integer in r2 to ascii.
cnvert: add #366,r2 ;begin loop
tstb r2
bpl cnvert ;end loop
add #"00-366,r2 ;convert to ascii
swab r2 ;reorder bytes
movb r2,(r0)+ ;store digit
swab r2
movb r2,(r0)+ ;store digit
rts pc
.save
.psect $PDATA ,D
mnthtab:.ascii /JanFebMarAprMayJunJulAugSepOctNovDec/
.even
.restore
.sbttl systat get list of users logged in
sercmd::
systat::
moverr #-1 ,r0
return
.sbttl dodir get a reasonable directory printed
.save
.psect dirctx ,rw,d,lcl,rel,con
dirnam: .blkb 120
dirbuf: .blkb 120
diridx: .word 0
dirptr: .word dirbuf
dcrlf: .byte 15,12,0
wild: .asciz /*.*;*/
.even
.restore
; D O D I R
;
; input: @r5 wildcarded filespec
; output: r0 error code
;
; DODIR prints a directory listing at the local terminal.
;
;
; S D O D I R
;
; Passed: @r5 wildcarded name
; Return: r0 error code, zero for no errors
; r1 next character in the directory listing
;
; SDODIR is called by the server to respond to a remote directory
; command. Instead of the pre 2.38 method of dumping output to a
; disk file and then sending the disk file in an extended replay,
; SDODIR returns the next character so that BUFFIL can use it.
; The routine GETCR0 is actually a dispatch routine to call the
; currently selected GET_NEXT_CHARACTER routine.
dodir::save <r1,r2,r3,r4> ; /38/ Entirely rewritten
STRCPY #dirnam ,@r5 ; copy the filespec to save area
call dirini ; initialize things
10$: call dirnex ; get next entry to display
bcs 100$ ; error, exit please
.print #dirbuf ; ok, dump it
br 10$ ; next please
100$: unsave <r4,r3,r2,r1> ; exit
clr diridx ; clear flag and exit
return ; bye
sdirin::STRCPY #dirnam ,@r5 ; copy name over
clr diridx ; ditto
call dirini ; init for CALLS to sdodir
bcs 100$
mov #dirbuf ,dirptr ; yes, init pointers please
clrb @dirptr ; yes, zap the buffer
call dirnex ; preload buffer
100$: return
sdodir::save <r2,r3,r4>
10$: movb @dirptr ,r1 ; get the next character please
bne 20$ ; something was there
mov #dirbuf ,dirptr ; reset the pointer
clrb @dirptr ; yes, zap the buffer
call dirnex ; empty buffer, load with next file
bcs 90$ ; no more, return ER$EOF
br 10$ ; and try again
20$: inc dirptr ; pointer++
clr r0 ; no errors
br 100$ ; exit
90$: mov #ER$EOF ,r0 ; failure, return(EOF)
95$: clr r1 ; return no data also
clr diridx ; init for next time through
100$: unsave <r4,r3,r2>
return
.sbttl return next directory entry and init directory
dirini: clr diridx ; clear context flag
mov #dirbuf ,dirptr ; set pointer up for SDODIR
clrb @dirptr ; clear buffer
return ; thats all folks
dirnex: movb defdir ,-(sp) ; anything in DEFDIR ?
bne 10$ ; yes, don't alter it please
STRCPY #defdir ,#wild ; nothing, insert *.*;*
10$: CALLS lookup ,<#3,#dirnam,#diridx,#dirbuf>
tst r0 ; successfull?
bne 20$ ; no
strcat #dirbuf ,#dcrlf ; yes, append <cr><lf>
clr r0 ; strcat returns DST addr in r0
br 100$ ; exit
20$: cmp r0 ,#ER$NMF ; no more files error ?
bne 90$ ; no
tst diridx ; ever do anything?
bne 90$ ; yes
mov #ER$FNF ,r0 ; no, convert to file not found
90$: sec
100$: movb (sp)+ ,defdir ; restore DEFDIR
return
.sbttl fix up error codes
$mover: tstb 2(sp)
bmi 10$
clr 2(sp)
return
10$: neg 2(sp)
return
.sbttl rsxsys sys command for RSX11M/M+
; 21-Aug-83 16:12:37 Brian Nelson
; 12-Jan-84 09:54:02 Created from MINITAB v82 source
; 07-Mar-84 21:58:10 Bob Denny - Stop instead of wait, nicer.
.enabl gbl
.mcall spwn$s ,stse$s ,r50$
.enabl lsb
runjob::
mov #cli... ,r0
call rsxsys
return
runmcr::
mov #mcr... ,r0
call rsxsys
return
rsxsys::
save <r1,r2,r3,r4>
QIOW$S #io.det,#lun.tt,#ef.tt,#50,#kbiost
mov r0 ,r4 ; save the CLI we want to use
sub #12*2 ,sp ; need eight word exit block BDN
mov sp ,r2 ; Get address of exit block BDN
clr @r2 ; to be safe ?
mov 2(r5) ,r1 ; the command buffer address
mov r1 ,r3 ; save it
strlen r1 ; get the command string length
add r0 ,r3 ; point to the end
cmpb -(r3) ,#cr ; trailing carriage return ?
bne 5$ ; no
dec r0 ; yes, fix the length up
5$: mov r0 ,r3 ; save the length
clr r0 ; assume no error please
spwn$s r4,,,,,#6,,r2,r1,r3 ; do it
bcc 10$ ; Ignore error for now
moverr @#$DSW ,r0 ; get the error code please
QIOW$S #io.att,#lun.tt,#ef.tt,#50,#kbiost
print #100$
br 20$
10$: stse$s #6 ; Stop for task to exit
20$: add #12*2 ,sp ; pop exit status block
QIOW$S #io.att,#lun.tt,#ef.tt,#50,#kbiost
unsave <r4,r3,r2,r1> ; pop registers and exit
return
.save
.psect $PDATA ,D
100$: .asciz <15><12>/Spawn failure for SYS command/<15><12>
.even
mcr...: r50$ MCR...
cli...: r50$ CLI...
.restore
.dsabl lsb
.sbttl spool to printer
.mcall print$
; can we do this with RMS i/o ?????
qspool::movb #1 ,r0
return
; CALLS open ,<@r5,2(r5)>
; CALLS rsxspl ,<2(r5)>
;100$: return
;
;
;rsxspl::mov r0 ,-(sp) ; save temps
; mov r1 ,-(sp) ; also this one
; mov @r5 ,r1 ; unit number file is open on
; asl r1 ; get into word offset
; mov fdblst(r1),r1 ; fdb for that file
; clr errsav
; print$ r1,,,#"LP,#1 ; spool file to lp0 now
; bcc 100$
; moverr f.err(r1)
;100$: mov (sp)+ ,r1 ; pop temps and exit
; mov (sp)+ ,r0 ;
; return ; bye
.sbttl detach for the server
; Much simpler for RSX than for RSTS
detach::QIOW$S #io.det,#5,#ef.tt,,#kbiost
clr r0
return
login:: mov 4(r5) ,r0
STRCPY r0,#nologin
mov #1 ,r0
return
.save
.psect $PDATA ,D
nologin:.asciz #Can't do REMOTE LOGIN for RSX11M/M+ and P/OS#<15><12>
.even
.restore
.sbttl error MESSAGE text
syserp::
save <r0>
mov @r5 ,r0
call rmserp
MESSAGE
unsave <r0>
return
syserr::
save <r1> ; save a register
clr -(sp) ; allocate variable for error #
mov sp ,r1 ; and point to it
mov @r5 ,@r1 ; if errornumber > 0
bmi 10$ ; then
CALLS direrr ,<#2,r1,2(r5)> ; call fiperr(num,text)
br 100$ ; else
10$: CALLS rmserr ,<#2,r1,2(r5)> ; call rmserr(num,text)
100$: tst (sp)+
unsave <r1>
return
global <direrr ,rmserp ,rmserr>
.sbttl dodial for the DIAL command
.enabl lsb
; This is Steve Covey's code for dialing on XT1 or XT2 on the
; PRO/TMS Telephone Management System. BDN 06-Dec-85 11:00:40
;
; TMS
; TMS for a Telephone Management System (TMS) on a PRO/350
; TMS supports lines XT1: or XT2: under P/OS V2
; TMS
; TMS the DIAL command establishes the phone connection
; TMS assuming that the appropriate SET LINE XTn: and SET SPEED n
; TMS commands have been issued, and that the lun has been assigned
; TMS and attached.
; TMS
; TMS the phone number can consist of the following:
; TMS digits to be dialed
; TMS ! 6 second access pause for dial tone
; TMS !! 40 second access pause for dial tone
; TMS , 2 second delay
; TMS # changes to DTMF if initially pulse mode
; TMS *ABCD other valid DTMF codes
; TMS ^ as the first character causes a "hook flash"
; TMS ()- and spaces ignored. max total number 48 characters
.mcall QIOW$S ,alun$s ; TMS
; TMS
ef.rem = 14. ; TMS
tmsdia::save <r1> ; TMS
CALLS ttpars ,<#ttname> ; TMS
bcs 5$ ; TMS
alun$s #lun.ti,r1,r0 ; TMS
QIOW$S #io.att,#lun.ti,#ef.rem,,#tmsios ; TMS
QIOW$S #sf.smc,#lun.ti,#ef.rem,,#tmsios,,<#smctms,#smclen> ; TMS
strlen argbuf ; TMS get length of phone number
QIOW$S #io.con,#lun.ti,#ef.rem,,#tmsios,,<argbuf,r0> ; TMS
cmpb tmsios,#is.suc ; TMS did it work?
beq 10$ ; TMS yes
5$: unsave <r1> ; TMS
MESSAGE <Unsuccessful call>,cr ; TMS/BDN
mov #-1 ,r0 ; TMS/BDN
return ; TMS
10$: unsave <r1> ; TMS
MESSAGE <Call complete, type CONNECT to access system>,cr ; TMS/BDN
clr r0 ; TMS/BDN
return ; TMS
.save
.psect $PDATA ,D
tmsios: .word 0,0 ; TMS iosb for tms CALLS
smctms: .byte xt.dmd ; TMS set data mode
.byte xt.ser ; TMS serial data (not codec, dtmf, or voice)
.byte xt.dlm ; TMS set dial mode
.byte xt.dtm ; TMS DTMF (not pulse 10 or 20, or off hook)
.byte xt.dit ; TMS set DTMF intertone time * 10ms
.byte 10. ; TMS 100 milliseconds
.byte xt.dtt ; TMS set DTMF tone time * 10ms
.byte 10. ; TMS 100 milliseconds
; .byte xt.mtp ; TMS set modem type - should default from speed
; .byte xtm.ps ; TMS DPSK - 1200 baud Bell 212
smclen = . - smctms ; TMS
.restore
.dsabl lsb
.sbttl Look in logical name tables for KERMIT$LINEn
.mcall tlog$s ,alun$s ,QIOW$S ,cmkt$s ,astx$s ,mrkt$s
; TRNTRM(&return_name) ; Added edit /41/
;
; Passed: 0(r5) address of where to return first available dev
; Return: r0 zero for success, else directive error code.
;
;
; Look through logical name tables for a free terminal to use. The
; first translation will be on KERMIT$LINEn, where N is null, then
; 1 though NN. Stop on first translation that has a free terminal,
; or when we fail on the translation (IE.LNF). For now, to see if
; the line is free, try IO.ATT with a short marktime to abort the
; attach in case the line is already in use (actually call ASSDEV)
;
; Added edit /41/ 23-DEC-1985 10:20
;
; Local copy of TLON$S from M+ v3
;
; Since I may have to do this on M+ 2.1 or RSTS v9, those RSXMAC's
; have TLOG$S but not TLON$S. Thus lets define it here. Note that
; trying to execute TLON or TLOG on old RSX's won't hurt anything,
; they will simply return an error.
.MACRO TLON$S MOD,TBMSK,STATUS,LNS,LNSSZ,ENS,ENSSZ,RSIZE,RTBMOD,ERR
.MCALL DIR$,MOV$,MVB$,LNMOD$
LNMOD$
MOV$ STATUS
MOV$ RTBMOD
MOV$ RSIZE
MOV$ ENSSZ
MOV$ ENS
MOV$ LNSSZ
MOV$ LNS
MVB$ TBMSK,#0
MVB$ #13.,MOD
MOV (PC)+,-(SP)
.BYTE 207.,10.
DIR$ ,ERR
.ENDM TLON$S
tr$res = 0
tr$nam = 2
tr$uni = 4
trntrm::save <r1,r2,r3,r4> ; +/41/ save temp registers
sub #10 ,sp ; local r/w things
mov sp ,r3 ; base it off of r3
sub #30 ,sp ; allocate a result buffer
mov sp ,tr$res(r3) ; and a pointer to it
sub #30 ,sp ; allocate buffer for xlate name
mov sp ,tr$nam(r3) ; and a pointer to the buffer
mov #-1 ,tr$uni(r3) ; 'unit' number counter
call getsys ; vanilla RSX 11M today?
cmpb r0 ,#SY$11M ; well ?
bne 10$ ; no
jmp 90$ ; yes, do nothing at all then
10$: STRCPY tr$nam(r3),#ln$nam ; copy the prototype name over
tst tr$uni(r3) ; is this the first time through?
bmi 30$ ; yes (ie, it's -1)
mov tr$uni(r3),r1 ; no, append the 'unit' on logical
clr r2 ; so we get a name like KERMIT$LINE2
20$: tstb (r0)+ ; get to the end of the logical
bne 20$ ; not yet
dec r0 ; r0 --> end of copy of prototype
call $cbdmg ; r0 already had address from STRCPY
clrb @r0 ; insure .asciz
30$: clr -(sp) ; allocate buffer for returned_size
mov sp ,r1 ; and a pointer to it
clr -(sp) ; allocate buffer for 'RTBMOD'
mov sp ,r2 ; and a pointer to it also
strlen tr$nam(r3) ; get length of name to translate
tst proflg ; is this P/OS today ?
bne 40$ ; yes, use TLOG$S then
TLON$S #0,ln$msk,#0,tr$nam(r3),r0,tr$res(r3),#27,r1,r2
br 50$ ;
40$: TLOG$S #0,ln$msk,#0,tr$nam(r3),r0,tr$res(r3),#27,r1,r2
50$: tst (sp)+ ; ignore the returned table number
mov (sp)+ ,r1 ; get the length of translated string
cmpb @#$DSW ,#IS.SUC ; successfull translation ?
bne 70$ ; no
60$: add tr$res(r3),r1 ; success, make name .asciz
clrb @r1 ; simple
CALLS assdev ,<tr$res(r3)> ; parse and assign the device
cmpb r0 ,#IE.DAA ; device busy today ?
beq 80$ ; yes, try next logical
tst r0 ; other errors are fatal
bne 100$ ; exit
STRCPY @r5 ,tr$res(r3) ; success, return device name
clr r0 ; success
br 100$ ; exit
70$: tst tr$uni(r3) ; translation failure, first time?
bpl 90$ ; no, error is fatal
80$: inc tr$uni(r3) ; first time, goto KERMIT$LINE0
jmp 10$ ; next logical name please
90$: clr r0 ; return an error
bisb #IE.IDU ,r0 ; return invalid device name
100$: add #10+<2*30>,sp ; pop local buffers
unsave <r4,r3,r2,r1> ; and pop registers we saved
return ; -/41/ exit
.save
.psect $idata
ln$nam::.asciz /KERMIT$LINE/ ; prototype logical name
.even ; always please
ln$msk::.word 0 ; may want .word IN.SYS!IN.GRP
.restore
.sbttl dialout line setup routines ; /45/
; From Steve Heflin, 08-Feb-86
;
; These SET and RESTORE line characteristics for the DIAL command
; that are special for talking to the modem. These are NOT needed
; for RSTS/E and RT11, so thus are return stubbs to resolve the
; global symbol references.
tidias:: ; Setup line for dialout /45/
call getprv ; get privledges /45/
cmpb savdlu+1,tcdlu ; already in dialout mode ? /45/
beq 45$ ; yes, no need to change it /45/
tstb tcdlu ; allowing tc.dlu change? /45/
beq 45$ ; no /45/
movb tcdlu ,fixti2+1 ; adust setting for TC.DLU /45/
dir$ #set.dlu ; issue set /45/
45$: dir$ #set.chars ; set other attribs. for dialout /45/
call drpprv ; drop privs /45/
return ; /45/
tidiar:: ; Restore remote line attrib. /45/
call getprv ; get privledges /45/
cmpb savdlu+1,fixti2+1 ; if TC.DLU param got changed /45/
beq 50$ ; no, /45/
movb savdlu+1,fixti2+1 ; yes, restore it like it was /45/
dir$ #set.dlu ; issue request /45/
50$: dir$ #rest.chars ; restore remote line attributes /45/
; that could have been lost when /45/
; carrier was detected /45/
call drpprv ; drop privs /45/
return ; /45/
.sbttl find out kind of terminal
; INQTER 12-Feb-86 14:51:00 Brian Nelson
;
; This returns VT100 for all VT1xx and VT2xx terminals.
; Since we don't treat VT200's different, why bother.
; If TC.ANI is unknown on old RSX's, SF.GMC will simply
; stop there, returning only TC.TPP. For applications
; that REALLY need to know the terminal type, take out
; the check for TC.ANI. Including the TC.ANI helps when
; Digital adds new VTxxx terminals.
.enabl lsb
inqter: save <r1,r2> ; /45/ Get the type of terminal
clr -(sp) ; /45/ A small buffer to use
clr -(sp) ; /45/ Another one
mov sp ,r2 ; /45/ A pointer to that buffer
movb #TC.TTP ,@r2 ; /45/ Characteristic to read
movb #TC.ANI ,2(r2) ; /45/ Does this one work on old RSXs
qiow$s #SF.GMC,#5,,,,,<r2,#4> ; /45/ Get RSX to tell us now
bcs 90$ ; /45/ Failed, return TTY
tstb 3(r2) ; /45/ See if ANSICRT
bne 20$ ; /45/ YES, exit now with VT100
mov #200$ ,r1 ; /45/ Check for it
10$: tstb @r1 ; /45/ End of the list
beq 90$ ; /45/ Yes, return TTY
cmpb (r1)+ ,1(r2) ; /45/ A match ?
bne 10$ ; /45/ No, exit please
20$: mov #VT100 ,r0 ; /45/ Yes, return(VT100)
br 100$ ; /45/ Exit
90$: clr r0 ; /45/ No match, return(TTY)
100$: cmp (sp)+ ,(sp)+ ; /45/ Pop buffer and exit
unsave <r2,r1> ; /45/ Pop registers and exit
return
; Note: If the PRO/350 is to actually be used for, say, editing
; or if it is to use the Kermit-11 connect code's GRAY key re-
; mapping, then we should ALWAYS map T.BMP1 to a VT100. This is
; a problem, however, as the value of T.BMP1 is the same as it
; is for T.V2XX. At least, according to the Micro-RSX doc vt2xx
; code is 35 (8), actual task build shows T.BMP1 to be 35 also.
; Please note the the PRO is NOT totally compatible with VT2xxs
; TC.BMP1 is the PRO terminal type (Bit MaPped)
.save
.psect $PDATA ,D
200$: .byte T.V100 ,T.V101 ,T.V102 ,T.V105 ,T.V125 ,T.V131
.byte T.V132 ,T.BMP1 ,T.V2XX
.byte 0
.even
.restore
.dsabl lsb
.end