cbios-0.25/ 0000755 0001750 0001750 00000000000 11522060650 011612 5 ustar joost joost cbios-0.25/src/ 0000755 0001750 0001750 00000000000 11522060650 012401 5 ustar joost joost cbios-0.25/src/scancodes_uk.asm 0000644 0001750 0001750 00000007236 11522060650 015554 0 ustar joost joost ; $Id: scancodes_uk.asm 525 2008-12-22 22:16:42Z mthuurne $ ; Scan code tables UK keyboard for C-BIOS ; ; Copyright (c) 2008 Eric Boon. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; ; ------------------------------------- ; scan code tables scode_tbl: db "01234567" ;00 db "89-=",$5C,"[];" ;01 db "'",$9C,",./",$00,"ab" ;02 db "cdefghij" ;03 db "klmnopqr" ;04 db "stuvwxyz" ;05 scode_tbl_shift: db ")!@#$%^&" ;00 db "*(_+|{}:" ;01 db $22,"~<>?",$00,"AB" ;02 db "CDEFGHIJ" ;03 db "KLMNOPQR" ;04 db "STUVWXYZ" ;05 scode_tbl_graph: db $09,$AC,$AB,$BA,$EF,$BD,$F4,$FB ;00 db $EC,$07,$17,$F1,$1E,$01,$0D,$06 ;01 db $05,$BB,$F3,$F2,$1D,$00,$C4,$11 ;02 db $BC,$C7,$CD,$14,$15,$13,$DC,$C6 ;03 db $DD,$C8,$0B,$1B,$C2,$DB,$CC,$18 ;04 db $D2,$12,$C0,$1A,$CF,$1C,$19,$0F ;05 scode_tbl_shift_graph: db $0A,$00,$FD,$FC,$00,$00,$F5,$00 ;00 db $00,$08,$1F,$F0,$16,$02,$0E,$04 ;01 db $03,$F7,$AE,$AF,$F6,$00,$FE,$00 ;02 db $FA,$C1,$CE,$D4,$10,$D6,$DF,$CA ;03 db $DE,$C9,$0C,$D3,$C3,$D7,$CB,$A9 ;04 db $D1,$00,$C5,$D5,$D0,$F9,$AA,$F8 ;05 scode_tbl_code: db $EB,$9F,$D9,$BF,$9B,$98,$E0,$E1 ;00 db $E7,$87,$EE,$E9,$60,$ED,$DA,$B7 ;01 db $B9,$E5,$86,$A6,$A7,$00,$84,$97 ;02 db $8D,$8B,$8C,$94,$81,$B1,$A1,$91 ;03 db $B3,$B5,$E6,$A4,$A2,$A3,$83,$93 ;04 db $89,$96,$82,$95,$88,$8A,$A0,$85 ;05 scode_tbl_shift_code: db $D8,$AD,$9E,$BE,$9C,$9D,$00,$00 ;00 db $E2,$80,$00,$00,$00,$E8,$EA,$B6 ;01 db $B8,$E4,$8F,$00,$A8,$00,$8E,$00 ;02 db $00,$00,$00,$99,$9A,$B0,$00,$92 ;03 db $B2,$B4,$00,$A5,$00,$E3,$00,$00 ;04 db $00,$00,$90,$00,$00,$00,$00,$00 ;05 ; vim:ts=8:expandtab:filetype=z8a:syntax=z8a: cbios-0.25/src/basic.asm 0000644 0001750 0001750 00000037171 11522060650 014175 0 ustar joost joost ; $Id: basic.asm 525 2008-12-22 22:16:42Z mthuurne $ ; C-BASIC(minibas) main ROM ; ; Copyright (c) 2005 BouKiCHi. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; CHGMOD: equ $005f CHPUT: equ $00A2 CHGET: equ $009F ENASLT: equ $0024 EXPTBL: equ $FCC1 RSLREG: equ $0138 WORK: equ $E000 MEMPTR: equ WORK INCMD: equ WORK+$100 MEMMGR: equ WORK+$800 ;------------------------ ; Memory structure info ; MEMMGR+0h : type id ; MEMMGR+1h : a pointer to string ; MEMMGR+3h : an address of value ; ----------------------- ; ROM Header org $4000 db "AB" dw bas_main dw $0000 dw $0000 dw $0000 dw $0000 dw $0000 dw $0000 ; The start point of the code bas_main: ld a,1 call CHGMOD ; change to screen 1 call make_ramslot ; make a value to RAM ld hl,$8000 call ENASLT ; form here : Page0 = BIOS ,Page 1 = THIS, Page 2,3 = RAM call init_bas ld hl,str_startmsg call prn_text ld hl,str_lf call prn_text jp bas_loop ;------------------------ ; init_bas ; The routine initialises all parameters ; Changes : ALL init_bas: ld hl,MEMMGR ld (MEMPTR),hl ld a,$80 ld (hl),a ld hl,bas_code ld de,$8000 ld bc,bas_code_end - bas_code ldir ; transmit to ram ret ;------------------------ ; bas_loop ; The routine does loop mainly ; Changes : ALL bas_loop: ld hl,str_okprompt call prn_text ld hl,INCMD call get_string ld hl,INCMD call strupr ld hl,INCMD call parser jr bas_loop ;------------------------ ; get_string ; The routine is for getting string a line ; Changes : AF,HL ; get_string: ld b,$00 gs_lp: call CHGET cp $08 jr z,gs_get_back cp $0d jr z,gs_end call CHPUT ld (hl),a inc hl inc b jr gs_lp gs_end: call CHPUT ld a,$0a call CHPUT xor a ld (hl),a ret gs_get_back: xor a cp b jr z,gs_lp dec hl dec b ld a,$08 call CHPUT ld a,$20 call CHPUT ld a,$08 call CHPUT jr gs_lp ;----------------------- ; parser ; The routine is parser of the BASIC ; Changes: unknown parser: call isdigit jr z,single_cmd ld hl,str_linecmd call prn_text ret single_cmd: call search_cmd ret ;----------------------- ; search_cmd ; The routine searches command to execute and executes actually ; Changes: unknown search_cmd: ld hl,data_icmd ld b,$00 scmd_lp: ld de,INCMD ld a,(hl) cp $00 jr nz,scmd_chk inc hl ld a,(hl) cp $00 ret z dec hl scmd_chk: call scmd_get_sl jr z,scmd_eql inc hl inc hl inc b jr scmd_lp scmd_eql: ld hl,data_cmdexe xor a or b jr z,scmd_jmp scmd_eql_lp: inc hl inc hl dec b jr nz,scmd_eql_lp scmd_jmp: ld a,(hl) inc hl ld h,(hl) ld l,a push hl ret scmd_get_sl: push hl ld a,(hl) inc hl ld h,(hl) ld l,a call strcmp pop hl ret ;----------------------- ; strcmp ; Compares string HL with DE until HL is NUL ; Out : ZF = 1 when it is equal ; Changes: AF,HL,DE strcmp: xor a cp (hl) jr z,scmp_eq ld a,(de) cp (hl) jr nz,scmp_neq cp $00 ret z inc hl inc de jr strcmp scmp_neq: ld a,$ff or a scmp_eq: ret ;----------------------- ; ifasval ; Checks the input is action of assigning the value ; In : DE = head of input string , HL = the name of the value ; Out : AF = operand or token, AF == 0xff when it failed ; Changes: AF,HL,DE ifasval: xor a cp (hl) jr z,ifas_eq ld a,(de) cp '=' jr z,ifas_eq cp '$' jr z,ifas_eq cp (hl) jr nz,scmp_neq cp $00 ret z inc hl inc de jr ifasval ifas_neq: ld a,$ff or a ifas_eq: ret ;----------------------- ; disp_niy ; The routine says "not implemented yet" ; Changes: unknown disp_niy: ld hl,str_niy call prn_text ret ;----------------------- ; disp_list ; The routine displays BASIC list ; Changes: unknown disp_list: ld ix,$8001 call list_bas ret ;----------------------- ; isdigit ; Checks digit or not ; In : HL = pointer to character to check ; Out: ZF = 1 when (HL) is digit ; Changes: unknown isdigit: ld a,(HL) cp '0' jr z,isdigit_true jr c,isdigit_false cp '9' jr nc,isdigit_false isdigit_true: ld a,$ff or a ret isdigit_false: xor a ret ;----------------------- ; strupr ; Changes string to upper case ; In : HL = a pointer to string ; Changes: unknown strupr: ld a,(HL) cp 'a' jr z,supr_toupr jr c,supr_skip cp 'z' jr nc,supr_skip supr_toupr: sub $20 ld (HL),a supr_skip: cp $00 ret z inc hl jr strupr ;----------------------- ; get_value ; The routine gets a value from memory managed area ; In : HL = a pointer of string ; Out: DE = a pointer to value, status = A ; Changes : Unknown get_value: ld de,MEMMGR loop_get_value: ld a,(de) cp $80 ret z inc de push hl push de ex de,hl ld a,(hl) inc hl ld h,(hl) ld l,a call str_compr jr z,read_value pop de pop hl inc de inc de inc de inc de jr loop_get_value read_value: pop hl ; a simple trick pop de ld a,(hl) inc hl ld h,(hl) ld l,a xor a ret ;----------------------- ; str_compr ; The routine compares string HL with DE ; The strings have to be terminated by NUL($00) ; In : HL,DE = string ; Out: Z -> the same : NZ -> not the same ; Changes : HL,DE str_compr: ld a,(de) cp (hl) ret nz cp $00 ret z inc hl inc de jr str_compr ;------------------------ ; list_bas ; for displaying internal code as a list ; Changes : ALL list_bas: ld b,(ix) ; ptr of next_line inc ix ld c,(ix) inc ix ld a,b or c ret z line_start: call read_num ; line number call disp_dec_nz ld a,' ' call CHPUT line_loop: ld a,(ix) inc ix cp $20 jp nc,put_code ; special code (A < $20) cp $11 jp nc,disp_num1 cp $0f jp z,disp_num2 cp $00 jp z,line_end jr line_loop put_code: ld d,a ld c,a ld b,0 ld hl,table_code add hl,bc add hl,bc ld a,(hl) inc hl ld h,(hl) ld l,a or h jr nz,prn_code ld a,d call CHPUT jp line_loop prn_code: call prn_text jp line_loop disp_num1: add a,'0'-$11 call CHPUT jp line_loop disp_num2: call read_num call disp_dec_nz jp line_loop line_end: ld hl,str_lf call prn_text jp list_bas read_num: ld l,(ix) inc ix ld h,(ix) inc ix ret ;----------------------------- dispdec_lf: ld d,0 call disp_dec ld hl,str_lf call prn_text ret ;--------------------------- ;disp_dec_nz ; The routine displays decimal without zero ; This is a wrapper of disp_dec disp_dec_nz: ld d,0 ;--------------------------- ; display decimal ; The routine displays decimal ; In : HL = value , D = zero flag ; Changes: unknown disp_dec: ld bc,$d8f0 ; -10000 call nega_hl call put_dec ld bc,$fc18 ; -1000 call nega_hl call put_dec ld bc,$ff9c ; -100 call nega_hl call put_dec ld bc,$fff6 ; -10 call nega_hl call put_dec ld a,l add a,'0' call CHPUT ret put_dec: or a jr z,skip_flag ld d,1 skip_flag: bit 0,d ret z add a,'0' jp CHPUT nega_hl: xor a nega_lp: add hl,bc inc a jr c,nega_lp sbc hl,bc dec a ret ;table_dec_neg ; dw $d8f0 ; -10000 ; dw $fc18 ; -1000 ; dw $ff9c ; -100 ; dw $fff6 ; -10 ;------------------------ ;make_ramslot ;The routine makes a value of RAM slot make_ramslot: call RSLREG rlca rlca and $03 ld c,a ld b,0 ld ix,EXPTBL add ix,bc ld e,a ld a,(ix) and $80 jr z,no_exp or e ld e,a inc ix inc ix inc ix inc ix ld a,(ix) rrca rrca rrca rrca and $0c or e ret no_exp: ld a,e ret ;------------------------ prn_text: prn_str_disp: ld a,(hl) or a jp z,nul_term call CHPUT inc hl jr prn_str_disp nul_term: ret ; internal code table include "basic_tables.asm" str_startmsg: db "C-BASIC ver 0.02 (050607)",$0d,$0a db "Copyright (C) BouKiCHi",$0d,$0a,$00 str_okprompt: db "Ok",$0d,$0a,$00 str_linecmd: db "recognized Line num",$0d,$0a,$00 str_niy: db "Not implemented yet",$0d,$0a,$00 str_lf: db $0d,$0a,$00 ; Internal command table data_icmd: dw icmd_list dw icmd_vlist dw $0000 data_cmdexe: dw disp_list dw disp_niy dw $0000 ;--------------------------- ; list of internal commands icmd_list: db "LIST",$00 icmd_vlist: db "VLIST",$00 ;--------------------------- ; test.bas(for test) ; bas_code: incbin "test.bas" bas_code_end: ;end ds $8000-$ cbios-0.25/src/logo.asm 0000644 0001750 0001750 00000156173 11522060650 014060 0 ustar joost joost ; C-BIOS logo ROM ; ; Copyright (c) 2004-2005 Maarten ter Huurne. All rights reserved. ; Copyright (c) 2004-2005 Albert Beevendorp. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; include "systemvars.asm" ; logo_ident: db "C-BIOS Logo ROM",$FF logo_show: IF VDP = TMS99X8 call $6f ld a,5 ld (BAKCLR),a ld (BDRCLR),a call $62 ld hl,(NAMBAS) ld bc,768 ld a,$00 call $56 ; Set up SCREEN 2 mirrored ld bc,0 +256* 2 call $47 ld bc,3 +256* 159 call $47 ld bc,4 +256* 0 call $47 ; Fill the color table ld a,(FORCLR) and 15 rlca rlca rlca rlca ld b,a ld a,(BAKCLR) and 15 or b ld bc,2048 ld hl,(GRPCOL) call $56 ld hl,(CGPBAS) ld bc,8 * logo_patoffset add hl,bc ex de,hl ld bc,8 * logo_npatterns ld hl,logo_patterns call $5c ld hl,(CGPBAS) ld bc,8 * 32 add hl,bc ex de,hl ld hl,(4) add hl,bc ld bc,8 * 96 call $5c ld hl,(GRPCOL) ld bc,8 * logo_patoffset add hl,bc ex de,hl ld bc,8 * logo_ncolors ld hl,logo_colors call $5c ld hl,(GRPCOL) ld de,8 * 32 add hl,de ld bc,8 * 96 ld a,$f1 call $56 ld hl,(NAMBAS) ld bc,logo_namoffset add hl,bc ex de,hl ld hl,logo_names ld b,logo_height plot_logo_nam: push bc push hl push de ld bc,logo_width call $5c pop hl ; value of DE ld bc,32 add hl,bc ex de,hl pop hl ; value of HL ld bc,logo_width add hl,bc pop bc djnz plot_logo_nam ret ; logo_patoffset: equ 128 logo_namoffset: equ 4 *32+ 4 ; Y *32+ 4 ; logo_patterns: db $00,$00,$00,$00,$00,$00,$00,$00 logo_patlength: equ $ - logo_patterns db $00,$00,$00,$00,$00,$00,$FE,$F8 db $00,$00,$FE,$F8,$1F,$7F,$00,$00 db $FE,$3F,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$00,$00 db $1F,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$1F,$F8,$FE,$00,$00,$00 db $00,$00,$00,$00,$00,$7F,$1F,$F0 db $00,$00,$00,$00,$FE,$FC,$F8,$F0 db $1F,$3F,$7F,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$FE,$FC,$F8,$F0 db $00,$F8,$1F,$7F,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$1F,$F8,$FE,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$7F,$3F,$1F db $F8,$FC,$FE,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$7F,$3F,$1F,$F0 db $00,$00,$00,$00,$00,$00,$FE,$FE db $1F,$3F,$7F,$7F,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$FE,$FE,$FC db $1F,$3F,$7F,$00,$00,$00,$00,$00 db $F8,$F8,$F8,$F8,$F0,$F0,$F0,$F0 db $1F,$1F,$1F,$1F,$3F,$3F,$3F,$3F db $F8,$F8,$F8,$F8,$00,$00,$00,$00 db $F8,$F8,$F0,$F0,$F0,$1F,$1F,$1F db $00,$00,$00,$00,$00,$00,$00,$00 db $F8,$F8,$F0,$F0,$F0,$1F,$1F,$1F db $F0,$F0,$F0,$F0,$1F,$1F,$1F,$1F db $3F,$C7,$DF,$00,$00,$F8,$F0,$1F db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$F8,$00,$00,$00 db $00,$1F,$F8,$FC,$FE,$00,$7F,$3F db $FE,$FE,$FE,$FE,$FC,$FC,$FC,$7C db $F0,$F0,$F0,$F0,$1F,$1F,$1F,$1F db $00,$00,$FC,$F8,$1F,$3F,$7F,$FE db $1F,$00,$00,$00,$F0,$7F,$00,$00 db $1F,$FC,$00,$00,$00,$1F,$F0,$F8 db $00,$00,$00,$7F,$3F,$1F,$1F,$F0 db $FE,$F8,$F0,$1F,$7F,$7C,$FC,$F8 db $3F,$3F,$7F,$7F,$7F,$7F,$7F,$7F db $00,$00,$00,$00,$00,$00,$00,$00 db $3F,$3F,$7F,$7F,$7F,$7F,$7F,$7F db $1F,$1F,$1F,$1F,$3F,$3F,$3F,$3F db $3F,$7F,$7F,$7F,$00,$00,$00,$00 db $1F,$F0,$F8,$F8,$F8,$F8,$F8,$F8 db $7C,$3C,$3C,$3C,$C7,$C7,$C7,$C7 db $1F,$1E,$E3,$E3,$C7,$C7,$C7,$C7 db $FC,$F8,$F0,$F0,$1F,$3F,$3F,$3F db $FC,$FE,$00,$00,$00,$00,$00,$00 db $F0,$F8,$F8,$F8,$F8,$F8,$F8,$F8 db $F8,$F8,$F8,$F8,$F8,$FE,$7F,$3F db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$7F,$1F db $00,$00,$00,$00,$00,$00,$00,$00 db $3F,$3F,$3F,$3F,$7E,$7E,$7E,$7E db $F8,$F8,$F8,$F0,$1F,$1F,$3F,$7E db $C7,$C7,$C7,$C7,$F0,$F0,$F0,$F0 db $C7,$C7,$C7,$C7,$78,$78,$78,$7C db $3F,$3F,$3F,$3F,$3F,$3F,$1F,$F0 db $00,$00,$00,$FE,$FC,$FC,$F8,$F0 db $F8,$F8,$F8,$F8,$F0,$F0,$1F,$1F db $1F,$F8,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$FE,$00,$00,$00,$00,$00 db $F0,$F8,$FC,$7C,$7C,$7C,$7C,$7C db $00,$00,$00,$7F,$7F,$7F,$3F,$3F db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$7F,$7F,$7F,$3F,$3F db $7E,$7E,$7E,$7E,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$FE,$FC,$1F,$00,$00,$FE,$F0 db $FE,$FC,$F8,$F0,$3C,$8F,$1F,$7F db $F0,$F0,$F0,$F0,$9F,$9F,$9F,$9F db $7C,$7E,$7E,$7F,$E3,$3E,$3F,$3F db $F8,$FC,$FE,$00,$7F,$3F,$F0,$3E db $00,$00,$00,$3F,$00,$00,$00,$00 db $00,$00,$00,$FC,$00,$00,$00,$FE db $1F,$3F,$7F,$FE,$F8,$F1,$3C,$F0 db $3F,$7F,$00,$00,$7F,$00,$00,$00 db $00,$00,$00,$FC,$00,$00,$00,$FE db $7C,$FC,$F8,$F8,$1F,$3F,$7F,$00 db $3F,$3F,$1F,$1F,$F0,$F0,$F8,$FC db $3F,$1F,$1F,$F0,$F8,$F8,$FC,$FE db $FC,$FE,$00,$00,$00,$00,$00,$00 db $00,$00,$00,$7F,$3F,$1F,$F0,$F8 db $FE,$00,$00,$00,$00,$00,$00,$00 db $00,$00,$7F,$3F,$1F,$F8,$FE,$00 db $00,$00,$00,$00,$00,$00,$00,$3F db $00,$00,$00,$00,$00,$FE,$F8,$3F db $F0,$1F,$3F,$7F,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$FE,$FC db $F8,$F0,$1F,$3F,$7F,$00,$00,$00 db $FC,$FE,$00,$00,$00,$00,$00,$00 db $00,$00,$7F,$1F,$F8,$FE,$00,$00 db $00,$00,$00,$00,$00,$00,$3F,$FE db $00,$00,$00,$00,$00,$00,$00,$1F db $00,$00,$00,$FE,$F8,$1F,$00,$00 db $F0,$1F,$7F,$00,$00,$00,$00,$00 db $00,$00,$00,$00,$00,$00,$00,$00 db $00,$7F,$7F,$7F,$7F,$7F,$7F,$7F db $7F,$7F,$7F,$7F,$7F,$7F,$7F,$7F db $7F,$00,$00,$00,$00,$00,$00,$00 logo_npatterns: equ ($ - logo_patterns) / logo_patlength ; logo_colors: db $00,$00,$00,$00,$00,$00,$00,$00 logo_collength: equ $ - logo_colors db $00,$00,$00,$00,$00,$00,$09,$09 db $00,$00,$09,$09,$90,$90,$09,$09 db $09,$90,$09,$09,$09,$09,$09,$09 db $09,$09,$09,$09,$09,$09,$09,$09 db $09,$09,$09,$09,$09,$09,$09,$09 db $00,$00,$09,$90,$90,$09,$09,$09 db $00,$00,$00,$00,$00,$09,$09,$90 db $01,$01,$01,$01,$19,$19,$19,$19 db $91,$91,$91,$09,$09,$09,$09,$09 db $09,$09,$09,$09,$91,$91,$91,$91 db $09,$91,$19,$19,$01,$01,$01,$01 db $01,$01,$01,$01,$01,$01,$01,$01 db $09,$91,$19,$19,$01,$01,$01,$01 db $09,$09,$09,$09,$09,$91,$91,$91 db $91,$91,$91,$09,$09,$09,$09,$09 db $01,$01,$01,$01,$19,$19,$19,$91 db $00,$00,$00,$00,$00,$00,$09,$09 db $91,$91,$91,$91,$09,$09,$09,$09 db $09,$09,$09,$09,$09,$91,$91,$91 db $19,$19,$19,$01,$01,$01,$01,$01 db $1F,$1F,$1F,$1F,$1F,$1F,$1F,$1F db $1F,$1F,$1F,$1F,$1F,$1F,$1F,$1F db $F1,$F1,$F1,$F1,$01,$01,$01,$01 db $08,$09,$09,$09,$08,$90,$90,$90 db $08,$09,$09,$09,$08,$09,$09,$09 db $81,$91,$91,$91,$81,$19,$19,$19 db $1F,$1F,$1F,$1F,$F1,$F1,$F1,$F1 db $1F,$F1,$F1,$0F,$0F,$F1,$F1,$1F db $0F,$0F,$0F,$0F,$01,$01,$01,$01 db $0F,$0F,$0F,$0F,$1F,$01,$01,$01 db $01,$1F,$F1,$F1,$F1,$0F,$F1,$F1 db $1F,$1F,$1F,$1F,$1F,$1F,$1F,$1F db $F1,$F1,$F1,$F1,$1F,$1F,$1F,$1F db $01,$01,$1F,$1F,$F1,$F1,$F1,$F1 db $F1,$0F,$0F,$0F,$F1,$1F,$01,$01 db $1F,$F1,$0F,$0F,$0F,$F1,$1F,$1F db $01,$01,$01,$1F,$1F,$1F,$1F,$F1 db $1F,$1F,$1F,$F1,$F1,$F1,$F1,$F1 db $80,$90,$90,$80,$90,$80,$80,$90 db $08,$09,$09,$08,$09,$08,$08,$09 db $18,$19,$19,$18,$19,$18,$18,$19 db $F1,$F1,$F1,$F1,$F1,$F1,$F1,$F1 db $1F,$1F,$1F,$1F,$01,$01,$01,$01 db $F1,$1F,$1F,$1F,$1F,$1F,$1F,$1F db $1F,$1F,$1F,$1F,$F1,$F1,$F1,$F1 db $1F,$1F,$F1,$F1,$F1,$F1,$F1,$F1 db $F1,$F1,$F1,$F1,$1F,$1F,$1F,$1F db $1F,$1F,$01,$01,$01,$01,$01,$01 db $F1,$F1,$F1,$F1,$F1,$F1,$F1,$F1 db $F1,$F1,$F1,$F1,$F1,$F1,$F1,$F1 db $01,$01,$01,$01,$01,$01,$0F,$0F db $01,$01,$01,$01,$01,$01,$1F,$1F db $08,$08,$08,$09,$08,$08,$08,$09 db $F1,$F1,$E1,$F1,$F1,$E1,$E1,$F1 db $1F,$1F,$1E,$1F,$F1,$E1,$E1,$F1 db $F1,$F1,$E1,$F1,$1F,$1E,$1E,$1F db $F1,$F1,$E1,$F1,$1F,$1E,$1E,$1F db $1F,$1F,$1E,$1F,$1F,$1E,$1E,$F1 db $01,$01,$01,$1F,$1F,$1E,$1E,$1F db $F1,$F1,$E1,$F1,$F1,$E1,$1E,$1F db $F1,$1F,$01,$01,$01,$01,$01,$01 db $0F,$0F,$01,$01,$01,$01,$01,$01 db $0F,$0F,$1E,$01,$01,$01,$01,$01 db $F1,$F1,$E1,$F1,$F1,$E1,$E1,$F1 db $08,$08,$08,$80,$80,$80,$80,$80 db $08,$08,$08,$08,$08,$08,$08,$08 db $01,$01,$01,$18,$18,$18,$18,$18 db $E1,$E1,$E1,$E1,$0E,$0E,$0E,$0E db $01,$01,$01,$01,$0E,$0E,$0E,$0E db $01,$1E,$1E,$E1,$0E,$0E,$E1,$E1 db $E1,$E1,$E1,$E1,$1E,$E1,$E1,$E1 db $1E,$1E,$1E,$1E,$E1,$E1,$E1,$E1 db $1E,$1E,$1E,$1E,$1E,$E1,$E1,$E1 db $E1,$E1,$E1,$0E,$E1,$E1,$1E,$1E db $01,$01,$01,$1E,$0E,$0E,$0E,$0E db $01,$01,$01,$1E,$0E,$0E,$0E,$E1 db $E1,$E1,$E1,$E1,$E1,$E1,$1E,$1E db $1E,$1E,$01,$01,$E1,$0E,$0E,$0E db $01,$01,$01,$1E,$0E,$0E,$0E,$E1 db $E1,$E1,$E1,$E1,$1E,$1E,$1E,$01 db $80,$80,$80,$80,$08,$08,$08,$08 db $18,$18,$18,$81,$81,$81,$81,$81 db $08,$08,$00,$00,$00,$00,$00,$00 db $08,$08,$08,$81,$81,$81,$18,$18 db $81,$08,$08,$08,$08,$08,$08,$08 db $01,$01,$18,$18,$18,$81,$81,$08 db $01,$01,$01,$01,$01,$01,$01,$18 db $01,$01,$01,$01,$01,$18,$18,$81 db $18,$81,$81,$81,$08,$08,$08,$08 db $08,$08,$08,$08,$08,$08,$81,$81 db $81,$81,$18,$18,$18,$01,$01,$01 db $08,$08,$00,$00,$00,$00,$00,$00 db $08,$08,$80,$80,$08,$08,$00,$00 db $08,$08,$08,$08,$08,$08,$80,$08 db $08,$08,$08,$08,$08,$08,$08,$08 db $08,$08,$08,$80,$80,$08,$00,$00 db $84,$08,$08,$00,$00,$00,$00,$00 db $04,$00,$00,$00,$00,$00,$00,$00 db $00,$04,$04,$04,$04,$04,$04,$04 db $04,$04,$04,$04,$04,$04,$04,$04 db $04,$00,$00,$00,$00,$00,$00,$00 logo_ncolors: equ ($ - logo_colors) / logo_collength ; logo_names: db $80,$80,$81,$82,$83,$84,$85,$86,$87,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80,$80 logo_width: equ $ - logo_names db $80,$88,$89,$8A,$8B,$8C,$8D,$8E,$8F,$90,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$E3 db $91,$92,$93,$94,$8C,$95,$96,$8C,$8C,$8C,$8C,$97,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$E4 db $98,$99,$9A,$8C,$8C,$9B,$9C,$9D,$9E,$9F,$A0,$A1,$A2,$A3,$9D,$A4,$A5,$A6,$9D,$9D,$9D,$9D,$8C,$E4 db $A7,$A8,$A9,$8C,$8C,$AA,$AB,$8C,$8C,$AC,$AD,$AE,$AF,$8C,$8C,$B0,$B1,$B2,$B3,$B3,$B3,$B4,$8C,$E4 db $B5,$B5,$8C,$8C,$8C,$B6,$8C,$8C,$8C,$B7,$B8,$B9,$BA,$8C,$8C,$BB,$BC,$BD,$BE,$BE,$BF,$C0,$8C,$E4 db $C1,$C2,$C3,$8C,$8C,$C4,$C5,$C5,$C6,$C7,$C8,$C9,$CA,$CB,$CC,$CD,$CE,$C5,$C5,$C5,$CF,$D0,$8C,$E4 db $D1,$C2,$D2,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$E4 db $D3,$D4,$D5,$D6,$D7,$D8,$D9,$DA,$DB,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C,$8C db "V" incbin "../version.txt" db $E4 db $80,$DC,$DD,$DE,$C2,$DF,$E0,$E1,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E2,$E5 logo_height: equ ($ - logo_names) / logo_width ; ENDIF ; IF VDP = V9938 ld de,$c000 ld hl,msx2logodata call unPack ld hl,0 ld (BAKCLR),hl ld a,5 call $5f ld hl,palette1 call setpalette call $41 ld hl,256 ld (BAKCLR),hl call $62 ld a,(RG8SAV+1) and 127 ld b,a ld c,9 call $47 wait_ce_logo: ld a,2 ld ix,$131 call $15f bit 0,a jr nz,wait_ce_logo push de ld bc,15 ld hl,logo_hmmc ldir pop hl ld bc,13 add hl,bc ld de,$c000 ld a,(de) inc de ld (hl),a ex de,hl di ld a,32 out ($99),a ld a,128+ 17 out ($99),a push hl ld bc,15 *256+ $9b ld hl,logo_hmmc otir pop hl ld a,128+ 44 out ($99),a ld a,128+ 17 out ($99),a ei ld b,255 otir loop_logo: ld a,2 ld ix,$131 call $15f bit 0,a jr z,done_logo otir jr loop_logo done_logo: ld bc,32 ld de,$c000 ld hl,palette1 ldir ld hl,22 *8 ld (GRPACX),hl ld hl,12 *8 +1 ld (GRPACY),hl ld a,7 ld (FORCLR),a ld a,8 ld (LOGOPR),a ld hl,logo_ver call prn_text ld (LOGOPR),a call $44 palette_loop: ld b,16 ld de,palette2 ld hl,$c000 palette_color: ld a,(de) ; change red and 240 ld c,a ld a,(hl) and 240 cp c jr z,palette_red_done jr nc,palette_red_down add a,16 jr palette_red_done palette_red_down: sub 16 palette_red_done: ld c,a ld a,(hl) and 15 or c ld (hl),a ld a,(de) and 15 ld c,a ld a,(hl) and 15 cp c jr z,palette_blue_done jr nc,palette_blue_down inc a jr palette_blue_done palette_blue_down: dec a palette_blue_done: ld c,a ld a,(hl) and 240 or c ld (hl),a inc de inc hl ld a,(de) ld c,a ld a,(hl) cp c jr z,palette_green_done jr nc,palette_green_down inc a jr palette_green_done palette_green_down: dec a palette_green_done: ld (hl),a inc de inc hl djnz palette_color ld hl,$c000 call setpalette ld b,6 palette_wait: halt djnz palette_wait ld b,32 ld de,palette2 ld hl,$c000 palette_check: ld a,(de) cp (hl) jr nz,palette_loop inc de inc hl djnz palette_check ld b,9 ld hl,glare glare_loop: ld e,(hl) inc hl ld d,(hl) inc hl push bc push hl ex de,hl call setpalette pop hl pop bc halt halt djnz glare_loop ret setpalette: di xor a out ($99),a ld a,128+ 16 out ($99),a ld bc,32 *256+ $9a otir ei ret prn_text: ld a,(SCRMOD) cp 5 jr nc,prn_text_graph prn_text_char: ld a,(hl) or a ret z call $a2 inc hl jr prn_text_char prn_text_graph: ld a,(hl) or a ret z ld ix,$0089 call $15f inc hl jr prn_text_graph logo_hmmc: dw 0 dw 0 dw 0 dw 31 dw 256 dw 85 col: db 0 db 0 db $f0 palette1: dw $000,$327,$327,$327,$327,$327,$327,$327 dw $327,$327,$327,$327,$327,$327,$327,$327 palette2: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$470,$270 palette3: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$470,$777 palette4: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$777,$270 palette5: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$777,$470,$270 palette6: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$777,$772,$470,$270 palette7: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$777,$672,$772,$470,$270 palette8: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$777,$572,$672,$772,$470,$270 palette9: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $777,$563,$573,$572,$672,$772,$470,$270 palette10: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$777,$573,$572,$672,$772,$470,$270 glare: dw palette3,palette4,palette5,palette6 dw palette7,palette8,palette9,palette10,palette2 ; logo_ver: db "V" incbin "../version.txt" db 0 ; ; Bitbuster by Team Bomba ; ; ; In: HL = source ; DE = destination ; unPack: exx ld bc,128 ; b' = 0 (register loading optimize) ; c' = bits from bitstream exx unPack_loop: exx call getBit exx jr c,unPack_outCompress ; if set, we got LZ77 compression unPack_outLiteral: ldi ; copy byte from compressed data to destination jr unPack_loop ; handle more compressed data unPack_outCompress: ld a,(hl) ; get lowest 7 bits of offset, plus the offset ; extension bit inc hl or a jr z,unPack_outRle ; offset = 0, RLE compression used unPack_outMatch: exx ld e,a ld d,b ; b' should be always clear when entering this part rlca ; offset extension bit set? jr nc,unPack_outMatch1 ; no need to get extra bits if carry not set call getBit ; get offset bit 10 rl d call getBit ; get offset bit 9 rl d call getBit ; get offset bit 8 rl d call getBit ; get offset bit 7 jr c,unPack_outMatch1 ; since extension mark already makes bit 7 set res 7,e ; only clear it if the bit should be cleared unPack_outMatch1: inc de call getGammaValue_0 ; get the match length ; HL' = length push hl ; save compressed data pointer exx push hl ; save match length push de ; save match offset exx ld h,d ; destination in HL ld l,e pop bc ; load match offset length sbc hl,bc ; calculate source address pop bc ; load match length ldir pop hl ; load compressed data pointer jr unPack_loop unPack_outRle: call getGammaValue ret c ; HL' = repeat length push hl ; save compressed data pointer exx push hl ; save repeat length exx pop bc ; load repeat length ld h,d ; source = destination - 1 ld l,e dec hl ldir pop hl ; load compressed data pointer jr unPack_loop ; getBit: sla c ; shift out new bit ret nz ; if remaining value != 0, we're done exx ld a,(hl) ; get 8 bits from the compressed stream inc hl exx ld c,a ; 8 bits in C' sla c ; shift out new bit inc c ; set bit 0 so C' will be zero after shifting 8 times ret ; getGammaValue: exx ; get number of bits used to encode value getGammaValue_0: ld hl,1 ; initial length ld b,1 ; bitcount getGammaValue_size: call getBit ; get more bits jr nc,getGammaValue_sizeEnd ; if bit is not set, bit length is known inc b ; increase bitcount jr getGammaValue_size getGammaValue_bits: call getBit ; get next bit of value from the compressed stream adc hl,hl ; insert new bit in HL getGammaValue_sizeEnd: djnz getGammaValue_bits ; repeat if more bits to go getGammaValue_end: inc hl ; correct HL (was stored as length - 2) exx ret ; msx2logodata: db $7E,$00,$00,$01,$04,$33,$00,$C1,$40,$00,$00,$FD,$A2,$43,$79,$36 db $A9,$99,$00,$07,$7F,$34,$7D,$63,$FB,$10,$3A,$99,$9A,$6A,$BB,$00 db $BA,$85,$24,$93,$83,$BF,$61,$7E,$0F,$AA,$AA,$BB,$00,$02,$AA,$A9 db $80,$3F,$AE,$C7,$7E,$AB,$7E,$8C,$83,$AC,$80,$7F,$59,$7E,$EF,$80 db $1F,$D7,$67,$7E,$7D,$AC,$80,$7F,$5B,$7E,$E2,$AA,$D9,$00,$89,$6A db $80,$2B,$85,$7E,$98,$05,$43,$E8,$72,$BA,$AA,$B5,$FD,$57,$89,$88 db $63,$BA,$93,$50,$7A,$F9,$FC,$EF,$66,$F6,$D9,$B6,$F7,$61,$0D,$38 db $98,$9A,$80,$1D,$4D,$81,$00,$FB,$1F,$7F,$96,$39,$BF,$F6,$0E,$3C db $91,$88,$80,$D2,$A9,$8E,$37,$01,$F5,$5F,$20,$7F,$94,$99,$F6,$7E db $8D,$80,$9E,$90,$26,$8E,$FE,$7F,$8C,$39,$9B,$E1,$7F,$B9,$6C,$E6 db $88,$97,$80,$DF,$FC,$7F,$A4,$99,$EC,$F3,$EB,$1E,$82,$38,$8A,$BB db $80,$5F,$77,$7F,$F2,$63,$FE,$B8,$EA,$F5,$96,$80,$66,$93,$7F,$93 db $7F,$41,$FE,$1F,$1C,$80,$AE,$8A,$31,$16,$EF,$7F,$FC,$8C,$FE,$7C db $B3,$01,$89,$89,$F8,$9F,$01,$93,$7F,$CF,$1C,$99,$CC,$00,$57,$E9 db $EC,$FE,$7F,$E9,$39,$9C,$7E,$C1,$C9,$93,$7F,$FD,$B4,$FE,$7C,$2B db $66,$00,$4E,$E1,$7C,$36,$14,$7F,$7F,$C1,$B9,$9C,$7F,$8F,$FE,$21 db $57,$77,$76,$4E,$F0,$BE,$35,$14,$3F,$7F,$E0,$A5,$FE,$E2,$7C,$56 db $7F,$8F,$67,$7F,$E5,$07,$04,$3C,$CC,$7F,$28,$33,$FF,$F3,$7C,$66 db $7F,$47,$55,$56,$7F,$F2,$64,$43,$CC,$FE,$FC,$11,$E9,$14,$77,$63 db $FF,$FD,$39,$04,$33,$FE,$1D,$3F,$93,$7F,$B5,$3A,$03,$EE,$00,$7F db $33,$7F,$6B,$FE,$2F,$17,$7F,$F5,$94,$FD,$D5,$FD,$B9,$F5,$7F,$EF db $79,$01,$C4,$8A,$77,$09,$E7,$01,$CE,$B0,$3A,$7A,$01,$3F,$63,$7F db $21,$38,$7F,$F3,$CE,$44,$77,$00,$7B,$67,$4B,$57,$94,$51,$97,$5C db $1E,$18,$23,$76,$90,$C7,$11,$AF,$01,$0F,$7F,$C8,$27,$43,$3E,$FE db $A7,$E3,$7F,$B7,$52,$95,$67,$7F,$E7,$7E,$78,$66,$C7,$80,$59,$2B db $23,$79,$00,$FE,$7F,$53,$DD,$00,$96,$D9,$E9,$7A,$C8,$59,$67,$02 db $65,$55,$DC,$00,$6E,$38,$76,$63,$7F,$E7,$06,$0F,$39,$19,$46,$56 db $A1,$23,$66,$91,$8C,$2B,$7A,$55,$00,$FE,$7F,$38,$04,$43,$8D,$F8 db $7F,$92,$56,$DC,$E7,$67,$73,$66,$FE,$9D,$45,$98,$19,$DE,$8F,$48 db $67,$99,$E5,$66,$87,$2D,$D3,$FF,$E8,$DD,$FD,$FF,$1D,$3D,$C9,$7F db $D2,$66,$8D,$E3,$5F,$6F,$66,$7F,$31,$EB,$BE,$27,$3C,$0C,$DB,$AD db $CF,$7F,$F8,$69,$3B,$FE,$F8,$B6,$7F,$EB,$59,$F0,$66,$F0,$7F,$8E db $8B,$63,$99,$CB,$18,$8F,$7F,$D8,$23,$43,$3D,$FE,$97,$DC,$FB,$FA db $4B,$F1,$5E,$66,$4E,$66,$7F,$A3,$FE,$D2,$99,$37,$7A,$3B,$97,$E8 db $53,$20,$FE,$E4,$BD,$DC,$38,$3B,$FE,$1E,$63,$0F,$DD,$7F,$FA,$19 db $DF,$A8,$1F,$7F,$B8,$AE,$D7,$FD,$86,$FF,$38,$F7,$F9,$7E,$66,$A5 db $89,$8F,$29,$47,$66,$7F,$ED,$D7,$FE,$CB,$7F,$F0,$5F,$FA,$1A,$66 db $36,$A7,$EA,$7B,$A9,$AF,$14,$7F,$DC,$8F,$FF,$91,$57,$7F,$EE,$56 db $D8,$7F,$EA,$C9,$FE,$76,$9E,$94,$7F,$7F,$69,$44,$7F,$F2,$4E,$D5 db $3E,$73,$7F,$1E,$03,$65,$FE,$D7,$7F,$F8,$0B,$FE,$F9,$3E,$7F,$B7 db $73,$7F,$C4,$56,$DE,$A0,$BF,$7F,$4A,$FE,$FE,$4F,$7F,$CE,$D3,$A1 db $FD,$7D,$BF,$7F,$29,$3A,$7F,$FC,$1C,$80,$9D,$FB,$E9,$8D,$2E,$1F db $7F,$D3,$F2,$A2,$47,$FD,$97,$94,$35,$7F,$F8,$A9,$38,$FF,$E9,$93 db $7F,$FB,$8E,$33,$FB,$F4,$D2,$94,$80,$5A,$FC,$7F,$04,$04,$FF,$7C db $A8,$34,$CE,$9E,$53,$66,$A3,$45,$66,$43,$03,$AF,$18,$69,$2A,$64 db $F6,$4F,$00,$44,$46,$64,$7E,$43,$7F,$E4,$FF,$7C,$0C,$36,$FF,$D2 db $57,$76,$FF,$3E,$2D,$8F,$77,$97,$AD,$0F,$7F,$DB,$CF,$FE,$81,$66 db $E5,$9D,$FB,$7F,$EB,$8F,$C1,$7F,$F9,$F3,$FF,$F2,$48,$E5,$65,$97 db $FE,$7C,$A8,$25,$E9,$81,$45,$56,$53,$FE,$2E,$F2,$EA,$CC,$AD,$FC db $11,$FF,$FB,$7E,$7F,$E6,$34,$46,$50,$70,$7F,$44,$27,$56,$55,$EA db $D5,$66,$FE,$3F,$0F,$7F,$F0,$32,$FF,$EF,$FE,$29,$FE,$DD,$53,$99 db $B4,$FE,$A6,$F9,$7C,$72,$FF,$F9,$68,$AE,$FF,$FC,$18,$FE,$92,$65 db $FE,$47,$FF,$29,$34,$1A,$55,$FE,$1E,$84,$54,$43,$FF,$7E,$E9,$33 db $8E,$FF,$CF,$17,$7F,$B7,$65,$36,$E9,$CD,$80,$04,$75,$53,$98,$7B db $7C,$01,$11,$A4,$5B,$FF,$E4,$F7,$FF,$C9,$7F,$EB,$65,$37,$55,$65 db $7F,$90,$44,$55,$67,$55,$8F,$98,$14,$65,$FE,$7C,$98,$93,$E1,$7F db $F8,$6F,$8A,$7F,$BF,$CF,$2A,$FC,$B6,$65,$55,$8E,$85,$24,$80,$18 db $65,$55,$53,$A5,$CA,$55,$67,$8F,$FE,$92,$AF,$47,$44,$7F,$E4,$AB db $38,$80,$E2,$CD,$7F,$CD,$72,$95,$FD,$A7,$53,$85,$28,$06,$88,$C9 db $80,$36,$E1,$EA,$19,$25,$C7,$67,$44,$00,$C3,$94,$4E,$1B,$FF,$F8 db $56,$80,$F2,$67,$62,$01,$8C,$E3,$8C,$44,$7E,$52,$64,$D4,$CD,$89 db $0A,$BC,$EC,$E0,$55,$8D,$8E,$BB,$9A,$00,$E0,$CF,$30,$7F,$DE,$F3 db $00,$A7,$22,$F5,$71,$7F,$55,$7F,$62,$ED,$C4,$80,$45,$E6,$18,$66 db $CE,$0C,$0B,$BC,$01,$FC,$7E,$3F,$7F,$11,$38,$80,$5F,$14,$CD,$BA db $39,$43,$0F,$CB,$04,$7F,$0E,$C7,$00,$67,$EA,$7E,$00,$37,$33,$7F db $E4,$DF,$80,$CD,$01,$FC,$37,$7F,$E1,$DB,$80,$83,$E3,$7F,$FB,$6B db $80,$6D,$EE,$7F,$FD,$AD,$80,$38,$3F,$EF,$7F,$B3,$52,$00,$AD,$3A db $8A,$7F,$7F,$F3,$7F,$6B,$80,$3E,$0F,$FF,$7F,$EC,$E7,$80,$E9,$3A db $3F,$FF,$00,$FE,$7F,$7E,$80,$7E,$64,$FF,$96,$FF,$03,$7F,$F8,$53 db $80,$A4,$39,$9F,$E9,$7C,$51,$FE,$FC,$17,$7F,$E2,$4A,$80,$BA,$99 db $6A,$8F,$EA,$3E,$7E,$EB,$95,$F6,$FF,$7F,$1E,$80,$5E,$28,$FE,$FE db $0F,$7F,$F1,$2F,$81,$65,$80,$C1,$FF,$FE,$1F,$C6,$7E,$7F,$2F,$82 db $24,$80,$B8,$BD,$FF,$7E,$96,$FF,$FF,$FC,$FC,$80,$AE,$29,$11,$9A db $FF,$F0,$E6,$3F,$F4,$0D,$FE,$7F,$7D,$04,$29,$83,$38,$AF,$FF,$00 db $E3,$63,$F4,$FF,$F4,$14,$81,$CE,$83,$24,$80,$7C,$87,$34,$22,$00 db $EE,$7E,$7F,$33,$04,$83,$12,$80,$3E,$41,$33,$40,$00,$00,$FD,$22 db $44,$80,$3E,$5F,$7E,$E9,$E5,$80,$63,$80,$E2,$3F,$33,$30,$7E,$A6 db $96,$80,$23,$80,$5E,$AA,$7D,$43,$AF,$33,$34,$7E,$FA,$88,$80,$EC db $38,$AA,$4B,$AA,$83,$23,$FA,$AA,$F3,$7E,$FA,$C8,$80,$E7,$88,$16 db $83,$4C,$00,$63,$AF,$08,$44,$7E,$FA,$C8,$80,$EA,$83,$53,$00,$83 db $34,$44,$7E,$FA,$F8,$80,$EF,$01,$BF,$7E,$EC,$2D,$85,$9E,$01,$8F db $40,$00,$00,$ED,$63,$FB,$FA,$2F,$00,$FF,$F8 ; ENDIF ; IF VDP = V9958 call $17a rla ret c ld a,$80 call $17d ; MSX2+ logo version ld de,$c000 ld hl,msx2logodata_1 call unPack_1 ld hl,0 ld (BAKCLR),hl ld a,5 call $5f ld hl,palette1_1 call setpalette_1 call $41 ld hl,256 ld (BAKCLR),hl call $62 ld a,(RG8SAV+1) and 127 ld b,a ld c,9 call $47 wait_ce_logo_1: ld a,2 ld ix,$131 call $15f bit 0,a jr nz,wait_ce_logo_1 push de ld bc,15 ld hl,logo_hmmc_1 ldir pop hl ld bc,13 add hl,bc ld de,$c000 ld a,(de) inc de ld (hl),a ex de,hl di ld a,32 out ($99),a ld a,128+ 17 out ($99),a push hl ld bc,15 *256+ $9b ld hl,logo_hmmc_1 otir pop hl ld a,128+ 44 out ($99),a ld a,128+ 17 out ($99),a ei ld b,255 otir loop_logo_1: ld a,2 ld ix,$131 call $15f bit 0,a jr z,done_logo_1 otir jr loop_logo_1 done_logo_1: ld bc,32 ld de,$c000 ld hl,palette1_1 ldir ld hl,22 *8 ld (GRPACX),hl ld hl,12 *8 +1 ld (GRPACY),hl ld a,7 ld (FORCLR),a ld a,8 ld (LOGOPR),a ld hl,logo_ver_1 call prn_text_1 ld (LOGOPR),a call $44 palette_loop_1: ld b,16 ld de,palette2_1 ld hl,$c000 palette_color_1: ld a,(de) ; change red and 240 ld c,a ld a,(hl) and 240 cp c jr z,palette_red_done_1 jr nc,palette_red_down_1 add a,16 jr palette_red_done_1 palette_red_down_1: sub 16 palette_red_done_1: ld c,a ld a,(hl) and 15 or c ld (hl),a ld a,(de) and 15 ld c,a ld a,(hl) and 15 cp c jr z,palette_blue_done_1 jr nc,palette_blue_down_1 inc a jr palette_blue_done_1 palette_blue_down_1: dec a palette_blue_done_1: ld c,a ld a,(hl) and 240 or c ld (hl),a inc de inc hl ld a,(de) ld c,a ld a,(hl) cp c jr z,palette_green_done_1 jr nc,palette_green_down_1 inc a jr palette_green_done_1 palette_green_down_1: dec a palette_green_done_1: ld (hl),a inc de inc hl djnz palette_color_1 ld hl,$c000 call setpalette_1 ld b,6 palette_wait_1: halt djnz palette_wait_1 ld b,32 ld de,palette2_1 ld hl,$c000 palette_check_1: ld a,(de) cp (hl) jr nz,palette_loop_1 inc de inc hl djnz palette_check_1 ld b,9 ld hl,glare_1 glare_loop_1: ld e,(hl) inc hl ld d,(hl) inc hl push bc push hl ex de,hl call setpalette_1 pop hl pop bc halt halt djnz glare_loop_1 ret setpalette_1: di xor a out ($99),a ld a,128+ 16 out ($99),a ld bc,32 *256+ $9a otir ei ret prn_text_1: ld a,(SCRMOD) cp 5 jr nc,prn_text_graph_1 prn_text_char_1: ld a,(hl) or a ret z call $a2 inc hl jr prn_text_char_1 prn_text_graph_1: ld a,(hl) or a ret z ld ix,$0089 call $15f inc hl jr prn_text_graph_1 logo_hmmc_1: dw 0 dw 0 dw 0 dw 31 dw 256 dw 85 col_1: db 0 db 0 db $f0 palette1_1: dw $000,$327,$327,$327,$327,$327,$327,$327 dw $327,$327,$327,$327,$327,$327,$327,$327 palette2_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$470,$270 palette3_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$470,$777 palette4_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$772,$777,$270 palette5_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$672,$777,$470,$270 palette6_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$572,$777,$772,$470,$270 palette7_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$573,$777,$672,$772,$470,$270 palette8_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$563,$777,$572,$672,$772,$470,$270 palette9_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $777,$563,$573,$572,$672,$772,$470,$270 palette10_1: dw $000,$327,$117,$000,$111,$333,$555,$777 dw $674,$777,$573,$572,$672,$772,$470,$270 glare_1: dw palette3_1,palette4_1,palette5_1,palette6_1 dw palette7_1,palette8_1,palette9_1,palette10_1,palette2_1 ; logo_ver_1: db "V" incbin "../version.txt" db 0 ; ; Bitbuster by Team Bomba ; ; ; In: HL = source ; DE = destination ; unPack_1: exx ld bc,128 ; b' = 0 (register loading optimize) ; c' = bits from bitstream exx unPack_loop_1: exx call getBit_1 exx jr c,unPack_outCompress_1 ; if set, we got LZ77 compression unPack_outLiteral_1: ldi ; copy byte from compressed data to destination jr unPack_loop_1 ; handle more compressed data unPack_outCompress_1: ld a,(hl) ; get lowest 7 bits of offset, plus the offset ; extension bit inc hl or a jr z,unPack_outRle_1 ; offset = 0, RLE compression used unPack_outMatch_1: exx ld e,a ld d,b ; b' should be always clear when entering this part rlca ; offset extension bit set? jr nc,unPack_outMatch1_1 ; no need to get extra bits if carry not set call getBit_1 ; get offset bit 10 rl d call getBit_1 ; get offset bit 9 rl d call getBit_1 ; get offset bit 8 rl d call getBit_1 ; get offset bit 7 jr c,unPack_outMatch1_1 ; since extension mark already makes bit 7 set res 7,e ; only clear it if the bit should be cleared unPack_outMatch1_1: inc de call getGammaValue_0_1 ; get the match length ; HL' = length push hl ; save compressed data pointer exx push hl ; save match length push de ; save match offset exx ld h,d ; destination in HL ld l,e pop bc ; load match offset length sbc hl,bc ; calculate source address pop bc ; load match length ldir pop hl ; load compressed data pointer jr unPack_loop_1 unPack_outRle_1: call getGammaValue_1 ret c ; HL' = repeat length push hl ; save compressed data pointer exx push hl ; save repeat length exx pop bc ; load repeat length ld h,d ; source = destination - 1 ld l,e dec hl ldir pop hl ; load compressed data pointer jr unPack_loop_1 ; getBit_1: sla c ; shift out new bit ret nz ; if remaining value != 0, we're done exx ld a,(hl) ; get 8 bits from the compressed stream inc hl exx ld c,a ; 8 bits in C' sla c ; shift out new bit inc c ; set bit 0 so C' will be zero after shifting 8 times ret ; getGammaValue_1: exx ; get number of bits used to encode value getGammaValue_0_1: ld hl,1 ; initial length ld b,1 ; bitcount getGammaValue_size_1: call getBit_1 ; get more bits jr nc,getGammaValue_sizeEnd_1 ; if bit is not set, bit length is known inc b ; increase bitcount jr getGammaValue_size_1 getGammaValue_bits_1: call getBit_1 ; get next bit of value from the compressed stream adc hl,hl ; insert new bit in HL getGammaValue_sizeEnd_1: djnz getGammaValue_bits_1 ; repeat if more bits to go getGammaValue_end_1: inc hl ; correct HL (was stored as length - 2) exx ret ; msx2logodata_1: db $7E,$00,$00,$01,$04,$33,$00,$C1,$40,$00,$00,$FD,$A2,$43,$79,$36 db $A9,$99,$00,$07,$7F,$34,$7D,$63,$FB,$10,$3A,$99,$9A,$6A,$BB,$00 db $BA,$85,$24,$93,$83,$BF,$61,$7E,$0F,$AA,$AA,$BB,$00,$02,$AA,$A9 db $80,$3F,$AE,$C7,$7E,$AB,$7E,$8C,$83,$AC,$80,$7F,$59,$7E,$EF,$80 db $1F,$D7,$67,$7E,$7D,$AC,$80,$7F,$5B,$7E,$E2,$AA,$D9,$00,$89,$6A db $80,$2B,$85,$7E,$98,$05,$43,$E8,$72,$BA,$AA,$B5,$FD,$57,$89,$88 db $63,$BA,$93,$50,$7A,$F9,$FC,$EF,$66,$F6,$D9,$B6,$F7,$61,$0D,$38 db $98,$9A,$80,$1D,$4D,$81,$00,$FB,$1F,$7F,$96,$39,$BF,$F6,$0E,$3C db $91,$88,$80,$D2,$A9,$8E,$37,$01,$F5,$5F,$20,$7F,$94,$99,$F6,$7E db $8D,$80,$9E,$90,$26,$8E,$FE,$7F,$8C,$39,$9B,$E1,$7F,$B9,$6C,$E6 db $88,$97,$80,$DF,$FC,$7F,$A4,$99,$EC,$F3,$EB,$1E,$82,$38,$8A,$BB db $80,$5F,$77,$7F,$F2,$63,$FE,$B8,$EA,$F5,$96,$80,$66,$93,$7F,$93 db $7F,$41,$FE,$1F,$1C,$80,$AE,$8A,$31,$16,$EF,$7F,$FC,$8C,$FE,$7C db $B3,$01,$89,$89,$F8,$9F,$01,$93,$7F,$CF,$1C,$99,$CC,$00,$57,$E9 db $EC,$FE,$7F,$E9,$39,$9C,$7E,$C1,$C9,$93,$7F,$FD,$B4,$FE,$7C,$2B db $66,$00,$4E,$E1,$7C,$36,$14,$7F,$7F,$C1,$B9,$9C,$7F,$8F,$FE,$21 db $57,$77,$76,$4E,$F0,$BE,$35,$14,$3F,$7F,$E0,$A5,$FE,$E2,$7C,$56 db $7F,$8F,$67,$7F,$E5,$07,$04,$3C,$CC,$7F,$28,$33,$FF,$F3,$7C,$66 db $7F,$47,$55,$56,$7F,$F2,$64,$43,$CC,$FE,$FC,$11,$E9,$14,$77,$63 db $FF,$FD,$39,$04,$33,$FE,$1D,$3F,$93,$7F,$B5,$3A,$03,$EE,$00,$7F db $33,$7F,$6B,$FE,$2F,$17,$7F,$F5,$94,$FD,$D5,$FD,$B9,$F5,$7F,$EF db $79,$01,$C4,$8A,$77,$09,$E7,$01,$CE,$B0,$3A,$7A,$01,$3F,$63,$7F db $21,$38,$7F,$F3,$CE,$44,$77,$00,$7B,$67,$4B,$57,$94,$51,$97,$5C db $1E,$18,$23,$76,$90,$C7,$11,$AF,$01,$0F,$7F,$C8,$27,$43,$3E,$FE db $A7,$E3,$7F,$B7,$52,$95,$67,$7F,$E7,$7E,$78,$66,$C7,$80,$59,$2B db $23,$79,$00,$FE,$7F,$53,$DD,$00,$96,$D9,$E9,$7A,$C8,$59,$67,$02 db $65,$55,$DC,$00,$6E,$38,$76,$63,$7F,$E7,$06,$0F,$39,$19,$46,$56 db $A1,$23,$66,$91,$8C,$2B,$7A,$55,$00,$FE,$7F,$38,$04,$43,$8D,$F8 db $7F,$92,$56,$DC,$E7,$67,$73,$66,$FE,$9D,$45,$98,$19,$DE,$8F,$48 db $67,$99,$E5,$66,$87,$2D,$D3,$FF,$E8,$DD,$FD,$FF,$1D,$3D,$C9,$7F db $D2,$66,$8D,$E3,$5F,$6F,$66,$7F,$31,$EB,$BE,$27,$3C,$0C,$DB,$AD db $CF,$7F,$F8,$69,$3B,$FE,$F8,$B6,$7F,$EB,$59,$F0,$66,$F0,$7F,$8E db $8B,$63,$99,$CB,$18,$8F,$7F,$D8,$23,$43,$3D,$FE,$97,$DC,$FB,$FA db $4B,$F1,$5E,$66,$4E,$66,$7F,$A3,$FE,$D2,$99,$37,$7A,$3B,$97,$E8 db $53,$20,$FE,$E4,$BD,$DC,$38,$3B,$FE,$1E,$63,$0F,$DD,$7F,$FA,$19 db $DF,$A8,$1F,$7F,$B8,$AE,$D7,$FD,$86,$FF,$38,$F7,$F9,$7E,$66,$A5 db $89,$8F,$29,$47,$66,$7F,$ED,$D7,$FE,$CB,$7F,$F0,$5F,$FA,$1A,$66 db $36,$A7,$EA,$7B,$A9,$AF,$14,$7F,$DC,$8F,$FF,$91,$57,$7F,$EE,$56 db $D8,$7F,$EA,$C9,$FE,$76,$9E,$94,$7F,$7F,$69,$44,$7F,$F2,$4E,$D5 db $3E,$73,$7F,$1E,$03,$65,$FE,$D7,$7F,$F8,$0B,$FE,$F9,$3E,$7F,$B7 db $73,$7F,$C4,$56,$DE,$A0,$BF,$7F,$4A,$FE,$FE,$4F,$7F,$CE,$D3,$A1 db $FD,$7D,$BF,$7F,$29,$3A,$7F,$FC,$1C,$80,$9D,$FB,$E9,$8D,$2E,$1F db $7F,$D3,$F2,$A2,$47,$FD,$97,$94,$35,$7F,$F8,$A9,$38,$FF,$E9,$93 db $7F,$FB,$8E,$33,$FB,$F4,$D2,$94,$80,$5A,$FC,$7F,$04,$04,$FF,$7C db $A8,$34,$CE,$9E,$53,$66,$A3,$45,$66,$43,$03,$AF,$18,$69,$2A,$64 db $F6,$4F,$00,$44,$46,$64,$7E,$43,$7F,$E4,$FF,$7C,$0C,$36,$FF,$D2 db $57,$76,$FF,$3E,$2D,$8F,$77,$97,$AD,$0F,$7F,$DB,$CF,$FE,$81,$66 db $E5,$9D,$FB,$7F,$EB,$8F,$C1,$7F,$F9,$F3,$FF,$F2,$48,$E5,$65,$97 db $FE,$7C,$A8,$25,$E9,$81,$45,$56,$53,$FE,$2E,$F2,$EA,$CC,$AD,$FC db $11,$FF,$FB,$7E,$7F,$E6,$34,$46,$50,$70,$7F,$44,$27,$56,$55,$EA db $D5,$66,$FE,$3F,$0F,$7F,$F0,$32,$FF,$EF,$FE,$29,$FE,$DD,$53,$99 db $B4,$FE,$A6,$F9,$7C,$72,$FF,$F9,$68,$AE,$FF,$FC,$18,$FE,$92,$65 db $FE,$47,$FF,$29,$34,$1A,$55,$FE,$1E,$84,$54,$43,$FF,$7E,$E9,$33 db $8E,$FF,$CF,$17,$7F,$B7,$65,$36,$E9,$CD,$80,$04,$75,$53,$98,$7B db $7C,$01,$11,$A4,$5B,$FF,$E4,$F7,$FF,$C9,$7F,$EB,$65,$37,$55,$65 db $7F,$90,$44,$55,$67,$55,$8F,$98,$14,$65,$FE,$7C,$98,$93,$E1,$7F db $F8,$6F,$8A,$7F,$BF,$CF,$2A,$FC,$B6,$65,$55,$8E,$85,$24,$80,$18 db $65,$55,$53,$A5,$CA,$55,$67,$8F,$FE,$92,$AF,$47,$44,$7F,$E4,$AB db $38,$80,$E2,$CD,$7F,$CD,$72,$95,$FD,$A7,$53,$85,$28,$06,$88,$C9 db $80,$36,$E1,$EA,$19,$25,$C7,$67,$44,$00,$C3,$94,$4E,$1B,$FF,$F8 db $56,$80,$F2,$67,$62,$01,$8C,$E3,$8C,$44,$7E,$52,$64,$D4,$CD,$89 db $0A,$BC,$EC,$E0,$55,$8D,$8E,$BB,$9A,$00,$E0,$CF,$30,$7F,$DE,$F3 db $00,$A7,$22,$F5,$71,$7F,$55,$7F,$62,$ED,$C4,$80,$45,$E6,$18,$66 db $CE,$0C,$0B,$BC,$01,$FC,$7E,$3F,$7F,$11,$38,$80,$5F,$14,$CD,$BA db $39,$43,$0F,$CB,$04,$7F,$0E,$C7,$00,$67,$EA,$7E,$00,$37,$33,$7F db $E4,$DF,$80,$CD,$01,$FC,$37,$7F,$E1,$DB,$80,$83,$E3,$7F,$FB,$6B db $80,$6D,$EE,$7F,$FD,$AD,$80,$38,$3F,$EF,$7F,$B3,$52,$00,$AD,$3A db $8A,$7F,$7F,$F3,$7F,$6B,$80,$3E,$0F,$FF,$7F,$EC,$E7,$80,$E9,$3A db $3F,$FF,$00,$FE,$7F,$7E,$80,$7E,$64,$FF,$96,$FF,$03,$7F,$F8,$53 db $80,$A4,$39,$9F,$E9,$7C,$51,$FE,$FC,$17,$7F,$E2,$4A,$80,$BA,$99 db $6A,$8F,$EA,$3E,$7E,$EB,$95,$F6,$FF,$7F,$1E,$80,$5E,$28,$FE,$FE db $0F,$7F,$F1,$2F,$81,$65,$80,$C1,$FF,$FE,$1F,$C6,$7E,$7F,$2F,$82 db $24,$80,$B8,$BD,$FF,$7E,$96,$FF,$FF,$FC,$FC,$80,$AE,$29,$11,$9A db $FF,$F0,$E6,$3F,$F4,$0D,$FE,$7F,$7D,$04,$29,$83,$38,$AF,$FF,$00 db $E3,$63,$F4,$FF,$F4,$14,$81,$CE,$83,$24,$80,$7C,$87,$34,$22,$00 db $EE,$7E,$7F,$33,$04,$83,$12,$80,$3E,$41,$33,$40,$00,$00,$FD,$22 db $44,$80,$3E,$5F,$7E,$E9,$E5,$80,$63,$80,$E2,$3F,$33,$30,$7E,$A6 db $96,$80,$23,$80,$5E,$AA,$7D,$43,$AF,$33,$34,$7E,$FA,$88,$80,$EC db $38,$AA,$4B,$AA,$83,$23,$FA,$AA,$F3,$7E,$FA,$C8,$80,$E7,$88,$16 db $83,$4C,$00,$63,$AF,$08,$44,$7E,$FA,$C8,$80,$EA,$83,$53,$00,$83 db $34,$44,$7E,$FA,$F8,$80,$EF,$01,$BF,$7E,$EC,$2D,$85,$9E,$01,$8F db $40,$00,$00,$ED,$63,$FB,$FA,$2F,$00,$FF,$F8 ; ENDIF ; ds $c000 - $,$ff cbios-0.25/src/logo_msx2.asm 0000644 0001750 0001750 00000003207 11522060650 015016 0 ustar joost joost ; $Id: logo_msx2.asm 525 2008-12-22 22:16:42Z mthuurne $ ; C-BIOS main ROM for MSX2 machines ; ; Copyright (c) 2005 Maarten ter Huurne. All rights reserved. ; Copyright (c) 2005 Albert Beevendorp. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; include "hardware.asm" VDP: equ V9938 MODEL_MSX: equ MODEL_MSX2 org $8000 include "logo.asm" ; vim:ts=8:expandtab:filetype=z8a:syntax=z8a: cbios-0.25/src/inlin.asm 0000644 0001750 0001750 00000021502 11522060650 014214 0 ustar joost joost ; $Id: inlin.asm 525 2008-12-22 22:16:42Z mthuurne $ ; INLIN/PINLIN/QINLIN routines for C-BIOS ; ; Copyright (c) 2007 Eric Boon. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; ;-------------------------------- ; $00AE PINLIN ; Function : Stores in the specified buffer the character codes input ; until the return key or STOP key is pressed ; Output : HL - for the starting address of the buffer -1 ; C-flag set when it ends with the STOP key ; Registers: All ; TODO: call H_PINL pinlin: call H_PINL ld a,(AUTFLG) ; If AUTO is active and a jp z,inlin ; then start line input ld a,1 ; else set cursor ld (CSRX),a ; to left border first jp inlin ; and then start line input ;-------------------------------- ; $00B4 QINLIN ; Function : Prints a questionmark and one space and continues with INLIN ; Output : HL - for the starting address of the buffer -1 ; C-flag set when it ends with the STOP key ; Registers: All qinlin_prompt: db "? ",0 qinlin: call H_QINL ld hl,qinlin_prompt call prn_text ; continue with inlin ;-------------------------------- ; $00B1 INLIN ; Function : Main line input routine ; Output : HL - for the starting address of the buffer -1 ; C-flag set when it ends with the STOP key ; Registers: All inlin: ld hl,(CSRX) ; loads CSRX and CSRY ld (FSTPOS),hl ; save in FSTPOS ld de,LINTTB-2 ; break logical line ld h,0 ; above cursor pos ld a,l add hl,de ld (hl),a inlin_loop: call chget ; get a character from the kbd cp $7F jp z,inlin_del cp $20 jr nc,inlin_printable ld b,20 ld hl,inlin_table call jump_table xor a ; we just put out a ctrl char ld (INSFLG),a ; switch insert mode off ld (CSTYLE),a jr inlin_loop inlin_printable: ; else... push af ld a,(INSFLG) and a call nz,inlin_insert pop af rst $18 jr inlin ; ---------------------------------------------- inlin_insert: call chput_remove_cursor ld hl,(CSRY) ; save cursorpos ld (TEMP2),hl ld a,' ' ; oldchar = space ld (TEMP),a inlin_insert_loop: ; REPEAT call curs2hl ; get char under curpos call rdvrm cp ' ' ; IF is space jr nz,inlin_insert_cont ld hl,(CSRY) ; AND at end of line ld a,(LINLEN) cp h jr nz,inlin_insert_cont1 ld h,0 ; AND logical line does ld de,LINTTB-1 ; not continue add hl,de ld a,(hl) or a jr z,inlin_insert_cont1 ld a,(TEMP) ; THEN call curs2hl call wrtvrm ; put old char ld hl,(TEMP2) ; restore cursor pos ld (CSRY),hl ret jp chput_restore_cursor ; and exit inlin_insert_cont1: ld a,' ' inlin_insert_cont: push af ; ELSE ld a,(TEMP) ; put old char rst $18 pop af ld (TEMP),a ; oldchar = character read jr inlin_insert_loop ; ENDREP ; ---------------------------------------------- inlin_wback: ret ; ---------------------------------------------- inlin_break: scf ; C pop hl ; do not return to INLIN ret ; but to caller of INLIN ; ---------------------------------------------- inlin_clear: ret ; ---------------------------------------------- inlin_wfwd: ret ; ---------------------------------------------- inlin_bs: ret ; ---------------------------------------------- inlin_cr: ret ; ---------------------------------------------- inlin_end: xor a ; NZ, NC pop hl ; do not return to INLIN ret ; but to caller of INLIN ; ---------------------------------------------- inlin_ins: ret ; ---------------------------------------------- inlin_clrlin: ret ; -- ESCAPE inlin_esc: ret ; Do nothing ; -- DELETE inlin_del: ret ; -- Jump table. Control chars not handled in one of the routines above ; are simply forwarded to OUTDO inlin_table: dw $0018 ; @ dw $0018 ; A - dw inlin_wback ; B word back dw inlin_break ; C stop, abort, quit dw $0018 ; D dw inlin_clear ; E: clear to end of line dw inlin_wfwd ; F: word fwd dw $0018 ; G dw inlin_bs ; H BACKSP: erase char left dw $0018 ; I dw $0018 ; J dw $0018 ; K dw $0018 ; L dw inlin_cr ; M ENTER : confirm, yes, ok dw inlin_end ; N to end of line dw $0018 ; O dw $0018 ; P dw $0018 ; Q dw inlin_ins ; R INSERT: toggle insert mode dw $0018 ; S dw $0018 ; T dw inlin_clrlin ; U clear line dw $0018 ; V dw $0018 ; W dw $0018 ; X dw $0018 ; Y dw $0018 ; Z dw inlin_esc ; ESCAPE: ignore dw $0018 ; (28) dw $0018 ; (29) dw $0018 ; (30) dw $0018 ; (31) ; vim:ts=8:expandtab:filetype=z8a:syntax=z8a: cbios-0.25/src/disk.asm 0000644 0001750 0001750 00000067657 11522060650 014062 0 ustar joost joost ; $Id: disk.asm 525 2008-12-22 22:16:42Z mthuurne $ ; C-BIOS Disk ROM - based on WD2793 FDC ; ; Copyright (c) 2004 Albert Beevendorp. All rights reserved. ; Copyright (c) 2005 Maarten ter Huurne. All rights reserved. ; ; Redistribution and use in source and binary forms, with or without ; modification, are permitted provided that the following conditions ; are met: ; 1. Redistributions of source code must retain the above copyright ; notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright ; notice, this list of conditions and the following disclaimer in the ; documentation and/or other materials provided with the distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. ; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; include "hooks.asm" include "systemvars.asm" include "hardware.asm" calslt: equ $001C enaslt: equ $0024 chput: equ $00A2 ; Disk Transfer Area. DTA_ADDR: equ $F23D ; For each page, the slot in which RAM is located. RAM_PAGE0: equ $F341 RAM_PAGE1: equ $F342 RAM_PAGE2: equ $F343 RAM_PAGE3: equ $F344 ; BDOS entry point. BDOS_ENTRY: equ $F37D ; Actual place where the BDOS inter slot call is made. ; The entry point is just 3 bytes, inter slot call requires 5. H_BDOS: equ $F331 ; Number of drives on interface. NUM_DRIVES: equ 1 org $4000 db "AB" dw init ; init dw 0 ; statement dw 0 ; device dw 0 ; basic text dw 0,0,0 ; $4010 DSKIO ds $4010 - $,$FF jp dskio ; $4013 DSKCHG ds $4013 - $ jp dskchg ; $4016 GETDPB ds $4016 - $ jp getdpb ; $4019 CHOICE ds $4019 - $ jp choice ; $401C DSKFMT ds $401C - $ jp dskfmt ; $401F LOC_DS - stop motor of drives connected to this interface ds $401F - $ jp loc_ds ; $4022 BASIC ds $4022 - $ jp basic scf ; $4026 FORMAT ds $4026 - $ jp format ; $4029 DSKSTP - stop motor of drives on all interfaces ds $4029 - $ jp dskstp ; $402D DSKSLT ds $402D - $,$00 jp dskslt ;-------------------------------- init: ld hl,init_text call print_debug ; Init variables: ; Init RAM_PAGEx. ; Note: Should this happen in disk ROM or main ROM? ; We assume that the same slot that is chosen by the main ROM ; to hold the system vars provides RAM in all pages. ; This is not true for all MSX models, but it is for most. ; TODO: Search for RAM for each page separately. in a,(PSL_STAT) and $C0 rlca rlca ld c,a ; C = 000000PP ld a,(SSL_REGS) cpl and $C0 rrca rrca rrca rrca ; A = 0000SS00 or c ; A = 0000SSPP ld b,0 ld hl,EXPTBL add hl,bc or (hl) ; A = E000SSPP ld hl,RAM_PAGE0 ld (hl),a inc hl ld (hl),a inc hl ld (hl),a inc hl ld (hl),a ; Init DRVINF. ; TODO: Cooperate with other disk ROMs. ld hl,DRVINF ld (hl),NUM_DRIVES inc hl push hl call dskslt pop hl ld (hl),a ; Init DTA. call resetdta ; Setup hooks: call dskslt ; BDOS ld de,bdos ld hl,H_BDOS call init_sethook ; PHYDIO ld de,phydio ld hl,H_PHYD call init_sethook ; FORMAT ld de,format ld hl,H_FORM call init_sethook ; boot loader ld de,boot ld hl,H_RUNC call init_sethook ; Setup BDOS entry point. ld a,$C3 ; jp ld hl,H_BDOS ld (BDOS_ENTRY),a ld (BDOS_ENTRY + 1),hl ; Init megarom mapper. ld a,1 ld ($6000),a ret init_sethook: ld (hl),$F7 ; rst $30 inc hl ld (hl),a ; slot ID inc hl ld (hl),e ; addr low inc hl ld (hl),d ; addr high inc hl ld (hl),$C9 ; ret ret init_text: db "C-DISK is initializing",0 ;-------------------------------- boot: ld hl,boot_text call print_debug ld hl,$C000 ; address to load to ld de,$0000 ; boot sector ld bc,$01F9 ; 1 sector, 720K disk xor a ; drive 0, read (NC) call dskio ret c ; error -> abort boot ; TODO: Perform sanity checks on boot sector contents? ; TODO: Put RAM in page 0 and set up minimal call environment. ; TODO: Since the bootsector routine checks CF, I assume it is ; called two times: first time with CF reset, second ; time with CF set. But I don't know the difference ; between the two. ;and a ;call $C01E ld hl,0 ; a pointer will be written here ld de,0 ; ??? ld a,0 ; ??? scf call $C01E ret boot_text: db "C-DISK booting",0 ;-------------------------------- ; DSKIO ; Input: F = NC to read, C to write ; A = Drive number (0=A:) ; B = Number of sectors to transfer ; C = Media descriptor ; DE = Logical sector number ; HL = Transfer address ; ; Output: F = NC if successful, C if error ; A = Error code if error ; 0 = Write protected ; 2 = Not ready ; 4 = Data (CRC) error ; 6 = Seek error ; 8 = Record not found ; 10 = Write fault ; 12 = Other errors ; B = Always the number of sectors transferred ; NOTE: This routine is still stubbed dskio: call dskio_debug ; Check whether the drive exists. push af cp NUM_DRIVES jr c,dskio_drive_ok pop af ld a,12 scf ret dskio_drive_ok: pop af ; Read or write? jp c,dskio_write dskio_read_loop: push de push bc call load_sector pop bc pop de inc de ; next sector djnz dskio_read_loop and a ; CF = 0 call dskio_done ret ; Load 1 sector. ; Input: HL = address to load to ; DE = sector number ; Output: HL = updated address to load to ; Changes: AF, DE, BC ; TODO: Loading will fail if a sector is loaded across a page boundary. ; Probably the only decent way to fix this is loading to a RAM buffer ; and LDIR-ing in two steps. load_sector: ld a,h cp $40 jr c,load_sector_skip cp $80 jr c,load_sector_page1 load_sector_skip: ex de,hl ; DE = address to load to add hl,hl ; HL = sectornr * 2 ld b,l add hl,hl add hl,hl add hl,hl ld a,h add a,2 ld ($6000),a ; page nr ld a,b and $1F ld b,a ld c,0 ; BC = offset in page ld hl,$6000 add hl,bc ld bc,$0200 ; 512 bytes per sector ldir ex de,hl ; HL = updated address to load to ld a,1 ld ($6000),a ret ; Load 1 sector to an address in page 1. load_sector_page1: ; TODO: Determine slot currently active in page 2. ld a,(RAM_PAGE2) ; RAM slot push af ; Select disk ROM in page 2. push hl push de call dskslt push af ld h,$80 call enaslt ; MegaROM bank 0 and 1. xor a ld ($8000),a inc a ld ($A000),a pop af pop de pop hl ; Call routine which runs in page 2. call load_sector_page1_high + $4000 ; Restore slot in page 2. pop af push hl ld h,$80 call enaslt pop hl ret load_sector_page1_high: push af ; A = disk ROM slot push hl push de ; Select RAM in page 1. ; Note that this will only allow loading into the primary ; mapper; does the MSX disk ROM have the same limitation? ; If not, how does it know which slot to load to? ld a,(RAM_PAGE1) ld h,$40 call enaslt pop hl ; HL = sector number pop de ; DE = address to load to add hl,hl ; HL = sectornr * 2 ld b,l add hl,hl add hl,hl add hl,hl ld a,h add a,2 ld ($A000),a ; page nr ld a,b and $1F ld b,a ld c,0 ; BC = offset in page ld hl,$A000 add hl,bc ld bc,$0200 ; 512 bytes per sector ldir ex de,hl ; HL = updated address to load to ld a,1 ld ($A000),a ; Restore disk ROM in page 1. pop af push hl ld h,$40 call enaslt pop hl ret dskio_write: ; write protect error xor a scf call dskio_done ret dskio_debug: push hl push af ld a,$23 ; ASCII mode out (DBG_CTRL),a ld hl,dskio_text_1 call print_debug_asciiz pop af push af ld hl,dskio_text_wr jr c,dskio_debug_write ld hl,dskio_text_rd dskio_debug_write: call print_debug_asciiz ld hl,dskio_text_2 call print_debug_asciiz ld l,e ld h,d call print_debug_hexword ld hl,dskio_text_3 call print_debug_asciiz ld a,b call print_debug_hexbyte ld hl,dskio_text_4 call print_debug_asciiz pop af pop hl push hl push af call print_debug_hexword ld hl,dskio_text_5 call print_debug_asciiz ld a,c call print_debug_hexbyte ld a,$00 ; flush out (DBG_CTRL),a pop af pop hl ret dskio_text_1: db "disk: ",0 dskio_text_rd: db "READ",0 dskio_text_wr: db "WRITE",0 dskio_text_2: db " sectors: first $",0 dskio_text_3: db ", num $",0 dskio_text_4: db ", to $",0 dskio_text_5: db ", media $",0 ;-------------------------------- ; DSKCHG ; Input: A = Drive number (0=A:) ; B = Media Descriptor ; C = Media Descriptor ; HL = Base address of DPB ; ; Output: F = NC if successful, C if error ; A = Error code if error ; 0 = Write protected ; 2 = Not ready ; 4 = Data (CRC) error ; 6 = Seek error ; 8 = Record not found ; 10 = Write fault ; 12 = Other errors ; B = Disk Change state if successful ; -1 = Disk changed ; 0 = Unknown ; 1 = Disk unchanged ; Note: If the disk has been changed or may have been changed (unknown) ; read the bootsector or the first FAT sectoe for a disk media ; descriptor and transfer a new DPB as with GETDPB. ; NOTE: This routine is still stubbed dskchg: push hl push af ld hl,dskchg_text call print_debug pop af pop hl ld b,0 ; unknown whether changed or not ret dskchg_text: db "disk: DSKCHG ($4013) called",0 ;-------------------------------- ; GETDPB ; Input: A = Drive number (0=A:) ; B = First byte of FAT (media descriptor) ; C = Media descriptor ; HL = Base address of DPB ; ; Output: HL = DPB filled in ; Note: DPB consists of: ; Name Offset Size Description ; -------------------------------------------------- ; MEDIA $00 1 Media type ($F8 - $FF) ; SECSIZE $01 2 Sector size (must be 2^n) ; DIRMSK $03 1 (SECSIZ / 32 - 1) ; DIRSHFT $04 1 Number of one bits in DIRMSK ; CLUSMSK $05 1 (Sectors per cluster - 1) ; CLUSSHFT $06 1 (Number of one bits in CLUSMSK) - 1 ; FIRFAT $07 2 Logical sector number of first FAT ; FATCNT $09 1 Number of FATs ; MAXENT $0A 1 Number of root directory entries ; FIRREC $0B 2 Logical sector number of first data ; MAXCLUS $0D 2 (Number of clusters) + 1 ; This excludes the number of reserved, ; FAT and root directory sectors. ; FATSIZ $0F 1 Number of sectors used for FAT ; FIRDIR $10 2 Logical sector number of first directory ; NOTE: This routine is still stubbed getdpb: push hl push af ld hl,getdpb_text call print_debug pop af pop hl ret getdpb_text: db "disk: GETDPB ($4016) called",0 ;-------------------------------- ; CHOICE ; Output: HL = Address of ASCIIz string containing the text with choices ; for DSKFMT. If there are no choices (only one format sup- ; ported) HL=0 choice: ld hl,choice_text ret choice_text: db 13,10,"1 - Single sided, 80 tracks" db 13,10,"2 - Double sided, 80 tracks" db 13,10,0 ;-------------------------------- ; DSKFMT ; Input: A = Choice specified by user: 1-9. See CHOICE ; D = Drive number (0=A:) ; BC = Length of work area ; HL = Base address of work area ; ; Output: F = NC if successful, C if error ; A = Error code if error ; 0 = Write protected ; 2 = Not ready ; 4 = Data (CRC) error ; 6 = Seek error ; 8 = Record not found ; 10 = Write fault ; 12 = Bad parameter ; 14 = Insufficient memory ; 16 = Other errors ; Note: Also write MSX bootsector at sector 0, clears all FATs (media ; descriptor ar first byte, $FF at the second/third byte and ; rest filled with $00) and clears the root directory (full $00). ; NOTE: This routine is still stubbed dskfmt: push hl push af ld hl,dskfmt_text call print_debug pop af pop hl scf ; error, because we didn't format ret dskfmt_text: db "disk: DSKFMT ($401C) called",0 ;-------------------------------- ; LOC_DS ; Note: Stop motor for all drives on THIS interface. loc_ds: push hl push af ld hl,loc_ds_text call print_debug pop af pop hl ret loc_ds_text: db "disk: LOC_DS ($401F) called",0 ;-------------------------------- ; BASIC ; Note: Warmboots to BASIC. ; NOTE: This routine is still stubbed basic: push hl push af ld hl,basic_text call print_debug pop af pop hl ret basic_text: db "disk: BASIC ($4022) called",0 ;-------------------------------- ; FORMAT ; Note: Like CALL FORMAT, FORMAT (DOS) and BIOS routine $0147. ; Display CHOICE, wait for input and do DSKFMT. ; NOTE: This routine is still stubbed format: push hl push af ld hl,format_text call print_debug pop af pop hl ret format_text: db "disk: FORMAT ($4026) called",0 ;-------------------------------- ; DSKSTP ; Note: Stop motor for all drives on all interfaces. Interslot-calls ; LOC_DS for all detected interfaces. ; NOTE: This routine is still stubbed dskstp: push hl push af ld hl,dskstp_text call print_debug pop af pop hl ret dskstp_text: db "disk: DSKSTP ($4029) called",0 ;-------------------------------- ; $402D DSKSLT ; Calculate slot ID for disk ROM slot. ; Output: A = slot ID ; Changes: F, HL, BC ; TODO: Old description said this: ; Output: Address $F348 keeps the slot where the DISK-ROM is found. dskslt: ; TODO: Calculate this dynamically. ld a,$8F ; slot 3.3 ret ;-------------------------------- ; PHYDIO phydio: ; TODO: Support multiple disk ROMs. jp dskio ;-------------------------------- ; BDOS bdos: ; Note: none of the BDOS functions uses A as an input. ld a,c cp $31 jr nc,bdos_illfunc push hl ld hl,bdos_table add a,a add a,l ld l,a ld a,0 adc a,h ld h,a ld a,(hl) inc hl ld h,(hl) ld l,a ex (sp),hl ret ; jump to address from table bdos_illfunc: ; Invalid function number. ; Note: I couldn't find a specification anywhere of the proper ; behaviour in this case, so I'll return a typical error ; value. ld a,$FF ld l,a ret bdos_table: dw bdos_print ; $00 dw bdos_print ; $01 dw bdos_conout ; $02 dw bdos_print ; $03 dw bdos_print ; $04 dw bdos_print ; $05 dw bdos_print ; $06 dw bdos_print ; $07 dw bdos_print ; $08 dw bdos_strout ; $09 dw bdos_print ; $0A dw bdos_print ; $0B dw bdos_print ; $0C dw bdos_dskrst ; $0D dw bdos_print ; $0E dw bdos_print ; $0F dw bdos_print ; $10 dw bdos_print ; $11 dw bdos_print ; $12 dw bdos_print ; $13 dw bdos_print ; $14 dw bdos_print ; $15 dw bdos_print ; $16 dw bdos_print ; $17 dw bdos_print ; $18 dw bdos_curdrv ; $19 dw bdos_setdta ; $1A dw bdos_print ; $1B dw bdos_print ; $1C dw bdos_print ; $1D dw bdos_print ; $1E dw bdos_print ; $1F dw bdos_print ; $20 dw bdos_print ; $21 dw bdos_print ; $22 dw bdos_print ; $23 dw bdos_print ; $24 dw bdos_print ; $25 dw bdos_print ; $26 dw bdos_print ; $27 dw bdos_print ; $28 dw bdos_print ; $29 dw bdos_print ; $2A dw bdos_print ; $2B dw bdos_print ; $2C dw bdos_print ; $2D dw bdos_verify ; $2E dw bdos_rdabs ; $2F dw bdos_print ; $30 bdos_print: ld a,$23 ; ASCII mode out (DBG_CTRL),a ld hl,bdos_text call print_debug_asciiz ld a,c call print_debug_hexbyte ld a,$00 ; flush out (DBG_CTRL),a ret bdos_text: db "disk: BDOS ($F37D/$0005) called, function $",0 ;-------------------------------- ; BDOS $02: CONOUT ; Print character on stdout. ; TODO: Support printer echo. ; TODO: Check CTRL-C and other key combos (see function $0B in DOS2 docs). ; Input: E = character to print bdos_conout: push iy push ix ld ix,chput ld iy,(EXPTBL - 1) ld a,e call calslt pop ix pop iy ret ;-------------------------------- ; BDOS $09: STROUT ; Print string on stdout. ; Input: DE = address of string, string is terminated by "$" character bdos_strout: ld a,(de) cp '$' ret z push de ld e,a call bdos_conout pop de inc de jr bdos_strout ;-------------------------------- ; BDOS $0D: DSKRST ; Flush internal buffers and reset DTA. bdos_dskrst: ; TODO: Flush internal buffers. ; (we don't have any buffers yet) call resetdta ret ;-------------------------------- ; BDOS $19: CURDRV ; Gets the current drive. ; Output: drive (0=A) bdos_curdrv: ; TODO: Keep the current drive in a sysvar. xor a ld l,a ret ;-------------------------------- ; BDOS $1A: SETDTA ; Set Disk Transfer Area. ; Input: DE = new DTA address resetdta: ld de,$0080 bdos_setdta: ld (DTA_ADDR),de ret ;-------------------------------- ; BDOS $2E: VERIFY ; Set/reset verify flag. ; The DOS2 docs say it is optional to implement the verify feature. ; That means we will not implement it, because: ; - most people will be using C-BIOS with disk images rather than real disks ; - verification is very slow ; - verification doesn't really add a lot of protection ; Input: E = new flag state (E=0: disabled, E!=0: enabled) bdos_verify: ret ;-------------------------------- ; BDOS $2F: RDABS ; Read sectors. ; Input: DE = number of first sector to read ; L = drive (0=A) ; H = number of sectors to read ; Output: A = error code (0=OK) bdos_rdabs: ld a,l ld b,h ld c,$F9 ; TODO: Retrieve media ID from disk. ld hl,(DTA_ADDR) and a ; CF = 0 call phydio jr c,bdos_rdabs_error xor a ret bdos_rdabs_error: ; TODO: Find out how to translate PHYDIO errors to BDOS errors. inc a ret ; Input: F = NC to read, C to write ; A = Drive number (0=A:) ; B = Number of sectors to transfer ; C = Media descriptor ; DE = Logical sector number ; HL = Transfer address ;-------------------------------- include "debug.asm" ;-------------------------------- ; The purpose of this routine is having a fixed address to put breakpoints on. ; I expect that having a break point just after loading will be very useful ; when debugging the disk ROM. ds $7F00 - $,$FF dskio_done: nop ret ds $8000 - $,$FF cbios-0.25/src/font.png 0000644 0001750 0001750 00000002235 11522060650 014057 0 ustar joost joost PNG IHDR @ ϓ; PLTE ٟ RIDATx-I&8qDli1p2e@d'l,NsЬ&0&"bUX%%z6]8jwc˛_tk@\x\.UER.W3_i(t:^`//Uk}5,¼0#>*o5)H#,>%1_d'1pfX.) $N+̙#a&Qd&ɇZު*=FmȚ>[(e 'Hg)b-"w &V٫Q 4ФkYْ"X&Gd"dQT*wd/j($P{Ul|ߧ'185֛-Q DHLqk!xt臂9xe26ȇ͍wइpN;(<