DEFINE PAGE00, SPACE=ROM SEGMENT PAGE00 include "includes\os2.inc" include "includes\internal.inc" PUBLIC LdHLInd,BCALLRoutine,CheckForBootLoader,OS2Marker,AppInit,JForceCmdNoChar,JForceCmd EXTERN PutS,PutC,ifastcopy,CallUSBActivityHook,CheckLowBatteriesTurnOff,SaveOScreen EXTERN RunLinkActivityHook,HandleLinkKeyActivity,ResetStacks,LCD_DRIVERON,NZIf84PlusSeries EXTERN _APP_PUSH_ERRORH,_APP_POP_ERRORH,FindSym,PushRealO1,Mov9ToOP1,FPAdd,OP1ToOP2,LCDDelay EXTERN Placeholder005Fh,Placeholder0006h,Placeholder004Eh,Placeholder0003h,Placeholder0035h EXTERN outputPage,NZIf83Plus,_ZERO_PORT_3,_OUT_PORT_3,AnimateRunIndicator,PowerOff,clrTR EXTERN DispHexA,DispHexHL,IPutC,ReadKeyboardKey,ReadKeypad,ClrLCDFull,InitHomescreenContext EXTERN curBlink,resetAPDTimer,UpdateAPD,BCALL,BJUMP,CopyRAMToFlashPage,cphlde,CalculateOSChecksum EXTERN _HandleDefaultUSBInterrupt,_ReadUSBInterruptData,_HandleUSBInterruptInitialize,CopyToRAMPage EXTERN _HandleUSBACablePluggedIn,_HandleUSBACableUnplugged,_HandleUSBBCablePluggedIn,_HandleUSBBCableUnplugged EXTERN GetHexA,GetHexHL,CursorOff,RunIndicOn,SetFastSpeed,CanAlph,homescreenContextVectors,SetContrast,_PULLDOWNCHK EXTERN savepartialWin,VPutS,VPutSCenter ;0000h: boot: jp JumpToBootCode ;0003h: jp Placeholder0003h ;0006h: jr Placeholder0006h_1 ;0008h: jp OP1ToOP2 ;000Bh: jp LCDDelay ;000Eh: ;I'm not sure what this is for yet. nop ret ;0010h: jp FindSym ;0013h: ;This is "bit 4,(iy+02h) \ ret", but I'm not sure that anything external actually knows of this. nop nop nop nop ret ;0018h: jp PushRealO1 ;001Bh: ;This is "call _RecAByteIO \ nop \ ret", but I'm not sure anything external actually knows of this. nop nop nop nop ret ;0020h: jp Mov9ToOP1 ;0023h: ;This is "call _SendAByte \ nop \ ret", but I'm not sure anything external actually knows of this. nop nop nop nop ret ;0028h: jp BCALL ;002Bh: ;This is "sub a \ ld (basic_prog+1),a \ ret", but I'm not sure anything external actually knows of this. nop nop nop nop ret ;0030h: jp FPAdd ;0033h: jr LdHLInd ;0035h: jp Placeholder0035h ;0038h: jr handleUSBEvents ;003Ah: resumeInterruptHandler: in a,(interruptStatusPort) bit INT_TRIGGER_TIMER1,a jp nz,firstCrystalTimerExpired bit INT_TRIGGER_TIMER2,a jp nz,secondCrystalTimerExpired bit INT_TRIGGER_TIMER3,a jp nz,thirdCrystalTimerExpired jp continueInterruptHandler ;004Eh: jr Placeholder004Eh_1 ;0050h: jp BJUMP ;0053h: jp BootCalculator ;0056h: DB 0FFh,0A5h ;0058h: DB 0FFh ;0059h: jp _APP_PUSH_ERRORH ;005Ch: jp _APP_POP_ERRORH ;005Fh: jp Placeholder005Fh ;I don't think anything external depends on 0062h-006Ah. ;0062h: DB 23h,0Fh ;penCol coordinates for displaying OS version ;0064h: DB OS2_VERSION_STRING OS2Marker: DB 0 ;I have this set as 0, any other TI-OS version will have it set as a space DB 0 ;This is a crude check, and hopefully temporary. Placeholder0006h_1: jp Placeholder0006h Placeholder004Eh_1: jp Placeholder004Eh LdHLInd: ld a,(hl) inc hl ld h,(hl) ld l,a ret ;0075h: ;This is used as the hard-coded return point for BCALL/BJUMP routines. ex (sp),hl push af ld a,l out (6),a pop af pop hl ret ;This routine is no longer at 006Ah, but most programs shouldn't care at all. handleUSBEvents: ex af,af' exx call NZIf84PlusSeries jr z,resumeInterruptHandler in a,(usbStatusPort) xor 0FFh and 1Fh jr z,resumeInterruptHandler bit USBActivityHookEnabled,(iy+hookFlags4) jr z,$F ld b,2Ch ld c,a call CallUSBActivityHook jr z,interruptReturnA $$: in a,(usbEventPort) ld b,a or a jr z,noUSBEvents bit onRunning,(iy+onFlags) jr z,linkActivityDetectedTurnOn ;turn on the calculator because we have link stuff going on in a,(7) cp 81h jr nz,linkActivityDetectedTurnOn ld a,b bit 4,a jr nz,AcablePluggedIn bit 5,a jr nz,AcableUnplugged bit 6,a jr nz,BcablePluggedIn bit 7,a jr nz,BcableUnplugged bit 1,a jr nz,usbInitializeDetected noUSBEvents: in a,(55h) ld b,a and 11h xor 11h jr z,resumeInterruptHandler in a,(7) cp 81h jr nz,linkActivityDetectedTurnOn ;turn on the calculator because we have link stuff going on bit 4,b jr z,readUSBData ;Handle default USB interrupt, I guess call _HandleDefaultUSBInterrupt jr $F readUSBData: call _ReadUSBInterruptData $$: bit onRunning,(iy+onFlags) jr z,linkActivityDetectedTurnOn jr interruptReturnA AcablePluggedIn: call _HandleUSBACablePluggedIn jr interruptReturnA AcableUnplugged: call _HandleUSBACableUnplugged jr interruptReturnA BcablePluggedIn: call _HandleUSBBCablePluggedIn jr interruptReturnA BcableUnplugged: call _HandleUSBBCableUnplugged jr interruptReturnA usbInitializeDetected: call _HandleUSBInterruptInitialize jr interruptReturnA continueInterruptHandler: bit INT_TRIGGER_HW2,a jr nz,secondHardwareTimerTriggered bit INT_TRIGGER_LINK,a jr nz,linkActivityDetectedTurnOn rra jr c,onKeyPressed rra jr c,firstHardwareTimerTriggered jr interruptReturnStandard interruptReturnA: push af ld a,INTERRUPT_MASK_POWER ;keep calculator powered at least out (interruptEnPort),a pop af out (interruptEnPort),a interruptReturnStandard: ld a,iNormal bit enableHW2Timer,(iy+interruptFlags) jr z,interruptDirectReturnA interruptReturnEnableTimer2: or INTERRUPT_MASK_HW2 ;enable hardware timer 2 interruptDirectReturnA: out (interruptEnPort),a ex af,af' exx ei ret ;i secondHardwareTimerTriggered: ;This only fires when enableHW2Timer,(iy+interruptFlags) is set, and that's only done by _getKey. ld a,INTERRUPT_MASK_HW2 bit enableHW2Timer,(iy+interruptFlags) jr z,interruptReturnA ld a,(iy+interruptFlags) xor skipHW2Timer ;toggles skipHW2Timer bit ld (iy+interruptFlags),a bit skipHW2Timer,(iy+interruptFlags) jr nz,shtt1 ;Set the battery state set batteriesGood,(iy+interruptFlags) in a,(statusPort) bit statusBatteriesGood,a jr nz,$F res batteriesGood,(iy+interruptFlags) $$: ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a res hw2TimerSkipped,(iy+linkKeyFlags) res enableHW2Timer,(iy+interruptFlags) ;disable HW2 timer, we're done set intBattCheckComplete,(iy+scriptFlag) ld a,INTERRUPT_MASK_POWER+INTERRUPT_MASK_ON jr interruptReturnA shtt1: set hw2TimerSkipped,(iy+linkKeyFlags) ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a ;Why we do this again, I'm not sure. ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a ld a,INTERRUPT_MASK_POWER+INTERRUPT_MASK_ON push af ld a,INTERRUPT_MASK_POWER out (interruptEnPort),a pop af out (interruptEnPort),a jr interruptReturnEnableTimer2 firstCrystalTimerExpired: secondCrystalTimerExpired: thirdCrystalTimerExpired: ;I'm not using these, so any interrupts generated by them should just be acknowledged and forgotten. xor a out (31h),a out (34h),a out (37h),a jr interruptReturnStandard firstHardwareTimerTriggered: res intBattCheckComplete,(iy+scriptFlag) res hw2TimerSkipped,(iy+linkKeyFlags) bit enableHW2Timer,(iy+interruptFlags) jr z,$F bit turnOffIfLowBatteriesFound,(iy+batteryCheckFlags) call nz,CheckLowBatteriesTurnOff set turnOffIfLowBatteriesFound,(iy+batteryCheckFlags) $$: ld a,(laTimer) or a jr z,$F dec a ld (laTimer),a $$: bit indicRun,(iy+indicFlags) call nz,AnimateRunIndicator bit indicOnly,(iy+indicFlags) jr nz,interruptReturnOn call ReadKeyboardKey bit curAble,(iy+curFlags) call nz,curBlink call UpdateAPD ;Deal with link activity hook bit LinkActivityHookEnabled,(iy+scriptFlag) jr z,interruptReturnOn bit ignoreBPLink,(iy+scriptFlag) jr nz,interruptReturnOn call NZIf83Plus jr z,$F in a,(bport) and D0D1_bits cp D0LD1L call nz,RunLinkActivityHook jr interruptReturnOn $$: in a,(laStatusPort) and 00011000b ;receiving/received data? jr z,interruptReturnOn ld a,80h out (laEnPort),a xor a out (laEnPort),a set linkAssistEnabled,(iy+linkAssistFlags) call RunLinkActivityHook interruptReturnOn: ld a,INTERRUPT_MASK_POWER+INTERRUPT_MASK_ON jr interruptReturnA linkActivityDetectedTurnOn: res shift2nd,(iy+shiftFlags) push hl sub a push af ld a,INTERRUPT_MASK_POWER out (interruptEnPort),a pop af out (interruptEnPort),a ;Turn ourselves on if we're not already jr handleWokenUp onKeyPressed: call HandleOnKeyPress ;If we managed to return from HandleOnKeyPress, we're on and just happened to press ON ;So enable only the first hardware timer and march onward res skipHW2Timer,(iy+interruptFlags) ld a,INTERRUPT_MASK_POWER+INTERRUPT_MASK_HW1 ;+INTERRUPT_MASK_ON jr interruptReturnA HandleOnKeyPress: ;We either just started holding down the key or we just released it, find out what to do in a,(statusPort) and STATUS_NON_83P_MASK jr z,$F ld a,(speedPort) ld e,a xor a out (speedPort),a $$: ld b,0 debounceOnLoop: ld hl,1016h ;hard-coded debounce delay at 6MHz $$: in a,(interruptStatusPort) and INT_STATUS_ON_MASK cp b ld b,a jr nz,debounceOnLoop dec hl ld a,l or h jr nz,$B cp b jr z,handleKeyOn ;We just released ON, either boot or return in a,(memPageBPort) ld b,a in a,(statusPort) and STATUS_NON_83P_MASK jr z,$F ld a,e out (speedPort),a ld a,b cp 81h jr dol1 $$: ld a,b and 4Fh cp 41h dol1: jr nz,WaitForStart bit onRunning,(iy+onFlags) ret nz pop hl call _ZERO_PORT_3 ld a,11h jr interruptDirectReturnA handleKeyOn: ;We're pressing down ON, so either turn on or do nothing in a,(statusPort) and STATUS_NON_83P_MASK jr z,handleWokenUp ld a,e out (speedPort),a handleWokenUp: ;Either link activity was detected or we pressed ON, so either boot or do pretty much nothing ; depending on our on/off status (RAM page swapped in, onRunning,(iy+onFlags), etc.) ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a in a,(statusPort) and STATUS_NON_83P_MASK jr z,$F in a,(memPageBPort) cp 81h jr dol2 $$: in a,(memPageBPort) and 4Fh cp 41h dol2: jr nz,RAMUnhookedTurnCalculatorOn bit shift2nd,(iy+shiftFlags) jr z,_2ndNotPressedWithOn bit echoKeyRemotely,(iy+scriptFlag) jr nz,$F bit returnOffKey,(iy+getKeyFlags) jr z,PowerOff $$: set kOffPressed,(iy+getKeyFlags) ret _2ndNotPressedWithOn: ;We're (probably) turned on and we just happened to press ON res turnOffIfLowBatteriesFound,(iy+batteryCheckFlags) call resetAPDTimer bit onRunning,(iy+onFlags) jr z,TurnCalculatorOn set onInterrupt,(iy+onFlags) ret JumpToBootCode: in a,(statusPort) and STATUS_NON_83P_MASK ld a,1Fh jr z,$F ld a,3 out (0Eh),a ;not sure yet ld a,7Fh $$: out (memPageAPort),a ld a,7 out (4),a ld hl,812Ch in a,(statusPort) and STATUS_84P_SERIES_MASK jr nz,$F ld hl,80D5h $$: jp (hl) xor a BootCalculator: di ;Basic port outputs ld a,lcd8BitMode call LCDDelay out (LCDinstPort),a ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a ld a,INTERRUPT_MASK_LINK+INTERRUPT_MASK_ON out (interruptEnPort),a ld a,lcdXAutoIncrementMode call LCDDelay out (LCDinstPort),a ;Set up RAM pages call NZIf83Plus jr nz,$F xor a out (memPageCPort),a $$: ld a,81h out (memPageBPort),a ;Set up RAM pointers ld sp,0FFC5h ld iy,flags ;Do any other initialization ;Appear "off" xor a out (memPageBPort),a WaitForStart: ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a call _ZERO_PORT_3 ld a,INTERRUPT_MASK_LINK+INTERRUPT_MASK_ON out (interruptEnPort),a ei halt RAMUnhookedTurnCalculatorOn: ;Set everything back up ld a,STATE_MODE0_DEFAULT out (interruptStatusPort),a ld a,41h call NZIf83Plus jr nz,$F ld a,81h $$: out (memPageBPort),a call NZIf83Plus jr nz,$F ld a,1 out (speedPort),a xor a ;Still not really sure what this is about out (0Fh),a $$: call _ZERO_PORT_3 call SetContrast ld a,INTERRUPT_MASK_POWER+INTERRUPT_MASK_HW1+INTERRUPT_MASK_ON out (interruptEnPort),a res receiveTIOS,(iy+linkFlags2) ;Start the OS, minimal as it is ld hl,(RAMChecksum) ld de,0A55Ah call cphlde jr z,$F call CalculateOSChecksum ld de,(RAMChecksum) call cphlde jr z,$F ;The RAM checksum check has failed, so wipe out RAM and hope for the best ;TODO: figure out what this actually needs to do ld hl,appData ld de,appData+1 ld bc,7FFFh ld (hl),0 ldir ld hl,0109h ;English ld (localLanguage),hl ld sp,0FFF7h ld a,17h ;default contrast level ld (contrast),a call LCD_DRIVERON ld hl,0800h ld (winTop),hl set appTextSave,(iy+appFlags) B_CALL ClrScrnFull ld hl,userMem ld (tempMem),hl ld (fpBase),hl ld (FPS),hl ld (newDataPtr),hl ld hl,symTable ld (pTemp),hl ld (OPBase),hl ld (OPS),hl ld (progPtr),hl ld hl,lcdTallP ld (hl),64 inc hl ld (hl),96 inc hl ld (hl),95 inc hl ld (hl),94 ld hl,_monErrorHandler call APP_PUSH_ERRORH ld (onSP),sp call LCD_DRIVERON set onRunning,(iy+onFlags) res indicOnly,(iy+indicFlags) res textInverse,(iy+textFlags) res textInsMode,(iy+textFlags) set indicRun,(iy+indicFlags) set curAble,(iy+curFlags) set apdAble,(iy+apdFlags) set apdRunning,(iy+apdFlags) set batteriesGood,(iy+interruptFlags) xor a ld (menuCurrent),a ld a,appStart call _newContext0 call ResetStacks ld hl,0205h ld (curRow),hl res appTextSave,(iy+appFlags) call DisplayOS2Version ld hl,sRAMCleared call PutS ld hl,0 ld (penCol),hl ld hl,0 ld (curRow),hl set appTextSave,(iy+appFlags) call savepartialWin B_CALL GetKey push af B_CALL ClrLCDFull pop af jr _monForceKey $$: ;Screw up the RAM checksum so it's no longer valid ld de,(RAMChecksum) dec de ld (RAMChecksum),de TurnCalculatorOn: call LCD_DRIVERON set onRunning,(iy+onFlags) res indicOnly,(iy+indicFlags) in a,(statusPort) and STATUS_NON_83P_MASK jr z,$F ;no dual booting for you! call ReadKeypad cp skGraphvar call z,StartBootLoader $$: set indicRun,(iy+indicFlags) set curAble,(iy+curFlags) set apdAble,(iy+apdFlags) set apdRunning,(iy+apdFlags) xor a ld (menuCurrent),a ld a,appStart call _newContext0 call ResetStacks set appTextSave,(iy+appFlags) call savepartialWin RestartMon: _Mon: xor a ld (kbdKey),a ld (keyExtend),a B_CALL GetKey _monForceKey: ld (kbdKey),a cp kQuit jr z,doContextSwitch push af call CursorOff call RunIndicOn pop af call _PULLDOWNCHK jr c,RestartMon call clrTR jr c,RestartMon call CallcxMain jr _Mon doContextSwitch: call _newContext0 jr RestartMon JForceCmdNoChar: xor a JForceCmd: ld sp,(onSP) ld a,appStart call _newContext0 jr _Mon sRAMCleared: DB "RAM cleared",0 DisplayOS2Version: ld a,7 ld (penRow),a ld hl,sOS2Ver1 call VPutSCenter ld a,15 ld (penRow),a ld hl,sOS2Ver2 jr VPutSCenter sOS2Ver1: DB "OS2 v",OS2_VERSION_STRING,0 sOS2Ver2: DB "Build ",OS2_VERSION_BUILD_STR,0 CallcxMain: push hl ld hl,(cxMain) push af ld a,(cxPage) out (6),a pop af call jumpToHL pop hl ret jumpToHL: jp (hl) _monErrorHandler: ld hl,_monErrorHandler call APP_PUSH_ERRORH ld a,kError call _newContext0 jr _Mon _newContext: ld c,a sub a ld (kbdKey),a ld b,a in a,(6) push af ld a,c call _newContext0 pop af out (memPageAPort),a ret _newContext0: ld hl,cxCurApp cp (hl) jr nz,differentContext cp kGraph jr nz,$F push bc call _GRPUTAWAY pop bc ret $$: cp appStart jr z,differentContext ld b,kApp ret differentContext: ld b,a in a,(memPageAPort) push af ld a,b push bc push af sub appStart call GetContextStartRoutine out (memPageAPort),a pop af push hl push af res curLock,(iy+curFlags) ; call CallcxPPutAwayRoutine pop af push af ; call CallcxPutAwayRoutine call IsExternalApp call z,SetFastSpeed ld a,(cxCurApp) pop bc push af push bc ld hl,cxMain ld de,cxPrev ld bc,14 ldir ld a,(flags+appFlags) ld (de),a pop af push af pop af pop bc pop hl ld (cxCurApp),a pop af ;Call context start routine push af call jumpToHL pop bc pop af out (memPageAPort),a ret AppInit: ld de,cxMain ld bc,12 ldir ld a,(hl) ld (flags+appFlags),a in a,(6) ld (cxPage),a ret _GRPUTAWAY: ;TODO: come back to this ret IsExternalApp: ld b,a ld a,(cxCurApp) cp 58h ld a,b ret CallcxPPutAwayRoutine: push hl ld hl,(cxPPutAway) call CallMonRoutine jr $F CallcxPutAwayRoutine: push hl ld hl,(cxPutAway) call CallMonRoutine xor a ld (parseVar+1),a $$: pop hl jr CanAlph CallMonRoutine: in a,(memPageAPort) push af ld a,(cxPage) out (memPageAPort),a call jumpToHL pop af out (memPageAPort),a ret GetContextStartRoutine: ld hl,contextStartTable ld d,0 ld e,a add hl,de add hl,de add hl,de ld e,(hl) inc hl ld d,(hl) inc hl ld a,(hl) ex de,hl ret contextStartTable: DW InitHomescreenContext DB 00h CheckForBootLoader: ;Check if skGraphvar is being pressed ld a,0FFh out (1),a nop nop nop ld a,0EFh out (1),a nop nop nop in a,(1) bit 7,a ld a,0FFh out (1),a jr z,StartBootLoader ;Just boot normally ld hl,(3FFEh) jp (hl) StartBootLoader: ;This is called in two places: during OS2 boot (we're on page 0) ; while on page 70h and we're temporarily swapped in ;We need to put a loader in RAM and call that, which might return and we're good, or it'll switch OSes. ld a,81h out (memPageBPort),a xor a out (memPageCPort),a ld a,(OS2Marker) or a ld hl,BootLoader jr z,$F ld hl,BootLoader+4000h $$: ld de,userMem ld bc,BootLoaderEnd-BootLoader ldir jp userMem BootLoader: B_CALL LCD_DRIVERON res indicOnly,(iy+indicFlags) res curAble,(iy+curFlags) B_CALL ClrLCDFull ld hl,0 ld (curRow),hl ld hl,sBoot-BootLoader+userMem B_CALL PutS ld hl,2 ld (curRow),hl call DoesSecondOSExist-BootLoader+userMem jp z,ReceiveTIOS-BootLoader+userMem ;We have the TI-OS, decide to make the switch or not $$: ld hl,sCurrently-BootLoader+userMem B_CALL PutS call IsOS2Running-BootLoader+userMem ld hl,sOS2-BootLoader+userMem jr z,$F ld hl,sTIOS-BootLoader+userMem $$: B_CALL PutS ld hl,5 ld (curRow),hl ld hl,sInstructions-BootLoader+userMem B_CALL PutS ld hl,6 ld (curRow),hl ld hl,sInstructions2-BootLoader+userMem B_CALL PutS ld hl,7 ld (curRow),hl ld hl,sClearToCancel-BootLoader+userMem B_CALL PutS ld a,iNormal out (interruptEnPort),a bootSelectKeyLoop: ei B_CALL GetCSC cp skYEqu jp z,SwitchOS-BootLoader+userMem cp skDel jp z,ReceiveTIOS-BootLoader+userMem cp sk0 jp z,DeleteOS-BootLoader+userMem ld hl,contrast cp skAdd jr z,contrastUp cp skSub jr z,contrastDown cp skClear jr nz,bootSelectKeyLoop ;We pressed CLEAR, just reset and boot whatever it is that we are ; B_CALL ClrLCDFull di ld hl,0 ld (RAMChecksum),hl ld a,lcdTurnOff out (LCDinstPort),a xor a out (memPageBPort),a rst 00h contrastDown: dec (hl) jr $F contrastUp: inc (hl) $$: ld a,(contrast) add a,18h or 0C0h $$: push af in a,(2) and 80h jr z,$F in a,(2) and 2 jr z,$B $$: pop af out (LCDinstPort),a jr bootSelectKeyLoop SwitchOS: B_CALL ClrLCDFull ld hl,0 ld (curRow),hl ld hl,sSwitching-BootLoader+userMem B_CALL PutS di call UniversalUnlockFlash-BootLoader+userMem ;NOTE: Remember, this is all running from userMem. ;Do the following: ; Back up sector 0 to the extra RAM pages xor a ld b,04h ld c,4 $$: push bc push af call MyCopyToRAMPage-BootLoader+userMem pop af pop bc inc a inc b dec c jr nz,$B ; Erase sector 0 xor a ld ix,_EraseFlashPage-4000h call BCALLRoutine-BootLoader+userMem ; Copy sector 70h to sector 0 ld a,70h ld b,0 ld c,4 $$: push af push bc call MyCopyFlashPage-BootLoader+userMem pop bc pop af inc a inc b dec c jr nz,$B ; Erase sector 70h ld a,70h ld ix,_EraseFlashPage-4000h call BCALLRoutine-BootLoader+userMem ; Write our backup from the extra RAM pages to sector 70h ld a,04h ld b,70h ld c,4 $$: push bc push af call MyCopyRAMToFlashPage-BootLoader+userMem pop af pop bc inc a inc b dec c jr nz,$B ; Copy pages 68h and 69h to the extra RAM pages (04h-05h) ld a,68h ld b,04h call MyCopyToRAMPage-BootLoader+userMem ld a,69h ld b,05h call MyCopyToRAMPage-BootLoader+userMem ; Copy pages 7Ch and 7Dh to the extra RAM pages (06-07h) ld a,7Ch ld b,06h call MyCopyToRAMPage-BootLoader+userMem ld a,7Dh ld b,07h call MyCopyToRAMPage-BootLoader+userMem ; Erase sector 7Ch ld a,7Ch ld ix,_EraseFlashPage-4000h call BCALLRoutine-BootLoader+userMem ; Copy pages 6Ah and 6Bh to 7Ch and 7Dh ld a,6Ah ld b,7Ch call MyCopyFlashPage-BootLoader+userMem ld a,6Bh ld b,7Dh call MyCopyFlashPage-BootLoader+userMem ; Erase sector 68h ld a,68h ld ix,_EraseFlashPage-4000h call BCALLRoutine-BootLoader+userMem ; Copy from the extra RAM pages to pages 68h-6Bh ld a,04h ld b,68h ld c,4 $$: push af push bc call MyCopyRAMToFlashPage-BootLoader+userMem pop bc pop af inc a inc b dec c jr nz,$B ;Restart. di ld hl,0 ld (RAMChecksum),hl ; B_CALL ClrLCDFull ; B_CALL PowerOff ld a,lcdTurnOff out (LCDinstPort),a rst 00h DeleteOS: call UniversalUnlockFlash-BootLoader+userMem ld a,70h ld b,0 ld de,4056h B_CALL WriteAByte ;Restart. di ld hl,0 ld (RAMChecksum),hl ld a,lcdTurnOff out (LCDinstPort),a xor a out (memPageBPort),a rst 00h ReceiveTIOS: ;We don't have a copy of the TI-OS, receive one res indicOnly,(iy+indicFlags) res curAble,(iy+curFlags) B_CALL ClrLCDFull ld hl,0 ld (curRow),hl ld hl,sBoot-BootLoader+userMem B_CALL PutS ld hl,2 ld (curRow),hl call DoesSecondOSExist-BootLoader+userMem ld hl,sStartTransfer2-BootLoader+userMem jr nz,$F ld hl,sStartTransfer-BootLoader+userMem $$: B_CALL PutS ld hl,7 ld (curRow),hl ld hl,sClearToCancel-BootLoader+userMem B_CALL PutS set receiveTIOS,(iy+linkFlags2) ;receive the TI-OS to the extra pages instead of just jumping to the boot code ld a,iNormal out (interruptEnPort),a BootLoaderKeyLoop: B_CALL GetKey cp kClear jr z,$F jr BootLoaderKeyLoop $$: di ld hl,0 ld (RAMChecksum),hl ld a,lcdTurnOff out (LCDinstPort),a xor a out (memPageBPort),a rst 00h DoesSecondOSExist: in a,(memPageAPort) push af ld a,70h out (memPageAPort),a ld a,(4000h+0056h) ;HACK: be smarter about this... cp 5Ah jr z,$F xor a jr DoesSecondOSExist_1 $$: or 1 DoesSecondOSExist_1: pop bc ld a,b out (memPageAPort),a ret IsOS2Running: ld a,(OS2Marker) or a ret MyCopyToRAMPage: di ld c,a in a,(6) push af ld a,c out (6),a ld a,b out (5),a ld hl,4000h ld de,0C000h ld bc,4000h ldir xor a out (5),a pop af out (6),a ret MyCopyRAMToFlashPage: di ld hl,4000h $$: push af push bc push hl ;Copy from extra RAM page A to Flash page B out (5),a ld de,8000h add hl,de ld de,tempSwapArea ld bc,128 ldir xor a out (5),a pop de pop af push af ld hl,tempSwapArea ld bc,128 push de ld ix,_WriteFlash-4000h call BCALLRoutine-BootLoader+userMem pop hl ld bc,128 add hl,bc pop bc pop af bit 7,h jr z,$B ret BCALLRoutine: ;Calls boot code routine ;Pass IX as the address (subtract 4000h first) ld (9C87h),a in a,(6) push af ld a,7Fh push hl push bc ld b,a in a,(2) and 80h jr z,$F in a,(21h) and 3 ld a,b jr nz,translateDone and 3Fh jr translateDone $$: ld a,b and 1Fh translateDone: pop bc out (6),a ld l,(ix+0) ld h,(ix+1) push hl pop ix pop hl ld a,(9C87h) call jpIX-BootLoader+userMem ld (9C87h),a pop af out (6),a ld a,(9C87h) ret jpIX: jp (ix) MyCopyFlashPage: ld hl,4000h $$: push af push bc ld de,tempSwapArea ld bc,128 push hl ld ix,_FlashToRam2-4000h call BCALLRoutine-BootLoader+userMem pop de pop af push af ld hl,tempSwapArea ld bc,128 push de ld ix,_WriteFlash-4000h call BCALLRoutine-BootLoader+userMem pop hl ld bc,128 add hl,bc pop bc pop af bit 7,h jr z,$B ret UniversalUnlockFlash: call IsOS2Running-BootLoader+userMem jr nz,$F B_CALL UnlockFlash ret $$: ld hl,UnlockFlashStart+4000h ld de,appBackUpScreen ld bc,UnlockFlashEnd-UnlockFlashStart ldir jp appBackUpScreen UnlockFlashStart: in a,(6) push af ld a,7Bh call myTranslatePage-UnlockFlashStart+appBackUpScreen out (6),a ld hl,5092h ld e,(hl) inc hl ld d,(hl) inc hl ld a,(hl) call myTranslatePage-UnlockFlashStart+appBackUpScreen out (6),a ex de,hl ld a,0CCh ld bc,0FFFFh cpir ld e,(hl) inc hl ld d,(hl) push de pop ix ld hl,9898h ld (hl),0C3h inc hl ld (hl),(returnPoint-UnlockFlashStart+appBackUpScreen) & 11111111b inc hl ld (hl),(returnPoint-UnlockFlashStart+appBackUpScreen) >> 8 ld hl,pagedBuf ld (hl),98h ld de,pagedBuf+1 ld bc,49 ldir ld (iMathPtr5),sp ld hl,(iMathPtr5) ld de,9A00h ld bc,50 ldir ld de,(iMathPtr5) ld hl,-12 add hl,de ld (iMathPtr5),hl di ld iy,0056h-25h ld a,50 ld (pagedCount),a ld a,8 ld (arcInfo),a jp (ix) myTranslatePage: ld b,a in a,(2) and 80h jr z,$F in a,(21h) and 3 ld a,b ret nz and 3Fh ret $$: ld a,b and 1Fh ret returnPoint: ld iy,flags ld hl,(iMathPtr5) ld de,12 add hl,de ld sp,hl ex de,hl ld hl,9A00h ld bc,50 ldir pop af out (6),a ret UnlockFlashEnd: sBoot: DB "Select Boot OS",0CEh,0 sCurrently: DB "Currently: ",0 sTIOS: DB "TI-OS",0 sOS2: DB "OS2",0 sInstructions: DB LlBrack,"Y=] to switch",0CEh,0 sInstructions2: DB LlBrack,"0] to delete",0CEh,0 sClearToCancel: DB LlBrack,"CLEAR] to exit",0 sStartTransfer: DB "OS not found. " sStartTransfer2: DB "Send secondary " DB "OS now to enable" DB "dual booting.",0 sSwitching: DB "Switching...",0 xor a BootLoaderEnd: