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

Text File | 2020-01-01 | 24KB | 896 lines

    .title    k11rtd    wildcard directory lookup for RT11
    .ident    /2.17/

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


;    Include things we want for kermit



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

    .iif ndf, k11inc,   .error    ; .INCLUDE failed

    .psect

    .enabl    gbl










    .sbttl    local data offsets and definitions


    .mcall    .csispc ,.dstat ,.fetch ,.lookup,.readw ,.close ,.cstat
    .mcall    .serr    ,.herr    ,.purge

    topmem    =    50
    errbyt    =    52

    DEV$LD    =    46        ;/45/ LD: identification

    tent    =    400        ; status for a tentative file
    empty    =    1000        ; status for an empty entry
    perm    =    2000        ; status bit for a permanent file
    endseg    =    4000        ; end of a segment bits

;;    star    =    134745        ; from .csispc for a '*' (rt11/rsts)
    star    =    132500        ; from .csispc for a '*' (real RT11)

    .psect    rtdir    ,rw,d,lcl,rel,con


hd$blk    =    1            ; vbn of the home block
hd$fir    =    724            ; offset into home block for first block
hd$vol    =    730            ; RT11A and seven spaces usually
hd$sys    =    760            ; always DECRT11A


outlun: .word    0
dirbuf: .blkb    2000            ; 2 block buffer for directory segments
name1:    .blkb    12
name2:    .blkb    12

    .save
    .psect    rtdir1    ,rw,d,gbl,rel,con
contex: .word    0            ; current file number
hd.fir: .word    0            ; block number of first entry
itsopen:.word    0
time:    .word    0,45
devtyp: .word    0
    .restore
junk:    .blkb    20










;     information from the directory header

h$nseg    =    0            ; offset for segment count in buffer
h$next    =    2            ; offset for next block link
h$max    =    4            ; offset for highest segment in use
h$ext    =    6            ; offset for number of extra words
h$blk    =    10            ; offset for first block # of data

h.nseg: .blkw    1            ; number of segments in the directory
h.next: .blkw    1            ; link to the next directory segment
h.max:    .blkw    1            ; max segment actually in use
h.ext:    .blkw    1            ; number of extra words per entry
h.blk:    .blkw    1            ; data block number for the segment


;     information from the current directoty entry

f.stat    =    0            ; entry status word
f.nam    =    2            ; all three words of the name+type
f.nam1    =    2            ; first three rad50 characters of name
f.nam2    =    4            ; last three rad50 characters of name
f.type    =    6            ; all three rad50 characters of type
f.len    =    10            ; file size
f.misc    =    12            ; we don't care about this stuff
f.date    =    14            ; creation date


    .save
    .psect    rtdir1    ,rw,d,gbl,rel,con
loklen: .word    0            ;/38/ added for server
lokdate:.word    0            ;/38/ added for server
dirsiz: .blkw    1            ; total size of a directory entry
filnam: .blkw    4            ; the .csispc parsed filename+type
resnam: .blkw    4            ; the name we found
    .restore

    .psect










    .psect    $code

lookup::save    <r1,r2,r3>        ; save all the temps please
    copyz    2(r5)    ,6(r5)        ; return the passed name for starters
    tst    nowild            ;/51/ Perhaps send a DEVICE?
    beq    30$            ;/51/ No
    clr    r0            ;/51/ Assume success
    tst    @4(r5)            ;/51/ Second time for sending device?
    beq    20$            ;/51/ No
    mov    #ER$NMF ,r0        ;/51/ Yes, br 100$ all done
    br    100$            ;/51/ Exit
20$:    inc    @4(r5)            ;/51/ Success, increment context.
    br    100$            ;/51/ Exit

30$:    tst    @4(r5)            ; new call sequence today?
    bne    40$            ; no
    clr    context            ; yes, flag so
    clr    h.max            ; also init a flag
    .close    #lun.sr            ; close the old device up also
    clr    r0            ; no errors please
    clr    itsopen            ; device is no longer open

40$:    tst    itsopen            ; need to open it up
    bne    50$            ; no, already established a context
    call    opndev            ; get the disk opened up please
    tst    r0            ; any errors ?
    bne    100$            ; yes, we will have to die then
    mov    sp    ,itsopen    ; device is open for next call
