[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:12:43 DEVICE - LS-DOS 6.2 Page 00001
00001 ;LBDEVICE/ASM - DEVICE Command
00003 ;
000A 00004 LF EQU 10
000D 00005 CR EQU 13
0000 00006 *GET BUILDVER:3
00007 ;
00008 ; Buildver/asm is a bit of a kludge since not all utilities can load
00009 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00010 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00011 ; for programs that can use that.
00012 ;
FFFF 00013 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00014 ; These switches activate patches made since the 1B release.
00015 ; It is important that all earlier patches be enabled when a higher
00016 ; patch is enabled.
00017 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00018 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00019 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00020 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00021 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00022 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00023 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00024 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00025 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00026 ;
00027 ;End of BUILDVER/ASM
0000 00028 *GET SVCMAC:3 ;SVC Macro equivalents
00029 ;SVCMAC/ASM - LS-DOS Version VI
00030 *LIST OFF
00422 *LIST ON
00424 ;
2400 00425 ORG 2400H
00426 ;
00427 DEVICE
2400 00428 @@CKBRKC ;Check for break
2400+3E6A 00429 LD A,106
2402+EF 00430 RST 40
2403 2804 00431 JR Z,DEVICEA ;Continue if not
2405 21FFFF 00432 LD HL,-1 ; else abort
2408 C9 00433 RET
00434 ;
2409 ED73B227 00435 DEVICEA LD (SAVESP+1),SP ;Save stack pointer
240D 119E28 00436 LD DE,PRMTBL$ ;First check for user parms
2410 00437 @@PARAM
2410+3E11 00438 LD A,17
2412+EF 00439 RST 40
2413 C27A27 00440 JP NZ,IOERR ;Go if parm error
2416 00441 @@FLAGS ;Get flag table pointer
2416+3E65 00442 LD A,101
2418+EF 00443 RST 40
2419 CDA227 00444 CALL RESKFL ;Reset Pause and Enter
241C FB 00445 EI ;Make sure they're on
241D 21FFFF 00446 DPARM LD HL,-1 ;Check Drive parameter
2420 7C 00447 LD A,H
2421 B5 00448 OR L
2422 CA7B25 00449 JP Z,DEND ;Go if D=NO
2425 0E00 00450 LD C,0 ;Init to drive 0
2427 C5 00451 DEV1 PUSH BC ;Save drive #
2428 AF 00452 XOR A ;Reset flag stuff
2429 327A24 00453 LD (WPTEST+1),A ; location
242C 00454 @@GTDCT ;Get DCT address
242C+3E51 00455 LD A,81
242E+EF 00456 RST 40
242F FD7E00 00457 LD A,(IY+0) ;Is this drive disabled?
2432 FEC3 00458 CP 0C3H
2434 C27325 00459 JP NZ,POPDRV ;Ignore if it is
2437 00460 @@CKDRV ;This drive available?
2437+3E21 00461 LD A,33
2439+EF 00462 RST 40
243A 2022 00463 JR NZ,DEV2 ;Go if no diskette
243C 1F 00464 RRA ;Shift C-flag to bit-7
243D 327A24 00465 LD (WPTEST+1),A ; & save for WP test
2440 210029 00466 LD HL,BUFFER ;Pick up the GAT for the
2443 FD5609 00467 LD D,(IY+9) ; pack name
2446 5D 00468 LD E,L
2447 00469 @@RDSSC
2447+3E55 00470 LD A,85
2449+EF 00471 RST 40
244A 3E14 00472 LD A,20 ;"GAT read error
244C C27A27 00473 JP NZ,IOERR
244F 21D829 00474 LD HL,BUFFER+0D8H ;Shove bracket ETX
2452 365D 00475 LD (HL),']'
2454 2C 00476 INC L
2455 3620 00477 LD (HL),' '
2457 2C 00478 INC L
2458 3603 00479 LD (HL),3
245A 2ED0 00480 LD L,0D0H ;Point to start of name
245C 180B 00481 JR DEV2A
00482 ;
00483 ; Drive info for this active drive
00484 ;
245E 21BD27 00485 DEV2 LD HL,NOPACK$ ;Display pack name
2461 11D029 00486 LD DE,BUFFER+0D0H
2464 010C00 00487 LD BC,12
2467 EDB0 00488 LDIR
2469 3E3A 00489 DEV2A LD A,':' ;Output the colon
246B CD6727 00490 CALL BYTOUT
246E C1 00491 POP BC ;Get drive # back
246F C5 00492 PUSH BC
2470 79 00493 LD A,C ;Get drive # converted
2471 C630 00494 ADD A,'0' ; to ASCII & display it
2473 CD6727 00495 CALL BYTOUT
00496 IF @BLD631
2476 CD6527 00497 CALL OUTSP ;<631>
2479 3E00 00498 WPTEST LD A,0 ;<631>P/u CKDRV FDC status
247B FDB603 00499 OR (IY+3) ;<631>
247E E680 00500 AND 80H ;<631>
00501 ELSE
00502 LD A,' ' ;Space out one
00503 CALL BYTOUT
00504 WPTEST LD A,0 ;P/u CKDRV FDC status
00505 RLCA ;Hardware write protect?
00506 JR C,DEV2B ;Force "WP" if it is
00507 BIT 7,(IY+3) ;Test software WP
00508 ENDIF
2480 3E20 00509 LD A,' ' ;Output ' ' for read &
2482 0620 00510 LD B,' ' ; write access or
2484 2804 00511 JR Z,$+6
2486 3E57 00512 DEV2B LD A,'W' ; WP for read only
2488 0650 00513 LD B,'P'
248A CD6727 00514 CALL BYTOUT
248D 78 00515 LD A,B ;Xfer the 2nd char
248E CD6727 00516 CALL BYTOUT ; & display it
00517 IF @BLD631
2491 CD6527 00518 CALL OUTSP ;<631>
00519 ELSE
00520 LD A,' '
00521 CALL BYTOUT
00522 ENDIF
2494 3E5B 00523 LD A,'[' ;Left bracket
2496 CD6727 00524 CALL BYTOUT
2499 21D029 00525 LD HL,BUFFER+0D0H ;Write the pack name
249C CD5527 00526 CALL LINOUT
00527 ;
00528 ; Determine if 5" or 8"
00529 ;
249F FDCB036E 00530 BIT 5,(IY+3) ;Test 5"/8" drive
24A3 3E35 00531 LD A,'5' ;Init to 5
24A5 2802 00532 JR Z,$+4 ;Bypass if not 8
24A7 3E38 00533 LD A,'8' ; else init to 8
24A9 CD6727 00534 CALL BYTOUT
24AC FDCB035E 00535 BIT 3,(IY+3) ;Test rigid/floppy
24B0 214528 00536 LD HL,FLOPY$ ;Init to floppy
24B3 2803 00537 JR Z,$+5 ;Bypass if that kind
24B5 215028 00538 LD HL,RIGID$ ; else is hard
24B8 CD5527 00539 CALL LINOUT
24BB FD7E04 00540 LD A,(IY+4) ;Output drive select addr
24BE E60F 00541 AND 0FH ; in ASCII
24C0 C690 00542 ADD A,90H
24C2 27 00543 DAA
24C3 CE40 00544 ADC A,40H
24C5 27 00545 DAA
24C6 CD6727 00546 CALL BYTOUT
24C9 FD6E06 00547 DEV3 LD L,(IY+6) ;P/u highest cylinder
24CC 2600 00548 LD H,0
24CE 23 00549 INC HL ;Adjust for zero offset
24CF FDCB035E 00550 BIT 3,(IY+3) ;Hard drive?
24D3 2807 00551 JR Z,DEV4 ;Bypass if soft
24D5 FDCB046E 00552 BIT 5,(IY+4) ;2-sided hard drives
24D9 2801 00553 JR Z,DEV4 ; are 2*cyl
24DB 29 00554 ADD HL,HL ; & multiply by 2
24DC 116228 00555 DEV4 LD DE,COMMA$ ;Convert # of cyls to
00556 IF @BLD631
24DF 0603 00557 LD B,3 ;<631>
24E1 00558 @@HEXD ;<631>
24E1+3E5F 00559 LD A,95
24E3+EF 00560 RST 40
00561 ELSE
00562 CALL CVRTDEC ; decimal & stuff in msg
00563 ENDIF
24E4 215B28 00564 LD HL,CYLS$ ;Display cyls=xxx
24E7 CD5527 00565 CALL LINOUT
24EA FDCB035E 00566 BIT 3,(IY+3) ;Bypass if soft drive
24EE 2811 00567 JR Z,FLOPPY
24F0 FDCB0356 00568 BIT 2,(IY+3) ;Test fixed/removable
24F4 216828 00569 LD HL,REMOV$ ;Init to removable
24F7 2803 00570 JR Z,$+5 ;Bypass if that way
24F9 217228 00571 LD HL,FIXED$ ; else init fixed
24FC CD5527 00572 CALL LINOUT
24FF 186F 00573 JR ENDLINE ;Bypass DEN, STEP, DLY
00574 ;
00575 ; Next section deals only with floppies
00576 ;
2501 FDCB0376 00577 FLOPPY BIT 6,(IY+3) ;Test SDEN/DDEN
2505 3E53 00578 LD A,'S' ;Init to sden
2507 2802 00579 JR Z,$+4 ;Bypass if sden
2509 3E44 00580 LD A,'D' ; else init to dden
250B CD6727 00581 CALL BYTOUT
250E 217828 00582 LD HL,DEN$ ;Now display "den"
2511 CD5527 00583 CALL LINOUT
2514 FDCB046E 00584 BIT 5,(IY+4) ;Test # of sides
2518 3E31 00585 LD A,'1' ;Init to 1
251A 2801 00586 JR Z,$+3 ;Bypass if single sided
251C 3C 00587 INC A ; else bump to 2
251D CD6727 00588 CALL BYTOUT
2520 218428 00589 LD HL,STEP$ ;Display "step="
2523 CD5527 00590 CALL LINOUT
2526 FD7E03 00591 LD A,(IY+3) ;P/u step rate & 8/5
2529 E623 00592 AND 23H ;Convert step rate to an
252B 47 00593 LD B,A ; index into the table
252C 0F 00594 RRCA
252D 0F 00595 RRCA ;5/8 bit to bit 2
252E 0F 00596 RRCA
252F B0 00597 OR B ;Merge step rate
2530 07 00598 RLCA
2531 E60E 00599 AND 0EH ;Mask off garbage
2533 213528 00600 LD HL,STPRAT$ ;Get table base
2536 85 00601 ADD A,L ;Add table lo order
2537 6F 00602 LD L,A ;Set lo-order
2538 8C 00603 ADC A,H
2539 95 00604 SUB L
253A 67 00605 LD H,A
253B 7E 00606 LD A,(HL) ;P/u 1st step char
253C 23 00607 INC HL ;Bump to second
253D CD6727 00608 CALL BYTOUT ;Display the first
2540 7E 00609 LD A,(HL) ;P/u the second
2541 CD6727 00610 CALL BYTOUT ;Display the second
2544 218C28 00611 LD HL,MS$ ;Display "ms,"
2547 CD5527 00612 CALL LINOUT
254A FDCB036E 00613 BIT 5,(IY+3) ;Bypass DELAY if 8"
254E 2020 00614 JR NZ,ENDLINE ;8" drives always running
2550 218F28 00615 LD HL,DLY$ ;Display "dly="
2553 CD5527 00616 CALL LINOUT
2556 FDCB0356 00617 BIT 2,(IY+3) ;Test off/on
255A 3E20 00618 LD A,' ' ;1 sec if DELAY=ON
255C 0631 00619 LD B,'1'
255E 2804 00620 JR Z,$+6
2560 3E2E 00621 LD A,'.' ;0.5 sec if DELAY=OFF
2562 0635 00622 LD B,'5'
2564 CD6727 00623 CALL BYTOUT
2567 78 00624 LD A,B
2568 CD6727 00625 CALL BYTOUT
256B 3E73 00626 LD A,'s' ;Indicate seconds
256D CD6727 00627 CALL BYTOUT
2570 CD8527 00628 ENDLINE CALL CKPAWS ;Check pause of display
2573 C1 00629 POPDRV POP BC ;Recover drive #
2574 0C 00630 INC C ;Bump to next drive
2575 79 00631 LD A,C
2576 FE08 00632 CP 8 ;Loop thru all 8
2578 C22724 00633 JP NZ,DEV1
257B 00634 DEND EQU $
00635 ;
00636 ; Byte I/O devices
00637 ;
257B 210000 00638 BPARM LD HL,$-$ ;Check B parameter
257E 7C 00639 LD A,H
257F B5 00640 OR L
2580 CAAF26 00641 JP Z,BEND ;Go if B=NO (default)
00642 ;
00643 ; Display the device vectoring
00644 ;
2583 114B49 00645 LD DE,'IK' ;Start of device tables
2586 00646 @@GTDCB
2586+3E52 00647 LD A,82
2588+EF 00648 RST 40
2589 C27A27 00649 JP NZ,IOERR
258C 7E 00650 LOGDCB LD A,(HL) ;Bypass this device if
258D B7 00651 OR A ; table shows spare
258E CA3D26 00652 JP Z,DVRB2
2591 11002A 00653 LD DE,STRBUF ;Pt to string buffer
2594 E5 00654 PUSH HL ;Save origin ptr
2595 CD9F26 00655 CALL MOVNAM ;Move dev name -> strbuf
2598 E1 00656 POP HL ;Rcvr org of table
2599 E5 00657 PUSH HL
259A CB5E 00658 LOGDCB1 BIT 3,(HL) ;If NIL, don't show
259C 201A 00659 JR NZ,DVRADDR ; any routes
259E CB66 00660 BIT 4,(HL) ;Is device routed?
25A0 2816 00661 JR Z,DVRADDR ;Bypass if not
00662 ;
00663 ; This device is routed
00664 ;
00665 IF @BLD631
25A2 CD9926 00666 LOGRTE CALL GETPTR ;<631>Pt to vector & get it
00667 ELSE
00668 LOGRTE INC L ;Pt to vector & get it
00669 LD A,(HL)
00670 INC L
00671 LD H,(HL)
00672 LD L,A
00673 ENDIF
25A5 CB7E 00674 BIT 7,(HL) ;Is the route to a file?
25A7 C24726 00675 JP NZ,RTEFCB ;Jump if a file
25AA E5 00676 PUSH HL ;Hang onto this vector
25AB CD7526 00677 CALL DCBDIR ;Get device direction
25AE CD9F26 00678 CALL MOVNAM ;Move dev name -> strbuf
25B1 E1 00679 POP HL ;Rcvr org of routee
25B2 CB66 00680 BIT 4,(HL) ;Is routee also routed?
25B4 20EC 00681 JR NZ,LOGRTE ;Loop de loop if yes
25B6 1878 00682 JR DVRB1 ; else go display the line
00683 ;
00684 ; Device has no routes - show its driver address
00685 ;
25B8 CD7526 00686 DVRADDR CALL DCBDIR ;Get device direction
25BB CB5E 00687 BIT 3,(HL) ;Is this a NIL device
25BD C26B26 00688 JP NZ,MOVNIL ;No address if NIL
00689 ;
00690 ; If linked, show device name of link
00691 ;
25C0 CB6E 00692 BIT 5,(HL) ;Any link DCB?
25C2 2822 00693 JR Z,DVRA0 ;Go if none
00694 IF @BLD631
25C4 CD9926 00695 CALL GETPTR ;<631>Get address of link DCB
00696 ELSE
00697 INC L ;Get address of link DCB
00698 LD A,(HL)
00699 INC L
00700 LD H,(HL)
00701 LD L,A
00702 ENDIF
00703 ;
00704 ; Now move in the name of the linked DCB
00705 ;
25C7 E5 00706 PUSH HL
25C8 E5 00707 PUSH HL
25C9 CD9F26 00708 CALL MOVNAM ;Move name of LINK DCB
25CC 3E7C 00709 LD A,'|' ;Get separator for display and
25CE 12 00710 LD (DE),A ; put in the buffer
25CF 13 00711 INC DE
25D0 FDE1 00712 POP IY ;Pop address to IY
25D2 FD6E04 00713 LD L,(IY+4) ;P/u linked DCB address
25D5 FD6605 00714 LD H,(IY+5)
25D8 CD9F26 00715 CALL MOVNAM ;Move name of linked DCB
25DB E1 00716 POP HL ;Recover address
25DC EB 00717 EX DE,HL ;Switch tempy, HL to
25DD 3620 00718 LD (HL),' ' ; display buffer
25DF 23 00719 INC HL
25E0 3626 00720 LD (HL),'&' ;Show the link
25E2 23 00721 INC HL
25E3 EB 00722 EX DE,HL ;Back to normal
25E4 18B4 00723 JR LOGDCB1 ;Go ck this one
00724 ;
00725 ; If filtered, find the filter DCB
00726 ;
25E6 CB76 00727 DVRA0 BIT 6,(HL) ;If filtered, recover the
25E8 2832 00728 JR Z,DVRB0 ; original data by
25EA E5 00729 PUSH HL ; swapping back the
25EB 3E5B 00730 LD A,'['
25ED 12 00731 LD (DE),A
25EE 13 00732 INC DE
25EF D5 00733 PUSH DE
25F0 54 00734 LD D,H
25F1 5D 00735 LD E,L
00736 IF @BLD631
25F2 CD9926 00737 CALL GETPTR ;<631>1st three bytes with the FILTER DCB
00738 ELSE
00739 INC L ; 1st three bytes with
00740 LD A,(HL) ; the FILTER DCB
00741 INC L
00742 LD H,(HL)
00743 LD L,A
00744 ENDIF
25F5 010400 00745 LD BC,4 ;HL now points to the
25F8 09 00746 ADD HL,BC ; entry point. Get its
25F9 4E 00747 LD C,(HL) ; DCB address by peeking
25FA 0C 00748 INC C ; past the name field
25FB 09 00749 ADD HL,BC
00750 IF @BLD631
25FC CD9A26 00751 CALL GETPTR2 ;<631>
00752 ELSE
00753 LD A,(HL) ;Get low-order
00754 INC HL
00755 LD H,(HL) ;Get hi-order
00756 LD L,A
00757 ENDIF
25FF E5 00758 PUSH HL ;If DCB is itself, then
2600 ED52 00759 SBC HL,DE ; bring in the "inactive
2602 E1 00760 POP HL
2603 D1 00761 POP DE ;Recover string buf ptr
2604 200A 00762 JR NZ,DVRA1
2606 21C827 00763 LD HL,INACT$
2609 010800 00764 LD BC,8
260C EDB0 00765 LDIR
260E 1803 00766 JR DVRA2
00767 ;
2610 CD9F26 00768 DVRA1 CALL MOVNAM ;Move name of filter DCB
2613 3E5D 00769 DVRA2 LD A,']' ;Put dsp chars into buffer
2615 12 00770 LD (DE),A
2616 13 00771 INC DE
2617 3E20 00772 LD A,' '
2619 12 00773 LD (DE),A
261A 13 00774 INC DE
261B E1 00775 POP HL ;Recover orig DCB ptr
00776 ;
00777 ; Routine to construct address "X'xxxx'"
00778 ;
261C 3E58 00779 DVRB0 LD A,'X' ;Show address as
261E 12 00780 LD (DE),A ; X'dddd'
261F 13 00781 INC DE
2620 3E27 00782 LD A,27H ;Single quote
2622 12 00783 LD (DE),A
2623 13 00784 INC DE
00785 IF @BLD631
2624 CD9926 00786 CALL GETPTR ;<631>P/U vector
00787 ELSE
00788 INC L
00789 LD A,(HL) ;P/u lo-order vector
00790 INC L
00791 LD H,(HL) ;P/u hi-order vector
00792 LD L,A ;Put lo in place
00793 ENDIF
2627 EB 00794 EX DE,HL ;Vector value to DE
2628 00795 @@HEX16 ;Convert to hex digits
2628+3E63 00796 LD A,99
262A+EF 00797 RST 40
262B EB 00798 EX DE,HL ;Restore strbuf ptr to DE
262C 3E27 00799 LD A,27H ;Closing '
262E 12 00800 LD (DE),A
262F 13 00801 INC DE
2630 3E0D 00802 DVRB1 LD A,CR
2632 12 00803 LD (DE),A ;Stuff end-of-line
2633 21002A 00804 LD HL,STRBUF ;Display the info
2636 CD5527 00805 CALL LINOUT
2639 CD8A27 00806 CALL CKPAWS0 ;Ck with no CR
263C E1 00807 POP HL ;Rcvr table org
263D 7D 00808 DVRB2 LD A,L ;Advance to next table
263E C608 00809 TABLEN ADD A,8
2640 6F 00810 LD L,A
2641 DAAF26 00811 JP C,SPARM ;Exit if finished
2644 C38C25 00812 JP LOGDCB ; else loop
00813 ;
00814 ; Device routed to a file - grab its filespec
00815 ;
2647 E5 00816 RTEFCB PUSH HL ;Save control block org
2648 219928 00817 LD HL,IO$ ;Show 2-way device
264B 010500 00818 LD BC,5
264E EDB0 00819 LDIR
2650 E1 00820 POP HL
2651 7D 00821 LD A,L ;Pt to file route data
2652 C606 00822 ADD A,6 ; by indexing into FCB
2654 6F 00823 LD L,A
2655 8C 00824 ADC A,H
2656 95 00825 SUB L
2657 67 00826 LD H,A ;HL = FCB+6
2658 4E 00827 LD C,(HL) ;P/u drive #
2659 23 00828 INC HL
265A 46 00829 LD B,(HL) ;P/u DEC
265B D5 00830 PUSH DE
265C 00831 @@FNAME ;Fetch filename
265C+3E50 00832 LD A,80
265E+EF 00833 RST 40
265F D1 00834 POP DE
2660 C27A27 00835 JP NZ,IOERR
2663 1A 00836 RTEF1 LD A,(DE) ;Find end of filename
2664 FE03 00837 CP 3
2666 28C8 00838 JR Z,DVRB1 ;Exit on ETX to put CR
2668 13 00839 INC DE
2669 18F8 00840 JR RTEF1
00841 ;
00842 ; Move in 'NIL' as driver address
00843 ;
266B 219628 00844 MOVNIL LD HL,NIL$ ;Move in NIL
266E 010300 00845 LD BC,3
2671 EDB0 00846 LDIR
2673 18BB 00847 JR DVRB1
00848 ;
00849 ; Routine to denote i/o direction
00850 ;
00851 IF @BLD631
2675 CD9426 00852 DCBDIR CALL ADDSPA ;<631>1st need a space
00853 ELSE
00854 DCBDIR LD A,' ' ;1st need a space
00855 LD (DE),A
00856 INC DE
00857 ENDIF
2678 CB46 00858 BIT 0,(HL) ;Test if input device
267A 2802 00859 JR Z,DCBD1 ;Put another space if not
267C 3E3C 00860 LD A,'<' ;Else show input capable
267E 12 00861 DCBD1 LD (DE),A
267F 13 00862 INC DE
2680 3E3D 00863 LD A,'=' ;Always need this
2682 CB76 00864 BIT 6,(HL) ;If a filter, then
2684 2802 00865 JR Z,$+4 ; reset to '#'
2686 3E23 00866 LD A,'#'
2688 12 00867 LD (DE),A
2689 13 00868 INC DE
268A 3E20 00869 LD A,' ' ;Init a space
268C CB4E 00870 BIT 1,(HL) ;Output device?
268E 2802 00871 JR Z,DCBD2 ;Use space if not
2690 3E3E 00872 LD A,'>' ;Else show output capable
2692 12 00873 DCBD2 LD (DE),A
2693 13 00874 INC DE
00875 IF @BLD631
00876 ADDSPA ;<631>
00877 ENDIF
2694 3E20 00878 LD A,' ' ;Close with a space
2696 12 00879 LD (DE),A
2697 13 00880 INC DE
2698 C9 00881 RET
00882 IF @BLD631
2699 2C 00883 GETPTR INC L ;<631>
269A 7E 00884 GETPTR2 LD A,(HL) ;<631>
269B 2C 00885 INC L ;<631>
269C 66 00886 LD H,(HL) ;<631>
269D 6F 00887 LD L,A ;<631>
269E C9 00888 RET ;<631>
00889 ELSE
00890 ;
00891 ; Convert HL to 3-place decimal & stuff into (DE)
00892 ;
00893 CVRTDEC PUSH DE ;Save place
00894 LD DE,BUFFER
00895 @@HEXDEC ;Convert to decimal ASCII
00896 LD HL,BUFFER+2 ;Skip leading spaces
00897 POP DE
00898 LD BC,3
00899 LDIR
00900 RET
00901 ENDIF
00902 ;
00903 ; Move device name into string buffer
00904 ;
269F 7D 00905 MOVNAM LD A,L ;Pt to name field
26A0 C606 00906 ADD A,6
26A2 6F 00907 LD L,A
26A3 3E2A 00908 LD A,'*' ;Stuff * in string buf
26A5 12 00909 LD (DE),A
26A6 13 00910 INC DE ;Bump ptr to next pos
26A7 EDA0 00911 LDI ;Move the first char
26A9 7E 00912 LD A,(HL) ;P/U next char
26AA B7 00913 OR A ; Check for 0
26AB C8 00914 RET Z ; return on NULL
26AC 12 00915 LD (DE),A
26AD 13 00916 INC DE
26AE C9 00917 RET
26AF 00918 BEND EQU $
00919 ;
00920 ; Show high memory device drivers
00921 ;
26AF 21FFFF 00922 SPARM LD HL,-1 ;Check S parameter
26B2 7C 00923 LD A,H
26B3 B5 00924 OR L
26B4 CAB827 00925 JP Z,EXIT ;Exit if through
26B7 21D027 00926 LD HL,DVCHDR$ ;Display header
26BA CD5527 00927 CALL LINOUT
26BD 00928 @@FLAGS ;Get flag table pointer
26BD+3E65 00929 LD A,101
26BF+EF 00930 RST 40
26C0 FD7E03 00931 LD A,(IY+'D'-'A') ;P/u device flag
26C3 B7 00932 OR A ;Exit if none in use
26C4 F5 00933 PUSH AF ;Save flag
26C5 282B 00934 JR Z,SHOWFS ;Go if nothing on
26C7 21DA27 00935 LD HL,DVCS$ ;Pt to word string
26CA 01FF08 00936 LD BC,8<8!0FFH ;Init for 8 flag bits
26CD F1 00937 DOD1 POP AF ;Rcvr link
26CE 0F 00938 RRCA ;Test if active
26CF F5 00939 PUSH AF
26D0 3019 00940 JR NC,DOD3 ;Bypass if inactive
26D2 0C 00941 INC C ;Do we do the comma?
26D3 3E2C 00942 LD A,',' ;End of word, do comma
26D5 C46727 00943 CALL NZ,BYTOUT
00944 IF @BLD631
26D8 CD6527 00945 CALL OUTSP ;<631>Start with a space
00946 ELSE
00947 LD A,' ' ;Start with a space
00948 CALL BYTOUT
00949 ENDIF
26DB 7E 00950 DOD2 LD A,(HL) ;Display word until carry
26DC 23 00951 INC HL
26DD F5 00952 PUSH AF
26DE E67F 00953 AND 7FH ;Strip possible carry
26E0 CD6727 00954 CALL BYTOUT ;Display the char
26E3 F1 00955 POP AF
26E4 07 00956 RLCA ;Was carry set
26E5 30F4 00957 JR NC,DOD2 ;Loop if not
26E7 10E4 00958 DJNZ DOD1 ;Loop for 8 bits
26E9 1807 00959 JR SHOWFS ;Exit the loop
26EB 7E 00960 DOD3 LD A,(HL) ;Loop & ignore word
26EC 23 00961 INC HL
26ED 07 00962 RLCA ;Carry set on last char
26EE 30FB 00963 JR NC,DOD3
26F0 10DB 00964 DJNZ DOD1 ;Loop for 8 bits
26F2 FDCB125E 00965 SHOWFS BIT 3,(IY+'S'-'A') ;Show FAST or SLOW
26F6 2005 00966 JR NZ,FAST
26F8 210E28 00967 LD HL,SLOW$ ;Point to slow$
26FB 1803 00968 JR SHOWIT
26FD 210728 00969 FAST LD HL,FAST$ ;Point to fast$
2700 FD7E03 00970 SHOWIT LD A,(IY+'D'-'A') ;Check if others shown
2703 B7 00971 OR A
2704 2001 00972 JR NZ,COMAOK
2706 23 00973 INC HL ;Bypass comma
2707 CD5527 00974 COMAOK CALL LINOUT
00975 ;
00976 ; Display system modules resident
00977 ;
270A F1 00978 DORES POP AF ;Stack integrity
270B CD8527 00979 NOTON CALL CKPAWS
270E 111528 00980 LD DE,RES$ ;Check if driver resident
2711 00981 @@GTMOD ; in memory
2711+3E53 00982 LD A,83
2713+EF 00983 RST 40
2714 C2B827 00984 JP NZ,EXIT ;Done if nothing res'd
2717 210500 00985 LD HL,5
271A 19 00986 ADD HL,DE ;Point to hi-order table
271B E5 00987 PUSH HL
271C 211C28 00988 LD HL,SYSRES$ ;Display header
271F CD5527 00989 CALL LINOUT
2722 E1 00990 POP HL
2723 01FF10 00991 LD BC,16<8!0FFH ;Init for 16 modules
2726 7E 00992 DORES1 LD A,(HL) ;P/u a high-order vector
2727 23 00993 INC HL ;Bump pointer to next
2728 23 00994 INC HL
2729 B7 00995 OR A ;Is this module resident?
272A 2822 00996 JR Z,DORES3 ;Go if not
272C 0C 00997 INC C
272D 3E2C 00998 LD A,',' ;Need comma if 2nd
272F C46727 00999 CALL NZ,BYTOUT
01000 IF @BLD631
2732 CD6527 01001 CALL OUTSP ;<631>Start with a space
01002 ELSE
01003 LD A,' ' ;Start with a space
01004 CALL BYTOUT
01005 ENDIF
2735 3E10 01006 LD A,16
2737 90 01007 SUB B ;Calculate module #
2738 16FF 01008 LD D,-1
273A 14 01009 DORES2 INC D
273B D60A 01010 SUB 10
273D 30FB 01011 JR NC,DORES2
273F F5 01012 PUSH AF ;Save units place
2740 7A 01013 LD A,D ;Test tens place
2741 C630 01014 ADD A,'0' ; for non-zero
2743 FE30 01015 CP '0'
2745 C46727 01016 CALL NZ,BYTOUT ;Output if non-zero
2748 F1 01017 POP AF ;Get units
2749 C63A 01018 ADD A,'0'+10 ;Adjust to ASCII
274B CD6727 01019 CALL BYTOUT
274E 10D6 01020 DORES3 DJNZ DORES1
2750 CD8527 01021 CALL CKPAWS ;One last ck for CR
2753 1863 01022 JR EXIT
01023 ;
01024 ; Output display routines
01025 ;
2755 01026 LINOUT @@DSPLY
01027 IFEQ 00H,1
01028 LD HL,
01029 ENDIF
2755+3E0A 01030 LD A,10
2757+EF 01031 RST 40
2758 2020 01032 JR NZ,IOERR
275A 3A6F27 01033 LD A,(PPARM+1) ;Ck P-parm
275D B7 01034 OR A
275E C8 01035 RET Z
275F 01036 @@PRINT ;Also print if needed
01037 IFEQ 00H,1
01038 LD HL,
01039 ENDIF
275F+3E0E 01040 LD A,14
2761+EF 01041 RST 40
2762 2016 01042 JR NZ,IOERR
2764 C9 01043 RET
01044 ;
01045 IF @BLD631
2765 3E20 01046 OUTSP LD A,' ' ;<631>
01047 ENDIF
2767 C5 01048 BYTOUT PUSH BC
2768 4F 01049 LD C,A
2769 01050 @@DSP ;Display it
2769+3E02 01051 LD A,2
276B+EF 01052 RST 40
276C 200A 01053 JR NZ,POPBC
276E 110000 01054 PPARM LD DE,0 ;P/u P-parm
2771 7B 01055 LD A,E
2772 B2 01056 OR D
2773 2803 01057 JR Z,POPBC
2775 01058 @@PRT ;Print chr if needed
2775+3E06 01059 LD A,6
2777+EF 01060 RST 40
2778 C1 01061 POPBC POP BC
2779 C8 01062 RET Z
277A 6F 01063 IOERR LD L,A ;Save error code
277B 2600 01064 LD H,0
277D F6C0 01065 OR 0C0H ;Abbrev & return
277F 4F 01066 LD C,A
2780 01067 @@ERROR
2780+3E1A 01068 LD A,26
2782+EF 01069 RST 40
2783 182C 01070 JR SAVESP
01071 ;
01072 ; Routine to ck on pause or break
01073 ;
2785 3E0D 01074 CKPAWS LD A,CR ;End line first
2787 CD6727 01075 CALL BYTOUT
278A 01076 CKPAWS0 @@FLAGS ;Get flag table pointer
278A+3E65 01077 LD A,101
278C+EF 01078 RST 40
278D FD7E0A 01079 LD A,(IY+'K'-'A') ;P/u KFLAG
2790 CB47 01080 BIT 0,A ;Check for break
2792 2017 01081 JR NZ,BREAK ; if so exit
2794 CB4F 01082 BIT 1,A ;Check for pause
2796 C8 01083 RET Z ;Ret if not
2797 01084 CKPAW1 @@KEY ;Wait for key input
2797+3E01 01085 LD A,1
2799+EF 01086 RST 40
279A FE60 01087 CP 60H
279C 28F9 01088 JR Z,CKPAW1 ;Loop on pause
279E FE80 01089 CP 80H ;Abort on BREAK
27A0 2809 01090 JR Z,BREAK
27A2 FD7E0A 01091 RESKFL LD A,(IY+'K'-'A') ;Reset Pause & Enter bits
27A5 E6F9 01092 AND 0F9H ;
27A7 FD770A 01093 LD (IY+'K'-'A'),A
27AA C9 01094 RET
01095 ;
01096 ; BREAK handler routine
01097 ;
27AB CDA227 01098 BREAK CALL RESKFL
27AE 21FFFF 01099 LD HL,-1
27B1 310000 01100 SAVESP LD SP,$-$ ;Restore the stack
27B4 01101 @@CKBRKC ;Clear any
27B4+3E6A 01102 LD A,106
27B6+EF 01103 RST 40
27B7 C9 01104 RET ; and RETurn
27B8 210000 01105 EXIT LD HL,0 ;Init to no error
27BB 18F4 01106 JR SAVESP ;P/u stack & return
01107 ;
01108 ; String area
01109 ;
27BD 4E 01110 NOPACK$ DB 'No Disk] ',3
6F 20 20 44 69 73 6B 5D
20 03
27C8 49 01111 INACT$ DB 'Inactive'
6E 61 63 74 69 76 65
27D0 0A 01112 DVCHDR$ DB LF,'Options:',3
4F 70 74 69 6F 6E 73 3A
03
27DA 53 01113 DVCS$ DB 'Spoole','r'!80H,'Typ','e'!80H
70 6F 6F 6C 65 F2 54 79
70 E5
27E5 56 01114 DB 'Verif','y'!80H,'Smoot','h'!80H
65 72 69 66 F9 53 6D 6F
6F 74 E8
27F1 4D 01115 DB 'Memdis','k'!80H,'Form','s'!80H
65 6D 64 69 73 EB 46 6F
72 6D F3
27FD 4B 01116 DB 'KS','M'!80H,'Graphi','c'!80H
53 CD 47 72 61 70 68 69
E3
2807 2C 01117 FAST$ DB ', Fast',3
20 46 61 73 74 03
280E 2C 01118 SLOW$ DB ', Slow',3
20 53 6C 6F 77 03
2815 53 01119 RES$ DB 'SYSRES',3
59 53 52 45 53 03
281C 53 01120 SYSRES$ DB 'System modules resident:',3
79 73 74 65 6D 20 6D 6F
64 75 6C 65 73 20 72 65
73 69 64 65 6E 74 3A 03
2835 20 01121 STPRAT$ DB ' 6122030 3 61015'
36 31 32 32 30 33 30 20
33 20 36 31 30 31 35
2845 22 01122 FLOPY$ DB '" Floppy #',3
20 46 6C 6F 70 70 79 20
23 03
2850 22 01123 RIGID$ DB '" Rigid #',3
20 52 69 67 69 64 20 20
23 03
285B 2C 01124 CYLS$ DB ', Cyls='
20 43 79 6C 73 3D
2862 20 01125 COMMA$ DB ' , ',3
20 20 2C 20 03
2868 52 01126 REMOV$ DB 'Removable',3
65 6D 6F 76 61 62 6C 65
03
2872 46 01127 FIXED$ DB 'Fixed',3
69 78 65 64 03
2878 64 01128 DEN$ DB 'den, Sides=',3
65 6E 2C 20 53 69 64 65
73 3D 03
2884 2C 01129 STEP$ DB ', Step=',3
20 53 74 65 70 3D 03
288C 6D 01130 MS$ DB 'ms',3
73 03
288F 2C 01131 DLY$ DB ', Dly=',3
20 44 6C 79 3D 03
2896 4E 01132 NIL$ DB 'Nil'
69 6C
2899 20 01133 IO$ DB ' <=> '
3C 3D 3E 20
289E 01134 PRMTBL$ EQU $
0080 01135 VAL EQU 80H
0040 01136 SW EQU 40H
0020 01137 STR EQU 20H
0010 01138 SGL EQU 10H
289E 80 01139 DB 80H
289F 56 01140 DB SW!SGL!6,'BYTEIO',0
42 59 54 45 49 4F 00
28A7 7C25 01141 DW BPARM+1
28A9 56 01142 DB SW!SGL!6,'DRIVES',0
44 52 49 56 45 53 00
28B1 1E24 01143 DW DPARM+1
28B3 55 01144 DB SW!SGL!5,'PRINT',0
50 52 49 4E 54 00
28BA 6F27 01145 DW PPARM+1
28BC 56 01146 DB SW!SGL!6,'STATUS',0
53 54 41 54 55 53 00
28C4 B026 01147 DW SPARM+1
28C6 56 01148 DB SW!SGL!6,'OPTION',0
4F 50 54 49 4F 4E 00
28CE B026 01149 DW SPARM+1
28D0 00 01150 NOP
01151 ;
2900 01152 ORG $<-8+1<8
2900 01153 BUFFER DS 256
2A00 01154 STRBUF EQU $
01155 ;
2400 01156 END DEVICE
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]