[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/19/99 01:07:04 PURGE - LS-DOS 6.3 Page 00001
00001 ;LBPURGE/ASM - PURGE Command
00003 ;
000A 00004 LF EQU 10
000D 00005 CR EQU 13
002C 00006 PAR_ERR EQU 44 ;Parameter Error
42E0 00007 PASSWORD EQU 42E0H
00008 ;
0000 00009 *GET BUILDVER/ASM:3
00010 ;
00011 ; Buildver/asm is a bit of a kludge since not all utilities can load
00012 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00013 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00014 ; for programs that can use that.
00015 ;
FFFF 00016 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00017 ; These switches activate patches made since the 1B release.
00018 ; It is important that all earlier patches be enabled when a higher
00019 ; patch is enabled.
00020 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00021 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00022 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00023 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00024 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00025 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00026 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00027 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00028 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00029 ;
00030 ;End of BUILDVER/ASM
0000 00031 *GET SVCMAC:3 ;SVC Macro equivalents
00032 ;SVCMAC/ASM - LS-DOS Version VI
00033 *LIST OFF
00425 *LIST ON
00427 ;
2400 00428 ORG 2400H
00429 ;
2400 00430 PURGE @@CKBRKC ;Break key down?
2400+3E6A 00431 LD A,106
2402+EF 00432 RST 40
2403 2804 00433 JR Z,BEGINA ;Ok if not
2405 21FFFF 00434 LD HL,-1 ; else abort
2408 C9 00435 RET
00436 ;
2409 ED737428 00437 BEGINA LD (SAVESP+1),SP ;Save stack pointer
240D E5 00438 PUSH HL ;Save cmdline ptr
240E 00439 @@FLAGS
240E+3E65 00440 LD A,101
2410+EF 00441 RST 40
2411 FDE5 00442 PUSH IY
2413 D1 00443 POP DE ;Flag base to DE
2414 211800 00444 LD HL,'Y'-'A' ;Year type flag
2417 19 00445 ADD HL,DE
2418 22B627 00446 LD (YFLAG1),HL
241B 223E26 00447 LD (YFLAG2),HL ;Save for date dsply
241E E1 00448 POP HL ;Restore cmdline ptr
241F 7E 00449 PURGE1 LD A,(HL) ;Bypass cmd line blanks
2420 23 00450 INC HL
2421 FE20 00451 CP ' '
2423 28FA 00452 JR Z,PURGE1
2425 113929 00453 LD DE,BLANKS ;Pt to filespec area
2428 0608 00454 LD B,8 ;Init for file name
242A FE2D 00455 CP '-' ;If -, set up flag
242C 2005 00456 JR NZ,PUR0
242E 326C25 00457 LD (MFLG+1),A
2431 7E 00458 LD A,(HL)
2432 23 00459 INC HL
2433 CD7927 00460 PUR0 CALL PRSPEC
2436 FE2E 00461 CP '.' ;Also as extent
2438 2804 00462 JR Z,PUR1A
243A FE2F 00463 CP '/' ;Ck on file EXT entered
243C 200A 00464 JR NZ,PUR1 ;Jump if no extension
243E 114129 00465 PUR1A LD DE,BLANKS+8 ;Point to ext field
2441 0603 00466 LD B,3 ;Max 3 chars
2443 7E 00467 LD A,(HL)
2444 23 00468 INC HL
2445 CD7927 00469 CALL PRSPEC ;Ck on EXT
2448 FE3A 00470 PUR1 CP ':' ;Drive entered?
244A 0E00 00471 LD C,0 ;Init to drive 0
244C 2032 00472 JR NZ,PRMERRA ;Quit if no drive #
244E 7E 00473 LD A,(HL) ;P/u drive #
244F 23 00474 INC HL ;Bump to next field
00475 IF @BLD631
2450 D630 00476 SUB '0' ;<631>
2452 FE08 00477 CP 7+1 ;<631>Ck drive range 0-7
2454 D25C28 00478 JP NC,PRMERR ;<631>
2457 4F 00479 LD C,A ;<631>
00480 ELSE
00481 CALL PATCH1 ;Ck drive range 0-7
00482 ENDIF
2458 41 00483 LD B,C ;Set bit instruct
2459 04 00484 INC B ;Always once
245A 3E3F 00485 LD A,47H-8
245C C608 00486 PUR2A ADD A,8
245E 10FC 00487 DJNZ PUR2A
2460 32B927 00488 LD (DVTEST1),A ;This is bit x,a
2463 324126 00489 LD (DVTEST2),A ; opcode
2466 79 00490 LD A,C ;Xfer drive to regA
2467 32CE26 00491 LD (TSTMPW+1),A ; & stuff for later
246A 00492 @@CKDRV ;Ck if drive available
246A+3E21 00493 LD A,33
246C+EF 00494 RST 40
246D 3E20 00495 LD A,32 ;"drive not avail...
00496 IF @BLD631
246F C25E28 00497 JP NZ,IOERR ;<631>Go on CKDRV error
2472 3E0F 00498 LD A,15 ;<631>Init WP error
2474 DA5E28 00499 JP C,IOERR ;<631>Exit if WP
00500 ELSE
00501 CALL PATCH2 ;Ck WP or missing disk
00502 ENDIF
2477 00503 @@GTDCT ;DCT to reg IY
2477+3E51 00504 LD A,81
2479+EF 00505 RST 40
247A 116829 00506 LD DE,PRMTBL$ ;Get parms
247D 00507 @@PARAM
247D+3E11 00508 LD A,17
247F+EF 00509 RST 40
2480 C25C28 00510 PRMERRA JP NZ,PRMERR ;Jump on error
2483 210000 00511 DATPRM LD HL,0 ;P/u date="from-to"
2486 7C 00512 LD A,H
2487 B5 00513 OR L
2488 2835 00514 JR Z,PUR3 ;Bypass if not entered
248A 7E 00515 LD A,(HL) ;Check for "-to"
248B FE2D 00516 CP '-'
248D 2818 00517 JR Z,CKTO
248F 3E80 00518 LD A,80H ;Set from bit
2491 324429 00519 LD (FTFLG),A ;Note from entered
2494 CDCE27 00520 CALL PAKDAT ;Pack the date entry
2497 C25E28 00521 JP NZ,IOERR ;Quit if bad date
249A ED434529 00522 LD (FMPAKD),BC
249E 7E 00523 LD A,(HL)
249F FE22 00524 CP '"'
24A1 2810 00525 JR Z,FRCTO
24A3 FE2D 00526 CP '-' ;Check for "-to"
24A5 2018 00527 JR NZ,PUR3
24A7 23 00528 CKTO INC HL ;Bypass the '-'
24A8 7E 00529 LD A,(HL) ;Ck for end of parm
24A9 FE22 00530 CP '"'
24AB 2812 00531 JR Z,PUR3 ;Go on parm end
24AD CDCE27 00532 CALL PAKDAT ; else pack the date
24B0 C25E28 00533 JP NZ,IOERR ;Quit on bad date
24B3 3A4429 00534 FRCTO LD A,(FTFLG)
24B6 F601 00535 OR 1 ;Set TO bit
24B8 324429 00536 LD (FTFLG),A
24BB ED434729 00537 LD (TOPAKD),BC ;Stuff for later
24BF 3ADE25 00538 PUR3 LD A,(QPARM+1) ;Query parm used?
24C2 B7 00539 OR A
24C3 2806 00540 JR Z,DOEVER ;Go if not
24C5 CD6727 00541 CALL CKINDO ;Invalid command during
24C8 C25E28 00542 JP NZ,IOERR ; processing
24CB CDCD26 00543 DOEVER CALL TSTMPW ;Ck on master password
24CE C25E28 00544 JP NZ,IOERR ;Go if worng
24D1 3ACE26 00545 LD A,(TSTMPW+1) ;P/u drive
24D4 4F 00546 LD C,A
24D5 FD5609 00547 LD D,(IY+9) ;Get DIR cylinder
24D8 1E01 00548 LD E,1 ;Pt to HIT sector
24DA 21002C 00549 LD HL,HITBUF
24DD 00550 @@FLAGS ;Pt IY => Flags
24DD+3E65 00551 LD A,101
24DF+EF 00552 RST 40
24E0 00553 @@RDSSC ;Read the HIT
24E0+3E55 00554 LD A,85
24E2+EF 00555 RST 40
24E3 3E16 00556 LD A,16H ;Init "HIT read error...
24E5 C25E28 00557 JP NZ,IOERR ;Abort on read error
24E8 1818 00558 JR SCNH3
00559 ;
00560 ; Major loop to scan HIT for files
00561 ;
24EA E1 00562 SCNHIT POP HL
24EB C1 00563 SCNH1 POP BC ;Rcvr HIT ptr DEC
24EC 262C 00564 LD H,HITBUF<-8 ;Pt to hi-order buffer
24EE 68 00565 LD L,B ;Set lo-order DEC
24EF 7D 00566 SCNH2 LD A,L
24F0 C620 00567 ADD A,32 ;Pt to next one in
24F2 6F 00568 LD L,A ;Same dir sector
24F3 300D 00569 JR NC,SCNH3 ;Jump if still in sector
24F5 2C 00570 INC L ;Bump to next dir sector
24F6 FE1F 00571 CP 1FH ;End of the line?
24F8 2008 00572 JR NZ,SCNH3 ;Loop if not
24FA 0E0D 00573 LD C,CR
24FC 00574 @@DSP ;Write new line & exit
24FC+3E02 00575 LD A,2
24FE+EF 00576 RST 40
24FF C37928 00577 JP EXIT
00578 ;
00579 ; Routine to check on dir record in use
00580 ;
2502 7D 00581 SCNH3 LD A,L ;Ignore BOOT & DIR
2503 E6FE 00582 AND 0FEH
2505 28E8 00583 JR Z,SCNH2
2507 7E 00584 LD A,(HL) ;P/u HIT hash byte
2508 B7 00585 OR A
2509 28E4 00586 JR Z,SCNH2 ;Ignore if spare
250B 45 00587 LD B,L ;Save DEC
250C C5 00588 PUSH BC
250D 7D 00589 LD A,L ;Get record # in L
250E E6E0 00590 AND 0E0H
2510 6F 00591 LD L,A
2511 A8 00592 XOR B ;Get sector # in A
2512 FEFF 00593 SCNH3A CP 0FFH ;Same as what's in core?
2514 280D 00594 JR Z,SCNH4 ;Bypass if same
2516 321325 00595 LD (SCNH3A+1),A ;Update indicator byte
2519 00596 @@DIRRD ;Read this directory
2519+3E57 00597 LD A,87
251B+EF 00598 RST 40
251C C25E28 00599 JP NZ,IOERR ;Quit on read error
251F 7C 00600 LD A,H ;Set SBUFF pointer
2520 322425 00601 LD (SCNH4+1),A
2523 2600 00602 SCNH4 LD H,0 ;Pt to dir buf hi-order
2525 7E 00603 LD A,(HL) ;L set to lo-order
2526 CB67 00604 BIT 4,A ;Ignore if not assigned
2528 28C1 00605 JR Z,SCNH1
252A CB7F 00606 BIT 7,A ;Ignore if it's an
252C 20BD 00607 JR NZ,SCNH1 ; extended dir record
252E CB77 00608 BIT 6,A ;Jump if not a SYS file
2530 280A 00609 JR Z,CKINV
2532 110000 00610 SPARM LD DE,0 ;P/u S-parm
2535 7A 00611 LD A,D
2536 B3 00612 OR E ;Ignore this one if
2537 CAEB24 00613 JP Z,SCNH1 ; S-parm not entered
253A 180C 00614 JR CKNAM
00615 ;
00616 ; Non-SYS file
00617 ;
253C CB5F 00618 CKINV BIT 3,A ;Jump if visible
253E 2808 00619 JR Z,CKNAM
2540 110000 00620 IPARM LD DE,0 ;I-parm
2543 7A 00621 LD A,D ;Ignore if I-parm not
2544 B3 00622 OR E ; entered as this file
2545 CAEB24 00623 JP Z,SCNH1 ; is invisible
00624 ;
00625 ; Parms match, grab filename & check class
00626 ;
2548 E5 00627 CKNAM PUSH HL ;Save ptr to record
2549 7D 00628 LD A,L ;Pt to filename in dir
254A C605 00629 ADD A,5
254C 6F 00630 LD L,A
254D 113929 00631 LD DE,BLANKS ;Pt to parsed input
2550 060B 00632 LD B,11 ;Ck name/ext (11-chars)
2552 1A 00633 SCNH5 LD A,(DE)
2553 FE24 00634 CP '$' ;Wild char?
2555 2807 00635 JR Z,SCNH6 ;Always a match
2557 BE 00636 CP (HL) ;Not global, char match?
2558 2804 00637 JR Z,SCNH6 ;Ck more if match
255A FE20 00638 CP ' ' ;Blank = end of ck
255C 200D 00639 JR NZ,MFLG ;If not blank, no match
255E 23 00640 SCNH6 INC HL ;Bump pointers
255F 13 00641 INC DE
2560 10F0 00642 DJNZ SCNH5 ;Loop for 11 chars
2562 3A6C25 00643 LD A,(MFLG+1) ;Bypass if a match but
2565 B7 00644 OR A ; - exclude given
2566 C2EA24 00645 JP NZ,SCNHIT
2569 1806 00646 JR SCNH6A
256B 3E00 00647 MFLG LD A,0 ;Ignore if no match &
256D B7 00648 OR A ; no exclude given
256E CAEA24 00649 JP Z,SCNHIT
2571 E1 00650 SCNH6A POP HL ;Rcvr ptr to DIR+0
2572 E5 00651 PUSH HL
00652 ;
00653 ; Now check if date matches
00654 ;
2573 23 00655 INC HL ;Pt to date field
2574 CDA427 00656 CALL UNPACK ;Alter date for cpr
2577 3A4429 00657 LD A,(FTFLG)
257A 07 00658 RLCA ;Tst fm bit
257B 3010 00659 JR NC,SCNH6B
257D 7A 00660 LD A,D ;Ignore if no date
257E B3 00661 OR E ; in DIR for file
257F CAEA24 00662 JP Z,SCNHIT
2582 2A4529 00663 LD HL,(FMPAKD) ;P/u user entry
2585 EB 00664 EX DE,HL
2586 CD5628 00665 CALL CPHLDE ;HL-DE
2589 EB 00666 EX DE,HL
258A DAEA24 00667 JP C,SCNHIT ;Go if out of range
258D 3A4429 00668 SCNH6B LD A,(FTFLG)
2590 0F 00669 RRCA ;Tst TO bit
2591 300E 00670 JR NC,MATCHES ;Go if no TOPARM
2593 7A 00671 LD A,D ; else ck if file is dated
2594 B3 00672 OR E
2595 CAEA24 00673 JP Z,SCNHIT ;Go if no dir date
2598 2A4729 00674 LD HL,(TOPAKD) ;P/u user's packed date
259B CD5628 00675 CALL CPHLDE ;HL-DE
259E DAEA24 00676 JP C,SCNHIT ;Go if out of range
25A1 E1 00677 MATCHES POP HL ;Rcvr pointer to DIRREC
25A2 E5 00678 DONAM PUSH HL
25A3 7D 00679 LD A,L ; & point to file name
25A4 C605 00680 ADD A,5
25A6 6F 00681 LD L,A
25A7 114D29 00682 LD DE,FCB1$ ;Pt to name/ext buffer
25AA 0608 00683 LD B,8 ;Max 8-char name
25AC 7E 00684 DONAM1 LD A,(HL) ;Move filename into
25AD FE20 00685 CP ' ' ; buffer until space
25AF 2805 00686 JR Z,DONAME2 ; or 8 characters
25B1 12 00687 LD (DE),A
25B2 23 00688 INC HL
25B3 13 00689 INC DE
25B4 10F6 00690 DJNZ DONAM1
25B6 7D 00691 DONAME2 LD A,L ;Point to file ext
25B7 80 00692 ADD A,B
25B8 6F 00693 LD L,A
25B9 7E 00694 LD A,(HL) ;Is there an extension?
25BA FE20 00695 CP ' '
25BC 2810 00696 JR Z,DONAM5 ;Bypass if not
25BE 3E2F 00697 LD A,'/'
25C0 12 00698 LD (DE),A ;Stuff ext separator
25C1 13 00699 INC DE
25C2 0603 00700 LD B,3 ;Init 3-char ext max
25C4 7E 00701 DONAM4 LD A,(HL) ;Transfer up to space
25C5 FE20 00702 CP ' ' ; or 3 chars
25C7 2805 00703 JR Z,DONAM5
25C9 12 00704 LD (DE),A
25CA 23 00705 INC HL
25CB 13 00706 INC DE
25CC 10F6 00707 DJNZ DONAM4
25CE 3E3A 00708 DONAM5 LD A,':' ;Add the drivespec
25D0 12 00709 LD (DE),A
25D1 13 00710 INC DE
25D2 3ACE26 00711 LD A,(TSTMPW+1) ;P/u drivespec
25D5 F630 00712 OR '0' ;Make it ASCII & stuff
25D7 12 00713 LD (DE),A
25D8 13 00714 INC DE
25D9 3E03 00715 LD A,3 ;Terminate with ETX
25DB 12 00716 LD (DE),A
25DC D5 00717 PUSH DE ;Save pointer
25DD 11FFFF 00718 QPARM LD DE,-1 ;Query each file?
25E0 7A 00719 LD A,D
25E1 B3 00720 OR E
25E2 CA8F26 00721 JP Z,NOPRMPT ;Not if not Q=N
00722 ;
25E5 00723 @@DSPLY PRGFIL$ ;"Purge file?...
00724 IFEQ 01H,1
25E5+21F828 00725 LD HL,PRGFIL$
00726 ENDIF
25E8+3E0A 00727 LD A,10
25EA+EF 00728 RST 40
25EB D1 00729 POP DE ;Rcvr ptr to file buf ETX
25EC E1 00730 POP HL ;Rcvr ptr to 1st dir byte
25ED D5 00731 PUSH DE
25EE 23 00732 INC HL ;Pt to MOD bit
25EF CB76 00733 BIT 6,(HL) ;Test MOD flag
25F1 2808 00734 JR Z,SCDAT1 ;Go if not mod'ed
25F3 3E20 00735 LD A,' ' ;Put a space
25F5 12 00736 LD (DE),A
25F6 13 00737 INC DE
25F7 3E2B 00738 LD A,'+' ; and the mod sign
25F9 12 00739 LD (DE),A
25FA 13 00740 INC DE
25FB 3E20 00741 SCDAT1 LD A,' ' ;Write a space
25FD 12 00742 LD (DE),A
25FE 13 00743 INC DE
25FF 23 00744 INC HL ;Advance to date field
2600 EB 00745 EX DE,HL
2601 367B 00746 LD (HL),'{' ;Stuff left brace
2603 23 00747 INC HL
2604 EB 00748 EX DE,HL
2605 7E 00749 LD A,(HL)
2606 B7 00750 OR A
2607 2861 00751 JR Z,SCDAT4 ;Ignore if no date saved
2609 0F 00752 RRCA ;Has date, get day
260A 0F 00753 RRCA
260B 0F 00754 RRCA
260C E61F 00755 AND 1FH
260E 062F 00756 LD B,2FH ;Convert day to decimal
2610 04 00757 SCDAT2 INC B ; by counting # of 10's
2611 D60A 00758 SUB 10 ;Sub 10 from day #
2613 30FB 00759 JR NC,SCDAT2
2615 C63A 00760 ADD A,3AH ;Cvrt lo order to ASCII
2617 F5 00761 PUSH AF ;Save day low order
2618 78 00762 LD A,B ;Stuff day hi order
2619 12 00763 LD (DE),A
261A 13 00764 INC DE ;Bump
261B F1 00765 POP AF ;Rcvr lo order day #
261C 12 00766 LD (DE),A ;Stuff low order
261D 13 00767 INC DE ;Bump pointer to msg
261E 3E2D 00768 LD A,'-' ;Init seperator
2620 12 00769 LD (DE),A ; and stuff in buffer
2621 13 00770 INC DE ;Pt to month field
2622 E5 00771 PUSH HL ;Save DIR ptr
2623 2B 00772 DEC HL ;Pt to DIR+1 (month+)
2624 7E 00773 LD A,(HL) ;P/u month etc
2625 E60F 00774 AND 0FH ;Strip off flags
2627 3D 00775 DEC A ;(mon-1)*3 indexes string
2628 4F 00776 LD C,A ; conversion table
2629 07 00777 RLCA
262A 81 00778 ADD A,C
262B 4F 00779 LD C,A
262C 0600 00780 LD B,0
262E 211529 00781 LD HL,MONTBL
2631 09 00782 ADD HL,BC ;Add offset to tbl start
2632 0E03 00783 LD C,3
2634 EDB0 00784 LDIR ;Move 3-char month
2636 3E2D 00785 LD A,'-' ;Suff separator char
2638 12 00786 LD (DE),A
2639 13 00787 INC DE ;Advance to year field
263A E1 00788 POP HL ;Get ptr to dir+2
263B 0E38 00789 LD C,'8' ;Init 1980
263D 3A0000 00790 LD A,($-$) ;Year type flag
263E 00791 YFLAG2 EQU $-2
2640 CB 00792 DB 0CBH
2641 47 00793 DVTEST2 DB 47H
2642 2005 00794 JR NZ,NEWDT2 ;Using new style
2644 7E 00795 LD A,(HL) ;Get old date
2645 E607 00796 AND 7
2647 1818 00797 JR THERE ;Make for dsp
2649 7D 00798 NEWDT2 LD A,L
264A C611 00799 ADD A,17 ;Pt to new year
264C 6F 00800 LD L,A
264D 7E 00801 LD A,(HL) ;get year
264E E61F 00802 AND 1FH
00803 IF @BLD631
00804 L2650:
00805 ENDIF
2650 FE0A 00806 CP 10 ;1980's
2652 380D 00807 JR C,THERE ;Go if so
00808 IF @BLD631
2654 0C 00809 INC C ;<631>
00810 ELSE
00811 LD C,'9'
00812 ENDIF
2655 D60A 00813 SUB 10 ;Sub off decade
2657 FE0A 00814 CP 10 ;Must be less
2659 3806 00815 JR C,THERE
00816 IF @BLD631
265B D60A 00817 SUB 10 ;<631>
265D 0E30 00818 LD C,'0' ;<631>
265F 18EF 00819 JR L2650 ;<631>
00820 ELSE
00821 LD A,9 ;Else bogus, use 1999
00822 ENDIF
2661 47 00823 THERE LD B,A ;Save year
2662 79 00824 LD A,C
2663 12 00825 LD (DE),A ;Stuff decade
2664 13 00826 INC DE
2665 78 00827 LD A,B
2666 C630 00828 ADD A,'0' ;Make ascii
2668 12 00829 LD (DE),A ;Stuff year
2669 13 00830 INC DE
266A 3E03 00831 SCDAT4 LD A,3 ;Show etx for display
266C 12 00832 LD (DE),A
266D 00833 @@DSPLY FCB1$ ;Display filename
00834 IFEQ 01H,1
266D+214D29 00835 LD HL,FCB1$
00836 ENDIF
2670+3E0A 00837 LD A,10
2672+EF 00838 RST 40
2673 00839 @@DSPLY QMARK$ ;Display ???
00840 IFEQ 01H,1
2673+210529 00841 LD HL,QMARK$
00842 ENDIF
2676+3E0A 00843 LD A,10
2678+EF 00844 RST 40
2679 214929 00845 LD HL,LILBUF$ ;Get response y,n
267C 010003 00846 LD BC,3<8 ;For Yes, No
267F 00847 @@KEYIN
267F+3E09 00848 LD A,9
2681+EF 00849 RST 40
2682 DA6D28 00850 JP C,BREAK ;Abort on
2685 7E 00851 LD A,(HL) ;P/u response
2686 CBAF 00852 RES 5,A ;Strip l/c if entered
2688 FE59 00853 CP 'Y' ;Is it yes?
268A C2EA24 00854 JP NZ,SCNHIT ;Bypass if not
268D E3 00855 EX (SP),HL ;Place dummy HL below
268E E5 00856 PUSH HL ; pointer
268F FDCB0A46 00857 NOPRMPT BIT 0,(IY+'K'-'A') ;Ck if BREAK bit in
2693 C26D28 00858 JP NZ,BREAK ; KFLAG is active
2696 00859 @@LOGOT PURGE$ ;Dsply "Purging: "
00860 IFEQ 01H,1
2696+210B29 00861 LD HL,PURGE$
00862 ENDIF
2699+3E0C 00863 LD A,12
269B+EF 00864 RST 40
269C E1 00865 POP HL ;Get pointer where ETX is
269D 360D 00866 LD (HL),CR ; & replace with CR
269F 00867 @@LOGOT FCB1$ ;Dsply filename
00868 IFEQ 01H,1
269F+214D29 00869 LD HL,FCB1$
00870 ENDIF
26A2+3E0C 00871 LD A,12
26A4+EF 00872 RST 40
26A5 E1 00873 POP HL ;Pop dummy or DIRREC ptr
26A6 C1 00874 POP BC ;Get drive & DEC
26A7 C5 00875 PUSH BC
26A8 78 00876 LD A,B ;P/u the DEC
26A9 329729 00877 LD (FCB+7),A ; & stuff
26AC 3ACE26 00878 LD A,(TSTMPW+1) ;P/u drive
26AF 329629 00879 LD (FCB+6),A ; & stuff
26B2 3E01 00880 LD A,1 ;Set up FCB for remove
26B4 329129 00881 LD (FCB+1),A
26B7 3E80 00882 LD A,80H ;Show FCB as open
26B9 329029 00883 LD (FCB),A
26BC 119029 00884 LD DE,FCB ;Remove the file
26BF 00885 @@REMOV
26BF+3E39 00886 LD A,57
26C1+EF 00887 RST 40
26C2 C25E28 00888 JP NZ,IOERR ;Jump on error
26C5 3EFF 00889 LD A,0FFH ;Show we don't have the
26C7 321325 00890 LD (SCNH3A+1),A ; latest dir record
26CA C3EB24 00891 JP SCNH1 ;Loop
00892 ;
00893 ; Routine to get the master password & match it
00894 ;
26CD 0E00 00895 TSTMPW LD C,$-$ ;Init to drive requested
26CF CD5627 00896 CALL GATRD ;Read GAT into GATBUF
26D2 C0 00897 RET NZ ;Back on error
26D3 2ACE2B 00898 LD HL,(GATBUF+0CEH)
26D6 11E042 00899 LD DE,PASSWORD ;Password="PASSWORD" ?
26D9 AF 00900 XOR A
26DA ED52 00901 SBC HL,DE
26DC C8 00902 RET Z ;Back if PASSWORD
00903 ;
00904 ; MPW is not "PASSWORD" - check entry match
00905 ;
26DD 110000 00906 PWPARM LD DE,0 ;P/u MPW string addr
26E0 21AC28 00907 LD HL,MPW$ ;Init prompt
26E3 CDF426 00908 CALL GETMPW ;Hash parm or entry
26E6 C0 00909 RET NZ
26E7 EB 00910 EX DE,HL ;Xfer haashed MPW to DE
26E8 2ACE2B 00911 LD HL,(GATBUF+0CEH) ;Grab pack MPW &
26EB AF 00912 XOR A ; check if user entered
26EC ED52 00913 SBC HL,DE ; the pack MPW
26EE 21C428 00914 LD HL,BADMPW$ ;Init error pointer
26F1 3E3F 00915 LD A,63 ;Set extended error
26F3 C9 00916 RET ;Z or NZ
00917 ;
00918 ; Routine to get 8-char password
00919 ;
26F4 CDFB26 00920 GETMPW CALL GMPW1 ;Test if user entered MPW
26F7 C0 00921 RET NZ
26F8 3EE4 00922 LD A,0E4H ;Hash password (DE) to HL
26FA EF 00923 RST 28H ;Ret to what called
26FB 7A 00924 GMPW1 LD A,D ;Test if user entered MPW
26FC B3 00925 OR E
26FD 281D 00926 JR Z,GMPW3 ;Prompt if not
26FF 3C 00927 INC A ; or no operand
2700 281A 00928 JR Z,GMPW3
00929 ;
00930 ; Place entered password into buffer
00931 ;
2702 21002A 00932 LD HL,BUFFER
2705 E5 00933 PUSH HL
2706 0608 00934 LD B,8 ;Max entry of 8 chars
2708 1A 00935 GMPW2 LD A,(DE) ;P/u pswd char
2709 FE0D 00936 CP CR ;End of the line?
270B 282F 00937 JR Z,GMPW4 ;Space out if so
270D FE2C 00938 CP ',' ;Comma separator?
270F 282B 00939 JR Z,GMPW4
2711 FE22 00940 CP '"' ;Closing quote?
2713 2827 00941 JR Z,GMPW4
2715 13 00942 INC DE
2716 77 00943 LD (HL),A ;Xfer the char
2717 23 00944 INC HL
2718 10EE 00945 DJNZ GMPW2 ;Loop for 8
271A 1825 00946 JR GMPW5
00947 ;
00948 ; Not entered as parm, grab from keyboard
00949 ;
271C CD6727 00950 GMPW3 CALL CKINDO ;Can't prompt in
271F C0 00951 RET NZ
2720 00952 @@DSPLY ;Display request
00953 IFEQ 00H,1
00954 LD HL,
00955 ENDIF
2720+3E0A 00956 LD A,10
2722+EF 00957 RST 40
2723 C0 00958 RET NZ
2724 010008 00959 LD BC,8<8 ;Max 8 chars input
2727 21002A 00960 LD HL,BUFFER ;Pt to buffer
272A E5 00961 PUSH HL
272B 00962 @@KEYIN ;Get parm input
272B+3E09 00963 LD A,9
272D+EF 00964 RST 40
272E DA6D28 00965 JP C,BREAK ;Exit on Break
2731 EB 00966 EX DE,HL ;Buf start to DE
2732 2600 00967 LD H,0 ;Buf len to HL
2734 68 00968 LD L,B
2735 19 00969 ADD HL,DE ;Pt to 1st unused pos
2736 3E08 00970 LD A,8 ;Calculate spaces needed
2738 90 00971 SUB B
2739 2806 00972 JR Z,GMPW5 ;Ret if none needed
273B 47 00973 LD B,A ;Set counter for spaces
273C 3620 00974 GMPW4 LD (HL),' ' ; & put them in
273E 23 00975 INC HL
273F 10FB 00976 DJNZ GMPW4
00977 ;
00978 ; Convert (SP) through (SP)+7 to upper case
00979 ;
2741 E1 00980 GMPW5 POP HL ;Rcvr pointer to buf
2742 E5 00981 PUSH HL
2743 0608 00982 LD B,8 ;Loop through field
2745 7E 00983 GMPW6 LD A,(HL)
2746 FE61 00984 CP 'a'
2748 3806 00985 JR C,GMPW7
274A FE7B 00986 CP 'z'+1
274C 3002 00987 JR NC,GMPW7
274E CBAE 00988 RES 5,(HL) ;L/c -> U/C
2750 23 00989 GMPW7 INC HL
2751 10F2 00990 DJNZ GMPW6
2753 D1 00991 POP DE ;Rcvr ptr to start
2754 AF 00992 XOR A ;Indicate no error
2755 C9 00993 RET
00994 ;
00995 ; Routine to read the granule allocation table
00996 ;
2756 D5 00997 GATRD PUSH DE
2757 E5 00998 PUSH HL
2758 FD5609 00999 LD D,(IY+9) ;Dir cylinder
275B 21002B 01000 LD HL,GATBUF
275E 5D 01001 LD E,L ;Set to sector 0
275F 01002 @@RDSSC
275F+3E55 01003 LD A,85
2761+EF 01004 RST 40
2762 E1 01005 POP HL
2763 D1 01006 POP DE
2764 3E14 01007 LD A,14H ;Init "GAT read error
2766 C9 01008 RET ;Z or NZ
01009 ;
01010 ; Routine to check if active
01011 ;
2767 FDE5 01012 CKINDO PUSH IY
2769 01013 @@FLAGS
2769+3E65 01014 LD A,101
276B+EF 01015 RST 40
276C FDCB126E 01016 BIT 5,(IY+'S'-'A') ;Set if DO active
2770 FDE1 01017 POP IY
2772 C8 01018 RET Z
2773 218528 01019 LD HL,NOINDO$
2776 3E3F 01020 LD A,63
2778 C9 01021 RET
01022 ;
01023 ; Parse file name or ext on command line
01024 ;
2779 FE2A 01025 PRSPEC CP '*'
277B 2008 01026 JR NZ,PS4
277D 3E24 01027 LD A,'$' ;Wild card char
277F 12 01028 PS5 LD (DE),A ;Store it
2780 10FD 01029 DJNZ PS5
2782 7E 01030 LD A,(HL) ;P/u terminator
2783 23 01031 INC HL
2784 C9 01032 RET
01033 ;
2785 FE24 01034 PS4 CP '$' ;Wild character?
2787 2814 01035 JR Z,PRS2 ;Always a match
2789 FE41 01036 CP 'A' ;Ck on filename entry
278B 3006 01037 JR NC,PRS1 ;Jump if possible alpha
278D FE3A 01038 CP '9'+1 ;Ck on 0-9
278F D0 01039 RET NC ;Bad if > 9 and < A
2790 FE30 01040 CP '0'
2792 D8 01041 RET C ;Bad if < 0
2793 FE61 01042 PRS1 CP 'a' ;Cvrt to UC if needed
2795 3806 01043 JR C,PRS2
2797 FE7B 01044 CP 'z'+1
2799 3002 01045 JR NC,PRS2
279B CBAF 01046 RES 5,A
279D 12 01047 PRS2 LD (DE),A ;Xfer char to buffer
279E 13 01048 INC DE ;Bump dest ptr
279F 7E 01049 LD A,(HL) ;Get next char
27A0 23 01050 INC HL ;Bump source ptr
27A1 10D6 01051 DJNZ PRSPEC ;Loop 8 max
27A3 C9 01052 RET
01053 ;
01054 ; Routine to extract date from directory
01055 ;
27A4 7E 01056 UNPACK LD A,(HL) ;P/u DIR+1
27A5 E60F 01057 AND 0FH ;Mask all but month
27A7 1E00 01058 LD E,0
27A9 CB3F 01059 SRL A
27AB CB1B 01060 RR E
27AD 57 01061 LD D,A ;Month to DE
27AE 23 01062 INC HL ;Pt to day
27AF 7E 01063 LD A,(HL)
27B0 E6F8 01064 AND 0F8H ;Mask off year
27B2 0F 01065 RRCA ;Day to bits 2-6
27B3 B3 01066 OR E
27B4 5F 01067 LD E,A ;Mon,day in E
27B5 3A0000 01068 LD A,($-$) ;Get YFLAG
27B6 01069 YFLAG1 EQU $-2
27B8 CB 01070 DB 0CBH ;Bit x,A
27B9 47 01071 DVTEST1 DB 47H
27BA 2009 01072 JR NZ,NEWDT ;Go if new style
27BC 7E 01073 LD A,(HL)
27BD E607 01074 AND 7 ;Get old style date
27BF 07 01075 SHFTD RLCA
27C0 07 01076 RLCA
27C1 07 01077 RLCA
27C2 B2 01078 OR D ;Merge year w/MSbits mon
27C3 57 01079 LD D,A
27C4 C9 01080 RET
01081 ;
27C5 7D 01082 NEWDT LD A,L ;Pt to new year style
27C6 C611 01083 ADD A,17
27C8 6F 01084 LD L,A
27C9 7E 01085 LD A,(HL) ;Get year
27CA E61F 01086 AND 1FH ;Mask mins
27CC 18F1 01087 JR SHFTD ;Store
01088 ;
01089 ; Pack user date string
01090 ;
27CE 7E 01091 PAKDAT LD A,(HL)
27CF 0E2F 01092 LD C,'/' ;Init separator
27D1 CD2328 01093 CALL PARSDAT ;Parse entry
27D4 2046 01094 JR NZ,BADFMT ;Jump on format error
27D6 EB 01095 EX DE,HL
01096 IF @BLD631
27D7 7E 01097 LD A,(HL) ;<631>
27D8 FE0C 01098 CP 12 ;<631>
27DA 3003 01099 JR NC,NOTLP ;<631>
27DC C664 01100 ADD A,64H ;<631>
27DE 77 01101 LD (HL),A ;<631>
01102 NOTLP: ;<631>
01103 ELSE
01104 LD A,(LILBUF$) ;Is year a leap year?
01105 ENDIF
27DF E603 01106 AND 3
27E1 21DD28 01107 LD HL,MAXDAYS+1 ;Set Feb to have 29 days
27E4 2001 01108 JR NZ,$+3 ; if so
27E6 34 01109 INC (HL)
27E7 3A4B29 01110 LD A,(LILBUF$+2) ;P/u month
27EA 3D 01111 DEC A ;Range check
27EB FE0C 01112 CP 12
27ED 302D 01113 JR NC,BADFMT ;Go if 0 or >12
27EF 2B 01114 DEC HL ;Point to Jan entry
27F0 85 01115 ADD A,L ;Index the month
27F1 6F 01116 LD L,A
27F2 7C 01117 LD A,H
27F3 CE00 01118 ADC A,0
27F5 67 01119 LD H,A
27F6 3A4A29 01120 LD A,(LILBUF$+1) ;P/u day entry
27F9 3D 01121 DEC A ;Reduce for test (0->FF)
27FA BE 01122 CP (HL)
27FB 301F 01123 JR NC,BADFMT ;Go if too large (or 0)
27FD 214B29 01124 LD HL,LILBUF$+2 ;Pt to month
2800 46 01125 LD B,(HL) ;Get month
2801 0E00 01126 LD C,0
2803 CB38 01127 SRL B ;Split month to BC
2805 CB19 01128 RR C
2807 2B 01129 DEC HL
2808 7E 01130 LD A,(HL) ;Get day
2809 07 01131 RLCA ;Shift into bits 2-6
280A 07 01132 RLCA
280B B1 01133 OR C
280C 4F 01134 LD C,A ;Merge day into C
280D 2B 01135 DEC HL
280E 7E 01136 LD A,(HL) ;Get year
280F D650 01137 SUB 80 ;Offset only
2811 3001 01138 JR NC,GDATE ;OK if >= 1980
2813 AF 01139 XOR A ; else use 1980
2814 07 01140 GDATE RLCA ;Shift into bits 3-7
2815 07 01141 RLCA
2816 07 01142 RLCA
2817 B0 01143 OR B ; & merge with month
2818 47 01144 LD B,A
2819 EB 01145 EX DE,HL
281A AF 01146 XOR A ;Set Z, no error
281B C9 01147 RET
01148 ;
281C 21E828 01149 BADFMT LD HL,BADFMT$ ;Init error pointer
281F 3E3F 01150 LD A,63 ;Set extended error
2821 B7 01151 OR A
2822 C9 01152 RET
01153 ;
01154 ; Routine to parse DATE/TIME entry
01155 ;
2823 114B29 01156 PARSDAT LD DE,LILBUF$+2 ;Point to buf end
2826 0603 01157 LD B,3 ;Process 3 fields
2828 D5 01158 PRSD1 PUSH DE ;Save pointer
2829 CD3828 01159 CALL PRSD2 ;Get a digit pair
282C D1 01160 POP DE ;Recover pointer
282D C0 01161 RET NZ ;Ret if bad digit pair
282E 12 01162 LD (DE),A ; else stuff the value
01163 IF @BLD631
282F 05 01164 DEC B ;<631>Loop countdown
2830 C8 01165 RET Z ;<631>
2831 1B 01166 DEC DE ;<631>Backup the pointer
01167 ELSE
01168 DEC DE ;Backup the pointer
01169 DEC B ;Loop countdown
01170 RET Z
01171 ENDIF
2832 7E 01172 LD A,(HL) ;Ck for valid separator
2833 23 01173 INC HL ;Bump pointer
2834 B9 01174 CP C ;Separator char required
2835 28F1 01175 JR Z,PRSD1 ;Loop if match
2837 C9 01176 RET ; else ret bad (NZ)
01177 ;
01178 ; Routine to parse a digit pair
01179 ;
2838 CD4F28 01180 PRSD2 CALL PRS4 ;Get a digit
283B 3010 01181 JR NC,PRSD3 ;Jump if bad digit
283D 5F 01182 LD E,A ;Multiply by ten
283E 07 01183 RLCA
283F 07 01184 RLCA
2840 83 01185 ADD A,E
2841 07 01186 RLCA
2842 5F 01187 LD E,A
2843 CD4F28 01188 CALL PRS4 ;Get another digit
2846 3005 01189 JR NC,PRSD3 ;Jump on bad digit
2848 83 01190 ADD A,E ;Accumulate new digit
2849 5F 01191 LD E,A ;Save 2-digit value
284A AF 01192 XOR A ;Clear flags
284B 7B 01193 LD A,E ;Xfer field value
284C C9 01194 RET
01195 ;
284D B7 01196 PRSD3 OR A ;Set NZ
284E C9 01197 RET
284F 7E 01198 PRS4 LD A,(HL) ;P/u a digit &
2850 23 01199 INC HL ; convert to binary
2851 D630 01200 SUB '0'
2853 FE0A 01201 CP 10
2855 C9 01202 RET
01203 ;
01204 ; Routine to compare DE to HL
01205 ;
2856 7C 01206 CPHLDE LD A,H
2857 92 01207 SUB D
2858 C0 01208 RET NZ
2859 7D 01209 LD A,L
285A 93 01210 SUB E
285B C9 01211 RET
01212 ;
01213 ; Error processing
01214 ;
285C 3E2C 01215 PRMERR LD A,PAR_ERR ;Parameter Error
285E FE3F 01216 IOERR CP 63 ;Extended error?
2860 281E 01217 JR Z,EXTERR
2862 6F 01218 LD L,A
2863 2600 01219 LD H,0
2865 F6C0 01220 OR 0C0H ;Abbrev & return
2867 4F 01221 LD C,A
2868 01222 @@ERROR
2868+3E1A 01223 LD A,26
286A+EF 01224 RST 40
286B 1806 01225 JR SAVESP
01226 ;
01227 ; BREAK handler routine
01228 ;
286D 01229 BREAK @@CKBRKC ;Clear Break Bit
286D+3E6A 01230 LD A,106
286F+EF 01231 RST 40
2870 21FFFF 01232 ERREXIT LD HL,-1
2873 310000 01233 SAVESP LD SP,$-$ ;Restore the stack
2876 227A28 01234 LD (RETCOD),HL
2879 01235 EXIT EQU $ ;Exit clears Break
2879 210000 01236 LD HL,0
287A 01237 RETCOD EQU $-2
287C 01238 @@CKBRKC
287C+3E6A 01239 LD A,106
287E+EF 01240 RST 40
287F C9 01241 RET
01242 ;
2880 01243 EXTERR @@LOGOT
01244 IFEQ 00H,1
01245 LD HL,
01246 ENDIF
2880+3E0C 01247 LD A,12
2882+EF 01248 RST 40
2883 18EB 01249 JR ERREXIT
2885 49 01250 NOINDO$ DB 'Invalid command during '
6E 76 61 6C 69 64 20 63
6F 6D 6D 61 6E 64 20 64
75 72 69 6E 67 20 3C 44
4F 3E 20
28A1 70 01251 DB 'processing',CR
72 6F 63 65 73 73 69 6E
67 0D
28AC 4D 01252 MPW$ DB 'Master password ? ',3
61 73 74 65 72 20 70 61
73 73 77 6F 72 64 20 3F
20 20 20 20 20 20 03
28C4 49 01253 BADMPW$ DB 'Invalid master password',CR
6E 76 61 6C 69 64 20 6D
61 73 74 65 72 20 70 61
73 73 77 6F 72 64 0D
28DC 1F 01254 MAXDAYS DB 31,28,31,30,31,30,31,31,30,31,30,31
1C 1F 1E 1F 1E 1F 1F 1E
1F 1E 1F
28E8 42 01255 BADFMT$ DB 'Bad date format',CR
61 64 20 64 61 74 65 20
66 6F 72 6D 61 74 0D
01256 ;
28F8 50 01257 PRGFIL$ DB 'Purge file: ',3
75 72 67 65 20 66 69 6C
65 3A 20 03
2905 7D 01258 QMARK$ DB '} ? ',3
20 3F 20 20 03
290B 50 01259 PURGE$ DB 'Purging: ',3
75 72 67 69 6E 67 3A 20
03
2915 4A 01260 MONTBL DM 'JanFebMarAprMayJunJulAugSepOctNovDec'
61 6E 46 65 62 4D 61 72
41 70 72 4D 61 79 4A 75
6E 4A 75 6C 41 75 67 53
65 70 4F 63 74 4E 6F 76
44 65 63
2939 20 01261 BLANKS DM ' '
20 20 20 20 20 20 20 20
20 20
2944 00 01262 FTFLG DB 0
2945 01263 FMPAKD DS 2
2947 01264 TOPAKD DS 2
2949 01265 LILBUF$ DS 4
294D 01266 FCB1$ DS 27
01267 ;
01268 ; Parameter table
01269 ;
2968 80 01270 PRMTBL$ DB 80H
0080 01271 VAL EQU 80H
0040 01272 SW EQU 40H
0020 01273 STR EQU 20H
0010 01274 SGL EQU 10H
2969 53 01275 DB SW!SGL!3,'INV',0
49 4E 56 00
296E 4125 01276 DW IPARM+1
2970 53 01277 DB SW!SGL!3,'SYS',0
53 59 53 00
2975 3325 01278 DW SPARM+1
2977 73 01279 DB SW!STR!SGL!3,'MPW',0
4D 50 57 00
297C DE26 01280 DW PWPARM+1
297E 55 01281 DB SW!SGL!5,'QUERY',0
51 55 45 52 59 00
2985 DE25 01282 DW QPARM+1
2987 34 01283 DB STR!SGL!4,'DATE',0
44 41 54 45 00
298D 8424 01284 DW DATPRM+1
298F 00 01285 NOP
01286 ;
2990 01287 FCB DS 32
01288 IF @BLD631
01289 ELSE
01290 PATCH1 SUB '0' ;Cvrt to binary
01291 CP 7+1
01292 JP NC,PRMERR
01293 LD C,A
01294 RET
01295 ;
01296 PATCH2 JP NZ,IOERR ;Go on CKDRV error
01297 LD A,15 ;Init WP error
01298 JP C,IOERR ;Exit if WP
01299 RET
01300 ENDIF
01301 ;
2A00 01302 ORG $<-8+1<+8
2A00 01303 BUFFER DS 256
2B00 01304 GATBUF DS 256
2C00 01305 HITBUF DS 256
2CFF 01306 LAST EQU $-1
01307 ;
2400 01308 END PURGE
2400 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]