50$:    call    getnth            ; lookup the next one please
    tst    r0            ; errors ?
    bne    90$            ; no
    inc    @4(r5)            ; return correct context
    br    100$

90$:    push    r0            ;    yes, close the device please
    .close    #lun.sr            ; close the device up on errors
    clr    context            ; insure current context is cleared
    clr    itsopen            ; insure we do an open next time
    pop    r0            ; restore the error code now

100$:    unsave    <r3,r2,r1>        ; pop temps and exit please
    return                ; return any errors in r0










    .sbttl    print directory listing



;     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.


    .save
    .psect    dirmap    ,rw,d,gbl,rel,ovr
dirnam: .blkw    1            ;/51/ Filled in at startup
dirbfr: .blkw    1            ;/51/ Ditto

    .psect    rtdir1    ,rw,d,gbl,rel,con
diridx: .word    0
dirptr: .word    0
wild:    .asciz    /*.*/
dspace: .byte    40,0
dcrlf:    .byte    15,12,0
    .even
    .restore




dodir:: save    <r1,r2,r3,r5>        ; save these please
    mov    2(r5)    ,outlun
10$:    mov    @r5    ,-(sp)
    mov    #1    ,-(sp)
    mov    sp    ,r5
    call    .dodir
    cmp    (sp)+    ,(sp)+
100$:    unsave    <r5,r3,r2,r1>
    clr    r0
    return


.dodir: tst    itsopen            ; need to open it up
    beq    10$            ; yes
    .close    #lun.sr            ; please close up shop first
    clr    itsopen            ; say it's closed now
10$:    call    opndev            ; get the disk opened up please
    tst    r0            ; any errors ?
    bne    100$            ; yes, we will have to die then
    mov    sp    ,itsopen    ; device is open for next call
50$:    call    pridir            ; lookup the next one please
    tst    r0            ; errors ?
    beq    50$            ; no

90$:    mov    r0    ,-(sp)        ; yes, close the device please
    .close    #lun.sr            ; close the device up on errors
    clr    itsopen            ; insure we do an open next time
    mov    (sp)+    ,r0        ; restore the error code now

100$:    return                ; return any errors in r0










    .sbttl    SDODIR    directoty stuff for a server


sdirin::strcpy    dirnam    ,@r5        ; copy name over
    mov    dirbfr    ,dirptr        ; yes, init pointers please
    clr    diridx            ; ditto
    call    dirini            ; init for calls to sdodir
    bcs    100$
    mov    dirbfr    ,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    dirbfr    ,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



dirini: clr    diridx            ; clear context flag
    mov    dirbfr    ,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$:    mov    dirbfr    ,r2        ; pointer to buffer
    mov    #junk    ,r3        ; pointer to work buffer
    calls    lookup    ,<#3,dirnam,#diridx,r2>
    tst    r0            ; successfull?
    bne    80$            ; no
    strlen    r2            ; get the length of the string
    mov    #20    ,r1        ; and format the string
    sub    r0    ,r1        ; number of spaces to append
    ble    30$            ; can't happen
20$:    strcat    r2    ,#dspace    ; append spaces please
    sob    r1    ,20$        ; next please
30$:    deccvt    loklen    ,r3        ; filesize
    clrb    6(r3)            ; insure .asciz please
    strcat    r2    ,r3        ; append it please
    strcat    r2    ,#dspace    ; a space
    mov    lokdate ,r0        ; get date converted
    bne    40$            ; valid
    dec    r0            ; invalid, force 00-xxx-00
40$:    calls    cvtdat    ,<r3,r0>,nogbl    ; append the date please
    strcat    r2    ,r3        ;
    strcat    r2    ,#dcrlf        ; yes, append <cr><lf>
    clr    r0            ; success
    br    100$            ; exit
80$:    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    open the disk up to search the directory

opndev: .SERR                ;/51/ Trap fatal errors please
    sub    #20.    ,sp        ; allocate buffer for the
    mov    sp    ,r2        ; device status call
    sub    #40.*2    ,sp        ; allocate a buffer for the
    mov    sp    ,r1        ; .csispc data

1$:    mov    #defdir ,r3        ; insert default device name
    scan    #':    ,2(r5)        ; check for a device already there
    tst    r0            ; well ?
    bne    6$            ; yep. don't try to put one in please
