;----------------------------------------------------------------------- ; OS-82/Ash Environment for SNG 1.0 ; by Vasantha Crabb ; (c) 2000 ; by Marc Plouhinec ; (c) 2004 ; ; This program approximates an OS-82 or Ash 2.0 environment under SNG. ; This allows you to run OS-82, OShell and Ash 2.0 programs and SNG ; programs on the same calculator without switching between shells (so ; you can run MarioMan without doing messy backups!). ; ; The user interface is pretty simple. First select the emulation mode ; with the [1] or [2]. Then use the up and down arrows to select a ; program, [ENTER] runs the selected program and [CLEAR] quits. When ; you run exit from an OS-82 or Ash 2.0 program, you'll return directly ; to SNG. ; ; You must load any OS-82 or Ash 2.0 programs, and any variables that ; they use _after_ you load this program. Results of not adhering to ; this rule are very unpredictable. Strange things may happen if you ; load more than 63 OS-82 or Ash 2.0 programs onto your calculator at a ; time, but they'd have to be pretty small programs to fit that many. ; ; There are, of course, a few of limitations to this emulator. You ; _must not_ hit [2nd]-[OFF] while an OS-82 or Ash 2.0 program is ; calling the ROM key handler (i.e. while you can change the contrast). ; Doing so will guarantee a SNG sooner or later. OS-82 and Ash 2.0 ; programs which turn the calculator off totally or exit directly to ; TI-OS will also cause crashes. Running this program while an ; interrupt is installed is very risky and may also crash the ; calculator if the interrupt attempts to call SNG. ;----------------------------------------------------------------------- #INCLUDE "sng10.inc" ; TI-82/SNG header .db "Jass for SNG",0 ; Program title oPROGRAM_ADDR = $8D5B ; OS-82 programs will use this aPROGRAM_ADDR = $8D94 ; Ash programs will use this VAT_END_ADDR = $8D12 ; So we can find it later PROG_COUNT = TEXT_MEM+$00 ; No. of valid programs found SELECTION = TEXT_MEM+$01 ; Currently selected program no. CUR_APP_CODE = TEXT_MEM+$02 ; Address of title of selected program PROG_TABLE = TEXT_MEM2 ; Addresses of valid programs ;----------------------------------------------- ; SafeROMCall ; Since we'll be stuffing up SNG a bit, we'll ; need this to access ROM functions. ;----------------------------------------------- #DEFINE SafeROMCall(index) call RomCall \ .db index call CR_GRBCopy ; Clear the screen ;----------------------------------- ; First job: set up ROM access for ; the ROM version we're running on. ;----------------------------------- Start: ld HL,OffsetTable ld (OffsetTableAdr-2),HL ld HL,GET_KEY ld (GET_KEY_adr-2),HL ld h,a ; Set hl to zero ld l,a ld a,($29EA) ; Check ROM version cp $3E jr z,PatchRom19006 cp '9' jr nz,PatchNow ld l,$1A ; ROM version 19.0 is unique jr PatchNow PatchRom19006: ld HL,OffsetTable19006 ld (OffsetTableAdr-2),HL ld HL,$01F3 ;Get_key_19006 ld (GET_KEY_adr-2),HL ld HL,0 PatchNow: ld (SetRomOffset+1),hl ; This is added to ROM addresses ld (aSetRomOffset+1),hl ld (aSetRomOffset_2+1),hl ;----------------------------------- ; Next task: ask user which shell to ; emulate and set status variable. ;----------------------------------- ld hl,StrAskMode ; Ask which mode to run res 1,(iy+$0D) SafeROMCall($0B) call WaitKey ; See what the user says ld hl,ModeFlag ld (hl),0 cp G_1 ; OS-82 is already set up jr z,SetupShell inc (hl) ; Try for Ash 2.0 cp G_2 ret nz ; Clear out on invalid selection ;----------------------------------- ; Third: set up the environment and ; scan for programs. ;----------------------------------- SetupShell: call FakeEnvirons ; Create fake OS-82 or Ash environment call VATScan ; Create a list of programs ld a,(PROG_COUNT) ; Check the program count or a jr nz,MainLoop ; Continue if there's at least one program ld hl,StrNoProgs ; Tell the user what's happened ld b,a ; Move to top left corner of display ld c,a set 7,(iy+$14) ; Display the string call ShowStr SafeROMCall($0F) ld hl,FakeEnvirons ; Make it so WaitKey will return to FakeEnvirons push hl ; and FakeEnvirons will return to SNG jp WaitKey ; Wait for a keystroke and exit ;----------------------------------- ; Most importantly: let user select ; the program to run. ;----------------------------------- MainLoop: call DispMenu ; Show the program menu and get a keystroke cp G_CLEAR ; Clear? jp z,FakeEnvirons ; Get out! cp G_ENTER ; Enter? jr z,RunNow ; Let's go! cp G_UP ; Up arrow? jr nz,ChkDwn ld a,(SELECTION) ; Decrement selection dec a jr z,MainLoop ; Can't go below 1 ld (SELECTION),a jr MainLoop ChkDwn: cp G_DOWN ; Down arrow? jr nz,MainLoop ld a,(PROG_COUNT) ; Can't go beyond last program ld hl,SELECTION cp (hl) jr z,MainLoop inc (hl) ; Increment selection jr MainLoop ;----------------------------------- ; Lastly: run the program. ;----------------------------------- RunNow: ld hl,FakeEnvirons ; Program will return to FakeEnvirons which will push hl ; then return to SNG ld hl,(CUR_APP_CODE) ; HL now contains address of program ld a,(ModeFlag) ; See which shell to set up for or a jr nz,RunAsh ld (oPROGRAM_ADDR),hl ; For the program's sake ld bc,0 ; Move HL to address of code call ShowStr push hl ;Si c'est la rom 19.006 ;on remplace certains appels vers la rom (c'est un peu dangereux mais c'est la seule solution) ;Attention c'est irréversible! ld hl,(OffsetTableAdr-2) ld de,OffsetTable19006 call CP_HL_DE jr z,RunRom19006 pop hl jr ClearAndRun RunAsh: dec hl ; Address of program pointer in HL ld e,(hl) dec hl ld d,(hl) ; Address of program in DE ld hl,5 ; Skip over size and header add hl,de ld (aPROGRAM_ADDR),hl ; The program will need this! push hl ;Si c'est la rom 19.006 ;on remplace certains appels vers la rom (c'est un peu dangereux mais c'est la seule solution) ;Attention c'est irréversible! ld hl,(OffsetTableAdr-2) ld de,OffsetTable19006 call CP_HL_DE jr z,RunRom19006 pop hl ClearAndRun: push hl ; Set address to call call ClearGRBuf ; Wipe graph memory ld hl,GRAPH_MEM ; Wipe text memory ld de,TEXT_MEM ld bc,128 ldir ld de,TEXT_MEM2 ld bc,128 ldir xor a ; Zero out all the registers ld b,a ld c,a ld d,a ld e,a ld h,a ld l,a push hl push hl pop ix pop af ld (CURSOR_POS),hl ; Reset cursor positions ld (CURSOR_X),hl ret ; Go! RunRom19006: ;On récupère l'adresse où se lance le programme LD HL,(oPROGRAM_ADDR) LD A,(ModeFlag) OR A JR Z,Oshell LD HL,(aPROGRAM_ADDR) Oshell: LD BC,5 SBC HL,BC ;On charge dans BC la taille du programme LD C,(HL) INC HL LD B,(HL) ChercheCALL: LD A,(HL) INC HL DEC BC CP $DC JR Z,AppelTrouve CP $FC JR Z,AppelTrouve CP $D4 JR Z,AppelTrouve CP $C4 JR Z,AppelTrouve CP $F4 JR Z,AppelTrouve CP $EC JR Z,AppelTrouve CP $E4 JR Z,AppelTrouve CP $CC JR Z,AppelTrouve CP $CD JR Z,AppelTrouve ;si BC=0 on a fini XOR A CP B JR NZ,ChercheCALL CP C JR NZ,ChercheCALL POP HL JR ClearAndRun AppelTrouve: ;On essaie de retrouvé une adresse de la rom ;D'abord on regarde si c'est un appel vers la rom INC HL LD A,(HL) DEC HL CP $40 JR NC,ChercheCALL ;maintenant on regarde si on connais cet appel LD DE,AppelsRom160 LD (SavBC),BC ChercheAdresse: LD A,(DE) OR A JR Z,AsTonFini OnAPasFini: INC DE INC DE CP (HL) JR NZ,ChercheAdresse ;ici on a déjà trouvé un bout, on vérifie si l'autre correspond INC HL LD A,(HL) LD B,A DEC HL DEC DE LD A,(DE) INC DE CP B JR NZ,ChercheAdresse ;On a trouvé l'adresse! ;On la modifie DEC DE DEC DE EX DE,HL LD BC,AppelsRom160 SBC HL,BC LD BC,AppelsRom19006 ADD HL,BC ;HL->Adresse rom 19.006 ;DE->Adresse rom 16.0 LD A,(HL) LD (DE),A INC HL INC DE LD A,(HL) LD (DE),A EX DE,HL INC HL LD BC,0 SavBC = $-2 JR ChercheCALL AsTonFini: LD BC,(SavBC) INC DE LD A,(DE) DEC DE OR A JR Z,ChercheCALL JR OnAPasFini AppelsRom160: .DW $2124 .DW $3924 .DW $07F3 .DW $01D4 .DW 0 AppelsRom19006: .DW $2269 .DW $3A87 .DW $083A .DW $01F3 StrAskMode: .db "Select Mode: " .db " 1: OS-82 1.1 " .db " 2: Ash 2.0 " .db "Any other key " .db "will exit now.",0 StrNoProgs: .db "No compatible programs!",0 ModeFlag: .block 1 ;----------------------------------------------- ; FakeEnvirons ; ; This routine sets up the OS-82 or Ash 2.0 ; entrypoint table and status block. This ; involves overwriting some of SNG, so the ; overwritten code is saved. The routine is ; written so it can also be used to restore the ; SNG code. ;----------------------------------------------- FakeEnvirons: ld hl,oBlockStart ; Set OS-82 source, destination and byte count ld de,$8D28 ld b,oBlockSize ld (iy+$05),$00 ; OS-82 programs depend on these settings ld (iy+$0D),$0C ld (iy+$14),$80 ld a,(ModeFlag) ; See what shell we're doing or a jr z,FakeLoop CALL AdapteROMCALL ld hl,aBlockStart ; Set Ash 2.0 source, destination and byte count ld e,$74 ld b,aBlockSize ld (iy+$05),$04 ; Ash programs depend on these settings, too ld (iy+$14),$00 FakeLoop: ld a,(de) ; Get data from source and destination ld c,(hl) ex de,hl ; Switch the locations of the data ld (hl),c ld (de),a ex de,hl inc hl ; Increment counters and loop inc de djnz FakeLoop ret ;----------------------------------------------- ; ClearGRBuf ; ; Fills GRAPH_MEM with zeroes. ;----------------------------------------------- ClearGRBuf: ld hl,GRAPH_MEM ld de,GRAPH_MEM+1 ld bc,(64*12)-1 ld (hl),0 ldir ret ;----------------------------------------------- ; ShowStr ; ; Display the ASCIIZ string at (HL) in menu font ; at location C,B. ;----------------------------------------------- ShowStr: ld (CURSOR_X),bc ; Set cursor location SafeROMCall($03) ; Display string ret ;----------------------------------------------- ; DispMenu ; ; Display menu of programs. First item will be ; selection and will be marked with an arrow. ; The last item will be either the last program, ; or the last one we can fit on the screen. ; After displaying the menu, WaitKey will be ; executed. ;----------------------------------------------- DispMenu: call ClearGRBuf ; Clear the graph memory set 7,(iy+$14) ; Work from graphics memory ld a,(SELECTION) ; This is the item to start from ld bc,$0004 ; Beginning cursor location dec a DispLoop: inc a ; Increment item no. counter push af ; Save item no. ld l,a ; Get item no. in HL ld h,0 add hl,hl ; Convert to offset ld de,PROG_TABLE-2 ; Address of table-2 (first item is 1, not 0) add hl,de ; (HL) contains address of title/VAT entry call LD_HL_MHL ; HL contains address of title/VAT entry inc b ; See if we're on first item dec b jr nz,NotItemOne ld (CUR_APP_CODE),hl ; Save address of code NotItemOne: ld a,(ModeFlag) ; Display Ash or OShell title or a jr z,ShowTitle dec hl ; Point HL at title length in VAT dec hl dec hl push bc ; Save cursor location ld b,(hl) ; Copy just enough bytes to get string across ld de,OP1 ; Set destination to OP1 dec hl ; Advance HL to text call BackCopy ; Un-reverse title ex de,hl ; Add a terminating zero ld (hl),0 ld hl,OP1 ; Point HL at title pop bc ; Restore cursor location ShowTitle: call ShowStr ; Display the program's title ld a,6 ; Move down a line add a,b ld b,a ld a,60 ; See if we're out of screen space cp b jr z,ExitLoop pop af ; Get item no. back ld hl,PROG_COUNT ; See if that's the last program's name cp (hl) jr nz,DispLoop push af ; Dummy stack item ExitLoop: pop af ; Kill excess stack item ld hl,0 ; Display the arrow at the top left corner ld (CURSOR_X),hl ; Move cursor ld a,$05 ; Arrow character in A SafeROMCall($02) ; M_CHARPUT SafeROMCall($0F) ; Update the display ld a,(ModeFlag) ; Restore 7,(IY+$14) or a jr z,WaitKey ; It should stay set for OS-82 res 7,(iy+$14) ;----------------------------------------------- ; WaitKey ; ; This routine holds the calculator in low ; power mode until a keystroke is received and ; returns the scancode in A. ;----------------------------------------------- WaitKey: halt ; Save power call GET_KEY ; Check keypad GET_KEY_adr: or a ; See if there was a keystroke ret nz ; Return if there was one jr WaitKey ; Otherwise loop ;----------------------------------------------- ; ChkProg ; ; See if the VAT entry in OP1-OP2 corresponds to ; a valid OS-82 or Ash program. If it does, add ; it to the database. ;----------------------------------------------- ChkProg: ld a,(OP1) ; Make sure it is a program cp $05 jr z,IsProgram cp $06 ret nz IsProgram: ld hl,(OP1+1) ; Check for OShell/Ash header inc hl ; Skip over size inc hl ld de,OSHead ; Set correct header data address ld a,(ModeFlag) or a jr z,ChkHead ld de,AshHead ChkHead: ld a,(de) cp (hl) ret nz inc hl inc de ld a,(de) cp (hl) ret nz inc hl inc de ld a,(de) cp (hl) ret nz ; If this doesn't return, we're in business! inc hl ; Get address of OShell title in DE ex de,hl push bc ; Save address of VAT entry ld hl,(PROG_COUNT) ; Get no. of programs in HL ld h,0 add hl,hl ; Convert to table address ld bc,PROG_TABLE add hl,bc pop bc ; Restore address of VAT entry ld a,(ModeFlag) ; For Ash, we store VAT entry addresses or a jr z,StoreEntry ; DE already contains address of OShell title ld d,b ld e,c StoreEntry: ld (hl),e ; Store address of title or VAT entry inc hl ld (hl),d ld hl,PROG_COUNT ; Increment no. of valid programs inc (hl) inc hl ; Set selection to 1 ld (hl),1 ret ;----------------------------------------------- ; OSHead/AshHead ; ; These bytes are placed at the beginning of ; assembly programs for identification. ;----------------------------------------------- OSHead: .db $FE,$82,$0F AshHead: .db $D9,$00,$20 ;--------------------------------------------- ; VATScan ; ; Runs through the VAT and calls ChkProg for ; every variable encountered. ;--------------------------------------------- VATScan: ld hl,VAT_START ; Start at the beginning of the VAT VATScanLoop: ld a,(hl) ; Check the variable type and $1F cp $05 ; Programs need different handling jr z,VATScanProg ld b,$06 cp b jr nz,VATScanCont VATScanProg: push hl ; Save HL dec hl ; Get the size of the VAT entry in B dec hl dec hl ld a,(hl) ; A will contain the name length add a,4 ; Add the size of standard info ld b,a pop hl ; Restore HL VATScanCont: push hl ; Save address of VAT entry for ChkProg ld de,OP1 ; This is where we'll put the VAT entry call BackCopy ; Reverse the VAT entry into OP1/OP2 pop bc ; VAT entry address in BC push hl ; Save address of next VAT entry call ChkProg ; Check out this variable pop hl ; Restore address of next entry ld de,(VAT_END_ADDR) ; Check for end of VAT call CP_HL_DE ret c ret z jr VATScanLoop ;----------------------------------------------- ; BackCopy ; ; This routine copies B bytes from (HL) to (DE), ; incrementing DE and decrementing HL. Used for ; reversing VAT entries. ;----------------------------------------------- BackCopy: ld a,(hl) ; Copy a byte ld (de),a dec hl ; Source moves back inc de ; Destination moves forward djnz BackCopy ; Loop ret ; Return ;--------------------------------------------------------------- ; The next few routines are used by OS-82 programs to perform ; basic flow control operations. Since OS-82 programs aren't ; relocated, they need another method for calling and making ; 16-bit jumps. The routines here accomodate for this. There ; is also a table-based ROM call routine. This is used to ; access ROM functions in the same way as the SNG ROM_CALL ; macro is used. The vector table approach allowed OS-82 to ; run on ROM version 7*, wheras SNG never will be able to. ;--------------------------------------------------------------- ;----------------------------------------------- ; RomCall ; ; Version independant ROM call using table of ; addresses. On entry, ((SP)) will contain the ; index of the desired routine address in the ; vector table. An offset is added for ROM ; version 19.0. ;----------------------------------------------- RomCall: ld (SaveHLRom+1),hl ; Save HL pop hl ; Correct return address inc hl push hl dec hl ; Address of index byte in HL push de ; Save DE ld e,(hl) ; Get index in DE ld d,0 ex de,hl ; Double index to get offset into table add hl,hl ld de,OffsetTable ; Add to table base address OffsetTableAdr: add hl,de ld e,(hl) ; Extract value from table inc hl ld d,(hl) SetRomOffset: ld hl,$001A ; Offset for ROM version 19.0 add hl,de ; Add offset pop de ; Restore DE push hl ; Fake return address SaveHLRom: ld hl,0 ; Restore HL ret ; Jump to code ;----------------------------------------------- ; OffsetTable ; ; Addresses of ROM functions in ROM versions ; 16.0, 17.0 and 18.0 used by RomCall. ;----------------------------------------------- OffsetTable: .dw $39EC-$1A ; TX_CHARPUT .dw $3758-$1A ; D_LT_STR .dw $37E8-$1A ; M_CHARPUT .dw $37EE-$1A ; D_ZM_STR .dw $37F4-$1A ; D_LM_STR - not in TI-82.h .dw $37E2-$1A ; GET_T_CUR - not in TI-82.h .dw $37A0-$1A ; SCROLL_UP .dw $3752-$1A ; TR_CHARPUT .dw $3890-$1A ; CLEARLCD .dw $3896-$1A ; D_HL_DECI .dw $38E4-$1A ; CLEARTEXT .dw $3914-$1A ; D_ZT_STR .dw $3932-$1A ; BUSY_OFF .dw $394A-$1A ; BUSY_ON .dw $393E-$1A ; _GETKEY .dw $38C6-$1A ; _GRBUFCPY_V OffsetTable19006: .dw $39EC-$1A+$163 ; TX_CHARPUT .dw $3758-$1A+$145 ; D_LT_STR .dw $37E8-$1A+$139 ; M_CHARPUT .dw $37EE-$1A+$139 ; D_ZM_STR .dw $37F4-$1A+$139 ; D_LM_STR - not in TI-82.h .dw $37E2-$1A+$139 ; GET_T_CUR - not in TI-82.h .dw $37A0-$1A+$145 ; SCROLL_UP .dw $3752-$1A+$145 ; TR_CHARPUT .dw $3890-$1A+$1E7 ; CLEARLCD .dw $3896-$1A+$133 ; D_HL_DECI .dw $38E4-$1A+$127 ; CLEARTEXT .dw $3914-$1A+$133 ; D_ZT_STR .dw $3932-$1A+$157 ; BUSY_OFF .dw $394A-$1A+$163 ; BUSY_ON .dw $393E-$1A+$163 ; _GETKEY .dw $38C6-$1A+$133 ; _GRBUFCPY_V ;----------------------------------------------- ; RelativeCall ; ; Call relative to (oPROGRAM_ADDR). On entry, ; ((SP)) will hold a reslative address to call. ;----------------------------------------------- CallNow: ld (SaveHLCall+1),hl ; Save HL pop hl ; Increment return address by two push hl inc hl inc hl ex (sp),hl ; Address of offset value in HL push hl ; Place previous HL on stack SaveHLCall: ld hl,0 ex (sp),hl push de ; Save DE ld e,(hl) ; Get offset in DE inc hl ld d,(hl) ld hl,(oPROGRAM_ADDR) ; Add to program address add hl,de pop de ; Restore DE ex (sp),hl ; Restore original HL/fake return address ret ; Jump to routine ;----------------------------------------------- ; RelativeJump ; ; Jump relative to (oPROGRAM_ADDR) with a 16-bit ; offset. ;----------------------------------------------- JumpNow: ex (sp),hl ; Save HL/get address of offset value push de ; Save DE ld e,(hl) ; Get offset value in DE inc hl ld d,(hl) ld hl,(oPROGRAM_ADDR) ; Add to program address add hl,de pop de ; Restore DE ex (sp),hl ; Restore HL/fake return address ret ; Jump to code ;----------------------------------------------- ; ; RomCall de SNG ; ;----------------------------------------------- AdapteROMCALL: LD A,($29D0) ;pour rom |16.0:36| |17.0:37| |18.0:38| |19.0:6D| |19.006:18| CP $18 JR Z,nouv_rom LD HL,ROM_CALL_anciennes_rom JR adapte_rom_cont nouv_rom: LD HL,ROM_CALL_nouvelles_rom adapte_rom_cont: LD (ROM_CALLS),HL RET ROM_CALL_nouvelles_rom: ;ROM_CALL(adresse) = CALL $8D74 \ .DW adresse LD (ROM_CALLan1),A ;On sauve A LD (ROM_CALLan3),DE ;On sauve DE LD (ROM_CALLan4),BC ;On sauve BC LD (ROM_CALLan5),HL ;On sauve HL EX (SP),HL ; LD E,(HL) ; INC HL ; Met dans DE l'adresse à appeller LD D,(HL) ; INC HL ; EX (SP),HL ; LD A,$FF LD HL,rom_call_zones-1 JR modif_appel modif_appel0: EX DE,HL modif_appel: INC A INC HL LD C,(HL) INC HL LD B,(HL) EX DE,HL CALL CP_HL_BC JR NC,modif_appel0 EX DE,HL SLA A LD H,0 LD L,A LD BC,rom_call_diff ADD HL,BC LD A,(HL) INC HL LD H,(HL) LD L,A ADD HL,DE PUSH HL LD BC,0 ROM_CALLan4 = $-2 LD DE,0 ROM_CALLan3 = $-2 LD A,0 ROM_CALLan1 = $-1 LD HL,0 ROM_CALLan5 = $-2 RET ;Constantes: ;----------- ;indispensable pour adapter les appels à la rom 19.006 rom_call_diff: .DW 0 .DW 0 .DW $1F .DW $51 .DW $52 .DW $53 .DW $9B .DW $46 .DW $57 .DW $221 .DW $53 .DW $FFCE ;-32 .DW $43 .DW $47 .DW $12B .DW $12C .DW $12E .DW $12F .DW $13F .DW $142 .DW $145 .DW $143 .DW $144 .DW $160 .DW $166 .DW $13C .DW $15D .DW $157 .DW $14B .DW $145 .DW $13F .DW $139 .DW $133 .DW $13F .DW $127 .DW $133 .DW $157 .DW $163 .DW $163 rom_call_zones: .DW $0008 .DW $0103 .DW $021d .DW $0272 .DW $027E .DW $059D .DW $05AD .DW $05F2 .DW $061E .DW $0625 .DW $066A .DW $067A .DW $0684 .DW $07F8 .DW $0A0D .DW $0FCE .DW $0FD0 .DW $0FD5 .DW $0FF9 .DW $1005 .DW $29D6 .DW $2E1C .DW $2E22 .DW $2E37 .DW $2E3C .DW $2E46 .DW $31E1 .DW $3249 .DW $32DF .DW $37B3 .DW $37C5 .DW $3878 .DW $38BB .DW $38C7 .DW $38D0 .DW $390F .DW $3924 .DW $4000 ;----------------------------------------------- ; ROM_CALL_anciennes_rom ; ; Version independant ROM routine access for Ash ; programs. THis behaves just like the SNG ; ROM_CALL macro. ;----------------------------------------------- ROM_CALL_anciennes_rom: ld (aSaveHLRom_2+1),hl ; Save HL pop hl ; Correct return address push hl inc hl inc hl ex (sp),hl ; Address of ROM offset in HL push de ; Save DE ld e,(hl) ; Get offset in DE inc hl ld d,(hl) aSetRomOffset_2: ld hl,$001A ; Offset for ROM version 19.0 add hl,de ; Correct address for ROM version 19.0 pop de ; restore DE push hl ; Fake return address aSaveHLRom_2: ld hl,0 ; Restore HL ret ; Jump to ROM routine ;--------------------------------------------------------------- ; The following code is written over the top of a portion of ; SNG to simulate an OS-82 environment for the software to run ; in. The code dispatches calls to OS-82 to appropriate ; handlers in this program. The original SNG code is restored ; on quitting the OS-82 program. ;--------------------------------------------------------------- oBlockStart: oBlockBase = $8D28 - oBlockStart oRomCall: ; Version-independant access to ROM routines jp RomCall oCallZ: ; Relative CALL routines jp nz,aFallThrough oCall: jp CallNow oCallNZ: jp z,aFallThrough jp CallNow oCallC: jp nc,aFallThrough jp CallNow oCallNC: jp c,aFallThrough jp CallNow oJumpZ: ; Long-range relative jump routines jp nz,aFallThrough oJump: jp JumpNow oJumpNZ: jp z,aFallThrough jp JumpNow oJumpC: jp nc,aFallThrough jp JumpNow oJumpNC: jp c,aFallThrough jp JumpNow oProgramAddr: ; Contains address of current program .block 2 oOSVer: ; Status block (contains OS-82 version numbers) .db $30 oOSBits: .db 0 oOS82Ver: .db $11 oBlockEnd: oBlockSize = oBlockEnd-oBlockStart ;--------------------------------------------------------------- ; The following scraps of code ensure that the fake environment ; creation will work properly. They ensure the data to be ; written is less than 256 bytes long and report the actual ; size. An assembly error is generated if the criteria are not ; met (using the .error pseudo-directive). ;--------------------------------------------------------------- #IF oBlockSize > 255 .error .echo "Dummy OS-82 environment is too large!\n" .echo "Remove " .echo oBlockSize - 255 .echo " bytes\n" #ELSE .echo oBlockSize .echo " bytes of SNG overwritten for OS-82 1.1.\n" #ENDIF ;--------------------------------------------------------------- ; The following code sets up the entry points for an Ash 2.0 ; environment. It works more or less like OS-82, except that it ; uses a SNG-style ROM calling routine. ;--------------------------------------------------------------- aBlockStart: aBlockBase = $8D74 - aBlockStart rCallZ: jr nz,aFallThrough aCall: jr aCallNow aCallNZ: jr z,aFallThrough jr aCallNow aCallC: jr nc,aFallThrough jr aCallNow aCallNC: jr c,aFallThrough jr aCallNow aJumpZ: jr nz,aFallThrough aJump: jr aJumpNow aJumpNZ: jr z,aFallThrough jr aJumpNow aJumpC: jr nc,aFallThrough jr aJumpNow aJumpNC: jr c,aFallThrough jr aJumpNow aProgramAddr: .block 2 ;----------------------------------------------- ; aRomCall ; ; Version independant ROM routine access for Ash ; programs. THis behaves just like the CrASH ; ROM_CALL macro. ; ; 16/07/2004: Cette fonction est "court-circuitée" ; par le jp $0000, le reste n'est pas effacé ; pour ne pas modifié les adresses. ; ;----------------------------------------------- aRomCall: ROM_CALLS = $+1 jp $0000 ; ld (aSaveHLRom+aBlockBase+1),hl ; Save HL pop hl ; Correct return address push hl inc hl inc hl ex (sp),hl ; Address of ROM offset in HL push de ; Save DE ld e,(hl) ; Get offset in DE inc hl ld d,(hl) aSetRomOffset: ld hl,$001A ; Offset for ROM version 19.0 add hl,de ; Correct address for ROM version 19.0 pop de ; restore DE push hl ; Fake return address aSaveHLRom: ld hl,0 ; Restore HL ret ; Jump to ROM routine ;----------------------------------------------- ; aFallThrough ; ; Return correctly from a conditional call or ; jump which falls through. ;----------------------------------------------- aFallThrough: ex (sp),hl inc hl inc hl ex (sp),hl ret ;----------------------------------------------- ; aCallNow ; ; Call relative to (aPROGRAM_ADDR). Used to ; call subroutines which are not fixed in RAM. ;----------------------------------------------- aCallNow: ld (aSaveHLCall+aBlockBase+1),hl ; Save HL pop hl ; Increment return address by two push hl inc hl inc hl ex (sp),hl ; Address of offset value in HL push hl ; Place previous hl on stack aSaveHLCall: ld hl,0 ex (sp),hl push de ; Save DE ld e,(hl) ; Get offset in DE inc hl ld d,(hl) ld hl,(aPROGRAM_ADDR) ; Add to program address add hl,de pop de ; Restore DE ex (sp),hl ; Restore original HL/fake return address ret ; Jump to routine ;----------------------------------------------- ; aJumpNow ; ; Jump relative to (aPROGRAM_ADDR) using a ; 16-bit offset to overcome the limitations of ; normal relative jumps. ;----------------------------------------------- aJumpNow: ex (sp),hl ; Save HL/get address of offset value push de ; Save DE ld e,(hl) ; Get offset value in DE inc hl ld d,(hl) ld hl,(aPROGRAM_ADDR) ; Add to program address add hl,de pop de ; Restore DE ex (sp),hl ; Restore HL/fake return address ret ; Jump to code aBlockEnd: aBlockSize = aBlockEnd-aBlockStart ;--------------------------------------------------------------- ; As with OS-82, checks are needed to ensure the environment is ; small enough to be loaded with a DJNZ loop... ;---------------------------------------------------------------- #IF aBlockSize > 255 .error .echo "Dummy Ash environment is too large!\n" .echo "Remove " .echo aBlockSize - 255 .echo " bytes\n" #ELSE .echo aBlockSize .echo " bytes of SNG overwritten for Ash 2.0.\n" #ENDIF