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

Text File | 2020-01-01 | 28KB | 1,117 lines

    .title    k11rt4    i/o for rt11 version 4 or 5 for Kermit-11
    .ident    /1.0.01/


;    08-Mar-84  09:18:25  Brian Nelson
;
;    6-May-85             Added a little more to the TSX message to
;                            indicate that the TSX version comes up in
;                            the remote mode.  If a set line 0 is performed
;                            you are changed to a local kermit and send
;                            receive do not work.  Going to server mode
;                            works fine.  Purpose of the message is to alert
;                            user that the default is remote mode and no
;                            setting of the line is required.
;
;    20-May-86  09:03:30  Mods for .SETTOP in XM, also .SERR mods
;
;    Copyright (C) 1984 1986 Change Software, Inc.
;
;     This is the RT11 version of K11RMS.MAC.  It simply tries
;    to emulate,  as much as is  reasonable,  what the RMS i/o
;    routines do for  RSX and RSTS.  This strains a few things
;    in as  much that RT11  does not provide  much of anything
;    in the  sense of file services as compared to that  which
;    RMS11 v2 provides.  Since the whole of Kermit-11 is built
;    around RMS11  for i/o we will even  take the step  to map
;    RT11 error codes  into RMS11 error  codes,  thus allowing
;    the use  of the RMS error  routines and removing any need
;    to modify Kermit-11 elsewhere.
;    We won't really use the RMS error routines since they are
;    much to comprehensive for the errors that RT can have.
;
;    This routine MUST be in the root segment.
;    The RT11 executive must have multiple terminal support.
;
;
;    Disk i/o epts
;
;    open  ( %loc filename, %val channel_number ,%val type )
;    create( %loc filename, %val channel_number ,%val type )
;    getrec( %loc buffer  , %val channel_number ) { returns RSZ in R1}
;    putrec( %loc buffer  , %val record_size    ,%val channel_number )
;    close ( %val channel_number )
;    putc  ( %val char    , %val channel_number )
;    getc  ( %val channel_number )



    .sbttl    non disk i/o entry points

;    In all cases, R0 will have the returned error code (zero for success)
;    For KBREAD and READ, R1 will have the size of the read
;    For BINREAD,  R1 will have the character just read
;
;    The use of %LOC and %VAL are from VMS Pascal and Fortran.
;    %LOC means ADDRESS, whereas %VAL means literal. All call
;    formats assume the first argument is at 0(r5), the next
;    at 2(r5) and so on, as in:
;
;    clr    -(sp)            ; today's date by default
;    mov    #datebf    ,-(sp)        ; where to put the converted string
;    mov    sp    ,r5        ; call ASCDAT
;    call    ascdat            ; simple
;    cmp    (sp)+    ,(sp)+        ; all done
;
;    or by using the CALLS macro (defined in K11MAC.MAC)
;
;    calls    ascdat    ,<#datebf,#0>
;
;
;    Any version of Kermit-11 which can not, due to the lack of
;    executive  support,  implement a function should return an
;    error of -1 in r0.  For instance,  RT11 does not have  any
;    executive primitives to do wildcarding directory lookup.
;
;
;
;
;    ASCDAT    ( %loc buffer, %val datevalue )
;    ASCTIM    ( %loc buffer, %val timevalue )
;    ASSDEV    ( %loc device_name )
;    BINREA    ( %val lun, %val timeout )
;    BINWRI    ( %loc buffer, %val byte_count, %val lun )
;    CANTYP    ( %loc device_name, %val lun )
;    CHKABO    ( )
;    DODIR    ( %loc directory_string, %val lun )
;    DRPPRV    ( )
;    DSKUSE    ( %loc returned_string )
;    ECHO    ( %loc terminal_name )
;    EXIT    ( )
;    GETPRV    ( )
;    GETUIC    ( )
;    GTTNAM    ( %loc returned_ttname )
;    KBREAD    ( %loc buffer )
;    L$PCRL    ( )
;    L$TTYO    ( %loc buffer, %val bytecount )
;    LOGOUT    ( )
;    NAMCVT    ( %loc source_filename, %loc returned_normal_name )
;    NOECHO    ( %loc device_name, %val lun )
;    QUOCHK    ( )
;    READ    ( %loc buffer, %val buffer_length, %val lun, %val block_number )
;    SETCC    ( %loc control_c_ast_handler )
;    SETSPD    ( %loc device_name, %val speed )
;    SUSPEN    ( %val seconds, %val ticks )
;    SYSERR    ( %val error_number, %loc error_text_buffer )
;    TTRFIN    ( )
;    TTRINI    ( )
;    TTSPEE    ( %loc terminal_name )
;    TTYDTR    ( %loc terminal_name )
;    TTYFIN    ( %loc terminal_name, %val lun )
;    TTYHAN    ( %loc terminal_name )
;    TTYINI    ( %loc terminal_name, %val lun, %val open_flags )
;    TTYPAR    ( %loc terminal_name, %val parity_code )
;    TTYRST    ( %loc terminal_name )
;    TTYSAV    ( %loc terminal_name )
;    TTYSET    ( %loc terminal_name )
;    WRITE    ( %loc buffer, %val buffer_length, %val lun, %val block_number )
;    XINIT    ( )



    .sbttl    define macros and local i/o database




    .if ndf, K11INC
    .ift
    .include    /IN:K11MAC.MAC/
    .endc

    .iif ndf,k11inc    ,.error    ; missing INCLUDE for K11MAC.MAC

    cr    =    15
    lf    =    12
    ff    =    14
    soh    =    1
    maxsiz    =    1000
    errbyt    ==    52
    topmem    =    50
    JSW    =    44

    .enabl    gbl

    .psect    $code    ,ro,i,lcl,rel,con
    .psect    rtdir1    ,rw,d,gbl,rel,con
    .psect    rtioda    ,rw,d,lcl,rel,con

;    Note that for RT11,  of course, all files are considered
;    to be image files. If there was a RMS11/RT we would have
;    had  transportability from RSX and  RSTS version of disk
;    i/o.

buflst::.word    ttbuf    ,0    ,0    ,0    ,0
bufdef::.word    ttbuf    ,0    ,0    ,0    ,0
bufsiz::.word    ttbsiz    ,maxsiz    ,maxsiz    ,maxsiz    ,maxsiz
filtyp:    .word    terminal,text    ,text    ,text    ,text
bufp:    .word    0    ,0    ,0    ,0    ,0
bufs:    .word    0    ,0    ,0    ,0    ,0
mode:    .word    1    ,0    ,0    ,0    ,0
blknum:    .word    0    ,0    ,0    ,0    ,0
sizof:    .word    0    ,0    ,0    ,0    ,0

    filsiz    ==    100

defdir::.blkb    filsiz+2        ; default directory for send and rec
srcnam::.blkb    filsiz+2        ; original send filespec
filnam::.blkb    filsiz+2        ; output from directory lookup routine
asname::.blkb    filsiz+2        ; for SEND file [as] file
bintyp::.word    0
totp.s::.word    0,0
totp.r::.word    0,0
dkdev:    .rad50    /DK /

    $hbufs    ==    1

    ie.its    ==    0
    fb$stm    ==    0
    fb$var    ==    0
    fb$cr    ==    0
    xdorsx    ==    0

df$rfm::.word    0
df$rat::.word    0


; /51/    The following buffers are allocated after the initial .SETTOP
;    They can swap with the USR if need be.

    ALSIZE    ==    600
    SDBSIZ    ==    600
    $$LBUF    ==    < <MAXLNG/10>+MAXLNG > & 177776
    $$BUFP    ==    <<MAXSIZ+2>*4> + $$LBUF + ALSIZE



    ttbsiz    =    40
ttbuf:    .blkb    ttbsiz+2
$prtbu::.word    ttbuf            ; /51/ Altered at startup

tsxsav::.word    0
devidx::.word    0            ; /45/ From .dstat, device type
wtime:    .word    0,60.
cancel:
mtsts:    .word    0,0,0,0,0
timbuf:    .word    0,0
timbf1:    .word    0,0
clkflg::.word    0
tenth:    .word    0,6
wasxc::    .word    0
jobsts::.blkw    10            ; /51/ From .GTJB
freept::.word    0            ; /51/ For the next general allocation
fetpt::    .word    0            ; /51/ For the next .FETCH
fetptm::.word    0            ; /51/ Max address for fetching
xmfetp::.word    0            ; /51/ Base of area for fetching, XM
maxtop::.word    0            ; /51/ Size after .settop
xklgbu::.word    0            ; /51/ Pointer to special XL buffer
montyp::.word    0            ; /51/ < 0 -> SJ, = 0 -> FB, > 0 -> XM
hilimi::.word    50            ; /51/ It's 50 for FB, $limit+2 for XM
$ttyou::.word    0            ; /51/ Filled in at startup
$$cbta::.word    0            ; /53/
$limit::.limit                ; /51/ Enable XM .SETTOP .limit
lun1    =    1
lun2    =    2
lun3    =    3
lun4    =    4
maxlun    =    lun4



    .sbttl    error mapping, error codes defined in overlay K11RTE

    .psect    $pdata

cloerr::.word    er$sy1    ,er$sy1    ,er$sys    ,er$prv
csierr::.word    er$fnm    ,er$dev    ,er$sy2
dsterr::.word    er$dev
enterr::.word    er$lby    ,er$ful    ,er$sy3    ,er$prv    ,er$sy3
feterr::.word    er$dev    ,er$sy4
lokerr::.word    er$lby    ,er$fnf    ,er$sys
reaerr::.word    er$eof    ,er$rer    ,er$nop    ,er$sys
wrierr::.word    er$eof    ,er$wer    ,er$nop    ,er$sys
twaerr::.word    er$que
mrkerr::.word    er$que
renerr::.word    er$lby    ,er$fnf    ,er$iop    ,er$prv
xcierr::.word    er$lby    ,er$xco
xcspfu::.word    er$fun    ,er$hrd    ,er$nop    ,er$sys
    .word    er$sup
