Columbia Kermit/kermit.zip/pdp11/k11m41.mac

Text File | 2020-01-01 | 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