home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / filcpy / rpl.lbr / RPLSUBS.MZC / RPLSUBS.MAC
Text File  |  1987-02-15  |  11KB  |  579 lines
  1.     title    RPLSUB - RPL Subroutines.
  2.     .list
  3.  
  4. ;; RPLSUB -- Assembly language support routines for RPL.
  5. ;  Richard A. Holmes, February 12, 1987.
  6. ;  4845 San Sebastian Avenue
  7. ;  Las Vegas, NV 89121
  8. ;  (702) 458-4933
  9.  
  10. ;; This code has the program's starting point.  It sets the stack
  11. ;  and then calls a FORTRAN main driving routine.  The FORTRAN code
  12. ;  calls several routines included in here:
  13. ;
  14. ;  start        program starting address
  15. ;  endrun        return to CCP
  16. ;  fsize        determine file size.
  17. ;  sfirst        search for first directory entry
  18. ;  strend        output string to console with CRLF.
  19. ;  strout        output string with no CRLF.
  20. ;  opin            open input file
  21. ;  opout        open output file
  22. ;  rsectr        read disk sector from input file
  23. ;  wsectr        write disk sector to output file
  24. ;  clout        close output disk file
  25. ;  error        write error message to console, abort
  26. ;  getusr        get current user number
  27. ;  setusr        set current user number
  28. ;  amb1st        find 1st file with wildcard spec
  29. ;  ambnxt        find next file with wildcard spec
  30. ;  putfil        save a file name
  31. ;  getfil        retrieve a file name
  32. ;  chrout        output one character to the screen
  33. ;  makres        make reserved space file
  34. ;  delres        delete reserved space file
  35. ;  help            show help message
  36.  
  37. cr    set    13
  38. lf    set    10
  39.  
  40. start::
  41.     lxi    h,0
  42.     dad    sp
  43.     shld    savestack
  44.     lxi    sp,stack    ; set our stack pointer
  45.     lxi    h,cuser
  46.     call    getusr
  47.     call    rpl##        ; join main line code
  48.  
  49. ; Endrun.  Terminate execution.
  50. endrun::
  51.     call    delres        ; delete reserved space file
  52.     lxi    h,cuser
  53.     call    setusr
  54. ;;    lhld    savestack
  55. ;;    sphl
  56. ;;    ret
  57.     jp    0
  58.  
  59. savestack: ds    2
  60.  
  61.     page    60
  62.  
  63. ;;    FSIZE - Determine size of file.
  64. ;    Richard A. Holmes, 1983.
  65. ;
  66. ;    This FORTRAN-80 callable function will determine the
  67. ;    number of 128 byte blocks used by a file.
  68. ;
  69. ;        size = fsize(drive,name)
  70. ;
  71. ;    where
  72. ;
  73. ;        FSIZE    (integer)  if = -1, file does not exist
  74. ;                    else, count of 128 byte blocks
  75. ;        DRIVE     (integer)  the drive indicator
  76. ;                    0 = default drive
  77. ;                    1 = A, 2 = B, etc.
  78. ;        NAME     (byte(11)) the file name and extension
  79.  
  80. fszfcb:    ds    36
  81. fszdrv    equ    fszfcb
  82. fsznam    equ    fszfcb+1
  83. fszext    equ    fszfcb+12
  84. fszr0    equ    fszfcb+33
  85. fszr1    equ    fszr0+1
  86. fszr2    equ    fszr1+1
  87. fszlex: ds    1        ; highest extent seen
  88. fszrec:    ds    1        ; record count of highest ext
  89.  
  90. fsize:: call    setup
  91.     mvi    a,'?'
  92.     sta    fszext        ; set extension to ?
  93. ; Set the DMA address to x'80'.
  94.     mvi    c,x'1A'        ; SETDMA command
  95.     lxi    d,x'80'        ; actual address
  96.     call    5        ; do it.
  97.     lxi    d,fszfcb
  98.     mvi    c,35
  99.     call    5
  100. ; Check for maximum size file.
  101.     lxi    h,-1
  102.     lda    fszr2
  103.     ora    a
  104.     rnz
  105. ; Get the high record number from r0 and r1 in the FCB.
  106.     lda    fszr0
  107.     mov    l,a    
  108.     lda    fszr1
  109.     mov    h,a
  110.     ret
  111.  
  112. ; Search for first.
  113. sfirst::
  114.     call    setup
  115.     lxi    d,fszfcb
  116.     mvi    c,x'11'
  117.     call    5
  118.     ret
  119.  
  120. setup:    push    h
  121. ; Initially clear out the FCB.
  122.     lxi    h,fszfcb    ; where to start zeroing
  123.     mvi    c,35        ; length of FCB
  124.     xra    a        ; initialization constant
  125. fsz10:    dcr    c        ; count this byte
  126.     jm    fsz20        ; if all zeroed
  127.     mov    m,a        ; clear a byte
  128.     inx    h        ; move to next byte
  129.     jmp    fsz10        ; look for more
  130. ; Store the file name in the FCB.
  131. fsz20:    mvi    c,11        ; length of file name
  132.     lxi    h,fsznam    ; where to store the name
  133. fsz30:    dcr    c        ; count this byte
  134.     jm    fsz40        ; if all moved
  135.     ldax    d        ; fetch a byte
  136.     mov    m,a        ; stash it
  137.     inx    d        ; adjust source
  138.     inx    h        ; adjust destination
  139.     jmp    fsz30        ; try for another
  140. ; Store the drive code.
  141. fsz40:    pop    h        ; retrieve address of drive code
  142.     mov    a,m        ; fetch drive code
  143.     sta    fszdrv        ; save it in FCB
  144.     ret
  145.  
  146. ;; STROUT - output a string with no trailing characters.
  147.  
  148. strout:: push    h
  149.     pop    d
  150.     mvi    c,9
  151.     jmp    5
  152.  
  153.  
  154. ;; STREND - output a string with a trailing CRLF.
  155.  
  156. strend::
  157.     push    h
  158.     pop    d
  159.     mvi    c,9
  160.     call    5
  161.     mvi    e,13
  162.     mvi    c,6
  163.     call    5
  164.     mvi    e,10
  165.     mvi    c,6
  166.     call    5
  167.     ret
  168.  
  169.     .z80
  170.  
  171. opin::
  172. ; Initialize the input FCB.
  173.     ld    bc,36
  174.     ld    de,infcb
  175.     ld    hl,zerofcb
  176.     ldir                ; initially clear the FCB
  177.     ld    a,(indev)
  178.     ld    (infcb),a        ; set device
  179.     ld    bc,11
  180.     ld    de,infcb+1
  181.     ld    hl,infile
  182.     ldir                ; set file name/extension
  183. ; Now open it
  184.     ld    c,x'0f'
  185.     ld    de,infcb
  186.     call    5
  187.     cp    x'ff'
  188.     ret    nz
  189.  
  190.     ld    hl,noinfile
  191.     call    error
  192.  
  193.  
  194. opout::
  195. ; Initialize the output FCB.
  196.     ld    bc,36
  197.     ld    de,outfcb
  198.     ld    hl,zerofcb
  199.     ldir
  200.     ld    a,(outdev)
  201.     ld    (outfcb),a
  202.     ld    bc,11
  203.     ld    de,outfcb+1
  204.     ld    hl,outfil
  205.     ldir
  206. ; Now open it
  207.     ld    c,x'0f'
  208.     ld    de,outfcb
  209.     call    5            ; do an OPEN
  210. ; If it didn't work, then MAKE it.
  211.     or    a
  212.     ret    p
  213.     ld    c,x'16'
  214.     ld    de,outfcb
  215.     call    5            ; do a MAKE
  216.     or    a
  217.     ret    p
  218.     ld    hl,nodirspace
  219.     call    error
  220.  
  221. nodirspace: db    'No directory space for output file.$'
  222.  
  223. ;; stat = rsectr(bufptr,recnumber)
  224. ;
  225. ;  stat = 0, good read
  226. ;  stat > 0, error
  227. ;  stat < 0, EOF
  228.  
  229. rsectr::
  230.     push    de
  231.     ld    e,(hl)
  232.     inc    hl
  233.     ld    d,(hl)
  234.     ld    hl,sector
  235.     add    hl,de
  236.     push    hl
  237.     pop    de        ; DE = DMA address
  238.     ld    c,x'1a'
  239.     call    5        ; set DMA address
  240.     pop    de
  241.     ld    a,(de)
  242.     ld    (infcb+33),a    ; set record number
  243.     inc    de
  244.     ld    a,(de)        ; set record number (high byte)
  245.     ld    (infcb+34),a
  246.     ld    c,x'21'        
  247.     ld    de,infcb
  248.     call    5        ; issue random read
  249.     or    a
  250.     ret    z        ; if no error condition
  251.     cp    1
  252.     jr    z,rseceof    ; if EOF situation
  253.     cp    4
  254.     jr    z,rseceof    ; if EOF situation
  255.     cp    6
  256.     jr    z,rseceof    ; if EOF situation
  257.     ret
  258.  
  259. rseceof: ld    a,x'80'        ; negative returned value means EOF
  260.     or    a
  261.     ret
  262.  
  263. noinfile:  db    'The input file does not exist.$'
  264.  
  265. ;; stat = wsectr(bufptr,recnumber)
  266. ;
  267. ;  stat = 0, good write
  268. ;  stat > 0, error
  269.  
  270. wsectr::
  271.     push    de
  272.     ld    e,(hl)
  273.     inc    hl
  274.     ld    d,(hl)
  275.     ld    hl,sector
  276.     add    hl,de
  277.     push    hl
  278.     pop    de
  279.     ld    c,x'1a'
  280.     call    5        ; set DMA address
  281.     pop    de
  282.     ld    a,(de)
  283.     ld    (outfcb+33),a    ; set record number
  284.     inc    de
  285.     ld    a,(de)        ; set record number (high byte)
  286.     ld    (outfcb+34),a
  287.     ld    c,x'22'        
  288.     ld    de,outfcb
  289.     call    5        ; issue random write
  290.     or    a
  291.     ret            ; if no error condition
  292.  
  293. clout::    ld    de,outfcb
  294.     ld    c,x'10'
  295.     call    5
  296.     ret
  297.  
  298. ;; ERROR - put out an error message.  Terminate.
  299.  
  300. error::    push    hl
  301.     ld    hl,dollar
  302.     call    strend        ; force beginning of new line
  303.     pop    hl
  304.     call    strend        ; show provided error message
  305.     ld    e,7        ; ring the bell
  306.     ld    c,x'06'
  307.     call    5        ; console output character
  308.     call    delres        ; make sure there is no reserved space file
  309.     ld    hl,cuser
  310.     call    setusr
  311.     ld    c,x'00'
  312.     jp    5        ; do a SYSTEM RESET
  313.  
  314. dollar:    db    '$'
  315.  
  316. ;; SETUSR - set user number.
  317.  
  318. setusr::
  319.     ld    e,(hl)        ; fetch user number
  320.     ld    c,x'20'        ; set function code
  321.     call    5
  322.     ret
  323.  
  324. ;; GETUSR - get current user number.
  325.  
  326. getusr::
  327.     push    hl
  328.     ld    e,x'ff'
  329.     ld    c,x'20'
  330.     call    5
  331.     pop    hl
  332.     ld    (hl),a
  333.     ret
  334.  
  335.  
  336. ;; GETDEV - get current device (default disk drive)
  337.  
  338. getdev::
  339.     push    hl
  340.     ld    c,x'19'
  341.     call    5
  342.     pop    hl
  343.     inc    a
  344.     ld    (hl),a
  345.     ret
  346.  
  347.  
  348. ;; AMB1ST - Get first file using ambiguous file spec.
  349.  
  350. amb1st::
  351.     push    hl
  352.     pop    de
  353.     ld    c,x'11'
  354.     call    5        ; issue search for first
  355.     ret
  356.  
  357. ;; AMBNXT - Get next file using ambiguous file spec.
  358.  
  359. ambnxt::
  360.     push    hl
  361.     pop    de
  362.     ld    c,x'12'
  363.     call    5        ; issue search for next
  364.     ret
  365.  
  366. ;; PUTFIL - Put next file name in list.
  367.  
  368. putfil::
  369.     ld    bc,11
  370.     push    hl
  371.     ld    hl,(pptr)
  372.     ex    de,hl
  373.     pop    hl
  374.     ldir
  375.     ld    hl,(pptr)
  376.     ld    de,11
  377.     add    hl,de
  378.     ld    (hl),0
  379.     ld    (pptr),hl
  380.     ret
  381.  
  382. pptr:    dw    fnames    ; put name pointer
  383.  
  384. getfil::
  385.     ld    bc,11
  386.     push    hl
  387.     pop    de
  388.     ld    hl,(gptr)
  389.     ldir
  390.     ld    hl,(gptr)
  391.     ld    de,11
  392.     add    hl,de
  393.     ld    (gptr),hl
  394.     ret
  395.  
  396. gptr:    dw    fnames
  397.  
  398. ;; CHROUT - output a character to the console.
  399. ;
  400. ;    call chrout(char)
  401.  
  402. chrout::
  403.     ld    e,(hl)
  404.     ld    c,x'06'
  405.     jp    5
  406.  
  407. ;; MAKRES - make reserved space file.
  408. ;
  409. ;    call makres(amount)        (integer K amount)
  410.  
  411. makres::
  412.     push    hl
  413.     ld    hl,user0
  414.     call    setusr            ; work with user zero
  415.     ld    a,(outdev)
  416.     ld    (xxresfcb),a
  417.     ld    de,x'80'
  418.     ld    c,x'1a'            ; set DMA
  419.     call    5
  420.     call    setresfcb
  421.     ld    de,resfcb
  422.     ld    c,x'13'            ; DELETE function
  423.     call    5
  424.     call    setresfcb
  425.     ld    de,resfcb
  426.     ld    c,x'16'            ; MAKE function
  427.     call    5
  428.     or    a
  429.     jp    m,makopnerr    
  430.     pop    hl
  431.     ld    a,(hl)            ; fetch K count
  432.     and    x'1F'            ; don't allow wraparound
  433.     rla                 ; * 2
  434.     rla                 ; * 4
  435.     rla                 ; * 8 = number of sectors to write
  436.     push    af
  437. makr10:    pop    af
  438.     dec    a
  439.     jp     m,makxit        ; if no more to write
  440.     push    af
  441.     ld    de,resfcb
  442.     ld    c,x'15'            ; WRITE SEQUENTIAL
  443.     call    5
  444.     or    a
  445.     jr    nz,makerr        ; if not good write
  446.     jp    makr10            ; try again    
  447.  
  448. makxit:    ld    de,resfcb
  449.     ld    c,x'10'            ; CLOSE
  450.     call    5
  451.     ret
  452.  
  453. makerr:    pop    af
  454.     ld    hl,makerrmsg
  455.     call    error
  456.  
  457. makopnerr:
  458.     ld    hl,opnerrmsg
  459.     call    error
  460.  
  461. makerrmsg: db    'Error in reserving space.  Disk is full.$'
  462. opnerrmsg: db    'Error in reserving space.  Directory is full.$'
  463.  
  464. ;; DELRES - Delete reserved space file.
  465. ;
  466. ;    call delres
  467.  
  468. delres::
  469.     ld    hl,user0
  470.     call    setusr
  471.     call    setresfcb
  472.     ld    de,resfcb
  473.     ld    c,x'13'
  474.     call    5
  475.     ret
  476.  
  477. ;; SETRESFCB - Setup reserve space file block.
  478.  
  479. setresfcb:
  480.     ld    de,resfcb
  481.     ld    hl,xxresfcb
  482.     ld    bc,36
  483.     ldir
  484.     ret
  485.  
  486.  
  487. ;; HELP - Show help message.
  488. ;
  489. ;       call help
  490. ;
  491. ;  Note direct console output on a character by character basis
  492. ;  is used because there are dollar signs in the text.
  493.  
  494. help::    ld    hl,helpmsg
  495. help05:    ld    a,(hl)
  496.     or    a
  497.     ret    z            ; if end of message
  498.     push    hl
  499.     ld    e,a
  500.     ld    c,6
  501.     call    5            ; direct console output
  502.     pop    hl
  503.     inc    hl
  504.     jr    help05
  505.  
  506. helpmsg:
  507.     db    cr,lf
  508.  db ' Function:   RPL is used to copy disk files.  It reserves space'
  509.  db            ' at the ',cr,lf
  510.  db '             beginning of the disk and rewrites in place when'
  511.  db            ' possible.',cr,lf
  512.  db '             It accepts user numbers and wildcards.',cr,lf,lf
  513.  db ' Usage:      RPL destination=source $nnk',cr,lf,lf
  514.  db '      where:     destination   specifies where to copy to',cr,lf
  515.  db '                      source   specifies where to copy from',cr,lf 
  516.  db '                        $nnK   specifies amount of reserved space'
  517.  db cr,lf
  518.  db '                                   (if omitted, 4K is reserved)'
  519.  db cr,lf,lf
  520.  db ' Examples:',cr,lf,lf
  521.  db '    A> RPL X.OUT=Y.IN      copies Y.IN to X.OUT',cr,lf
  522.  db '    A> RPL E7:=A:SOURCE    copies SOURCE on A: to SOURCE in'
  523.  db                             ' user 7 of E:',cr,lf
  524.  db '    A> RPL E3:=7:*.* $10K  copies all files in user 7 of the'
  525.  db                 ' default drive',cr,lf
  526.  db '                             to user 3 of drive E: after first'
  527.  db                 ' reserving',cr,lf
  528.  db '                             10K of disk space'  
  529.  db cr,lf
  530. lenhelp equ $-helpmsg
  531.  
  532. resfcb:    db    0,'RESERVE!$$$'
  533.     db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  534.  
  535. xxresfcb: db    0,'RESERVE!$$$'
  536.     db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  537.  
  538. user0:    db    0        ; to select user zero
  539.  
  540. zerofcb: db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  541.     db    0,0,0,0,0,0,0,0,0,0,0
  542.  
  543. infcb:    ds    36
  544. outfcb: ds    36
  545.  
  546. nfnames:db    0
  547. ambig:    db    0        ; non-zero if ambiguous name
  548. maxfiles equ    255
  549.  
  550. ;; SECTOR, STACK and FNAMES must be the very last things allocated in memory.
  551. ;  This is the case when using L80 or SLRNK+ .
  552.     
  553. sector::    ds    1        ; beginning of disk sector buffer
  554. endsect    equ    sector+12800        ; allow 100 sector buffer area
  555. stack    equ    endsect+600
  556. fnames    equ    stack+2
  557.     entry    highaddr
  558. highaddr equ    fnames
  559.  
  560. ;; The following common blocks must have been previously allocated by another
  561. ;  module already loaded.  This is the case with the FORTRAN routines.
  562.  
  563.     common    /in/
  564. infile:    ds    11
  565. indev:    ds    1
  566. inunit:    ds    1
  567.  
  568.     common    /out/
  569. outfil:    ds    11
  570. outdev:    ds    1
  571. outunt:    ds    1
  572.  
  573.     common  /user/
  574. iuser:    ds    1
  575. ouser:    ds    1
  576. cuser:    ds    1
  577.  
  578.     end    start
  579.