5$:    movb    (r3)+    ,@r1        ; copy it
    beq    6$            ; all done
    inc    r1            ; not null, next please
    br    5$            ;
6$:    mov    2(r5)    ,r0        ; string address
10$:    movb    (r0)+    ,(r1)+        ; copy it to the csi buffer
    bne    10$            ; until a null byte is found.
    dec    r1            ; get back to the last character
    cmpb    -1(r1)    ,#':        ; is the just just a device only?
    bne    15$            ; no
    movb    #'*    ,(r1)+        ; yes, insert *.*
    movb    #'.    ,(r1)+        ; yes, insert *.*
    movb    #'*    ,(r1)+        ; yes, insert *.*
15$:    movb    #'=    ,(r1)+        ; fake an output filespec here
    clrb    @r1            ; and .asciz
    mov    sp    ,r1        ; reset pointer (also saving sp)
    .csispc r1,#defext,r1        ; and try to parse the name
    mov    r1    ,sp        ; restore from any switches
    bcs    80$            ; oops
    calls    fetch    ,<@r1>        ; try to get the thing loaded
    tst    r0            ; well ?
    bne    120$            ; no, exit with mapped error
    mov    devidx    ,devtyp        ;/45/ Save device type from .FETCH
20$:    tst    @r1            ; a specific device name ?
    bne    30$            ; yes
    mov    #^RDK    ,@r1        ; no, stuff DK: into it then

30$:    mov    r1    ,r0        ; copy the pointer to .csispc results
    mov    #filnam ,r2        ; and save the results
    mov    (r0)+    ,(r2)+        ; copy the device spec first of all
    mov    @r0    ,(r2)+        ; copy the first 3 rad50 of filename
    bne    40$            ; something was indeed there
    mov    #star    ,-2(r2)        ; nothing, convert to wilcard
40$:    clr    (r0)+            ; and clear any filenames please
    mov    @r0    ,(r2)+        ; copy the last 3 rad50 of filename
    clr    (r0)+            ; and clear any filenames please
    mov    @r0    ,(r2)+        ; copy the 3 rad50 of filetype
    .if eq,-1            ;/58/ not longer implied wildcard here
    bne    50$            ; something was passed for filetype
    mov    #star    ,-2(r2)        ; nothing there, stuff a wilcard in
    .endc
50$:    clr    (r0)+            ; and clear any filetypes please
    clr    (r0)+            ; to be sure
    .lookup #rtwork,#lun.sr,r1    ; open the file for input
    bcs    100$            ; can not find it
    clr    r0            ; no errors
    br    120$            ; and exit

60$:    mov    #dsterr ,r1
    br    110$
80$:    mov    #csierr ,r1        ; .csispc error mapping
    br    110$            ; get the correct error now
90$:    mov    #feterr ,r1        ; .fetch error codes
    br    110$
100$:    mov    #lokerr ,r1        ; .lookup error mapping
    br    110$

110$:    movb    @#errbyt,r0        ; get the error code now
    bpl    115$            ;/51/ Normal RT11 error
    com    r0            ;/51/ Make positive
    add    #faterr ,r0        ;/51/ Map to fatal error list
115$:    asl    r0            ; times 2 for indexing into error map
    add    r0    ,r1        ; now map the rt11 error into a fake
    mov    @r1    ,r0        ; of a rms11 error

120$:    add    #<40.*2>+20.,sp        ; pop all the tiny buffers now.
    push    r0            ;/51/ Successfull?
    beq    130$            ;/51/ Yes
    .PURGE    #LUN.SR            ;/51/ No, purge the channel now
130$:    .HERR                ;/51/ Restore normal error control
    pop    r0            ;/51/ Pop actual error code
    return                ; and get out


    .save
    .psect    rtdir
defext: .word    star,star,star,star    ;/58/ default ext. are wildcards
    .restore










    .sbttl    read the home block in please

gethom: save    <r1,r2>            ;/54/
    .readw    #rtwork,#lun.sr,#dirbuf,#400,#hd$blk
    bcs    90$            ; it failed, bye
    mov    #dirbuf ,r2        ; point to the buffer now
    mov    hd$fir(r2),hd.fir    ; get the first directory block number
    bne    5$            ; /56/
    mov    #6    ,hd.fir        ; /56/ Disk had no init data
