home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11rmz.mac < prev    next >
Text File  |  2020-01-01  |  11KB  |  356 lines
  1.     .title    k11rmz    overlayed RMS11 code (3.43)
  2.     .ident    /3.43/
  3.     .psect    $code
  4.  
  5. ;    Creation: 24-Jan-86  14:06:18  Brian Nelson
  6. ;
  7. ;    Will the addition of long packet support the root is getting
  8. ;    too large.
  9. ;
  10. ;    Entry points:
  11. ;
  12. ;    delete        delete a file(s)
  13. ;    rename        rename a file(s)
  14. ;    getmcr        get mcr/ccl command line, only used ONCE
  15. ;
  16. ;
  17. ;    Copyright (C) 1986 Change Software, Inc
  18.  
  19.  
  20.  
  21.  
  22.  
  23.     .if ndf, K11INC
  24.     .ift
  25.     .include    /IN:K11MAC.MAC/
  26.     .endc
  27.  
  28.     .library    /LB:[1,1]RMSMAC.MLB/
  29.  
  30.  
  31.     .mcall    $compare,$fetch    ,$parse    ,$search,$set    ,$store
  32.     .mcall    fab$b    ,nam$b    ,$rename,$erase ,$off    ,$testb
  33.  
  34.  
  35.  
  36.     nb$nod    =    400    ; Node in file or default string (FNB in NAM)
  37.  
  38.     .enabl    gbl
  39.  
  40.     .psect    $code    ,ro,i,lcl,rel,con
  41.     .psect    rmssup    ,rw,d,lcl,rel,con
  42.  
  43.  
  44.     .mcall    fabof$
  45.     .mcall    rabof$
  46.     .mcall    xabof$
  47.  
  48.     fabof$    RMS$L
  49.     rabof$    RMS$L
  50.     xabof$    RMS$L
  51.  
  52.  
  53.  
  54.  
  55.     .sbttl    rename
  56.  
  57.  
  58. ;    R E N A M E
  59. ;
  60. ;    input:    @r5    old filename address
  61. ;        2(r5)    new filename address
  62. ;        4(r5)    flag, lt 0 don't print the results else print a log
  63. ;
  64. ;    output:    r0    error code, zero if at least one file found
  65. ;        r1    number of files renamed
  66.  
  67.  
  68.  
  69.     .sbttl    the real work of rename
  70.     .psect    $code
  71.     .enabl    lsb
  72.  
  73. rename::save    <r2,r3,r4,r5>        ; save temps please
  74.     mov    #rnfab1    ,r0        ; point to the old name FAB
  75.     mov    #rnfab2    ,r1        ; point to the new name FAB
  76.     mov    #rnnam1    ,r2        ; point to the old name's NAMEBLOCK
  77.     mov    #rnnam2    ,r3        ; point to the new name's NAMEBLOCK
  78.     tst    fu$def            ; do we really need a default device?
  79.     beq    1$            ; no
  80.     $store    #sydisk,DNA,r0        ; yes. Stuff the default system device
  81.     $store    #sylen ,DNS,r0        ; name and length to the source name and
  82.     $store    #sydisk,DNA,r1        ; then do the same for the new name. Put
  83.     $store    #sylen ,DNS,r1        ; the def device address and length in.
  84.  
  85. 1$:    mov    r0    ,r4        ; save the FAB1 pointer now     ;RBD01--
  86.     strlen    #defdir            ; anything in the Kermit default dir?
  87.     tst    r0            ; if <> then use it
  88.     beq    5$            ; nothing there to use, use SY:
  89.     $store    #defdir    ,DNA,r1        ; something was there, stuff it in
  90.     $store    r0    ,DNS,r1        ; and the length of the default
  91.     $store    #defdir    ,DNA,r4        ; something was there, stuff it in
  92.     $store    r0    ,DNS,r4        ; and the length of the default
  93. 5$:    mov    r4    ,r0        ; restore FAB1 pointer now
  94.     $store    #lun.sr ,LCH,r0        ; stuff a logical unit number
  95.     $store    #lun.sr ,LCH,r1        ; stuff a logical unit number
  96.     sub    #100    ,sp        ; allocate an ESA for old name
  97.     $store    sp  ,ESA,r2        ; and stuff the address in
  98.     $store    #100,ESS,r2        ; and the length of it please
  99.     sub    #100    ,sp        ; next is the resultant string
  100.     $store    sp  ,RSA,r2        ; buffer for the old filename
  101.     $store    #100,RSS,r2        ; and the size of it please
  102.     sub    #100    ,sp        ; the new filename buffer
  103.     $store    sp  ,ESA,r3        ; stuff address of the buffer
  104.     $store    #100,ESS,r3        ; and the size of it please
  105.     clr    -(sp)            ; a count of the files done so far
  106.  
  107.     mov    #rnfab1    ,r1        ; point to the old name FAB
  108.     mov    #rnfab2    ,r2        ; point to the new name FAB
  109.     strlen    @r5            ; get the .asciz length of old
  110.     $store    @r5 ,FNA,r1        ; store the old filename address
  111.     $store    r0  ,FNS,r1        ; stuff the length of the old name
  112.     mov    #rnfab1    ,r0        ; point to the old name FAB
  113.     $parse    r0            ; parse the old name please
  114.     $compar    #0  ,STS,r0        ; did the parse work out ok ?
  115.     blt    90$            ; no, exit
  116.     strlen    2(r5)            ; get the length of the new name
  117.     $store    2(r5),FNA,r2        ; stuff the new name into FNS field
  118.     $store    r0  ,FNS,r2        ; and the size of it please
  119.  
  120.  
  121. 10$:    mov    #rnfab1    ,r0        ; point to the old name FAB
  122.     mov    #rnfab2    ,r1        ; point to the new name FAB
  123.     mov    #rnnam1    ,r2        ; point to the old name's NAMEBLOCK
  124.     mov    #rnnam2    ,r3        ; point to the new name's NAMEBLOCK
  125.     $set    #fb$fid,FOP,r0        ; set explicit search please
  126.     $search    r0            ; do a directory lookup please
  127.     $compar    #0  ,STS,r0        ; did the lookup work ?
  128.     blt    90$            ; oops, it didn't work
  129.     $fetch    r4  ,RSA,r2        ; get the resultant address
  130.     $store    r4  ,DNA,r1        ; set this as default
  131.     $fetch    r4  ,RSL,r2        ; get the resultant length
  132.     $store    r4  ,DNS,r1        ; set the default length
  133.     $rename    r0,,,r1            ; rename input as output
  134.     $compar    #0  ,sts,r0        ; error?
  135.     blt    90$            ; yes, exit please
  136.     inc    @sp            ; no errors, count that file
  137.     tst    4(r5)            ; should we print the results ?
  138.     bmi    10$            ; no
  139.     call    200$            ; yes
  140.     br    10$            ; go back for more please
  141.  
  142.  
  143. 90$:    mov    @sp    ,r1        ; return # files renamed
  144.     dec    (sp)+            ; did we get any work done ?
  145.     bge    100$            ; yes
  146.     $fetch    r0  ,STS,r0        ; no, get the error code
  147.     cmp    r0    ,#ER$NMF    ; no files, was it NO MORE FILES ?
  148.     bne    110$            ; no
  149.     mov    #ER$FNF    ,r0        ; yes, change it to FILE NOT FOUND
  150.     br    110$            ; and exit
  151.  
  152. 100$:    clr    r0            ; success exit, no errors
  153.  
  154. 110$:    add    #3*100    ,sp        ; pop the buffers
  155.     unsave    <r5,r4,r3,r2>        ; pop registers now
  156.     return
  157.  
  158.  
  159. 200$:    print    #300$
  160.     movb    o$rsl(r2),r0
  161.     print    o$rsa(r2),r0
  162.     print    #310$
  163.     movb    o$esl(r3),r0
  164.     print    o$esa(r3),r0
  165.     print    #320$
  166.     return
  167.  
  168.     .save
  169.     .psect    $PDATA    ,D
  170.     .enabl    lc
  171. 300$:    .asciz    /File /
  172. 310$:    .asciz    / renamed to /
  173. 320$:    .byte    cr,lf,0
  174.     .even
  175.     .restore
  176.     .dsabl    lsb
  177.  
  178.  
  179.  
  180.  
  181.     .sbttl    delete a file(s)
  182.     .enabl    lsb
  183.  
  184. ;    input:    @r5    address of filename spec
  185. ;        2(r5)    if eq -1, don't print the results out
  186. ;                   0, print on terminal
  187. ;                  >0, write to lun in 2(r5)
  188. ;
  189. ;    output:    r0    RMS error code
  190. ;        r1    number of files renamed
  191. ;
  192. ;
  193. ;    internal register usage
  194. ;
  195. ;    r0    RMS error STS
  196. ;    r1    pointer to the FAB for this operation
  197. ;    r2    pointer to the NAM block for this operation
  198. ;    r3    number of files deleted
  199. ;    r5    pointer to the argument list
  200.  
  201.  
  202. delete::save    <r2,r3,r4>        ; save registers we may overwrite
  203.     clr    r3            ; files_deleted := 0
  204.     mov    #rnfab1    ,r1        ; point to the fab we use       ;RBD01--
  205.     tst    fu$def            ; do we need a default device name?
  206.     beq    1$            ; no
  207.     $store    #sydisk ,DNA,r1        ; yes, please stuff the correct defs
  208.     $store    #sylen  ,DNS,r1        ; simple
  209. 1$:    strlen    #defdir            ; anything in the Kermit default dir?
  210.     tst    r0            ; if <> then use it
  211.     beq    5$            ; nothing there to use, use SY:
  212.     $store    #defdir    ,DNA,r1        ; something was there, stuff it in
  213.     $store    r0    ,DNS,r1        ; and the length of the default
  214. 5$:    $store    #lun.sr,LCH,r1        ; a channel number to use for delete
  215.     $off    #fb$fid,FOP,r1        ; we want an implicit $SEARCH
  216.     mov    #rnnam1    ,r2        ; also point to the NAME block
  217.     sub    #200    ,sp        ; allocate result name string
  218.     $store    sp  ,RSA,r2        ; set up the pointer to name string
  219.     $store    #200,RSS,r2        ; and set the size of the string
  220.     sub    #200    ,sp        ; allocate result expanded name string
  221.     $store    sp  ,ESA,r2        ; set up the pointer to expanded name
  222.     $store    #200,ESS,r2        ; and set the size of the string
  223.     $store    #ER$FNM ,STS,r1        ; preset a bad filename error
  224.     strlen    @r5            ; get the length of the filename
  225.     tst    r0            ; anything left at all ?
  226.     beq    90$            ; no, fake a bad filename please
  227.     $store    r0  ,FNS,r1        ; stuff the filename size in please
  228.     $store    @r5 ,FNA,r1        ; stuff the filename address into FAB
  229.     $parse    r1            ; try to parse the filename now
  230.     $compar    #0  ,STS,r1        ; did the parse of the name work ?
  231.     blt    90$            ; no, exit and return STS in r0
  232. 10$:    $erase    r1            ; parse worked, try to delete it
  233.     $compar    #0  ,STS,r1        ; did the erase work out ok ?
  234.     blt    90$            ; no
  235.     inc    r3            ; count the file as being deleted
  236.     call    200$            ; do any echoing now please
  237.     br    10$            ; next please
  238.  
  239. 90$:    $fetch    r0  ,STS,r1        ; get the error code out please
  240.     mov    r3    ,r1        ; return the # of files deleted
  241.     cmp    r0    ,#ER$NMF    ; error is no more files ?
  242.     bne    95$            ; no
  243.     mov    #ER$FNF    ,r0        ; yes, make it into file not found
  244.     tst    r3            ; ever delete any files at all ?
  245.     beq    100$            ; no, leave the error as FNF
  246.     clr    r0            ; yes, at least one file deleted
  247.     br    100$            ; bye
  248. 95$:    tst    r0            ; error code > 0
  249.     bmi    100$            ; no
  250.     clr    r0            ; yes, make the error STS zero then
  251. 100$:    add    #200*2    ,sp        ; pop local buffers please
  252.     unsave    <r4,r3,r2>        ; pop temps and exit
  253.     return
  254.  
  255.  
  256.  
  257.     .sbttl    printing routines for DELETE
  258.  
  259.  
  260.  
  261. 180$:    tst    2(r5)            ; print out an initial header
  262.     beq    190$            ; yes, but to the terminal
  263.     bmi    195$            ; not at all, please
  264.     strlen    #300$            ; no, put it out to disk please
  265.     calls    putrec    ,<#300$,r0,2(r5)>; dump the record to disk
  266.     br    195$            ; and exit
  267. 190$:    print    #300$            ; dump the header to the terminal
  268. 195$:    return                ; bye
  269.  
  270.  
  271. 200$:    cmp    r3    ,#1        ; deleted anything as of yet ?
  272.     bne    210$            ; yes
  273.     call    180$            ; no, dump a header out please
  274. 210$:    clr    r0            ; get set to get the string length
  275.     bisb    o$rsl(r2),r0        ; get the string length
  276.     beq    250$            ; nothing was there to print ?????
  277.     tst    2(r5)            ; echo files deleted to terminal ?
  278.     beq    240$            ; yes, echo to tt:
  279.     bmi    250$            ; no, don't echo at all
  280.     calls    putrec    ,<o$rsa(r2),r0,2(r5)>; echo to a file that's open
  281.     br    250$
  282. 240$:    print    o$rsa(r2),r0        ; print the filename out to tt:
  283.     print    #310$
  284. 250$:    return
  285.  
  286.     .save
  287.     .psect    $PDATA    ,D
  288. 300$:    .asciz    <cr><lf>/Files deleted:/<cr><lf>
  289. 310$:    .byte    cr,lf,0
  290.     .even
  291.     .restore
  292.     .dsabl    lsb
  293.  
  294.  
  295.     .sbttl    get mcr/ccl (rsts) command line and remove task name
  296.  
  297.     .mcall    gmcr$    ,dir$
  298.     .psect    mcrbuf    ,rw,d,lcl,rel,con
  299.  
  300. gmcr:    gmcr$
  301.  
  302.     .psect    $code
  303.  
  304. ;    G M C R
  305. ;
  306. ;    output:    @r5    the command line less the task name, .asciz
  307. ;        r0    the length of whats left
  308. ;            NOTE:     blank insertion ----+             +SSH
  309. ;                              V             +SSH
  310. ;                  @takefil will parse to @ takefile...     +SSH
  311. ;                  which allows KER @TAKEFIL to work.     +SSH
  312.  
  313. getmcr::save    <r1,r2,r3>        ; just for kicks, save these     /SSH
  314.     clr    r3            ; clear the "space flag"     +SSH
  315.     mov    @r5    ,r2        ; point to the resultant command
  316.     clrb    @r2            ; insure .asciz
  317.     dir$    #gmcr            ; get the command line
  318.     movb    @#$dsw    ,r0        ; get the length of it
  319.     ble    90$            ; nothing
  320.     mov    #gmcr+g.mcrb,r1
  321. 10$:    cmpb    @r1    ,#40        ; look for the space delimiting
  322.     beq    20$            ; the task name from the command
  323.     inc    r1            ; line. did not find it, keep looking
  324.     sob    r0    ,10$        ; keep trying
  325.     br    90$            ; nothing
  326. 20$:    inc    r1            ; found the space, skip past it
  327.     dec    r0            ; whats left of it
  328.     ble    90$            ; nothing
  329.     clr    -(sp)            ; a length counter today
  330. 30$:    tst    r3            ; is the space flag set ?     +SSH
  331.     bne    32$            ; yes, go check for " " char     +SSH
  332.     cmpb    (r1),#'@        ; no, check for "@" char     +SSH
  333.     bne    33$            ; no @ char, just continue      +SSH
  334.     inc    r3            ; yes an @, so set space flag     +SSH
  335.     br    33$            ; and continue with copy     +SSH
  336. 32$:    clr    r3            ; clear the space flag         +SSH
  337.     cmpb    (r1),#40        ; char after @ is a space ?     +SSH
  338.     beq    33$            ; yes, continue with copy     +SSH
  339.     movb    #40    ,(r2)+        ; no, insert a space char     +SSH
  340.     inc    @sp            ;     increment count         +SSH
  341. 33$:    movb    (r1)+    ,(r2)+        ; copy next char to buffer
  342.     inc    @sp            ; length := succ( length )
  343.     sob    r0    ,30$        ; next byte please
  344.     mov    (sp)+    ,r0        ; return the command length
  345.     mov    @r5    ,r2        ; restore pointer to the returned string
  346.     calls    cvt$$    ,<r2,r0,#50>    ; remove leading spaces, upper case it
  347.     add    r0    ,r2        ; insure .asciz
  348.     clrb    @r2            ; simple
  349.     br    100$            ; bye
  350.  
  351. 90$:    clr    r0            ; nothing
  352. 100$:    unsave    <r3,r2,r1>        ; pop used registers and exit
  353.     return
  354.  
  355.     .end
  356.