home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol135 / lock.wpf < prev    next >
Encoding:
Text File  |  1984-04-29  |  10.9 KB  |  664 lines
  1. ;LOCK - Give "lock (filename or match) (keyword)"
  2.  
  3. base equ 0
  4. dmad1 equ base+80h
  5. fcb1 equ base+5ch
  6. ftp equ 9 ;file type increment
  7. fex equ 12
  8. fss equ 13
  9. frc equ 15
  10. fdd equ 16
  11. fcr equ 32
  12. frr equ 33
  13. secmax equ 32 ;8k buf, read and write interleaved
  14.  
  15. dfldrv:: db 0 ;keeps default drive
  16. stackp:: dw 0 ;keeps stack ptr
  17. secct:: db 0 ;sector ct, read
  18. csecct:: db 0 ;ditto code
  19. rdma:: dw 0 ;running dma
  20. pj1fl:: db 1 ;page 1 to be written
  21. attrb:: db 0 ;keeps r/o attribute byte
  22. nunqfl:: db 0 ;indic file spec not unique
  23. tmpex:: db 'TMP'
  24. prltyp:: db 'PRL'
  25. dirpt:: dw 0 ;directory ptr
  26. fcb2:: ds 36
  27. fcb3:: ds 36
  28.  
  29. start:: ld (stackp),sp
  30.  ld sp,stac0
  31.  ld c,19h
  32.  call base+5
  33.  ld (dfldrv),a ;keep default drive
  34.  call paschc ;ret z if no keyword
  35.  jp z,nopsds
  36.  call pascod ;code keyword, ret c if invalid
  37.  jp c,invdis
  38.  call dmshmk ;make 1 rec of coded mush and
  39.   ;write part over keyword
  40.  call nunqst ;set nunqfl nz if fcb1 has qmks
  41.  call makdir ;make directory of matched files
  42.   ;ret z if none, c if more than 32
  43.  jp z,nofdis
  44.  call c,toodis
  45.  ld hl,0
  46.  ld (dirpt),hl ;zero directory ptr
  47. codlp:: call getdir ;dir adr of next file to fcb2
  48.   ;ret z if no more, c if file empty
  49.  jr z,reb
  50.  call c,empdis ;also preserves c flag
  51.  call nc,codit ;read buf full, code, write,
  52.   ;del original, rename, msg
  53.   ;msg and reb if no dir space
  54.   ;msg and reb if ctrl c
  55. jr codlp
  56.  
  57. reb:: ld a,(dfldrv)
  58.  ld e,a
  59.  ld c,0eh
  60.  call base+5 ;reset default drive
  61.  ld sp,(stackp)
  62.  jp base
  63.  
  64.  ;sr make directory of files matching fcb1
  65. makdir:: ld hl,fcb1+fex
  66.  ld b,3
  67. mdr2:: ld (hl),0
  68.  djnz mdr2 ;zero ex and ss bytes
  69.  ld de,fcb1
  70.  ld c,11h
  71.  call base+5 ;search for first
  72.  cp 0ffh
  73.  ret z
  74. mdr3:: and 3
  75.  rrca
  76.  rrca
  77.  rrca
  78.  ld hl,dmad1
  79.  ld c,a
  80.  ld b,0
  81.  add hl,bc ;dir entry
  82.  ex de,hl
  83.  ld hl,(dirpt) ;local dir ptr
  84.  ld a,h
  85.  sub 4
  86.  ccf
  87.  ret c ;if too many matcxhing files
  88.  ld bc,dirbuf
  89.  add hl,bc
  90.  ex de,hl ;ptrs for block load
  91.  ld bc,32
  92.  ldir ;transcribe to local dir
  93.  ld hl,(dirpt) ;will update ptr ctr
  94.  ld de,32
  95.  add hl,de
  96.  ld (dirpt),hl
  97.  ld de,fcb1
  98.  ld c,12h
  99.  call base+5 ;search for next
  100.  cp 0ffh
  101.  jr nz,mdr3
  102.  xor a
  103.  inc a ;nz and nc flags if finished
  104.  ret
  105.  
  106.  ;sr get dir adr of next file to fcb2
  107.  ;ret z if no more, ret c if file empty
  108. getdir:: ld hl,(dirpt)
  109.  ld a,h
  110.  sub 4
  111.  ret z ;if no more
  112.  push hl
  113.  ld de,32
  114.  add hl,de
  115.  ld (dirpt),hl ;for next time
  116.  pop hl
  117.  ld de,dirbuf
  118.  add hl,de
  119.  push hl
  120.  pop ix
  121.  inc hl ;ptr to filename
  122.  ld a,(hl)
  123.  or a
  124.  ret z ;if no more files
  125.  ld a,(fcb1) ;drive
  126.  ld de,fcb2
  127.  ld (de),a ;same dr in fcb2
  128.  inc de
  129.  ld bc,11
  130.  ldir ;transcribe name, type
  131.  ld hl,0
  132.  ld (fcb2+fex),hl
  133.  ld (fcb2+fss),hl ;zero ex and ss bytes
  134.  ld a,(ix+15)
  135.  or a
  136.  jr nz,gdr2
  137.  scf ;to indicate empty
  138. gdr2:: inc c ;set nz flag
  139.  ret
  140.  
  141.  ;sr read buf, code, write, delete orig,
  142.  ;rename, msg
  143.  ;msg and reb if no dir space
  144.  ;msg and reb if ctrl c
  145. codit:: call atrchc ;ret nz if sys, or keep r/o byte
  146.  jp nz,sysdis ;msg and ret from codit
  147.  call wfmk ;make write fcb3 and make file
  148.   ;includes delete
  149.   ;ret z if no dir space
  150.  jp z,noddis
  151.  call mushtr ;transcribe mush
  152.  call open ;open read fcb2
  153.  xor a
  154.  ld (fcb2+fcr),a
  155.  ld (fcb3+fcr),a
  156.  ld a,1
  157.  ld (pj1fl),a ;page 1 to be written
  158. cdtlp:: call rdbuf ;read to buf, ret nz if passed eof
  159.   ;ctrl c checks
  160.  ex af,af'
  161.  ld a,(secct)
  162.  or a
  163.  jr z,cdt2
  164.  call codbuf ;code buffer
  165.  call wrbuf ;write buffer, reb if disk full
  166.   ;ctrl c checks
  167.  ex af,af'
  168.  jr z,cdtlp
  169. cdt2:: call eschc ;ret z if ctrl c
  170.  jr z,escout
  171.  call close ;close write file fcb3
  172.  ld de,fcb2
  173.  call delete ;delete original
  174.  call ren ;rename fcb3 file as fcb2
  175.   ;also turns prl to lrl
  176.  call dondis ;'File (name) locked', omit
  177.   ;name if unique
  178.  ret
  179.  
  180.  ;sr ret z if ctrl c inp
  181. eschc:: ld e,0ffh
  182.  ld c,6
  183.  call base+5
  184.  cp 3
  185.  ret
  186.  
  187. escout:: ld de,fcb3
  188.  call delete
  189.  jp abdis ;'Aborted'
  190.  
  191.  ;sr ret z if no keyword
  192. paschc:: ld a,(fcb1+fdd+1) ;keyword
  193.  cp 20h
  194.  ret
  195.  
  196.  ;sr code keyword, ret c if invalid
  197. pascod:: ld ix,fcb1+fdd+1 ;keyword
  198.  ld de,4 ;arb start pt
  199.  ld b,8 ;ct
  200. plp:: ld hl,pag1+50h ;res to be put here
  201.  add hl,de
  202.  ld a,(ix)
  203.  call chcvld ;ret nc if valid char
  204.  ret c
  205.  add a,(hl)
  206.  ld c,a
  207.  and 55h
  208.  rlca
  209.  xor c
  210.  ld (hl),a
  211.  inc ix
  212.  ld a,e
  213.  add a,3
  214.  and 7 ;col incr for ptr
  215.  ld e,a
  216.  djnz plp
  217.  or a ;clear carry
  218.  ret
  219.  
  220.  ;sr ret c if invalid keyword char
  221. chcvld:: cp ' '
  222.  ret z
  223.  cp '/'
  224.  ret c
  225.  cp ':'
  226.  jr c,chc2
  227.  cp '@'
  228.  ret c
  229.  cp '['
  230. chc2:: ccf
  231.  ret
  232.  
  233.  ;sr make 128 bytes of mush and
  234.  ;write part over keyword
  235. dmshmk:: ld c,51 ;arb start pt
  236.  ld b,80h ;length
  237. mlp:: ld hl,pag1+80h
  238.  ld a,c
  239.  add a,l
  240.  ld l,a
  241.  jr nc,mlp2
  242.  inc h
  243. mlp2:: ld ix,pag1+50h ;mush at keyword addr
  244.  ld a,b ;use b value for keyword ptr
  245.  and 7
  246.  ld e,a
  247.  ld d,0
  248.  add ix,de
  249.  ld a,(ix)
  250.  add a,(hl)
  251.  ld e,a
  252.  and 0aah
  253.  rra
  254.  xor e
  255.  ld (hl),a
  256.  ld a,c
  257.  add a,23 ;col incr
  258.  and 7fh
  259.  ld c,a
  260.  djnz mlp
  261.  ld ix,pag1+50h ;will write some over keyword
  262.  ld de,4
  263.  ld b,30h
  264. putlp:: ld hl,pag1+80h
  265.  add hl,de
  266.  ld a,(hl)
  267.  ld (ix),a
  268.  inc ix
  269.  ld a,e
  270.  add a,15
  271.  and 7fh
  272.  ld e,a
  273.  djnz putlp
  274.  ld l,18h ;='jr'
  275.  ld h,122h-175h
  276.  ld (pag1+73h),hl
  277.  ret
  278.  
  279.  ;sr set nunqfl if fcb1 has qmks
  280. nunqst:: ld hl,fcb1+1
  281.  ld a,'?'
  282.  ld b,11
  283. tunqlp:: cp (hl)
  284.  jr z,tunqot
  285.  inc hl
  286.  djnz tunqlp
  287.  xor a
  288. tunqot:: ld (nunqfl),a
  289.  ret
  290.  
  291.  ;sr check file attributes, store r/o byte
  292.  ;ret nz if sys
  293. atrchc:: ld hl,fcb2+ftp
  294.  ld a,(hl)
  295.  ld (attrb),a
  296. atr2:: inc hl
  297.  bit 7,(hl)
  298.  ret
  299.  
  300.  ;sr make write fcb3 and make file
  301.  ;ret z if no dir space
  302. wfmk:: ld hl,fcb2
  303.  ld de,fcb3
  304.  ld bc,9
  305.  ldir ;dr and filename
  306.  ld hl,tmpex
  307.  ld bc,3
  308.  ldir ;'TMP' extension
  309.  ld b,3
  310.  ex de,hl
  311. wfm2:: ld (hl),0
  312.  inc hl
  313.  djnz wfm2 ;zero ex and ss bytes
  314.  ld de,fcb3
  315.  call delete ;del any equiv file
  316.  ld de,fcb3
  317.  ld c,16h
  318.  call base+5 ;make file
  319.  inc a
  320.  ret
  321.  
  322.  ;sr delete (de) file
  323. delete:: ld c,13h
  324.  call base+5
  325.  ret
  326.  
  327.  ;sr transcribe dmush
  328. mushtr:: ld hl,pag1+80h
  329.  ld de,upmush
  330.  ld bc,80h
  331.  ldir
  332.  ret
  333.  
  334.  ;sr open read fcb2
  335. open:: ld de,fcb2
  336.  ld c,0fh
  337.  call base+5
  338.  ret
  339.  
  340.  ;sr read to buf, ret nz if eof before end, ctrl c checks
  341. rdbuf:: ld de,buf0
  342.  xor a
  343.  ld (secct),a
  344. rdlp:: ld (rdma),de
  345.  call rdsec ;read 1 sector, ret nz if passed eof
  346.   ;ctrl c check
  347.  ret nz ;if passed eof
  348.  ld hl,secct
  349.  inc (hl)
  350.  ld a,secmax
  351.  cp (hl)
  352.  ret z ;if end of buf
  353.  ld de,(rdma)
  354.  inc d
  355.  jr rdlp
  356.  
  357.  ;sr read sector to (de), ret nz if eof
  358.  ;ctrl c check
  359. rdsec:: ld c,1ah
  360.  call base+5 ;set dma
  361.  call eschc
  362.  jp z,escout
  363.  ld de,fcb2
  364.  ld c,14h
  365.  call base+5 ;read sequential
  366.  or a
  367.  ret ;nz if eof
  368.  
  369.  ;sr code buffer
  370. codbuf:: xor a
  371.  ld (csecct),a
  372.  ld de,buf0 ;rrec start
  373.  ld ix,buf0+80h ;wrec start
  374. cblp:: call cdr ;code data record
  375.  ex de,hl
  376.  ld de,80h
  377.  add hl,de
  378.  add ix,de ;next wrec
  379.  ex de,hl ;next rrec in de
  380.  ld hl,csecct
  381.  inc (hl)
  382.  ld a,(secct)
  383.  sub (hl)
  384.  jr nz,cblp
  385.  ret
  386.  
  387.  ;sr code data record, rrec de, wrec ix
  388. cdr:: ld hl,upmush
  389.  ld b,80h
  390. cdlp:: ld a,(de)
  391.  add a,(hl)
  392.  ld c,a
  393.  and 55h
  394.  rlca
  395.  xor c
  396.  ld (hl),a
  397.  ld (ix),a
  398.  inc hl
  399.  inc de
  400.  inc ix
  401.  djnz cdlp
  402.  ret
  403.  
  404.  ;sr write buffer, ret z if disk full
  405. wrbuf:: ld hl,pj1fl ;need to write page 1?
  406.  ld a,(hl)
  407.  ld (hl),0 ;zero the flag
  408.  or a
  409.  jr z,wrb2 ;skip if it was zero
  410.  ld de,pag1
  411.  call wrsec ;write record, ret nz if disk full
  412.   ;ctrl c check
  413.  jp nz,stflds
  414.  ld de,pag1+80h
  415.  call wrsec
  416.  jp nz,stflds
  417. wrb2:: ld de,buf0+80h ;initial dma in de
  418. wblp:: ld (rdma),de
  419.  call wrsec
  420.  jp nz,stflds
  421.  ld de,(rdma)
  422.  inc d
  423.  ld hl,secct
  424.  dec (hl)
  425.  jr nz,wblp
  426.  ret
  427.  
  428.  ;sr write record from (de), ret nz if disk full
  429.  ;ctrl c check
  430. wrsec:: ld c,1ah
  431.  call base+5 ;set dma
  432.  call eschc
  433.  jp z,escout
  434.  ld de,fcb3
  435.  ld c,15h
  436.  call base+5 ;write sequential
  437.  or a
  438.  ret
  439.  
  440.  ;sr close file
  441. close:: ld de,fcb3
  442.  ld c,10h
  443.  call base+5
  444.  ret
  445.  
  446.  ;sr rename write file as read file
  447.  ;.prl becomes .lrl
  448. ren:: call prllrl ;rename prl file as lrl
  449.  ld de,fcb2
  450.  call delete
  451.  ld hl,fcb2
  452.  ld de,fcb3+16
  453.  ld bc,16
  454.  ldir
  455.  ld hl,fcb3+ftp
  456.  ld a,(attrb)
  457.  and 80h
  458.  ld b,a
  459.  ld a,(hl)
  460.  and 7fh
  461.  or b
  462.  ld (hl),a ;to ensure r/o byte is kept
  463.  ld de,fcb3
  464.  ld c,17h
  465.  call base+5
  466.  ret
  467.  
  468.  ;sr rename prl file as lrl
  469. prllrl:: ld de,fcb2+ftp
  470.  ld hl,prltyp
  471.  ld b,3
  472. prl2:: ld a,(de)
  473.  and 7fh
  474.  cp (hl)
  475.  ret nz
  476.  inc hl
  477.  inc de
  478.  djnz prl2
  479.  ex de,hl
  480.  dec hl
  481.  dec hl
  482.  dec hl
  483.  ld (hl),'L'
  484.  ret
  485.  
  486. nopsds:: ld de,nopmsg
  487.  jp streb
  488. nopmsg:: db 'A valid keyword must be specified'
  489.  db 0dh,0ah,'$'
  490.  
  491. invdis:: ld de,invmsg
  492.  jp streb
  493. invmsg:: db 'Invalid keyword',0dh,0ah,'$'
  494.  
  495. nofdis:: ld de,nofmsg
  496.  jp streb
  497. nofmsg:: db 'No file',0dh,0ah,'$'
  498.  
  499. toodis:: ld de,toomsg
  500.  jp string
  501. toomsg:: db 'Limit of 32 matching files'
  502.  db 0dh,0ah,'$'
  503.  
  504. sysdis:: ld de,sysms1
  505.  call string
  506.  call namif
  507.  ld de,sysms2
  508.  jp string ;ret from codit sr when done
  509. sysms1:: db 'File $'
  510. sysms2:: db 'has system attribute',0dh,0ah,'$'
  511.  
  512. empdis:: push af ;keep c flag
  513.  ld de,empms1
  514.  call string
  515.  call namif
  516. empds2:: ld de,empms2
  517.  call string
  518.  pop af ;restore c flag
  519.  ret
  520. empms1 equ sysms1
  521. empms2:: db 'empty',0dh,0ah,'$'
  522.  
  523. noddis:: ld de,nodmsg
  524.  jp streb
  525. nodmsg:: db 'No directory space for operation'
  526.  db 0dh,0ah,'$'
  527.  
  528. dondis:: ld de,donms1
  529.  call string
  530.  call namif
  531.  ld de,donms2
  532.  jp string
  533. donms1 equ sysms1
  534. donms2:: db 'locked',0dh,0ah,'$'
  535.  
  536. abdis:: ld de,abmsg
  537.  jp streb
  538. abmsg:: db '------------Aborted',0dh,0ah,'$'
  539.  
  540. stflds:: ld de,fcb3
  541.  call delete
  542.  ld de,stflms
  543.  jp streb
  544. stflms:: db 'Disk full - aborting',0dh,0ah,'$'
  545.  
  546. string:: ld c,9
  547.  call base+5
  548.  ret
  549.  
  550. streb:: call string
  551.  jp reb
  552.  
  553. namif:: ld a,(nunqfl)
  554.  or a
  555.  ret z
  556.  ld hl,fcb2
  557.  ld a,(hl)
  558.  or a
  559.  jr z,namf2
  560.  add a,40h
  561.  call disp
  562.  ld a,':'
  563.  call disp
  564. namf2:: inc hl
  565.  ld b,8
  566. nlp:: ld a,(hl)
  567.  cp 20h
  568.  jr z,namf3
  569.  call disp
  570.  inc hl
  571.  djnz nlp
  572. namf3:: ld a,'.'
  573.  call disp
  574.  ld hl,fcb2+ftp
  575.  ld b,3
  576. nlp2:: ld a,(hl)
  577.  cp 20h
  578.  jr z,namf4
  579.  call disp
  580.  inc hl
  581.  djnz nlp2
  582. namf4:: ld a,20h
  583.  jp disp
  584.  
  585. disp:: push bc
  586.  push de
  587.  push hl
  588.  ld e,a
  589.  ld c,2
  590.  call base+5
  591.  pop hl
  592.  pop de
  593.  pop bc
  594.  ret
  595.  
  596. pag1:: .phase base+100h
  597.  
  598.  db 0dh,0ah,'==<Locked file>== ',0dh,0ah,1ah
  599.   ;as a seq of instns, this gives a jump either to
  600.   ;122h or to 173h
  601.  
  602. fill:: ds base+122h-fill ;foll instn shd be 122h
  603.   ;173h will be set to jr 122h later
  604.  
  605. sendms:: ld hl,base+100h
  606.  ld a,(hl)
  607.  cp 1ah
  608.  jp z,base
  609.  push bc
  610.  push de
  611.  push hl
  612.  ld e,a
  613.  ld c,2
  614.  call base+5
  615.  pop hl
  616.  pop de
  617.  pop bc
  618.  inc hl
  619.  jr sendms+3
  620.  
  621.   ;next byte 13ah
  622.  db 0f5h,79h,10h,0afh,23h,09h
  623.  db 51h,00h,19h,71h,0d9h,6fh,0b8h,0b6h
  624.  db 70h,26h,0a6h,63h,51h,03h,44h,20h
  625.  
  626. nmush:: db 57h,7eh,0c5h,14h,8fh,47h,0c1h,27h ;adr 150h
  627.  db 0feh,0eeh,9fh,0edh,09h,0a9h,33h,76h
  628.  db 0e2h,11h,72h,0d7h,0e3h,5dh,74h,66h
  629.  db 66h,39h,0fh,2dh,15h,34h,0ch,81h
  630.  db 25h,61h,33h,09h,12h,3eh,4eh,37h
  631.  db 96h,0b0h,0ebh,41h,89h,0a0h,24h,78h
  632.  
  633. dmush:: db 48h,0e0h,23h,0afh,2ah,77h,0f6h,86h ;adr 180h
  634.  db 0c3h,3ah,0d8h,7eh,5bh,7fh,0c1h,0eh
  635.  db 57h,0f8h,30h,26h,11h,0fh,2eh,0d8h
  636.  db 08h,6dh,0bah,7fh,8ch,0cch,90h,4ah
  637.  
  638.  db 95h,0a5h,0e4h,9fh,76h,5fh,0e0h,01h
  639.  db 1fh,22h,9ah,77h,3ch,5dh,0a0h,0a7h
  640.  db 75h,0a7h,0cfh,76h,0ach,40h,6fh,0aah
  641.  db 3eh,79h,56h,5eh,69h,77h,3ah,64h
  642.  
  643.  db 3eh,56h,53h,4dh,01h,29h,47h,0b2h
  644.  db 61h,85h,6ch,4ah,0a9h,0a2h,0d8h,0f3h
  645.  db 9fh,4fh,0bah,32h,0c2h,43h,4dh,31h
  646.  db 8ch,0ach,09h,58h,5ah,0fh,75h,0f7h
  647.  
  648.  db 0aah,73h,0a5h,9dh,0f3h,2dh,0beh,58h
  649.  db 03h,4ah,0d9h,21h,30h,4eh,0d7h,75h
  650.  db 0a8h,98h,82h,02h,41h,9ch,02h,0eh
  651.  db 0c4h,61h,63h,61h,10h,0a2h,42h,48h
  652.  
  653.  .dephase
  654.  
  655. ;WILL LATER INSERT MESSUP SECN HERE
  656.  
  657. upmush:: ds 80h ;to transcribe mush for updating
  658. dirbuf:: ds 1024 ;directory of matched files
  659.  ds 20h ;for stack
  660. stac0::
  661. buf0:: ds 8192 ;file buffer
  662.  
  663.  end start
  664.