5$:    add    #hd$sys ,r2        ; point to the volume ident
    cmpb    devtyp    ,#DEV$LD    ;/45/ Logical disk ?
    beq    30$            ;/45/ Yes, skip the check
    tst    rtvol            ; really verify volume ?
    beq    30$            ; no
    mov    r2    ,r1        ;/54/ Check
    mov    #rt    ,r0        ;/54/ ...
10$:    tstb    @r0            ;/54/ Done
    beq    30$            ;/54/ Yes, exit
    cmpb    (r0)+    ,(r1)+        ;/54/ Same
    beq    10$            ;/54/ Yes, keep looking
    mov    r2    ,r1        ;/54/ Check
    mov    #vms    ,r0        ;/54/ ...
20$:    tstb    @r0            ;/54/ Done
    beq    30$            ;/54/ Yes, exit
    cmpb    (r0)+    ,(r1)+        ;/54/ Same
    beq    20$            ;/54/ Yes, keep looking
    br    80$            ;/54/ Not valid
30$:    clr    r0            ; no errors
    br    100$            ; and exit

80$:    mov    #er$vol ,r0        ; return an error code and exit
    br    100$            ; bye

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    <r2,r1>            ;/54/
    return                ; bye

    .save                ;/54/
    .psect    $PDATA    D        ;/54/
rt:    .asciz    /DECRT11/        ;/54/
vms:    .asciz    /DECVMSEX/        ;/54/ From EXCHANGE under VMS4.x
    .even                ;/54/
    .restore            ;/54/


gethdr: .readw    #rtwork,#lun.sr,#dirbuf,#1000,r1
    bcs    90$            ; it failed, bye
    mov    #dirbuf ,r0        ; point to the buffer now
    mov    h$nseg(r0),h.nseg    ; get the total segment count now
    asl    h$next(r0)        ; segments are two blocks in length
    beq    5$            ; no more segments if zero
    add    #4    ,h$next(r0)    ; and at last, the offset
5$:    mov    h$next(r0),h.next    ; get the link to the next one
    tst    h.max            ; already set up ?
    bne    10$            ; yes, don't touch it please
    mov    h$max(r0) ,h.max    ; get the maximum segment in use
10$:    mov    h$ext(r0) ,h.ext    ; get the extra words per dir entry
    mov    h$blk(r0) ,h.blk    ; and the starting block for data
    mov    #7*2    ,dirsiz        ; the default entry size
    add    h$ext(r0),dirsiz    ; plus extra bytes per entry
    clr    r0            ; no errors
    br    100$            ; and exit

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

100$:    return                ; bye


    global    <rtvol>










    .sbttl    print the directory out



pridir: save    <r1,r2,r3>        ; save temps
    call    gethom            ; read in the home block
    tst    r0            ; did it work ?
    bne    100$            ; no, exit with the error please
    mov    hd.fir    ,r1        ; get this directory entry
10$:    tst    r1            ; end of the directory list ?
    beq    90$            ; yes, return 'no more files' please
    call    gethdr            ; the the first directory header
    tst    r0            ; did this work out ?
    bne    100$            ; no, return mapped error code please
    mov    #dirbuf ,r3        ; point to the directory buffer
    add    #5*2    ,r3        ; skip past the header information
20$:    bit    #endseg ,f.stat(r3)    ; end of this segment ?
    bne    80$            ; yes, try the next one please
    bit    #perm    ,f.stat(r3)    ; is this a real file ?
    beq    70$            ; no, skip it please
    call    match            ; see if the file matches up
    tst    r0            ; well ?
    beq    70$            ; no, try again please
    mov    #junk    ,r2        ; a local buffer to use
    call    convert            ; convert to asciz
    mov    #junk    ,-(sp)        ; push the buffer address
    call    110$            ; dump it please
    deccvt    f.len(r3),#junk        ; convert size to decimal
    clrb    junk+6            ; insure .asciz please
    mov    #junk    ,-(sp)        ; push the buffer address
    call    110$            ; and do it
    mov    #210$    ,-(sp)        ; push buffer
    call    110$            ; dump it
    mov    f.date(r3),r0        ; a real date today?
    bne    60$            ; yes
    dec    r0            ; no, force 00-xxx-00
60$:    calls    cvtdat    ,<#junk,r0>,nogbl; and convert the date
    mov    #junk    ,-(sp)        ; same again
    call    110$            ;
    mov    #200$    ,-(sp)        ;
    call    110$            ;


70$:    add    dirsiz    ,r3        ; skip to the next entry please
    br    20$            ; and check this one out please
80$:    mov    h.next    ,r1        ; end of segment, check the next one
    br    10$            ; simple to do

90$:    mov    #er$nmf ,r0

100$:    unsave    <r3,r2,r1>        ; pop temps and exit
    return


110$:    save    <r0,r1,r2,r3>        ; save registers
    mov    12(sp)    ,r3        ; get the buffer address
    tst    outlun            ; output to disk or terminal
    beq    150$            ; tt:
    strlen    r3            ; disk, get the buffer size
    mov    r0    ,r2        ; save it please
    beq    190$            ; nothing to do
120$:    movb    (r3)+    ,r0        ; get the next character
    mov    outlun    ,r1        ; set the lun up also
    call    putcr0            ; dump the character
    sob    r2    ,120$        ; and get the next one
    br    190$            ; exit
150$:    .print    r3            ; output to tt:
190$:    unsave    <r3,r2,r1,r0>        ; pop registers and exit
    mov    (sp)+    ,(sp)        ; move return address up and exit
    return                ; bye


200$:    .byte    15,12,0
210$:    .byte    40,40,40,0
    .even










    .sbttl    get the next entry matching a possibly wildcarded name


getnth: save    <r1,r2,r3,r4>        ; save temps
    clr    r4            ; counter for number of matches
    call    gethom            ; read in the home block
    tst    r0            ; did it work ?
    bne    100$            ; no, exit with the error please
    mov    hd.fir    ,r1        ; get this directory entry
10$:    tst    r1            ; end of the directory list ?
    beq    90$            ; yes, return 'no more files' please
    call    gethdr            ; the the first directory header
    tst    r0            ; did this work out ?
    bne    100$            ; no, return mapped error code please
    mov    #dirbuf ,r3        ; point to the directory buffer
    add    #5*2    ,r3        ; skip past the header information

20$:    bit    #endseg ,f.stat(r3)    ; end of this segment ?
    bne    80$            ; yes, try the next one please
    bit    #perm    ,f.stat(r3)    ; is this a real file ?
    beq    70$            ; no, skip it please
    call    match            ; see if the file matches up
    tst    r0            ; well ?
    beq    70$            ; no, try again please
    cmp    r4    ,context    ; a match here ?
    bne    50$            ; no, try again please
    mov    6(r5)    ,r2        ; a buffer to convert into
    call    convert            ; convert to asciz
    mov    r2    ,r0        ; not get rid off ALL spaces in the name
30$:    tstb    @r0            ; end of the string yet ?
    beq    40$            ; yes
    cmpb    @r0    ,#40        ; if it's a space, then ignore it
    beq    35$            ; skip it please
    movb    @r0    ,(r2)+        ; not a space, please copy it then
35$:    inc    r0            ; point to the next character now
    br    30$            ; and check the next character please
40$:    clrb    @r2            ; insure returned string is .asciz
    mov    F.DATE(r3),lokdate    ;/38/ save this
    mov    F.LEN(r3),loklen    ;/38/ save this
    clr    r0            ; success
    inc    context            ; next one next time please
    br    100$            ; bye
50$:    inc    r4            ; matches := succ( matches )
    br    70$            ; next try please

70$:    add    dirsiz    ,r3        ; skip to the next entry please
    br    20$            ; and check this one out please
80$:    mov    h.next    ,r1        ; end of segment, check the next one
    br    10$            ; simple to do

90$:    mov    #er$nmf ,r0

100$:    unsave    <r4,r3,r2,r1>        ; pop temps and exit
    return










    .sbttl    convert current directory entry to asciz

;     input: r2    buffer for the result
;            r3    current directory entry pointer


convert:mov    r2    ,-(sp)        ; save the passed pointer to a buffer
    calls    rdtoa    ,<r2,filnam>    ; convert the device name please
    cmpb    @r2    ,#40        ; a space for device name ?
    bne    10$            ; no
    movb    #'D&137 ,@r2        ; yes, stuff 'DK' in please
    movb    #'K&137 ,1(r2)        ; simple to do