faterr::.word    fa$imp    ,fa$nhd    ,fa$dio    ,fa$fet    ,fa$ovr    ,fa$dfl    ,fa$adr
    .word    fa$lun    ,fa$imp    ,fa$imp    ,fa$imp    ,fa$idr    ,fa$imp    ,fa$imp
    .word    fa$imp    ,fa$imp    ,fa$imp    ,fa$imp

mterr::    .word    er$nin    ,er$nat    ,er$lun    ,er$iop    ,er$bsy    ,er$buf    ,er$sys
    .word    er$sup

    .psect    $rtque
nrtque    ==    20
rtque::    .blkw    10.*nrtque
    .psect    $code


    .sbttl    one shot init code for Kermit-11 RT11

    CONFIG    =    300
    CONFG2    =    370
    SYSGEN    =    372
    $USRLC    =    266
    SYSVER    =    276

    PRO350    =    20000
    TSXPLU    =    100000

    SJSYS    =    1
    XMSYS    =    10000

    .MCALL    .QSET,.TWAIT,.FETCH,.GVAL,.SETTOP,.SERR,.HERR,.GTIM
    .MCALL    .DSTAT,.MTSTAT,.EXIT



;    23-May-86  18:21:33 XINIT moved to K11RTI.MAC


    GLOBAL    <lun.in,lun.ou,proflg,rtvol,rtque,tsxflg>
    GLOBAL    <defdir,infomsg>



    .sbttl    open a file for rt11

    .MCALL    .CSISPC,.DSTATUS,.LOOKUP,.FETCH,.ENTER,.CLOSE
    .MCALL    .SERR    ,.HERR    ,.PURGE
    .psect    $code

;    OPEN( &filename,channel,type )
;
;    CREATE( &filename,channel,type )



    .psect    $pdata
defext:    .word    0
    .word    0
    .word    0
    .word    0
en$siz::.word    0            ; 1/2 largest free or 2nd largest
    .psect    $code


    .enabl    lsb

fcreat::                ; Create a file
append::                ; Alternate EP's
create::mov    #1    ,r0        ; Say we want to create
    br    10$            ; And off to common code

fopen::                    ; Open a file for reading
open::    clr    r0            ; .LOOKUP please
10$:    Save    <r1,r2,r3>        ; Save these
    mov    r0    ,r2        ; .ENTER/.LOOKUP ?
    mov    (r5)    ,r1        ; Filespec address, .Asciz
    mov    2(r5)    ,r0        ; LUN
    mov    4(r5)    ,r3        ; Binary/text
    call    mtb$op            ; Call file opener
    Unsave    <r3,r2,r1>        ; Pop em
    return                ; And exit
                    ;
    .dsabl    lsb            ;


;    MTB$OP    20-Nov-86  14:56:59  BDN
;
;    Input:    R0    Lun
;        R1    Filename, .asciz
;        R2    Direction, zero --> read (.LOOKUP), else write (.ENTER)
;        R3    Binary flag <> 0 --> binary
;    Return:    R0    Mapped error code
;
;     This is the old open/create code from Kermit-11/RT rewritten for
;    inclusion in another application. I have replaced the old code as
;    this version is cleaner and 100 words shorter.

    .iif ndf, BINARY, BINARY = 1
    .iif ndf, RD$ONL, RD$ONL = 0
    .iif ndf, RD$WRI, RD$WRI = 1
    .ASSUME    RD$ONL EQ 0
    .ASSUME    BINARY EQ 1


Mtb$op::Save    <r4,r5>            ; Save regs (r1,r2,r3 saved above)
    sub    #40.*2    ,sp        ; Allocate a buffer for .CSISPC
    mov    r0    ,r4        ; Copy the LUN to use
    .SERR                ; Inhibit fatal aborts by RT
    asl    r4            ; Zero?
    bne    10$            ; Non-zero
    mov    sp    ,mode+0        ; Zero, implies terminal always
    clr    bufp+0            ; Clear this out also
    clr    r0            ; No errors
    br    100$            ; Exit
10$:    clr    sizof(r4)        ; Clear I/O subsystem tables
    clr    bufp(r4)        ; Clear buffer pointer out
    clr    bufs(r4)        ; Clear buffer size out
    clr    mode(r4)        ; Assume reading
    clr    blknum(r4)        ; To keep track of current VBN
    mov    r3    ,filtyp(r4)    ; Text or binary?
    mov    bufdef(r4),r0        ; Insert default buffer addresses
    mov    r0    ,buflst(r4)    ; Copy it
    mov    #MAXSIZ    ,r5        ; Insert the buffer size
    mov    r5    ,bufsiz(r4)    ; Do it
20$:    clrb    (r0)+            ; Clear it out
    sob    r5    ,20$        ; Next please
    mov    sp    ,r5        ; Point to save area
