Columbia Kermit/kermit.zip/b/krtdir.mac

Text File | 2020-01-01 | 28KB | 812 lines

    .title    KRTDIR    RT-11 directory services
    .ident    "V03.63"

; /63/    27-Sep-97  Billy Youdelman  V03.63
;
;    buffil back to root (KRTPAK), for speed and room now available
;    add support for SET WILDCARDS

; /62/    27-Jul-93  Billy Youdelman  V03.62
;
;    reorganized and substantially sped up
;    added .csispc comma delimiter parsing
;    fixed wildcard "%" match to no longer match on blanks
;    add version testing to support RT-11 V4
;    moved buffil here, has to be if not in root for getcr0 @sdodir..
;    make hd$fir=:6 so badly initted disks don't crash DIR

; /BBS/     1-Dec-91  Billy Youdelman  V03.61
;
;    this module has been extensively modified, please refer to it..
;    add TSX+ create time, date slug, prot status, summary lines, etc
;    corrected bugs in error handling
;    added d$cvtnum for file sizes/sums larger than 32767.
;    "DK" now uses defdir, not op system DK, needs fparse in krtrms
;    ascdat patched for RT-11 V5.5, now also used for cvtdat
;    add dirflg to control embedded blanks in file name
;    getnth used to reread until context=diridx, now context saves it
;    added summary only flag, for use with SPACE and REM SPACE
;    force USR to re-read dir segment, allowing one to swap floppies..

;    17-Sep-86  13:23:00  Handle Labels stuffed in by VMS Exchange
;    18-Jun-84  16:33:01  Brian Nelson
;
;    Copyright 1984 Change Software, Inc


    .include "IN:KRTMAC.MAC"
    .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>

; /62/    .PVAL bypassed for V4, also expanded to allow assembly under same

    .mcall    .CSISPC ,.DATE    ,.GTIM    ,.LOCK    ,.LOOKUP
    .mcall    .READW    ,.PURGE    ,.RCTRLO,.UNLOCK


    .macro    R0toR2    ptr        ; /62/ added..
    .if nb ptr
    mov    ptr    ,r0        ; load r0 if an arg is supplied
    .endc
    call    R0toR2            ; copy string in (r0) to (r2)
    .endm    R0toR2


    .sbttl    Data offsets

    SYSPTR    =    54        ; /62/ pointer to RMON base
        BLKEY    =    256    ; /BBS/ RMON dir seg number in memory

    ; directory home block
    HD$BLK    =    1        ; vbn of the home block
    HD$FIR    =    6        ; /62/ first dir segment block number
    HD$SYS    =    760        ; volume id (DECRT11, DECVMSEX)

    ; directory segment header
    H$NEXT    =    2        ; next logical dir segment
    H$EXT    =    6        ; number of extra bytes per entry

    ; current directory entry
    F.STAT    =    0        ; status word
    F.NAM1    =    2        ; first three rad50 chars of name
    F.NAM2    =    4        ; last three rad50 chars of name
    F.TYPE    =    6        ; all three rad50 chars of type
    F.LEN    =    10        ; file size
    F.TIME    =    12        ; /BBS/ TSX+ file creation time
    F.DATE    =    14        ; creation date

    ; entry status word bits
    PERM    =    2000        ; permanent file
    ENDSEG    =    4000        ; end of a segment
    PROT    =    100000        ; /BBS/ protected entry


    .sbttl    Data definitions

;    STAR    =    134745        ; RTEM (RSTS) .csispc for a "*"
    STAR    =    132500        ; real RT-11 .csispc for a "*"

    .psect    rtdir    ,rw,d,gbl,rel,con
csidev:    .word    0 ,0 ,0 ,0        ; /62/ rad50 dev name + 3 null words..
dirsiz: .word    0            ; length of a file's dir entry
dirbuf:    .blkw    1000            ; 2 block buffer for one dir segment
dbsize    = .-dirbuf            ; /62/ need this to prevent overruns..
dirptr: .word    0            ; server dirbfr read pointer
endflg:    .word    0            ; /BBS/ end of server dir listing flag
h.next: .word    0            ; link to next directory segment
name1:    .blkb    56.            ; /62/ ascii'd csinam(s), null, .even
name2:    .blkb    12            ; /62/ disk file name, for matching
numblks:.word    0            ; /BBS/ total blocks of listed files
numfree:.word    0            ; /BBS/ total blocks empty+tent files

    .psect    $rwdata    ,rw,d,lcl,rel,con
L310$:    .word    0            ; /58/ searched string base address
L311$:    .word    0            ; /58/ string width
sluggy:    .blkw    41.            ; /62/ slug buffer, .csispc, etc, etc.

    .psect    $pdata            ; /BBS/ all new..