10$:    add    #2    ,r2        ; skip past it and insert a ':'
    cmpb    @r2    ,#40        ; a space (no unit number?)
    beq    20$            ; no
    tstb    (r2)+            ; a real unit, skip over number
20$:    movb    #':    ,(r2)+        ; yes, get DD: format of device name
    calls    rdtoa    ,<r2,f.nam1(r3)>; convert first 3 filename to ascii
    add    #3    ,r2        ; and skip over those three characters
    calls    rdtoa    ,<r2,f.nam2(r3)>; now get the rest of the filename
    add    #3    ,r2        ; point to place a dot into the name
    movb    #'.    ,(r2)+        ; a dot
    calls    rdtoa    ,<r2,f.type(r3)>; get the filetype at last
    clrb    3(r2)            ; and insure .asciz please
    mov    (sp)+    ,r2        ; pop the pointer and exit
    return                ; bye

    .enabl    lsb

    percent = '.            ;/58/ percent in a filspc string
    wildc    = '?            ;/58/ wildcard flag

match:    save    <r1,r2>            ; we may need these here
    mov    filnam+2,rtwork+0    ; copy the name and type please
    mov    filnam+4,rtwork+2    ; copy the name and type please
    mov    filnam+6,rtwork+4    ; copy the name and type please
    mov    #name1    ,r1        ; was not a simple pattern so convert
    mov    #rtwork ,r2        ; both names back to ascii and check
    mov    #3    ,r0        ; for individual character wildcarding
40$:    calls    rdtoa    ,<r1,(r2)+>    ; convert the patter filename back
    add    #3    ,r1        ; increment the pointer by 3 char's.
    sob    r0    ,40$        ; next please
                    ;
    mov    #name2    ,r1        ; a buffer for the file we just found
    mov    r3    ,r2        ; on the disk. Now get the address of
    add    #f.nam1 ,r2        ; the name and filetype, convert this
    mov    #3    ,r0        ; to ascii in a loop
50$:    calls    rdtoa    ,<r1,(r2)+>    ; convert
    add    #3    ,r1        ; next please
    sob    r0    ,50$        ;
                    ;
60$:    mov    #name1    ,r1        ; the filename pattern
    mov    #name2    ,r2        ; the current filename on disk
    mov    #6.    ,r0        ; the loop count for scanning
    call    200$            ;/58/ compare filename
    bcs    90$            ;/58/  /B on match failure
    mov    #name1+6,r1        ; the filetype pattern
    mov    #name2+6,r2        ; the current filetype on disk
    mov    #3.    ,r0        ; the loop count for scanning
    call    200$            ;/58/ compare filetype
    bcs    90$            ;/58/  /B on match failure
    mov    sp    ,r0        ; flag success and exit
    br    100$            ; bye
                    ;
90$:    clr    r0            ; failure, exit
                    ;
100$:    unsave    <r2,r1>            ; restore registers
    return                ;   and exit at last
                    ;
200$:    mov    r0    ,311$        ;/58/ save for later re-use
    mov    r1    ,310$        ;/58/
201$:    cmpb    @r1    ,@r2        ;/58/ if they match, no problem
    beq    202$            ;/58/ simply check the next character
    cmpb    @r1    ,#wildc        ;/58/ a translated "* wildcard ?
    beq    210$            ;/58/  yes - alternativ check
    cmpb    @r1    ,#percent    ;/58/ a translated "% wildcard ?
    bne    231$            ;/58/  no  - match failure ...
202$:    inc    r1            ;/58/ match so far,
    inc    r2            ;/58/    update pointers
    sob    r0    ,201$        ;/58/    and check the next ones
    call    300$            ;/58/ are we at end of string?
    bcs    230$            ;/58/  yes - success
    cmpb    @r1    ,#space        ;/58/  no - see if wildcarded
    beq    230$            ;/58/          if so, success
    br    231$            ;/58/          else failure ...
                    ;/58/
210$:    inc    r1            ;/58/ point to char. after wildc
    call    300$            ;/58/ are we at end of string?
    bcs    230$            ;/58/  if so, success ...
211$:    cmpb    @r1    ,#space        ;/58/  a spaces?
    beq    230$            ;/58/     end of matching check
    cmpb    @r1    ,#percent    ;/58/ a translated "% wildcard ?
    bne    220$            ;/58/  no - compare strings
    inc    r1            ;/58/ point to char. after wildc
    sob    r0,211$            ;/58/  otherwise loop to find a char.
    br    230$            ;/58/ all "%'s - assume success
                    ;/58/