30$:    movb    (r1)+    ,(r5)+        ; Copy the filename over now
    bne    30$            ; Next please
    dec    r5            ; Back up to the null.
    movb    #'=    ,(r5)+        ; Setup
    clrb    @r5            ; .Asciz
    mov    sp    ,r5        ; Point back to save area
    mov    #csierr    ,r1        ; Assume .CSI error mapping
    .CSISPC    r5,#defext,r5        ; Do it
    mov    r5    ,sp        ; Restore the stack pointer
    bcs    80$            ; Filename parse error
    tst    @r5            ; Device name present?
    bne    40$            ; Yes
    mov    #^RDK     ,@r5        ; No, insert one then
40$:    CALL    fetch            ; Insure that handlers are loaded
    tst    r0            ; Well?
    bne    100$            ; No, error codes already mapped.
    mov    r4    ,r3        ; Get channel number back
    asr    r3            ; Get correct channel number
    tst    r2            ; And check for .ENTER
    bne    50$            ; .ENTER
                    ;
    mov    #lokerr    ,r1        ; Set up error mapping for .LOOKUP
    .LOOKUP    #rtwork,r3,r5        ; Do it
    bcs    80$            ; It failed
    mov    r0    ,sizof(r4)    ; Success, return the created size
    mov    #-1    ,bufp(r4)    ; Force a disk read on first call.
    clr    r0            ; Success
    br    100$            ; Exit
                    ;
50$:    tst    2(r5)            ; Never allow NFS writes to a disk
    bne    60$            ; Its ok
    mov    #^RNON    ,2(r5)        ; No name, stuff one in then
    mov    #^RNAM    ,4(r5)        ; ....
    mov    #^RTMP    ,6(r5)        ; ......
60$:    mov    #enterr    ,r1        ; Assume .ENTER error code mapping
    mov    at$len    ,r2        ; Is there a protocol passed size?
    bne    70$            ; Yes
    mov    en$siz    ,r2        ; No, use SET value or default.
70$:    .ENTER    #rtwork,r3,r5,r2    ; Try hard to create the file
    bcs    80$            ; No way
    mov    sp    ,mode(r4)    ; Writing today
    clr    r0            ; Success
    br    100$            ; Time to go now
                    ;
80$:    movb    @#errbyt,r0        ; Get the error code
    bpl    90$            ; Normal error
    com    r0            ; Hard error code
    mov    #faterr    ,r1        ; Map into the hard errors
90$:    asl    r0            ; Word addressing
    add    r0    ,r1        ; Get the mapped (fake RMS) error
    asr    r4            ; Channel number
    .PURGE    r4            ; Insure the channel in cleared
    mov    (r1)    ,r0        ; Copy and exit
100$:    mov    r0    ,-(sp)        ; Save errors
    .HERR                ; Restore normal error handling
    mov    (sp)+    ,r0        ; Pop
    add    #40.*2    ,sp        ; Pop stack
    Unsave    <r5,r4>            ; Pop registers and exit
    return





getsiz::mov    @r5    ,r1        ; get opened filesize
    asl    r1            ; get the lun times 2
    mov    sizof(r1),r1        ; return the size
    clr    r0            ; no errors
    return                ; bye



    .sbttl    close a file
    .MCALL    .CLOSE


;    C L O S E
;
;    close (%val lun)
;
;    input:    @r5    channel number to close
;    output:    r0    mapped error code
;
;    calls:    flush(lun)


close::    save    <r1>            ; save registers we may have
    call    flush            ; dump out any remaining buffer
    mov    @r5    ,r1        ; then disconnect the access stream
    beq    10$            ; terminal
    .CLOSE    r1            ; do the rt close
    bcc    10$            ; it worked
    movb    @#errbyt,r0        ; it failed, map the rt11 error
    asl    r0            ; to something more descriptive
    mov    cloerr(r0),r0        ; simple
    br    20$            ; map the error please
10$:    clr    r0            ; no errors
20$:    asl    r1            ; channel number times 2
    clr    bufp(r1)        ; buffer_pointer[lun] := 0
    clr    sizof(r1)        ; no size please
    unsave    <r1>            ; pop the saved r1
    return                ; and exit with error in r0


rewind::mov    @r5    ,r0        ; get the channel number
    beq    100$            ; for the terminal, a no-op
    asl    r0            ; times two please
    mov    #-1    ,bufp(r0)    ; flag a buffer reload is needed
    clr    bufs(r0)        ; nothing is in the buffer
    clr    blknum(r0)        ; first block of the disk file
100$:    clr    r0            ; no errors are possible
    return                ; bye






    .sbttl    put a record to an rt11 sequential file


;    P U T R E C
;
;    putrec( %loc buffer, %val record_size, %val channel_number )
;
;    input:    @r5    address of user buffer
;        2(r5)    record size
;        4(r5)    channel number
;
;    output:    r0    rms sts
;
;    Write the next record to  a disk file.
;
;    Assumption: The record to be written will have a cr/lf
;            appended  to it unless the filetype is not
;            text.  In other words, PUTREC provides the
;            carriage control unless the file is a ter-
;            minal.


