REM > DRDOS.6502/src REM Source for 6502.SYS TUBE handling code for the Master 512 REM ========================================================= REM 6502.SYS source adapted from Appendix F of Master 512 Technical Guide by Robin Burton : IF PAGE>&8000:SYS "OS_GetEnv"TOA$:IFLEFT$(A$,5)<>"B6502":OSCLI"B6502"+MID$(A$,INSTR(A$," ")) ON ERROR REPORT:PRINT" at line ";ERL:END : load%=&2800:DIM mcode% &1000:name$="6502/sys" : : REM The first section of code is the program from 6502.SYS proper, while REM following it there is the patch which resides at &2500 to handle the REM OSWORD &FA, which was originally also in 6502.SYS. OSWORD &FA was REM removed from disc for practical reasons as well as 'neatness'. The code REM was separated so it could be put into the 512's boot ROMs to enable it REM to assist virtually immediately with the rapid tube transfers used on REM initial system start-up, rather than itself first having to be '*LOAD'ed REM from an ADFS file, which would look untidy and of course would take REM longer. : REM 6502.SYS provides the main support for cross-tube dialogue between the REM 512 and the host for the majority of 512 operations. Only when a tube REM claim or release is called for, or a completely standard MOS or filing REM system function is required, is the tube host code, resident in pages 4 REM to 6 of the host called. : : REM ********************************************** REM 6502.SYS TUBE handling code for the Master 512 REM ********************************************** : REM This code is copied to the I/O processor during initial system boot. : REM The boot strap loader looks for a file 6502.SYS in the root directory of REM the DOS+ boot disk and loads it into the 512's RAM along with DOS+. REM Before initialising the system it copies this code to 6502 memory at REM &2800. It then sets the user vector to point to the code's first REM executable instruction at &2803. : REM To make the code accessible to the boot-strap loader: REM 1 assemble code at address &2800 and save to disc REM 2 Boot DOS+ REM 3 'MOVE' the assembled machine code file from the BBC micro's disc to REM the file 6502.SYS in the root REM directory of the DOS+ boot disc. : REM ************************************************ REM NOTE - that some of the code here is position REM critical and much of it is also time critical. REM ************************************************ : REM Various addresses and data declarations for the REM 6502 MOS calls and hardware interfaces follow: REM ************************************************ REM ZERO PAGE MOS VARIABLES REM *********************** : key1 = &EC :REM new key press in zero page key2 = &ED :REM old key press in zero page REM STANDARD MOS CALLS & VECTORS USED BY THIS CODE REM ********************************************** : keyvec = &022B :REM The keyboard vector oswrch = &FFEE :REM Console (screen) output osbyte = &FFF4 :REM General MOS call entry REM ADDRESS OF INTERCEPTED BBC MICRO VECTORS REM **************************************** : userv = &200 :REM user vector brkv = &202 :REM The break vector irqvl = &204 :REM Interrupt request 1 eventvec = &220 :REM The event vector REM ENTRY TO BBC MICRO's STANDARD TUBE CODE REM *************************************** : tube_entry = &406 :REM claim/re1ease/program tube NMI REM SHEILA MEMORY MAPPED ADDRESSES REM ****************************** : io_page = &FE00 :REM base address of SHEILA crtc_addr = &FE00 :REM 6845 CRTC address register crtc_data = &FE01 :REM 6845 CRTC data register userport = &FE60 :REM user-port data I-O up_rdwrt = &FE62 :REM User-port data direction ACRu = &FE6B :REM 6522 auxiliary control register IFRu = &FE6D :REM Interrupt flag register IERu = &FE6E :REM Interrupt enable register REM 1770 FDC OFFSETS FROM &FE00 REM *************************** : Master fdc base = &24 Master_fdn_stat = &28 Master_fdc_data = &2B BBC_fdc_base = &80 BBC_fdc_stat = &84 BBC_fdc_data = &87 REM THE TUBE STATUS AND DATA REGISTERS REM ********************************** : tubeR1stat = &FFF0 :REM Register 1 status tubeR1data = &FEE1 :REM Register 1 data tubeR2stat = &FEE2 :REM Register 2 status tubeR2data = &FEE3 :REM Register 2 data tubeR3stat = &FEE4 :REM Register 3 status tubeR3data = &FEE5 :REM Register 3 data tubsR4stat = &FEE6 :REM Register 4 status tubeR4data = &FEE7 :REM Register 4 data REM OSWORD TYPE DECLERATIONS REM ************************ : GRAPH_OSWORD = &FF :REM fast graphics update DISK_OSWORD = &FE :REM hard disk read/write (unimplemented) RESERVED = &FD :REM was text_osword CRTC_OSWORD = &FC :REM cursor, soft scroll, mouse etc FDC_OSWORD = &FB :REM seek/read/write RESERVED = &FA :REM block xfer osword REM FILING SYSTEM COMMANDS REM ********************** : osfind = &FFCE :REM open/close file osgbpb = &FFD1 :REM read/write open file fdc_ctrl = 0 :REM select drive/FM-MFM/... fdc_stat = 4 :REM DRC,INDEX,RNF,CRC,... fdc_cmnd = 4 :REM RESTORE/SEEK/READ/WRITE fdc_trck = 5 :REM 0-79 fdc_sect = 6 :REM 1-10 fdc_data = 7 :REM data for READ/WRITE, track for SEEK REM NMI DECLARATIONS REM **************** : nmi_code = &0D00 :REM MMI handler location - FIXED! nmi_stat = &0D02 :REM direction patch location nmi_rd = &0D0B :REM direction patch location nmi_wr = &0D0E :REM direction patch location REM NMI ZERO PAGE WORKSPACE REM *********************** : nmiws0 = &A0 :REM temporary status storage nmiwsl = &A1 :REM end of command semaphore nmiws2 = &A2 nmiws3 = &A3 nmiws4 = &A4 nmiws5 = &A5 nmiws6 = &A6 nmiws7 = &A7 REM Aliases fdc_base = nmiwso :REM indirect all accesses to FDC fdo_base_lo = nmiwso fdc base_hi = nmiwsl REM BEGINNING OF 512 TUBE CODE REM ************************** : FOR P=0TO1 P%=load%:O%=mcode% [OPT P*3+4 .L2800 JMP &2500 :\ not one of the following :\ so jump to OSWORD &FA code .L2803 CMP #GRAPH_OSWORD :\ graphics update? BEQ to_graph_write :\ BEQ to_graph_write CMP #CRTC_OSWORD :\ cursor OSWORD? BEQ to_osword_fc :\ beq to_osword_fc CMP #DISK_OSWORD :\ hard disk OSWORD? BEC to_osword_fe :\ beq to_osword_fe CMP #FDC_OSWORD :\ floppy disk controller OSWORD? BEC to_osword_fdc :\ beq to_osword_fdc JMP L2800 :\ else default code \ MEMORY RESERVED FOR TRANSIENT STORAGE \ ************************************* \ Temporary storage for FDC operations .cpm_dma EQUD 0 .ram_status EQUB 0 .rw_cmd EQUB 0 .sector_count EQUB 0 .error_mask EQUB 0 .ram_cmd EQUB 0 .watchdogl EQUB 0 .watchdog2 EQUB 0 \ screen address mapped mouse pointer co-ordinates .mouse_y_hi EQUB 0 .mouse_y_lo EQUB 0 .mouse_x_hi EQUB 0 .mouse_x_lo EQUB 0 \ ************************************************* \ The following code overcomes the limted branching \ range of conditional jumps from the initial entry \ by converting them to direct unconditional jumps \ ************************************************* .to_osword_fe JMP &2C2F :\ Jump to common RTS .to_osword_fc JMP &2A7F :\ write 6845 data - jmp osword_fc .to_graph_write JMP &29F8 :\ Graphics output - jmp graph_write .to_osword_fdc JMP &28E0 :\ Floppy disk - jmp osword_fdc .newevent JMP &2AFC :\ Jump to event handler - eventcode .new_irq JMP &2B80 :\ Jump to newirq1 \ ******************************************************* \ ****** The main operational routines now follow: ****** \ ******************************************************* \ get one byte from register 2 .getR2data LDA tubeR2atat :\ Test bit 7 of R2 status BPL tube_oswrch :\ Not set - branch to tube_oswrch LDA tubeR2data :\ else, Read R2 data RTS .tube_oswrch LDA tubeRlstat :\ Test bit 7 of R1 status BPL getR2data :\ Jump to getR2data if unset LDA tubeR1data :\ Read R1 data JSR oswrch :\ write character JMP tube_osvrch :\ Repeat, write one byte to register 2 .write_R2 BIT tubeR2stat :\ Test bit 6 of R2 status BVC write_R2 :\ Not set - loop until it is! STA tubeR2data :\ write R2 data RTS \ Get one byte from register 4 .read_R4 BIT tubeR4satat :\ Test bit 7 of R4 status BPL read_R4 :\ Not set - loop until it is! LDA tubeR4data :\ Read R4 data RTS \ write one byte to register 4 .write R4 BIT tubea4stat :\ test bit 6 of R4 status BVC write_Rd :\ Not set - 1oop until it is! STA tubeR4data :\ write R4 data RTS \ write one byte to register 1 .write_R1 BIT tubeR1stat :\ Test bit 6 of R1 status BVC write_R1 :\ Not set - loop until it is! STA tubeR1data :\ write R1 data RTS \ ***************************************************** \ FDC OSWORD for WD1770 5 1/4" FM/MFM floppy controller \ ***************************************************** \ the floppy controller uses five registers \ 0 special control latch \ 4 command/status \ 5 track register \ 6 sector register \ 7 data register \ ************************************************** \ *** WARNING! - POSITION DEPENDENT CODE FOLLOWS *** \ ************************************************** .fdc_exec 2872 LDA #&00 :\ clear A 2873 STA ram_status :\ sta ram_status - ensure clear initially 2877 LDY #&07 :\ ldy #fdc_data - ensure drq not pending 2879 LDA (&A0),Y :\ lda (fdc_base),y 287B JSR getR2data 287E STA error_mask :\ sta error_mask - save for disk int. 2981 JSR getR2data 2884 STA sector_count :\ sta sector_count - multi sector count 2887 JSR getR2data :\ read command from 80186 288A STA ram_cmnd :\ sta ram_cmnd - for multi sector xfer 288D JSR &2072 :\ jsr tube_program - set dma addr in 80186 2890 LDY #&04 :\ ldy #fdc_cmnd 2092 LDA ram_cmnd :\ lda ram_cmnd 2895 STA (&A0).Y :\ sta (fdc_base),y - send command to fdc 2897 AND #&C0 :\ Is it group 3/4? 2899 CMP #&C0 :\ were top two bits set? 289B BNE fdc_e7 :\ bne fdc_e7 - No! leave to interrupts 289D IDA #&3C 289F STA watchdog1 :\ sta watchdog1 28Al IDA #&00 28A4 STA watchdog2 :\ sta watchdog2 28A7 TAX :\ Set up timeout counters 28A8 LDY #&04 :\ ldy #fdc_stat - point to status reg .fdc_e1 28AA DEX 28AB BNE fdc_e1 :\ Loop fdc_e1 until status goes busy .fdc_e2 28AD LDA #&01 :\ Test busy flag 28AF AND (&A0),Y :\ AND (fdc_base),y in the status register \ ************************************************* \ WARNING! - the following instruction must not lie \ on an address where the bottom 3 bits are set \ ************************************************* 28B1 BEQ fdc_e4 :\ Branch fdc_e4 If no longer busy 28B3 DEC watchdog2 :\ dec watchdog2 28B6 BNE fdc_e1 :\ bne fda_e1 28B8 DEC watchdog1 :\ dec watchdog1 28BB BNE fdc_e1 :\ bne fdc_e1 - else fall thru on timeout 28BD LDA #&FF :\ and return a timeout error 28BF BNE fdc_e5 :\ bne fdc_e5 (will always branch) .fdc e4 28C1 LDY #&04 :\ ldy fdc_stat - get the status 28C3 LDA (&A0),Y :\ ida (fdc_base),y .fdc_e5 28C5 STA ram_status :\ Save status for return in ram_status .fdc_e6 28C6 SEI :\ Disable interrupts 28C9 JSR fdc_event :\ generate FDC event to return status 28D0 CLI :\ Enable interrupts 28CD RTS :\ and return .fdc_e7 28CE BPL fdc_e9 :\ bpl fdc_e9 - Grp 1 commands return now 28D0 LDY #&00 :\ Others don't, so load timeout counters 28D2 LDX #&00 .fdc_e8 28D4 LDA status_pending :\ lda status_pending and check FDC atatna 28D7 BNE fdc_e6 :\ bne fdc_e6 - if finished return status 28D9 DEX :\ If not finished dec\ent counter 28DA BNE fdc_e8 :\ Not done, branch fdc_e8 - wait a while 28DC DEY 28DD BNE fdc_e8 :\ bne fdc_e8 if still not complete, else .fdc_e9 28DF RTS :\ Timer event returns status \ ***************** \ FDC OSWORD proper \ ***************** .osword_fdc 28E0 CLI :\ Enable interrupts again 28E1 CLD :\ Ensure operation in binary 29E2 JSR getR2data :\ Read tube R2 data - get a command 28E5 BNE tube_call_1 :\ If > 0 jmp to tube_call_1, else... .fdc osword_ret 28E7 RTS :\ Done! \\\\\\\\\\\ got here so far \\\\\\\\\\ \ ******************************************************************* \ These routines claim or release the tube, set up the l770 addresses \ for the host machine, or write data to nemory mapped I/0 in SHEILA. \ ******************************************************************* .tube_call_1 28E8 CMP #&01 :\ Master 128 command? 28EA BNE &28FB :\ No! - Try tube_call_2 (B/B+) 28EC JSR tube_setup :\ else, get tube params - store at rw_cmd &281B 28EF JSR move_NMI_data :\ Copy and adapt nmi routine 28F2 JSR Master_setup :\ jsr Master_setup - set up regs for Master 28F5 JSR fdc_exec :\ jsr fdc_exec - get and execute command 28F8 JMP osword_fdc :\ jmp osword_fdc - get another byte .tube_call_2 28FB CMP #&02 :\ BBC (B/B+) command? 28FD BNE tube_call_3 :\ no! - Try tube_call_3 28FF JSR tube_setup :\ else, get tube params - store at rw_cmd &281B 2902 JSR move_NMI_data :\ copy and adapt the nmi routine 2905 JSR BBC_setup :\ jsr BBC_setup - set up regs for BBC 2908 JSR fdc_exec :\ jsr fdc_exec get and execute command 290B JMP osword_fdc :\ jmp osword_fdc - get another byte .tube_call_3 290E CMP #&03 :\ Claim tube required? 2910 BNE tube_call_4 :\ No! try tube_call_4 2912 JSR nmi_claim :\ jsr nmi_claim - get control of nmi 2915 JSR tube_claim :\ Get tube - jsr tube_claim 2918 JMP osword_fdc :\ jmp osword_fdc - get another byte .tube_call_4 291B CMP #&04 :\ Release tube? 291D BNE other_output :\ No! branch other_output 291F JSR tube_release :\ jsr tube_release - give up tube 2922 JSR nmi_release :\ Call nmi_release - give up NMI 2925 JMP oswrd_fdc :\ jmp osword_fdc - get another byte .other_output 2928 TAX :\ port number in x 2929 JSR getR2data :\ Read tube R2 data - get data byte 292C STA &FE00,X :\ Store in i/o_page,X - write it to port 292F JMP osword_fdc :\ jmp osword_fdc - get another byte .BBC_setup 2932 LDX #&84 :\ BBC_fdc_stat 2934 LDY #&87 :\ BBC_fdc_data 2936 LDA #&80 :\ BBC_fdc_base 2938 BNE &2940 :\ bne Setup1 - always .Master_setup 293A LDX #&26 :\ Master_fdc_stat 293C LDY #&2B :\ Master_fdc_data 293F LDA #&24 :\ Master_fdc_base .setup1 2940 STA &A0 :\ sta fdc_base_lo - patch for indirection 2942 LDA #&FE :\ Load io_page (Sheila) high byte 2944 STA &A1 :\ sta fdc_base_hi 2946 STX &0D02 :\ stx nmi_stat - Patch nmi status read 2949 JSR getR2data :\ Are we performing write? 294C BEQ &2952 :\ zero is No! go to setup2 for read 294E STY &0D0E :\ sty nmi_wr - patch the nmi write code 2951 RTS .setup2 2952 STY &0D0B :\ sty stat_rd - patch the nmi read code 2955 RTS .tube_claim 2956 LDA #&Cl :\ A = 193 (&C0 + 1) to claim tube 2958 JSR tube_entry :\ Call tube data transfer at &0406 295B BBC_tube_claim :\ If C = 0 failed, repeat until success 295D RTS .tube_setup 295E LDX #&00 :\ Fill in dma address .fdc_dma1 296O JSR getR2data :\ Read tube R2data - get 1 of 4 bytes 2963 STA &2816,X :\ Store it in cpm_dma,x 2966 INX 2967 CPX #&04 :\ Done 4 times? 2969 BNE &2960 :\ No! - Repeat fdc_dma1 296B JSR getR2data :\ Read tube R2data get r/w command 296E STA &2A1B :\ Store tube R2data at rw_cmd 2971 RTS .tube_program 2972 LDA &281B :\ A = stored rw_cmd - dma claimer type 2975 LDX #&16 :\ set X to cpm_dma low byte 2977 LDY #&28 :\ Set Y to cpm_dma high byte 2979 JSR tube_entry :\ call tube data transfer at &0406 297C RTS .tube release 297D LDA #&81 :\ A = 129 (&80 + 1) to release tube 297F JSR tube_entry :\ call tube code at &0406 - release tube 2982 RTS \ ******************************************************************* \ These routines claim or release NMI ownership according to whether \ tube data transfer is to take place or disc access is required. In \ practical terms only one of three facilities can be the current NMI \ owner, the disc system, the network handler (econet), or the tube. \ A copy of this routine's NMI code is kept at nmi_image (&29DB) and \ transferred to page &D when NMI ownership is required. The routines \ are called by the code in tube_call_1 to tube_call_4. \ ******************************************************************* .nmi_claim 2983 LDA #&8F :\ Setup paged ROM service request 2985 LDX #&0C :\ for NMI claim, service call number placed in X 2987 LDY #&FF 2989 JSR osbyte :\ Claim NMI routine 298D STY &299A :\ Store original NMI ROM No. at nmi_owner 298F RTS .nmi_release 2990 LDA &299A :\ Load Y with original nmi_owner 2993 LDA &298F :\ set up Paged ROM service request 2995 LDX #&0B :\ for NMI release 2997 JMP osbyte :\ Release NMI to previous owner .nmi_owner 299A EQUB 0 .move_NMI_data 299B LDX #&1F :\ Move 32 bytes of NMI data to page &D .nmi_su1 299D LDA &29DB,X :\ lda nmi_image,x - (saved orig NMI data) 29A0 STA &0D00,X :\ sta nmi_code,x (Restore to NMI page &D) 29A3 DEX :\ Completed 32 times? 29A4 BPL &299D :\ No! - repeat from nmi_su1 29A6 RTS .nmi_next_sect 29A7 LDY #&04 :\ ldy #fdc_stat - status reg offset 29A9 LDX (&A0),Y :\ lda (fdc_base),y - get the status 29AB STA &281A :\ sta ram_status - save for return status 29AE AND &281D :\ and error_mask - any error bits on? 29B1 BNE &29D5 :\ bne nmi_next_exit - Yes! - abort it 29B3 LDA &28lE :\ lda ram_cmnd - test for group1 (seek ea) 29B6 BPL &29D5 :\ bpl nmi_next_exit - Yes! then finished 29B8 LDA &2810 :\ lda sector_count - get \aining sectors 29BB CMP #&01 :\ cmp #1 - is it the last one? 29BD BEQ &29D5 :\ beq nmi_next_exit - signal final int. 29BF DEC &281C :\ dec sector_count - count down sectors 29C2 LDY #&06 :\ ldy #fdc_sect 29C4 LDA (&A0),Y :\ lda (fdc_base),y - get the sector reg 29C6 CLC :\ Clear carry flag 29C7 ADC #&01 :\ Move to next sector 29C9 STA (&A0),Y :\ sta (fdc_base),y - and insert new value 29CB LDA &281E :\ lda ram_cmnd - get read/write 29CE AND #&F3 :\ \ove head settle delay 29D0 LDY #&04 :\ ldy #fdc_cmnd 29D2 STA (&A0),Y :\ sta (fdc_base),y - fire off again 29D4 RTS .nmi_next_exit 29D5 LDA #&FF :\ Flag an FDC event 29D7 STA &29F6 :\ Set status_pending to return status 29DA RTS .nmi_image 29DB PHA :\ save context 0D00 29DC LDA &FE00 :\ 6845 address register 0D0l 29DF AND #&1F :\ Get error bits 0D04 29E1 CMP #&03 :\ DRQ + Busy? 0D06 29E3 BNE &29ED :\ Final interrupt - nmi_exit 0D08 29E5 LDA tubeR3data :\ Either this or the next ins 0D0A 29E8 STA tubeR3data :\ patched to point to FDC 0D1D 29EB PLA :\ Restore context 0D10 29EC RTI :\ Return from interrupt 0D11 .nmi_exit 29ED TYA :\ 0D12 29EE PHA :\ Save Y 0D13 29EF JSR nmi_next_sect :\ Next sector or finish 0D14 29F2 PLA :\ Restore context 0D17 29F3 TAY :\ Restore Y 0D18 2SFA PLA :\ Restore A 0D19 29FB RTI :\ Return from interrupt ODlA .status_pending 29FC EQUB 0 :\ 0D1B .return 29F7 RTS :\ Return from OSWORD \ ********************************************************* \ Copy bit patterns to 6502 for block write & graphics \ This part of the code fills 6502 screen RAM with bit \ patterns sent across by the 80186. \ This can either be font bytes in alpha mode or \ virtual graphics screen bytes in graphics mode. \ Operations are: \ a) send screen address MSB - or zero to stop \ b) send screen address LSB \ c) send 8 font bytes, or 1 byte for background/space fill \ d) send sync byte - or &FF to repeat from a) \ e) wait for sync response \ f) inc\ent pointer, go to c) \ ********************************************************* .graph_write 29F8 CLI :\ Enable interrupts 29F9 CLD :\ Ensure we operate in binary .next_addr_hi 29FA JSR getR2data :\ Read R2 for hi-byte until data received 29FD BEQ &29F7 :\ no data? - finished - go to RTS 29FF STA &71 :\ Store R2 contents at zero page &71 .next_addr_lo 2A01 LDA tubeR2stat :\ Read R2 status until ready 2A04 BPL &2A01 :\ Not ready? - repeat, branch .next_addr_lo 2A06 LDA tubeR2data :\ Read R2 for lo-byte 2A09 TAY :\ and keep in Y 2A0A LDA #&00 :\ clear low byte 2A0C STA &70 :\ Zero &70 (real low byte is in Y) \ ******************************************************** \ Writing to the screen is optimised for maximum possible \ speed, hence these routines are written 'longhand' and \ so avoid the use of counters, instructions to dec\ent \ them and the tests to check when the loop is complete. \ Spaces are further optimised because they are the most \ frequently written character and only need a single \ fill byte. They are therefore the easiest to write too \ as no reading of tubeR1data is required between bytes. \ transfer_loop1 writes spaces, transfer_loop2 other bytes. \ ******************************************************** .transfer_loop1 2A0E LDA tubeR2stat :\ Read R2 status - wait for vsync byte 2A11 BPL &2AOE :\ Repeat until 8 bytes ready in R1 buffer 2A13 LDA tubeR2data :\ Read R2 data-\ove sync byte/check chr 2A16 BEQ &2A43 :\ If 0 go to transfer_loop2 - get 8 bytes 2A1B CMP #&FF :\ either a space or the end of output 2A1A EEC &29FA :\ &FF = end. branch next_addr_hi to repeat 2A1C LDA tubeR1data :\ Read R1 data for space fill pattern 2A1F STA (&70),Y :\ and move same byte into main screen RAM 2A21 INY :\ 8 times as fast as possible 2A22 STA (&70),Y 2A21 INY 2A25 STA (&70),Y 2A27 INY 2A28 STA (&70),Y 2A2A INY 2112 STA (&70),Y 2fl9 INY 2A2E STA (&70),Y 2A30 INY 2A31 STA (&70),Y 2AS3 INY 2A34 STA (&70),Y 2A36 INY 2A37 BNE &2A0E :\ wait for sync unless on page boundary 2A39 INC &71 :\ Inc\ent high byte first 2A3n BPL &2AOE :\ check for wrap around - bpl .transter_loop1 2A3n LDA #&40 :\ go back to bottom of screen 2A3F STA &71 :\ by resetting hi byte 2A41 BNE &2A0E :\ quickest jump to transfer_loop1 .transfer_loop2 2A43 LDA tubeR1data :\ Read R1 data - 1st byte - 7 left 2A46 STA (&70),Y 2A48 INY 2A49 LDA tubeR1data :\ Read R1 data - 2nd byte - 6 left 2A4C STA (&70),Y 2A4E INY 234F LDA tubeR1data :\ Read R1 data - 3rd byte - 5 left 2A52 STA (&70),Y 2A54 PHY 2A55 INA tubeR1data :\ Read R1 data - 4th byte - 4 left 2A56 STA (&70),Y 2A5A INY 2A5B LDA tubeR1data :\ Read R1 data - 5th byte - 3 left 2A5E STA (&70),Y 2A60 INY 2A61 INA tubeR1data :\ Read R1 data - 6th byte - 2 left 2A64 STA (&70),Y 2A66 INY 2A67 LDA tubeR1data :\ Read R1 data - 7th byte - 1 left 2A6A STA (&70),Y 2A6C INC 2A6D LDA tubeR1data :\ Read R1 data - 8th byte - buffer empty 2A70 STA (&70),Y :\ (unless already re-filled by 186) 2A72 INY 2A73 BNE &2AOE :\ wait for sync unless on page boundary 2A75 INC &71 :\ Inc\ent high byte first 2A77 BPL &2A0E :\ Check wrap around - bpl transfer_loop1 2A79 LDA #&40 :\ Go back to bottom of screen 2A7B STA &71 :\ by resetting hi byte 2A7D BNE &2A0E :\ Branch to transfer_loop1... always \ CRT OSWORD - programs CRT controller, handles initialisation \ ************************************************************ .osword_fc 2A7F JSR getR2data :\ Get CRT controller tegister number 2A82 BMI &2A90 :\ Return on &FE 2A84 STA &FE00 :\ write 6845 CRTC address register 2A87 JSR getR1data :\ Get data byte for 6845 2A8A STA &FE00 :\ write 6845 CRTC data register 2A8D JMP &2A7F :\ Repeat until &FF received .osword_fc_1 2A90 TAX :\ Get command code 2A91 INX :\ In it &FF? 2A92 BEQ exit :\ Yes! - finished 2A94 INX :\ Is it &FE? 2A95 BNE &2ACC :\ bne osword_fc_2 - initialise Mouse code 2A97 SEI :\ set interrupt disable 2A98 LDA irqv1 :\ Load original int. 1 vector lo-byte 2A9B STA &2BEA :\ Store in oldirq1+1 2A9E LDA irqvl+1 :\ Load original int - 1 vector hi-byte 2AA1 STA &2B8B :\ Store in oldirq1+2 2AA4 LDA #newirq1+1 MOD 256 :\ new_irq low byte 2AA6 STA irqv1 :\ Store in IRQ1 vector low byte 2AA9 LDA #newirq1 DIV 256 :\ new_lrq high byte 2AAB STA irqv1+1 :\ Store in IRQ1 vector high byte 2AAE CLI :\ re-enable interrupts 2AAF LDA #0 :\ Enable user-port input 2AB2 STA &FE62 :\ Store in up_rdwrt - userport data dir 2AB4 LDA #&98 :\ enable CB1, CB2 interrupts 2As6 STA &FE6E :\ write interrupt enable register 2An9 LDA &FE6B :\ Read auxiliary control register values 2ABC AND #1 :\ leave PA, disable PB latching & timers 2ABE STA &FE6B :\ write auxiliary control register 2A01 LDA &FE6C :\ Read peripheral control register 2AC4 AND #&F :\ Clear CB1, CB2 bits 2AC6 STA &FE6C :\ write peripheral control register 2AC9 JMP &2A7F :\ JMP osword_fc to wait for cormaends .osword_fc_2 2ACC INX :\ is it &FD (intercept events)? 2ACD BNE &2AE8 :\ bne osword_fc_3 - No, continue 2ACF LDA eventvec :\ Yes! - load event vector low byte 2AD2 STA oldevent+1 :\ Store it 2An5 LDA eventvec+1 :\ Load event vector high byte 2AD8 STA oldevent+2 :\ store it 2ADB LDA #newevent MOD 256 :\ Load new event low byte 2ADn STA eventvec :\ Replace original 2AE0 LDA #newevent DIV 256 :\ Load new event high byte 2AE2 STA eventvec+1 :\ Replace original 2AE5 JMP &2A7F :\ Jump osword_fc to wait for commands .osword_fc_3 2AE6 INX :\ is it &FC (was write mouse port) 2AE9 BNE exit :\ No! - continne 2AEB JMP &2A7F :\ rest - next coninand .exit 2AEE RTS :\ return from OSWORD .fdc_event 2AEF LDX &281A :\ ldx ram_status - FDC status ret'd in X 2AF2 LDY #0 :\ zero Y for now 2AF4 STY &29F6 :\ zero the status_pending flag 2AF7 LDA #&A :\ Generate event 10 - FDC result waiting .oldevent 2AF9 EQUB &4C :\ JMP instruction - for saved_vector .event l0 :\ Jump address of original event code 2AFA EQUB 0 .event_hi 2AFB EQUB 0 \TWO KEY ROLLOVER PROCESSING DONE HERE ON VSYNC EVENT \**************************************************** .eventcode 2AFC CMP #4 :\ Event 4 (vsync)? 2AFE BNE &2AF9 :\ No! - branch oldevent 2B00 LDA &29F6 :\ Read Status_pendIng - FDC status o/s? 2B03 BEQ &2B08 :\ No! - Continue 2B05 JSR fdc_event :\ jsr fdc_event to ret. pending FDC status .eventcode1 2B08 JSR keyscan :\ JSR SHFT/CTRL scan at &2B7B 2B0B PHP :\ save status flags on stack 2B0C LDA key1 :\ Read current key pressed 2B0E AND #&7F :\ Clear top bit 2B10 PLP :\ Recover status flags from stack 2B11 PHP :\ then re-save them again for SHIFT 2B12 BPL &2B16 :\ Branch no_ctrl if CTRL not pressed 2B14 ORA #&80 :\ CTRL was pressed - set top bit .no_ctrl 2316 TAX :\ store current key in x 2B17 LDA key2 :\ Read last key pressed 2B19 AND #&7F :\ Clear top bit 2B1B PLP :\ Recall scan status for SHIFT 2B1C BVC &2B20 :\ Branch no_shift if SHIFT not pressed 2B1E ORA #&80 :\ SHIFT was pressed - set top bit .no_shift 2B20 TAY :\ store last key in Y 2B21 LDA #4 :\ Re-load vsync event 2B23 JSR oldevent :\ Re-issue original event \************************************************************** \The current key (if any in now in X - The top bit always set \if CONTROL was pressed, even when no other key was pressed. \The previous key, (if any) is now in Y - The top bit always set \if SHIFT was pressed, even when there is no previous key press. \*************************************************************** .async_command 2B26 JSR read_R4 :\ Read tube R4 data 2B29 BEQ &2B7A :\ exit if R4 - zero - finished 2B2B TAX :\ store in x 2B2C DEX :\ Dec\ent R4 value 2B2D BNE &2B3E :\ R4 was > 1 - go to async_mouse \UPDATE 6845 CRTC CONTROL REGGISTERS \*********************************** \ r4=l .async_cursor 2B2F JSR read_R4 :\ Read tube R4 data - get 6845 reg. addr. 2B32 STA &FEOO :\ write 6845 CRTC address register 2B35 JSR read_R4 :\ Read tube R4 data - get the data byte 2B38 STA &FE01 :\ write 6845 CRTC data register 283B JMP &2B26 :\ Repeat async_command \READ USERPORT AbiD TRANSFER DATA \******************************** \r4=2 .async_mouse 2B3E DEX :\ 2 = mouse 2B3F BNE &2B64 :\ R4 was > 2 - go to async_leds 2B41 LDA amx :\ R4 wan 2 - read amx 2544 PHP :\ Store flags for Z 2545 LDA userport :\ Read userport 2B48 PLP :\ Recover Z flag 2B49 BEQ &2B4F :\ Not AMX, trackball? - brancb async_mouse_1 2B4B ROL A :\ AMX buttons are top bits 2B4C ROL A :\ so move them to the bottom 2B4D ROL A 2B4E ROL A :\ bits 5, 6 and 7 are now 0, 1. 2 .async_mouse_1 2B4F AND #7 :\ mask off the buttons 2B51 EOR #7 :\ invert the bits 2553 JSR write_R1 :\ Write tube R1 data to send to 186 2B56 LDX #3 :\ Set count for 4 bytes of co-ords .async_mouse_2 2B58 LDA &2821,X :\ read mouse_y_hi,X 2B53 JSR write_Rl :\ write tube R1 data - send mouse data 2B5E DEX :\ from &2821 2B5F BPL &2B58 :\ four times So branch async_mouse_2 if incomplete 2B61 JMP &2B26 :\ JMP async_command \SET KEYBOARD STATUS AND LEDs \**************************** \r4=3 .async_leds 2B64 DEX 2365 BNE &2B26 :\ R4 > 3 - read tube again at async_command 2B67 JSR read_R4 :\ Read tube R4 data 2B6A TAX :\ put in X 2B6B LDA #&CA :\ set up FX 202 - write keyboard status 2B6D LDY #0 :\ Y = 0, X parameter from R4 2n6F JSR osbyte :\ set keyboard statua according to R4 2B72 LDA #&76 :\ set up FX l18 2874 JSR osbyte :\ Set keyboard LEDs 2377 JMP &2B26 :\ Jump async_command .exit 2B7A RTS .keyscan :\ scans shift and control key presses 2B7B CLC :\ clear carry and overflow flags to 2B7C CLV :\ indicate botb SHIFT+CTRL scan required 2B7D JMP (keyvec) :\ Exit through orig. kybd vector routine \******************************************** WARNING! MASKABLE INTERRUPT CODE FOLLOWS \X and Y must be preserved here. !!! The \original contents of A are preserved by the \MOS, in zero page &FC. This also must be \reloaded before exiting - with an RTI if we \process the interrupt, or if we jump to the \original vector because we're not interested \******************************************** .newirq1 2B80 LDA &FE6D :\ Load int flag register - is it mouse? 2B83 AND #&18 :\ mask=00011000 - CBl and CB2 active edge? 2B85 BNE &2B8C :\ At least one - go to new_irq_code 2B87 LDA &FC :\ Not CB1 not CB2 - restore A, forget it .oldirq1 :\ Drop thru to here on any other int. 2B89 EQUB &4C :\ JMP - for saved_original vector .irq_lo :\ saved jump address of orig IRQ1 code 2B8A BRK .irq_hi 2B8B BRK .new_irq_code 2B8C STA &2C2A :\ Masked int flags in RAM in ifr_copy 2B8F LDA userport :\ Load VIA input reg B - tracker ball? 2B92 STA &2C2B :\ store it at orb_copy 2B95 AND #&18 :\ Mask it - these bits always hi for AMX 2B97 CMP #&18 :\ Both set? - if either low must be trackball 2B99 BEQ &2BAA :\ Yes! - AMX no new_irq_code2 2B9B LDA #0 :\ Mark as tracker ball by storing 0 2B9D STA &2C27 :\ in AMX to override default 2BA0 LDA #8 :\ y quad signal is different to default 2BA2 STA &2C28 :\ store it in RAM - in mouse_x_quad 2BA5 LDA #&10 :\ and x quad signal is different too 2BA7 STA &2C29 :\ store it in RAM in mouse_x_quad .new_irq_code2 2BAA LDA &2C2A :\ masked int flag reg copy - ifr_copy 2BAD AND #&10 :\ Mask with 00010000 - is it X? 2BAF BEQ &2BDF :\ No! - must be Y, branch new_irq_code5 2BB1 LDA &2C2E :\ Get peripheral control copy - pcr_copy 2BB4 EOR #&10 :\ Invert pos/neg edge bit 2BB6 STA &2C2E :\ Store in pcr_copy - update PCR edge 2BB9 LDA &2C2C :\ Load x_edge - get edge triggering mode 2BBC EOR #&FF :\ Invert it 2BBE STA &2C2C :\ re-store in x_edge 2BC1 EOR &2C2B :\ quad sig, orb_copy, invert if pos edge 2BC4 AND &2C28 :\ X component in mouse_y_quad 2BC7 BNE &2BD4 :\ Decrease? - Yes - branch new_irq_code3 2BC9 INC &2824 :\ Else, inc\ent the low byte - mouse_x_lo 2BCC BNE &2BDF :\ and if that becomes 0 - new_irq_code5 2BCE INC &2823 :\ Inc the high edge - mouse_x_hi too 2BD1 JMP &2BDF :\ Jump to new_irq_code5 for Y component .new_irq_code3 2BD4 LDA &2824 :\ Dec - so load the low eage - mouse_x_lo 2BD7 BNE &2BDC :\ If not 0 jump new_irq_code4, skip 2BD9 DEC &2823 :\ Dec\ent of mouse_x_hi .new_irq_ccde4 2BDC DEC &2824 :\ Dec\ent mouse_x_lo .new_irq_code5 2BDF LDA &2C2A :\ Read masked int flag contents- ifr_copy 2BE2 AND #&08 :\ Is there any input from Y? 2BE4 BEQ &2C14 :\ No! - jump new_irq_code8 2BE6 LDA &2C2E :\ Get peripheral ctrl register - pcr_copy 2BE9 EOR #&40 :\ Invert pos/neg bit 2BEB STA &2C2E :\ Update peripheral ctrl reg - pcr_COPY 2BEE LDA &2C20 :\ Get edge triggering mode - y_edge 2BF1 EOR #&FF :\ Invert it 2BF3 STA &2C2D :\ Store in y_edge 2BF6 EOR &2C2B :\ Quad sigs. invert if pos - orb_copy 2BF9 AND &2C29 :\ Look at mouse_y_quad 2BFC BNE &2009 :\ Inc\ent? - No! branch new_irq_code6 2BFE INC &2822 :\ Else, inc\ent as per X - mouse_y_lo 2C01 BNE &2C14 :\ Not zero? - branch new_irq_code8 2C03 INC &2821 :\ Inc\ent mouse_y_hi 2C06 JMP &2C14 :\ Jump new_irq_code8 .new_irq_code6 2C09 LDA &2B22 :\ Dec\ent as per X - mouse_y_lo 2COC BNE &2C11 :\ Not zero? - branch new_irq_code7 2C0E DEC &2821 :\ Dec\ent mouse_y_hi .new_irq_code7 2C11 DEC &2822 :\ Dec\ent mouse_y_lo .new_irq_code8 2C14 LDA &FE6C :\ Read real peripheral control register 2C17 AND #&0F :\ preserve the bottom nibble but set 2C19 ORA &2C2E :\ the \ainder to our copy in pcr_copy 2C1C STA &FE6C :\ Re-write peripheral control register 2C1F LDA #&18 :\ Load CB1 and CB2 active edge bits 2C21 STA &FE6D :\ write IFR to clear our interrupt 2C24 LDA &FC :\ Recover A to interrupt entry state 2C26 RTI :\ Return from interrupt 2C27 .amx EQUQ &FF :\ default is AMX (0 = Tracker) 2C28 .mouse_y_quad EQUB 1 :\ 01 = AMX, (08 = Tracker) 2C29 .mouse_x_quad ECUB 4 :\ 04 = AMX, (10 = Tracker) 2C2A .ifr_copy BRK :\ RAM copy of IFR state 2C2B .orb_copy BRK :\ RAM copy of user port B 2C2C .x_edge BRK :\ defines pos/neg edge triggering 2C2D .y_edge BRK :\ defines pos/neg edge triggering 2C2E .pcr_copy BRK :\ Local copy of PCR .osword_fe 2C2F RTS \********************************************************* \NOTE:- A local copy of the peripheral control register is \maintained at pcr_copy because someone is reprogramming \the VIA when they shouldn't be, leading to mouse reversal \- suspect a Master 128 hardware problem (??) \********************************************************* \HARD DISK OSWORD \**************** .OSWORD_fe 2C30 RTS :\ not imp1emented .pad EQUB 0 \ ************************************************************** \ ********************** EMD OF CODE *************************** \ ************************************************************** OSWORD &FA source listing It should be noted that major bugs exist in the OSWORD &FA code which are virtually guaranteed to cause problems when the function is called from DOS Plus. Users are therefore warned that they should proceed with ext\e caution when testing new routines which call this code and should consider the following points if (i.e. when) problems are encountered. First, the original designer of the code seerns to have been unaware of various differences between the three host machifles' MOS variables and functions. For example OSBYTE &FB has no fundion in a model B or B+ but is called in the routine at &2517 to d'e& the current shadow setting. Also reading or writing the contents of ROMSEL at &FE30 may have undefined implications in a model B. Worst than this however, is that certain areas in memory mapped I/C, specifically ACCCON at &FE34, are not common to all versions of host. An attempt to read ACCCON in any host except a Master produces a nonsense result. Although this is in itself harmless, the result of an attempt to write ACCCON in either a model B or B+ (as at &26EB) is totally unpredictable and will almost certainly cause an immediate crash. The code shown here is downloaded from the 512's ROMs on either a hard or a soft break. It therefore does not vary with the host type and can be guaranteed to hang the system in a Model B or B+ because of the instruction at &26EB which attempts to re-instate ACCCON's contents as originally recorded at &251C. In a Master 128 ACCCON is designated as read/write, but readers should be aware that in spite of this fact the OSWORD &FA routine is not reliable in a Master either. While investigating the disassembly provides no clue as to a reason, in all the tests conducted by myself calling OSWORD &FA from DOS Plus hangs a Master 128 too! In addition word transfers seem to be inconsistently unreliable. Single byte transfers of types 0 and 1 and page transfers (types 6 and 7) appear to be reliable provided that writing to ACCCON is prevented. However, word transfers from the 512 (type 2) sometimes do not function correctly, sometimes doing nothing at all (including the transfer) occasionally hanging the system. On balance however, type two transfers probably function correctly more often than not. The fault is ext\ely obscure, but so far as testing has been able to determine, it appears to depend on a combination of both the host target address and the type of transfer performed the last time the routine was called. The only consistent fact to emerge from lengthy tests is that if any specific type 2 transfer in a sequence of transfers does fail, it can be reproduced and will fail consistently unless one of the attendant conditions is changed. If this particular problem is encountered users are advised to avoid it if possible by changing the target address rather than attempting to find the cause. OSWORD &FA code \ ******************* \ ZERO PAGE WORKSPACE \ ******************* \ &70 - LSB of parameter block in host RAM \ &71 - MSB of parameter block in host RAM \ &72 - Storage of current paged ROM number \ &73 - Storage of current shadow setting \ &74 - LSB of host RAM data address \ &75 - MSB of host RAM data address \ &76 - MSB of length of data to be transferred \ &77 - LSB of length of data to be transferred \ Note: Pararameters &76 and &77 are NOT in error. They \ are reversed from the usual low-byte-high-byte format \ Zero page MOS variables \ *********************** &F4 = romnum :\ MOS copy of the current ROM number \ Mos calls used by this code \ *************************** osbyte &FFF4 :\ General MOS call entry \ SHEILA memory mapped I/O addresses \ ********************************** &FE30 = romsel :\ The page ROM select latch &FE34 = acccon :\ The paged ROM access control \ *********************************************************** \ Initial entry to this code is after all other possibilities \ have been exhausted, by first the MOS, then by 6502.SYS. If \ the call is not an OSWORD &FA, control is passed to the MOS \ default handler, giving the familiar 'Bad command' error, \ which is passed across the tube as described in chapter 4. \ *********************************************************** 2500 CLC :\ clear carry for tube claim 2501 BCC &2505 :\ branch to osword_test - always .default_handler 2503 BRK :\ Contains the address of the MOS 2504 BRK :\ 'unknown OSWORD' default handler \2503 10 E3 :\ EQUW &E310 .osword_test 2505 CMP #&FA :\ is this an OSWORD &FA? 2S07 BEQ &250C :\ Yes - branch osword_confirmed 2509 JMP (&2503) :\ No - jump to default_handler .osword_confirmed 250C STX &70 :\ Store low byte of parameter address 250E STY &71 :\ Store hi byte of parameter address 2510 PHA :\ Store A on the stack 2511 LDA #&FB :\ Set up OSBYTE 251 to read 2513 LDX #&00 :\ the state of the host's current 2515 LDY #&FF :\ shadow/main RAM selection 2517 JSR osbyte :\ Current setting returned in X 2SlA STX &73 :\ Store current shadow setting 251C LDA accoon :\ Read contents of &FE34 in SHEILA 251F PHA :\ Store it on the stack .tube_claim 2520 LDA #&C7 :\ Load tube claim identifier (This :\ code pretends to be a video disc) 2522 JSR tube_entry :\ Claim the tube 2525 BCC &2520 :\ Failed? - repeat till success 2527 LDY #&00 :\ Index to parameter 1 2529 LDA (&70),Y :\ Read total number of parameters 252B CMP #&0D :\ &D = RAM access, &E = paged ROM access 252D PHP :\ Store flags - z = 0 means normal RAM 252E LDA &F4 :\ Read MOS copy of curr. paged ROM number 2530 STA &72 :\ Store in zero page 2532 LDY #&0D :\ Index of memory access byte parameter 2534 LDA (&70) ,Y :\ Read memory access type byte 2536 TAX :\ Transfer to X 2537 LDY #&02 :\ Index to host RAM address parameter 2539 LDA (&70),Y :\ read LSB of host memory addtess 253B STA &74 :\ store in zero page base 253D INY :\ Inc\ent index 253E LDA (&70),Y :\ Read MSB of host memory address 2540 STA &75 :\ store in zero page base 2542 PLP :\ Pull flags stored at &252D 2543 BEQ &2585 :\ Branch on normal RAM access 2545 TXA :\ Memory access type byte to A 2546 PHA :\ Store memory access type on stack 2547 AND #&40 :\ Isolate screen memorv bit (sm) 2549 BNE &255E :\ Not zero means write screen RAM only 254B TXA :\ Recover access type byte again 254C AND #&20 :\ Isolate screen address bit (m/s) 254E BNE &2554 :\ Not zero means use shadow screen .set_main_access 2550 LDX #&00 :\ zero in X 2552 BEQ &2556 :\ Branch select_ram - always .set_shadow_access 2554 LDX #&01 :\ Set access for shadow screen .select_ram 2556 LDA #&6C :\ OSBYTE l08 sel. scr. for direct access 2558 JSR osbyte :\ on contents of X - 0 = main, 1 = shadow 255A JMP &2577 :\ Jump get_rom_number .write_screen_RAM_only 255E LDA #&84 :\ OSBYTE 132 read top of user RAM (HIMEM) 2560 JSR osbyte :\ Returns X = low byte, Y = high byte 2563 CPY #&80 :\ HIMEM = &8000? Yes means shadow 2565 BNE &256F :\ no - branch to shadow_test 2567 LDA #&01 :\ Load A with 1 2569 CMP &73 :\ compare to current shadow setting 256B BNE &2554 :\ Not equal branch to net_shadow_access 256D BEQ &2550 :\ Branch set_main_access - a1ways .shadow-test 256F LDA #&02 :\ Load A with 2 2571 CMP &73 :\ Compare to current shadow setting 2573 BNE &2550 :\ Not equal - branch to set_main_access 2575 BEQ &2564 :\ Branch to set_shadow_access - always .get_rom_number 2577 PLA :\ pull memory access type from stack 2578 TAX :\ store in X 2579 AND #&10 :\ Isolate ROM type number (bit 4) 257B BNE &2585 :\ Not zero - use current ROM nuriber 257D TXA :\ Recover memory access type byte 257E AND #&0F :\ Isolate required ROM number (bits 0-3) 2580 STA &F4 :\ stare in MOS copy of ROM number 2582 STA romsel :\ Store at &FE30 in SHEILA .ROM_nunber_set 2585 LDY #&0A :\ Index at transfer length paraneter 2587 LDA (&70),Y :\ Read LSB of transfer length 2589 STA &77 :\ Store in zero page 258B INY :\ Inc\ent index to parameter &0B 258C LDA (&70),Y :\ Read MSB of transfer length 258E STA &76 :\ Store in zero page 2590 ORA &77 :\ Check transfer length LSB = MSB = zero 2592 BNE &2596 :\ Not zero - continue 2594 BEQ &2604 :\ LSB = MSB - 0 means complete 2596 LDA &77 :\ Reload transfer length LSB 2598 BEQ &259C :\ Integral page transfer? 259A INC &76 :\ No - Inc\ent transfer length MSB 259C INY :\ Inc\ent index to parameter &C 259D LDA (&70),Y :\ Read transfer type (0 to 3, 6 or 7) .set_transfer_type 259F PHA :\ store transfer type on stack 25A0 LDA &77 :\ Reload transfer length LSB 25A2 BEQ &25B5 :\ If LSB = 0 transfer is whole pages 25A4 LDA &76 :\ Load transfer length MSB 25A6 CMP #&01 :\ single page 25A8 BNE &25B5 :\ No - it's a multi-page 25AA PLA :\ Recover transfer type from stack 25AB PHA :\ and re-store for further time 25AC CMP #&06 :\ Is it type 6 or 7 (256 byte transfer) 25AE BCC &25B5 :\ Yes branch to get_address 25B0 PLA :\ Neither - get transfer type 25B1 SEC :\ Set the carry flag 25B2 SBC #&06 :\ subtract 6 25B4 PHA :\ Store the result on the stack .get_address 25B5 LDA &70 :\ Load the low byte parameter address 25B7 CLC :\ Clear carry 25B8 ADC #&06 :\ Add 6 25BA TAX :\ Transfer to x 25BB LDA #&00 :\ Clear A 25BD ADC &71 :\ Load the high byte parameter address 25BF TAY :\ Transfer to Y 25C0 PLA :\ Recover the transfer type byte 25C1 PHA :\ and re-store for further use 25C2 JSR tube_entry :\ Call tube host code 25C5 LDX &77 :\ LSB at transfer length into X 25C7 PLA :\ Recover transfer type 25C8 LDY #&00 :\ Clear Y 25CA CMP #&00 :\ Transfer type 0? (1 byte to host) 25CC BEQ &25EC :\ Yes - branch to jump_type_0 25CE CMP #&01 :\ Transfer type 1? (1 byte from host 2500 BEQ &2607 :\ YES - branch to type_1_transfer 25D2 CMP #&02 :\ Transfer type 2? (2 bytes to host) 25D4 BEQ &261F :\ Yes - branch to type_2_transfer 25D6 CMP #&03 :\ Transfer type 3? (2 bytes from host 25D8 BEQ &264A :\ Yes - branch to type_3_transfer 25DA CMP #&06 :\ Transfer type 6? (1 page to host) 25DC BEQ &25E6 :\ Branch to jump_type_6 25DE CMP #&07 :\ Transfer type 7? (1 page from host) 25E0 BEQ &25E9 :\ Branch to jump_type_7 25E2 LDA #&00 :\ must be finished 25E4 BEQ &2604 :\ indirect jump to release tube .jump_type_6 25E6 JMP &2675 :\ Long jump to type_ 6_transfer .jump_type_7 25E9 JMP &26A3 :\ Long jump to type_7 transfer .jump_type_0 25EC JSR waste_some_time :\ waste some time .type_zero_transfer :\ transfers single bytes from 512 to host at 24 µsecs/byte 25EF LDA tubeR3data :\ Read data from tube register 3 25F2 STA (&74),Y :\ Store it at indexed host address 25F4 JSR waste_some_time :\ waste some time 25F7 INC &74 :\ Inc\ent host address low byte 25F9 BNE &25FD :\ If we haven't crossed a page boundary 25FB INC &75 :\ else inc\ent the address high byte 25FD DEX :\ and dec\ent the count 25FE BNE &25EF :\ Finished 256 bytes? No - Repeat 2600 DEC &76 :\ Decrenent MSB of length 2602 BNE &25FF :\ and go back for the next byte 2604 JMP &26DA :\ Jump to release_tube .type_1 transfer :\ Transfers single byte from host to 512 at 24 µsecs/byte 2607 LDA (&74),Y :\ Read data from host memory 2609 STA tubeR3data :\ Write it to tube register 3 260C JSR waste_some_time :\ waste some time 260F INC &74 :\ Inc\ent host address low byte 2611 BNE &2615 :\ If we haven't crossed a page boundary 2613 INC &75 :\ Inc\ent the host address high byte 2615 DEX :\ and dec\ent the count 2616 BNE &2607 :\ and go back for the next byte 2618 DEC &76 :\ Decreemnnt MSB of length 261A BNE &2607 :\ Not zero - not finished 261C JMP &26DA :\ Jump to release_tube .type_2_transfer :\ Transfers words from 512 to host at 26 µsecs/word 261F JSR waste_some_time :\ Waste some time .2_bytes_in 2622 LDA tubeR3data :\ Read data from tube register 3 2625 STA (&74),Y :\ Store it at indexed boat address 2627 INC &74 :\ Inc\ent host address low byte 2629 BNE &262D :\ If we haven't crossed a page boundary 262B INC &75 :\ Inc\ent the host addresss high byte 262D NOP :\ Delay for 2 cycles 262E NOP :\ Delay for 2 cycles 262F LDA tubeR3data :\ Read data from tube register 3 2632 STA (&74),Y :\ Store it at indexed host address 2634 INC &74 :\ inc\ent host address low byte 2636 BNE &263A :\ If we haven't crossed a page boundary 2638 INC &75 :\ Inc\ent the high address byte 263A JSR wait_6us :\ waste 12 clock cycles 263D NOP :\ Delay for 2 cycles 263E NOP :\ Delay for 2 cycles 263F DEX :\ dec\ent the count 2640 DEX :\ dec\ent the count 2641 BNE &2622 :\ Not zero? branch for next 2 bytes 2643 DEC &76 :\ else dec\ent the MSB of length 2645 BNE &2622 :\ Not zero? branch to next 2_bytes_in 2647 JMP &26DA :\ Jump to release_tube .type_3_transfer :\ Transfers words from host to 512 at 26 µsecs/word 264A LDA (&74),Y :\ Read data from host memory 264C STA tubeR3data :\ write it to tube register 3 264F INC &74 :\ Inc\ent host address low byte 265l DEC &2656 :\ If we haven't crossed a page boundary 2653 NOP :\ Delay for 2 cycles 2654 BNE &2658 :\ Branch if page boundary crossed 2656 INC &75 :\ Inc\ent the host address high byte 2656 LDA a73 :\ waste 5 cycles (loads shadow setting) 265A LDA (&74) ,Y :\ Load from indexed host menory 265C STA tubeR3data :\ write to tube register 3 265F INC &74 :\ Inc\ent the low address byte 2661 BEQ &2666 :\ If we haven't crossed a page boundary 2663 NOP :\ Delay for 2 cycles 2664 BNE &2665 :\ If we haven't croased a page boundary 2666 INC &75 :\ else inc\ent the high address byte 2668 JSR wait_6us :\ waste 12 clock cycles 266B DEX :\ dec\ent the count 266C DEX :\ dec\ent the count 266D BNE &264A :\ Not zero? branch for next 2 bytes 266F DEC &76 :\ else dec\ent the MSB of length 2671 BNE &264A :\ Not zero? branch for next 2 bytes 2673 BEQ &26DA :\ Branch to release_tube .type_6_transfer :\ Transfers 256 byte block from 512 to :\ host at 10 µsec/byte 2675 JSR waste_some_time :\ waste some time .get_tube_byte 2678 LDA tubeR3data :\ Read data from tube register 3 267B STA (&74),Y :\ Store it at indexed host address 267D NOP :\ Delay for 2 clock cycles 267E NOP :\ Delay for 2 clock cycles 267F NOP :\ Delay for 2 clock cycles 2680 INY :\ Inc\ent the index 268l BNE &2678 :\ Branch get_tube_byte if < 256 bytes 2683 CPX #&00 :\ Have we finished? 2685 BNE &2693 :\ No - Repeat for next page 2687 DEC &76 :\ Dec\ent MSS of length 2689 BEQ &26DA :\ Branch to release_tube .Repeat_page 268B JSR inc\ent_512_offset :\ Inc\ent 512 page address 268E LDA #&06 2690 JMP set_transfer_type :\ Jump to set_transfer_type .set_type_0 2693 DEC &76 :\ dec\ent MSB of length 2695 LDA &76 :\ load LSB of length 2697 CMP #&01 :\ Is this the last page? 2e99 BNE &268B :\ No - branch to repeat_page 269B ASR &2sCe :\ Inc\ent 512 page address 269E LDA #&00 :\ set type zero transfer 26A0 JMP &259F :\ Jump to set_transfer_type .type_7_transfer 26A3 LDA (&74),Y :\ Read data from host memory 26A5 STA tubeR3data :\ write it to tube register 3 26A8 NOP :\ Delay for 2 clock cycles 26A9 NOP :\ Delay for 2 clock cycles 26AA NOP :\ Delay for 2 clock cycles 26AB INY :\ Inc\ent index 26AC BNE &26A3 :\ branch type_7_transfer if < 256 bytes 26AE CPX #&00 :\ Is length LSB = zero? 26B0 BNE &26BE :\ no - branch dec\ent_length_lsb 26B2 DEC &76 :\ Dec\ent MSB of length 26B4 BEQ &26DA :\ If complete, branch to release_tube .set_type_7 26B6 JSR inc\ent_512_offset :\ Inc\ent 512 page address 26B9 LDA #&07 :\ set transter type 7 26BB JMP set_transfer_type :\ jump to set_transfer_type .dec\ent_length_lsb 26BE DEC &76 :\ dec\ent MSB of length 26C0 LDA &76 :\ Load MSB of length 26C2 CMP #&01 :\ is this the last page? 26C4 BNE &26B6 :\ no, set_type_7 26C6 JSR inc\ent_512_offset :\ else, inc\ent 512 offset 26C9 LDA #&01 :\ Set transfer type 1 26CB JMP set_transfer_type :\ Jump to set_transfer_type .inc\ent_512_offset :\ Inc\ents the MSB of 512's offset :\ and the host address by one page 26CE INC &75 :\ Inc\ents the host address high byte 26D0 INY #&07 :\ load index to parameter block 26D2 LDA (&70).Y :\ Load MSB of 512 address 26D4 CLC :\ Clear carry 26D5 ADC #&01 :\ Add 1 page to 512's segment offset 26D7 STA (&70),Y :\ Store at MSB of 512 offset address 26D9 RTS :\ Return .release_tube 26DA LDA #&87 :\ Load A for tube release 26Dc JSR tube_entry :\ Call tube host code 26Dr LDA &72 :\ Load original current ROM number 26E1 CMP &F4 :\ is it consistent with MOS? 26E3 BEQ &26EA :\ Yes it's OK - leave it 26E5 STA &F4 :\ No restore M0S copy of ROM number 26E7 STA romsel :\ and restore &FE3O in SHEILA 26EA PLA :\ Recover contents of ACCCON 26EB STA accon :\ and store at &FE34 in SHEILA 2EEE LDX &70 :\ Restore X 26F0 LDY &71 :\ Restore Y 26F2 PLA :\ Restore A .wait_6us 26F3 RTS :\ Exit .waste_some_time :\ Occupies 24 clock cycles in all 26F4 JSR wait_6uc 26F7 JSR wait_6uc 26FA RTS \*********************** End of OSWORD &FA code ****************** ]NEXT OSCLI"Save "+name$+" "+STR$~mcode%+" "+STR$~O%+" "+STR$~load%+" "+STR$~load% ON ERROR ON ERROR OFF:END *Quit