KIM Kenner 18 1981 Hans Otten, Translated by Hans Otten 2021
A program to duplicate a KIM-1 cassette tape with multiple files on it. Command driven. Requires enough memory above $2000 to hold the largest file on tape (32K for example)
Version 1.1 added the Check tape command.
Binary V1.1 can be downloaded here.
Requires two cassette recorders controlled via the Remote control, see below for the Micro Ade description of control via KIM PIA PB2 and PB3.
Source in Micro Ade format, , also downloadable here.
************************************ TAPE COPYING PROGRAM ; HJC OTTEN JULY 1981 V1.0 JULY 1982 V1.1 ; BASED ON SUPERDUPE FROM THE FIRST BOOK OF KIM AND THE MICRO ADE CASSETTE ROUTINES ; COPY WILL REPRODUCE A TAPE COMPLETELY AUTOMATIC WHEN READ AND WRITE RECORDERS ARE CONNECTED WITH THE MOTOR CONTROLS OF MICRO ADE ; DURING READ OPERATIONS IT IS POSSIBLE TO STOP THE COPYING BY MAKING PA7 OF PIA 1700 HIGH REMOVE THIS BIT TESTS IF NOT AVAILABLE AT O249, 02D6 AND 02E9 OR CHANGE FOR KIM TTY BREAK THE PIA LOCATION TO 1740 AND THE BRANCH FOLLOWING TO BMI ; INSERT REWINDED READ AND WRITE CASSETTES AND START AT 0200 ; FIRST THE WRITE CASSETTE IS RUN PAST THE LEADER THEN A FILE IS READ , IF FOUND THE ID AND STARTADDRESS ARE DISPLAYED . NEXT THE FILE IS WRITTEN. IF READY THE DISPLAY LINE LOOKS LIKE ID= 01 START= $3600 COPY ! THE DATA FROM THE FILE IS STORED IN A BUFFER AT $2000 WHERE ENOUGH RAM MUST BE AVAILABLE ; THIS PROGRAM CAN EASILY BE MODIFIED TO A CHECKING AND DIRECTORY OF ALL FILES ON A TAPE BY REPLACING THE JUMP 02D0 4C 2A 02 JMP CREAD THAT SKIPS THE WRITING OF A FILE ; ******************************************************* ; COPY ORG $2000 ; ; DEFINES : ; BUFFER * $2300 ; SYNC * $16 ; SYNCHRONISATION CHARACTER EOD * $2F ; END OF DATA EOF * $04 ; END OF FILE SOD * $2A ; START OF DATA FF * $0C ; FORM FEED ; ; ZERO PAGE USE HELPL * $00DD ; HELPH * $00DE ; CHKCOP * $00DF ; CHECK OR COPY FLAG ; RPTRL * $00E0 ; READ POINTER IN BUFFER RPTRH * $00E1 ; WPTRL * $00E2 ; WRITE POINTER IN BUFFER WPTRH * $00E3 ; STRPTL * $00ED ; POINTER IN PRINT STRING STRPTH * $00EE ; CC * $00F1 ; COUNT FIELDS IN WRITE COUNT * $00F2 ; CHKSUM * $00F6 ; CHECKSUM CHKHI * $00F7 ; GANG * $00F5 ; USED BY WRITE ID * $00F9 ; ID OF FILE STADRL * $00FA ; STARTADDRESS OF FILE STADRH * $00FB ; STARTA * $00FC ; CONSTANT FOR INDEXED WRITE TRIB * $00FE ; USED BY WRITE ; ; PIA LOCATIES ; PAD * $1700 ; BREAKKEY IN BIT 7 PBD * $1702 ; PB2 = READ, PB3 = WRITE MOTOR CONTROL PBDD * $1703 ; KPAD * $1740 ; LEDDISPLAY KPADD * $1741 ; KPBD * $1742 ; CASSETTE I/O KPBDD * $1743 ; TIMERT * $1744 ; TIMER TIMER * $1747 ; ; ; KIM MONITOR ROUTINES ; RDBIT * $1A41 ; READ BIT FROM TAPE RDBTK * $19F3 ; READ BYTE FROM TAPE RDCHTK * $1A24 ; READ CHARACTER FROM TAPE (2 BYTE) PACKT * $1A00 ; PACK ASCII TO HEX CHK * $1F91 ; COMPUTE CHECKSUM IN F6,F7 CHKT * $194C ; COMPUTE CHECKSUM IN 17E7,E8 INIT * $1E8C ; INIT KIM PIA'S SPACE * $1E9E ; PRINT SPACE ON TTY OUTCH * $1EA0 ; PRINT ACCU ON TTY PRTBYT * $1E3B ; PRINT ACCU AS TWO HEX CHARACTERS ON TTY CRLF * $1E2F ; PRINT CR + LF ON TTY MNITOR * $1C00 ; KIM MONITOR ENTRY POINT ; ******************************************************* ; MAIN FLOW OF PROGRAM : ; PROGRAM COPY ; INITCOPY REPEAT READ FILE TO BUFFER WRITE BUFFER TO FILE UNTIL FOREVER ; END ; ******************************************************* ; PROCEDURES : ; START CLD ; PROCEDURE INITCOPY LDAIM $0C ; INIT CASSETTE MOTOR CONTROL STA PBDD ; LDAIM $FF ; STA PBD ; LDAIM FF ; CLEARSCREEN JSR OUTCH ; LDXIM $FF ; NEX DEX ; BNE NEX ; LDXIM HELLOM ; PRINTSTRING ('TAPE COPY') LDYIM HELLOM / JSR PRTSTR ; LDXIM ANDMSG ; LDYIM ANDMSG / JSR PRTSTR ; LDXIM CHKMSG ; LDYIM CHKMSG / JSR PRTSTR ; LDXIM VRSMSG ; LDYIM VRSMSG / JSR PRTSTR ; JSR CRLF ; JSR CRLF ; LDXIM CHKMSG ; PRINT ('CHECK OR COPY) LDYIM CHKMSG / JSR PRTSTR ; LDXIM ONLMSG ; LDYIM ONLMSG / JSR PRTSTR ; LDAIM $00 ; CHKCOP FLAG = COPY STA CHKCOP ; JSR GETCH ; WAIT FOR ANSWER PHA ; JSR OUTCH ; ECHO CHARACTER JSR CRLF ; PLA ; CMPIM 'Y ; BNE NOCHK ; IF CHAR <> Y THEN COPY LDAIM $FF ; STA CHKCOP ; LDXIM CHKMSG ; PRINT CHECK LDYIM CHKMSG / JSR PRTSTR ; JMP CREAD ; NOCHK LDXIM COPYMS ; LDYIM COPYMS / JSR PRTSTR ; PRINT COPY LDAIM $F7 ; TURN WRITE CASSETTE MOTOR ON STA PBD ; LDXIM $10 ; DELAY (LEADERCASSETTE) JSR DELAY ; LDAIM $FF ; TURN WRITE CASSETTE MOTOR OFF STA PBD ; END INITCOPY CREAD LDAIM BUFFER / PROCEDURE READ FILE TO BUFFER STA RPTRH ; READPTR := BUFFERSTART STA WPTRH ; WRITEPTR := BUFFERSTART LDAIM $00 ; CHECKSUM := 0 STA CHKSUM ; STA CHKHI ; LDAIM BUFFER ; STA RPTRL ; STA WPTRL ; LDAIM $FB ; TURN READ CASSETTEMOTOR ON STA PBD ; LDAIM $13 ; INIT CASSETTE I/O STA KPBD ; LDAIM $7F ; INIT LEDDISPLAY STA KPADD ; SYN BIT PAD ; REPEAT BPL GOON ; WHILE NOT BYTE = SYNC DO JMP MONRET ; READ(BYTE) GOON JSR RDBIT ; IF BREAK EXIT TO MONITOR LSR ID ; ENDWHILE ORA ID ; READ(BYTE) STA ID ; UNTIL BYTE = START OF DATA STA KPAD ; TST CMPIM $16 ; BNE SYN ; JSR RDCHT ; STA KPAD ; CMPIM $2A ; BNE TST ; JSR RDBYT ; STA ID ; ID := READ(BYTE) LDXIM $FE ; STARTADDRESS := READ(ADDRESS) ADDR JSR RDBYT ; STAZX STARTA ; JSR CHK ; INX ; BMI ADDR ; ; BYTE LDXIM $02 ; WHILE NOT BYTE = END OF DATA DO DUBL JSR RDCHT ; BUFFER(RPOINTER) := READ(CHARACTER) CMPIM EOD ; CHECKSUM := CHECKSUM + CHARACTER BEQ WIND ; RPOINTER := RPOINTER + 1 JSR PACKT ; ENDWHILE BNE ELNK ; DEX ; BNE DUBL ; STAIX RPTRL ; JSR CHK ; INC RPTRL ; BNE OVER ; INC RPTRH ; OVER BNE BYTE ; WIND JSR RDBYT ; RCHECKSUM := READ(CHECKSUM) CMP CHKHI ; BNE ELNK ; JSR RDBYT ; CMP CHKSUM ; PHP ; LDAIM $FF ; TURN READ CASSETTE MOTOR OFF STA PBD ; PLP ; IF RCHECKSUM <> CHECKSUM GREAD FILE TO BUFFER BNE ELNK ; JSR CRLF ; PRINTSTRING ('ID=') LDXIM IDMES ; PRINT (ID) LDYIM IDMES / JSR PRTSTR ; LDA ID ; JSR PRTBYT ; LDXIM STMES ; PRINTSTRING (' START=') LDYIM STMES / JSR PRTSTR ; PRINT (STARTADDRESS) LDA STADRH ; JSR PRTBYT ; LDA STADRL ; JSR PRTBYT ; LDXIM ENMSG ; PRINT ('END = ') LDYIM ENMSG / JSR PRTSTR ; SEC ; LDA RPTRL ; HELP := READPOINTER - BEGINBUFFER SBCIM BUFFER ; STA HELPL ; LDA RPTRH ; SBCIM BUFFER / STA HELPH ; CLC ; HELP := HELP + STARTADDRESS LDA HELPL ; ADC STADRL ; STA HELPL ; LDA HELPH ; ADC STADRH ; JSR PRTBYT ; LDA HELPL ; JSR PRTBYT ; LDA CHKCOP ; BNE ELNK ; IF CHECKCOPY FLAG <> THEN CHECK ONLY JMP CWRITE ; ELNK JMP CREAD ; END READ FILE TO BUFFER ; ; SUBROUTINE READBYTE ; RDBYT BIT PAD ; PROCEDURE READ(BYTE) BMI MONRET ; IF BREAKKEY THEN EXIT TO MONITOR ; JMP RDBTK ; ENDIF MONRET LDAIM $FF ; READ BYTE FROM CASSETTE STA PBD ; END READ BYTE JSR INIT ; JMP MNITOR ; RDCHT BIT PAD ; PROCEDURE READ(CHARACTER) BMI MONRET ; IF BREAKKEY THEN EXIT TO MONITOR JMP RDCHTK ; READ CHARACTER FROM TAPE CWRITE LDAIM $F7 ; PROCEDURE WRITE BUFFER TO FILE STA PBD ; TURN WRITE CASSETTE MOTOR ON LDXIM $08 ; JSR DELAY ; DELAY (FILEGAP) LDAIM $27 ; INIT WRITE CASSETTE I/O STA GANG ; LDAIM $BF ; STA KPBDD ; LDXIM $FF ; COUNT := 255 LDAIM SYNC ; WHILE COUNT > 0 DO JSR NWRITE ; WRITE(SYNCHRONIZATION CHARACTER) LDAIM SOD ; COUNT := COUNT - 1 JSR OUTCHT ; ENDWHILE LDA ID ; WRITE (START OF DATA ) JSR OUTBT ; WRITE (ID) LDA STADRL ; WRITE (STARTADDRESS) JSR OUTBT ; LDA STADRH ; JSR OUTBT ; DATA LDYIM $00 ; WHILE WPOINTER < RPOINTER DO LDAIY WPTRL ; WRITE (BUFFER(WPOINTER)0) JSR OUTBT ; WPOINTER := WPOINTER + 1 INC WPTRL ; ENDWHILE BNE SAMP ; INC WPTRH ; SAMP LDA WPTRL ; CMP RPTRL ; LDA WPTRH ; SBC RPTRH ; BCC DATA ; LDAIM EOD ; WRITE (END OF DATA ) JSR OUTCHT ; LDA CHKHI ; WRITE (CHECKSUM) JSR OUTBT ; LDA CHKSUM ; JSR OUTBT ; LDXIM $02 ; LDAIM $04 ; WRITE (END OF FILE) JSR NWRITE ; LDAIM $FF ; TURN WRITE CASSETTE MOTOR OFF STA PBD ; JSR INIT ; LDXIM COPYMS ; PRINT ('COPY !') LDYIM COPYMS / JSR PRTSTR ; LDAIM '! ; JSR OUTCH ; JMP CREAD ; END WRITE BUFFER TO FILE ; ; SUBROUTINE NWRITE ; NWRITE STX CC ; PROCEDURE NWRITE (N,CHARACTER) HICA PHA ; WHILE N > 0 DO JSR OUTCHT ; WRITE (CHARACTER) PLA ; N := N - 1 DEC CC ; ENDWHILE BNE HICA ; END NWRITE RTS ; ; ; SUBROUTINE OUTBTC ; OUTBTC JSR CHKT ; PROCEDURE WRITE(BYTE) AS TWO ASCII OUTBT PHA ; LSRA ; CHECKSUM := CHECKSUM + BYTE LSRA ; CONVERT LEFT NIBBLE OF BYTE TO ASCII LSRA ; WRITE(ASCII) LSRA ; CONVERT RIGHT NIBBLE OF BYTE TO ASCII JSR HEXT ; WRITE(ASCII) PLA ; END WRITE BYTE HEXT ANDIM $0F ; CMPIM $0A ; CLC ; BMI HEXAT ; ADCIM $07 ; HEXAT ADCIM $30 ; OUTCHT LDYIM $08 ; PROCEDURE WRITE (BYTE) STY COUNT ; COUNT :=8 TRY LDYIM $02 ; WHILE COUNT > 0 DO STY TRIB ; SEND 3 PULSES 3700 HZ ZON LDXAY NPUL ; IF MSB BYTE = 1 THEN PHA ; SEND 3 PULSES 3700 HZ ZONA BIT TIMER ; ELSE BPL ZONA ; SEND 2 PULSES 2400 HZ LDAAY TIMG ; STA TIMERT ; ENDIF LDA GANG ; SEND 2 PULSES 2400 HZ EORIM $80 ; SHIFT BYTE LEFT STA KPBD ; ENDWHILE STA GANG ; END WRITE BYTE DEX ; BNE ZONA ; PLA ; DEC TRIB ; BEQ SETZ ; BMI ROUT ; LSRA ; BCC ZON ; SETZ LDYIM $00 ; BEQ ZON ; ROUT DEC COUNT ; BNE TRY ; RTS ; ; ; TIMING TABLE ; NPUL = $02 ; NUMBER OF 2400 HZ PULSES TIMG = $C3 ; TIMER COUNT = $03 ; NUMBER OF 3700 PULSES = $7E ; TIMER COUNT ; ; DELAY ROUTINE ; DELAY LDYIM $FF ; PROCEDURE DELAY (NR) YLOOP LDAIM $FF ; DELAY TIME * NR ALOOP SEC ; END DELAY SBCIM $01 ; BNE ALOOP ; DEY ; BNE YLOOP ; DEX ; BNE DELAY ; RTS ; ; ; SUBROUTINE PRINT STRING ; PRTSTR STX STRPTL ; PROCEDURE PRINTSTRING(STRINGPTR) STY STRPTH ; PNEXT LDYIM $00 ; WHILE NOT END OF STRING DO LDAIY STRPTL ; PRINT (MEMORY(STRINGPTR) PHA ; STRINGPTR := STRINGPTR + 1 JSR OUTCH ; ENDWHILE PLA ; BMI LAST ; INC STRPTL ; BNE NEXTS ; INC STRPTH ; NEXTS JMP PNEXT ; LAST RTS ; ; ; SUBROUTINE GET CHARACTER ; GETCH BIT PAD ; PROCEDURE GETCHARACTER ( CHAR ) BPL GETCH ; WAIT FOR STROBE GWAIT BIT PAD ; WAIT FOR END OF STROBE BMI GWAIT ; LDA PAD ; GET CHARACTER RTS ; END GETCHARACTER ; ; STRING DATA ; IDMES = 'I = 'D = '= = $A0 ; STMES = ' = 'S = 'T = '= = $A0 ; ENMSG = ' = 'E = 'N = '= = $A0 ; HELLOM = 'T = 'A = 'P = 'E COPYMS = ' = 'C = 'O = 'P = 'Y = $A0 ; ; CHKMSG = 'C = 'H = 'E = 'C = 'K = $A0 ONLMSG = 'O = 'N = 'L = 'Y = ' = '? = $A0 VRSMSG = 'V = '1 = '. = '1 = $A0 ; ANDMSG = 'A = 'N = 'D ; = $A0
See also:
Part 4 Sorbus runs Wozmon, Apple 1 Basic, MCP
The first test run of the Sorbus computer can be done with two simple images: Wozmon with Apple 1 Basic and the MCP prog...
Sorbus computer part 3: the hardware
The hardware of the Sorbus computers could not be simpler. Designed with care to be as flexible as possible, fully progr...
Sorbus computer (part 2)
Soldering the PCBs
I got from Sven PCBs for the Sorbus and the Sorbus Junior. It took an afternoon to solder all part...
The Sorbus computers
A new development! A minimal 65(C)02 system, called Sorbus designed by Sven Oliver Moll (SvOlli).
Thank you Sven for th...