putrec::save    <r1,r2,r3>        ; save registers we may need
    mov    2(r5)    ,r2        ; the size of the i/o
    mov    @r5    ,r3        ; the buffer address
    mov    4(r5)    ,r1        ; the channel number please
    bne    10$            ; a real disk file

    tst    r2            ; faking output to a terminal
    beq    100$            ; nothing at all to do ?
    print    r3    ,r2        ; do the terminal i/o
    br    100$            ; bye


10$:    tst    r2            ; the size of the i/o to do
    beq    30$            ; nothing to do, add carriage control

20$:    clr    r0
    bisb    (r3)+    ,r0        ; the character to write out
    call    putcr0            ; channel is passed in r1
    tst    r0            ; did the write fail ?
    bne    100$            ; yes, exit asap
    sob    r2    ,20$        ; next ch please

30$:    asl    r1            ; get the channel number times 2
    cmp    filtyp(r1),#text    ; is this a text file
    bne    100$            ; no, don't add carriage control in
    asr    r1            ; get the channel number back
    movb    #cr    ,r0        ; and add in a cr/lf
    call    putcr0            ; simple
    movb    #lf    ,r0        ; and at last the line feed
    call    putcr0            ; do the line feed at the end

100$:    unsave    <r3,r2,r1>        ; pop registers we saved
    return                ; bye



    .sbttl    getc    get one character from an input file
    .MCALL    .READW


;    G E T C
;
;    getc(%val channel_number)
;
;    input:    @r5    channel_number
;    output:    r0    rms error status
;        r1    the character just read

getc::    mov    @r5    ,r0
    call    getcr0
    return

fgetcr::save    <r3>            ; use for saving the channel#
10$:    mov    r0    ,r3        ; save the channel number please
    call    .getc            ; get the next ch please
    tst    r0            ; did the read work ok ?
    bne    100$            ; no, exit
    asl    r3            ; get the channel number times 2
    cmp    filtyp(r3),#text    ; if filetype[lun] = text
    bne    100$            ;  then
    tstb    r1            ;   if ch = NULL
    bne    100$            ;    then try-again
    asr    r3            ; get origional channel back
    mov    r3    ,r0        ; setup the correct call format
    br    10$
100$:    unsave    <r3>
    return


.getc:    save    <r2,r3>            ; save temps
    mov    r0    ,r2        ; channel number please
    mov    r0    ,r1        ; for the .READW please
    asl    r2            ; times 2
    tst    bufs(r2)        ; anything in the buffer ?
    beq    10$            ; no, please load it
    cmp    bufp(r2),#-1        ; need to initialize the buffer?
    bne    20$            ; no
10$:    mov    bufsiz(r2),r3        ; we need buffer size in words
    asr    r3            ; convert bytes to words
    .READW    #rtwork,r1,buflst(r2),r3,blknum(r2)
    bcs    90$            ; it failed, bye
    inc    blknum(r2)        ; next time read the next block
    clr    bufp(r2)        ; it worked. clear current pointer
    asl    r0            ; convert words read to bytes
    mov    r0    ,bufs(r2)    ; and save the record size
20$:    mov    buflst(r2),r3        ; get the address of the buffer
    add    bufp(r2),r3        ; and point to the next character
    clr    r1            ; to be returned in r1
    bisb    @r3    ,r1        ; simple
    inc    bufp(r2)        ; buffer.pointer := succ(buffer.pointer)
    dec    bufs(r2)        ; amountleft := pred( amountleft )
    clr    r0            ; no errors please
    br    100$

90$:    movb    @#errbyt,r0        ; get the error code
    asl    r0            ; times two
    mov    reaerr(r0),r0        ; map it into a unique global error

100$:    unsave    <r3,r2>
    return



    .sbttl    putc    put a single character to an rms file
    .MCALL    .WRITW

;    P U T C
;
;    input:    @r5    the character to put
;        2(r5)    the channel number to use
;
;    Buffer single character i/o to internal disk buffer.
;    Buffer is dumped if internal buffer is  full.
;    The local buffers are allocated in CREATE and OPEN.


putc::    save    <r1>            ; simply save r1 and call putcr0
    mov    2(r5)    ,r1        ; to do it. putcr0 will be somewhat
    clr    r0            ; faster to call directly due to the
    bisb    @r5    ,r0        ; overhead involved in setting up an
    call    putcr0            ; argument list.
    unsave    <r1>            ; pop saved r1 and exit
    return                ; bye


putcr0::save    <r1,r2,r3,r4>        ; save registers we use
    mov    r1    ,r2        ; channel number
    asl    r2            ; times 2 of course
    cmp    bufp(r2),bufsiz(r2)    ; is the buffer full ?
    blo    20$            ; no, store some more characters in it
    movb    r0    ,r3        ; yes, save the input character r0
    mov    bufsiz(r2),r4        ; and setup for a .WRITW
    asr    r4            ; rt11 needs word count not byte count
    tst    r1            ; channel zero is always terminal
    beq    3$            ; simple
    cmp    filtyp(r2),#terminal    ; check for being a terminal today?
    bne    4$            ; not a terminal
