;======================================================
;MCS-4 Control Program for 1702A PROM Programming
;Intel Tapes A0540, A0541, and A0543
;MCS-4 Microcomputer Set User's Manual, Rev 4
;February, 1973 Appendix I, Page 165
;
;(This is not suitable for programming 1702 EPROMs.)
;
;Retyped and reformatted for William C. Colley, III's
;portable 4004, 4040 cross-assembler Ver. 0.1
;by M. Eberhard  21 May 2019
;
;Note: Values are in decimal, as in Intel's source code
;======================================================

;Some equates to make the source code look
;more like it does in the Intel manual

;Condition code equates (in hex)

TZ	equ	01h		;(Could use JNT)
CN	equ	02h		;(Could use JC)
AZ	equ	04h		;(Could use JZ)
CZ	equ	0Ah		;(Could use JNC)
AN	equ	0Ch		;(COuld use JNZ)

;Port name equates

P0	equ	0
P1	equ	1
P2	equ	2
P3	equ	3
P4	equ	4
P5	equ	5
P6	equ	6
P7	equ	7

;======================================================
	ORG	0

START:	ldm	1		;Suppress TTY
	fim	P0,0

	src	P0
	wmp			;Send to RAM port
STA1:	jms	CRLF		;Position pointer

	jms	ST		;Receive input data

	fim	P3,80		;IR(6)=5, IR(7)=0, (P)

	jms	COMPR

	jcn	AN,LISTN

	fim	P0,32		;IR(0)=2, IR(1)=0

	ldm	1
	src	P0
	wr2
	jun	STA2

NEXT:	fim	P3,83		;IR(6)=5, IR(7)=3, (S)

 	jms	COMPR

	jcn	AZ,STA2

 	jms	ERROR

	jun	STA1

LISTN:	fim	P3,76		;IR(6)=4, IR(7)=12,(L)

	jms	COMPR

	jcn	AN,NEXT

	ldm	12
	xch	15		;IR(15)=15
	fim	P0,32		;IR(0)=2, IR(1)=0

	ldm	1
	src	P0
	wr1
STA2:	jms	CRLF

	ldm	14		;Enter address
	xch	10		;IR(10)=14
ADRS2:	ldm	13
	xch	9		;IR(9)=13
ADRS1:	jms	ST

	jms	STORE

	isz	9,ADRS1

	jms	CRLF

	isz	10,ADRS2

	jms	LF

	jms	LF

	jms	ADDTN

	fim	P0,0

	jms	DBIN		;Final address

	ld	3
	wr2			;(C0),R(0),CH(2),LORD 4-bits
	ld	2
	wr3			;C(0),R(0),CH(3),HIORD 4-bits
	fim	P0,3		;IR(0)=0,IR(1)=3

	jms	DBIN		;Initial address

	ld	3
	wr0			;C(0),R(0),CH(0),LORD 4-bits
	ld	2
	wr1			;C(0),R(0),CH(1),HIORD 4-bits
PRGM1:	fim	P2,0		;IR(4-5)=0

	fim	P0,0		;Address 1701 read to write

	src	P0
	rd0
	wrr
	inc	4
	rd1
	src	P2
	wrr
	fim	P0,32		;IR(0)=2, IR(1)=0

	src	P0
	rd1
	rar	
	jcn	CN,NEXT1

	jun	REPT		;Call for input data

NEXT1:	jun	LISTR		;Call listing routine

;BCD to Binary Conversion Routine
DBIN:	fim	P1,0		;IR(2)=0,IR(3)=0
	fim	P2,10		;IR(4)=0,IR(5)=10

	ldm	14
	xch	6
	src	P0
	rdm
	xch	3
BDBN:	inc	1
	src	P0
BB1:	rdm
	jcn	AZ,BB2

	dac
	wrm
	clc
	ld	3
	add	5
	xch	3
	ld	2
	add	4
	xch	2
	jun	BB1

BB2:	fim	P2,100		;IR(4)=6,IR5)=4

	isz	6,BDBN

	bbl	0

ERROR:	fim	P1,191		;IR(2)=11, IR(3)=15, (?)

	jms	PRINT

	bbl	0