defext:    .word    star ,0 ,0 ,0        ; /62/ input default extent is wild
months:    .ascii "-ERR-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-" ; /BBS/
nodate:    .asciz " No Date "        ; /BBS/
blocks:    .asciz    " Block"        ; /62/ # of blocks for summary
dcrlf:    .asciz    <cr><lf>        ; a new line
files:    .asciz    " File"            ; /62/ tag line at end of dir list
free:    .asciz    " Free block"        ; /62/ free space..
plural:    .asciz    "s"            ; /63/ this allow easier translation..
protspc:.asciz    "P  "            ; where the P in protect lives
rt:    .asciz    "DECRT11"        ; /54/ home block disk id
unpspc:    .ascii    " "            ; come here for three blanks
 prospc:.asciz    "  "            ; or, come here for just two
vms:    .asciz    "DECVMSEX"        ; /54/ from EXCHANGE under VMS4.x
    .even


    .psect    $code
    .sbttl    Wildcarded lookup

;    L O O K U P            ; /62/ merged getnth into this..
;
;     (r5)    = possibly wildcarded input file specification
;    2(r5)    = output file spec, name of file matching input spec
;    index    = count of files found, init to 0 before first call
;      r0    = if <>, error code

lookup::save    <r1,r2,r3>
    tst    index            ; /62/ new call sequence today?
    bgt    10$            ; /62/ no, already found a file
    call    opndev            ; ya, get the disk opened up please
    tst    r0            ; any errors?
    bne    120$            ; /62/ yes, we will have to die then
10$:    mov    context    ,r3        ; /BBS/ recover where we were
    bne    30$            ; /BBS/ dir is already in progress
    call    gethom            ; read in the home block
    tst    r0            ; did it work?
    bne    120$            ; /62/ no, exit with the error please

    mov    #hd$fir    ,r1        ; /62/ the first directory segment
20$:    call    gethdr            ; read in a dir segment
    tst    r0            ; did this work?
    bne    120$            ; /62/ no, return mapped error code
    mov    #dirbuf ,r3        ; point to the directory buffer
    add    #5*2    ,r3        ; skip past the header information

30$:    mov    #dirbuf    ,r0        ; /62/ top of the dir buffer
    add    #dbsize    ,r0        ; /62/ end of the buffer
    cmp    r3    ,r0        ; /62/ room for one more?
    bhis    110$            ; /62/ no, so avoid a trap to 4 here!
    bit    #endseg ,f.stat(r3)    ; end of this segment?
    bne    100$            ; yes, try the next one please
    bit    #perm    ,f.stat(r3)    ; /62/ is this a real file?
    bne    40$            ; /62/ ya
    add    f.len(r3),numfree    ; /62/ no, add to total free blocks
    br    90$            ; /62/ next..
40$:    call    match            ; see if the file matches up
    tst    r0            ; well?
    beq    90$            ; no, try again please
    inc    index            ; /62/ ya, bump caller's match count
    add    f.len(r3) ,numblks    ; /62/ add size to total blocks
    tst    summary            ; /62/ need to do any file data?
    bne    90$            ; /62/ no
    mov    2(r5)    ,r2        ; /62/ ya, pass buffer location
    call    convert            ; and convert name to asciz
    mov    r2    ,r0        ; copy to process embedded spaces
50$:    tstb    (r0)            ; end of the string yet?
    beq    80$            ; yes
    tst    dirflg            ; /BBS/ retain embedded blanks?
    bne    60$            ; /BBS/ ya, this is for a dir display
    cmpb    (r0)    ,#space        ; no, if it's a space
    beq    70$            ; then ignore it
60$:    movb    (r0)    ,(r2)+        ; copy one byte
70$:    inc    r0            ; then point to the next char
    br    50$            ; and go check it
80$:    clrb    (r2)            ; ensure returned string is .asciz
    mov    f.date(r3),lokdate    ; /38/ save create date
    mov    f.len(r3) ,loklen    ; /38/ save file size
    mov    f.stat(r3),lokstat    ; /BBS/ file status word
    mov    f.time(r3),loktime    ; /BBS/ TSX+ file create time
    add    dirsiz    ,r3        ; /BBS/ next time, try next one
    mov    r3    ,context    ; /BBS/ save where next one is..
    clr    r0            ; success
    br    130$

90$:    add    dirsiz    ,r3        ; skip to the next entry please
    br    30$            ; and check it
100$:    mov    h.next    ,r1        ; end of segment, check the next one
    bne    20$            ; /62/ if one is there
110$:    mov    #er$nmf ,r0        ; /BBS/ no more files..

