1000     .TITLE "DDIR2.M65"
1010 ;
1020 ; --------------------------------
1030 ;
1040 ; Assemble as DDIR.COM  --  if
1050 ; you have the 'original' DDIR
1060 ; program, unprotect the .COM
1070 ; file and when this is assembled
1080 ; it will wipe out the original
1090 ; version
1100 ;
1110 ; --------------------------------
1120 ;
1130 ; WARNING!!!
1140 ;    For some reason that I can't
1150 ;  fathom, this program will only
1160 ;  run properly when used with
1170 ;  DOS/XL versions 2.2 and 2.3.
1180 ;    If it is run under any of the
1190 ;  earlier OSS DOSes, it hangs up.
1200 ;    Is it possible that I am
1210 ;  running into a bug that has
1220 ;  been fixed in the latest
1230 ;  versions of DOS/XL?  Of course,
1240 ;  its more likely that I'm the
1250 ;  culprit.  If you find that I
1260 ;  am the guilty party, let me
1270 ;  what the error is.
1280 ;
1290 ; --------------------------------
1300 ;
1310 ; USAGE:
1320 ;   - [Dx:] DDIR Dn:filename.ext
1330 ;       uses filename.ext as a
1340 ;       search specification for
1350 ;       files on Dn:
1360 ;   - [Dx:] DDIR filename.ext
1370 ;       works same as above
1380 ;   - [Dx:] DDIR
1390 ;       shows all files on Dx:,
1400 ;       the default drive
1410 ;
1420 ; Note - the [Dx:] is meant to
1430 ;        stand for the prompt
1440 ;        that OS/A+ or DOS/XL
1450 ;        is displaying.  The
1460 ;        'x' would be the number
1470 ;        of the default drive,
1480 ;        which ranges from 1 to 4
1490 ;
1500 ; --------------------------------
1510 ;
1520 ; the needed equates
1530 ;
1540 COPN =  $03
1550 CGTXTR = $05
1560 OPDIR = $06
1570 CPBINR = $0B
1580 CCLOSE = $0C
1590 ROWCRS = $54
1600 COLCRS = $55
1610 EOL =   $9B
1620 CPGNFN = $03
1630 CPDFDV = $07
1640 CPALOC = $0A
1650 CPBUFP = $0A
1660 CPFNAM = $21
1670 GOADR = $02E0
1680 ICCOM = $0342
1690 ICBADR = $0344
1700 ICBLEN = $0348
1710 ICAUX1 = $034A
1720 ICAUX2 = $034B
1730 CIOV =  $E456
1740 ;
1750     *=  $4000
1760 ;
1770 ; miscellaneous storage, etc.
1780 ;
1790 TEMP
1800     .BYTE $15
1810 BUFPTR
1820     .BYTE 0
1830 DEFAULT
1840     .BYTE "D1:*.*",EOL
1850 BUFFER
1860     *=  *+$12   ; I/O buffer
1870 FNAME
1880     *=  *+$10   ; filename buffer
1890 ;
1900 ; start the code.....
1910 ;
1920 FETCHNAME
1930     JMP $E477   ;dummy address
1940     RTS 
1950 PARSE ;         ...we begin here
1960     LDY #CPBUFP
1970     LDA (CPALOC),Y
1980     STA BUFPTR  ;save pointer
1990     CLC 
2000     LDA CPALOC
2010     ADC #CPGNFN
2020     STA FETCHNAME+1
2030     LDA CPALOC+1
2040     ADC #$00
2050     STA FETCHNAME+2
2060     JSR FETCHNAME
2070     LDY #CPBUFP
2080     LDA (CPALOC),Y
2090     CMP BUFPTR  ;did pointer move?
2100     BEQ NONAME  ;no, use default
2110 MOVENAME
2120     LDX #$00
2130     LDY #CPFNAM
2140 LOOP
2150     LDA (CPALOC),Y
2160     STA FNAME,X
2170     CMP #EOL
2180     BEQ GOTNAME
2190     INY 
2200     INX 
2210     CPX #$10
2220     BNE LOOP
2230     BEQ GOTNAME
2240 NONAME
2250     LDY #CPDFDV+1 ;default drive #
2260     LDA (CPALOC),Y
2270     STA DEFAULT+1
2280     LDA # <DEFAULT ;brute force!
2290     STA REALNAME+1
2300     LDA # >DEFAULT
2310     STA REALNAME+6
2320 GOTNAME
2330     LDX #$10    ;open 1,6,0,fname
2340     LDA #COPN
2350     STA ICCOM,X
2360     LDA #OPDIR
2370     STA ICAUX1,X
2380     LDA #$00
2390     STA ICAUX2,X
2400 REALNAME
2410     LDA # <FNAME
2420     STA ICBADR,X
2430     LDA # >FNAME
2440     STA ICBADR+1,X
2450     JSR CIOV
2460     TYA 
2470     BMI ERROR
2480 ENTRY
2490     LDX #$10    ;input 1,buffer,18
2500     LDA #CGTXTR
2510     STA ICCOM,X
2520     LDA # <BUFFER
2530     STA ICBADR,X
2540     LDA # >BUFFER
2550     STA ICBADR+1,X
2560     LDA #$12
2570     STA ICBLEN,X
2580     LDA #$00
2590     STA ICBLEN+1,X
2600     JSR CIOV
2610     TYA 
2620     BMI ERROR
2630     LDA TEMP
2640     EOR #$14    ;nice trick!
2650     STA COLCRS
2660     STA TEMP
2670     CMP #$01
2680     BEQ SKIP
2690     DEC ROWCRS
2700 SKIP
2710     LDX #$00    ;bput 0,buffer,18
2720     LDA #CPBINR
2730     STA ICCOM,X
2740     LDA # <BUFFER
2750     STA ICBADR,X
2760     LDA # >BUFFER
2770     STA ICBADR+1,X
2780     LDA #$12
2790     STA ICBLEN,X
2800     LDA #$00
2810     STA ICBLEN+1,X
2820     JSR CIOV
2830     TYA 
2840     BPL ENTRY
2850 ERROR
2860     LDX #$10    ;close 1
2870     LDA #CCLOSE
2880     STA ICCOM,X
2890     JSR CIOV
2900     DEC ROWCRS  ; do it twice...
2910     DEC ROWCRS  ; ...saves a line
2920     RTS 
2930 ;
2940     *=  GOADR
2950     .WORD PARSE ; start at PARSE
2960 ;
2970     .END 