3$:    print    buflst(r2),bufsiz(r2)    ; a terminal, force it out please
    br    5$            ; and reinit the buffer now
4$:    .WRITW    #rtwork,r1,buflst(r2),r4,blknum(r2); dump this block to disk
    bcs    90$            ; it failed for some reason
5$:    inc    blknum(r2)
    clr    bufp(r2)        ; pointer := 0
    mov    buflst(r2),r4        ; it worked. zero the buffer now
    mov    bufsiz(r2),r0        ; get the buffer address and size
10$:    clrb    (r4)+            ; for i := 1 to bufsiz
    sob    r0    ,10$        ;   do buffer[i] := chr(0)
    movb    r3    ,r0        ; ok, restore the old character
20$:    mov    bufp(r2),r1        ; get the current buffer pointer
    add    buflst(r2),r1        ; and point to a new home for the
    movb    r0    ,@r1        ; the input character in r0
    inc    bufp(r2)        ; pointer := succ( pointer )
    clr    r0            ; success
    br    100$

90$:    movb    @#errbyt,r0        ; get the rt11 error code
    asl    r0            ; times two
    mov    wrierr(r0),r0        ; map it into a global error code

100$:    unsave    <r4,r3,r2,r1>
    return


    .sbttl    flush
    .MCALL    .WRITW

flush:    save    <r1,r2>
    mov    @r5    ,r1        ; get the internal channel number
    asl    r1            ; times 2 for indexing
    tst    bufp(r1)        ; anything in the buffer
    beq    100$            ; no
    tst    mode(r1)        ; writing today ?
    beq    100$            ; no
    tst    r1            ; terminal today ?
    beq    20$            ; yes
    mov    bufsiz(r1),r2        ; rt11 likes to have word counts
    asr    r2            ; simple
    .WRITW    #rtwork,@r5,buflst(r1),r2,blknum(r1)
    br    100$

20$:    print    buflst(r1),bufp(r1)
    br    100$

100$:    unsave    <r2,r1>
    clr    r0
    return





    .sbttl    fparse    parse filename and fill in with defaults


;    F P A R S E
;
;    input:    @r5    input filename,     .asciz
;        defdir    the default directory name string to use
;
;    output:    2(r5)    expanded filename, .asciz, maximum length 63 bytes
;        r0    error codes
;
;    For RT11, simply return the passed string. Perhaps later do
;    something real.


fparse::save    <r1>
    mov    #defdir    ,r0
    mov    2(r5)    ,r1
10$:    movb    (r0)+    ,(r1)+
    bne    10$
    dec    r1
    copyz    @r5    ,r1        ; simple
    clr    r0            ; no errors are possible today
    unsave    <r1>
    return                ; bye

    global    <defdir>






    .sbttl    l$ttyout

;    Print a string to the console terminal
;
;    Input:    @r5    buffer address
;        2(r5)    string length
;
;    If 2(r5) is zero, then assume .asciz

    .if eq    ,0
    .ift

l$ttyo::call    @$ttyou
    return

    .iff

l$ttyo::save    <r0,r1,r2,r3>        ; save registers we may need
    mov    @r5    ,r1        ; get the string address
    mov    2(r5)    ,r2        ; get the string length
    bne    20$            ; non-zero then
    mov    r1    ,r2        ; count until a null now
10$:    tstb    (r2)+            ; well ?
    bne    10$            ; not yet, keep looking
    sub    r1    ,r2        ; get the length now
    dec    r2            ; all done
    beq    100$            ; nothing to print at all?

20$:    mov    $prtbuf    ,r0        ; now buffer the i/o to avoid
    mov    #36    ,r3        ; the printing of cr/lf at the
30$:    tstb    (r1)+            ; don't copy nulls please
    beq    35$            ; ignore if null
    movb    -1(r1)    ,(r0)+        ; copy a byte please
35$:    dec    r2            ; done yet ?
    beq    40$            ; yes
    sob    r3    ,30$        ; no, next please
40$:    movb    #200    ,(r0)+        ; insure no carraige control !
    clrb    @r0            ; must be passed .asciz
    mov    $prtbuf    ,r0        ; point back to the start of buffer
    emt    351            ; do the .print kmon request
    tst    r2            ; any more data to buffer ?
    bne    20$            ; yes, try again

100$:    unsave    <r3,r2,r1,r0>
    return

    .endc

l$pcrl::print    #100$
    return

100$:    .byte    cr,lf,0,0


;    G E T S Y S
;
;    output:    r0    operating system
;
;    sy$11m    (1)    for rsx11m
;    sy$ias    (3)    for ias
;    sy$rsts    (4)    for rsts
;    sy$mpl    (6)    for m+
;    sy$rt    (7)    for rt11 ????


getsys::mov    #7    ,r0        ; this is rt11 folks
    return                ; bye


    .sbttl    misc routines

iswild::mov    @r5    ,r0
10$:    tstb    @r0
    beq    100$
    cmpb    @r0    ,#'%
    beq    90$
    cmpb    (r0)+    ,#'*
    bne    10$
