; ; ****** PROMER V3.1 ****** ; ; Based on the original Acorn PROM Programmer Board (200.007) ; software 'PROMER' listed in the Technical Manual Issue 2 January 1981 ; ; The original Acorn PROM Programmer Board supports National ; Semiconductors (NSC) fusible link PROM's and single supply rail ; 1K, 2K and 4K EPROM's. ; ; This version of PROMER has an improved user interface with ; additional commands for memory manipulation as well as providing ; support for NSC 74S287 256 x 4-bit PROM's and TESLA MH74S287 ; and MH74S571 PROM's. ; ; For TESLA support my Tesla PROM Programmer Board is required. ; ; Please note that on Issue 1 TESLA Programmer PCBs the 8255 base address was ; $1A80 which unfortunately clashes with the Analogue Interface Board. ; On Issue 2 PCBs the links are changed to move the base address to $1B80. ; If you have an Issue 1 PCB you must cut the 'A' link and fit a 'B' link. ; ; Chris Oddy October 2026 ; ; Execute from $2800 (START) ; .define DEBUG 'N' ; if set to 'Y' includes Breakpoint code ; ; *** Zero Page Registers *** ; type := $80 ; 0 - EPROM, 1 - NSC PROM, 2 - Tesla PROM (1 byte) size := $81 ; PROM size 256 ($00) or 512 bytes ($01) (1 byte) hilow := $82 ; PROM low ($00) or high nibble ($80) (1 byte) prctrl := $83 ; control byte for EPROM program (1 byte) vectrl := $84 ; control byte for EPROM verify (1 byte) rdctrl := $85 ; control byte for EPROM read (1 byte) ppctrl := $86 ; control byte for EPROM program pulse (1 byte) device := $87 ; pointer to DEVTAB current device ;($FF if not set) (1 byte) temp := $88 ; temporary storage (1 byte) ctrl := $89 ; control byte (1 byte) from := $8A ; from address (2 bytes) to := $8C ; to address (2 bytes) point := $8E ; pointer in E/PROM routines (2 bytes) fill := $8E ; fill byte in FILL command (1 byte) column := $8F ; column in DUMP command (1 byte) crc := $90 ; CRC checksum (1 byte) mask := $91 ; bit mask in PROM (1 byte) tries := $92 ; number of tries in PROM program (1 byte) extra := $93 ; number of extra blows in PROM program (1 byte) count := $94 ; counter (1 byte) page := $95 ; page counter (1 byte) progs := $96 ; programmers present: (1 byte) ; bit 0 set if Acorn PROM Programmer present ; bit 1 set if TESLA PROM Programmer present base := $97 ; base address for memory workspace (2 bytes) fail := $99 ; failed address in blank and verify (2 bytes) buffer := $0100 ; command input buffer (64 bytes) ; ; *** Debug Storage *** ; brk_a := $C4 ; breakpoint A storage (1 byte) brk_x := $C5 ; breakpoint X storage (1 byte) brk_y := $C6 ; breakpoint Y storage (1 byte) brkpcl := $C7 ; breakpoint PCL storage (1 byte) brkpch := $C8 ; breakpoint PCH storage (1 byte) brk_sr := $C9 ; breakpoint status register (1 byte) stack := $100 ; bottom of processor stack BRKVEC := $0202 ; BRK vector (2 bytes) ; ; *** Hardware Addresses *** ; keybrd := $0E21 ; keyboard ; ; Acorn PROM Programmer (NSC PROM's and all EPROM's) aporta := $1980 ; 8255 Port A - PROM Data D0 to D3 / EPROM Data D0 to D7 aportb := $1981 ; 8255 Port B - PROM/EPROM Address A0 to A7 aportc := $1982 ; 8255 Port C - C0 PROM/EPROM Address A8 ; C1 EPROM Pin 22 Address A9 ; C2 EPROM Pin 19 Address A10 except 2758 AR(0) ; C3 EPROM Pin 18 CE/PGM or Address A11, PROM CE ; C4 EPROM Pin 20 OE or PD/PGM ; C5 PROM RW Control (1 enables Read) ; C6 PROM Power Control (1 enables +10.2V VCC) ; C7 EPROM Power Control (1 enables +26V VPP) actlrg := $1983 ; 8255 control register ; writing these values has this effect: ; $00 resets C0 A8 low ; $01 sets C0 A8 high ; $02 resets C1 A9 low ; $03 sets C1 A9 high ; $04 resets C2 A10 low ; $05 sets C2 A10 high ; $06 resets C3 PROM CE or A11 active/low ; $07 sets C3 PROM CE or A11 inactive/high ; $08 resets C4 EPROM OE or PD/PGM low ; $09 set C4 EPROM OE or PD/PGM high ; $0A resets C5 RW Control Write ; $0B set C5 RW Control Read ; $0C resets C6 PROM Power Control OFF ; $0D sets C6 PROM Power Control ON ; ; TESLA PROM Programmer (Tesla PROM's) tporta := $1B80 ; 8255 Port A - PROM Data D0 to D3 for reading tportb := $1B81 ; 8255 Port B - PROM Address A0 to A7 tportc := $1B82 ; 8255 Port C - C0 PROM Address A8 ; C1 Vcc ON/OFF (0 = Vcc ON) ; C2 Switches between 5V and 10.5V Vcc (0 = 5V, 1 = 10.5V) ; C3 PROM OE (1 = active i.e. low) ; C4-7 PROM Data D0 to D3 for writing tctlrg := $1B83 ; 8255 control register ; writing these values has this effect: ; $00 resets C0 A8 low ; $01 sets C0 A8 high ; $02 resets C1 Vcc ON ; $03 sets C1 Vcc OFF ; $04 resets C2 Vcc=5V ; $05 sets C2 Vcc=10.5V ; $06 resets C3 OE inactive ; $07 sets C3 OE active ; ; *** ASCII Codes *** ; LF := $0A ; LineFeed CR := $0D ; Carriage Return CAN := $18 ; CANcel ESC := $1B ; ESCape SPACE := $20 ; space DEL := $7F ; DELete ; ; *** OS Calls *** ; OSWRCH := $FFF4 ; WRite CHaracter to output channel OSRDCH := $FFE3 ; ReaD CHaracter from input channel OSCRLF := $FFED ; write CRLF to output channel OSECHO := $FFE6 ; reads character from Input channel and ECHOs to output channel OSCLI := $FFF7 ; call Command Line Interpreter ; .org $2800 ; ; ; *** Entry Point *** START: jsr OUTSTR ; output start-up message .byte CR,LF,"*** PROMER V3.1 ***",CR,LF,LF .byte "Ensure no ICs are fitted in sockets",CR,LF,LF nop lda #$00 ; determine which programmers are present sta progs ; set no programmers found lda #$9B ; write $91B to each 8255 control register (all Ports inputs) sta actlrg sta tctlrg lda aporta ; check for Acorn PROM Programmer bne nacorn ; if Port A = 00 its present jsr OUTSTR ; output message .byte "Acorn PROM Programmer found at $1980",CR,LF,LF nop lda #$01 ; set bit 0 sta progs ; and save lda #$90 ; initialise Acorn PROM Programmer sta actlrg ; control register (Port A input, Ports B & C outputs) lda #$00 ; Port C - A8,A9,A10 low (C0,1,2=0), CE,OE low C3,4=0), ; RW write (C5-0), PROM power +5 (C6=0), EPROM power +5 (C7=0) sta aportc nacorn: lda tporta ; check for TESLA PROM Programmer cmp #$0F ; if Port A <> $0F bne ntesla ; its not present jsr OUTSTR ; output message .byte "TESLA PROM Programmer found at $1B80",CR,LF,LF nop lda progs ; retrieve acorn programmer status ora #$02 ; and set bit 1 sta progs ; and save lda #$90 ; initialise Tesla PROM Programmer sta tctlrg ; control register (Port A inputs, Ports B & C outputs) lda #$02 ; Port C - A8 low (C0=0), Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0),D0-3 low (C4-7=1) sta tportc ntesla: lda progs bne prgsok ; if non-zero then at least one programmer is present jsr OUTSTR ; otherwise no programmers found ? .byte "No Programmers Found ?",CR,LF,LF nop rts ; return to OS prgsok: ldx #$FF stx device ; clear current device inx ; X = 0 stx base ; set default base to $4000 ldx #$40 stx base+1 jsr OUTBAS ; output default BASE address jsr OSCRLF ; .if DEBUG = 'Y' ; BRK vector redirection required for DEBUG lda #BRKPNT sta BRKVEC+1 .endif ; RESTRT: jsr COMIN ; read command into buffer jsr PRCLI ; action command jmp RESTRT ; and do it again ; PRCLI: ldx #$FF ; *** PROMER3 Command Line Interpreter *** cld ; X is command table pointer nxtcom: ldy #$00 ; Y is buffer pointer jsr RDIBUF ; ignore leading spaces in buffer lda buffer,y ; check for CR and no command cmp #CR bne nocr ; no - continue to extract command rts ; yes - return nocr: dey ; backup buffer pointer chkcom: iny ; increment buffer pointer inx ; increment command table pointer rdcom: lda COMTAB,x ; read command table beq addres ; end of string found (0) ? cmp buffer,y ; compare with buffer beq chkcom ; if equal compare whole string noteos: inx ; until a difference is found lda COMTAB,x bne noteos ; find end of string (00) inx ; adjust command table pointer for next command string inx ; i.e. point at 2nd byte of address lda buffer,y cmp #'.' ; was command abbreviated ? bne nxtcom ; no - try next command from table iny ; increment buffer pointer past '.' dex ; backup command table pointer to end of string (0) dex addres: inx ; increment pointer to command address lda COMTAB,x ; load MSB sta from+1 ; save lda COMTAB+1,x ; load LSB sta from ; save jmp (from) ; and call command routine ; ; COMMAND TABLE COMTAB: .byte "BASE",$00,>BASE, .byte "BLANK",CR,$00,>BLANK,DEVICE, .byte "DUMP",$00,>DUMP, .byte "EXIT",$00,>EXIT,FILL, .byte "HELP",CR,$00,>HELP,HLPBAS,HLPBLK,HLPDEV,HLPDMP,HLPEXT,HLPFIL,HLPMEM,HLPPGM,HLPRED,HLPVER,MEM, .byte "PROGRAM",$00,>PROGRM,) .byte "READ",$00,>READ,) .byte "VERIFY",$00,>VERIFY,) .byte "*",$00,>OSCOM,COMMES,, if no parameter ; is entered then the current BASE address is output. BASE: jsr RDIBUF ; read next character from input buffer ignoring leading spaces cmp #CR bne getbas ; yes - get
parameter OUTBAS: jsr OUTSTR ; no - output current BASE address .byte "BASE Address set to: " nop ldx #base ; point X at base address jsr OUTWRD ; output jsr OSCRLF rts ; and return getbas: ldx #base ; point X at base jsr HXPARA ; get value bne baseok ; valid hex value entered ? jsr OUTSTR ; no - output error message .byte "Must be a hex address",CR,LF nop rts ; and return nobase: jsr OUTSTR ; output error message .byte "No valid hex value entered ?",CR,LF nop baseok: jsr ENDTST ; check for end of input buffer rts ; and return ; ; *** BLANK Command - check device is blank *** ; no parameters required BLANK: jsr CHKDEV ; check a device has been set bcc bnodev ; if carry clear no device set - exit brept: jsr CBLANK ; do blank check jsr BLMESS ; output blank/not blank message jsr REPEAT ; do it again ? beq brept ; yes - repeat bnodev: rts ; otherwise return ; ; Output Blank or Not Blank Message BLMESS: bne nblank jsr OUTSTR ; output blank message .byte CR,LF,"Device is Blank" nop bmi done ; always branch nblank: jsr OUTSTR ; output not blank message .byte CR,LF,"Device is Not Blank at Address: " nop ; and first non-blank address ldx #fail ; point X at fail address jsr OUTWRD ; output address done: jsr OSCRLF ; final CRLF rts ; and return ; ; *** BLANK Core *** ; (used by BLANK and PROGRAM commands) CBLANK: jsr OUTSTR .byte "Checking Device is Blank: " nop jsr INIPTR ; initialise pointers ldx type ; call either EPROM Blank (0), NSC PROM Blank (1) or Tesla PROM Blank (2) beq beprom ; if 0 - EPROM dex ; NSC PROM ? bne btesla ; if not must be Tesla PROM jsr PBLANK ; call NSC PROM Blank routine rts ; and return btesla: jsr TBLANK ; call Tesla PROM Blank routine rts ; and return beprom: ldy size ; get EPROM size cpy #$02 ; 1, 2 or 4K ? beq betwo ; branch if 2K bmi beone ; branch if 1K ; blank check first 1K of 4K EPROM lda #$00 ; set address MSB for a fail sta fail+1 lda rdctrl ; load control byte (A10 and A11 low) jsr EBLANK ; blank check 4K device (1st quarter) bne bedone ; not blank return ; blank check second 1K of 4K EPROM lda #$04 ; set address MSB for a fail sta fail+1 ora vectrl ; add control byte jsr EBLANK ; blank check 2nd quarter bne bedone ; not blank return ; blank check third 1K of 4K EPROM lda #$08 ; set A11 high sta fail+1 ; save as fail address MSB ora rdctrl ; add control byte jsr EBLANK ; blank check 3rd quarter bne bedone ; not blank return ; blank check fourth 1K of 4K EPROM lda #$0C ; set A10 and A11 high sta fail+1 ; save as fail address MSB ora rdctrl ; add control byte jsr EBLANK ; blank check 4th quarter rts ; and return betwo: ; blank check first 1K of 2K EPROM lda #$00 ; set A10 low sta fail+1 ; save as fail address MSB ora rdctrl ; add control byte jsr EBLANK ; blank check first half of 2K EPROM bne bedone ; not blank return ; blank check second 1K of 2K EPROM lda #$04 ; set A10 high sta fail+1 ; save as fail address MSB ora rdctrl ; add control byte jsr EBLANK ; blank check second half of 2K EPROM bedone: rts ; and return beone: ; blank check 1K EPROM lda #$00 ; set fail address MSB sta fail+1 ora rdctrl ; add control byte jsr EBLANK ; blank check 1K device bdone: rts ; and return ; ; *** DEVICE Command - select device *** ; takes one parameter: ; If no parameter specified then the current ; is displayed (if one has been set). DEVICE: jsr RDIBUF ; ignore leading spaces lda buffer,y ; is there a parameter ? cmp #CR bne setdev ; yes - get parameter jsr CHKDEV ; no - so display current device, has one been set ? bcc devrtn ; no - return jsr OUTSTR ; yes - display it .byte "Device: " nop jmp OUTDEV ; output device label and return setdev: ldx #$00 ; initialise device table pointer sty temp ; save input buffer pointer current position find: ldy temp ; retrieve input buffer pointer stx device ; save pointer to start of current device label fnddev: lda buffer,y ; get next character from input buffer cmp DEVTAB,x ; compare with device label in table beq match ; branch if a match findff: inx ; not this one so pass over rest of this device entry lda DEVTAB,x cmp #$FF ; entry is terminated by $FF bne findff ; keep going till we find it inx lda DEVTAB,X ; then read next entry in table to cmp #$FF ; check for end of table (2nd $FF) bcc find ; no - try and match next device jsr OUTSTR ; yes - no match found ? .byte "Invalid Device ?",CR,LF nop devrtn: rts ; return match: inx ; increment device table pointer iny ; increment input buffer pointer cmp #CR ; have we reached the terminating CR ? bne fnddev ; no - continue comparing characters lda DEVTAB,x ; read device type from table sta type ; and store cmp #$02 ; check appropriate programmer present beq chktes ; is device type a Tesla PROM ? lda progs ; no - must be EPROM or NSC PROM ; check Acorn programmer present and #$01 ; check bit 0 bne progok ; if set programmer present jsr OUTSTR ; no - output message .byte "Requires Acorn Programmer ?",CR,LF nop bmi clrdev ; always branch chktes: lda progs ; check Tesla Programmer present and #$02 ; check bit 1 bne progok ; if set programmer present jsr OUTSTR ; no - output message .byte "Requires Tesla Programmer ?",CR,LF nop clrdev: lda #$FF ; set no device defined sta device rts ; and return progok: lda DEVTAB+1,x ; read device size from table sta size ; and store lda type ; reload device type bne dvprom ; is it an EPROM ? lda DEVTAB+2,x ; yes - read EPROM BLOW control parameter from table sta prctrl ; and store lda DEVTAB+3,x ; read EPROM VERIFY control parameter from table sta vectrl ; and store lda DEVTAB+4,x ; read EPROM READ control parameter from table sta rdctrl ; and store lda DEVTAB+5,x ; read EPROM Program Pulse parameter from table sta ppctrl ; and store bne dvset ; always branches dvprom: lda DEVTAB+2,x ; no - must be a PROM so read PROM hilo parameter from table sta hilow ; and store dvset: jsr OUTSTR .byte "Device Set to:" nop jsr OUTDEV ; output device label jsr SOCKET ; output message as to which socket to use rts ; and return ; ; *** PROM/EPROM Device Data *** ; ; The format of the table is as follows: ; "device label" followed by CR ; device type: 0 - EPROM, 1 - NSC PROM, 2 - Tesla PROM ; size: for PROM's 0 - 256bytes, 1 - 512bytes ; for EPROMs 1 - 1K, 2 - 2K, 4 - 4K ; for PROM's only: nibble $00 - low, $80 - high ; for EPROM's only: control byte for BLOW ; control byte for VERIFY ; control byte for READ ; control byte for program pulse ; and a final $FF to terminate each entry ; DEVTAB: .byte "2758",CR ; 2758 1Kbyte EPROM .byte 0 ; EPROM .byte 1 ; 1 Kbytes .byte $90 ; control byte for BLOW .byte $80 ; control byte for VERIFY .byte $00 ; control byte for READ .byte $07 ; control byte for program pulse .byte $FF ; .byte "2516",CR ; 2516 2Kbyte EPROM (same as 2716) .byte 0 ; EPROM .byte 2 ; 2 Kbytes .byte $90 ; control byte for BLOW .byte $80 ; control byte for VERIFY .byte $00 ; control byte for READ .byte $07 ; control byte for program pulse .byte $FF ; .byte "2716",CR ; 2716 2Kbyte EPROM .byte 0 ; EPROM type .byte 2 ; 2 Kbytes .byte $90 ; control byte for BLOW .byte $80 ; control byte for VERIFY .byte $00 ; control byte for READ .byte $07 ; control byte for program pulse .byte $FF ; .byte "2532",CR ; 2532 4Kbyte EPROM .byte 0 ; EPROM .byte 4 ; 4 Kbytes .byte $90 ; control byte for BLOW .byte $00 ; control byte for VERIFY .byte $00 ; control byte for READ .byte $08 ; control byte for program pulse .byte $FF ; .byte "287L",CR ; NSC 74S287 256byte x 4-bits PROM .byte 1 ; fusible link PROM type .byte 0 ; 256 bytes .byte 0 ; low nibble .byte $FF ; .byte "287H",CR ; NSC 74S287 256byte x 4-bits PROM .byte 1 ; fusible link PROM type .byte 0 ; 256 bytes .byte $80 ; high nibble .byte $FF ; .byte "571L",CR ; NSC 74S571 512byte x 4-bits PROM .byte 1 ; fusible link PROM type .byte 1 ; 512 bytes .byte 0 ; low nibble .byte $FF ; .byte "571H",CR ; NSC 74S571 512byte x 4-bits PROM .byte 1 ; fusible link PROM type .byte 1 ; 512 bytes .byte $80 ; high nibble .byte $FF ; .byte "MH287L",CR ; Tesla MH74S287 256 byte x 4-bits PROM .byte 2 ; fusible link PROM type .byte 0 ; 256 bytes .byte 0 ; low nibble .byte $FF ; .byte "MH287H",CR ; Tesla MH74S287 256byte x 4-bits PROM .byte 2 ; fusible link PROM type .byte 0 ; 256 bytes .byte $80 ; high nibble .byte $FF ; .byte "MH571L",CR ; Tesla MH74S571 512 byte x 4-bits PROM .byte 2 ; fusible link PROM type .byte 1 ; 512 bytes .byte 0 ; low nibble .byte $FF ; .byte "MH571H",CR ; Tesla MH74S571 512byte x 4-bits PROM .byte 2 ; fusible link PROM type .byte 1 ; 512 bytes .byte $80 ; high nibble .byte $FF .byte $FF ; end of table ; ; *** DUMP Command - Dump block of Memory *** ; takes three parameters: and addresses ; and optional DUMP: ldx #from ; point X at address jsr PARAM ; get address from input buffer ldx #to ; point X at address jsr PARAM ; get address from input buffer inc to ; add one to address bne dnoinc inc to+1 dnoinc: ldx #column ; and optionally number of jsr HXPARA ; in output bne dodump ; use default number of columns ? lda #$08 ; yes = 8 sta column dodump: jsr ENDTST ; test for end of input buffer nxtlin: lda column sta temp jsr OSCRLF ; output address ldx #from jsr OUTWRD lda #'|' ; and a delimiter '|' jsr OSWRCH ldy #$00 ; y=0 ldx #from ; point X at from address nxtcol: lda #SPACE jsr OSWRCH lda (from),y ; get a byte jsr OUTBYT ; output jsr INCCMP ; check if last one beq finish ; if so return dec temp ; otherwise check for end of line bne nxtcol ; if not output next byte beq nxtlin ; last column - output next line finish: jsr OSCRLF ; finished - output 2 CRLF's jmp OSCRLF ; and return ; ; *** EXIT Command - Return to OS *** EXIT: jsr OUTSTR .byte "Goodbye",CR,LF nop brk ; and return to OS (doesn't work if DEBUG enabled) ; ; *** FILL Command - Fill block of Memory *** ; takes three parameters: and addresses ; and optional byte to with FILL: ldx #from ; point X at address jsr PARAM ; get address from input buffer ldx #to ; point X at address jsr PARAM ; get address from input buffer clc inc to ; add one to address bcc fnoinc inc to+1 fnoinc: ldx #fill ; point X at temp for parameter jsr HXPARA ; get fill byte bne dofill ; specified ? lda #$FF ; no - use default value $FF sta fill dofill: jsr ENDTST ; test for end of input buffer ldx #from ldy #$00 nxtfil: lda fill ; byte to fill with sta (from),y ; store the byte jsr INCCMP ; increment pointers and compare bne nxtfil ; finished ? rts ; return ; HELP: jsr OUTSTR ; *** HELP Command - output help *** .byte CR,LF,"The following commands are available:",CR,LF,LF .byte "BASE
",CR,LF .byte "BLANK",CR,LF .byte "DEVICE ",CR,LF .byte "DUMP ",CR,LF .byte "EXIT",CR,LF .byte "FILL ",CR,LF .byte "MEM ",CR,LF .byte "PROGRAM ",CR,LF .byte "READ ",CR,LF .byte "VERIFY ",CR,LF .byte "* ",CR,LF,LF .byte "Type HELP for help on a",CR,LF .byte "particular command.",CR,LF,LF .byte "Commands can be abbreviated with '.'",CR,LF,LF nop rts ; and return ; ; *** HELP BASE Command - output help *** HLPBAS: jsr OUTSTR .byte CR,LF,"The BASE command takes one parameter",CR,LF,LF .byte " BASE (
)",CR,LF,LF .byte "The command sets the BASE address of the",CR .byte "memory workspace",CR,LF,LF .byte "The default address is $4000",CR,LF,LF .byte "If no parameter is entered then the",CR,LF .byte "current BASE address is output",CR,LF,LF nop rts ; and return ; ; *** HELP BLANK Command - output help *** HLPBLK: jsr OUTSTR .byte CR,LF,"The BLANK command takes no parameters",CR,LF,LF .byte "The command carries out a blank check of",CR .byte "the selected device.",CR,LF,LF nop rts ; and return ; ; *** HELP DEVICE Command - output help *** HLPDEV: jsr OUTSTR .byte CR,LF,"The DEVICE command takes one parameter",CR,LF,LF .byte " DEVICE ",CR,LF,LF .byte " specifies the programmable",CR,LF .byte "device which can be one of:",CR,LF .byte "EPROMs: 2758, 2516, 2716 or 2532",CR,LF .byte "NSC PROMs: 287L, 287H, 571L or 571H",CR,LF .byte "Tesla PROMs: MH287L, MH287H, MH571L or",CR,LF .byte "MH571H",CR,LF,LF nop rts ; and return ; ; *** HELP DUMP Command - output help *** HLPDMP: jsr OUTSTR .byte CR,LF,"The DUMP command takes 3 parameters",CR,LF,LF .byte " DUMP ()",CR,LF,LF .byte "The command dumps the specified memory",CR,LF .byte "range to the screen with the address",CR,LF .byte "followed by 8 bytes.",CR,LF,LF .byte "The third optional parameter specifies",CR,LF .byte "a different number of bytes to display",CR,LF .byte "on a line.",CR,LF,LF .byte "All values are in hex.",CR,LF,LF nop rts ; and return ; ; *** HELP EXIT Command - output help *** HLPEXT: jsr OUTSTR .byte CR,LF,"The EXIT command returns to the OS",CR,LF,LF nop rts ; and return ; ; *** HELP FILL Command - output help *** HLPFIL: jsr OUTSTR .byte CR,LF,"The FILL command takes three parameters",CR,LF,LF .byte " FILL ",CR,LF,LF .byte "The command fills the specified memory",CR,LF .byte "range with the value .",CR,LF,LF .byte "All values are in hex.",CR,LF,LF nop rts ; and return ; ; *** HELP MEM Command - output help *** HLPMEM: jsr OUTSTR .byte CR,LF,"The MEM command takes one parameter",CR,LF,LF .byte " MEM ",CR,LF,LF .byte "The command displays the address",CR,LF .byte "and current contents of that address.",CR,LF,LF .byte "Pressing the U key will move 'up' to",CR,LF .byte "the next address, pressing V will move",CR,LF .byte "'down' to the previous address.",CR,LF,LF .byte "The contents can be changed by typing a hex value.",CR,LF,LF .byt "Pressing any other key will exit.",CR,LF,LF nop rts ; and return ; ; *** HELP PROGRAM Command - output help *** HLPPGM: jsr OUTSTR .byte CR,LF,"The PROGRAM command takes one parameter",CR,LF,LF .byte " PROGRAM ()",CR,LF,LF .byte "Programs the selected device with the",CR,LF .byte "data stored at address .",CR,LF,LF .byte "If no address is entered then the BASE",CR,LF .byte "address is used.",CR,LF,LF nop rts ; and return ; ; *** HELP READ Command - output help *** HLPRED: jsr OUTSTR .byte CR,LF,"The READ command takes one parameter",CR,LF,LF .byte " READ ()",CR,LF,LF .byte "Reads the selected device and writes",CR,LF .byte "the data to the address.",CR,LF,LF .byte "If no address is entered then the BASE",CR,LF .byte "address is used.",CR,LF,LF nop rts ; and return ; ; *** HELP VERIFY Command - output help *** HLPVER: jsr OUTSTR .byte CR,LF,"The VERIFY command takes one parameter",CR,LF,LF .byte " VERIFY ()",CR,LF,LF .byte "Reads the selected device and compares",CR,LF .byte "the contents with the data stored at",CR,LF .byte "address .",CR,LF,LF .byte "If no address is entered then the BASE",CR,LF .byte "address is used.",CR,LF,LF nop rts ; and return ; ; *** MEM Command - read/modify memory *** ; takes one parameter: address MEM: ldx #from ; point X at address jsr PARAM ; get address from input buffer jsr ENDTST ; test for end of input wraddr: jsr OSCRLF ; output CR LF jsr OUTWRD ; output address dex ; backup X to point at from address dex wrdata: lda ($00,x) ; read data from memory location sta temp ; save it jsr OUTBYT ; output byte jsr OSRDCH ; read input channel tay jsr HEXKEY ; hex key pressed ? bcs updown ; no - try up and down ldy #$04 shift: asl temp ; shift old byte one digit left dey bne shift ora temp ; OR new digit in sta ($00,x) ; alter memory location contents lda #DEL ; move cursor over old byte jsr OSWRCH ; with two deletes jsr OSWRCH bne wrdata ; write out new data updown: cpy #'U' ; up key 'U' pressed ? bne down inc from ; increment address bne wraddr ; then rewrite it inc from+1 bcs wraddr down: cpy #'V' ; down key 'V' pressed ? bne crlf ; some other key ? - output CR LF and return lda from ; decrement address bne nodec dec from+1 nodec: dec from bcs wraddr ; always branch to rewrite address crlf: jmp OSCRLF ; output CR LF and return ; ; *** OS Command *** OSCOM: ldy #$00 ; move command in buffer down one to overwrite '*' movcom: lda buffer+1,y ; get command from input buffer sta buffer,y ; put back in input buffer cmp #CR ; until CR found beq calcom ; finished iny ; else increment pointer cpy #$3F ; check for end of buffer (64 characters) bne movcom ; and move rest of command lda #CR ; end of buffer reached sta buffer,y ; put a CR at end of buffer and calcom: jmp OSCLI ; pass to OS and return ; ; *** PROGRAM Command - program device *** ; takes one parameter: address of data PROGRM: jsr CHKDEV ; check a device has been set bcc prexit ; if carry clear no device set - exit jsr CPYBAS ; copy BASE address to jsr RDIBUF ; read next character from input buffer ignoring leading spaces cmp #CR ; is it a CR ? beq puseb ; yes - use BASE ldx #from ; no - get parameter, point X at address jsr PARAM ; get address from input buffer puseb: jsr ENDTST ; check for end of input buffer prrept: jsr CBLANK ; check device is blank jsr BLMESS ; output blank/not blank message jsr CONTIN ; continue ? bne prexit ; no - return jsr PRCORE ; do program jsr OSCRLF jsr REPEAT ; do it again ? beq prrept ; yes - repeat prexit: rts ; otherwise return ; ; *** PROGRAM Core *** PRCORE: jsr INIPTR ; initialise pointers for programming jsr PRGMES ; output Programming message ldx type ; call either EPROM Program (0), NSC PROM Program (1) ; or Tesla PROM Program (2) beq eprog ; if 0 - EPROM dex ; NSC PROM ? bne ptesla ; if not must be Tesla PROM jsr PPROG ; call NSC PROM Program routine rts ; and return ptesla: jsr TPROG ; call Tesla PROM Program routine rts ; and return eprog: lda prctrl ; EPROM - load control byte ldy size ; get EPROM size cpy #$02 ; 1, 2 or 4K ? beq eptwo ; branch if 2K bmi epone ; branch if 1K jsr EPROG ; program 4K device (1st quarter) ora #$04 ; control byte for 2nd quarter (A10 high, A11 low) jsr EPROG ; program 2nd quarter eor #$0C ; control byte for 3rd quarter (A10 low, A11 high) eptwo: jsr EPROG ; program 2K device 1st half / 3rd quarter ora #$04 ; control byte for 2nd half / 4th quarter (A10 high) epone: jsr EPROG ; program 1K device / 2nd half / 4th quarter pdone: jsr OSCRLF rts ; otherwise return ; ; *** READ Command - read device into memory *** ; takes one parameter: (
) ; if no parameter is entered then the BASE address is used READ: jsr CHKDEV ; check a device has been set ? bcc rexit ; if carry clear no device set - return jsr CPYBAS ; copy BASE address to jsr RDIBUF ; read next character from input buffer ignoring leading spaces cmp #CR ; is it a CR ? beq ruseb ; yes - use BASE ldx #from ; no - get parameter, point X at address jsr PARAM ; get address from input buffer ruseb: jsr ENDTST ; check for end of input buffer rrept: jsr OUTSTR .byte "Reading Device: " nop jsr CREAD ; do read jsr OSCRLF jsr REPEAT ; do it again ? beq rrept ; yes - repeat rexit: rts ; otherwise return ; ; *** READ Core *** CREAD: jsr INIPTR ; initialise pointers and CRC ldx type ; call either EPROM Read (0), NSC PROM Read (1) ; or Tesla PROM Read (2) beq eread ; if 0 - EPROM dex ; NSC PROM ? bne rtesla ; if not must be Tesla PROM jsr PREAD ; call NSC PROM Read routine rts ; and return rtesla: jsr TREAD ; call Tesla PROM Read routine rts ; and return eread: lda #$00 ; EPROM - load initial control byte (A10 and A11 low) ldy size ; get EPROM size cpy #$02 ; 1, 2 or 4K ? beq ertwo ; branch if 2K bmi erone ; branch if 1K jsr EREAD ; read 4K device (1st quarter) lda #$04 ; control byte for 2nd quarter (A10 high, A11 low) jsr EREAD ; read 2nd quarter lda #$08 ; control byte for 3rd quarter (A10 low, A11 high) ertwo: jsr EREAD ; read 2K device 1st half / 3rd quarter ora #$04 ; control byte for 2nd half / 4th quarter (A10 high) erone: jsr EREAD ; read 1K device / 2nd half / 4th quarter jsr CRCOUT ; output CRC (EPROM only) rdrept: jsr OSCRLF ; output CR LF rts ; and return ; ; *** VERIFY Command - verify device against memory *** ; takes one parameter: address for data VERIFY: jsr CHKDEV ; check a device has been set ? bcc vnodev ; if carry clear no device set - return jsr CPYBAS ; copy BASE address to jsr RDIBUF ; read next character from input buffer ignoring leading spaces cmp #CR ; is it a CR ? beq vuseb ; yes - use BASE ldx #from ; no - get parameter, point X at address jsr PARAM ; get address from input buffer vuseb: jsr ENDTST ; check for end of input buffer vrept: jsr CVERFY ; do verify ; jsr REPEAT ; do it again ? beq vrept ; yes - repeat vnodev: rts ; otherwise return ; ; *** VERIFY Core *** CVERFY: jsr OUTSTR .byte "Verifying Device: " nop jsr INIPTR ; initialise pointers and CRC ldx type ; call either EPROM Verify (0), NSC PROM verify (1) or Tesla PROM verify (2) beq veprom ; if 0 - EPROM dex ; NSC PROM ? bne vtesla ; if not must be Tesla PROM jsr PVERFY ; call NSC PROM Verify routine beq verok ; verify OK bne vernok ; verify not OK vtesla: jsr TVERFY ; call Tesla PROM Verify routine beq verok ; verify OK bne vernok ; verify not OK veprom: ldy size ; get EPROM size cpy #$02 ; 1, 2 or 4K ? beq evtwo ; branch if 2K bmi evone ; branch if 1K ; verify first 1K of 4K EPROM lda #$00 ; set address MSB for a fail sta fail+1 lda vectrl ; load control byte (A10 and A11 low) jsr EVERFY ; verify 4K device (1st quarter) bne vernok ; verify second 1K of 4K EPROM lda #$04 ; set address MSB for a fail sta fail+1 ora vectrl ; add control byte jsr EVERFY ; verify 2nd quarter bne vernok ; verify fail - branch ; verify third 1K of 4K EPROM lda #$08 ; set A11 high sta fail+1 ; save as fail address MSB ora vectrl ; add control byte jsr EVERFY ; verify 3rd quarter bne vernok ; verify fail - branch ; verify fourth 1K of 4K EPROM lda #$0C ; set A10 and A11 high sta fail+1 ; save as fail address MSB ora vectrl ; add control byte jsr EVERFY ; verify 4th quarter bne vernok ; verify fail - branch beq verok ; 4K EPROM verify OK evtwo: ; verify first 1K of 2K EPROM lda #$00 ; set A10 low sta fail+1 ; save as fail address MSB ora vectrl ; add control byte jsr EVERFY ; verify first half of 2K EPROM bne vernok ; verify fail - branch ; verify second 1K of 2K EPROM lda #$04 ; set A10 high sta fail+1 ; save as fail address MSB ora vectrl ; add control byte jsr EVERFY ; verify second half of 2K EPROM bne vernok ; verify fail - branch beq verok ; 2K EPROM verify OK evone: ; verify 1K EPROM lda #$00 ; set fail address MSB sta fail+1 ora vectrl ; add control byte jsr EVERFY ; verify 1K device bne vernok ; verify fail - branch verok: jsr OUTSTR ; verify OK - output message .byte CR,LF,"OK" nop ldx type ; only output CRC for EPROM bne nocrc jsr CRCOUT ; output CRC nocrc: jsr OSCRLF ; CR LF rts ; and return vernok: jsr OUTSTR ; verify not OK - output message .byte CR,LF,"FAIL at Address: " nop ldx #fail ; point X at fail address jsr OUTWRD ; output jsr OSCRLF rts ; and return ; ; ****** EPROM ROUTINES ****** ; ; *** EPROM Blank *** ; no entry parameters, return Z=1 if blank EBLANK: sta ctrl ; save control byte lda #$90 ; set Port A (Data) to input sta actlrg lda #$00 sta page ; clear page counter tay ; and byte pointer ecpage: lda page ; get page counter (A8 and A9) ora ctrl ; OR in control byte sta aportc ; and update Port C ecnloc: sty aportb ; set address LSB sty fail ; save as fail address LSB in case not blank lda aporta ; read EPROM data cmp #$FF ; blank ? bne ecfail ; branch if not iny ; next location bne ecpage ; do all 256 bytes of page lda #'*' ; output a * for each page checked jsr OSWRCH inc page ; increment page counter inc fail+1 ; increment fail address MSB lda page ; read page counter cmp #$04 bne ecpage ; do all 4 pages php ; save status lda ctrl ; reload control byte plp ; retrieve status ecfail: rts ; and return (Z=1 if blank) ; ; *** EPROM Read *** EREAD: sta ctrl ; save control byte lda #$90 ; set Port A, data to input sta actlrg lda #$00 sta page ; clear page counter tay ; and byte pointer erpage: lda page ; get page counter (A8 and A9) ora ctrl ; combine with control byte sta aportc ; and update Port C ernloc: sty aportb ; set address lda aporta ; read EPROM location sta (point),y ; store it jsr CRC ; add to CRC iny ; next location bne ernloc ; do all 256 bytes of page inc point+1 ; increment address pointer MSB lda #'*' ; output a * for each page read jsr OSWRCH inc page ; increment page counter lda page ; read page counter cmp #$04 bne erpage ; do all 4 pages lda ctrl ; reload control byte rts ; and return ; ; *** EPROM Verify *** ; no entry parameters, on exit Z=1 if verify OK ; verifies 1K of EPROM i.e. four 256 byte pages EVERFY: sta ctrl ; save control byte lda #$90 ; set Port A, data to input sta actlrg lda #$00 sta page ; clear page counter tay ; and byte pointer evpage: lda page ; get page counter (A8 and A9) ora ctrl ; OR with ctrl sta aportc ; and update Port C evnloc: sty aportb ; set address LSB sty fail ; save as fail address LSB in case verify fails lda aporta ; read EPROM jsr CRC ; add to CRC cmp (point),y ; compare with memory bne evrtn ; return with Z=0 iny ; next location bne evnloc ; do all 256 bytes of page inc point+1 ; increment address pointer MSB lda #'*' ; output a * for each page checked jsr OSWRCH inc page ; increment page counter inc fail+1 ; increment fail address MSB lda page ; read page counter cmp #$04 bne evpage ; do all 4 pages ; lda ctrl ; reload control byte ldx #$00 ; Z=1 evrtn: rts ; and return ; ; *** EPROM Program *** EPROG: sta ctrl ; save control byte lda #$80 ; all Ports are outputs sta actlrg lda #$00 sta count tay eppage: lda count ; page counter (A8 and A9) ora ctrl ; OR with ctrl sta aportc ; and update Port C epnloc: sty aportb ; set address lda keybrd ; check for escape key cmp #ESC bne noesc brk ; emergency exit - return to OS noesc: lda (point),y ; read from memory cmp #$FF ; if $FF beq goon ; then nothing to do sta aporta ; send to Port A data jsr FLIPBT ; and apply program pulse goon: iny ; next location bne epnloc ; do all 256 bytes inc point+1 ; increment pointer MSB inc count lda #'*' ; output a * for each page programmed jsr OSWRCH inc page lda count cmp #$04 bne eppage ; do all 4 pages lda #$90 sta actlrg ; switch things off lda ctrl ; retrieve control byte rts ; and return ; ; *** EPROM Programming Pulse *** FLIPBT: lda ppctrl sta actlrg ; flip bit defined in ppctrl ldx #$19 ; now wait 50mS dlylp: dec temp bne dlylp dex bne dlylp eor #$01 sta actlrg ; return bit to previous level rts ; and return ; ; ****** NSC Fusible Link PROM Routines ****** ; ; *** NSC PROM BLANK **** ; no entry parameters, returns Z=1 if blank PBLANK: ldy #$00 ; reset byte pointer sty fail+1 ; save address MSB for a fail ldx size ; 256 or 512 bytes (0 or 1) lda #$90 ; set control byte for reading (Port A input) sta actlrg lda #$30 ; set Port C for lower half C5=1 for read, C0(A8)=0 pbfull: sta aportc pbpage: sty aportb ; set address LSB lda aporta ; read PROM data and #$0F ; mask lower nibble bne pbfail ; blank (0) ? - branch if not iny ; next location bne pbpage ; read all 256 bytes of page lda #'*' ; output a * for each page checked jsr OSWRCH lda #$31 ; set Port C for upper half C5(PROM RW)=1 Read, C0(A8) = 1 inc fail+1 ; increment fail address MSB dex ; decrement PROM size beq pbfull ; do the other half if 512 byte PROM lda #$00 ; set Z pbfail: rts ; and return (Z=1 if blank) ; ; *** NSC PROM Read *** ; no entry parameters, no return values PREAD: ldy #$00 ; reset byte pointer ldx size ; 256 or 512 bytes (0 or 1) lda #$90 ; set control byte for reading (Port A input) sta actlrg lda #$20 ; set Port C for lower half C5(PROM RW)=1 Read, C0(A8)=0 prfull: sta aportc prpage: sty aportb ; set address LSB lda (from),y ; get current data from destination location bit hilow ; check for upper or lower nibble bpl prlow ; lower - branch and #$0F ; upper nibble - mask and save lower half sta temp ; of current data lda aporta ; read byte from PROM asl a ; shift to upper nibble asl a asl a asl a jmp prcom ; and combine data prlow: and #$F0 ; save upper nibble of current data sta temp lda aporta ; load byte from PROM and #$0F ; mask off lower nibble prcom: ora temp ; assemble new byte sta (from),y ; and put it back iny ; increment byte pointer bne prpage ; read all 256 bytes of page lda #'*' ; output a * for each page read jsr OSWRCH dex ; decrement PROM size bne prrts ; when not zero ($FF) finished inc from+1 ; increment memory pointer MSB lda #$21 ; set Port C for upper half C5(PROM RW)=1 Read, C0(A8)=1 bne prfull ; and do the other half if 512 bytes prrts: rts ; and return ; ; *** NSC PROM Verify *** ; no entry parameters, on exit Z=1 if verify OK PVERFY: ldy #$00 ; reset byte pointer sty fail+1 ; save address MSB for a fail ldx size ; 256 or 512 bytes (0 or 1) lda from+1 ; save a copy of from address MSB for repeat sta temp lda #$90 ; set control byte for reading (Port A input) sta actlrg lda #$20 ; set Port C for lower half C5(PROM RW)=1 Read, C0(A8)=0 pvfull: sta aportc pvpage: sty aportb ; set address (A0 to A7) lda (from),y ; get data from memory bit hilow ; check for upper or lower nibble bpl pvlow ; lower - branch lsr a ; upper - shift upper to lower lsr a lsr a lsr a pvlow: eor aporta ; match against data in PROM and #$0F ; keep lower nibble, result should be 0 bne pvnok ; if not return with Z=0 pnoflg: iny ; increment byte pointer bne pvpage ; read all 256 bytes of page lda #'*' ; output a * for each page verified jsr OSWRCH dex ; decrement PROM size bne pvok ; when not zero ($FF) finished inc from+1 ; increment memory pointer MSB inc fail+1 ; increment fail address MSB lda #$21 ; set Port C for upper half C5(PROM RW)=1 Read, C0(A8)=1 bne pvfull ; and do the upper half if 512 bytes pvok: ldx #$00 ; Z=1 pvnok: php sty fail ; save fail address LSB lda temp sta from+1 ; restore from plp rts ; and return ; ; *** NSC PROM Program *** PPROG: ldy #$00 ; reset byte pointer ldx #$00 ; set A8 low for first 256 bytes halfp: lda #$08 ; start on most significant bit sta mask p4bit: lda #$80 ; no of tries at blowing each location sta tries lda #$10 ; no of extra pulses after blowing sta extra jsr PCORE ; go and blow a bit lsr mask ; step to next bit in byte bcc p4bit ; do all four bits iny bne halfp ; and for all 256 bytes lda #'*' ; output a * for each page programmed jsr OSWRCH cpx #$01 ; if A8 high then we have completed 2nd page of 512 byte PROM beq ppfin ; so finished ldx size ; check PROM size 256 or 512 byte (0 or 1) beq ppfin ; if 256 byte then we are finished inc from+1 ; 512 byte - increment memory pointer MSB ldx #$01 ; set A8 high bne halfp ; and do the other half ppfin: dec from+1 ; restore memory pointer MSB rts ; and return ; ; *** Blow an NSC PROM Bit *** PCORE: lda #$80 ; set up Ports for programming (all outputs) sta actlrg sty aportb ; set address - LSB txa ; and A8 ora #$08 ; add control bits C3=1 (PROM CE inactive) sta aportc lda (from),y ; load data to blow bit hilow ; blowing upper or lower nibble ? (N=bit 7) bpl plow ror a ; shift upper nibble down ror a ror a ror a plow: and mask ; mask off current bit beq pcorex ; if zero nothing to program so return sta aporta ; set bit to program lda #$0D ; flip power on C6(PROM Power Control)=1 ON sta actlrg nop ; delay for program pulse width nop nop nop nop lda #$06 ; flip enable on C3(PROM CE)=0 active sta actlrg nop ; delay for program pulse width nop lda #$07 ; enable off C3(PROM CE)=1 inactive sta actlrg lda #$0C sta actlrg ; power off C6 (PROM Power Control)=0 OFF lda #$90 ; set Port A to input to verify bit sta actlrg sty aportb ; set address again - LSB txa ; and A8 ora #$20 ; add control bits C5(PROM RW)=1 Read), C3(PROM CE)=0 active sta aportc lda aporta ; read data back from PROM and mask ; is the bit programmed ? bne pblown ; yes - branch dec tries ; no - decrement tries bne PCORE ; try again ? tya ; no - failed pha jsr OUTSTR ; print a '.' for each failed bit .byte "." nop pla tay rts ; and give up pblown: dec extra ; extra blows for luck bne PCORE pcorex: rts ; and return ; ; ****** Tesla Fusible Link PROM Routines ****** ; ; *** Tesla PROM BLANK **** ; no entry parameters, returns Z=1 if blank TBLANK: ldy #$00 ; reset byte pointer sty fail+1 ; save address MSB for a fail ldx size ; 256 or 512 bytes (0 or 1) lda #$08 ; set Port C for lower half A8 low (C0=0), Vcc 5V (C1=0,C2=0), ; OE active (C3=1), D0-3 inactive (C4-7=0) sta tportc tbpage: sty tportb ; set address LSB sty fail ; save as fail address LSB in case not blank lda tporta ; read PROM data and #$0F ; mask lower nibble bne tbfail ; blank (0) ? - branch if not iny ; next location bne tbpage ; read all 256 bytes of page lda #'*' ; output a * for each page checked jsr OSWRCH lda #$01 ; set A8 high for upper half of PROM sta tctlrg sta fail+1 ; and save as fail address MSB dex ; decrement page count (size) beq tbpage ; do the other half if 512 byte PROM lda #$00 ; set Z tbfail: php ; save status ; lda #$02 ; finished, switch off power - A8 low (C0=0), Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc plp ; retrieve status rts ; and return (Z=1 if blank) ; ; *** Tesla PROM Read *** ; no entry parameters, no return values TREAD: ldy #$00 ; reset byte pointer ldx size ; page count 256 or 512 bytes (0 or 1) lda #$08 ; set Port C for lower half A8 low (C0=0), Vcc 5V (C1=0,C2=0), ; OE active (C3=1), D0-3 inactive (C4-7=0) trfull: sta tportc ; and write to Port C trpage: sty tportb ; set address LSB lda (from),y ; get current data from destination location bit hilow ; check for upper or lower nibble bpl trlow ; lower - branch and #$0F ; upper nibble - mask and save lower half sta temp ; of current data lda tporta ; read byte from PROM asl a ; shift to upper nibble asl a asl a asl a jmp trcom ; and combine data trlow: and #$F0 ; save upper nibble of current data sta temp lda tporta ; load byte from PROM and #$0F ; mask off lower nibble trcom: ora temp ; assemble new byte sta (from),y ; and put it back iny ; increment byte pointer bne trpage ; read all 256 bytes of page lda #'*' ; output a * for each page read jsr OSWRCH cpx #$00 ; if page count 256 bytes (0) beq trfin ; then we are finished dex ; decrement page count inc from+1 ; increment memory pointer for 2nd page lda #$09 ; set Port C for A8 high (C0=1), Vcc 5V (C1=0,C2=0), ; OE active (C3=1), D0-3 inactive (C4-7=0) bne trfull ; and do the other half (branch always) trfin: ldx size ; check PROM size 256 or 512 byte (0 or 1) beq troff ; if 256 byte then we are finished dec from+1 ; if 512 byte restore memory pointer MSB troff: lda #$02 ; switch off power - A8 low (C0=0), Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc ; write to Port C rts ; and return ; ; *** Tesla PROM Verify *** ; no entry parameters, on exit Z=1 if verify OK TVERFY: ldy #$00 ; reset byte pointer sty fail+1 ; save address MSB for a fail ldx size ; 256 or 512 bytes (0 or 1) lda from+1 ; save a copy of from address MSB for repeat sta temp lda #$08 ; set Port C for lower half A8=0 (C0=0),Vcc 5V (C1=0,C2=0), ; OE active (C3=1) tvfull: sta tportc tvpage: sty tportb ; set address (A0 to A7) lda (from),y ; get data from memory bit hilow ; check for upper or lower nibble bpl tvlow ; lower - branch lsr a ; upper - shift upper to lower lsr a lsr a lsr a tvlow: eor tporta ; match against data in PROM and #$0F ; keep lower nibble, result should be 0 bne tvnok ; if not return with Z=0 tnoflg: iny ; increment byte pointer bne tvpage ; read all 256 bytes of page lda #'*' ; output a * for each page verified jsr OSWRCH dex ; decrement PROM size bne tvok ; when not zero ($FF) finished inc from+1 ; increment memory pointer MSB inc fail+1 ; increment fail address MSB lda #$09 ; set Port C for upper half A8 high (C0=1), Vcc 5V (C1=0,C2=0), ; OE active (C3=1), D0-3 inactive (C4-7=0) bne tvfull ; and do the upper half if 512 bytes tvok: ldx #$00 ; finished - verified OK, set Z=1 tvnok: php ; save status sty fail ; save fail address LSB lda temp sta from+1 ; restore from address MSB lda #$02 ; finished, switch off power - Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc plp ; retrieve status rts ; and return (Z=1 if verified OK) ; ; *** Tesla PROM Program *** TPROG: ldy #$00 ; reset byte pointer (address LSByte) ldx #$00 ; set A8 low for first 256 bytes (address MSBit) halft: lda #$08 ; start on most significant bit sta mask t4bit: jsr TCORE ; go and blow a bit lsr mask ; step to next bit in byte bcc t4bit ; do all four bits iny bne halft ; and for all 256 bytes lda #'*' ; output a * for each page programmed jsr OSWRCH cpx #$01 ; if A8 is high then we have completed 2nd page of 512 byte PROM beq tpfin ; so finished ldx size ; check PROM size 256 or 512 byte (0 or 1) beq tpexit ; if 256 byte then we are finished inc from+1 ; 512 byte so increment memory pointer MSB bne halft ; and do the other half (branch always) tpfin: dec from+1 ; restore memory pointer MSB tpexit: rts ; and return ; ; *** Blow a Tesla PROM Bit *** TCORE: lda (from),y ; load data to blow bit hilow ; blowing upper or lower nibble ? (N=bit 7) bpl tlow ; low nibble - branch ror a ; high nibble - shift to lower nibble ror a ror a ror a tlow: and mask ; mask off current bit beq tcorex ; if zero nothing to program, return txa ; get A8 and add control bits ora #$08 ; enable 5V Vcc and OE active - Vcc 5V (C1=0,C2=0), ; OE active (C3=1), D0-3 inactive (C4-7=0) sta tportc ; and write to Port C sty tportb ; write address lda tporta ; read current contents of PROM location and mask ; is it already programmed (1) ? beq tblow ; no - branch lda #$02 ; switch off - A8 low (C0=0), Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc ; write to Port C rts ; and return tblow: lda mask ; reload bit to program asl a ; shift to upper nibble for writing asl a asl a asl a ; this clears the lower nibble (control bits) ; i.e. A8 low, Vcc 5V (C1=0,C2=0), OE inactive (C3=0) cpx #$00 ; low or high page ? beq A8low ora #$01 ; high page - set A8 high A8low: sta tportc ; and write to Port C pha ; save control bits on stack (A8) lda #$05 ; increase Vcc to 10.5V (C2=1) sta tctlrg jsr T60DEL ; settling delay lda #$07 ; take OE active (low) sta tctlrg jsr T10DEL ; 10mS delay lda #$06 ; take OE inactive (high) sta tctlrg jsr T60DEL ; settling delay pla ; retrieve control bits and #$01 ; reduce Vcc to 5V and remove data - Vcc 5V (C1=0,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc jsr T60DEL ; settling delay lda #$07 ; take OE active (C3=1) sta tctlrg lda tporta ; read data back from PROM and mask ; is the bit programmed ? bne tblown ; yes - branch tya pha jsr OUTSTR ; no - print a '.' for each failed bit .byte "." nop pla tay tblown: lda #$02 ; switch off - A8 low (C0=0), Vcc OFF,5V (C1=1,C2=0), ; OE inactive (C3=0), D0-3 inactive (C4-7=0) sta tportc jsr T10DEL ; 40mS cooling period jsr T10DEL jsr T10DEL jsr T10DEL tcorex: rts ; and return ; ; *** Settling Delay (~50uS) *** ; (the Tesla spec for settling time is 10 to 1000uS) T60DEL: lda #$FF ; delay is approximately 60uS t60: asl a bcs t60 rts ; and return ; ; *** Tesla 10mS Delay *** T10DEL: lda #$8F t10: pha jsr T60DEL ; 60uS delay pla sbc #$00 ; decrement accumulator (carry is clear) bne t10 rts ; and return ; ; ****** User Input / Output and Other Routines ****** ; ; *** Output a String of Characters *** OUTSTR: pla ; retrieve return PC (-1) LSB sta temp pla sta temp+1 ; and MSB outnxt: ldy #$00 ; Y=0 ldx #temp ; point x at pc jsr INCCMP ; increment pointer lda (temp),y ; get character from string bmi eos ; end of string ? jsr OSWRCH ; output character jmp outnxt ; next character eos: jmp (temp) ; continue execution after string ; cancel: jsr OSCRLF ; *** Get Command From Buffer *** COMIN: lda #'>' ; display prompt jsr OSWRCH buffin: ldx #$FF nxtchr: inx ; increment buffer pointer cpx #$40 ; buffer full ? (64 bytes) bcs bufful readch: jsr OSECHO ; read character from input channel and echo cmp #CAN ; cancel ? beq cancel ; yes - start again cmp #DEL ; delete ? bne nodel ; no - branch bufful: dex ; backup buffer pointer bpl readch ; and read another character bmi buffin ; start of line - start again nodel: sta buffer,x ; put character in buffer cmp #CR ; CR ? bne nxtchr ; no - read next character rts ; yes - return ; ; *** Read Parameter from Input Buffer *** PARAM: jsr HXPARA ; get hex parameter from input buffer beq synerr ; if not hex - syntax error rts ; hex - return ; ; *** Get (up to) 4-digit Hex Parameter and Store at X *** HXPARA: lda #$00 ; set parameter to 0 sta $00,x sta $01,x sta temp ; clear parameter found flag jsr RDIBUF ; ignore leading spaces rdnxch: lda buffer,y ; read character from input buffer jsr HEXKEY ; is it hex ? bcs delim ; branch if not hex (delimiter character ?) asl a ; shift up a digit asl a asl a asl a sty temp ; temporarily save the input buffer pointer and set parameter flag ldy #$04 shfdig: asl a ; shift X, X+1 and A left one digit (4-bits) rol $00,x rol $01,x dey bne shfdig ldy temp ; retrieve the input buffer pointer iny ; increment buffer pointer bne rdnxch ; always branch to read next character delim: lda temp ; sets Z if no parameter was found rts ; and return ; space: iny ; *** Read the Yth Character From the Input Buffer *** RDIBUF: lda buffer,y cmp #SPACE ; ignoring spaces beq space rts ; and return ; ; *** Test Key Value In A For Hex *** HEXKEY: cmp #'0' ; > '0' ? bcc nothex ; return invalid hex cmp #':' ; < '9' ? bcc hex ; yes - valid hex sbc #$07 ; convert 'A' to 'F' bcc nothex ; if < 'A' then not hex cmp #'@' ; > 'F' ? bcs hexrtn ; return with C=1, invalid hex digit hex: and #$0F ; valid hex digit, convert to ASCII clc ; (unnecessarily set) C=0 hexrtn: rts ; and return, valid hex digit nothex: sec ; C=1 rtn: rts ; and return, invalid hex digit ; ; *** Test For End Of Input Buffer *** ENDTST: jsr RDIBUF ; read character from input buffer cmp #CR ; CR ? beq rtn ; yes - return, end found synerr: jsr OUTSTR ; no - output 'Syntax Error ?' error .byte "Syntax Error ?",CR,LF nop jmp RESTRT ; abort command ; ; *** Increment the Word at X,X+1 and Compare with X+2,3 *** INCCMP: inc $00,x ; increment LSB bne do_cmp ; carry ? inc $01,x ; increment MSB do_cmp: lda $00,x ; compare LSB cmp $02,x bne notequ ; if not equal return lda $01,x ; otherwise compare MSB cmp $03,x notequ: rts ; and return ; ; *** Output the Word at X+1, X *** OUTWRD: lda $01,x ; first byte jsr OUTBYT ; output the second byte (at X+1) inx ; increment the pointer to the next word inx lda $FE,x ; output the first byte (now at X-2) jsr OUTBYT outspc: lda #SPACE ; followed by a space jmp OSWRCH ; and return ; ; Output CRC CRCOUT: jsr OUTSTR ; print out CRC header .byte CR,LF,"CRC: " nop lda crc+1 ; first byte jsr OUTBYT lda crc ; and second byte ; ; *** Output the Byte in A In Hex *** OUTBYT: pha ; save A lsr a ; start with the upper nibble lsr a ; shift to the lower nibble position lsr a lsr a jsr OUTDIG ; and output pla ; retrieve A and output the lower nibble ; ; *** Output the Hex Digit in A *** OUTDIG: and #$0F ; mask off the upper nibble cmp #$0A ; is it A-F ? bcc ascii ; no adc #$06 ; yes - add offset to 'A' ascii: adc #'0' ; convert to ASCII jmp OSWRCH ; output character and return ; ; *** Output "Continue ?" Message and Get Reply *** CONTIN: jsr OUTSTR ; output message .byte "Continue ?" nop jsr OSECHO ; get reply pha jsr OSCRLF pla cmp #'Y' ; if yes Z=1 rts ; return ; ; *** Output "Repeat ?" Message and Get Reply *** REPEAT: jsr OUTSTR ; output message .byte "Repeat ?" nop jsr OSECHO ; get reply pha jsr OSCRLF pla cmp #'Y' ; if yes Z=1 rts ; return ; ; *** Output "Programming:" Message *** PRGMES: jsr OUTSTR .byte "Programming: " nop rts ; and return ; ; *** Check a Device Has Been Set *** CHKDEV: sec ; set carry (device set) ldx device ; device will be $FF if device set inx bne devset ; yes - return set jsr OUTSTR ; no - output message .byte "Device Not Set ?",CR,LF nop clc ; clear carry - no device set devset: rts ; and return ; ; *** Initialise Pointers *** INIPTR: ldx from ; copy from address to point stx point ldx from+1 stx point+1 ldx #$00 stx page ; reset page count stx crc ; clear checksum stx crc+1 rts ; and return ; ; *** Calculate CRC *** CRC: ldx #$08 pha ; save A crclp: lsr A rol crc rol crc+1 bcc noc pha lda crc eor #$2D sta crc pla noc: dex bne crclp pla ; retrieve A rts ; and return ; ; *** Output Device Label *** OUTDEV: ldx device ; pointer to device label nxdvch: lda DEVTAB,x ; get device label character cmp #CR ; and check for end of device label beq dvcrlf ; yes - done jsr OSWRCH ; no - output character inx ; increment device table pointer bne nxdvch ; and always branch to get next character dvcrlf: jsr OSCRLF rts ; and return ; ; *** Output Socket Message *** SOCKET: jsr CHKDEV ; check a device has been set ? bcc srtn ; if carry clear no device set - return ldx type ; get device type bne neprom ; 0 - EPROM jsr OUTSTR ; output message .byte "Use Acorn PROM Programmer lower socket",CR,LF nop srtn: rts ; and return neprom: dex bne nnsc ; 1 - NSC PROM jsr OUTSTR ; output message .byte "Use Acorn PROM Programmer upper socket",CR,LF nop rts ; and return nnsc: jsr OUTSTR ; must be Tesla - output message .byte "Use Tesla PROM Programmer socket",CR,LF nop rts ; and return ; ; *** Copy BASE address to from *** CPYBAS: lda base sta from lda base+1 sta from+1 rts ; and return ; ; ****** DEBUG CODE ****** .if DEBUG = 'Y' ; Breakpoint Handler for DEBUG ; BRKPNT: cld ; Breakpoint Routine Entry sta brk_a ; save A, X and Y stx brk_x sty brk_y tsx ; retrieve stack pointer lda stack+2,x ; pc=pc-2 sec ; i.e. address of BRK instruction sbc #$02 tay sta brkpcl lda stack+3,x sbc #$00 sta brkpch ; save pc lda stack+1,x ; get status register from stack sta brk_sr ; and save jsr OUTSTR ; output pc = program counter value .byte CR,LF,"BREAK at PC=" lda brkpch jsr OUTBYT lda brkpcl jsr OUTBYT jsr OUTSTR ; output CRLF A = accumulator value .byte " A=" lda brk_a jsr OUTBYT jsr OUTSTR ; output X = X register value .byte " X=" lda brk_x jsr OUTBYT jsr OUTSTR ; output Y = Y register value .byte " Y=" lda brk_y jsr OUTBYT jsr OUTSTR ; output PS = status register value .byte " PS=" lda brk_sr jsr OUTBYT jsr OSCRLF ; and a final CR LF jmp RESTRT ; re-enter command line interpreter .endif