120$:    save    <r0>            ; /63/ save the incoming error
    .purge    #lun.sr            ; /62/ dump the device on any error
    clr    lokdate            ; /62/ clear
    clr    lokstat            ; /62/ these
    clr    loktime            ; /62/ on
    clr    loklen            ; /62/ failure..
    clr    dirflg            ; /62/ done with this now
    strcpy    2(r5)    ,(r5)        ; /62/ return input name causing error
    unsave    <r0>            ; /63/ restore the error code now
130$:    unsave    <r3,r2,r1>
    return


    .sbttl    Replace "?" with "%" for RSTS/E users ; /BBS/ from K11RMS.MAC

;    input:    (r5)    = address of string to process

fixwil::save    <r2>
    mov    @r5    ,r2        ; get the string address
10$:    tstb    @r2            ; done with the file name yet?
    beq    30$            ; yes, exit
    cmpb    @r2    ,#'?        ; check for a "?" character
    bne    20$            ; no
    movb    #'%    ,@r2        ; yes, replace with a percent sign
20$:    inc    r2            ; next please
    br    10$            ; back again
30$:    unsave    <r2>
    clr    r0            ; no error
    return


    .sbttl    Display directory listing on terminal

;     D O D I R            ; /62/ major rewrite using server code
;
;     (r5)    = wildcarded filespec
;      r0    = if <>, error code

dodir::    call    sdirini            ; init directory lookup and
    tst    r0            ; pre-load output buffer
    bne    40$            ; an error occurred
    br    20$            ; enter loop writing..

10$:    call    dirnex            ; look for a matching file
    bcs    30$            ; done..
    tst    endflg            ; about to type the summary lines?
    beq    20$            ; no
    .rctrlo                ; ya, ensure totals are visible
20$:    wrtall    dirbfr            ; dump matching file spec to terminal
    br    10$            ; try for another match

30$:    clr    r0            ; no error
40$:    return


    .sbttl    Server directory    ; /62/ condensed a bit..

;    S D I R I N I  -  Initialization
;    S D O D I R    -  Get next char
;
;    input:   (r5)    = wildcarded name
;    output:   r1    = next character in the directory listing
;          r0    = if <>, error code
;
;    SDODIR is called by the server to respond to a remote directory
;    command, returning one char at a time so BUFFIL can use it, via
;    the GETCR0 routine.  SDIRINI must be called first, to check for
;    a valid device and file spec, and to pre-load the date slug.

sdirini::copyz    (r5)    ,dirnam    ,#80.    ; /62/ copy name over, don't overwrite
    clr    index            ; /62/ init to
    calls    lookup    ,<dirnam,@r5>    ; /62/ open device and check file spec
    tst    r0            ; /62/ well?
    beq    10$            ; /62/ no error
    cmp    r0    ,#er$nmf    ; /62/ no good, but
    bne    40$            ; /62/ ignore no more files error
10$:    clr    index            ; /62/ reset match counter
    mov    sp    ,dirflg        ; /62/ keep blanks in name
    clr    endflg            ; clear all done looking flag
    mov    dirbfr    ,r2        ; the output buffer
    mov    r2    ,dirptr        ; reset its pointer
    mov    #sluggy    ,r0        ; /62/ scratch buff
    calls    ascdat    ,<r0,#-1>    ; /62/ get date into a buffer
    cmpb    #space    ,(r0)        ; leading space in date?
    beq    20$            ; ya, so skip adding one
    movb    #space    ,(r2)+        ; no, so blank col. 1 ala RT-11
20$:    R0toR2                ; /62/ copy the date
    tst    summary            ; doing a summary only?
    beq    30$            ; /62/ nope
    R0toR2    #dcrlf            ; /62/ ya, prefix with <cr><lf>
    R0toR2    dirnam            ; /62/ display file spec for SPACE cmd
30$:    clr    r0            ; /62/ no error
40$:    return

sdodir::save    <r2,r3>
10$:    movb    @dirptr ,r1        ; get the next char please
    beq    20$            ; /63/ nothing left, reload buffer
    inc    dirptr            ; pointer++, something was there
    clr    r0            ; no errors
    br    40$
20$:    mov    dirbfr    ,dirptr        ; /63/ reset the pointer
    clrb    @dirptr            ; init the buffer
    call    dirnex            ; load next file's data into buffer
    bcc    10$            ; /63/ back to get next char loop
30$:    mov    #er$eof ,r0        ; failure, return(EOF)
    clr    r1            ; return no data also
40$:    unsave    <r3,r2>
    return

