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