STORE:	fim	P0,11		;IR(0)=0,IR(1)=11

	fim	P2,53		;IR(4)=3, IR(5)=5

	fim	P3,52		;IR(6)=3, IR(7_=4

RE1:	src	P3
	rdm
	src	P2
	wrm
	ld	5
	dac
	xch	5
	clc
	ld	7
	dac
	xch	7
	clc
	isz	1,RE1

	ld	3
	src	P2
	wrm
	bbl	0
;
;
;
;
;
;Timing Subroutines
;
SBR1:	fim	P0,0		;IR(0-1)=0

L1:	isz	0,L1		;547 memory cycles

	isz	1,L1

	bbl	0
;
;
SBR2:	fim	P0,8		;IR(0)=0, IR(1)=8

L2:	isz	0,L2		;275

	isz	1,L2

	bbl	0
;
;
; Print Routine
;
PRINT:	fim	P0,16		;IR(0)=1,IR(1)=0

	ldm	7
	src	P0
	wrm
	inc	1
	xch	3
	src	P0
	wrm
	inc	1
	xch	2
	src	P0
	wrm
	fim	P4,16		;IR(8)=1, IR(9)=0

	fim	P1,208		;IR(2)=13, IR(3)-0

ST7:	fim	P2,12		;IR(4)=0, IR(5)=12

	src	P4
	rdm
ST8:	wmp
	xch	4		;Save C(AC) in index reg 4
	jms	SBR1		;Delay routine #1

	jms	SBR2		;Delay routine #2

	isz	5,ST9		;Number of rotations

	inc	9		;Number of digits
	nop
	nop
	nop
	nop
	nop
	isz	2,ST7		;Number of 4-bit words

	ldm	1
	wmp
	bbl	0
ST9:	ldm	12		;C(AC)=12
	xch	7		;C(7)=12
	xch	4		;Restore saved C(AC)
ST12:	isz	7,ST12

	rar
	jun	ST8
;
;
; CR/LF Routine
;
CRLF:	fim	P1,141		;IR(2)=8, IR(3)=13, (CR)

	jms	PRINT

LF:	fim	P1,138		;IR(2)=8, IR(3)=10, (LF)

	jms	PRINT

	bbl	0
;
;
;
;
; Routines for Compare Program
;
;
; Teletype Input Handler
;
TTY:	ldm	1
	fim	P0,64

	src	P0
	wmp
ST:	jcn	TZ,ST		;Wait for start bit

	fim	P0,64		;Set RAM 1 address

	src	P0		;Send RAM address
	ldm	0
	wmp			;Stop reader
	jms	SBR2

	fim	P0,0

	src	P0
	rdr
	cma	
	wmp
	jms	SBR1		;Time out start bit

	fim	P1,0		;Reset data location

	ldm	8
	xch	4
ST1:	jms	SBR2		;5.6 mSec. delay

	clc			;It treats reg. pair 1 (2-3)
	src	P0		;..as if it were 1 8-bit shift
	rdr			;..register, to input data
	cma
	wmp
	rar			;Complelent data to true state
	ld	2		;..and link into reg 2 HIORD word
	rar
	xch	2
	ld	3		;Then link reg 2 overflow to
	rar
	xch	3		;..LORD word to complete shift
	jms	SBR1

	isz	4,ST1		;8 data bits accepted?

	jms	SBR1

	ldm	1
	wmp			;re-suppress Teletype
	ld	2		;Input complete now
	ral
	clc			;Eliminate parity bit
	rar
	xch	2
	bbl	0		;Exit with data in pair (203)
;
;
;
;
;Compare Routine, accepts input in Pair 3
;and Pair 1 will output a (1) if compare
;fails.
;
COMPR:	clc			;Data compare routine
	xch	7
	sub	3
	jcn	AN,NEG		;Test for AC is not 0

	clc
	xch	6
	sub	2
	clc
	jcn	AN,NEG

	bbl	0
NEG:	bbl	1

ADDTN:	fim	P0,0		;IR(0)=0, IE(1)=0

	fim	P2,48		;IR(4)-3, IR(5)=0

	ldm	10
	xch	6
	clc
AD1:	src	P2
	rdm
	src	P0
	adm
	daa
	wrm
	inc	1
	inc	5
	isz	6,AD1

	bbl	0

CLRAM:	ldm	0
	xch	1
CLEAR:	ldm	0
	src	P2
	wrm
	inc	5
	isz	1,CLEAR

	bbl	0
;
;
;
;
;
;
;
REPT:	fim	P3,66		;IR(6)=4,IR(7)=2, (B)

	jms	TTY		;Call input routine

	jms	COMPR		;Call for compare routine

	jcn	AN,REPT		;Test for nonzero C

REPTB:	ldm	8		;Accept 8 data bits
	xch	9
DATA1:	jms	TTY		;Look for data word

	fim	P3,80		;IR(6)=5, IR(7)=0, (P)

	jms	COMPR

	jcn	AZ,CONT		;Test for a match

	fim	P3,78		;IR(6)=4, IR(7)=14, (N)

	jms	COMPR

	jcn	AZ,CONT		;If AC=0 print

	fim	P3,66		;IR(6)=4, IR(7)=2, (B)

	jms	COMPR

	jcn	AZ,REPTB

	fim	P3,127		;IR(6)=7, IR(7)=5, (R0)

	jms	COMPR

	jcn	AN,FORMT

	jun	RBOUT

CONT:	fim	P0,16		;Data storage

	src	P0
	ld	3
	ral
	rd1			;chip 0, reg 1, har 1
	ral
	wr1			;Least significant bit, data
	rd0			;chip 0, reg, 1, char 0
	ral
	wr0			;Most significant bit, data
	isz	9,DATA1

Final:	jms	TTY		;Get next char

	fim	P3,70		;IR(6)=4, IR(7)=6, (F)

	jms	COMPR

	jcn	AZ,CONA		;AC=0, if not restart input

	fim	P3,66		;IR(6)=4, IR(7)=2, (B)

	jms	COMPR

	jcn	AZ,REPTB

	fim	P3,127		;IR(6)=7, IR(7)=15, (R0)

	jms	COMPR

	jcn	AN,FORMT	;Check for error

RBOUT:	fim	P0,16

	src	P0
	rd0
	rar
	wr0
	rd1
	rar
	wr1
	ld	9
	dac
	xch	9
	jun	DATA1

FORMT:	jms	CRLF		;Position carriage

	jms	FMER

PRINL:	jms	PRINA

	fim	P5,32		;IR(10)=2, IR(11)=0

	ldm	1
	src	P5
	wr0			;Chip 0, reg. 2, char 0
	jun	STB

PRINA:	ldm	13		;Print fm error address
	xch	12		;IR(2)=13
	fim	P5,53		;IR(10)=3, IR(11)=5

FORM1:	src	P5		;Print out address
	rdm
	xch	3
	ldm	11
	xch	2
	jms	PRINT

	ld	11
	dac
	xch	11
	clc
	isz	12,FORM1

	bbl	0

CONA:	fim	P0,16

	src	P0
	rd1
	cma
	wr1
	rd0
	cma
	wr0
	fim	P0,32		;IR(0)=2, IR(1)=0, init adr

	src	P0
	rd2
	rar
	jcn	CN,CONT2

	fim	P0,0		;IR(0)=0, IR(1)=0, Adr comp

	src	P0
	rd0
	xch	7
	rd1
	xch	6
	inc	0
	src	P0
	rd2
	xch	3
	rd3
	xch	2
	jms	COMPR

	jcn	AN,SRCH

	fim	P1,170		;IR(2)=10, IR(3)=10, (*)

	jms	PRINT

	fim	P0,32		;IR(0)=2, IR(1)=0

	ldm	1		;Set init adr flag
	src	P0
	wr2
	fim	P0,0		;IR(0-1)=0

	fim	P2,16		;IR(4)=1, IR(5)=0

	src	P0
	rd2
	iac
	src	P2
	wr2
	ldm	0
	xch	2
	src	P0
	rd3
	add	2
	src	P2
	wr3
CONT2:	jun	CONT1

SRCH:	fim	P0,16		;IR(0)=1, IR(1)=0

	src	P0		;Inc init address by one (1)
	rd2
	iac
	wr2
	ldm	0
	xch	2
	rd3
	add	2
	wr3
	jun	REPT

CONT1:	fim	P0,32		;IR(0)=2, IR(1)=0

	src	P0		;Check format error ecxist
	rd0
	rar
	jcn	CZ,NOFE

	jun	ADCHK

NOFE:	fim	P0,16		;IR(0)=1, IR(1)=0

	fim	P2,32		;IR(4)=2, IR(5)=0

	src	P0		;Write data to 1701
	rd1
	src	P2
	wrr			;LS 4-bits, data
	src	P0
	rd0
	inc	4
	src	P2
	wrr			;MS 4-bits, data
	ldm	12
	xch	10
PRGRM:	fim	P3,64		;IR(6)=4, IR(7)=0

	src	P3
	nop
	nop
;
;
	ldm	2		;Pulsing for 517 mSec.
	wmp
	fim	P2,0		;IR(4)=0, IR(5)=0

	fim	P4,11		;IR(8)=0, IR(9)=11

DELY1:	isz	4,DELY1

	isz	5,DELY1

	isz	8,DELY1

	jms	SBR1

	jms	SBR2

	isz	9,DELY1

	ldm	0
	wmp
	fim	P2,128		;IR(4)=8, IR(5)=0

	jms	SBR1		;Read delay (5.6 mS)

READ:	jms	SBR1		;Read delay

	inc	0
	inc	0
	src	P0
	rdr
	src	P2
	wmp
	xch	7		;LS 4-bits, 1701 output data
	ldm	4
	add	4
	xch	4
	inc	0
	src	P0
	rdr
	src	P2
	wmp
	xch	6		;MS 4-bits, 1701 output data
	ldm	1
	xch	0
	src	P0
	rd0
	xch	2		;MS 4-bits, input data
	rd1
	xch	3		;LS 4-bits, input data
	jms	COMPR

	jcn	AZ,ADCHK

	jun	RPRGM

ADCHK:	fim	P0,0

	src	P0
	rd0
	xch	3
	rd1
	xch	2
	rd2
	xch	7
	rd3
	xch	6
	jms	COMPR

	jcn	AN,INADR

STB:	jms	CRLF

	fim	P1,70		;IR(2)=4, IR(3)=5, (F)

	jms	PRINT

	fim	P0,32

	src	P0
	ldm	0
	WR0
	WR1
	WR2
	fim	P2,0

	jms	CLRAM

	jun	STA1

INADR:	fim	P2,0		;Address increment

	jms	CLRAM

	fim	P0,3		;IR(0)=0, IR(1)=3

	src	P0
	ldm	1
	wrm
	jms	ADDTN

	fim	P0,0

	fim	P2,48		;IR(4)=3, IR(5)=0

	ldm	10
	xch	6
STOR1:	src	P0
	rdm
	src	P2
	wrm
	inc	1
	inc	5
	isz	6,STOR1

	fim	P0,0

	src	P0
	rd0
	iac
	wr0
	ldm	0
	xch	2
	rd1
	add	2
	wr1
	jun	PRGM1

RPRGM:	isz	10,PRGMA

	jms	ERROR

	jun	PRINL

PRGMA:	fim	P1,164		;IR(2)=10, IR(3)=4, (DS)

	jms	PRINT

	jun	PRGRM
;
;
FMER:	fim	P1,198		;IR(2)=12, IR(3)=6, (F)

	jms	PRINT

	fim	P1,197		;IR(2)=12, IR(3)=5, (E)

	jms	PRINT

	fim	P1,160		;;IR(2)=10, IR(3)=0, (SP)

	jms	PRINT

	bbl	0
;
;
LISTR:	jms	PRINA

	fim	P1,160		;;IR(2)=10, IR(3)=0, (SP)

	jms	PRINT

	fim	P1,194		;IR(2)=12, IR(3)=2, (B)

	jms	PRINT

	ldm	14
	xch	10		;Set bit counter
	fim	P6,48		;IR(12)=3, IR(13)=0

SECON:	ldm	12
	xch	6
	src	P6
	rdr
ROTAT:	ral
	xch	14
	jcn	CZ,PRNTN

	fim	P1,208		;IR(2)=13, IR(3)=0, (P)

	jms	PRINT

	jun	NEXT2

PRNTN:	fim	P1,206		;IR(2)=12, IR(3)=14, (N)

	jms	PRINT

NEXT2:	xch	14
	isz	6,ROTAT

	ld	12
	dac
	xch	12
	isz	10,SECON

	fim	P1,198		;IR(2)=12, IR(3)=6, (F)

	jms	PRINT

	fim	P1,187		;IR(2)=11, IR(3)=11, (SC)

	jms	PRINT

	isz	15,AINC

	ldm	12
	xch	15
	jms	CRLF

	jms	LF

	jun	ADCHK

AINC:	fim	P1,160		;Space

	jms	PRINT

	fim	P1,160		;Space

	jms	PRINT

	jun	ADCHK

	END