dirnex:    mov    dirbfr    ,r2        ; pointer to buffer
    mov    #sluggy    ,r3        ; /62/ local scratch buffer
    tst    endflg            ; /BBS/ done the tally lines yet?
    bne    50$            ; /BBS/ ya, time to bail out
    calls    lookup    ,<dirnam,r3>    ; /62/ try to find a matching file
    tst    r0            ; successful?
    bne    30$            ; no
    R0toR2    #dcrlf            ; /62/ ya, prefix with <cr><lf>
    R0toR2    r3            ; /62/ copy file spec into buff
    calls    d$cvtnum,<r3,loklen,#0>    ; /BBS/ file size
    R0toR2    r3            ; /62/ append it please
    bit    #prot    ,lokstat    ; /BBS/ protected file?
    beq    10$            ; /BBS/ nope..
    R0toR2    #protspc        ; /62/ ya, so flag it accordingly
    br    20$            ; /BBS/ and continue
10$:    R0toR2    #unpspc            ; /62/ three spaces..
20$:    calls    ascdat    ,<r3,lokdate>    ; /62/ convert date to asciz
    R0toR2    r3            ; /62/ append the date please
    tst    tsxsav            ; /BBS/ if not TSX
    beq    40$            ; /63/ skip the file time
    R0toR2    #prospc            ; /62/ two blanks
    calls    filtim    ,<r3,loktime>    ; /BBS/ make it displayable
    R0toR2    r3            ; /62/ copy that into dir string
    br    40$

30$:    cmp    r0    ,#er$nmf    ; no more files error?
    bne    60$            ; no
    call    dirsum            ; /63/ ya, do summary lines now
40$:    clr    r0            ; success
    br    70$
50$:    mov    #er$eof ,r0        ; failure, return(EOF)
60$:    sec                ; indicate there was some error
70$:    return

dirsum:    mov    sp    ,endflg        ; /63/ flag it's all over
    R0toR2    #dcrlf            ; /62/ prefix with <cr><lf>
    tst    summary            ; doing a SPACE summary only?
    bne    10$            ; ya, skip the newline here
    tst    index            ; anything listed?
    bgt    10$            ; ya
    R0toR2    #dcrlf            ; no, so blank a line ala RT-11
10$:    calls    d$cvtnum,<r3,index,#-1>    ; number of files listed
    R0toR2    r3            ; copy to buffer
    R0toR2    #files            ; " File"
    dec    index            ; singular or plural?
    beq    20$            ; singular
    R0toR2    #plural            ; /63/ not 1, so make it plural
20$:    movb    #comma    ,(r2)+        ; ","
    calls    d$cvtnum,<r3,numblks,#-1> ; total blocks
    R0toR2    r3            ; append it please
    R0toR2    #blocks            ; " Block"
    dec    numblks            ; singular or plural?
    beq    30$            ; just one
    R0toR2    #plural            ; /63/ not 1, so make it plural
30$:    R0toR2    #dcrlf            ; <cr><lf>
    calls    d$cvtnum,<r3,numfree,#-1> ; free blocks
    R0toR2    r3            ; put ascii number in buffer
    R0toR2    #free            ; " Free Block"
    dec    numfree            ; singular or plural?
    beq    40$            ; singular
    R0toR2    #plural            ; /63/ not 1, so make it plural
40$:    R0toR2    #dcrlf            ; <cr><lf>
    return


    .sbttl    Copy (r0) to (r2)    ; /62/ replaces strcat here

R0toR2:    movb    (r0)+    ,(r2)+        ; copy a byte
    bne    R0toR2            ; until hitting a null
    dec    r2            ; leave r2 on the null
    return


    .sbttl    Open device, build name list to search directory

;    O P N D E V
;
;    input:      (r5)    = file spec string
;    output:       r0    = if <>, error code

opndev:    calls    fparse    ,<(r5),#sluggy>    ; /62/ check for valid device
    tst    r0            ; /BBS/ is it?
    beq    10$            ; /BBS/ ya
    return                ; /BBS/ no

10$:    .purge    #lun.sr            ; /62/ dump possible old device
    mov    #sluggy    ,r0        ; /62/ input string address
    copyz    r0    ,dirnam        ; /62/ return cleaned up file spec
    clr    context            ; /62/ init curr dir seg offset reg
    clr    numblks            ; /62/ clear total blocks of above
    clr    numfree            ; /62/ clear free space reg

    sub    #ln$max+2.,sp        ; /63/ .csispc input data buffer
    mov    sp    ,r1        ; pointer to it
    movb    #'=    ,(r1)+        ; /62/ fake an output file spec
20$:    movb    (r0)+    ,(r1)+        ; copy input string to the CSI buffer
    bne    20$            ; until a null byte is found
    mov    sp    ,r1        ; reset pointer (also saving sp)
    .csispc #sluggy    ,#defext ,r1    ; /62/ try to parse the file spec(s)
    mov    r1    ,sp        ; hose any switches, unsupported here
    bcs    110$            ; oops
    mov    sluggy+36,csidev    ; /62/ save a copy of device name only
    calls    fetch    ,<csidev>    ; /62/ try to get the thing loaded
    tst    r0            ; well?
    bne    150$            ; exit with mapped error

    mov    #6    ,r1        ; /62/ do implicit "*." wildcarding
    mov    #sluggy+40,r0        ; /62/ first input file name is here