90$:    mov    #1    ,r0
    return
100$:    clr    r0
    return


;    E X I T
;
;    exit to kmon

    .MCALL    .EXIT    ,.HRESET,.CMKT    ,.TWAIT

exit::    .CMKT    #cancel,#0        ; /51/ Stop watchdogs please
    call    finrt            ; /37/ clear lines out
    clr    r0
    .EXIT                ; should always work ok
    halt                ; huh ?


    .MCALL    .TWAIT            ; mark time request


suspen::save    <r1>            ; save temps
    mov    @r5    ,r1        ; sleep time in seconds
    beq    10$            ; nothing, must be fractional
    mul    #60.    ,r1        ; sixty clock ticks in a second
    clr    r0            ; low order part
    br    20$            ; ignore the fractional part
10$:    mov    2(r5)    ,r0        ; sleep < 1 second
20$:    add    r1    ,r0        ; total time to sleep
    mov    r0    ,-(sp)        ; setup the timeout block
    clr    -(sp)            ; two words please
    mov    sp    ,r1        ; point to it
    .TWAIT    #rtwork,r1        ; suspend ourself for a while
    bcs    30$            ; it worked ok
    clr    r0            ; return success
    br    100$            ; bye
30$:    movb    @#errbyt,r0        ; it failed, map the error into
    asl    r0            ; a global error number
    mov    twaerr(r0),r0        ; simple
100$:    cmp    (sp)+    ,(sp)+        ; pop time buffer and exit
    unsave    <r1>            ; pop registers
    return                ; bye




    .sbttl    Log out and Set control C


logout::tst    tsxsav            ; /45/ Does this make sense?
    beq    100$            ; /45/ Not really
    mov    #510    ,r0        ; /45/ Address of chain command
    mov    #4    ,(r0)+        ; /45/ Setup to log out on TSX+
    movb    #'B&137    ,(r0)+        ; /45/ And insert BYE
    movb    #'Y&137    ,(r0)+        ; /45/  ...
    movb    #'E&137    ,(r0)+        ; /45/   ...
    clrb    (r0)+            ; /45/ Make it .asciz please
    bis    #4000    ,@#JSW        ; /45/ Pass to KMON
    clr    r0            ; /45/ Must be zero
    .EXIT                ; /45/ Try to logout on TSX+
100$:    clr    r0            ; /45/ Exit
    return


    .MCALL    .SCCA    ,.MRKT    ,.EXIT    ,.CMKT    ,.RCTRLO,.SPCPS    ,.TTINR

    .save                ; /51/ Save current PSECT
    .psect    sccada    ,rw,d,lcl,rel,con;/51/ Get out of APR1 mapping?
sccwork:.word    0,0,0,0            ; /51/ A work area for .SCCA
ccflag:    .word    0            ; /51/ RT11's way of flagging ^C
mkw:    .word    0,0,0,0            ; /51/ A Mark Time work area
mktime:    .word    0,15.            ; /51/ Check for ^C every 15 ticks
spcwork:.word    0,0            ; /51/ For the .SPCPS directive
spcarg:    .word    ccexit,0,0        ; /51/ Where to alter flow to.
    .restore            ; /51/ Pop old psect now.
    .save                ; /51/ Save current PSECT
    .psect    sccain    ,ro,i,lcl,rel,con;/51/ Perhaps get this out of APR1
    .enabl    lsb            ; /51/ mapping for XM?


setcc::    clr    ccflag            ; /51/ No control C's as of yet
    .CMKT    #mkw,#40        ; /51/ Clear previous Mark Time.
    .SCCA    #sccwork,#ccflag    ; /51/ Set the address for flag word
    .MRKT    #mkw,#mktime,#ccast,#40 ; /51/ Schedule a checkup for ^C
    return                ; /51/ Exit

ccast:    tst    ccflag            ; /51/ Was there a Control C typed?
    beq    100$            ; /51/ No, just reschedule
    clr    ccflag            ; /51/ Clear the flag
    .TTINR                ; /51/ In case control C's sitting
    .TTINR                ; /51/ around in the input buffer.
    .RCTRLO                ; /51/ Insure output enabled
    inc    cccnt            ; /51/ Bump the global ^C count
    cmp    cccnt    ,#CC$MAX    ; /51/ Exit?
    blos    100$            ; /51/ No
    call    finrt            ; /51/ Yes, get set to exit
    .SPCPS    #spcwork,#spcarg    ; /51/ Get RT11 to jump to .EXIT
    bcc    110$            ; /51/ Success
10$:    clr    r0            ; /51/ Normal .EXIT
    .EXIT                ; /51/ Bye
100$:    .MRKT    #mkw,#mktime,#ccast,#40 ; /51/ Start a timer to watch
110$:    return                ; /51/ And exit

ccexit:    .EXIT                ; /51/ Bye

    .dsabl    lsb            ; /51/
    .restore


    .sbttl    Dummy EPTS for RSTS/RSX compatibility


