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