30$:    tst    (r0)            ; /62/ does an input file name exist?
    bne    40$            ; /62/ something was indeed there
; /63/    Following two lines are here if needed, but probably will never be..
;    tst    dowild            ; /63/ implicit wildcarding enabled?
;    beq    40$            ; /63/ not this time..
    mov    #star    ,(r0)        ; /62/ nothing, convert to wildcard
40$:    add    #10    ,r0        ; /62/ bump pointer to next descriptor
    sob    r1    ,30$        ; /62/ do six input file descriptors
    clr    -(r0)            ; /62/ null terminate rad50 names

    mov    #name1    ,r0        ; /62/ init this buffer with nulls
    mov    #56./2    ,r1        ; /62/ clearing 2 bytes at a time
50$:    clr    (r0)+            ; /62/ is somewhat faster than one
    sob    r1    ,50$        ; /62/ by one..

    save    <r2>            ; /63/
    mov    #name1    ,r1        ; /62/ top of ascii'd names buffer
    mov    #sluggy+36,r2        ; /62/ offset to first input file spec
60$:    tst    (r2)+            ; /62/ ignore device name
    beq    80$            ; /62/ nothing left, done
    mov    #3    ,r0        ; /62/ loop 3 times
70$:    calls    rdtoa    ,<r1,(r2)+>    ; /62/ convert file name to ascii
    add    #3    ,r1        ; /62/ increment pointer by 3 chars
    sob    r0    ,70$        ; /62/ next please
    br    60$            ; /62/ then try next file name
80$:    unsave    <r2>            ; /63/

    .lock                ; /BBS/ lock the USR in memory
    cmp    rt11ver    ,#5        ; /62/ is the RT-11 V5 or above?
    bge    90$            ; /62/ ya, .pval will work
    tst    montyp            ; /62/ if XM and V4..
    bgt    100$            ; /62/ ..tough luck
    mov    @#sysptr,r0        ; /62/ otherwise, get RMON base and
    clr    blkey(r0)        ; /63/ force USR to re-read the dir
    br    100$
90$:
; /62/    .pval    #rtwork    ,#blkey    ,#0    ; /BBS/ force USR to re-read the dir
    MOV    #rtwork    ,R0        ; /62/ expanded to assemble under V4
    MOV    #28.*^o400+2,@R0    ; /62/ even though V4 can't run it
    MOV    #blkey    ,2.(R0)        ; /62/
    CLR    4.(R0)            ; /62/
    EMT    ^o375            ; /62/
100$:    .lookup #rtwork    ,#lun.sr,#csidev ; /62/ open the DEVICE for input
    bcs    120$            ; can not find it
    clr    r0            ; no errors
    br    150$

110$:    mov    #csierr ,r1        ; .csispc error mapping
    br    130$
120$:    mov    #lokerr ,r1        ; .lookup error mapping
130$:    movb    @#errbyt,r0        ; get the error code now
    bpl    140$            ; /51/ normal (non-fatal) RT-11 error
    com    r0            ; /51/ fatal error, flip it to map
    mov    #faterr ,r1        ; /BBS/ to a fatal error message
140$:    asl    r0            ; word indexing
    add    r0    ,r1        ; now map the RT-11 error into
    mov    @r1    ,r0        ; a fake RMS-11 error

150$:    add    #ln$max+2,sp        ; /63/ pop the .csispc input buffer
    save    <r0>            ; /63/ did an error occur?
    beq    160$            ; /51/ no
    .purge    #lun.sr            ; /51/ ya, purge the channel
160$:    .unlock                ; /BBS/ now release the USR..
    unsave    <r0>            ; /63/ restore possible error code
    return


    .sbttl    Read in the home block

;    G E T H O M E
;
;    output:       r0    = if <>, error code

gethom: save    <r1,r2>            ; /54/
    .readw    #rtwork,#lun.sr,#dirbuf,#400,#hd$blk
    bcs    50$            ; it failed, bye
    tst    rtvol            ; really verify volume?
    beq    30$            ; no
    mov    #dirbuf ,r2        ; ya, get top of the buffer
    add    #hd$sys ,r2        ; now point to the volume ident
    mov    r2    ,r1        ; /54/ copy of dirbuf pointer
    mov    #rt    ,r0        ; /54/ check for DECRT11 id
10$:    tstb    @r0            ; /54/ done?
    beq    30$            ; /54/ yes, exit
    cmpb    (r0)+    ,(r1)+        ; /54/ same?
    beq    10$            ; /54/ yes, keep looking
    mov    #vms    ,r0        ; /54/ check for VMSEXCH id
20$:    tstb    @r0            ; /54/ done?
    beq    30$            ; /54/ yes, exit
    cmpb    (r0)+    ,(r2)+        ; /62/ same?
    beq    20$            ; /54/ yes, keep looking
    br    40$            ; /54/ not valid
30$:    clr    r0            ; no error
    br    60$

40$:    mov    #er$vol ,r0        ; return an error code
    br    60$
50$:    movb    @#errbyt,r0        ; get the error code
    asl    r0            ; word indexing
    mov    drderr(r0),r0        ; /BBS/ disk read error mapping
60$:    unsave    <r2,r1>            ; /54/
    return


    .sbttl    Read in a segment, get header data

;    G E T H D R
;
;    input:    r1    = desired segment begins at this block
;    output:    dirbuf    = dir segment just read
;        dirsiz    = size of each file's dir entry
;        h.next    = link to next segment

gethdr: .readw    #rtwork,#lun.sr,#dirbuf,#1000,r1
    bcs    20$            ; it failed, bye
    mov    #dirbuf    ,r0        ; point to the buffer now
    asl    h$next(r0)        ; segments are two blocks in length
    beq    10$            ; no more segments if zero
    add    #4      ,h$next(r0)    ; and at last, the offset
10$:    mov    h$next(r0),h.next    ; get the link to the next one
    mov    #7*2     ,dirsiz    ; the default entry size
    add    h$ext(r0),dirsiz    ; plus extra bytes per entry
    clr    r0            ; no error
    br    30$

20$:    movb    @#errbyt,r0        ; get the error code
    asl    r0            ; word indexing
    mov    drderr(r0),r0        ; /BBS/ disk read error mapping
30$:    return


    .sbttl    Convert a directory entry to .asciz

;    C O N V E R T
;
;    input:       r2    = buffer for the result
;           r3    = current directory entry pointer

convert:save    <r2>
    calls    rdtoa    ,<r2,csidev>    ; /62/ convert the device name please
    add    #2    ,r2        ; skip past it and insert a ":"
    cmpb    @r2    ,#space        ; a space (no unit number?)
    beq    10$            ; no
    tstb    (r2)+            ; a real unit, skip over number
10$:    movb    #':    ,(r2)+        ; get DDn: format of device name
    calls    rdtoa    ,<r2,f.nam1(r3)> ; convert first 3 file name to ascii
    add    #3    ,r2        ; and skip over those three characters
    calls    rdtoa    ,<r2,f.nam2(r3)> ; now get the rest of the file name
    add    #3    ,r2        ; point to place a dot into the name
    movb    #'.    ,(r2)+        ; a dot
    calls    rdtoa    ,<r2,f.type(r3)> ; get the file type at last
    clrb    3(r2)            ; ensure .asciz
    unsave    <r2>
    return


    .sbttl    Wildcarded file name match test

;    M A T C H
;
;    r3 = passed pointer to current entry in directory segment buffer
;    r4 = internal pointer to current entry in file names data buffer

    PERCENT = '.            ; /58/ percent in a file spec string
    WILDC    = '?            ; /58/ wildcard flag in same

match:    save    <r1,r2,r4>        ; /62/
    mov    #name2    ,r1        ; /62/ ascii name of file on disk
    mov    r3    ,r2        ; /62/ address of its entry
    add    #f.nam1 ,r2        ; /62/ bump to start of file name
    mov    #3    ,r0        ; /62/ loop 3 times
10$:    calls    rdtoa    ,<r1,(r2)+>    ; /62/ convert to ascii
    add    #3    ,r1        ; /62/ next please
    sob    r0    ,10$        ; /62/

    mov    #name1    ,r4        ; /62/ top of input file names buffer
20$:    tstb    (r4)            ; /62/ is there an entry here?
    beq    50$            ; /62/ nothing left, bail out..
    mov    r4    ,r1        ; /62/ the file name pattern
    mov    #name2    ,r2        ; the current file name on disk
    mov    #6.    ,r0        ; the loop count for scanning
    add    r0    ,r4        ; /62/ preset to file type location
    call    m.char            ; /58/ compare file name
    bcs    30$            ; /58/ match failure
    mov    r4    ,r1        ; /62/ the file type pattern
    mov    #name2+6,r2        ; the current file type on disk
    mov    #3.    ,r0        ; the loop count for scanning
    add    r0    ,r4        ; /62/ preset to next file name
    call    m.char            ; /58/ compare file type
    bcs    40$            ; /62/ match failure
    mov    sp    ,r0        ; flag success and exit
    br    60$
30$:    add    #3    ,r4        ; /62/ bump to next file name
40$:    br    20$            ; /62/ go try possible next file spec
50$:    clr    r0            ; /62/ failure, exit
60$:    unsave    <r4,r2,r1>        ; /62/
    return