putcdt::
getcdt::
tlog::
tmsdia::
getuic::
quochk::
qspool::
noecho::
echo::
chkpar::
fixwil::
putatr::
runjob::clr    r0
getprv::
drpprv::
throtl::return




binfil::clr    r0
    calls    chkext    ,<@r5>
    return


getatr::
detach::
systat::
login::
sercmd::mov    #er$iop    ,r0
    return

okuser::mov    (sp)+    ,@sp
    return


dskuse::mov    @r5    ,r0
    clrb    @r0
    return

second::clr    r0
    clr    r1
    return

getpro::clr    r0
    return

getmcr::mov    @r5    ,r0
    clrb    @r0
    clr    r0
    return




    .sbttl    FETCH    Load a handler if not already resident (BG only)



;    FETCH( rad50(devicename) )
;
;    Mostly rewritten Edit /51/
;
;    /51/ Hard error recovery
;    /51/ New buffer allocation scheme
;    /51/ Checks on .FETCH when running in Foreground
;
;    Example call:    CALLS FETCH,<#^RDZ0>
;            TST R0
;            BNE ERROR


fetch::    .SERR                ; Trap all errors please
    .DSTAT    #rtwork,r5        ; Get handler status
    bcs    70$            ; No such handler present
    movb    rtwork    ,devidx        ; Save device index
    tst    rtwork+4        ; Is this handler resident ?
    bne    50$            ; Yes
    tst    jobsts            ; No, we MUST be job zero to be in
    bne    55$            ; the background, else ERROR return.
    mov    fetptmax,-(sp)        ; Check for space to load it
    sub    @fetpt    ,@sp        ; Simple to do
    cmp    rtwork+2,(sp)+        ; Is there sufficient space ?
    bhi    60$            ; No, error and exit
    .FETCH    @fetpt    ,r5        ; Try hard to load the thing
    bcs    80$            ; No way, map the error code please
    mov    r0    ,@fetpt        ; update the free pointer and exit
50$:    clr    r0            ; No errors
    br    100$            ; Exit
                    ;
55$:    mov    #ER$FGF    ,r0        ; Can't fetch if running in FG
    br    100$            ; Exit
60$:    mov    #ER$FET    ,r0        ; Return NO ROOM for the handler
    br    100$            ; and exit with error in R0.
                    ;
70$:    mov    #DSTERR    ,-(sp)        ; Map a .dstat error
    br    90$            ; And do it
80$:    mov    #FETERR    ,-(sp)        ; Map a .FETCH error
90$:    movb    @#ERRBYT,r0        ; Get the error code
    bpl    95$            ; Normal error code here
    com    r0            ; Fatal error from .SERR
    mov    #FATERR    ,(sp)        ; Thus map to RT11 messages
95$:    asl    r0            ; Word offsets
    add    (sp)+    ,r0        ; The actual address
    mov    @r0    ,r0        ; Get it and exit
100$:    mov    r0    ,-(sp)        ; Save this
    .HERR                ; Reset executive error trapping
    mov    (sp)+    ,r0        ; Restore error codes
    return                ; Bye




    .sbttl    things to do eis instructions


$cbta::    jsr    pc    ,@$$cbta
    return

    .if ne    ,0
    .ift

    .psect

$mul::    mov    r0    ,-(sp)
    mov    r1    ,-(sp)
    mov    6(sp)    ,r0
    mov    10(sp)    ,r1
    mov    r0,-(sp)
    mov    #21,-(sp)
    clr    r0
10$:    ror    r0
    ror    r1
    bcc    20$
    add    2(sp),r0
20$:    dec    (sp)
    bgt    10$
    cmp    (sp)+    ,(sp)+
    mov    r1    ,10(sp)
    mov    (sp)+    ,r1
    mov    (sp)+    ,r0
    mov    (sp)    ,2(sp)
    tst    (sp)+
    return

$div::    mov    r0    ,-(sp)
    mov    r1    ,-(sp)
    mov    6(sp)    ,r0
    mov    10(sp)    ,r1
    mov    #20,-(sp)
    mov    r1,-(sp)
    clr    r1
e00040:    asl    r0
    rol    r1
    cmp    r1,(sp)
    bcs    e00054
    sub    (sp),r1
    inc    r0
e00054:    dec    2(sp)
    bgt    e00040
    cmp    (sp)+    ,(sp)+
    mov    r1    ,6(sp)
    mov    r0    ,10(sp)
    mov    (sp)+    ,r1
    mov    (sp)+    ,r0
    return

    .endc

    .sbttl    $CBTA    Conversion called by $CDDMG from RSX SYSLIB

;    09-Jun-86  10:14:54 $CBTA moved to K11DSP.MAC for XM root cuts

    .GLOBL    $SAVRG        ;Global reference
    .GLOBL    $CBTA


    .GLOBL    $SAVRG
$SAVRG:    MOV    R4,-(SP)
    MOV    R3,-(SP)
    MOV    R5,-(SP)
    MOV    6(SP),R5
    CALL    @(SP)+
    MOV    (SP)+,R3
    MOV    (SP)+,R4
    MOV    (SP)+,R5
    RETURN

    .end