;periph8x/UnivOS USB calculator driver routines include "settings.inc" include "ti83plus.inc" include "equates.inc" SEGMENT Main GLOBALS ON EXTERN IPutS,DispHexA,IGetKey,INewLine,Start,ILdHLInd,USBErrorFeatureDisabled,DispHexHL EXTERN receiveAndWriteUSBData,sendUSBData_BCbytesFromHL,receiveAndWriteUSBData_noInt,logPage EXTERN putAtoHL_ExtraRAMPage,LDIRtoExtraRAMPage,LDIRfromExtraRAMPage,LDIR_ExtraRAMPage,cphlde EXTERN unlockFlash,PutSApp bufferSize equ tempSwapArea bufferPtr equ tempSwapArea+1 currentPage equ tempSwapArea+5 currentRAMSector equ tempSwapArea+6 currentFlashSector equ tempSwapArea+8 RAMSectorOffset equ tempSwapArea+10 FlashSectorOffset equ tempSwapArea+12 BCALL_replacement equ savesscreen+512 calcDeviceDescriptor: DB 12h ;size of descriptor DB 01h ;device descriptor type DW 0200h ;USB version DB 00h ;bDeviceClass DB 00h ;bDeviceSubClass DB 00h ;bDeviceProtocol DB 40h ;bMaxPacketSize0 DW 0451h ;wVendorID DW 0E003h ;wProductID DW 0100h ;device release number DB 01h ;manufacturer string index DB 02h ;product string index DB 00h ;serial number string index DB 01h ;bNumConfigurations calcSEDeviceDescriptor: DB 12h ;size of descriptor DB 01h ;device descriptor type DW 0200h ;USB version DB 00h ;bDeviceClass DB 00h ;bDeviceSubClass DB 00h ;bDeviceProtocol DB 40h ;bMaxPacketSize0 DW 0451h ;wVendorID DW 0E008h ;wProductID DW 0100h ;device release number DB 01h ;manufacturer string index DB 02h ;product string index DB 00h ;serial number string index DB 01h ;bNumConfigurations calcConfigDescriptor: DB 09h ;size of descriptor DB 02h ;config descriptor type DW 32 ;total length of all descriptors DB 01h ;number of interfaces DB 01h ;configuration number DB 00h ;configuration string index DB 11000000b ;bmAttributes DB 0 ;bMaxPower (0mA) ;Interface descriptor DB 09h ;size of descriptor DB 04h ;interface descriptor type DB 00h ;interface number DB 00h ;bAlternateSetting DB 02h ;bNumEndpoints DB 0FFh ;bInterfaceClass DB 01h ;bInterfaceSubClass DB 00h ;bInterfaceProtocol DB 00h ;interface string index ;Endpoint descriptor (in) DB 07h ;size of descriptor DB 05h ;endpoint descriptor type DB 10000001b ;bEndpointAddress DB 02h ;bulk endpoint DW 0040h ;wMaxPacketSize DB 00h ;bInterval ;Endpoint descriptor (out) DB 07h ;size of descriptor DB 05h ;endpoint descriptor type DB 00000010b ;bEndpointAddress DB 02h ;bulk endpoint DW 0040h ;wMaxPacketSize DB 00h ;bInterval handleCalcData: ;BC contains number of bytes to receive (I guess I don't care) di ;just to be on the safe side ld hl,appData ld bc,5 res 4,(iy+43h) res useExtraRAMPages,(iy+periph8xFlags) call receiveAndWriteUSBData jr c,directUSBError di ;just to be on the safe side ld ix,appData ld b,(ix+2) ld c,(ix+3) ld a,(ix+4) LOG CalcCmd,a dec a jr z,bufferSizeRequestReceived dec a dec a jr z,virtualPacketDataWithContinuation dec a jr z,virtualPacketDataFinal dec a ret nz virtualPacketDataAcknowledgement: ;I don't think I care what this is ld hl,appData+5 ld bc,2 call receiveAndWriteUSBData_noInt ret nc directUSBError: di ;just to be on the safe side bit receivingOS,(iy+periph8xFlags) jp nz,0000h ;something went wrong during OS receive, just reset LOG Custom,0FFh res receivingOS,(iy+periph8xFlags) scf ret bufferSizeRequestReceived: ld hl,appData+5 ld bc,4 call receiveAndWriteUSBData_noInt ld ix,appData+5 ld d,(ix+0) ld e,(ix+1) ld h,(ix+2) ld l,(ix+3) ;DEHL is requested buffer size, say it's okay ld a,l ld (bufferSize),a ld a,2 ld (appData+4),a ld hl,appData ld bc,9 jr sendUSBData_BCbytesFromHL virtualPacketDataWithContinuation: ld hl,appData+5 push bc call receiveAndWriteUSBData_noInt pop bc jr c,directUSBError ld hl,appData+5 ld de,(bufferPtr) ldir ld (bufferPtr),de ret virtualPacketDataFinal: ld hl,appData+5 push bc call receiveAndWriteUSBData_noInt pop bc jr c,directUSBError ld hl,appData+5 ld de,(bufferPtr) ldir ld hl,virtualAcknowledgementData ld bc,7 call sendUSBData_BCbytesFromHL ld ix,appBackUpScreen ld (bufferPtr),ix ld h,(ix+4) ld l,(ix+5) LOG CalcCmd,h LOG CalcCmd,l call DispHexHL ;HL contains virtual packet type ld de,0005h call cphlde jr z,OSdataReceived ld de,0DD00h call cphlde jr z,endOfTransmissionReceived ;Something's going on that's not an OS packet res receivingOS,(iy+periph8xFlags) ld de,0001h call cphlde jr z,pingSetModeReceived ld de,000Bh call cphlde jr z,requestToSendReceived ld de,000Dh call cphlde jr z,variableContentsReceived ld de,0002h call cphlde jr z,beginOStransferReceived ld de,0004h call cphlde jr z,OSheaderReceived ld de,0007h call cphlde jr z,parameterRequestReceived ld de,0EE00h call cphlde jr z,errorReceived ld de,0009h call cphlde jr z,directoryListingReceived ld de,0011h call cphlde jr z,remoteControlReceived ; call DispHexHL ;*** TESTING ret errorReceived: ;I don't think I care scf ret remoteControlReceived: ld hl,remoteControlResponse ld bc,13 jr sendUSBData_BCbytesFromHL remoteControlResponse: DB 00h,00h,00h,0Ah DB 04h DB 00h,00h,00h,04h DB 0BBh,00h DB 0FFh,0FFh,0FFh,0FFh directoryListingReceived: ;Store number of attributes to (savesscreen), attribute IDs to savesscreen+1 ;HACK: this is ugly because I was too lazy to spend five seconds and look up the right way to do it ld hl,appBackUpScreen+6+3 ld a,(hl) ld (savesscreen),a ld l,a ld h,0 add hl,hl ld b,h ld c,l ld hl,appBackUpScreen+6+4 ld de,savesscreen+1 ldir ;TODO: Send back a series of 000Ah (header) packets for each variable type, using these attributes jr sendEndOfTransmission beginOStransferReceived: ld hl,OStransferAcknowledgement ld bc,19 jr sendUSBData_BCbytesFromHL OStransferAcknowledgement: DB 00h,00h,00h,0Eh DB 04h DB 00h,00h,00h,08h DB 00h,03h DB 00h,00h,01h,04h,00h,00h,00h,00h OSheaderReceived: ld hl,OStransferAcknowledgement ld bc,19 call sendUSBData_BCbytesFromHL B_CALL GrBufClr B_CALL ClrLCDFull B_CALL HomeUp ld hl,sReceivingOS call PutSApp call unlockFlash ;Set up things so that only page 0 code will execute from here on out (hopefully) ;TODO: Verify all this with OS versions 2.30+ (and make as generic as possible) ld a,00001010b out (3),a set indicOnly,(iy+indicFlags) B_CALL CursorOff B_CALL RunIndicOff B_CALL DisableApd xor a out (30h),a out (33h),a out (36h),a res 0,(iy+16h) ;Set up BCALL replacement routine (this might be unnecessary here) ld hl,BCALL_replacementStart ld de,BCALL_replacement ld bc,BCALL_replacementEnd-BCALL_replacementStart ldir ;Logging MUST be off because I'm using the extra RAM pages to store sector 0 temporarily ld ix,logPage ld (ix+0),0 ld (ix+1),0 ld (ix+2),0 ;Erase all of the OS except for page 0 (necessary for USB interrupts (which shouldn't be necessary, but it is for now)) ld a,4 B_CALL EraseFlashPage ld a,74h B_CALL EraseFlashPage ld a,78h B_CALL EraseFlashPage ld a,7Ch B_CALL EraseFlashPage set receivingOS,(iy+periph8xFlags) ; ld a,1 ;untested, but I think this will cause _GetKey to return and OS code execution will stop ; ld (kbdKey),a ; (which is what I want) ; ld (kbdScanCode),a ; ret sReceivingOS: DB "Receiving OS",0CEh,0 BCALL_replacementStart: ld (appData),a ld (appData+1),hl in a,(6) push af ld a,7Fh call translatePage-BCALL_replacementStart+BCALL_replacement out (6),a ld hl,returnPoint-BCALL_replacementStart+BCALL_replacement push hl ld l,(ix+0) ld h,(ix+1) ld a,(ix+2) call translatePage-BCALL_replacementStart+BCALL_replacement out (6),a push hl pop ix ld a,(appData) ld hl,(appData+1) jp (ix) returnPoint: ld (appData),a pop af out (6),a ld a,(appData) ret translatePage: push bc ld b,a in a,(2) and 80h ld a,b jr nz,$F and 3Fh $$: pop bc ret BCALL_replacementEnd: OSdataReceived: set receivingOS,(iy+periph8xFlags) ld ix,appBackUpScreen+10 ; ld de,0006h ;*** TESTING ; ld (curRow),de ;*** TESTING ; ld a,(ix-1) ;*** TESTING ; cp 10h ; jr c,$F ; or 60h ;$$: call DispHexA ;*** TESTING ; ld a,(ix-3) ;*** TESTING ; call DispHexA ;*** TESTING ; ld a,(ix-2) ; call DispHexA di ld a,(ix-2) ld d,(ix-4) ld e,(ix-3) ;ADE = page:address to write to ;IX => OS data ;TODO: do the actual write push ix pop hl ld ix,_WriteFlashUnsafe-4000h ld bc,256 ;this is bad to hard-code (maybe not? boot code does it) cp 4 jr c,$F cp 10h jr c,continueWrite or 60h continueWrite: call BCALL_replacement jr sendOSAck $$: di add a,4 out (5),a set 7,d set 6,d ldir xor a out (5),a sendOSAck: ;Send acknowledgement and go on ld hl,acknowledgementData ld bc,12 jr sendUSBData_BCbytesFromHL endOfTransmissionReceived: ;TODO: get this out of here or add a check, because you don't want to be writing to Flash (necessarily) on a normal variable transfer ; bit receivingOS,(iy+periph8xFlags) ; jr nz,$F ;Send EOT response ld hl,Var_EOT_Data ld bc,12 call sendUSBData_BCbytesFromHL ;Set up BCALL replacement (again...might not be necessary) di ld hl,BCALL_replacementStart ld de,BCALL_replacement ld bc,BCALL_replacementEnd-BCALL_replacementStart ldir ;Write sector 0 out from RAM pages ld hl,writeSector0 ld de,savesscreen ld bc,writeSector0End-writeSector0 ldir jp savesscreen writeSector0: ;Erase sector 0 xor a ld ix,_EraseFlashPage-4000h call BCALL_replacement ;Write out sector 0 from RAM pages 84h-87h (one byte at a time...for some reason...) in a,(6) push af xor a ld ix,plotSScreen ld (ix+0),a ld (ix+1),a ld (ix+2),a ld (ix+3),a writeFullLoop: ld de,4000h ld bc,4000h writeSector0Loop: push bc push af add a,84h out (6),a ld a,(de) ld b,a pop af push af push de ld ix,_WriteAByte-4000h call BCALL_replacement pop de pop af inc de pop bc dec bc ld l,a ld a,b or c ld a,l jr nz,writeSector0Loop push af ld b,a inc b ld hl,plotSScreen-3 ld de,3 $$: add hl,de djnz $B ;Update progress "bar" so user doesn't think the calculator is hanging ld (hl),0FFh inc hl ld (hl),0FFh inc hl ld (hl),0FFh call fastcopy-writeSector0+savesscreen pop af inc a cp 4 jr nz,writeFullLoop ;Mark the OS as validated in case it's not already xor a ld de,0056h ld b,5Ah B_CALL WriteAByte pop af out (6),a ;Reboot jp 0053h fastcopy: ld a,80h out (10h),a ld hl,plotSScreen-12-(-(12*64)+1) fastcopy_start: ld a,20h ld c,a inc hl dec hl fastCopyAgain: ld b,64 inc c ld de,-(12*64)+1 out (10h),a add hl,de ld de,10 fastCopyLoop: add hl,de inc hl inc hl inc de ld a,(hl) out (11h),a dec de djnz fastCopyLoop ld a,c cp 2Ch jr nz,fastCopyAgain ret writeSector0End: ;This...doesn't work? ;$$: res receivingOS,(iy+periph8xFlags) ; ld hl,7 ; ld (curRow),hl ; B_CALL EraseEOL ; ld hl,6 ;*** TESTING ; ld (curRow),hl ;*** TESTING ; B_CALL EraseEOL ;*** TESTING ; ld hl,OS_EOT_Data ; ld bc,15 ; call sendUSBData_BCbytesFromHL ; jr c,directUSBError ; ld a,5 ; B_CALL PutC ; ld hl,appData ; ld bc,5 ; call receiveAndWriteUSBData_noInt ; jr c,directUSBError ; ld a,(appData+2) ; ld b,a ; ld a,(appData+3) ; ld c,a ; ld hl,appData+5 ; call receiveAndWriteUSBData_noInt ; ld hl,Validation_Data ; ld bc,15 ; call sendUSBData_BCbytesFromHL ; ret Var_EOT_Data: DB 00h,00h,00h,07h DB 04h DB 00h,00h,00h,01h DB 00h,06h DB 01h ;OS_EOT_Data: ; DB 00h,00h,00h,0Ah ; DB 04h ; DB 00h,00h,00h,04h ; DB 0BBh,00h ; DB 00h,00h,17h,70h ;Validation_Data: ; DB 00h,00h,00h,0Bh ; DB 04h ; DB 00h,00h,00h,05h ; DB 00h,06h ; DB 01h ; DB 00h,00h,07h,0D0h pingSetModeReceived: ld hl,modeSettingAcknowledgement ld de,appData push de ld bc,11 ldir ld hl,appBackUpScreen+12 ldi ldi ldi ldi pop hl ld bc,15 jr sendUSBData_BCbytesFromHL modeSettingAcknowledgement: DB 00h,00h,00h,0Ah DB 04h DB 00h,00h,00h,04h DB 00h,12h requestToSendReceived: ld hl,acknowledgementData ld bc,12 jr sendUSBData_BCbytesFromHL variableContentsReceived: ld hl,acknowledgementData ld bc,12 jr sendUSBData_BCbytesFromHL virtualAcknowledgementData: DB 00h,00h,00h,02h DB 05h DB 0E0h,00h acknowledgementData: DB 00h,00h,00h,07h DB 04h DB 00h,00h,00h,01h DB 0AAh,00h DB 01h sendEndOfTransmission: ld hl,endOfTransmissionData ld bc,19 jr sendUSBData_BCbytesFromHL endOfTransmissionData: DB 00h,00h,00h,07h DB 04h DB 00h,00h,00h,01h DB 0DDh,00h DB 01h parameterRequestReceived: ; ld a,5 ;*** TESTING ; B_CALL PutC ;*** TESTING ;Set up parameter request response ld hl,8004h ld (iMathPtr5),hl ld hl,4 ld (iMathPtr4),hl ld de,8 call addParameterWord ld hl,appBackUpScreen+6 ld bc,2 push hl call addParameterData ;add number of parameters requested pop ix ld b,(ix+0) ld c,(ix+1) ld ix,appBackUpScreen+8 parameterResponseLoop: ld a,b or c jr z,sendParameterData ;Deal with parameter request ID ld (iMathPtr3),ix ld d,(ix+0) ld e,(ix+1) ; ex de,hl ; call DispHexHL ;*** TESTING ; ex de,hl push ix ld ix,parameterResponseTable findParameterResponseLoop: ld l,(ix+0) ld h,(ix+1) ld a,h or l jr z,$F call cphlde ld l,(ix+2) ld h,(ix+3) inc ix inc ix inc ix inc ix jr nz,findParameterResponseLoop push bc ;Add standard stuff to each parameter response push hl ld hl,(iMathPtr3) ld bc,2 call addParameterData xor a call addParameterByte pop hl ; ld a,6 ;*** TESTING ; B_CALL PutC ;*** TESTING call jpHL pop bc $$: pop ix dec bc inc ix inc ix jr parameterResponseLoop sendParameterData: ld hl,(iMathPtr4) ld de,6 or a sbc hl,de ex de,hl ld hl,8000h xor a call putAtoHL_ExtraRAMPage inc hl xor a call putAtoHL_ExtraRAMPage inc hl ld a,d call putAtoHL_ExtraRAMPage inc hl ld a,e call putAtoHL_ExtraRAMPage ;Send parameter data ld hl,8000h ld bc,(iMathPtr4) ;Send data using virtual packets sendVirtualPacket: ;HL => data on extra RAM pages ;BC = number of bytes to send ;Subtract 250 bytes, and as long as we carry, send a type 3 virtual packet ;When we finally stop carrying, send a type 4 virtual packet ld (iMathPtr5),bc push hl ld hl,250 or a sbc hl,bc pop hl jr c,sendContinuationPacket push hl ld hl,5 add hl,bc ld b,h ld c,l push bc ld hl,0C000h xor a call putAtoHL_ExtraRAMPage inc hl xor a call putAtoHL_ExtraRAMPage inc hl ld bc,(iMathPtr5) ld a,b call putAtoHL_ExtraRAMPage inc hl ld a,c call putAtoHL_ExtraRAMPage inc hl ld a,04h call putAtoHL_ExtraRAMPage inc hl ex de,hl pop bc pop hl push bc call LDIR_ExtraRAMPage pop bc ld hl,0C000h set useExtraRAMPages,(iy+periph8xFlags) call sendUSBData_BCbytesFromHL ret sendContinuationPacket: ;TODO: FINISH THIS ROUTINE!!! ;Decrease BC by 250 push hl ld h,b ld l,c ld bc,250 or a sbc hl,bc ld b,h ld c,l pop hl ;Send 250-byte type 3 virtual packet push bc push hl ld hl,5 add hl,bc ld b,h ld c,l ld hl,0C000h xor a call putAtoHL_ExtraRAMPage inc hl xor a call putAtoHL_ExtraRAMPage inc hl ld a,b call putAtoHL_ExtraRAMPage inc hl ld a,c call putAtoHL_ExtraRAMPage inc hl ld a,04h call putAtoHL_ExtraRAMPage inc hl ex de,hl pop hl call LDIR_ExtraRAMPage pop bc ld hl,0C000h set useExtraRAMPages,(iy+periph8xFlags) call sendUSBData_BCbytesFromHL ;Wait on acknowledgement here jr sendVirtualPacket jpHL: jp (hl) ;Okay, at this point, we need to store: ; LL LL = size of requested data ; DD ... = the data itself addProductNumber: ld de,4 call addParameterWord ld de,0 call addParameterWord ld de,0Ah jr addParameterWord addProductName: in a,(21h) and 3 ld hl,productNameText ld de,productNameTextEnd-productNameText jr nz,$F ld hl,productName84PText ld de,productName84PTextEnd-productName84PText $$: push de push hl call addParameterWord pop hl pop bc ld b,c $$: ld a,(hl) inc hl push bc call addParameterByte pop bc djnz $B ret productName84PText: DB "TI-84 Plus" productName84PTextEnd: productNameText: DB "TI-84 Plus Silver Edition" productNameTextEnd: addCalcID: ld de,5 call addParameterWord B_CALL GetCalcSerial ld hl,OP4 ld b,5 $$: ld a,(hl) push bc call addParameterByte pop bc djnz $B ret addHardwareVersion: ld de,2 call addParameterWord B_CALL GetHWVer ld d,0 ld e,a jr addParameterWord addLanguageID: ld de,1 call addParameterWord ld a,(localLanguage) jr addParameterByte addSubLanguageID: ld de,1 call addParameterWord ld a,(localLanguage+1) jr addParameterByte addDBUSDeviceType: ret addBootVersion: ld de,4 call addParameterWord xor a call addParameterByte B_CALL GetBootVer push bc call addParameterByte pop af call addParameterByte xor a jr addParameterByte addOSLoaded: ld de,1 call addParameterWord ld a,1 jr addParameterByte addOSVersion: ld de,4 call addParameterWord xor a call addParameterByte B_CALL GetBaseVer push bc call addParameterByte pop af call addParameterByte xor a jr addParameterByte addRAMPresent: ret addRAMAvailable: ld de,8 call addParameterWord ld de,0 call addParameterWord ld de,0 call addParameterWord ld de,0 call addParameterWord ld de,24000 jr addParameterWord addRAMFree: ld de,8 call addParameterWord ld de,0 call addParameterWord ld de,0 call addParameterWord ld de,0 call addParameterWord B_CALL MemChk ex de,hl jr addParameterWord addFlashPresent: addFlashAvailable: addFlashFree: addAppPagesAvailable: addAppPagesFree: ret add1: ld de,1 call addParameterWord ld a,1 jr addParameterByte add0: ld de,1 call addParameterWord xor a jr addParameterByte add32: addLCDWidth: addLCDHeight: addLCDContents: addClockEnabled: addClockSeconds: addDateFormat: addTimeFormat: ret addBatteryStatus: ld de,1 call addParameterWord ld a,1 jr addParameterByte addBit5IYPlus33h: addFullCalcID: ret addAtHomescreen: ld de,1 call addParameterWord ld a,1 jr addParameterByte addSplitStatus: ret unknown31Command: ld de,4 call addParameterWord xor a call addParameterByte ld de,1 ;4000h call addParameterWord ld a,0Ah call addParameterByte ret addParameterWord: ld hl,OP1 ld (hl),d inc hl ld (hl),e dec hl ld bc,2 jr addParameterData addParameterByte: ld hl,OP1 ld (hl),a ld bc,1 addParameterData: ld de,(iMathPtr5) push hl ld hl,(iMathPtr4) add hl,bc ld (iMathPtr4),hl pop hl call LDIRtoExtraRAMPage ld (iMathPtr5),de ret parameterResponseTable: ;TODO: finish the code for all these... DW 0001h DW addProductNumber DW 0002h DW addProductName DW 1002h DW addProductName ;I guess... DW 0003h DW addCalcID DW 0004h DW addHardwareVersion DW 0006h DW addLanguageID DW 0007h DW addSubLanguageID DW 0008h DW addDBUSDeviceType DW 0009h DW addBootVersion DW 000Ah DW addOSLoaded DW 000Bh DW addOSVersion DW 000Ch DW addRAMPresent DW 000Dh DW addRAMAvailable DW 000Eh DW addRAMFree DW 000Fh DW addFlashPresent DW 0010h DW addFlashAvailable DW 0011h DW addFlashFree DW 0012h DW addAppPagesAvailable DW 0013h DW addAppPagesFree DW 0019h DW add1 DW 001Ah DW add0 DW 001Bh DW add0 DW 001Ch DW add1 DW 001Dh DW add1 DW 001Eh DW addLCDWidth DW 001Fh DW addLCDHeight DW 0022h DW addLCDContents DW 0023h DW add1 DW 0024h DW addClockEnabled DW 0025h DW addClockSeconds DW 0027h DW addDateFormat DW 0028h DW addTimeFormat DW 0029h DW add0 DW 002Dh DW addBatteryStatus DW 0030h DW add32 DW 0031h DW unknown31Command DW 0032h DW addBit5IYPlus33h DW 0036h DW addFullCalcID DW 0037h DW addAtHomescreen DW 0038h DW add0 DW 0039h DW addSplitStatus DW 0000h ;end of table