m.char:    mov    r0    ,L311$        ; /63/ save for
    mov    r1    ,L310$        ; /58/ later re-use
10$:    cmpb    @r1    ,@r2        ; /58/ if they match, no problem
    beq    20$            ; /58/ simply check the next character
    cmpb    @r1    ,#wildc        ; /58/ a translated * wildcard?
    beq    30$            ; /58/ yes - alternative check
    cmpb    @r1    ,#percent    ; /58/ a translated % wildcard?
    bne    80$            ; /58/ no  - match failure..
    cmpb    (r2)    ,#space        ; /62/ ya, but must be something here
    ble    80$            ; /62/ nothing there, match failure
20$:    inc    r1            ; /58/ match so far,
    inc    r2            ; /58/ update pointers
    sob    r0    ,10$        ; /58/ and check the next ones
    call    m.len            ; /58/ are we at end of string?
    bcs    70$            ; /58/ yes - success
    cmpb    @r1    ,#space        ; /58/ no - see if wildcarded
    beq    70$            ; /58/ if so, success
    br    80$            ; /58/ else failure..

30$:    inc    r1            ; /58/ point to char after wildcard
    call    m.len            ; /58/ are we at end of string?
    bcs    70$            ; /58/ if so, success..
40$:    cmpb    @r1    ,#space        ; /58/ a space?
    beq    70$            ; /58/ end of matching check
    cmpb    @r1    ,#percent    ; /58/ a translated % wildcard?
    bne    50$            ; /58/ no - compare strings
    cmpb    (r2)    ,#space        ; /62/ ya, but must be something here
    ble    80$            ; /62/ nothing there, match failure
    inc    r1            ; /58/ point to char after wildc
    sob    r0    ,40$        ; /58/ otherwise loop to find a char
    br    70$            ; /58/ all %s, assume success

50$:    cmpb    @r1    ,@r2        ; /58/ find a matching character?
    bne    60$            ; /58/ not yet, see next..
    cmpb    1(r2)    ,@r2        ; /58/ next = same?
    bne    20$            ; /58/ no - verify remainder
60$:    inc    r2            ; /58/ else point to next
    sob    r0    ,50$        ; /58/ and loop until done
    br    80$            ; /58/ match failure
70$:    tst    (pc)+            ; /58/ skip next instr and clr carry
80$:    sec                ; /58/ or, flag failure by seting it
    return

m.len:    save    <r0>            ; /63/
    mov    r1    ,r0        ; /58/ copy searched string pointer
    sub    L310$    ,r0        ; /62/ get number of chars checked
    cmp    L311$    ,r0        ; /62/ compare with total char count
    beq    10$            ; /58/ a match - go flag it
    tst    (pc)+            ; /58/ else skip next instr, clr carry
10$:    sec                ; /58/ flag end of string
    unsave    <r0>            ; /63/
    return


    .sbttl    Convert date to .asciz

;    A S C D A T E
;
;    input:   (r5)    = output buffer address
;        2(r5)    = value of date, -1 for today's

; /BBS/    modified for RT-11 V5.5 extension of max year to 2099

    DOFOUR    = 1    ; /62/ zero to display just last two digits of year

ascdat::save    <r0,r1,r2,r3>
    mov    @r5    ,r1        ; the result address
    mov    2(r5)    ,r0        ; /62/ get the date desired please
    bne    10$            ; /62/ something is there
    strcpy    r1    ,#nodate    ; /62/ else return " No Date "
    br    60$            ; bye

10$:    cmp    r0    ,#-1        ; /62/ if -1, then return today's date
    bne    20$            ; it's something else..
    cmp    -(sp)    ,-(sp)        ; /BBS/ a two word buffer
    mov    sp    ,r3        ; /BBS/ point to it
    .gtim    #rtwork    ,r3        ; /BBS/ roll over clock so date is ok
    cmp    (sp)+    ,(sp)+        ; /BBS/ dump the time buffer
    .date                ; /BBS/ get today's date

20$:    mov    r0    ,r3        ; copy the date to get day of month
    ash    #3    ,r3        ; /62/ shift left 3 places
    swab    r3            ; then swap bytes to get
    bic    #^c<37>    ,r3        ; the date, at last
    call    i2toa            ; /BBS/ write ascii to out buff

    mov    r0    ,r3        ; get the date once again please
    swab    r3            ; get the month to bits 5..2
    bic    #^c<74>    ,r3        ; /62/ hose yrs/days, leave at *4
    cmp    r3    ,#12.*4        ; /62/ a legal month?
    ble    30$            ; /62/ most likely..
    clr    r3            ; /62/ no, force "-ERR-"
