[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/11/99 00:14:09 DIR - LS-DOS 6.3 Page 00001
00001 ;LBDIR/ASM - DIR / CAT Command
00003 ;
0000 00004 *GET BUILDVER/ASM:3
00005 ;
00006 ; Buildver/asm is a bit of a kludge since not all utilities can load
00007 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00008 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00009 ; for programs that can use that.
00010 ;
FFFF 00011 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00012 ; These switches activate patches made since the 1B release.
00013 ; It is important that all earlier patches be enabled when a higher
00014 ; patch is enabled.
00015 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00016 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00017 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00018 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00019 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00020 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00021 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00022 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00023 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00024 ;
00025 ;End of BUILDVER/ASM
2400 00026 ORG 2400H
00027 ;
2400 C39C2D 00028 ENTRY JP DIR ;Go if DIR
00029 ;
2403 E5 00030 CATBGN PUSH HL ;Here if CAT
2404 210000 00031 LD HL,0 ;Set the DIR (A
2407 22FC27 00032 LD (APARM+1),HL ; parameter to OFF
240A E1 00033 POP HL ; and do a DIR
240B 18F3 00034 JR ENTRY ; command
00035 ;
4296 00036 BLKHASH EQU 4296H ;Hash code of blank password
00037 ;
240D 00038 *GET SVCMAC:3 ;Get SVC Macro equivalents and
00039 ;SVCMAC/ASM - LS-DOS Version VI
00040 *LIST OFF
00432 *LIST ON
240D 00434 *GET VALUES:3 ; other misc. equates
00435 ;VALUES/ASM - Version 6
00436 *LIST OFF
00463 *LIST ON
00464 ;
240D 00465 *GET LBDIRA:3
00466 ;LBDIRA/ASM - DIR main processing loop
00469 ;
00470 ; error processing
00471 ;
240D 21532D 00472 NOMEM LD HL,NOMEM$
2410 DD 00473 DB 0DDH
2411 21662D 00474 BADFMT LD HL,BADFMT$
2414 00475 @@LOGOT
00476 IFEQ 00H,1
00477 LD HL,
00478 ENDIF
2414+3E0C 00479 LD A,12
2416+EF 00480 RST 40
00481 ;
2417 21FFFF 00482 ABORT LD HL,-1 ;Set HL = -1
241A 180F 00483 JR SAVESP ;Abort
00484 ;
00485 ; I/O Error Routine
00486 ;
241C 3E20 00487 ERR32 LD A,32 ;"Illegal Drive Number"
241E 6F 00488 IOERR LD L,A ;Set HL = Error #
241F 2600 00489 LD H,0
2421 F6C0 00490 OR 0C0H ;Set short error
2423 4F 00491 LD C,A ;Stuff in C
2424 00492 @@ERROR ;Display error
2424+3E1A 00493 LD A,26
2426+EF 00494 RST 40
00495 IF @BLD631
2427 DD 00496 DB 0DDH ;<631>Make LD IX,0000 for fall-thru HL NZ
00497 ELSE
00498 JR SAVESP ;Abort
00499 ENDIF
00500 ;
00501 ; Clear stack & Exit
00502 ;
2428 210000 00503 EXIT LD HL,0 ;Good exit
242B 310000 00504 SAVESP LD SP,$-$ ;P/u old SP address
242E 00505 ABORT3 @@CKBRKC ;Clear break
242E+3E6A 00506 LD A,106
2430+EF 00507 RST 40
2431 C9 00508 RET ;Go home now
00509 ;
00510 ; Init to 4 files/line & Drive # in string
00511 ;
2432 C5 00512 DIR4 PUSH BC ;Save drive #
2433 3E04 00513 LD A,4 ;4 filespecs/line
2435 320428 00514 LD (DONAM9+1),A ;Save
2438 41 00515 LD B,C ;Set for drive date type
2439 04 00516 INC B ;Always do once
243A 3E3F 00517 LD A,47H-8 ;Bit x,A opcode
243C C608 00518 DVTLP ADD A,8
243E 10FC 00519 DJNZ DVTLP
2440 32852A 00520 LD (DVTEST),A ;Save for unpack routine
2443 32F828 00521 LD (DVTEST1),A ; and display code
2446 79 00522 LD A,C ;P/u drive #
2447 C630 00523 ADD A,'0' ;Convert to ASCII
2449 32432C 00524 LD (DRIVE),A ; & stuff in message
244C 32072D 00525 LD (NDRIVE),A ;Also stuff in No Disk
00526 ;
00527 ; Is the starting Drive available ?
00528 ;
244F 00529 @@GTDCT ;IY => DCT+0
244F+3E51 00530 LD A,81
2451+EF 00531 RST 40
2452 00532 @@CKDRV ;Drive alive ?
2452+3E21 00533 LD A,33
2454+EF 00534 RST 40
2455 F5 00535 PUSH AF ;Save RETurn condition
2456 CDCD2A 00536 CALL CKPAWS ; hit ?
2459 F1 00537 POP AF ;NZ - couldn't log drive
245A 2826 00538 JR Z,GDCKDRV ;Z - Logged drive succ
00539 ;
00540 ; Is this Drive enabled ?
00541 ;
245C FD7E00 00542 LD A,(IY) ;P/u Enable/Disable byte
245F FEC3 00543 CP 0C3H ;Enabled ?
2461 2809 00544 JR Z,NO_DISK ;Yes - display No Disk
00545 ;
00546 ; If this is not global - Illegal Drive #
00547 ;
2463 3A3A26 00548 LD A,(SPECIF+1) ;Specific drive # ?
2466 B7 00549 OR A ;
2467 CA1C24 00550 JP Z,ERR32 ;Yes - illegal drive #
246A 1813 00551 JR NEXTDRV ;No - get next drive
00552 ;
00553 ; Enabled Drive - Display "No Disk" string
00554 ;
246C 32C22A 00555 NO_DISK LD (NOTITLE+1),A ;Turn off title
246F CD9F2A 00556 CALL CKPAGE ;Check for scroll
2472 21002D 00557 LD HL,NODISK ;HL => "No Disk" string
2475 CD102A 00558 CALL LINOUT ;Display line
2478 CD9F2A 00559 CALL CKPAGE ;Check for scroll
247B AF 00560 XOR A ;Turn on Title
247C 32C22A 00561 LD (NOTITLE+1),A ;
00562 ;
247F C33826 00563 NEXTDRV JP CKHIT4 ;Get next drive
00564 ;
00565 ; Calculate quantity of Sectors/Gran
00566 ;
2482 C5 00567 GDCKDRV PUSH BC ;Save Drive #
2483 FD7E08 00568 LD A,(IY+8) ;P/u # Sectors/Gran
2486 E61F 00569 AND 1FH ;Mask off junk
2488 3C 00570 INC A ;Bump for zero offset
2489 32442A 00571 LD (CALCK1+1),A ;Stuff it
00572 ;
00573 ; P/u # Cylinders from DCT & stuff in string
00574 ;
248C FD6E06 00575 LD L,(IY+6) ;P/u cyl count
248F 2C 00576 INC L ;Offset from 0
2490 2600 00577 LD H,0 ;Stuff in HL
2492 114E2C 00578 LD DE,CYLCNT-2 ;DE => Destination
2495 00579 @@HEXDEC
2495+3E61 00580 LD A,97
2497+EF 00581 RST 40
00582 ;
00583 ; Create "DDEN" String or "HARD" string
00584 ;
2498 11592C 00585 LD DE,DENSITY ;Destination
249B 21342C 00586 LD HL,DEN
249E 3E44 00587 LD A,'D'
24A0 FDCB0376 00588 BIT 6,(IY+3) ;Ck density
24A4 2002 00589 JR NZ,DUBDEN
24A6 3E53 00590 LD A,'S'
24A8 77 00591 DUBDEN LD (HL),A
24A9 010400 00592 LD BC,4 ;4 chars to Xfer
24AC FDCB035E 00593 BIT 3,(IY+3) ;Hard Drive ?
24B0 2803 00594 JR Z,DOLDIR
24B2 21382C 00595 LD HL,HARD ;HL => "HARD"
24B5 EDB0 00596 DOLDIR LDIR ;Xfer string
00597 ;
00598 ; Drive logged in - Read in GAT
00599 ;
24B7 C1 00600 POP BC ;Recover Drive #
24B8 21002E 00601 LD HL,GAT ;HL => GAT buffer
24BB FD5609 00602 LD D,(IY+9) ;D = Directory Cyl
00603 IF @BLD631
24BE 5D 00604 LD E,L ;<631>E = L = 0 = GAT Sector
00605 ELSE
00606 LD E,0 ;E = Gat Sector
00607 ENDIF
24BF 00608 @@RDSSC ;Read Sector
24BF+3E55 00609 LD A,85
24C1+EF 00610 RST 40
24C2 3E14 00611 LD A,20 ;Init "GAT Read Error"
24C4 C21E24 00612 JP NZ,IOERR
24C7 CDCD2A 00613 CALL CKPAWS ; hit ?
00614 ;
00615 ;
00616 ; Calculate the FREE space on the disk
00617 ;
00618 ;
24CA 110000 00619 LD DE,0 ;DE = Gran count
24CD 2ECC 00620 LD L,0CCH ;HL => GAT + X'CC'
24CF 7E 00621 LD A,(HL) ;P/u excess cyl byte
24D0 C623 00622 ADD A,35 ;Cyl excess of 35
24D2 47 00623 LD B,A ;Set loop counter
24D3 6A 00624 LD L,D ;HL => GAT + X'00'
24D4 C5 00625 PUSH BC ;Save cyl count in B
00626 ;
00627 ; HL => GAT, B = # of cyls, DE = Gran count
00628 ;
24D5 7E 00629 FS1 LD A,(HL) ;P/u a GAT byte & set
24D6 37 00630 FS2 SCF ;Carry so bit 7 stays 1
00631 ;
00632 ; Is the granule in use ?
00633 ;
24D7 1F 00634 RRA ;Shift gran bit -> carry
24D8 3801 00635 JR C,FS3 ;Don't inc if in use
00636 ;
00637 ; Free Granule - bump Free Granule Count
00638 ;
24DA 13 00639 INC DE ;Another spare gran
24DB FEFF 00640 FS3 CP 0FFH ;Fin with this GAT byte?
24DD 20F7 00641 JR NZ,FS2 ;Loop if not
00642 ;
00643 ; Finished with GAT byte, advance to next
00644 ;
24DF 2C 00645 INC L ;Advance to next byte
24E0 10F3 00646 DJNZ FS1 ;B cylinders to check
00647 ;
00648 ; DE = Free Grans, Calculate # Grans/cyl
00649 ;
24E2 C1 00650 POP BC ;B = # of cylinders
24E3 FD7E08 00651 LD A,(IY+8) ;P/u DCT+8
24E6 07 00652 RLCA ;Move Grans/Cyl into
24E7 07 00653 RLCA ;Bits 0-2
24E8 07 00654 RLCA
24E9 E607 00655 AND 7
24EB 3C 00656 INC A ;A = Grans/Cylinder
24EC FDCB046E 00657 BIT 5,(IY+4) ;Double-bit set ?
24F0 2801 00658 JR Z,NOTDUB ;No - don't double
24F2 87 00659 ADD A,A ;Double grans/cylinder
00660 ;
00661 ; A = # Grans/Cyl, Calculate Total # of Grans
00662 ;
24F3 210000 00663 NOTDUB LD HL,0 ;Init HL = 0
24F6 D5 00664 PUSH DE ;Save Free Grans
24F7 54 00665 LD D,H ;Set DE = # cyls
24F8 58 00666 LD E,B
24F9 47 00667 LD B,A ;B = Grans/Cyl
00668 ;
00669 ; Multiply Grans/Cyl (B) x # Cyls (DE)
00670 ;
24FA 19 00671 GPCLOOP ADD HL,DE ;Add cylinder count
24FB 10FD 00672 DJNZ GPCLOOP ;Grans/cyl times
00673 ;
00674 ; HL = # of grans/disk, Is this a hard drive ?
00675 ;
24FD FDCB035E 00676 BIT 3,(IY+3) ;Hard Drive ?
2501 201E 00677 JR NZ,SKIPLOC ;Yes-don't check lockout
00678 ;
00679 ; Floppy disk - check for locked out cylinders
00680 ;
2503 43 00681 LD B,E ;B = cylinder count
2504 EB 00682 EX DE,HL ;Save total cnt in DE
2505 21602E 00683 LD HL,GAT+60H ;HL => Lockout table
2508 0E00 00684 LD C,0 ;C = Locked out cyl count
250A F5 00685 PUSH AF ;Save Grans/Cyl in A
00686 ;
00687 ; Loop to count up Locked out cylinders in C
00688 ;
250B 3E01 00689 LKLOOP LD A,1 ;Init cyl checker
250D A6 00690 AND (HL) ;Locked out ?
250E 2801 00691 JR Z,GOODCYL ;No - good cylinder
2510 0C 00692 INC C ;Bump locked out count
2511 2C 00693 GOODCYL INC L ;Bump ptr
2512 10F7 00694 DJNZ LKLOOP ;B cylinders
00695 ;
00696 ; Multiply Cylinders (BC) x Grans/Cyl
00697 ;
2514 F1 00698 POP AF ;A = Grans/Cyl
2515 F5 00699 PUSH AF ;Save it
2516 60 00700 LD H,B ;Init HL = 0
2517 68 00701 LD L,B
00702 ;
2518 09 00703 GTUSED ADD HL,BC ;Add cylinder count
2519 3D 00704 DEC A ;Grans/cyl times
251A 20FC 00705 JR NZ,GTUSED
251C F1 00706 POP AF ;A = Grans/Cyl
00707 ;
00708 ; Subtract # of Grans locked out from total
00709 ;
251D B7 00710 OR A ;Clear carry
251E EB 00711 EX DE,HL
251F ED52 00712 SBC HL,DE ;HL = Grans possible
2521 D1 00713 SKIPLOC POP DE ;Rcvr # of Free Grans
00714 ;
00715 ; HL = # Grans possible, DE = # Grans Free
00716 ;
2522 E5 00717 PUSH HL ;Save Grans used
2523 21652C 00718 LD HL,KFREE ;Convert Grans Free
2526 CD3F2A 00719 CALL CALCK ; to ASCII K & stuff
2529 D1 00720 POP DE ; into string.
00721 ;
00722 ; Calculate # of K used & stuff into header
00723 ;
252A 21712C 00724 LD HL,KPOSS ;Pt to where to stuff
252D CD3F2A 00725 CALL CALCK ;Calculate K & stuff
00726 ;
00727 ; Transfer Diskette Name into string buffer
00728 ;
2530 21D02E 00729 LD HL,GAT+0D0H ;HL => Diskette Name
2533 11462C 00730 LD DE,NAME ;Move pack name -> header
2536 0E08 00731 LD C,8 ;BC = 8 chars to xfer
2538 EDB0 00732 LDIR ;Xfer into buff
00733 ;
00734 ; Clear out Date buffer
00735 ;
253A 11822C 00736 LD DE,DATBUF ;DE => Start of buffer
253D 3E20 00737 LD A,' ' ;Space
253F 0609 00738 LD B,9 ;9 chars to clear
2541 12 00739 CLRLP LD (DE),A ;Stuff in space
2542 13 00740 INC DE ;Bump
2543 10FC 00741 DJNZ CLRLP
00742 ;
00743 ; HL => Date in mm/dd/yy format - p/u month
00744 ;
2545 7E 00745 LD A,(HL) ;P/u month
2546 D630 00746 SUB '0' ;Convert tens to binary
2548 4F 00747 LD C,A ;Save in C
00748 ;
00749 ; Multiply first digit of month x 10
00750 ;
2549 87 00751 ADD A,A ;X 2
254A 87 00752 ADD A,A ;X 4
254B 81 00753 ADD A,C ;X 5
254C 87 00754 ADD A,A ;X 10
254D 4F 00755 LD C,A ;Stuff in C
00756 ;
00757 ; Pick up second digit of month & add to 10's
00758 ;
254E 23 00759 INC HL ;Bump to ones
254F 7E 00760 LD A,(HL) ;P/u ones of month
00761 IF @BLD631
2550 D631 00762 SUB '1' ;<631>Convert to binary
00763 ELSE
00764 SUB '0' ;Convert to binary
00765 ENDIF
2552 81 00766 ADD A,C ;A = Month (1-12)
00767 IF @BLD631
2553 FE0C 00768 CP 12 ;<631>Legal Month ?
00769 ELSE
00770 JR Z,ILLDATE ;Abort if NO DATE
00771 CP 13 ;Legal Month ?
00772 ENDIF
2555 3026 00773 JR NC,ILLDATE ;No - illegal date
00774 ;
00775 ; Legal Month - Mult x 3 & pt to month string
00776 ;
2557 4F 00777 LD C,A ;Xfer month to C
2558 87 00778 ADD A,A ;X 2
2559 81 00779 ADD A,C ;X 3
255A 4F 00780 LD C,A ;BC = offset
255B E5 00781 PUSH HL ;Save date pointer
00782 IF @BLD631
255C 21DC04 00783 LD HL,MONTBL ;<631>HL => Month String table
00784 ELSE
00785 LD HL,MONTBL-3 ;HL => Month String table
00786 ENDIF
255F 09 00787 ADD HL,BC ;HL => Month String
00788 ;
00789 ; HL => Month String, Stuff into Buffer
00790 ;
2560 3E2D 00791 LD A,'-' ;Init separator
2562 11852C 00792 LD DE,DATBUF+3 ;DE => Destination
2565 0E03 00793 LD C,3 ;BC = 3 chars to xfer
2567 EDB0 00794 LDIR ;Xfer date to buffer
2569 12 00795 LD (DE),A
00796 ;
00797 ; Transfer Day (00-31) into date buffer
00798 ;
256A E1 00799 POP HL ;Recover ptr
256B 23 00800 INC HL ;Bump
256C 23 00801 INC HL ;HL => Day of month
256D 11822C 00802 LD DE,DATBUF ;DE => date buffer
2570 0E02 00803 LD C,2 ;Xfer into buffer
2572 EDB0 00804 LDIR
2574 12 00805 LD (DE),A
00806 ;
00807 ; Transfer Year into buffer
00808 ;
2575 23 00809 INC HL ;HL => Year (80-87)
2576 0E02 00810 LD C,2 ;2 chars to xfer
2578 11892C 00811 LD DE,DATBUF+7 ;DE => Destination
257B EDB0 00812 LDIR ;Xfer into buffer
00813 ;
00814 ; Display the files in the directory
00815 ; Init DIR rec ptr = mem start, count = 0
00816 ;
00817 IF @BLD631G
257D 7A 00818 ILLDATE:LD A,D ;<631G>Set flag
00819 ELSE
00820 ILLDATE INC A ;Set flag
00821 ENDIF
257E 329B2D 00822 LD (FILFLAG),A ;Set file alr disp flag
2581 210030 00823 LD HL,MEMORY ;Init DIRPTR to start
2584 229C2D 00824 LD (DIRPTR),HL ; of available memory
2587 AF 00825 XOR A ;Set File display
2588 ED62 00826 SBC HL,HL ;Set HL = 0
258A 22F625 00827 LD (TFILES+1),HL ;Total Files = 0
258D 22DA25 00828 LD (COUNT+1),HL ;Count = 0
2590 220126 00829 LD (TOTGRNS+1),HL ;Total Grans = 0
00830 ;
00831 ; Read in the HIT of the disk
00832 ;
2593 C1 00833 POP BC ;Recover Drive # in C
2594 FD5609 00834 LD D,(IY+9) ;P/u directory cylinder
2597 1E01 00835 LD E,1 ;Pt to HIT sector
2599 21002E 00836 LD HL,HIT ;HL => I/O buffer
259C 00837 @@RDSSC ;Read System Sector
259C+3E55 00838 LD A,85
259E+EF 00839 RST 40
259F 3E16 00840 LD A,16H ;"HIT read error"?
25A1 C21E24 00841 JP NZ,IOERR ;Jump if read error
25A4 CDCD2A 00842 CALL CKPAWS ; hit ?
25A7 C34826 00843 $JP0 JP CKHIT5 ;Jump into middle of loop
00844 ;
00845 ; Loop to Process HIT entries
00846 ;
25AA E1 00847 CKHIT POP HL
25AB C1 00848 CKHIT1 POP BC ;Recover HIT pointer lo
00849 ;
00850 ; Point HL => Last HIT entry
00851 ;
25AC 262E 00852 LD H,HIT<-8 ;Set H = hi byte of HIT
25AE 68 00853 LD L,B ;HL => Last HIT entry
00854 ;
00855 ; Position to next entry of the Record
00856 ;
25AF 7D 00857 CKHIT2 LD A,L ;P/u current entry
25B0 C620 00858 ADD A,32 ;Add 32 (bytes/entry)
25B2 6F 00859 LD L,A ;HL => Next entry
25B3 30F2 00860 JR NC,$JP0 ;Go to next record ?
00861 ;
00862 ; Position to entry zero of next record
00863 ;
25B5 2C 00864 INC L ;Posn to next record
25B6 CB6D 00865 BIT 5,L ;Done with drive ?
25B8 28ED 00866 JR Z,$JP0 ;No - process entry
00867 ;
00868 ; Finished with drive - Sort data unless (O=N)
00869 ;
25BA 3AFC26 00870 LD A,(SORTPRM+1) ;If sort requested,
25BD B7 00871 OR A ; then need to output
25BE C4142B 00872 CALL NZ,SORTIT ; the sorted data
00873 ;
00874 ; Were there any files displayed ?
00875 ;
25C1 2ADA25 00876 LD HL,(COUNT+1) ;P/u displayed file count
25C4 7C 00877 LD A,H ;Any entered ?
25C5 B5 00878 OR L
25C6 200B 00879 JR NZ,FILES ;Yes - dsp under if (A)
00880 ;
00881 ; Display Title & line feed
00882 ;
25C8 213C2C 00883 LD HL,DSTRING ;HL => Title
25CB CD102A 00884 CALL LINOUT ;Display title
25CE CD9F2A 00885 CALL CKPAGE ;Check for scroll
25D1 184A 00886 JR NOTAP ;Get next drive
00887 ;
00888 ; Get next drive # if the A parm was specified
00889 ;
25D3 3AFC27 00890 FILES LD A,(APARM+1) ;Don't display if A
25D6 B7 00891 OR A
25D7 2844 00892 JR Z,NOTAP ;Not A - Output C/R
00893 ;
00894 ; Were there any files shown in directory ?
00895 ;
25D9 210000 00896 COUNT LD HL,$-$ ;P/u count
25DC 7C 00897 LD A,H ;Any files shown ?
25DD B5 00898 OR L
25DE 284E 00899 JR Z,TERMDRV ;No - get next drive
00900 ;
00901 ; Display Line of equal signs "="
00902 ;
25E0 064F 00903 LD B,79 ;Output 79 "="
25E2 3E3D 00904 D79EQ LD A,'='
25E4 CD222A 00905 CALL BYTOUT ;Output "="
25E7 10F9 00906 DJNZ D79EQ
00907 ;
00908 ; End line & check for scroll
00909 ;
00910 IF @BLD631
25E9 CD9A2A 00911 CALL CKPAGE1 ;<631>
00912 ELSE
00913 LD A,CR ;End line with C/R
00914 CALL BYTOUT
00915 CALL CKPAGE
00916 ENDIF
00917 ;
00918 ; Stuff # of files used into footer string
00919 ;
25EC C5 00920 PUSH BC ;Save Drive #
25ED 0603 00921 LD B,3 ;Max digits to dsp
25EF 11DA2C 00922 LD DE,FDISP ;DE => Destination
25F2 00923 @@HEXD
25F2+3E5F 00924 LD A,95
25F4+EF 00925 RST 40
00926 ;
00927 ; Pick up # of used files & stuff in string
00928 ;
25F5 210000 00929 TFILES LD HL,$-$ ;P/u total files used
25F8 11E72C 00930 LD DE,FUSED+1 ;DE => Destination
25FB 0603 00931 LD B,3
25FD 00932 @@HEXD
25FD+3E5F 00933 LD A,95
25FF+EF 00934 RST 40
00935 ;
00936 ; P/u Total # of Grans & stuff into string
00937 ;
2600 110000 00938 TOTGRNS LD DE,$-$ ;P/u total # of Grans
2603 21F52C 00939 LD HL,SPUSED ;HL => Destination
2606 CD3F2A 00940 CALL CALCK ;Stuff into string
2609 0613 00941 LD B,19
260B CD372A 00942 CALL OUTSPC
260E C1 00943 POP BC ;C = drive #
00944 ;
00945 ; Display Footer String
00946 ;
260F 21DA2C 00947 LD HL,FDISP ;HL => Files disp string
2612 CD102A 00948 CALL LINOUT ;Display line
2615 CD9F2A 00949 CALL CKPAGE ;Check for title
2618 CD9F2A 00950 CALL CKPAGE
261B 1811 00951 JR TERMDRV ;Get next drive
00952 ;
00953 ; A parm not spec'd, was a header displayed ?
00954 ;
261D 3A9B2D 00955 NOTAP LD A,(FILFLAG) ;Was a header displayed ?
2620 B7 00956 OR A
2621 200B 00957 JR NZ,TERMDRV ;No - get next drive
00958 ;
00959 ; Output a C/R if a full line wasn't displayed
00960 ;
2623 3A0428 00961 LD A,(DONAM9+1) ;Full line ?
2626 FE04 00962 CP 4
2628 C40F28 00963 CALL NZ,ENDLINE ;End line
262B CD0F28 00964 CALL ENDLINE ;Do a blank line
00965 ;
00966 ; Position to next drive - or exit if finished
00967 ;
262E 3E00 00968 TERMDRV LD A,$-$ ;P/u term drive
2630 0C 00969 INC C ;Bump current drive #
2631 B9 00970 CP C ;Done ?
00971 IF @BLD631E
00972 TODIR4: ;<631E>
00973 ENDIF
2632 D23224 00974 JP NC,DIR4 ;Loop if in range
2635 C32824 00975 JP EXIT ;Exit if NZ
00976 ;
00977 ; Get next drive unless drivespec specified
00978 ;
2638 C1 00979 CKHIT4 POP BC ;Get drive # in C
2639 3E00 00980 SPECIF LD A,$-$ ;P/u specific flag
263B B7 00981 OR A
00982 IF @BLD631
00983 IF @BLD631E
263C 210000 00984 LD HL,0 ;<631E>Put it back the way it was B4 631
00985 ELSE
00986 LD H,A ;<631>Init in case exit
00987 LD L,A ;<631>A will equal zero in this case so HL=0
00988 ENDIF ;<631E>
00989 ELSE
00990 LD HL,0 ;Init in case exit
00991 ENDIF
263F C8 00992 RET Z ;Not global
00993 ;
00994 ; Bump Drive number
00995 ;
2640 3A2F26 00996 LD A,(TERMDRV+1) ;P/u term drive #
2643 0C 00997 INC C ;Bump
2644 B9 00998 CP C ;Finished ?
00999 IF @BLD631E
2645 30EB 01000 JR NC,TODIR4 ;<631>Loop if more
01001 ELSE
01002 JP NC,DIR4 ;Loop if more
01003 ENDIF
2647 C9 01004 RET ; else return
01005 ;
01006 ; Is the HIT entry in use ?
01007 ;
2648 7E 01008 CKHIT5 LD A,(HL) ;P/u HIT entry
2649 B7 01009 OR A ;In use ?
264A CAAF25 01010 JP Z,CKHIT2 ;No - get next entry
01011 ;
01012 ; HIT entry in use - Point HL to that entry
01013 ;
264D 45 01014 LD B,L ;Save DEC in B
264E C5 01015 PUSH BC ; & to stack
264F 7D 01016 LD A,L ;Point L to Entry posn
2650 E6E0 01017 AND 0E0H
2652 6F 01018 LD L,A
01019 ;
01020 ; Do we need to Read in another sector ?
01021 ;
2653 A8 01022 XOR B ;Done with 8 entries ?
2654 FEFF 01023 CKHIT6 CP 0FFH
2656 2810 01024 JR Z,CKDIR1 ;No - check out entry
01025 ;
01026 ; Read in the next directory sector
01027 ;
2658 325526 01028 LD (CKHIT6+1),A ;Stuff in last entry posn
265B 01029 @@DIRRD ; & read it into buffer
265B+3E57 01030 LD A,87
265D+EF 01031 RST 40
265E C21E24 01032 JP NZ,IOERR ;Jump on read error
2661 7C 01033 LD A,H ;P/u high byte
2662 326926 01034 LD (CKDIR1+1),A ; and save
2665 32DD29 01035 LD (SBUFFER+1),A ; for later
01036 ;
01037 ; Valid File (Alive & FPDE) ?
01038 ;
2668 2600 01039 CKDIR1 LD H,$-$ ;P/u high byte
266A CB66 01040 BIT 4,(HL) ;Alive ?
266C CAAB25 01041 JP Z,CKHIT1 ;No - get next entry
266F CB7E 01042 BIT 7,(HL) ;FPDE ?
2671 C2AB25 01043 JP NZ,CKHIT1 ;No - get next entry
01044 ;
01045 ; Alive FPDE - Bump Total File counter
01046 ;
2674 E5 01047 PUSH HL ;Save ptr
2675 2AF625 01048 LD HL,(TFILES+1) ;HL => Total Files
2678 23 01049 INC HL ;Bump total files
2679 22F625 01050 LD (TFILES+1),HL
267C E1 01051 POP HL
01052 ;
01053 ; Is this a SYStem File ?
01054 ;
267D CB76 01055 BIT 6,(HL) ;SYS file ?
267F 280A 01056 JR Z,CKDIR3 ;No - continue
01057 ;
01058 ; SYS file - don't check unless S parm entered
01059 ;
2681 110000 01060 SPARM LD DE,$-$ ;P/u S-parm
2684 7A 01061 LD A,D ;Specified ?
2685 B3 01062 OR E
2686 CAAB25 01063 JP Z,CKHIT1 ;No - don't check it
2689 180C 01064 JR CKMOD ;Skip INV check
01065 ;
01066 ; Non-SYS file - Is the file Visible ?
01067 ;
268B CB5E 01068 CKDIR3 BIT 3,(HL) ;Visible ?
268D 2808 01069 JR Z,CKMOD ;Yes - skip I check
01070 ;
01071 ; File is invisible - was INV (I) specified ?
01072 ;
268F 110000 01073 IPARM LD DE,$-$ ;I-parm
2692 7A 01074 LD A,D ;Ignore if I-parm not
2693 B3 01075 OR E ; entered as this file
2694 CAAB25 01076 JP Z,CKHIT1 ; is invisible
01077 ;
01078 ; Was the MOD parm entered ?
01079 ;
2697 110000 01080 CKMOD LD DE,$-$ ;P/u mod parm
269A 7A 01081 LD A,D ;Was it entered ?
269B B3 01082 OR E
269C 2807 01083 JR Z,CKNAM ;Go if MOD not entered
01084 ;
01085 ; MOD parm entered - was this file modified ?
01086 ;
269E 2C 01087 INC L ;HL => DIR + 1
269F CB76 01088 BIT 6,(HL) ;Was the file modified ?
26A1 CAAB25 01089 JP Z,CKHIT1 ;No - get next entry
26A4 2D 01090 DEC L ;Adjust back to start
01091 ;
01092 ; Attributes match - check if filespec matches
01093 ;
26A5 E5 01094 CKNAM PUSH HL ;Save ptr to record
26A6 7D 01095 LD A,L ;Pt to filename in dir
26A7 C605 01096 ADD A,5
26A9 6F 01097 LD L,A ;HL => DIR filename
26AA 11A72D 01098 LD DE,BLANKS ;DE => Partspec input
26AD 060B 01099 LD B,11 ;Ck name/ext (11-chars)
01100 ;
01101 ; Loop to check if partspec matches dir name
01102 ;
26AF 1A 01103 CKNAM1 LD A,(DE) ;P/u partspec
26B0 FE24 01104 CP '$' ;Wild char?
26B2 2807 01105 JR Z,CKNAM2 ;Yes - match
01106 ;
01107 ; Does Directory char match partspec char ?
01108 ;
26B4 BE 01109 CP (HL) ;Not global, char match?
26B5 2804 01110 JR Z,CKNAM2 ;Ck more if match
01111 ;
01112 ; Chars don't match - Dir char a space ?
01113 ;
26B7 FE20 01114 CP ' ' ;Blank = end of ck
26B9 200B 01115 JR NZ,MFLG ;If not blank, no match
01116 ;
01117 ; Bump Dir ptr & Partspec ptr & continue loop
01118 ;
26BB 23 01119 CKNAM2 INC HL ;Bump pointers
26BC 13 01120 INC DE
26BD 10F0 01121 DJNZ CKNAM1 ;Loop for 11 chars
01122 ;
01123 ; Entries Match - Was the "-" Exclude given ?
01124 ;
26BF 3AC726 01125 LD A,(MFLG+1) ;P/u flag
26C2 FE2D 01126 CP '-' ; - exclude given ?
26C4 1803 01127 JR CK2HIT ;Yes - get next entry
01128 ;
01129 ; Entries Don't match - Was exclude given ?
01130 ;
26C6 3E00 01131 MFLG LD A,$-$ ;P/u Exclude flag
26C8 B7 01132 OR A ;If no exclude given
26C9 CAAA25 01133 CK2HIT JP Z,CKHIT ; get next entry
01134 ;
01135 ; Recover DIR+0 pointer
01136 ;
26CC E1 01137 CKNAM2A POP HL ;Rcvr ptr to DIR+0
26CD E5 01138 PUSH HL ;Save
01139 ;
01140 ; Unpack Date of Directory entry
01141 ;
26CE 23 01142 INC HL ;HL => DIR+1
26CF CD702A 01143 CALL UNPACK ;Unpack date
01144 ;
01145 ; Use Dates before user-specified date ?
01146 ;
26D2 3A9A2D 01147 LD A,(FTFLG) ;P/u From/To flag
26D5 07 01148 RLCA ;Tst fm bit
26D6 300F 01149 JR NC,CKNAM2B ;No - check to
01150 ;
01151 ; "FROM" flag set - does file have a date ?
01152 ;
26D8 7A 01153 LD A,D ;Ignore if no date
26D9 B3 01154 OR E ; in DIR for file
26DA CAAA25 01155 JP Z,CKHIT ;No date - get next entry
01156 ;
01157 ; Is the Specified date >= the file's date ?
01158 ;
26DD 2AA02D 01159 LD HL,(FMPAKD) ;P/u user date entry
26E0 EB 01160 EX DE,HL
26E1 CD6A2A 01161 CALL CPHLDE ;Compare HL to DE
26E4 EB 01162 EX DE,HL ;File date < User date ?
26E5 3811 01163 JR C,$JP1 ;Yes - get next entry
01164 ;
01165 ; Use Dates after user-specified Date ?
01166 ;
26E7 3A9A2D 01167 CKNAM2B LD A,(FTFLG) ;P/u FROM/TO flag
26EA 0F 01168 RRCA ;Test TO bit
26EB 300E 01169 JR NC,SORTPRM ;Go if no TOPARM
01170 ;
01171 ; "TO" Flag set - Does file have a date ?
01172 ;
26ED 7A 01173 LD A,D ;File have a valid date ?
26EE B3 01174 OR E
26EF CAAA25 01175 JP Z,CKHIT ;No - get next entry
01176 ;
01177 ; File has a date - Is spec'd date less ?
01178 ;
26F2 2AA22D 01179 LD HL,(TOPAKD) ;P/u user's packed date
26F5 CD6A2A 01180 CALL CPHLDE ;User date < File date ?
26F8 DAAA25 01181 $JP1 JP C,CKHIT ;Yes - get next entry
01182 ;
01183 ; Was the Sort Parameter turned off ?
01184 ;
26FB 11FFFF 01185 SORTPRM LD DE,-1 ;P/u default parm
26FE E1 01186 POP HL ;HL => DIR+0
26FF 7A 01187 LD A,D ;Default to SORT=ON
2700 B3 01188 OR E
2701 282D 01189 JR Z,DODSP ;Go display if no sort
01190 ;
01191 ; SORT = ON --- Calculate allocation & extents
01192 ;
2703 E5 01193 PUSH HL ;Save DIR + 0 ptr
2704 CDB229 01194 CALL ALL09A ;Calc alloc & extents
2707 E1 01195 POP HL ;Recover DIR+0 ptr
01196 ;
01197 ; Overwrite FPDE's 22-25 with # Grans & # exts
01198 ;
2708 E5 01199 PUSH HL ;Point IX = DIR+22
2709 DDE1 01200 POP IX
270B DD7316 01201 LD (IX+22),E ;Stuff in # Grans
270E DD7217 01202 LD (IX+23),D
2711 DD7118 01203 LD (IX+24),C ;Stuff in # Extents
2714 DD7019 01204 LD (IX+25),B
01205 ;
01206 ; Transfer Record into Memory For Sort
01207 ;
2717 ED5B9C2D 01208 LD DE,(DIRPTR) ;P/u last used mem addr
271B E5 01209 PUSH HL ;Save current DIR ptr
271C 012000 01210 LD BC,32 ;Move record to buffer
271F EDB0 01211 LDIR ;Xfer
2721 ED539C2D 01212 LD (DIRPTR),DE ;Update the pointer
01213 ;
01214 ; Is there an overflow of available memory ?
01215 ;
2725 2A9E2D 01216 LD HL,(MAXMEM) ;P/u approximate hi-mem
2728 ED52 01217 SBC HL,DE ;Did it overflow ?
272A D2AA25 01218 JP NC,CKHIT ;No - get next entry
272D C30D24 01219 JP NOMEM ;Insuf mem for sort buff
01220 ;
01221 ; Display A Filename
01222 ;
2730 CD3627 01223 DODSP CALL MATCH ;Display entry
2733 C3AB25 01224 JP CKHIT1 ;Loop to next DIR entry
2736 01225 *GET LBDIRB:3
01226 ;LBDIRB/ASM - Display Filespec & attributes
01229 ;
01230 ; MATCH - Display a File's Name and Extension
01231 ;
2736 E5 01232 MATCH PUSH HL ;Save HIT posn
2737 21DA25 01233 LD HL,COUNT+1 ;Bump file count
273A 34 01234 INC (HL)
01235 ;
01236 ; Was the Drive Header Displayed ?
01237 ;
273B 219B2D 01238 LD HL,FILFLAG ;HL => File Header flag
273E AF 01239 XOR A ;If (HL) is Non-Zero
273F BE 01240 CP (HL) ; then the header has not
2740 77 01241 LD (HL),A ; printed.
2741 C4EB2A 01242 CALL NZ,CKTITL ;Display title if NZ
01243 ;
01244 ; Position HL to Directory Entry Filename
01245 ;
2744 E1 01246 ALRPRT POP HL ;Recover DEC
2745 7D 01247 LD A,L ;P/u DEC
2746 E6E0 01248 AND 0E0H ;Posn to entry
2748 C605 01249 ADD A,5 ;Pt to start of filename
274A 6F 01250 LD L,A ;HL => Filename field
01251 ;
01252 ; Init B=8 chars for filename, C=19 to col
01253 ;
274B 0E13 01254 LD C,19 ;Chars to next column
274D 0608 01255 LD B,8 ;Filename
01256 ;
01257 ; Loop to Output the Filename
01258 ;
274F 7E 01259 DONAM1 LD A,(HL) ;P/u character
2750 23 01260 INC HL ;Bump DIR ptr
2751 FE20 01261 CP ' ' ;Space ?
2753 2807 01262 JR Z,DONAM2 ;Yes - done with filename
2755 CD212A 01263 CALL BYTOUT2 ;No - output char
2758 10F5 01264 DJNZ DONAM1 ;Field loop
275A 1804 01265 JR DONAM3 ;Bypass ext calculation
01266 ;
01267 ; Filename has < 8 chars, Pt to extension
01268 ;
275C 7D 01269 DONAM2 LD A,L ;P/u low byte
275D 80 01270 ADD A,B ;Add # of chars left
275E 3D 01271 DEC A ;Back one
275F 6F 01272 LD L,A ;HL => Extension
01273 ;
01274 ; Does this file have an extension ?
01275 ;
2760 7E 01276 DONAM3 LD A,(HL) ;P/u first char
2761 FE20 01277 CP ' ' ;Blank
2763 2812 01278 JR Z,DONAM5 ;Yes - no extension
01279 ;
01280 ; Output a "/" & Set up for Extension loop
01281 ;
2765 3E2F 01282 LD A,'/' ;Display slash
2767 CD212A 01283 CALL BYTOUT2
276A 0603 01284 LD B,3 ;3 chars max for EXT
01285 ;
01286 ; Loop to output the extension
01287 ;
276C 7E 01288 DONAM4 LD A,(HL) ;P/u char
276D 23 01289 INC HL ;Bump ptr
276E FE20 01290 CP ' ' ;Space ?
2770 2805 01291 JR Z,DONAM5 ;Exit on 1st blank
2772 CD212A 01292 CALL BYTOUT2 ;Else display the char
2775 10F5 01293 DJNZ DONAM4 ;Loop 3 chars
01294 ;
01295 ; Was the (A) parameter specified ?
01296 ;
2777 3AFC27 01297 DONAM5 LD A,(APARM+1) ;A parm specified ?
277A B7 01298 OR A
277B 2813 01299 JR Z,DONAM5A ;No - continue
01300 ;
01301 ; (A) parameter specified - Tab to column 14
01302 ;
277D 79 01303 LD A,C ;P/u chars left to col 20
277E D606 01304 SUB 6 ;Adjust to column 14
2780 47 01305 LD B,A ;Stuff into B for DJNZ
2781 CD372A 01306 CALL OUTSPC ;Output B spaces
01307 ;
01308 ; Output mod flag (if modified) & tab to 19
01309 ;
2784 7D 01310 LD A,L ;Pt HL => DIR+0
2785 E6E0 01311 AND 0E0H
2787 6F 01312 LD L,A
2788 CD8E29 01313 CALL OUTMOD ;Output "+" if mod
278B 0601 01314 LD B,1 ;Output 3 spaces
278D CD372A 01315 CALL OUTSPC ;Output B spaces
01316 ;
01317 ; Display the File's Attributes
01318 ;
2790 0601 01319 DONAM5A LD B,1 ;Set B=1 space
2792 CD372A 01320 CALL OUTSPC ;After filespec.
01321 ;
01322 ; Point HL => DIR+0 (Attributes)
01323 ;
2795 7D 01324 LD A,L ;Pt to 1st byte of
2796 E6E0 01325 AND 0E0H ;Directory record
2798 6F 01326 LD L,A
01327 ;
01328 ; Display "?" if File OPEN bit set
01329 ;
2799 3E3F 01330 LD A,'?' ;"?" character
279B 23 01331 INC HL ;HL => DIR + 1
279C CB6E 01332 BIT 5,(HL) ;File Open ?
279E 2B 01333 DEC HL ;HL => DIR + 0
279F C4212A 01334 CALL NZ,BYTOUT2 ;Yes - output byte
01335 ;
01336 ; Display an "*" if this is a PDS file
01337 ;
27A2 46 01338 LD B,(HL) ;P/u attributes byte
27A3 3E2A 01339 LD A,'*' ;Init for PDS display
27A5 CB68 01340 BIT 5,B
27A7 C4212A 01341 CALL NZ,BYTOUT2 ;Display if PDS
01342 ;
01343 ; Display an "S" if file is a SYS file
01344 ;
27AA CB70 01345 BIT 6,B ;Is it a SYS file?
27AC 3E53 01346 LD A,'S'
27AE C4212A 01347 CALL NZ,BYTOUT2 ;Display S if so
01348 ;
01349 ; Display an "I" if file is invisible
01350 ;
27B1 CB58 01351 BIT 3,B ;Is it an INV file?
27B3 3E49 01352 LD A,'I'
27B5 C4212A 01353 CALL NZ,BYTOUT2 ;Display I if so
01354 ;
01355 ; Point HL => Password Hash (DIR+16)
01356 ;
27B8 E5 01357 PUSH HL ;Save ptr to 1st dir byte
27B9 7D 01358 LD A,L ;Pt to owner password
27BA C610 01359 ADD A,16
27BC 6F 01360 LD L,A ;HL => DIR+16
01361 ;
01362 ; Pick up Password in DE
01363 ;
27BD 5E 01364 LD E,(HL) ;P/u in password in DE
27BE 2C 01365 INC L
27BF 56 01366 LD D,(HL)
01367 ;
01368 ; Is this a password protected File ?
01369 ;
27C0 E5 01370 PUSH HL ;Save ptr to user psw
27C1 219642 01371 LD HL,BLKHASH ;Init to blanks hash
27C4 ED52 01372 SBC HL,DE ;Is password blanks?
27C6 E1 01373 POP HL
27C7 2807 01374 JR Z,DONAM6 ;Blanks - no "P"assword
01375 ;
01376 ; Password - Display "P" if access <> ALL
01377 ;
27C9 78 01378 LD A,B ;P/u attributes byte
27CA E607 01379 AND 7 ;Get protection level
27CC 3E50 01380 LD A,'P' ;Init for protected
27CE 2002 01381 JR NZ,DONAM7 ;Stuff the 'P' if prot
27D0 3E20 01382 DONAM6 LD A,' ' ; else stuff a blank
01383 ;
01384 ; Set Password flag if protected & display "P"
01385 ;
27D2 321728 01386 DONAM7 LD (ALL02+1),A ;Stuff 'P' or blank
27D5 FE20 01387 CP ' ' ;Space ?
27D7 C4212A 01388 CALL NZ,BYTOUT2 ;Display char if needed
27DA E1 01389 POP HL ;HL => DIR+0
01390 ;
01391 ; Display a "C" if the file was Created
01392 ;
27DB 23 01393 INC HL ;HL => DIR+1
27DC 7E 01394 LD A,(HL) ;P/u attributes
27DD 2B 01395 DEC HL ;HL => DIR+0
27DE 07 01396 RLCA ;Created ?
27DF 3E43 01397 LD A,'C' ;"C"reate character
27E1 DC212A 01398 CALL C,BYTOUT2 ;Yes - output byte
01399 ;
01400 ; Display Mod flag here if (A) not specified
01401 ;
27E4 3AFC27 01402 LD A,(APARM+1) ;P/u A-parm
27E7 B7 01403 OR A
27E8 F5 01404 PUSH AF ;Save condition
27E9 CC8E29 01405 CALL Z,OUTMOD ;Output mod flag if -A
27EC F1 01406 POP AF ;NZ - (A) parm
01407 ;
01408 ; If (A) parameter given - then tab to col 26
01409 ;
27ED 2804 01410 JR Z,DONAM8 ;Not A - go to 20
27EF 3E04 01411 LD A,4 ;Add 6 to column #
27F1 81 01412 ADD A,C
27F2 4F 01413 LD C,A ;C = # of spaces
01414 ;
01415 ; Position to Next designated column
01416 ;
27F3 3E20 01417 DONAM8 LD A,' ' ;Write a space
27F5 CD222A 01418 CALL BYTOUT ;Output byte
27F8 0D 01419 DEC C ;Dec column counter
27F9 20F8 01420 JR NZ,DONAM8 ;Display trailing spaces
01421 ;
01422 ; Display other things if (A) parm set
01423 ;
27FB 11FFFF 01424 APARM LD DE,-1 ;P/u (A) parm
27FE 7A 01425 LD A,D ;Specified ?
27FF B3 01426 OR E
2800 C41528 01427 CALL NZ,ALL01 ;Full info if A-parm
01428 ;
01429 ; Check for end of line
01430 ;
2803 3E00 01431 DONAM9 LD A,0 ;Count down 4-across
2805 3D 01432 DEC A
2806 320428 01433 LD (DONAM9+1),A ;Update count
2809 C0 01434 RET NZ ;Loop if more to go
280A 3E04 01435 LD A,4 ; else re-init to 4/line
280C 320428 01436 LD (DONAM9+1),A
01437 ;
01438 ; Finished with one line - end with C/R
01439 ;
01440 IF @BLD631
280F CD9A2A 01441 ENDLINE CALL CKPAGE1 ;<631>Check for page pause
2812 C3CD2A 01442 JP CKPAWS ;<631>Scan pause or break loop
01443 ELSE
01444 ENDLINE LD A,CR ;End line
01445 CALL BYTOUT
01446 CALL CKPAGE ;Check for page pause
01447 CALL CKPAWS ;Scan pause or break
01448 RET ;Loop
01449 ENDIF
01450 ;
01451 ; ALL01 - Display Full Allocation of a file
01452 ;
2815 E5 01453 ALL01 PUSH HL ;Save pointer to 1st byte
2816 3E00 01454 ALL02 LD A,0 ;Bypass if not
2818 D620 01455 SUB 20H ; password protected
281A 2803 01456 JR Z,ALL03
281C 7E 01457 LD A,(HL) ;Get prot level &
281D E607 01458 AND 7 ; multiply by 4
281F 07 01459 ALL03 RLCA ; to index string array
2820 07 01460 RLCA
2821 4F 01461 LD C,A
2822 0600 01462 LD B,0
2824 211F2D 01463 LD HL,PROTS$ ;Pt to 4-char abbrevs
2827 09 01464 ADD HL,BC ;Pt to proper one
2828 11B42D 01465 LD DE,PLEVEL ;Move into output line
282B 0E04 01466 LD C,4
282D EDB0 01467 LDIR
282F E1 01468 POP HL ;Recover pointer to
2830 E5 01469 PUSH HL ; 1st byte of dir record
2831 2C 01470 INC L
2832 2C 01471 INC L
2833 2C 01472 INC L
01473 ;
01474 ; Pick up EOF offset byte & Stuff for later
01475 ;
2834 7E 01476 LD A,(HL) ;P/u EOF offset byte
2835 328328 01477 LD (EOFBYTE+1),A ;Stuff into LD DE,$-$
01478 ;
01479 ; calculate EOF record according to the formula:
01480 ; EOFREC= ((ERN-1)*256+EOF+LRL-1)/LRL if ERN<>0
01481 ; EOFREC= 0 if ERN=0
01482 ;
2838 7E 01483 LD A,(HL) ;P/u EOF offset byte
2839 F5 01484 PUSH AF ; & save it
283A 2C 01485 INC L ;Pt to LRL
283B 7E 01486 LD A,(HL) ;P/u LRL
283C 325828 01487 LD (ALL04+1),A ; & stuff it
01488 ;
01489 ; get LRL into message
01490 ;
283F E5 01491 PUSH HL ;Save ptr
2840 6F 01492 LD L,A ;Transfer LRL to HL
2841 2600 01493 LD H,0
2843 B7 01494 OR A ;Test for <> 256
2844 2001 01495 JR NZ,$+3
2846 24 01496 INC H ;Show 256
2847 11B92D 01497 LD DE,LRL-1 ;DE => LRL destination
01498 IF @BLD631
01499 ELSE
01500 LD A,' ' ;Init the ASCII byte
01501 ENDIF
284A 01502 @@HEXDEC
284A+3E61 01503 LD A,97
284C+EF 01504 RST 40
284D E1 01505 POP HL
01506 ;
01507 ; continue to calculate EOF
01508 ;
284E 7D 01509 LD A,L ;Pt to ERN
284F C610 01510 ADD A,16
2851 6F 01511 LD L,A
2852 5E 01512 LD E,(HL) ;P/u into reg DE
2853 2C 01513 INC L
2854 56 01514 LD D,(HL)
2855 C1 01515 POP BC ;Rcvr EOF byte in reg B
2856 EB 01516 EX DE,HL ;Xfer EOFREC -> reg HL
2857 3E00 01517 ALL04 LD A,0 ;P/u LRL
2859 B7 01518 OR A
285A 2818 01519 JR Z,TSTSIZ ;Go use ERN if LRL=0
285C 5F 01520 LD E,A ;Xfer LRL to reg E
285D 04 01521 INC B ;Test EOF
285E 05 01522 DEC B
285F 2801 01523 JR Z,DONTDEC ;Don't dec ERN if EOF=0
2861 2B 01524 DEC HL ;Reduce ERN for 0 offset
2862 CD8729 01525 DONTDEC CALL DIVIDE
2865 4D 01526 LD C,L
2866 54 01527 LD D,H
2867 67 01528 LD H,A
2868 68 01529 LD L,B ;P/u EOF
2869 7B 01530 LD A,E
286A CD8729 01531 CALL DIVIDE
286D 61 01532 LD H,C
286E B7 01533 OR A
286F 2801 01534 JR Z,DONTINC
2871 23 01535 INC HL ;Round up partial record
2872 7A 01536 DONTINC LD A,D ;Ck if overflow
2873 B7 01537 OR A
2874 280C 01538 TSTSIZ JR Z,EOFBYTE ;Use calc'd ERN if not
01539 ;
01540 ; Overflow in # of Records - use "*****"
01541 ;
2876 21BF2D 01542 LD HL,RECORDS ;Dsply field
2879 060A 01543 LD B,10 ;Display in record and
287B 362A 01544 DOSTAR LD (HL),'*' ; eof offset fields
287D 23 01545 INC HL
287E 10FB 01546 DJNZ DOSTAR
2880 1819 01547 JR DIR_0
01548 ;
01549 ; If # Records = 0 then set EOF = 0
01550 ;
2882 110000 01551 EOFBYTE LD DE,00 ;P/u EOF offset byte
2885 7C 01552 LD A,H ;# Records = 0 ?
2886 B5 01553 OR L
2887 2002 01554 JR NZ,KEEPEOF ;No - keep EOF
2889 1E01 01555 LD E,1 ;Set EOF=1 (gets DECed)
288B E5 01556 KEEPEOF PUSH HL ;Save # Records
288C 21C42D 01557 LD HL,OFFSET-2 ;HL => Destination
288F 1D 01558 DEC E ;DE = EOF byte
2890 EB 01559 EX DE,HL ;Swap for conversion
01560 IF @BLD631
01561 ELSE
01562 LD A,' ' ;Init
01563 ENDIF
2891 01564 @@HEXDEC
2891+3E61 01565 LD A,97
2893+EF 01566 RST 40
01567 ;
01568 ; Stuff # of Records used into string
01569 ;
2894 E1 01570 POP HL ;Recover # of Records
2895 11BF2D 01571 LD DE,RECORDS ;DE => Destination
2898 01572 @@HEXDEC
2898+3E61 01573 LD A,97
289A+EF 01574 RST 40
01575 ;
01576 ; Get # of extents & Granules used
01577 ;
289B E1 01578 DIR_0 POP HL ;Rcvr ptr to 1st byte
289C E5 01579 PUSH HL
289D CD9C29 01580 CALL ALL09 ;Get total grans in use
28A0 D5 01581 PUSH DE
28A1 79 01582 LD A,C ;Extents
28A2 11D72D 01583 LD DE,EXTENTS
28A5 CD6729 01584 CALL ATO2D
28A8 D1 01585 POP DE
01586 ;
01587 ; DE = # Grans used - Add to Grans Counter
01588 ;
28A9 2A0126 01589 LD HL,(TOTGRNS+1) ;P/u total grans
28AC 19 01590 ADD HL,DE ;Add this file's count
28AD 220126 01591 LD (TOTGRNS+1),HL ; & stuff into counter.
01592 ;
28B0 21CB2D 01593 LD HL,KSIZE ;Pt to where to stuff
28B3 CD3F2A 01594 CALL CALCK ;Cvrt to K
28B6 21DA2D 01595 LD HL,DATEFLD-1 ;Blank out day-mo-yr
28B9 11DB2D 01596 LD DE,DATEFLD
28BC 011100 01597 LD BC,17
28BF EDB0 01598 LDIR
28C1 E1 01599 POP HL ;Rcvr ptr to DIR+0
28C2 11DB2D 01600 LD DE,DATEFLD
28C5 23 01601 INC HL
28C6 23 01602 INC HL ;Advance to date field
28C7 7E 01603 LD A,(HL)
28C8 B7 01604 OR A
28C9 CA5B29 01605 JP Z,ALL08 ;Ignore if no date saved
28CC 0F 01606 RRCA ;Has date, get day
28CD 0F 01607 RRCA
28CE 0F 01608 RRCA
28CF E61F 01609 AND 1FH
28D1 CD6729 01610 CALL ATO2D ;Make ascii
28D4 13 01611 INC DE
28D5 E5 01612 PUSH HL
28D6 2B 01613 DEC HL ;Pt to month
28D7 7E 01614 LD A,(HL)
28D8 E60F 01615 AND 0FH
28DA 3D 01616 DEC A
28DB 4F 01617 LD C,A
28DC 07 01618 RLCA
28DD 81 01619 ADD A,C
28DE 4F 01620 LD C,A
28DF 0600 01621 LD B,0
28E1 21DC04 01622 LD HL,MONTBL
28E4 09 01623 ADD HL,BC
28E5 0E03 01624 LD C,3
28E7 EDB0 01625 LDIR
28E9 13 01626 INC DE
01627 IF @BLD631
28EA 3E2D 01628 LD A,2DH ;<631>
28EC 32DD2D 01629 LD (GETPRM-1),A ;<631>
28EF 32E12D 01630 LD (GETPRM+3),A ;<631>
01631 ENDIF
28F2 E1 01632 POP HL
28F3 E5 01633 PUSH HL
28F4 3A0000 01634 LD A,($-$) ;Drive year type
28F5 01635 YFLAG2 EQU $-2
28F7 CB 01636 DB 0CBH
28F8 47 01637 DVTEST1 DB 47H
28F9 F5 01638 PUSH AF ;Save for time ck
28FA 2005 01639 JR NZ,NEWDT2
28FC 7E 01640 LD A,(HL) ;Get old date
28FD E607 01641 AND 7
28FF 1807 01642 JR NEWDT3
2901 7D 01643 NEWDT2 LD A,L
2902 C611 01644 ADD A,17 ;Get new year
2904 6F 01645 LD L,A
2905 7E 01646 LD A,(HL)
2906 E61F 01647 AND 1FH
2908 C650 01648 NEWDT3 ADD A,80
290A FE64 01649 CP 100 ;Bad year?
290C 3802 01650 JR C,NEWD3A ;Go ifok
01651 IF @BLD631
290E D664 01652 SUB 100 ;<631>This is the max year
01653 ELSE
01654 LD A,99 ;This is max year
01655 ENDIF
2910 CD6729 01656 NEWD3A CALL ATO2D
2913 13 01657 INC DE
2914 13 01658 INC DE
2915 F1 01659 POP AF ;New style dating?
2916 2842 01660 JR Z,OLDCODE ;Go if not
01661 NEWDT4:
01662 IF @BLD631
01663 IF @BLD631D
2918 FDE5 01664 PUSH IY ;<631D>
291A CD762D 01665 CALL P631D1 ;<631D>Level-1D Patch
01666 ELSE ;<631D>
01667 DEC HL ;Pt to hours
01668 @@FLAGS ;<631>
01669 LD A,(HL)
01670 ENDIF ;<631D>
01671 ELSE ;<631>
01672 DEC HL ;Pt to hours
01673 LD A,(HL)
01674 ENDIF ;<631>
291D E6F8 01675 AND 0F8H ;Mask mins
291F 0F 01676 RRCA
2920 0F 01677 RRCA
2921 0F 01678 RRCA ;Hours into posn
2922 F5 01679 PUSH AF ;Save for a,p test
01680 IF @BLD631
2923 FDCB0866 01681 BIT 4,(IY+8) ;<631>
2927 200B 01682 JR NZ,NEWDT8 ;<631>
01683 ENDIF
2929 B7 01684 OR A ;If hour zero, then 12
292A 2002 01685 JR NZ,NEWDT7
292C 3E0C 01686 LD A,12
292E FE0D 01687 NEWDT7 CP 13
2930 3802 01688 JR C,NEWDT8
2932 D60C 01689 SUB 12
2934 CD6729 01690 NEWDT8 CALL ATO2D
2937 3E3A 01691 LD A,':'
2939 12 01692 LD (DE),A
293A 13 01693 INC DE
293B 7E 01694 LD A,(HL) ;MSbits, min
293C 23 01695 INC HL
293D 6E 01696 LD L,(HL) ;LS bits
293E E607 01697 AND 7 ;Mask off hour
2940 0603 01698 LD B,3
2942 CB25 01699 NEWDT5 SLA L ;Shift out a LSbit
2944 17 01700 RLA ; into A
2945 10FB 01701 DJNZ NEWDT5
2947 CD6729 01702 CALL ATO2D
294A F1 01703 POP AF ;Get hour
01704 IF @BLD631
01705 IF @BLD631D
294B C37C2D 01706 JP P631D2 ;<631D>Level 1D patch
294E 00 01707 NOP ;<631D>
01708 P631D3: ;<631D>Back from the patch
01709 ELSE
01710 BIT 4,(IY+8) ;<631>
01711 ENDIF
294F 2009 01712 JR NZ,OLDCODE ;<631>
01713 ENDIF
2951 FE0C 01714 CP 12
2953 3E61 01715 LD A,'a'
2955 3802 01716 JR C,NEWDT6
2957 3E70 01717 LD A,'p'
2959 12 01718 NEWDT6 LD (DE),A
295A E1 01719 OLDCODE POP HL ;Rcvr DIR+2
01720 IF @BLD631
01721 ELSE
01722 DEC HL ;B/u to DIR+1
01723 LD A,'-' ;Else change to not cur
01724 LD (DATEFLD+2),A ;Stuff indicator
01725 LD (DATEFLD+6),A ; between mo&day, day&yr
01726 ENDIF
295B 21B42D 01727 ALL08 LD HL,PLEVEL ;Pt to start of message
295E CD102A 01728 CALL LINOUT ; & output entire string
2961 3E01 01729 LD A,1 ;Show only one entry
2963 320428 01730 LD (DONAM9+1),A ; per line if A-parm
2966 C9 01731 RET
01732 ;
01733 ; A=> value, DE=> buffer for ascii
01734 ;
01735 IF @BLD631
2967 013000 01736 ATO2D LD BC,'0' ;<631>Init to 0
01737 ELSE
01738 ATO2D LD B,0 ;Init to 0
01739 ENDIF
296A D60A 01740 ATD1 SUB 10 ;Find 10's count
296C 3803 01741 JR C,ATD2 ;Go if got it
296E 04 01742 INC B ; else inc 10's counter
296F 18F9 01743 JR ATD1 ;Try again
2971 F5 01744 ATD2 PUSH AF ;Save 1's count
2972 78 01745 LD A,B ;Get 10's count
01746 IF @BLD631
2973 81 01747 ADD A,C ;<631>Make ascii
01748 ELSE
01749 ADD A,'0' ;Make ascii
01750 ENDIF
2974 12 01751 LD (DE),A ;Stuff in buffer
01752 IF @BLD631
2975 B9 01753 CP C ;<631>Leading zero?
01754 ELSE
01755 CP '0' ;Leading zero?
01756 ENDIF
2976 2008 01757 JR NZ,ATD3 ;Go if not
2978 1B 01758 DEC DE
2979 1A 01759 LD A,(DE) ;Was prev a space?
297A 13 01760 INC DE
297B FE20 01761 CP ' '
297D 2001 01762 JR NZ,ATD3 ;Go if not
297F 12 01763 LD (DE),A ; else lead 0 = space
2980 13 01764 ATD3 INC DE
2981 F1 01765 POP AF
2982 C63A 01766 ADD A,'0'+10
2984 12 01767 LD (DE),A
2985 13 01768 INC DE
2986 C9 01769 RET
01770 ;
01771 ; DIVIDE - Divide HL by A
01772 ;
2987 C5 01773 DIVIDE PUSH BC ;Save BC
2988 4F 01774 LD C,A ;Xfer Divisor in C
2989 01775 @@DIV16 ;Divide HL / C
2989+3E5E 01776 LD A,94
298B+EF 01777 RST 40
298C C1 01778 POP BC ;Restore BC
298D C9 01779 RET
01780 ;
01781 ; OUTMOD - Output a "+" if file has been modified
01782 ;
298E 23 01783 OUTMOD INC HL ;HL => DIR+1
298F 3E20 01784 LD A,' ' ;Default to no mod
2991 CB76 01785 BIT 6,(HL) ;Test MOD flag
2993 2802 01786 JR Z,OUTCHR ;Output space
2995 3E2B 01787 LD A,'+' ;Mod flag char
2997 CD212A 01788 OUTCHR CALL BYTOUT2 ;Display '+' if MOD
299A 2B 01789 DEC HL ;Repoint to 1st byte
299B C9 01790 RET ;Done
01791 ;
01792 ;
01793 ; routine calculates total # of grans in use
01794 ;
299C 3AFC26 01795 ALL09 LD A,(SORTPRM+1) ;If sorted, then data
299F B7 01796 OR A ; already calculated
29A0 2810 01797 JR Z,ALL09A ;Go if not sorted
29A2 E5 01798 PUSH HL
29A3 DDE1 01799 POP IX ;P/u the saved data
29A5 DD5E16 01800 LD E,(IX+22)
29A8 DD5617 01801 LD D,(IX+23) ;P/u Space used
29AB DD4E18 01802 LD C,(IX+24)
29AE DD4619 01803 LD B,(IX+25) ;P/u # of extents
29B1 C9 01804 RET
01805 ;
01806 ; ALL09A - Calculate space allocated to a file
01807 ; HL => DIR+0 of an FPDE
01808 ; BC <= # of Extents in the file
01809 ; DE <= # of Grans allocated to the file
01810 ;
29B2 110000 01811 ALL09A LD DE,0 ;Init gran counter to 0
29B5 43 01812 LD B,E ;Init extent ctr to 0
29B6 4B 01813 LD C,E
01814 ;
01815 ; Point to First Extent of a directory entry
01816 ;
29B7 7D 01817 ALL10 LD A,L ;P/u low byte
29B8 C616 01818 ALL11 ADD A,22
29BA 6F 01819 LD L,A ;HL => DIR + 22
01820 ;
01821 ; Is the Extent Field in Use ?
01822 ;
29BB 7E 01823 ALL14 LD A,(HL) ;P/u cylinder
29BC 2C 01824 INC L ;Bump to alloc info
29BD FEFE 01825 CP 0FEH ;Another extent or done ?
29BF 300D 01826 JR NC,ALL15 ;Either X'FE' or X'FF'
01827 ;
01828 ; Extent Field is in use - Get allocation info
01829 ;
29C1 03 01830 INC BC ;Bump extent counter
29C2 7E 01831 LD A,(HL) ;P/u alloc info
29C3 2C 01832 INC L ;Bump ptr to next extent
29C4 E61F 01833 AND 1FH ;Keep # of grans
29C6 3C 01834 INC A ;Adj for zero offset
01835 ;
01836 ; A = # of contig grans, add to gran counter
01837 ;
29C7 83 01838 ADD A,E ;Accumulate # of grans
29C8 5F 01839 LD E,A
29C9 30F0 01840 JR NC,ALL14 ;Forget hi if no carry
29CB 14 01841 INC D ;Bump hi
29CC 18ED 01842 JR ALL14 ;Get next extent field
01843 ;
01844 ; P/u DEC if (X'FE') or RET if done (X'FF')
01845 ;
29CE C0 01846 ALL15 RET NZ ;Ret if not extended
29CF 7E 01847 LD A,(HL) ;P/u DEC of FXDE
01848 ;
01849 ; Point HL => Extended Directory Entry posn
01850 ;
29D0 E61F 01851 AND 1FH ;Get dir sector of DEC
29D2 F5 01852 PUSH AF ;Save it
29D3 AE 01853 XOR (HL) ;Get dir record of FXDE
29D4 6F 01854 LD L,A ;Save dir record position
29D5 F1 01855 POP AF ;Recover DEC of FXDE
01856 ;
01857 ; Is the Dir Sector with FXDE already in mem ?
01858 ;
29D6 E5 01859 PUSH HL ;Save ptr to 1st extent
29D7 215526 01860 LD HL,CKHIT6+1 ;Do we have this dir
29DA BE 01861 CP (HL) ; sector in core?
29DB E1 01862 POP HL ;Restore ptr
29DC 2600 01863 SBUFFER LD H,00 ;Buffer hi order
29DE 28D7 01864 JR Z,ALL10 ;Jump if we have it
01865 ;
01866 ; Dir Sector not res - Is Ext buf resident ?
01867 ;
29E0 FEFF 01868 ALL16 CP 0FFH ;Same as extended area?
29E2 262F 01869 LD H,BUF2<-8 ;Pt to extended buf area
29E4 28D1 01870 JR Z,ALL10 ;Jump if we have it there
29E6 32E129 01871 LD (ALL16+1),A ; else upd the test byte
01872 ;
01873 ; Set B = Directory Entry Code of FXDE
01874 ;
29E9 C5 01875 PUSH BC ;Save Gran counter
29EA D5 01876 PUSH DE ; & Extent counter
29EB B5 01877 OR L ;Combine sector & record
29EC 47 01878 LD B,A ; pointers to retrieve DEC
01879 ;
01880 ; Set C = Logical Drive #, D = Directory Cyl
01881 ;
29ED 3A432C 01882 LD A,(DRIVE) ;P/u ASCII drive #
29F0 D630 01883 SUB '0' ;Adjust to binary
29F2 4F 01884 LD C,A ;Save in C
29F3 FD5609 01885 LD D,(IY+9) ;P/u Directory cyl in D
01886 ;
01887 ; Set E = FXDE's Dir Sector, HL => I/O buffer
01888 ;
29F6 78 01889 LD A,B ;P/u DEC
29F7 E61F 01890 AND 1FH ;Get sector #
29F9 C602 01891 ADD A,2 ;Adj for GAT & HIT
29FB 5F 01892 LD E,A ;Stuff in E
29FC 21002F 01893 LD HL,BUF2 ;HL => I/O Buffer
01894 ;
01895 ; Read in the FXDE's Directory Sector
01896 ;
29FF 01897 @@RDSEC ;Read a sector
29FF+3E31 01898 LD A,49
2A01+EF 01899 RST 40
2A02 FE06 01900 CP 6 ;Expecting Error #6
2A04 3E11 01901 LD A,11H ;Read error?
2A06 C21E24 01902 JP NZ,IOERR ;Jump if got error
01903 ;
01904 ; Set A = offset into Sector of entry
01905 ;
2A09 78 01906 LD A,B ;P/u FXDE DEC
2A0A E6E0 01907 AND 0E0H ;Pt to dir record
2A0C D1 01908 POP DE ;Restore counters
2A0D C1 01909 POP BC
2A0E 18A8 01910 JR ALL11 ;Loop through extents
01911 ;
01912 ; LINOUT - Output line to *DO/*PR
01913 ; HL => Buffer to output
01914 ;
2A10 01915 LINOUT @@DSPLY ;Output line to *DO
01916 IFEQ 00H,1
01917 LD HL,
01918 ENDIF
2A10+3E0A 01919 LD A,10
2A12+EF 01920 RST 40
2A13 2008 01921 JR NZ,IOER1 ;NZ - Abort
2A15 3A2A2A 01922 LD A,(PPARM+1) ;Ck P-parm
2A18 B7 01923 OR A
2A19 C8 01924 RET Z ;Not spec'd - don't print
2A1A 01925 @@PRINT ;Output line to *PR
01926 IFEQ 00H,1
01927 LD HL,
01928 ENDIF
2A1A+3E0E 01929 LD A,14
2A1C+EF 01930 RST 40
2A1D C21E24 01931 IOER1 JP NZ,IOERR ;NZ - Abort
2A20 C9 01932 RET
01933 ;
01934 ; BYTOUT - Output a byte to *DO/*PR
01935 ; A = Character to output
01936 ;
2A21 0D 01937 BYTOUT2 DEC C ;Decrement col #
2A22 C5 01938 BYTOUT PUSH BC ;Save BC
2A23 4F 01939 LD C,A ;Save char in C
2A24 01940 @@DSP ;Display char
2A24+3E02 01941 LD A,2
2A26+EF 01942 RST 40
2A27 20F4 01943 JR NZ,IOER1 ;NZ - Abort
2A29 110000 01944 PPARM LD DE,0 ;P/u P-parm
2A2C 1C 01945 INC E ;Specified ?
2A2D 2006 01946 JR NZ,NOPRT ;No - don't print
2A2F 01947 @@PRT ;Output byte
2A2F+3E06 01948 LD A,6
2A31+EF 01949 RST 40
2A32 20E9 01950 JR NZ,IOER1 ;NZ - Abort
2A34 79 01951 LD A,C ;Get back char
2A35 C1 01952 NOPRT POP BC ;Restore BC
2A36 C9 01953 RET ;And return
01954 ;
01955 ; OUTSPC - Output B spaces
01956 ;
2A37 3E20 01957 OUTSPC LD A,' ' ;Space char
2A39 CD212A 01958 CALL BYTOUT2 ;Output space
2A3C 10F9 01959 DJNZ OUTSPC
2A3E C9 01960 RET ;RETurn
2A3F 01961 *GET LBDIRC:3
01962 ;LBDIRC/ASM - DIR math, strings, & buffers
01965 ;
01966 ; CALCK - Calculate the # of K given # of Grans
01967 ; DE => # of Granules
01968 ; HL => Destination of #K ASCII string
01969 ;
2A3F 22542A 01970 CALCK LD (CALCK2+1),HL ;Stuff dest address
01971 ;
01972 ; Calc # of Free Sects (Sectors/Gran x Grans)
01973 ;
2A42 EB 01974 EX DE,HL ;HL = # of Free Grans
2A43 0E00 01975 CALCK1 LD C,$-$ ;C = Sectors/Gran
2A45 01976 @@MUL16 ;Mult HL x C
2A45+3E5B 01977 LD A,91
2A47+EF 01978 RST 40
01979 ;
01980 ; LA = Total # of Sectors - Divide by 4 for K
01981 ;
2A48 F5 01982 PUSH AF ;Save offset
2A49 65 01983 LD H,L ;Set HL = LA
2A4A 6F 01984 LD L,A
2A4B CB3C 01985 SRL H ;Divide HL / 4
2A4D CB1D 01986 RR L
2A4F CB3C 01987 SRL H
2A51 CB1D 01988 RR L
01989 ;
01990 ; P/u dest address & stuff in # of FULL K
01991 ;
2A53 110000 01992 CALCK2 LD DE,$-$ ;P/u destination address
2A56 01993 @@HEXDEC
2A56+3E61 01994 LD A,97
2A58+EF 01995 RST 40
2A59 13 01996 INC DE ;DE => Hundredths
01997 ;
01998 ; Stuff hundredths value into string
01999 ;
2A5A F1 02000 POP AF ;Rcvr offset to
2A5B E603 02001 AND 3 ;Get offset
2A5D 87 02002 ADD A,A
2A5E 0600 02003 LD B,0
2A60 4F 02004 LD C,A ;BC = offset
2A61 214B2D 02005 LD HL,HUNDTAB ;HL => Hundredths table
2A64 09 02006 ADD HL,BC ;HL => Hundredths offset
2A65 0E02 02007 LD C,2 ;BC = 2 characters
2A67 EDB0 02008 LDIR ;Transfer to DE
2A69 C9 02009 RET
02010 ;
02011 ; CPHLDE - Compare HL to DE
02012 ;
2A6A 7C 02013 CPHLDE LD A,H ;P/u high byte
2A6B BA 02014 CP D ;Same ?
2A6C C0 02015 RET NZ ;No - Return C or NC
2A6D 7D 02016 LD A,L ;P/u low byte
2A6E BB 02017 CP E ;Less than or greater ?
2A6F C9 02018 RET ;Return - C, NC, or Z
02019 ;
02020 ; UNPACK - Unpack the Date from a directory entry
02021 ; HL => DIR+1
02022 ; DE <= Date in DATE$ format
02023 ;
2A70 7E 02024 UNPACK LD A,(HL) ;Get month
2A71 E60F 02025 AND 0FH
2A73 1E00 02026 LD E,0
2A75 57 02027 LD D,A
2A76 CB3A 02028 SRL D
2A78 CB1B 02029 RR E ;Split into DE
2A7A 23 02030 INC HL ;Pt to day
2A7B 7E 02031 LD A,(HL)
2A7C E6F8 02032 AND 0F8H
2A7E 0F 02033 RRCA
2A7F B3 02034 OR E
2A80 5F 02035 LD E,A ;Month to E
2A81 3A0000 02036 LD A,($-$)
2A82 02037 YFLAG1 EQU $-2
2A84 CB 02038 DB 0CBH
2A85 47 02039 DVTEST DB 47H
2A86 2009 02040 JR NZ,NWDT ;Go if new type date
2A88 7E 02041 LD A,(HL)
2A89 E607 02042 AND 7 ;Else use old
2A8B 07 02043 SHFTD RLCA ;Into bits 3-7
2A8C 07 02044 RLCA
2A8D 07 02045 RLCA
2A8E B2 02046 OR D
2A8F 57 02047 LD D,A
2A90 C9 02048 RET
2A91 7D 02049 NWDT LD A,L
2A92 C611 02050 ADD A,17
2A94 6F 02051 LD L,A ;Pt to new year
2A95 7E 02052 LD A,(HL)
2A96 E61F 02053 AND 1FH
2A98 18F1 02054 JR SHFTD
02055 ;
02056 ; CKPAGE - Check for Page Pause
02057 ;
02058 IF @BLD631
2A9A 3E0D 02059 CKPAGE1 LD A,CR ;<631>
2A9C CD222A 02060 CALL BYTOUT ;<631>
02061 ENDIF
2A9F 3E00 02062 CKPAGE LD A,$-$ ;Ck for display pause
2AA1 3D 02063 DEC A ;Count down
2AA2 32A02A 02064 LD (CKPAGE+1),A ;Update
2AA5 C0 02065 RET NZ ;Ret if not yet full
02066 ;
02067 ; Displayed a full page - Reset Counter
02068 ;
2AA6 3E16 02069 LD A,22 ;Reset to max lines/page
2AA8 32A02A 02070 LD (CKPAGE+1),A
02071 ;
02072 ; Don't pause if NOPAUSE (N) parm entered
02073 ;
2AAB 110000 02074 NPARM LD DE,0 ;P/u NOPAUSE parm
2AAE 7B 02075 LD A,E ;Specified ?
2AAF B2 02076 OR D
2AB0 C0 02077 RET NZ ;Nonstop if non-zero
02078 ;
02079 ; Non-Stop if in effect
02080 ;
2AB1 3E00 02081 SFLAG LD A,$-$ ;P/u SFLAG$
2AB3 E620 02082 AND 20H ;Strip all but bit
2AB5 C0 02083 RET NZ ;Return if do in effect
02084 ;
02085 ; There isn't a in effect - Wait for key
02086 ;
2AB6 02087 @@KEY ;Wait for key entry
2AB6+3E01 02088 LD A,1
2AB8+EF 02089 RST 40
2AB9 C21E24 02090 IOERR5 JP NZ,IOERR
02091 ;
02092 ; Clear Screen
02093 ;
2ABC 3E69 02094 LD A,105
2ABE 00 02095 NOP ;CLS out for now
02096 ; rst 40 ;Uncomment for CLS
2ABF 20F8 02097 JR NZ,IOERR5
02098 ;
02099 ; If the NOTITLE flag is set - don't display
02100 ;
2AC1 3E00 02101 NOTITLE LD A,$-$ ;P/u flag
2AC3 B7 02102 OR A ;No title ?
2AC4 C0 02103 RET NZ ;Then RETurn
02104 ;
02105 ; Display a title if there were matching files
02106 ;
2AC5 3A9B2D 02107 LD A,(FILFLAG) ;Was a matching file
2AC8 B7 02108 OR A ; displayed ?
2AC9 C4EB2A 02109 CALL NZ,CKTITL ;Yes - display title
2ACC C9 02110 RET ;Return
02111 ;
02112 ; CKPAWS - Check for <@> or
02113 ;
02114 CKPAWS
02115 ;
02116 ; Was the key hit ?
02117 ;
2ACD 3A0000 02118 KFLAG LD A,($-$) ;P/u KFLAG$
2AD0 0F 02119 RRCA ; hit ?
2AD1 DA1724 02120 JP C,ABORT ;Yes - cease DIR
02121 ;
02122 ; Is the bit set ?
02123 ;
2AD4 0F 02124 RRCA ; bit set ?
2AD5 D0 02125 RET NC ;Ret if not pause
02126 ;
02127 ; The bit is set - Wait for Char
02128 ;
2AD6 02129 CKPAW1 @@KEY ;Scan keyboard
2AD6+3E01 02130 LD A,1
2AD8+EF 02131 RST 40
02132 ;
02133 ; Character entered - Ignore it if <@>
02134 ;
2AD9 FE60 02135 CKPAW2 CP 60H ;<@> ?
2ADB 28F9 02136 JR Z,CKPAW1 ;Yes - get another char
2ADD FE80 02137 CP BREAK
2ADF CA1724 02138 JP Z,ABORT
02139 ;
02140 ; Reset & bits
02141 ;
2AE2 3A0000 02142 RESKFL LD A,($-$) ;P/u KFLAG$
2AE5 E6F9 02143 AND 0F9H ;Reset &
2AE7 320000 02144 KFLAG1 LD ($-$),A ;Stuff into KFLAG$
2AEA C9 02145 RET ; & RETurn
02146 ;
02147 ; CKTITL - Display Title
02148 ;
02149 ; Display Disk type Header
02150 ;
2AEB 213C2C 02151 CKTITL LD HL,DSTRING ;HL => Heading
2AEE CD102A 02152 CALL LINOUT ;Output line
2AF1 CD9F2A 02153 CALL CKPAGE ;Bump line count
2AF4 CD9F2A 02154 CALL CKPAGE ; twice.
02155 ;
02156 ; Display Attributes header if A parm spec'd
02157 ;
2AF7 3AFC27 02158 LD A,(APARM+1) ;Was the A parm spec'd
2AFA B7 02159 OR A
2AFB 3E0D 02160 LD A,CR ;Output a CR if A
2AFD CA222A 02161 JP Z,BYTOUT ; not specified.
02162 ;
2B00 218C2C 02163 LD HL,HEADING ;HL => Attr heading
2B03 CD102A 02164 CALL LINOUT ;Output line
02165 ;
02166 ; Display Underline
02167 ;
2B06 C5 02168 PUSH BC ;Save BC
2B07 064F 02169 LD B,79 ;Display underline
2B09 3E2D 02170 D79L LD A,'-'
2B0B CD222A 02171 CALL BYTOUT ;Output byte
2B0E 10F9 02172 DJNZ D79L ; 79 times
2B10 C1 02173 POP BC ;Restore BC
02174 IF @BLD631
2B11 C39A2A 02175 JP CKPAGE1 ;<631>Check page pause & RET
02176 ELSE
02177 LD A,CR ;One CR between
02178 CALL BYTOUT
02179 JP CKPAGE ;Check page pause & RET
02180 ENDIF
02181 ;
02183 ;
02184 ; SORTIT - Set up Directory Records for Shell Sort
02185 ;
2B14 2A9C2D 02186 SORTIT LD HL,(DIRPTR) ;Calculate # of records
2B17 110030 02187 LD DE,MEMORY ;Point to buf start
2B1A 73 02188 LD (HL),E ;Prime the 1st index
2B1B 23 02189 INC HL ; in case there is
2B1C 72 02190 LD (HL),D ; only one record
2B1D 2B 02191 DEC HL ; to sort
2B1E AF 02192 XOR A
2B1F ED52 02193 SBC HL,DE ;PTREND - PTRBGN
2B21 C8 02194 RET Z ;Ret if nothing
02195 ;
02196 ; Set HL = # of directory entries
02197 ;
2B22 0605 02198 LD B,5 ;Divide by
2B24 CB3C 02199 SORT1 SRL H ; 32 bytes/record
2B26 CB1D 02200 RR L
2B28 10FA 02201 DJNZ SORT1
02202 ;
02203 ; Set B = # of entries & init count
02204 ;
2B2A 45 02205 LD B,L ;Set loop counter
2B2B C5 02206 PUSH BC ;Save it for printing
2B2C 22682B 02207 LD (COUNTM1),HL ;Init the count
02208 ;
02209 ; Skip sort if # of entries = 0
02210 ;
2B2F 7C 02211 LD A,H ;If length = 0
2B30 B5 02212 OR L ; then no need to sort
2B31 2821 02213 JR Z,SORT2A
2B33 29 02214 ADD HL,HL ;Make sure enuff room
2B34 EB 02215 EX DE,HL
2B35 2A9E2D 02216 LD HL,(MAXMEM)
2B38 AF 02217 XOR A
2B39 ED52 02218 SBC HL,DE
2B3B DA0D24 02219 JP C,NOMEM
2B3E 2A9C2D 02220 LD HL,(DIRPTR) ;Set up the index array
2B41 110030 02221 LD DE,MEMORY ;Starting record pointer
2B44 73 02222 SORT2 LD (HL),E ;Place record pointers
2B45 23 02223 INC HL ; into index array
2B46 72 02224 LD (HL),D
2B47 23 02225 INC HL
2B48 7B 02226 LD A,E ;Increment pointer by 32
2B49 C620 02227 ADD A,32
2B4B 5F 02228 LD E,A
2B4C 3001 02229 JR NC,$+3 ;Go if no overflow
2B4E 14 02230 INC D ; else bump high order
2B4F 10F3 02231 DJNZ SORT2 ;Loop for all records
2B51 CD672B 02232 CALL SHELL ;Sort the dir records
2B54 C1 02233 SORT2A POP BC ;Recover loop counter
2B55 2A9C2D 02234 LD HL,(DIRPTR) ;P/u starting record
2B58 5E 02235 SORT3 LD E,(HL) ;Grab its address
2B59 23 02236 INC HL
2B5A 56 02237 LD D,(HL)
2B5B 23 02238 INC HL
2B5C E5 02239 PUSH HL ;Save index pointer
2B5D C5 02240 PUSH BC ;Save loop counter
2B5E EB 02241 EX DE,HL ;Record address -> HL
2B5F CD3627 02242 CALL MATCH ;Display the record
2B62 C1 02243 POP BC ;Rcvr loop counter
2B63 E1 02244 POP HL ;Rcvr index pointer
2B64 10F2 02245 DJNZ SORT3
2B66 C9 02246 RET
02247 ;
02248 ; SHELL - Shell Sort Routine
02249 ;
2B67 210000 02250 SHELL LD HL,$-$ ;P/u count minus 1
2B68 02251 COUNTM1 EQU $-2
2B6A 226E2B 02252 LD (STORM),HL
02253 ;
02254 ; Start Select & Compare
02255 ;
2B6D 110000 02256 CYCLE LD DE,0 ;M = M / 2
2B6E 02257 STORM EQU $-2
2B70 CB3A 02258 SRL D
2B72 CB1B 02259 RR E
2B74 7A 02260 LD A,D ;Return when M=0
2B75 B3 02261 OR E
2B76 C8 02262 RET Z
2B77 ED536E2B 02263 LD (STORM),DE
2B7B 2A682B 02264 LD HL,(COUNTM1) ;K = N - M
2B7E ED52 02265 SBC HL,DE
2B80 22EF2B 02266 LD (STORK),HL
2B83 210000 02267 LD HL,0 ;J = 0
2B86 228A2B 02268 LD (STORJ),HL
2B89 210000 02269 AGAIN LD HL,$-$ ;I = J
2B8A 02270 STORJ EQU $-2
2B8C 22902B 02271 LD (STORI),HL
2B8F 210000 02272 REPEAT LD HL,$-$ ;L = I + M
2B90 02273 STORI EQU $-2
2B92 ED5B6E2B 02274 LD DE,(STORM)
2B96 19 02275 ADD HL,DE
2B97 29 02276 ADD HL,HL ;L * 2 -> regHL
2B98 E5 02277 PUSH HL ;Save L
2B99 2A902B 02278 LD HL,(STORI) ;I * 2 -> regHL
2B9C 29 02279 ADD HL,HL
2B9D ED4B9C2D 02280 LD BC,(DIRPTR) ;P/u string parm ptr
2BA1 09 02281 ADD HL,BC ;Pt to A$(I) parm
2BA2 EB 02282 EX DE,HL ;Ptr -> DE
2BA3 E1 02283 POP HL ;Pt to A$(L) parm
2BA4 09 02284 ADD HL,BC ;Ptr -> HL
2BA5 E5 02285 PUSH HL ;Save ptr to A$(L)
2BA6 D5 02286 PUSH DE ;Save ptr to A$(I)
2BA7 060B 02287 LD B,11 ;Set compare length
2BA9 C5 02288 PUSH BC ;Save cpr len & flag
2BAA 7E 02289 LD A,(HL) ;P/u string2 ptr
2BAB 23 02290 INC HL
2BAC 66 02291 LD H,(HL)
2BAD 6F 02292 LD L,A
2BAE 010500 02293 LD BC,5 ;Key is 5 bytes in
2BB1 09 02294 ADD HL,BC
2BB2 EB 02295 EX DE,HL ;String2 ptr -> rDE
2BB3 7E 02296 LD A,(HL) ;P/u string1 ptr
2BB4 23 02297 INC HL
2BB5 66 02298 LD H,(HL)
2BB6 6F 02299 LD L,A
2BB7 09 02300 ADD HL,BC ;Key is 5 bytes in
2BB8 C1 02301 POP BC ;Rcvr len & flag
2BB9 1A 02302 BACK LD A,(DE) ;Go swap if str1>str2
2BBA 96 02303 SUB (HL)
2BBB 3808 02304 JR C,POP
2BBD 2025 02305 JR NZ,FINIS ;Next str if str2>str1
2BBF 13 02306 INC DE ;Loop if this matches
2BC0 23 02307 INC HL
2BC1 10F6 02308 DJNZ BACK
2BC3 181F 02309 JR FINIS ;None really should match
2BC5 D1 02310 POP POP DE ;Else swap
2BC6 E1 02311 POP HL
2BC7 0602 02312 LD B,2 ;Swap 2-byte
2BC9 4E 02313 SWAP LD C,(HL) ;String pointer
2BCA EB 02314 EX DE,HL
2BCB 7E 02315 LD A,(HL)
2BCC 71 02316 LD (HL),C
2BCD EB 02317 EX DE,HL
2BCE 77 02318 LD (HL),A
2BCF 23 02319 INC HL
2BD0 13 02320 INC DE
2BD1 10F6 02321 DJNZ SWAP
2BD3 2A6E2B 02322 LD HL,(STORM) ;P/u M
2BD6 EB 02323 EX DE,HL
2BD7 2A902B 02324 LD HL,(STORI) ;P/u I
2BDA AF 02325 XOR A
2BDB ED52 02326 SBC HL,DE
2BDD 22902B 02327 LD (STORI),HL ;I = I - M
2BE0 30AD 02328 JR NC,REPEAT ;Repeat if I => 0
2BE2 1802 02329 JR EXITSRT ;Else exit the loop
2BE4 D1 02330 FINIS POP DE
2BE5 E1 02331 POP HL
2BE6 2A8A2B 02332 EXITSRT LD HL,(STORJ)
2BE9 23 02333 INC HL ;J = J + 1
2BEA 228A2B 02334 LD (STORJ),HL
2BED AF 02335 XOR A
2BEE 110000 02336 LD DE,$-$
2BEF 02337 STORK EQU $-2
2BF1 ED52 02338 SBC HL,DE ;J - K
2BF3 D26D2B 02339 JP NC,CYCLE ;Cycle if J => K *
2BF6 C3892B 02340 JP AGAIN ;Else again
02341 ;
02343 ;
2BF9 80 02344 PRMTBL$ DB 80H ;6.x parameters
02345 ;
02346 ; A - Flag input only
02347 ;
2BFA 41 02348 DB FLAG!1
2BFB 41 02349 DB 'A'
2BFC 00 02350 DB 0
2BFD FC27 02351 DW APARM+1
02352 ;
02353 ; INV (I) - Flag input only
02354 ;
2BFF 53 02355 DB FLAG!ABB!3
2C00 49 02356 DB 'INV'
4E 56
2C03 00 02357 DB 0
2C04 9026 02358 DW IPARM+1
02359 ;
02360 ; P - Flag input only
02361 ;
2C06 41 02362 DB FLAG!1
2C07 50 02363 DB 'P'
2C08 00 02364 DB 0
2C09 2A2A 02365 DW PPARM+1
02366 ;
02367 ; SYS (S) - Flag input only
02368 ;
2C0B 53 02369 DB FLAG!ABB!3
2C0C 53 02370 DB 'SYS'
59 53
2C0F 00 02371 DB 0
2C10 8226 02372 DW SPARM+1
02373 ;
02374 ; N - Flag input only
02375 ;
2C12 41 02376 DB FLAG!1
2C13 4E 02377 DB 'N'
2C14 00 02378 DB 0
2C15 AC2A 02379 DW NPARM+1
02380 ;
02381 ; DATE (D) - Flag or String input
02382 ;
2C17 74 02383 DB FLAG!STR!ABB!4
2C18 44 02384 DB 'DATE'
41 54 45
2C1C 00 02385 DRESP DB 0
2C1D 8E2E 02386 DW DATPRM+1
02387 ;
02388 ; MOD (M) - Flag input only
02389 ;
2C1F 53 02390 DB FLAG!ABB!3
2C20 4D 02391 DB 'MOD'
4F 44
2C23 00 02392 DB 0
2C24 9826 02393 DW CKMOD+1
02394 ;
02395 ; SORT (O) - Flag input only
02396 ;
2C26 44 02397 DB FLAG!4
2C27 53 02398 DB 'SORT'
4F 52 54
2C2B 00 02399 DB 0
2C2C FC26 02400 DW SORTPRM+1
02401 ;
2C2E 41 02402 DB FLAG!1
2C2F 4F 02403 DB 'O'
2C30 00 02404 DB 0
2C31 FC26 02405 DW SORTPRM+1
02406 ;
02407 ;
2C33 00 02408 DB 0
02409 ;
2C34 78 02410 DEN DB 'xDEN'
44 45 4E
2C38 48 02411 HARD DB 'Hard'
61 72 64
02412 ;
2C3C 44 02413 DSTRING DB 'Drive :'
72 69 76 65 20 3A
2C43 64 02414 DRIVE DB 'd '
20 20
2C46 64 02415 NAME DB 'diskname '
69 73 6B 6E 61 6D 65 20
20
2C50 20 02416 CYLCNT DB ' Cyl, '
20 20 20 43 79 6C 2C 20
2C59 6E 02417 DENSITY DB 'nDEN, Free ='
44 45 4E 2C 20 46 72 65
65 20 3D
2C65 20 02418 KFREE DB ' . K / '
20 20 20 20 2E 20 20 4B
20 2F 20
2C71 20 02419 KPOSS DB ' . K, Date '
20 20 20 20 2E 20 20 4B
2C 20 20 44 61 74 65 20
2C82 64 02420 DATBUF DB 'dd-mmm-yy',CR
64 2D 6D 6D 6D 2D 79 79
0D
02421 ;
2C8C 46 02422 HEADING DB 'Filespec MOD Attr Prot LRL'
69 6C 65 73 70 65 63 20
20 20 20 4D 4F 44 20 41
74 74 72 20 20 20 50 72
6F 74 20 20 4C 52 4C
2CAC 20 02423 DB ' #Recs EOF File Size Ext Mod '
20 23 52 65 63 73 20 20
45 4F 46 20 20 46 69 6C
65 20 53 69 7A 65 20 20
45 78 74 20 20 4D 6F 64
20
2CCE 44 02424 DB 'Date Time',CR
61 74 65 20 20 20 54 69
6D 65 0D
02425 ;
2CDA 20 02426 FDISP DB ' files of'
20 20 20 66 69 6C 65 73
20 6F 66
2CE6 20 02427 FUSED DB ' selected, '
20 20 20 20 73 65 6C 65
63 74 65 64 2C 20
2CF5 20 02428 SPUSED DB ' . K',LF,CR
20 20 20 20 2E 20 20 4B
0A 0D
02429 ;
2D00 44 02430 NODISK DB 'Drive :'
72 69 76 65 20 3A
2D07 6E 02431 NDRIVE DB 'n [No Disk]',LF,CR
20 20 5B 4E 6F 20 20 44
69 73 6B 5D 0A 0D
02432 ;
2D16 6D 02433 TDATE DB 'mm/dd/yy"'
6D 2F 64 64 2F 79 79 22
2D1F 46 02434 PROTS$ DB 'FULLREMVNAMEWRITUPDTREADEXECNO '
55 4C 4C 52 45 4D 56 4E
41 4D 45 57 52 49 54 55
50 44 54 52 45 41 44 45
58 45 43 4E 4F 20 20
2D3F 1F 02435 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
2D4B 30 02436 HUNDTAB DB '00255075'
30 32 35 35 30 37 35
2D53 4E 02437 NOMEM$ DB 'No memory for SORT',CR
6F 20 6D 65 6D 6F 72 79
20 66 6F 72 20 53 4F 52
54 0D
2D66 42 02438 BADFMT$ DB 'Bad date format',CR
61 64 20 64 61 74 65 20
66 6F 72 6D 61 74 0D
02439 IF @BLD631D
2D76 2B 02440 P631D1: DEC HL ;<631D>
2D77 02441 @@FLAGS ;<631D>
2D77+3E65 02442 LD A,101
2D79+EF 02443 RST 40
2D7A 7E 02444 LD A,(HL) ;<631D>
2D7B C9 02445 RET ;<631D>
2D7C FDCB0866 02446 P631D2: BIT 4,(IY+8) ;<631D>
2D80 FDE1 02447 POP IY ;<631D>
2D82 C34F29 02448 JP P631D3 ;<631D>
02449 ;<631D>If you want the code to exactly match the MISOSYS PATCH DIR1/FIX,
02450 ;<631D>Uncomment the EQU and comment-out the DB. WARNING, the EQU references
02451 ;<631D>a location in SYSRES to avoid making the module grow by the patch size.
04DC 02452 MONTBL EQU 04DCH ;<631D>Location of MONTBL$ in SYSRES
2D85 4A 02453 DB 'JunJulAugSepOctNovDec' ;<631D>Use with MONTBL$ EQU
75 6E 4A 75 6C 41 75 67
53 65 70 4F 63 74 4E 6F
76 44 65 63
02454 ;<631D>If you build the code, build it right, but it won't match exactly
02455 ;MONTBL DB 'JanFebMarAprMayJunJulAugSepOctNovDec' ;<631D>
02456 ELSE
02457 MONTBL DB 'JanFebMarAprMayJunJulAugSepOctNovDec'
02458 ENDIF
2D9A 00 02459 FTFLG DB 0
2D9B 00 02460 FILFLAG DB 0
2D9C 02461 DIRPTR EQU $
2D9E 02462 MAXMEM EQU DIRPTR+2
2DA0 02463 FMPAKD EQU MAXMEM+2
2DA2 02464 TOPAKD EQU FMPAKD+2
2DA4 02465 LILBUF$ EQU TOPAKD+2
02466 ;
02467 ;
2DA7 02468 BLANKS EQU LILBUF$+3
2DB4 02469 PLEVEL EQU BLANKS+13
2DBA 02470 LRL EQU PLEVEL+6
2DBF 02471 RECORDS EQU LRL+5
2DC6 02472 OFFSET EQU RECORDS+7
2DCB 02473 KSIZE EQU OFFSET+5
2DD7 02474 EXTENTS EQU KSIZE+12
2DDB 02475 DATEFLD EQU EXTENTS+4
2DEB 02476 ETXBUF EQU DATEFLD+16
02477 ;
2E00 02478 GAT EQU ETXBUF+1<-8+1<+8
2E00 02479 HIT EQU GAT
2F00 02480 BUF2 EQU GAT+256
3000 02481 MEMORY EQU GAT+512
02482 ;
02483 IFGT MEMORY,3000H
02484 ERR 'Buffers overflow LIB region'
02485 ENDIF
02486 ;
02489 ;
02490 ; DIR Entry Point - Initialization code
02491 ;
02492 DIR
2D9C 02493 @@CKBRKC ;Check for break
2D9C+3E6A 02494 LD A,106
2D9E+EF 02495 RST 40
2D9F 2804 02496 JR Z,DIRA ;If not go
2DA1 21FFFF 02497 LD HL,-1 ; else abort
2DA4 C9 02498 RET
02499 ;
02500 DIRA
2DA5 ED732C24 02501 LD (SAVESP+1),SP ;Save SP address
2DA9 E5 02502 PUSH HL ;Save command ptr
02503 ;
02504 ; Pick up Flag Table base Address
02505 ;
2DAA 02506 @@FLAGS ;IY => System Flag table
2DAA+3E65 02507 LD A,101
2DAC+EF 02508 RST 40
2DAD FDE5 02509 PUSH IY ;Xfer to DE too
2DAF D1 02510 POP DE
2DB0 211800 02511 LD HL,'Y'-'A' ;Get date type flag
2DB3 19 02512 ADD HL,DE
2DB4 22822A 02513 LD (YFLAG1),HL
2DB7 22F528 02514 LD (YFLAG2),HL
02515 ;
02516 ; Calculate KFLAG$ address & stuff away
02517 ;
2DBA 210A00 02518 LD HL,KFLAG$ ;KFLAG$ offset
2DBD 19 02519 ADD HL,DE ;HL => KFLAG$
2DBE 22CE2A 02520 LD (KFLAG+1),HL ;Save for later testing
2DC1 22E32A 02521 LD (RESKFL+1),HL
2DC4 22E82A 02522 LD (KFLAG1+1),HL
02523 ;
2DC7 CDE22A 02524 CALL RESKFL ;Reset bits 0-2 of KFLAG$
2DCA E1 02525 POP HL ;Rvr command ptr
02526 ;
02527 ; Pick up SFLAG
02528 ;
2DCB FD7E12 02529 LD A,(IY+'S'-'A') ;Get SFLAG
2DCE 32B22A 02530 LD (SFLAG+1),A ;Save for later testing
02531 ;
02532 ; Find parameter entry if existent
02533 ;
2DD1 E5 02534 PUSH HL ;Save command ptr
2DD2 7E 02535 FPLP LD A,(HL) ;P/u character
2DD3 FE28 02536 CP '(' ;Parameter(s) ?
2DD5 2807 02537 JR Z,GETPRM ;Yes - go get 'em
2DD7 FE0D 02538 CP CR ;End of line ?
2DD9 2809 02539 JR Z,RESTPTR ;Yes - restore ptr
2DDB 23 02540 INC HL ;No - bump til end
2DDC 18F4 02541 JR FPLP ;Do til eol or "("
02542 ;
02543 ; Process any parameters entered
02544 ;
2DDE 11F92B 02545 GETPRM LD DE,PRMTBL$ ;DE => Parameter table
2DE1 02546 @@PARAM ;@PARAM
2DE1+3E11 02547 LD A,17
2DE3+EF 02548 RST 40
2DE4 E1 02549 RESTPTR POP HL ;Recover ptr
2DE5 C21E24 02550 JP NZ,IOERR ;NZ - "Parameter Error"
02551 ;
2DE8 E5 02552 PUSH HL
2DE9 21A72D 02553 LD HL,BLANKS ;Clear dsp buffer area
2DEC 3620 02554 LD (HL),' '
2DEE 54 02555 LD D,H
2DEF 5D 02556 LD E,L
2DF0 13 02557 INC DE ;Set to blank buffer
2DF1 014400 02558 LD BC,ETXBUF-BLANKS
2DF4 EDB0 02559 LDIR
2DF6 3E03 02560 LD A,ETX
2DF8 12 02561 LD (DE),A
2DF9 3E2E 02562 LD A,'.'
2DFB 32D02D 02563 LD (KSIZE+5),A
2DFE 3E4B 02564 LD A,'K'
2E00 32D32D 02565 LD (KSIZE+8),A
2E03 E1 02566 POP HL
02567 ;
02568 ; If first character is a "8" or "9" abort
02569 ;
2E04 7E 02570 LD A,(HL) ;Is this a "8" or "9" ?
2E05 FE0D 02571 CP CR ;If CR, then global
2E07 2838 02572 JR Z,DIR2
2E09 FE38 02573 CP '8' ;If so - Illegal drive #
2E0B 2804 02574 JR Z,ILLDRV
2E0D FE39 02575 CP '9'
2E0F 2003 02576 JR NZ,CKITOUT ;Must be a partspec
02577 ;
02578 ; Illegal Drive Number
02579 ;
2E11 C31C24 02580 ILLDRV JP ERR32 ;Go to I/O error handler
02581 ;
02582 ; Pick up Drive # Range field if any
02583 ;
2E14 E5 02584 CKITOUT PUSH HL ;Save source ptr
2E15 CDDD2E 02585 CALL CKDSPEC ;Legal Drive range ?
2E18 D1 02586 POP DE ;Save source ptr in DE
2E19 283F 02587 JR Z,DIR3 ;Legal - use HL
02588 ;
02589 ; Point DE => Partspec match field, B=8 chars
02590 ;
2E1B EB 02591 EX DE,HL ;Illegal - use DE
2E1C 7E 02592 LD A,(HL) ;P/u first char
2E1D 23 02593 INC HL ; and bump to next
2E1E 11A72D 02594 DIR0 LD DE,BLANKS ;DE => Partspec area
2E21 0608 02595 LD B,8 ;B = 8 chars/filename
02596 ;
02597 ; Was the NOT switch entered ?
02598 ;
2E23 FE2D 02599 CP '-' ;NOT ?
2E25 2005 02600 JR NZ,DIR1 ;No - continue
02601 ;
02602 ; NOT "-" entered - set flag & bump cmd ptr
02603 ;
2E27 32C726 02604 LD (MFLG+1),A ;Stuff "-" in flag
2E2A 7E 02605 LD A,(HL) ;P/u next char & bump
2E2B 23 02606 INC HL ; command ptr
02607 ;
02608 ; Transfer Filename to Filespec buffer
02609 ;
2E2C CD202F 02610 DIR1 CALL PRSPC ;Parse 8 chars
2E2F FE2F 02611 CP '/' ;Extension ?
2E31 2804 02612 JR Z,DIR1A
2E33 FE2E 02613 CP '.'
2E35 200A 02614 JR NZ,DIR2
02615 ;
02616 ; Transfer Extension to Filespec buffer
02617 ;
2E37 11AF2D 02618 DIR1A LD DE,BLANKS+8 ;DE => Extension field
2E3A 0603 02619 LD B,3 ;Max 3 chars
2E3C 7E 02620 LD A,(HL) ;P/u next character
2E3D 23 02621 INC HL ;Bump
2E3E CD202F 02622 CALL PRSPC ;Xfer extension
02623 ;
02624 ; Was a drivespec entered ?
02625 ;
2E41 FE3A 02626 DIR2 CP ':' ;Drive entered?
2E43 010700 02627 LD BC,7 ;St = 0, terminating = 7
2E46 2809 02628 JR Z,DIR2A ;Yes, check it out
2E48 FE29 02629 CP '('+1 ;Was last char valid?
2E4A 380E 02630 JR C,DIR3 ;Yes, global dir
2E4C 3E13 02631 LD A,19 ;"Illegal filename
2E4E C31E24 02632 JP IOERR
02633 ;
02634 ; Check if char following is a legal drive #
02635 ;
2E51 CDDD2E 02636 DIR2A CALL CKDSPEC ;Legal Drive field ?
2E54 20BB 02637 JR NZ,ILLDRV ;Illegal - abort
2E56 FE08 02638 CP 8 ;Trap DIR :8
2E58 28B7 02639 JR Z,ILLDRV
02640 ;
02641 ; B = Start drv #, C = Term drv # - save 'em
02642 ;
2E5A 78 02643 DIR3 LD A,B ;Save starting drive
2E5B 32D42E 02644 LD (DIR3A+1),A
2E5E 91 02645 SUB C ;Set Specific Drive flag
2E5F 323A26 02646 LD (SPECIF+1),A
2E62 79 02647 LD A,C ;Save term drive
2E63 322F26 02648 LD (TERMDRV+1),A
02649 ;
02650 ; Command line parsed - check available mem
02651 ;
2E66 FDCB024E 02652 BIT 1,(IY+CFLAG$) ;Called from @CMNDR?
2E6A 210000 02653 LD HL,0 ;Set SORT (O) parm = 0
2E6D 2803 02654 JR Z,GETHI ;No - fine
02655 ;
02656 ; Executing from @CMNDR - Turn off SORT
02657 ;
2E6F 22FC26 02658 LD (SORTPRM+1),HL
02659 ;
02660 ; Pick up Current HIGH$, & set max mem to use
02661 ;
2E72 45 02662 GETHI LD B,L ;B=0
2E73 02663 @@HIGH$
2E73+3E64 02664 LD A,100
2E75+EF 02665 RST 40
2E76 11DFFF 02666 LD DE,-33 ;Subtract 33 from it
2E79 19 02667 ADD HL,DE
2E7A 229E2D 02668 LD (MAXMEM),HL ;Stuff in maximum memory
02669 ;
02670 ; Turn on N parm if P parm specified
02671 ;
2E7D 2A2A2A 02672 LD HL,(PPARM+1) ;P/u P-parm
2E80 7C 02673 LD A,H ;Specified ?
2E81 B5 02674 OR L
2E82 2803 02675 JR Z,GTDATE ;No - don't change N
2E84 22AC2A 02676 LD (NPARM+1),HL ;Turn on N-parm
02677 ;
02678 ; Was the DATE parameter specified ?
02679 ;
2E87 3A1C2C 02680 GTDATE LD A,(DRESP) ;Check out response
2E8A B7 02681 OR A ;Any response ?
2E8B 2846 02682 JR Z,DIR3A ;None entered - no date
02683 ;
02684 ; Something was specified - Check type
02685 ;
2E8D 210000 02686 DATPRM LD HL,$-$ ;P/u date
2E90 CB77 02687 BIT 6,A ;Flag input ?
2E92 280C 02688 JR Z,CHKSTR ;No - must be string
02689 ;
02690 ; Flag input - if YES, then use today's date
02691 ;
2E94 7C 02692 LD A,H ;DATE = OFF ?
2E95 B5 02693 OR L
2E96 283B 02694 JR Z,DIR3A ;Yes - ignore it
02695 ;
02696 ; DATE parameter entered - get today's date
02697 ;
2E98 21162D 02698 LD HL,TDATE ;HL => Todays Date
2E9B E5 02699 PUSH HL ;Save position
2E9C 02700 @@DATE ;Get today's date
2E9C+3E12 02701 LD A,18
2E9E+EF 02702 RST 40
2E9F E1 02703 POP HL ;HL => Today's Date
02704 ;
02705 ; Display dates before "-mm/dd/yy" ?
02706 ;
2EA0 7E 02707 CHKSTR LD A,(HL) ;P/u first char
2EA1 FE2D 02708 CP '-' ;"to-" ?
2EA3 2815 02709 JR Z,CKTO ;Yes - do it
02710 ;
02711 ; Not before - set flag accordingly
02712 ;
2EA5 3E80 02713 LD A,80H ;Set from bit
2EA7 329A2D 02714 LD (FTFLG),A ;Note from entered
02715 ;
02716 ; Pack Date entry
02717 ;
2EAA CD4C2F 02718 CALL PAKDAT ;Pack the date entry
2EAD ED43A02D 02719 LD (FMPAKD),BC ;Stuff away date
02720 ;
02721 ; End of first date ?
02722 ;
2EB1 7E 02723 LD A,(HL) ;P/u terminator
2EB2 FE22 02724 CP '"' ;End of date ?
2EB4 2811 02725 JR Z,FRCTO ;Yes - use spec'd date
02726 ;
02727 ; Is there a to "-" symbol following date ?
02728 ;
2EB6 FE2D 02729 CP '-' ;Check for "-to"
2EB8 2019 02730 JR NZ,DIR3A ;No - check if legal
02731 ;
02732 ; Is there a date following ?
02733 ;
2EBA 23 02734 CKTO INC HL ;Bypass the '-'
2EBB 7E 02735 LD A,(HL) ;P/u next char
2EBC FE22 02736 CP '"' ;End of parm ?
2EBE 2813 02737 JR Z,DIR3A ;Yes - use that date
02738 ;
2EC0 FE0D 02739 CP CR ;End of parm ?
2EC2 280F 02740 JR Z,DIR3A ;Yes - use that date
02741 ;
02742 ; Something following - parse date
02743 ;
2EC4 CD4C2F 02744 CALL PAKDAT ;Pack Date
02745 ;
02746 ; Stuff in "TO" packed date & set TO flag
02747 ;
2EC7 3A9A2D 02748 FRCTO LD A,(FTFLG) ;P/u From-To Flag
2ECA F601 02749 OR 1 ;Set TO bit
2ECC 329A2D 02750 LD (FTFLG),A ;Stuff in flag
2ECF ED43A22D 02751 LD (TOPAKD),BC ;Stuff for later
02752 ;
02753 ; P/u starting drive #, & init page counter
02754 ;
2ED3 0E00 02755 DIR3A LD C,$-$ ;P/u starting drive
2ED5 3E16 02756 LD A,22 ;Max lines to dsply
2ED7 32A02A 02757 LD (CKPAGE+1),A ;Stuff in counter
2EDA C33224 02758 JP DIR4 ;Directory Start
02759 ;
02760 ; CKDSPEC - Check if a drive spec field is legal
02761 ; HL => Drive specification Field
02762 ; Z - Set if Drive spec Field is Legal
02763 ; B <= Starting Drive # (0-7)
02764 ; C <= Terminating Drive # (0-7)
02765 ;
2EDD 7E 02766 CKDSPEC LD A,(HL) ;P/u first character
2EDE FE2D 02767 CP '-' ;"TO" or "NOT" ?
2EE0 200C 02768 JR NZ,NOTDASH ;No - check if drive #
02769 ;
02770 ; Char is a "-" ---- Could be "TO" or "NOT"
02771 ;
2EE2 CD182F 02772 CALL LEGDRV ;Legal Drive Number ?
2EE5 D8 02773 RET C ;No - RETurn NZ
02774 ;
02775 ; Legal Drive # - Next char must be a term
02776 ;
2EE6 4F 02777 LD C,A ;C = Terminating Drive
2EE7 23 02778 INC HL ;HL => Following char
2EE8 CD012F 02779 CALL TERM ;Does a term follow ?
2EEB 0600 02780 LD B,0 ;B default start 0
2EED C9 02781 RET ;RETurn Z or NZ
02782 ;
02783 ; Is the First character a legal drive # ?
02784 ;
2EEE CD192F 02785 NOTDASH CALL LEGDRV1 ;Legal drive (0-7) ?
2EF1 D8 02786 RET C ;No - RETurn NZ (ex 8)
2EF2 47 02787 LD B,A ;Set B = Starting Drive
2EF3 4F 02788 LD C,A ;Set C = Terminator
02789 ;
02790 ; Legal Drive - a "-" or term MUST follow
02791 ;
2EF4 23 02792 INC HL ;Bump to next char
2EF5 7E 02793 LD A,(HL) ;If next char is not a
2EF6 FE2D 02794 CP '-' ; "-", RETurn Z or NZ
2EF8 2811 02795 JR Z,CKTDRIV ; depending on next char.
2EFA CD012F 02796 CALL TERM ;Legal terminator ?
2EFD C2112E 02797 JP NZ,ILLDRV ;No - Illegal Drive #
2F00 C9 02798 RET ;Yes - Return
02799 ;
02800 ; Is the character a terminator ?
02801 ;
2F01 7E 02802 TERM LD A,(HL) ;P/u char
2F02 FE20 02803 CP ' ' ;Space is legal
2F04 C8 02804 RET Z ;RETurn Z if space
2F05 FE0D 02805 CP CR ;CR is legal
2F07 C8 02806 RET Z ;RETurn Z if CR
2F08 FE28 02807 CP '(' ;Paren is legal
2F0A C9 02808 RET ;RETurn w/ condition
02809 ;
02810 ; Next char must be a valid drive # or term
02811 ;
2F0B CD182F 02812 CKTDRIV CALL LEGDRV ;Legal Drive # ?
2F0E 0E07 02813 LD C,7 ;C = Default term drive 7
2F10 38EF 02814 JR C,TERM ;Not drv # - ck for term
02815 ;
02816 ; Make sure Term Drive # > or = Start Drive #
02817 ;
2F12 4F 02818 LD C,A ;Set C = Term drive #
2F13 B8 02819 CP B ;> or = start drive # ?
2F14 D8 02820 RET C ;Less - Return
02821 ;
02822 ; Drive span range good - make sure term legal
02823 ;
2F15 23 02824 INC HL ;Bump ptr
2F16 18E9 02825 JR TERM ;RETurn Z or NZ
02826 ;
02827 ; LEGDRV - Is a character a legal drive #
02828 ; HL => One before Character to check
02829 ; HL <= Character in question
02830 ; A <= Drive Number (0-7)
02831 ; CF <= Set if Character is not a legal drive #
02832 ;
2F18 23 02833 LEGDRV INC HL ;Bump to next
2F19 7E 02834 LEGDRV1 LD A,(HL) ;P/u char
2F1A D630 02835 SUB '0' ;Convert to binary
2F1C FE08 02836 CP 7+1 ;Greater than "7" ?
2F1E 3F 02837 CCF ;C - Illegal
2F1F C9 02838 RET ;RETurn with condition
02839 ;
02840 ; PRSPC - Parse a line and stuff in buffer
02841 ; HL => Source Buffer
02842 ; DE => Destination of converted field
02843 ; B = # of characters to parse
02844 ;
2F20 FE2A 02845 PRSPC: CP '*' ;Global wc?
2F22 2009 02846 JR NZ,PS4 ;Go if not
2F24 3E24 02847 LD A,'$' ;Make all remaining into $
2F26 12 02848 PS5 LD (DE),A
2F27 13 02849 INC DE
2F28 10FC 02850 DJNZ PS5
2F2A 7E 02851 LD A,(HL) ;Get next char
2F2B 23 02852 INC HL ;Posn for next char
2F2C C9 02853 RET
02854 ;
2F2D FE24 02855 PS4 CP '$' ;Wild character?
2F2F 2814 02856 JR Z,PS2 ;Yes - stuff in buff
2F31 FE41 02857 CP 'A' ;Alphabetic ?
2F33 3006 02858 JR NC,PS1 ;Maybe - convert to U/C
02859 ;
02860 ; Is the character a numeric value (0-9) ?
02861 ;
2F35 FE3A 02862 CP '9'+1 ;Greater than "9" ?
2F37 D0 02863 RET NC ;Yes - return
2F38 FE30 02864 CP '0' ;Less than "0" ?
2F3A D8 02865 RET C ;Yes - return
02866 ;
02867 ; Convert character to Upper Case
02868 ;
2F3B FE61 02869 PS1 CP 'a' ;Lower case alpha ?
2F3D 3806 02870 JR C,PS2 ;No - stuff in buffer
2F3F FE7B 02871 CP 'z'+1
2F41 3002 02872 JR NC,PS2
2F43 CBAF 02873 RES 5,A ;Convert to U/C
02874 ;
02875 ; Put char in buffer, & bump cmd & buffer ptrs
02876 ;
2F45 12 02877 PS2 LD (DE),A ;Stuff in buffer
2F46 13 02878 PS3 INC DE ;Bump
2F47 7E 02879 LD A,(HL) ;P/u command buff char
2F48 23 02880 INC HL ;Bump
2F49 10D5 02881 DJNZ PRSPC ; B times
2F4B C9 02882 RET
02883 ;
02884 ; PAKDAT - Pack Date & Stuff into buffer
02885 ; HL => Buffer containing Date string
02886 ; BC <= Packed Date in lsb,msb format
02887 ;
2F4C 7E 02888 PAKDAT LD A,(HL) ;P/u character
2F4D 0E2F 02889 LD C,'/' ;Init separator
02890 ;
02891 ; Is the date a valid entry ?
02892 ;
2F4F CD9D2F 02893 CALL PARSDAT ;Parse entry
2F52 C21124 02894 JP NZ,BADFMT ;Abort on format error
02895 ;
02896 ; If year = 1980 or 84 then set FEB = 29 days
02897 ;
02898 IF @BLD631
2F55 1A 02899 LD A,(DE) ;<631>
2F56 FE0C 02900 CP 0CH ;<631>
2F58 3003 02901 JR NC,L2F5D ;<631>
2F5A C664 02902 ADD A,64H ;<631>
2F5C 12 02903 LD (DE),A ;<631>
02904 L2F5D: ;<631>
02905 ENDIF
2F5D EB 02906 EX DE,HL ;Save command ptr
02907 IF @BLD631
02908 ELSE
02909 LD A,(LILBUF$) ;P/u year (80-87)
02910 ENDIF
2F5E E603 02911 AND 3 ;Mask off bits 7-2
2F60 21402D 02912 LD HL,MAXDAYS+1 ;Set Feb to have 29 days
2F63 2001 02913 JR NZ,NOTLEAP ;No - don't inc it
2F65 34 02914 INC (HL) ;Leap year - inc max days
02915 ;
02916 ; Check Range of month - must be 1-12
02917 ;
2F66 3AA62D 02918 NOTLEAP LD A,(LILBUF$+2) ;P/u month
2F69 3D 02919 DEC A ;Set month = 1-11
2F6A FE0C 02920 CP 12 ;Valid month ?
2F6C D21124 02921 JP NC,BADFMT ;Abort if 0 or >12
02922 ;
02923 ; Valid month - point HL to max days/month
02924 ;
2F6F 2B 02925 DEC HL ;Point before JAN entry
2F70 85 02926 ADD A,L ;Add the month
2F71 6F 02927 LD L,A ;HL => max days for month
2F72 3001 02928 JR NC,NOINC ;Bump H if C set
2F74 24 02929 INC H
02930 ;
02931 ; Check if day entry is valid
02932 ;
2F75 3AA52D 02933 NOINC LD A,(LILBUF$+1) ;P/u day entry
2F78 3D 02934 DEC A ;Reduce for test (0->FF)
2F79 BE 02935 CP (HL) ;More than max days ?
2F7A D21124 02936 JP NC,BADFMT ;Go if too large (or 0)
02937 ;
02938 ; Pick up month from buffer
02939 ;
2F7D 21A62D 02940 LD HL,LILBUF$+2 ;Pt to month
2F80 46 02941 LD B,(HL)
2F81 0E00 02942 LD C,0
2F83 CB38 02943 SRL B ;LSbit of mon to C
2F85 CB19 02944 RR C
2F87 2B 02945 DEC HL ;Pt to day
2F88 7E 02946 LD A,(HL)
2F89 2B 02947 DEC HL
2F8A 07 02948 RLCA ;Shift day left to
2F8B 07 02949 RLCA ; bits 2-6
2F8C B1 02950 OR C ;Merge w/month
2F8D 4F 02951 LD C,A
2F8E 7E 02952 LD A,(HL) ;Get year
2F8F D650 02953 SUB 80 ;Use only offset
02954 IF @BLD631
2F91 FE70 02955 CP 70H ;<631>
2F93 3801 02956 JR C,GDATE ;<631>Go if date ok
02957 ELSE
02958 JR NC,GDATE ;Go if date ok
02959 ENDIF
2F95 AF 02960 XOR A ; else use 0
2F96 07 02961 GDATE RLCA ;Posn for merge with month
2F97 07 02962 RLCA
2F98 07 02963 RLCA
2F99 B0 02964 OR B
2F9A 47 02965 LD B,A
2F9B EB 02966 EX DE,HL
2F9C C9 02967 RET
02968 ;
02969 ; PARSDAT - Parse TIME/DATE string entry
02970 ; HL => Buffer containing string to parse
02971 ; C => Delimiter ("/" = DATE, ":" = TIME)
02972 ; LILBUF$-LILBUF$+2 <= Data in compressed format
02973 ; Z - Set if successful
02974 ;
2F9D 11A62D 02975 PARSDAT LD DE,LILBUF$+2 ;Point to buf end
2FA0 0603 02976 LD B,3 ;Process 3 fields
02977 ;
02978 ; Parse a field - Return NZ if bad
02979 ;
2FA2 D5 02980 PRS1 PUSH DE ;Save pointer
2FA3 CDB22F 02981 CALL PRS2 ;Get a digit pair
2FA6 D1 02982 POP DE ;Recover pointer
2FA7 C0 02983 RET NZ ;Ret if bad digit pair
02984 ;
02985 ; Good field - Stuff in buff, dec ptr, & count
02986 ;
2FA8 12 02987 LD (DE),A ; else stuff the value
02988 IF @BLD631
2FA9 05 02989 DEC B ;<631>Loop countdown
2FAA C8 02990 RET Z ;<631>Do for 3 fields
2FAB 1B 02991 DEC DE ;<631>Backup the pointer
02992 ELSE
02993 DEC DE ;Backup the pointer
02994 DEC B ;Loop countdown
02995 RET Z ;Do for 3 fields
02996 ENDIF
02997 ;
02998 ; Parsed a field - is the separator valid ?
02999 ;
2FAC 7E 03000 LD A,(HL) ;P/u separator
2FAD 23 03001 INC HL ;Bump pointer
2FAE B9 03002 CP C ;Correct ?
2FAF 28F1 03003 JR Z,PRS1 ;Yes - continue
2FB1 C9 03004 RET ;No - RET NZ
03005 ;
03006 ; PRS2 - Parse a digit pair at HL
03007 ;
2FB2 CDC82F 03008 PRS2 CALL PRS4 ;Get a digit
2FB5 300F 03009 JR NC,PRS3 ;Illegal - clr stc & RET
03010 ;
03011 ; Legal Digit - Multiply by 10
03012 ;
2FB7 5F 03013 LD E,A ;Multiply by ten
2FB8 07 03014 RLCA ;X 2
2FB9 07 03015 RLCA ;X 4
2FBA 83 03016 ADD A,E ;X 5
2FBB 07 03017 RLCA ;X 10
2FBC 5F 03018 LD E,A ;Stuff in E
03019 ;
03020 ; Get another digit
03021 ;
2FBD CDC82F 03022 CALL PRS4 ;Get ones digit
2FC0 3004 03023 JR NC,PRS3 ;Bad - return NZ
03024 ;
03025 ; Legal digit - Add to tens digit & set Z flag
03026 ;
2FC2 83 03027 ADD A,E ;Accumulate new digit
2FC3 5F 03028 LD E,A ;Save 2-digit value
2FC4 BF 03029 CP A ;Clear flags
2FC5 C9 03030 RET ;Return Z
03031 ;
03032 ; Force NZ & Return
03033 ;
2FC6 B7 03034 PRS3 OR A ;Set NZ
2FC7 C9 03035 RET ;RETurn
03036 ;
03037 ; Pick up a digit and convert to binary
03038 ;
2FC8 7E 03039 PRS4 LD A,(HL) ;P/u a digit &
2FC9 23 03040 INC HL ; bump ptr
2FCA D630 03041 SUB '0' ;Convert to binary
2FCC FE0A 03042 CP 10 ;Legal ?
2FCE C9 03043 RET ;C - legal, NC - illegal
03044 ;
2FCF 03045 ENDMEM EQU $
03046 ;
03047 ; Bytes Free =
03048 ;
0031 03049 FREE$ EQU 3000H-ENDMEM
03050 ;
03051 IFGT $,2FFFH
03052 ERR 'LIB memory region overflow
03053 ENDIF
03054 ;
2400 03056 END ENTRY
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]