220$:    cmpb    @r1    ,@r2        ;/58/ find a matching character
    bne    221$            ;/58/    not yet, see next ...
    cmpb    1(r2)    ,@r2        ;/58/ next = same?
    bne    202$            ;/58/    no - verify remainder
221$:    inc    r2            ;/58/    else point to next
    sob    r0,220$            ;/58/         and loop until done
    br    231$            ;/58/ match failure
                    ;/58/
230$:    tst    (pc)+            ;/58/ bump next instr. and clr carry
231$:    sec                ;/58/ flag failure
    return                ;/58/  back to caller
                    ;/58/
300$:    push    r0            ;/58/ save temp
    mov    r1    ,r0        ;/58/ copy searched string pointer
    sub    (pc)+    ,r0        ;/58/ make match count
310$:    .word    0            ;/58/     searched string base address
    cmp    (pc)+    ,r0        ;/58/ compare with char. count
311$:    .word    0            ;/58/     string width
    beq    320$            ;/58/    yes - flag end string
    tst    (pc)+            ;/58/    else skip next instr.
320$:    sec                ;/58/ flag end-of-string
    pop    r0            ;/58/ restore reg
    return

    .dsabl    lsb









    .sbttl    ascdat    convert to ascii date for RT11
    .mcall    .date


;     input: @r5    output buffer address
;        2(r5)    value of date, zero implies current
;
;     I certainly could use my ASH and DIV macros, but may as
;     well do it this way for future possibilities.
;
;     N O T E :  This is a LOCAL copy of ASCDAT so I can overlay
;            the real ACSDAT oppossing this overlay.



cvtdat: save    <r0,r1,r2,r3>        ; save these please
    mov    @r5    ,r1        ; the result address
    cmp    2(r5)    ,#-1        ; if -1, then return 00-XXX-00
    bne    5$            ; no
    copyz    #310$    ,r1        ; yes, then exit
    br    100$            ; bye
5$:    mov    2(r5)    ,r0        ; get the date desired please
    bne    10$            ; it's ok
    .date                ; zero, assume todays date then
10$:    bic    #100000 ,r0        ; undefined
    mov    r0    ,r3        ; copy the date
    asr    r3            ;/2
    asr    r3            ;/2 again
    asr    r3            ; ditto
    asr    r3            ; sigh
    asr    r3            ; at last
    bic    #^C37    ,r3        ; the date, at last
    call    200$            ; convert it
    mov    r0    ,r3        ; get the date once again please
    swab    r3            ; get the month to bits 2..7
    asr    r3            ;/2
    asr    r3            ;/2 again
    bic    #^C17    ,r3        ; get rid of the unwanted bits now
    dec    r3            ; convert to 0..11
    asl    r3            ; convert to word offset
    asl    r3            ; quad offset
    add    #300$    ,r3        ; the address of the text
    movb    #'-    ,(r1)+        ; copy it over please
    movb    (r3)+    ,(r1)+        ; three characters please
    movb    (r3)+    ,(r1)+        ; three characters please
    movb    (r3)+    ,(r1)+        ; three characters please
    movb    #'-    ,(r1)+        ; copy it over please
    mov    r0    ,r3        ; copy the date
    bic    #^C37    ,r3        ; the year, at last
    add    #110    ,r3        ; plus the bias please
    call    200$            ; convert
    clrb    @r1            ; .asciz and exit
100$:    unsave    <r3,r2,r1,r0>
    return

200$:    clr    r2            ; subtract 10 a few times
210$:    inc    r2            ; high digit number
    sub    #12    ,r3        ; until we get a negative number
    tst    r3            ; done yet ?
    bge    210$            ; no
    dec    r2            ; yes
    add    #12    ,r3        ; correct it please
    add    #'0    ,r2        ; and copy the day number please
    add    #'0    ,r3        ; simple
    movb    r2    ,(r1)+        ; copy it
    movb    r3    ,(r1)+        ; copy it
    return

    .nlist    bex
300$:    .ascii    /Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
310$:    .asciz    /00-XXX-00/
    .list    bex
    .even



    .end