30$:    add    #months    ,r3        ; /BBS/ the easy way to point to month
    mov    #5    ,r2        ; /BBS/ prep to copy 5 chars "-Mon-"
40$:    movb    (r3)+    ,(r1)+        ; /BBS/ copy to out buff
    dec    r2            ; /BBS/ one byte
    bne    40$            ; /BBS/ at a time

    mov    r0    ,r3        ; copy the date
    bic    #^c<37>    ,r3        ; hose all but the year

    .if ne dofour            ; /62/ display all four years digits
    add    #1972.    ,r3        ; plus the bias please
    .iff                ; /62/ just last two digits of year
    add    #72.    ,r3        ; plus the bias please
    .iftf                ; /63/ common code ahead..

    bic    #^c<140000>,r0        ; /BBS/ extend max year w/two hi bits
    swab    r0            ; /BBS/ two hi bits now are bits 7,6
    asr    r0            ; /BBS/ shift to bits 6,5 (true value)
    add    r0    ,r3        ; /BBS/ add to total years

    .ift                ; /63/
    call    i4toa            ; /BBS/ write all 4 digits of year
    .iff                ; /62/ just last two digits of year
    cmp    #100.    ,r3        ; /BBS/ is it 2000 (next century) yet?
    bgt    50$            ; /BBS/ no
    sub    #100.    ,r3        ; /BBS/ ya, extract last 2 digits
50$:    call    i2toa            ; /BBS/ write ascii to out buff
    .endc    ; ne dofour

    clrb    @r1            ; .asciz
    cmpb    #'0    ,@(r5)        ; /BBS/ leading zero to blank?
    bne    60$            ; /BBS/ not zero
    movb    #space    ,@(r5)        ; /BBS/ ya
60$:    unsave    <r3,r2,r1,r0>
    return


    .sbttl    Display TSX+ file creation time    ; /BBS/ all new

;    F I L T I M E
;
;    input:      (r5)    = output buffer address
;         2(r5)    = input filtim in TSX+ "3 sec" format

filtim:    save    <r0,r1,r2,r3>
    mov    2(r5)    ,r1        ; get filtim (low) word
    clr    r0            ; clear hi word for divide
    div    #20.    ,r0        ; get # of 3-secs since midnite
    mov    r1    ,-(sp)        ; put on stack
    asl    r1            ; multiply by two
    add    r1    ,(sp)        ; *3 = secs component of time value
    mov    r0    ,r1        ; prep for divide to..
    clr    r0            ; ..get mins + hrs
    div    #60.    ,r0        ; get minutes component of time value
    mov    r1    ,-(sp)        ; save minutes
    mov    r0    ,r3        ; put hrs where i2toa expects them
    mov    @r5    ,r1        ; the result address
    call    i2toa            ; write hours to outbuff
    movb    #':    ,(r1)+        ; format display
    mov    (sp)+    ,r3        ; put mins where i2toa expects them
    call    i2toa            ; write mins to outbuf
    movb    #':    ,(r1)+        ; format display
    mov    (sp)+    ,r3        ; put secs where i2toa expects them
    call    i2toa            ; write secs to outbuf
    clrb    @r1            ; null terminate the whole thingie
    unsave    <r3,r2,r1,r0>
    return


    .sbttl    Unsigned 16-bit integer conversion  ; /BBS/ all new

;    D $ C V T N U M        accommodates sizes > 32767.
;
;    input:      (r5)    = output buffer address
;         2(r5)    = unsigned 16-bit value to write into buffer
;         4(r5)    = display formatting:
;              0  = field set to 6 and right justified
;              <> = space at left, number from left, .asciz

d$cvtnum:save    <r0,r1,r2,r3>        ; /62/ cleaned up this code..
    mov    (r5)    ,r2        ; write the number here
    mov    #6    ,r3        ; make its width 6
    mov    r3    ,r1        ; copy to clear buffer

10$:    movb    #space    ,(r2)+        ; fill the buffer with blanks
    sob    r1    ,10$
    clrb    @r2            ; null terminate end of buffer
    mov    2(r5)    ,r1        ; get the value to print out

20$:    clr    r0            ; set up for the divide by 10.
    div    #10.    ,r0        ; remainder in r1, quotient r0
    add    #'0    ,r1        ; convert remainder to character
    movb    r1    ,-(r2)        ; and stuff that into output buffer
    mov    r0    ,r1        ; copy for next iteration
    beq    30$            ; done
    sob    r3    ,20$        ; next..

30$:    tst    4(r5)            ; field flag flyin?
    beq    50$            ; no, exit
     mov    @r5    ,r1        ; start of the buffer here
     inc    r1            ; keep the leading blank in..
40$:     movb    (r2)+    ,(r1)+        ; move chars to front of buffer
     bne    40$            ; copy to and including the null

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

    .end