;@com.wudsn.ide.asm.hardware=APPLE2 !cpu 6502 !to "BITSYBYE#061000",plain !convtab "a2txt.bin" *= $1000 ;-------------------------------- ; BITSY BYE 2.4.2 (18-JAN-2018) ; by John Brooks / Peter Ferrie ; (source) by Deckard 20181230 ; ACME 6502 assembler ;-------------------------------- ; New ProDOS 8 releases : https://prodos8.com ; Qkumba compression & code optimization master : http://pferrie.000webhostapp.com/ ; Deckard : http://boutillon.free.fr ; A major new feature in the 2.4 release was replacing the OS ram-resident program launcher with a new version ; called Bitsy Bye. ; Bitsy Bye is an interactive, menu-based system for choosing which program to run next after the previous ; program exits with the quit or bye command. ; -JB ; Our tag-team optimization of Bitsy Bye in 2016 was epic. ; -JB ; Unique goal: 6502 memory exercise ; -Dckd ; Apple II memory info ; $0000..$00FF : zero page ; $0100..$01FF : stack ; $0200..$02FF : character input buffer ; $0300..$03CF : free space ; $0400..$07CF : txt screen (+variables in holes) ; ; $0B00..$0EFF : open buffer ; $1000..$12FA : Bitsy Bye 2.4.2 (code) ; $12FB..$13FF : Bitsy Bye 2.4.2 (datas) ; $1400..$BECF : structure infos (internal files list: up to 2733 files) 2733*16=$AAD0 ;-------------------------------- CV = $25 ; cursor vertical position BASL = $28 ; low txt screen addr (left) BASH = $29 ; high txt screen addr (left) CUR_SLOT_DRV = $56 ; current slot/!drive fmt=0000SSS? (?=!D) VOLNAME_LENGTH = $57 ; volume name length+1 (including 1st "/") PTR_1ST_NAME_ON_SCREEN = $58 ; +$59 pointer for 1st name of screen ($1400..) PTR_WORK_NAME = $5A ; +$5B pointer used to work with names structure PTR_CURRENT_NAME = $5C ; +$5D pointer for current name (reverse cursor) SCREEN_POSITION = $5E ; position on screen : $00 (top)..$0A (middle)..$13 (bottom) DISPLAY_MODE = $5F ; for AND : #%00111111 ($3F) = INVERSE / #%11111111 ($FF) = NORMAL NAME_LENGTH = $60 ; length of name $00 (no name) or $01..$0F FIRST_CHARACTER = $60 ; pressed key (research by name) TBL_ONLINE = $6E ; table for MLI ONLINE TBL_OPEN = $72 ; table for MLI OPEN TBL_READ = $78 ; table for MLI READ PATHNAME_LENGTH = $0280 ; partial path of current volume or directory PATHNAME = $0281 ; partial path of current volume or directory SYS_LAUNCHER_LENGTH = $0380 ; full (root) path to the launcher (BASIS.SYSTEM or BASIC.SYSTEM) SYS_LAUNCHER = $0381 ; full (root) path to the launcher (BASIS.SYSTEM or BASIC.SYSTEM) TXT_LINE0 = $0400 ; TXT screen: line 0 TXT_LINE1 = $0480 ; TXT screen: line 1 H1400 = $1400 ; internal structure infos SYSTEM_ADDR = $2000 ; implantation addr of SYS file ; ProDOS MLI = $BF00 ; machine language interface https://prodos8.com/docs/techref/calls-to-the-mli/ DEVNUM = $BF30 ; last used device DSSS0000 BITMAP = $BF58 ; memory bit map (ProDOS) ; ROM CLR80STORE = $C000 ; 80STORE off INIT = $FB2F ; screen initialization BASCALC = $FBC1 ; calc base addr in BASL/BASH BELL = $FBDD ; DING! an error occurs... VTAB = $FC22 ; perform vertical tab HOME = $FC58 ; clear TXT screen RDKEY = $FD0C ; read key SETKBD = $FE89 ; IN#0 SETVID = $FE93 ; PR#0 ; ProDOS MLI cmds QUIT = $65 ; exit from 1 interpreter, dispatch another GET_FILE_INFO = $C4 ; return file's attributes ONLINE = $C5 ; return names of one or all online volumes SET_PREFIX = $C6 ; change default pathname prefix OPEN = $C8 ; open a file READ = $CA ; read 1 or more bytes from an open file CLOSE = $CC ; close open file(s), flushing buffers GET_EOF = $D1 ; return end of file position of an open file ;-------------------------------- CLD ; bin mode (ADC/SBC) ; valid routine LDA $C082 ; enables rom CLI ; interrupts are allowed STA $C00C ; 40 col STA CLR80STORE JSR SETVID JSR SETKBD ; acc=$FD (high COUT1 $FDF0) %11111101 STA $04FB ; screen hole (scratchpad ram : slot 3) ; VMODE for RDKEY/KEYIN (escape sequence & escape enable bit) ; see "Inside the //c" Gary B. Little p.56/148/150 JSR INIT JSR HOME ; Init ProDOS memory bitmap & copy datas in zero page LDX #$DF ; X=$DF..$FF LDA #%11001111 ; $CF => used mem pages: $00/$01/$04..$07 ; (zero page/stack/txt screen) H101E STA BITMAP-$DF,X ; $BF58=$CF LDA H134F-$DF,X ; copy $134F..$136F STA $7A,X ; into $7A+[$DF..$FF]= [$59..$79] (zero page addressing mode) LDA #0 ; $BF59..$BF78=0 (unused mem pages +open file buffers) TXS ; last loop: S=$FF INX BNE H101E ; Apple ProDOS 8 Technical Reference Manual : Using the Stack ; System programs should set the stack pointer to $FF at the warm-start entry point. ; ; I set the stack to $FF before launching SYS files from Bitsy Bye (the new Quit dispatcher in P8 2.4) ; -JB !8 $C2,2 ; 6502/65c02: SKB #2 (skip next bytes / unofficial opcode) ; DOP=double NOP ; 65816: REP#%00000010 => Z=0 ; acc=0/X=0 BEQ H1034 ; always (6502/65c02) Z=1 ; //gs only--start INX ; X=1 STX $C029 ; //gs new video register=1 ; //gs direct access to mega II aux bank ; //gs only--stop H1034 INC BITMAP+$17 ; $BF6F=1: $BF mem page is used ;-------------------------------- ; Build initial TXT screen with ; authors and instructions ;-------------------------------- LDX #$57 ; counter X=$57..$01 step-1 H1039 LDA H1300-1,X ; $1300..$1356 BMI H1045 ; got a printable character ; got a special byte ; for coord update (requires 2 loop exec) ; for each coord update, the bascalc code is executed 2 times. ; - 1st is bad (X instead of Y coord + following byte) => ignored ; - 2nd is correct (Y coord and X coord) and BASCALC is correct ; comments below are for 2nd exec ; acc=txt screen line (Y coord) JSR BASCALC ; set BASL/BASH pointer LDY H1300,X ; get X coord (next byte) !8 $2C ; BIT trick: don't write Y coord byte on screen! H1045 STA (BASL),Y ; display printable character DEY ; X coord -1 DEX ; previous data byte BNE H1039 ; continue ; X coord=41-1=40 (ready to write "-" line) ; acc="-" ; write dashed lines #1 & #22 H104B STA TXT_LINE1,Y ; write "-" on line 1 STA (BASL),Y ; write "-" on line 22 DEY ; until X coord<0 (exit) BPL H104B ; continue ;-------------------------------- ; Get content of current S/Drive ;-------------------------------- ; ProDOS unit numbers are bytes where the bits are arranged in the pattern DSSS0000, ; where D = 0 for drive one and D = 1 for drive two, SSS is a three-bit integer with values ; from one through seven indicating the device slot number (zero is not a valid slot number), ; and the low nibble is ignored. ; ; It isn't practical. ; A better format is 0000SSS? where ? = !D (NOT drive #) ; 0000SSS0 means !D=0 => D=1 drive 2 ; 0000SSS1 means !D=1 => D=0 drive 1 ; ; To search the next unit number, you just have to: ; ; LDX current 0000SSS? ; DEX ; TXA ; AND #%00001111 (if current 0000SSS? was 0, X=$FF after DEX and now acc contains S=7, !D=1 => D=0 drive 1) ; STA new current 0000SSS? ; test if volume is OK for this unit number ; if volume OK, get content... ; ; You can navigate over ProDOS volumes using TAB key. ; e.g. current volume = /PRODOS.2.4.2 in slot 6, drive 1 (X=current 0000SSS? = 00001101) ; TAB => after DEX : 00001100 slot 6, !D=0 => D=1 drive 2 ; TAB => after DEX : 00001011 slot 5, !D=1 => D=0 drive 1 ; TAB => after DEX : 00001010 slot 5, !D=0 => D=1 drive 2 ; TAB => after DEX : 00001001 slot 4, !D=1 => D=0 drive 1 ; TAB => after DEX : 00001000 slot 4, !D=0 => D=1 drive 2 ; TAB => after DEX : 00000111 slot 3, !D=1 => D=0 drive 1 ; TAB => after DEX : 00000110 slot 3, !D=0 => D=1 drive 2 ; TAB => after DEX : 00000101 slot 2, !D=1 => D=0 drive 1 ; TAB => after DEX : 00000100 slot 2, !D=0 => D=1 drive 2 ; TAB => after DEX : 00000011 slot 1, !D=1 => D=0 drive 1 ; TAB => after DEX : 00000010 slot 1, !D=0 => D=1 drive 2 ; TAB => after DEX : 00000001 slot 0, !D=1 => D=0 drive 1 not a valide ProDOS unit # ; TAB => after DEX : 00000000 slot 0, !D=0 => D=1 drive 2 not a valide ProDOS unit # ; TAB => after DEX+TXA+AND : 00001111 slot 7, !D=1 => D=0 drive 1 ; TAB => after DEX : 00001110 slot 7, !D=0 => D=1 drive 2 ; get name of last used volume LDA DEVNUM ; DSSS0000 LSR ; 0DSSS000 LSR ; 00DSSS00 LSR ; 000DSSS0 TAX ; init !D ; easy way to get !D (NOT drive #) INX ; X=000DSSS1 (!D=1 => D=0 drive 1) ; the original "D" in "DSSS" will not be used anymore after this CMP ; Bitsy Bye always uses 0000SSS? (?=!D) CMP #%00010000 ; acc 000DSSS0 < 00010000 : test if D=0 (drive 1)? BCC H1060 ; yes, drive 1 ; X=000DSSS? (1st entry) D is ignored ; X=0000SSS? H105F DEX ; X-1 ; = switch from drive 1 (!D=1) to drive 2 (!D=0) ; or exec slot-1, drive 1 (!D=1) ; if drive 1: X=0000SSS1 ; if drive 2: X=0000SSS0 H1060 JSR GET_VOLUME_NAME ; get volume name (PATHNAME) BEQ H105F ; Z=1 (length=0). try another slot/drive H1065 LDA #>H1400 STA TBL_READ+3 ; read buffer (high) STA PTR_1ST_NAME_ON_SCREEN+1 ; 1st name addr = $1400 (high) LDY #=34. write only the end of the volname ; enough room to write the full name LDY #34 ; force trailing spaces (if shorter name) H108D DEY LDA #" " ; character = trailing space CPY VOLNAME_LENGTH ; need to write it? BCS H1098 ; yes ; write name LDA (TBL_ONLINE+2),Y ; get character ORA #%10000000 ; normal mode H1098 STA TXT_LINE0+5,X ; write it on screen STA SYS_LAUNCHER,Y ; build full SYS pathname DEX ; size-1 H109F BNE H108D ; not finished LDX #2 STX CV ; y position of the 1st name ; equivalent to ; LDA PTR_1ST_NAME_ON_SCREEN ; STA PTR_WORK_NAME ; LDA PTR_1ST_NAME_ON_SCREEN+1 ; STA PTR_WORK_NAME+1 ; LDX #0 ; optimization result = 3 bytes H10A5 LDA PTR_1ST_NAME_ON_SCREEN-1,X ; init working ptr STA PTR_WORK_NAME-1,X DEX BNE H10A5 ; optimized routine for: ; - writing a vertical line of "!" on the middle of the screen ; - displaying file's type (if managed, including subdir) and file's name for all files of the page ; - displaying the cursor (video INVERSE) for the current selected name ; - adding BASIS.SYSTEM after the full SYS path ; - getting addr of the current selected name ; X=0 H10AC JSR VTAB INC CV ; for next JSR VTAB LDY #20 ; middle of txt screen LDA #"!" STA (BASL),Y ; write separator (dir content/authors) LDA $61,X ; /BASIS.SYSTEM H10B9 STA SYS_LAUNCHER_LENGTH,X ; $0382,X .. $0391,X (self-modifying code) LDA #%11111111 ; display = NORMAL CPX SCREEN_POSITION ; cursor position? BNE H10CC ; no LDA PTR_WORK_NAME ; save pointer for current name STA PTR_CURRENT_NAME LDA PTR_WORK_NAME+1 STA PTR_CURRENT_NAME+1 LDA #%00111111 ; display = INVERSE ; acc=$FF (normal) or $3F (inverse) H10CC STA DISPLAY_MODE LDY #0 ; get infos byte LDA (PTR_WORK_NAME),Y ; DTTTLLLL BMI H10EF ; sub-directory (D=1) BNE H10DD ; there's a file in this location ; acc=0 LDY #$10 ; set ptr to "no name here" (empty location) STA (PTR_WORK_NAME),Y ; 1st byte=file/unknow type/len=0 = no file TAY ; Y=0 BEQ H10E4 ; always ; Process a file H10DD LSR ; 0DTTTLLL LSR ; 00DTTTLL LSR ; 000DTTTL LSR ; 0000DTTT AND #%00000111 ; keep only type TAY ; in Y H10E4 LDA LETTER_FILE_TYPE,Y ; display internal file type on screen LDY #0 STA (BASL),Y INC BASL ; next pos BNE H10FD ; always ; file is a subdirectory H10EF LDA #" " ; don't display a file type here STA (BASL),Y INC BASL INC BASL ; x position+2 LDA #"/" ; but display this character to identify a directory AND DISPLAY_MODE ; INVERSE (cursor) or NORMAL (not the cursor) STA (BASL),Y ; Display file's name (+additional trailing spaces) ; Y=0 (always) H10FD LDA (PTR_WORK_NAME),Y ; DTTTLLLL AND #%00001111 ; 0000LLLL STA NAME_LENGTH ; save len of name H1103 LDA #" " ; trailing space. character used to erase previously written name CPY NAME_LENGTH INY ; next byte of the name (instr doesn't change carry) BCS H1110 ; Y>=len. name is displayed. now complete with trailing space LDA (PTR_WORK_NAME),Y ; load character ORA #%10000000 ; default = NORMAL AND DISPLAY_MODE ; INVERSE if requested for cursor H1110 STA (BASL),Y ; write character (or NORMAL space) CPY #17 ; 17=1 (infos byte) + 1 (extra "/" for subdir) + 15 (name) BNE H1103 ; not finished ; Prepare for next name ; carry=0 LDA #$0F ; next name (ptr+16). if 20 names are now displayed, the work ptr=1st name of the next page ADC PTR_WORK_NAME ; low STA PTR_WORK_NAME BCC H1120 INC PTR_WORK_NAME+1 ; high+1 H1120 INX ; next name CPX #20 ; was it the last? BCC H10AC ; no, display next one ; In Bitsy Bye I use RdKey ($FD0C), but move the cursor offscreen first by pointing BASH above the text page: ; ASL $29 ; JSR $FD0C ; ; test with: ; 300:06 29 4c 0c fd ; ; I don't bother restoring the BASH afterward as Bitsy Bye does a VTAB (which resets BASH) after each keypress ; and before characters are printed to the screen. ; ; -JB ; X=$14 (addr $14XX -> out of TXT screen) STX BASH ; not ASL but same effect JSR RDKEY ; acc=key CMP #$8D ; return (=select)? BNE H11A8 ; no ;-------------------------------- ; Select a file/directory ;-------------------------------- JSR MLI ; The ProDOS PREFIX is set to the directory containing the selected file !8 SET_PREFIX ; (PATHNAME_LENGTH + PATHNAME) !wo TBL_SET_PREFIX BCS H1191 ; error TAY ; acc=0, Y=0 LDA (PTR_CURRENT_NAME),Y ; get DTTTLLLL BEQ H11A2 ; typeless file + no length => error STY TBL_READ+2 ; read buffer =$2000 LDX #>$2000 H113F STX TBL_READ+3 CMP #$60 ; test internal file type AND #%00001111 ; 0000LLLL BCS H1174 ; acc>=$60 (SYS+DIR) ;-------------------------------- ; process INT or BIN or BAS or ; TXT or GS/OS pgm ;-------------------------------- ; Y=0, acc=0000LLLL STA (PTR_CURRENT_NAME),Y ; store length INC TBL_OPEN+2 ; $02XX => $03XX (high) => SYS_LAUNCHER DEY ; Y=$FF : max number of bytes of data to read (high) ; load single file JSR GET_CONTENT ; load BASIS.SYSTEM (built-in hook) DEY ; MLI return code -1 BMI H1164 ; no error (BASIS.SYSTEM found and loaded) ; BASIS.SYSTEM not found LDX H10B9+1 ; $82..$91 LDA #"C" ; now BASIC.SYSTEM STA SYS_LAUNCHER+1-$82+5,X LDY #$FF ; max number of bytes of data to read (high) ; load single file H115C JSR GET_CONTENT ; read file BASIC.SYSTEM DEC TBL_OPEN+2 ; $03XX => $02XX (high) => PTR_CURRENT_NAME DEY ; MLI return code -1 BPL H11A2 ; error (unable to load BASIC.SYSTEM). Can't run the selected file. ; OK. BASIS.SYSTEM or BASIC.SYSTEM loaded at $2000 ; https://prodos8.com/docs/techref/writing-a-prodos-system-program/ ; Chapter 5.1.5 ; ; There is a way to pass a second pathname to interpreters -- for example, to language interpreters -- that ; like to run startup programs. ; Done by sophisticated program selectors. ; ; It requires that the interpreter start a certain way: ; ; $2000 is a jump instruction. $2003 and $2004 are $EE. ; If the interpreter starts this way, byte $2005 is assumed to indicate the length of a buffer that starts ; at $2006 and holds the pathname (starting with a length byte) of the startup file. ; ; Interpreters that support this mechanism should supply their own default string, which should be a standard ; choice for a startup program or a flag not to run a startup program. H1164 LDY #$0F ; copy name + length H1166 LDA (PTR_CURRENT_NAME),Y STA SYSTEM_ADDR+6,Y ; from $2006 DEY BPL H1166 H116E JSR HOME JMP SYSTEM_ADDR ; run BASIS.SYSTEM or BASIC.SYSTEM (and after that the selected file) ;-------------------------------- ; Execute SYS or go DIR ;-------------------------------- ; acc=0000LLLL H1174 TAY ADC VOLNAME_LENGTH ; rem: carry=1 (=an additionnal character for "/" after pathname) STA VOLNAME_LENGTH TAX ; path length + selected name length + 1 H117A LDA (PTR_CURRENT_NAME),Y ; add selected name to path STA PATHNAME-1,X ; if Y=0 acc=DTTTLLLL DEX DEY BPL H117A ; Y>=0 ; Y=$FF ; acc=DTTTLLLL ASL ; carry=D LDA #"/" ; add "/" before selected file name STA PATHNAME,X BCS H11A5 ; file is a directory. process it. ; SYS file ; Y=$FF max number of bytes of data to read (high) ; load single file JSR GET_CONTENT ; load it TYA ; acc= mli return code BEQ H116E ; no err: run it ; unable to load SYS file H1191 JSR BELL ;-------------------------------- ; ESC ;-------------------------------- ; Go to parent sub-directory or volume directory ; ; Example: current = /HD1/TOOLS (len=$0A) ; ; $0280: 0A AF 48 44 31 AF 54 4F 4F 4C 53 ; "/" 'H' 'D' '1' "/" 'T' 'O' 'O' 'L' 'S' ; ^ ; ! ; ESC pressed ; ^ ; ! stop here ; ; current = /HD1 ; $0280: 04 AF 48 44 31 HANDLE_ESC H1194 LDY VOLNAME_LENGTH H1196 LDA (TBL_OPEN+1),Y ; acc = volume name character DEY ; length-1 BEQ H11A2 ; can't esc: already root level ; but display files list from 1st name ; esc can be processed TAX ; test character BPL H1196 ; 'character' ; "character" <=> found "/" STY VOLNAME_LENGTH ; set new length BMI H11A5 ; always. go read parent dir ;-------------------------------- ; Error subroutine ;-------------------------------- H11A2 JSR BELL H11A5 JMP H1065 ;-------------------------------- H11A8 LDX SCREEN_POSITION ; acc=key CMP #$95 ; "right" arrow? BNE H11E5 ; no ;-------------------------------- ; Go down ;-------------------------------- ; In ; X : screen location [0..19] HANDLE_DOWN H11AE INX ; screen location+1 LDY #16 ; is next location empty? LDA (PTR_CURRENT_NAME),Y BEQ H11D1 ; yes. can't go down ; can go down ; but where is the cursor? CPX #$0A ; cursor was on the middle of the screen? BCC H120E ; no. save screen position (X) and go to display routine (JMP H1081). ; middle of the screen ; need to scroll down if 20 names on screen ; 1 name=16 byte. 20 names on the screen. 20*16=$0140=$0100+$40 INC PTR_1ST_NAME_ON_SCREEN+1 ; change temporarily : high+1 <=> +$100 LDY #$40 ; +$40 LDA (PTR_1ST_NAME_ON_SCREEN),Y ; load DEC PTR_1ST_NAME_ON_SCREEN+1 ; rollback change TAY ; DTTTLLLL BEQ H120E ; 0 means "less than 20 files on screen". ; no scroll down. save screen position (X++) ; go to the display routine and move cursor down ; filenames list : scroll down required LDA PTR_1ST_NAME_ON_SCREEN ; pointer (low) LDY PTR_1ST_NAME_ON_SCREEN+1 ADC #$0F ; low+16 BCC H11CD ; no action for high INY ; high+1 H11CD STA PTR_1ST_NAME_ON_SCREEN ; set new ptr STY PTR_1ST_NAME_ON_SCREEN+1 ; scroll up/down with screen refresh H11D1 JMP H1083 ; don't save screen position (X++) ; go screen refresh ;-------------------------------- ; Change slot ;-------------------------------- ; in ; acc : $F9..$FF (key "1".."7") ; carry : 1 ; ; Bitsy Bye uses keys 1-7 as slot keys with subsequent presses toggling the drive number at that slot. ; -JB HANDLE_CHANGE_SLOT H11D4 EOR #%11111000 ; $01..$07 ROL ; $03..$0F (carry in bit 0) TAX ; 0000SSS1 (!D=1 => D=0 : drive 1 default) ; retrieve current drive code EOR CUR_SLOT_DRV ; 0000SSS? (?=!D) ; bit 0 : 1 EOR 0 = 1 (!D=0 => D=1 current=drive 2) ; bit 0 : 1 EOR 1 = 0 (!D=1 => D=0 current=drive 1) LSR ; bit 0 in carry. ; carry=0 => bit 0 = 0 (current drive=drive 1) ; carry=1 => bit 0 = 1 (current drive=drive 2) ; (selected slot) EOR (current slot): ; 1 EOR 1 = 0 ; 0 EOR 0 = 0 ; if same slot acc=0 BNE H11E0 ; not same slot. begin with drive 1 (default) ; same slot BCS H11E0 ; carry=1 : current=drive 2. toggle: drive 1 required (keep default) DEX ; 0000SSS0 : !D=0 => D=1 (drive 2 required) H11E0 JSR GET_VOLUME_NAME ; get volume BPL H11A5 ; always. JMP H1065 (go read content) ;-------------------------------- H11E5 CMP #$9B ; esc? BEQ HANDLE_ESC ; yep CMP #"A" BCS HANDLE_FIRST_LETTER ; acc >= "A" ; carry=0 ADC #$48 CMP #"y" ; test : $B1+$48..$B7+$48 ; acc >= $F9 BCS HANDLE_CHANGE_SLOT ; yep: "1".."7" ; carry=0 SBC #$CF ; <=> -$D0 ; acc+$48-$D0=0 <=> acc=$D0-$48=$88 BEQ HANDLE_UP ; ^H (left arrow) TAY DEY ; acc+$48-$D0-1=0 <=> acc=$89 BEQ HANDLE_TAB ; ^I (TAB) DEY ; acc=$8A? BEQ HANDLE_DOWN ; ^J (down arrow) DEY ; acc=$8B? ^K (up arrow) BNE H11D1 ; no : JMP H1083 ;-------------------------------- ; Go up ;-------------------------------- ; In ; X : screen location [0..19] HANDLE_UP ; check if not already the 1st name of the directory/volume H1201 LDY PTR_1ST_NAME_ON_SCREEN+1 LDA PTR_1ST_NAME_ON_SCREEN BNE H1211 ; if low <> 0 when can't be $1400, so we can go up ; low=$00 CPY #>H1400 ; high=$14? BNE H1211 ; no, can go up ; already at the top of the screen ; X=0 H120B DEX ; screen position-1. ; if X=$FF, DEX used only to branch to H11D1 (H1083) H120C BMI H11D1 ; always if top of screen. don't save X in screen position H120E JMP H1081 ; save X to screen position ; the cursor can move up H1211 CPX #$0A ; cursor current pos>=middle of the screen+1? BCS H120B ; yes. don't need to scroll up the list. DEX=cursor up. ; filenames list : scroll up required ; carry=0 SBC #$0F ; ptr low -16. pointer on previous name BCS H11CD ; ptr high ok DEY ; ptr high-1 BCC H11CD ; always ;-------------------------------- ; Scan for another volume ;-------------------------------- ; slot DESC (7 -> 6 -> 5 -> 4 -> 3 -> 2 -> 1 -> 0 -> 7 -> etc...) ; drive ASC (1 -> 2 -> 1 & slot-1 -> 2 -> etc...) HANDLE_TAB H121C LDX CUR_SLOT_DRV ; 0000SSS? (?=!D) JMP H105F ; DEX done before calling GET_VOLUME_NAME: ; if drive 1 (!D=1) then try drive 2 (!D1=0) ; if drive 2 (!D=0) then try slot-1, drive 1 (!D=1) ; if slot-1=$FF than AND #$0F set slot 7, drive 1 (!D=1) ;-------------------------------- ; First name beginning with ; letter ; If found, become the 1st ; filename displayed on the ; screen ;-------------------------------- ; In ; acc : "letter" ; feature: Allows files to be selected by typing the first letter of their filename ; ; Notes: ; - search from the current cursor position. ; - If not found, try again from the beggining of the list. ; - If still not found (no filename starts with that letter), the cursor doesn't move. HANDLE_FIRST_LETTER H1221 AND #%01011111 ; "letter" to 'letter' for comparison STA FIRST_CHARACTER ; 1st attempt (X=1) : from current cursor position LDX #0 LDY PTR_CURRENT_NAME ; init Y with current ptr low STX PTR_CURRENT_NAME ; and set current ptr low=0 INX ; X=1 H122C TYA ; acc=ptr low CLC ; +16. next filename ADC #$10 ; carry=1 if ptr high+1 required TAY ; Y=ptr low+16. no effect on carry BCC H1235 ; ptr high OK INC PTR_CURRENT_NAME+1 ; ptr high+1 ; Y=0 H1235 LDA (PTR_CURRENT_NAME),Y ; load DTTTLLLL BEQ H124A ; end of list INY ; pos=1st letter of the filename LDA (PTR_CURRENT_NAME),Y ; load 1st letter DEY ; pos=DTTTLLLL CMP FIRST_CHARACTER ; key pressed? BNE H122C ; no, not the same letter ; found. start list with that name STY PTR_1ST_NAME_ON_SCREEN LDA PTR_CURRENT_NAME+1 STA PTR_1ST_NAME_ON_SCREEN+1 JMP H107B ; refresh display ; acc=0 H124A DEX ; another try? ; ; X=$FF? BMI H120C ; yes. 2 fails. stop now. rebuild PTR_CURRENT_NAME ptr ; with SCREEN_POSITION ; 2nd attemp (X=0): retry from the beginning of the list TAY ; Y=0. ptr low=0 LDA #>H1400 ; set ptr high = $14 STA PTR_CURRENT_NAME+1 BNE H1235 ; always ;-------------------------------- ; Get volume name ;-------------------------------- ; In ; X : 000DSSS? (?=!D) 1st entry : "D" is erased by TAX+AND #$0F ; : 0000SSS? (?=!D) others ; Out ; $56 : CUR_SLOT_DRV fmt=0000SSS? (?=!D) ; $57 : VOLNAME_LENGTH = volume name length+1 ; $0281 : "/" remplace PATHNAME's length ; $0282..$0290 : PATHNAME ; $0380 : SYS_LAUNCHER_LENGTH = full length : length("/BASIS.SYSTEM")=$0D + 1st "/" = $0E ; $0E : if name length=0 ; $0F : if name length=1 ; $10 : if name length=2 ; $11 : if name length=3 ; $12 : if name length=4 ; $13 : if name length=5 ; $14 : if name length=6 ; $15 : if name length=7 ; $16 : if name length=8 ; $17 : if name length=9 ; $18 : if name length=10 ($0A) ; $19 : if name length=11 ($0B) ; $1A : if name length=12 ($0C) ; $1B : if name length=13 ($0D) ; $1C : if name length=14 ($0E) ; $1D : if name length=15 ($0F) ; $10BA : name length $82..$91 ; Y : name length ; acc : name length $82..$91 ; $82 : if name length=0 ; $83 : if name length=1 ; $84 : if name length=2 ; $85 : if name length=3 ; $86 : if name length=4 ; $87 : if name length=5 ; $88 : if name length=6 ; $89 : if name length=7 ; $8A : if name length=8 ; $8B : if name length=9 ; $8C : if name length=10 ($0A) ; $8D : if name length=11 ($0B) ; $8E : if name length=12 ($0C) ; $8F : if name length=13 ($0D) ; $90 : if name length=14 ($0E) ; $91 : if name length=15 ($0F) ; X : unchanged GET_VOLUME_NAME H1254 TXA AND #%00001111 ; get slot 0000SSS? STA CUR_SLOT_DRV ; save as current LSR ; 00000SSS ; !D in carry BEQ H127C ; slot 0: not a valid ProDOS device (LLLL=0) H125C PHP ; save !D (carry) H125D ORA #"0" H125F STA TXT_LINE0+1 ; write slot on TXT screen H1262 ASL ; 0000SSS0 ASL ; 000SSS00 ASL ; 00SSS000 H1265 ASL ; 0SSS0000 H1266 PLP ; restore !D (carry) LDY #"1" ; drive "1" H1269 BCS H126E ; carry=1 => !D=1 => D=0 (drive 1) ; carry=0 => !D=0 => D=1 (drive 2) H126B ORA #%10000000 ; 1SSS0000 INY ; drive "2" ; Y=drive ("1"/"2") ; acc=DSSS0000 H126E STA TBL_ONLINE+1 ; unit number for ONLINE H1270 STY TXT_LINE0+4 ; write drive on TXT screen JSR MLI ; identity single volume (unit number) !8 ONLINE ; fill PATHNAME (16 bytes) !8 TBL_ONLINE,0 ; table in zero page LDA PATHNAME ; DSSSLLLL H127C LDY #"/" ; replace DSSSLLL by "/" STY PATHNAME AND #%00001111 ; 0000LLLL (volume name length) $00..$0F TAY ; Y=length CLC ADC #$0E ; $0E..$1D STA SYS_LAUNCHER_LENGTH ADC #$74 ; $82..$91 STA H10B9+1 ; low INY ; Y=length+1 STY VOLNAME_LENGTH DEY ; Y=length. if length=0, Z=1 RTS ;-------------------------------- ; Get a content ;-------------------------------- ; In ; VOLNAME_LENGTH : path length+1 ; PATHNAME ; Y : max number of bytes of data to read (high) ; $00 : load the content of a volume/directory ; $FF : load a file ; ; Out ; Y : MLI code return ("OPEN" if KO otherwise "READ") ; acc : MLI code return ("CLOSE") ; $1400..$???? structures buffer: ; 16 bytes : 1st structure ; 16 bytes : 2st structure ; ... ; ; structure infos (BB 2.4.2): ; $00 : format DTTTLLLL (infos byte) ; D : 0=file, 1=subDirectory ; TTT : internal file type ; 0=not managed type, 1=INT, 2=BIN, 3=BAS, 4=TXT, 5=GS/OS app pgm, 6=SYS ; TTT=0 if D=1 ; LLLL : name length ; $01..$0F : name ; PATHNAME_LENGTH : length including "/" ; ; ; Feature: Does not abort on drive errors, but instead lists and allows launching of all readable files ; ; I intend to open source Bitsy Bye along with several new drivers as part of ProDOS 2.5. ; The issue is that Bitsy Bye 2.4 is parsing directories in a way that is incompatible with ProDOS 2.5, so I want to hold off sharing that version. ; Once the new 2.5 system is in place, it will be ready for sharing, customizing, and migrating into other apps. ; -JB GET_CONTENT H1294 LDA VOLNAME_LENGTH ; name length+1 (including "/") STA PATHNAME_LENGTH JSR MLI ; open name !8 OPEN !8 TBL_OPEN,0 ; table in zero page BCS H12F3 ; error LDA TBL_OPEN+5 ; reference number (OPEN) STA TBL_READ+1 ; set ref number (READ) ; Y=$00 or $FF STY TBL_READ+5 ; max number of bytes of data to read (high) LDA #$2B ; size of volume directory/subdirectory header LDX #$0D ; nbr of file descriptive entries in 1 block ; (volume header + 12 files) !8 $2C ; BIT trick (hide size below) H12AC LDA #$27 ; size of file descriptive entry DEX ; nbr-1 BNE H12B5 ; process last name of the block ; note : 1 block = $2B + 12*$27 = $1FF ; +extra $00 at the end of the block LDA #$2C ; read $27 + extra $00 + 4 bytes of next block (next/previous block pointers) LDX #$0D ; loop for 13 entries ; if no "next" block: actual length=$28+mli return code $4C ; but no err => BB tries to read next & fail H12B5 STA TBL_READ+4 ; max number of bytes of data to read (low) JSR MLI ; read !8 READ !8 TBL_READ,0 ; table in zero page INY ; Y=$FF+1? If Y=0 => file loaded BEQ H12F3 ; stop reading ; processing a directory (not a file) LSR TBL_READ+6 ; actual number of bytes placed in buffer (low) BEQ H12F3 ; EOF : stop reading ; Note : if there's no file then the 1st byte of the corresponding structure is always set to 0. ; it's mandatory for the display routine and the cursor movement. TAY ; Y=0 LDA (TBL_READ+2),Y ; read 1st byte of buffer AND #%10001111 ; keep vol/dir bit + name length STA (TBL_READ+2),Y ASL ; remove vol/dir bit 000LLLL0 BEQ H12AC ; file is deleted (LLLL=0) or no file here. skip it LDY #$10 LDA (TBL_READ+2),Y ; get file type LDY #7 ; loop for known file types list+1 H12D4 DEY BEQ H12DC ; Y=0 : was last (file type not in the list) CMP FILE_TYPE_LIST-1,Y ; file type in list? BNE H12D4 ; not this one. Check another one. ; Y : 1..6 H12DC TYA ; acc = 00000TTT type index (TTT=0=not managed) ASL ASL ASL ASL ; acc = 0TTT0000 LDY #0 ; merge type index and ORA (TBL_READ+2),Y ; vol/dir bit (7) + LLLL (bits 3..0) STA (TBL_READ+2),Y ; format DTTTLLLL ; directory: D=1 TTT=0 LDA TBL_READ+2 ; buffer addr (low) for next name ADC #$10 ; +16 bytes STA TBL_READ+2 BCC H12AC ; same mem page. next name. INC TBL_READ+3 ; buffer addr (high) +1 BNE H12AC ; always. next name. ; close everything H12F3 TAY ; Y=MLI return code (err if <> 0) JSR MLI !8 CLOSE !wo TBL_CLOSE RTS ;-------------------------------- ; Table for MLI CLOSE ;-------------------------------- TBL_CLOSE H12FB !8 1 ; parameter count !8 0 ; close all files ;-------------------------------- ; Table for MLI SET_PREFIX ;-------------------------------- TBL_SET_PREFIX H12FD !8 1 !wo PATHNAME_LENGTH ;-------------------------------- ; TXT screen datas ; read from H1356 to H1300 desc ;-------------------------------- ; X: 1..40 ; Y: 0..23 ; end of screen datas H1300 !tx "-" ; not printed on screen in this loop !8 22,41 ; coord: X=41(out of screen),Y=22 !tx "BITSY BYE" !8 5,36 ; coord: X=36,Y=5 !tx "BY" !8 10,32 ; coord: X=32,Y=10 ; WTF!!! Authors name... in plain text! ; No tricks, no crazy encoding routine, even not a small EOR or inverted names! ; I'm very disappointed! !tx "J.BROOKS" !8 15,35 ; coord: X=35,Y=15 !tx "P.FERRIE" !8 18,35 ; coord: X=35,Y=18 !tx "RETURN:SELECT" !8 23,13 ; coord: X=13,Y=23 !tx "ESC:BACK" !8 23,24 ; coord: X=24,Y=23 !tx "TAB,#:NEW VOL" !8 23,40 ; coord: X=40,Y=23 ; $59..$60 H134F !tx "S6,D1:" !8 0 ; coord: Y=0 H1356 !8 6 ; coord: X=6 ; beginning of screen datas ;-------------------------------- ; Relocated in zero page $61..$6D ;-------------------------------- ; John Brooks at KansasFest 2017 ; https://youtu.be/Sm4D1wtWPck?t=957 ; BASIS.SYSTEM ; ; - Could 'smart launch' at boot or from Bisty Bye ; - Called by Bitsy Bye for non-SYS file types ; - Could map file/aux type to launch app path ; - If not found, Bitsy Bye will use BASIC.SYSTEM ; Chris Torrence : Assembly Lines #41 : ProDOS 2.4.1 Easter Egg ; https://www.youtube.com/watch?v=-_6P_a5C4Z0 ; $61 !tx "/BASIS.SYSTEM" ;-------------------------------- ; Relocated in zero page $6E..$71 ;-------------------------------- ; TBL_ONLINE ; $6E !8 2 ; parameter count ; $6F !8 $00 ; unit number DSSS0000 ; $70..$71 !wo PATHNAME ; 16 bytes buffer : $0281..$0290 ;-------------------------------- ; Relocated in zero page $72..$77 ;-------------------------------- ; TBL_OPEN !8 3 ; parameter count ; $73..$74 !wo PATHNAME_LENGTH ; addr of pathname $0280 (len) $0281..$02BF (name) ; $75..$76 !wo $0B00 ; addr of filebuffer $0B00..$0EFF ; $77 !8 $00 ; reference number ;-------------------------------- ; Relocated in zero page $78 ;-------------------------------- ; TBL_READ ; $78 !8 4 ; parameter count ; $79 : reference number (TBL_READ+1) ; $7A-$7B : addr of data buffer (TBL_READ+2/TBL_READ+3) ; $7C-$7D : requested length (TBL_READ+4/TBL_READ+5) ; $7E-$7F : actuel length // returned value (TBL_READ+6/TBL_READ+7) ;-------------------------------- ; ProDOS file type known by BB ;-------------------------------- FILE_TYPE_LIST H136F !8 $FA ; INT !8 $06 ; BIN !8 $FC ; BAS !8 $04 ; TXT !8 $B3 ; GS/OS app pgm (S16) !8 $FF ; SYS ;-------------------------------- ; Letter for ProDOS file type ;-------------------------------- LETTER_FILE_TYPE H1375 !tx " " ; unsupported file type !tx "I" ; Integer BASIC !tx "B" ; Binary !tx "A" ; AppleSoft BASIC !tx "T" ; Text !tx "-" ; GS/OS app pgm (S16) !tx "-" ; SYS