\				PC's come and go, but
\				PDP-11 is FOREVER!
\
\
\	 FORTH Cross-assembler for PDP-11 style CPU's
\	 With EIS & FIS opcodes.  Without labels yet.
\					      v 0.5.0
\
\	 Access Denied (mda@forth.org.ru)  25.05.2000
\

vocabulary	pdpasm
		pdpasm	definitions

2048 constant TIMAGESIZE

create TIMAGE TIMAGESIZE allot	create;			\ Target space
create THERE 0 ,        	create;			\ Target HERE

\ 	Words to work with target space

: THERE+1 THERE 1+! ;	: THERE-1 THERE 1-! ;
: THERE+2 THERE 2+! ;	: THERE-2 THERE 2-! ;
			: THERE+ ( n -- ) THERE @ + THERE ! ;

\			: tc@ ( adr -- n )	TIMAGE + c@ ;
\			: tc! ( n adr -- )	TIMAGE + c! ;
\			: tc, ( n -- )	THERE @  c! THERE+1 ;

: tw@	( adr -- n )	TIMAGE + w@ ;
: tw!	( n adr -- )	TIMAGE + w! ;
: tw,	( n -- )	THERE @ w! THERE+2 ;

\ 	Addresing types
\	------------------------------------------------------------------------
\	MACRO-11		FORTH
\	------------------------------------------------------------------------
\	MOV 1000, RO		1000 PC n() R0 MOV	or	1000 '' R0 MOV
\	MOV @1000, R0		1000 PC @n() R0 MOV	or	1000 '@' R0 MOV
\
\	MOV (R2), (SP)+		R2 () SP ()+ MOV
\	MOV @(R1)+, -(R2)	R1 @()+ R2 -() MOV
\	MOV @-(R1), 1000(R2)	1000 R1 @-() R2 n() MOV
\	MOV #1000, @#177566	1000 177566 # @# MOV
\	------------------------------------------------------------------------

	OCTAL

	: #	27 ; 		0	constant	R0
	: @#	37 ; 		1	constant	R1
	: ()	10 or ; 	2	constant	R2                                
	: ()+	20 or ; 	3	constant	R3
	: @()+	30 or ; 	4	constant	R4
	: -()	40 or ; 	5	constant	R5
	: @-()	50 or ; 	6	constant	R6
	: n()	60 or ; 	7	constant	R7
	: @n()	70 or ; 	6	constant	SP
	: ''	R7  n() ;	7	constant	PC
	: '@'	R7 @n() ;

	DECIMAL

\
\	Working with target image
\

: PDPINIT					\ Init, create image header
	TIMAGE THERE !
	TIMAGE TIMAGESIZE 0 fill
	512 32  tw!
	512 34  tw!
	560 40  tw!
	192 240 tw!
	512 THERE+ ;

: PDPSAVE					\ Save ready image
	TIMAGE TIMAGESIZE A" TEST.SAV"
	[ hidden ] (savedata) [ pdpasm ] ;

\
\	Types of instructions
\

	OCTAL

: 0op ( op-code )
	create w, does> ( adr-op-code -- )
			w@ tw, ;

: 1op ( op-code -- )
	create w, does> ( reg adr-op-code -- )
			w@ or tw, ;

: bop	( op-code -- )
	create w, does> ( ofset addr-op-code -- )
			w@ + tw, ;

: ?dops ( com-word -- flag )
	>R
	R@ 77 and 27 = if true rdrop exit then
	R@ 77 and 37 = if true rdrop exit then
	R> 60 and 60 = if true exit then
	false ;

: ?dopd	( com-word -- flag )			100 / ?dops ;
: ?2dop	( com-word -- flag )	dup >R ?dops R> 100 / ?dops and ;

: 2op	( op-code -- )
	create w, does> ( [srcn] [destn] src dest adr-op-code -- )
			w@				\ [s] [d] src dest op-code
			rot 100 * or or			\ [s] [d] com-word
			dup ?2dop if >R swap R> then	\ [d] [s] com-word
			dup tw,				\ [d] [s] com-word
			dup ?dops if swap tw, then	\ [d] com-word
			    ?dopd if tw, then ;

: 2opR	( op-code -- )
	create w, does> ( [srcn] src R-dest adr-op-code -- )
			w@				\ [s] src R-dest op-code
			swap 100 * or or		\ [s] com-word
			dup tw,				\ [s] com-word
			?dops if tw, then ;


: jop	( op-code -- )
	create w, does> ( [dest] R dest addr-op-code -- )
			w@				\ [dest] R op-code
			or				\ [dest] code-word
			dup tw,
			?dops if tw, then ;

\
\	Opcode masks & instruction definitions
\

	000000	0op	HALT
	000001	0op	WAIT	000002	0op	RTI
	000003	0op	BPT	000004	0op	IOT
	000005	0op	RESET	000006	0op	RTT

	000240	0op	NOP
	000241	0op	CLC	000261	0op	SEC
	000242	0op	CLV	000262	0op	SEV
	000244	0op	CLN	000264	0op	SEZ
	000250	0op	CLZ	000270	0op	SEN
	000257	0op	CCC	000277	0op	SCC

	104000	1op	EMT	104000	1op	TRAP

	005000	1op	CLR	105000	1op	CLRB
	005100	1op	COM	105100	1op	COMB
	005200	1op	INC	105200	1op	INCB
	005300	1op	DEC	105300	1op	DECB
	005400	1op	NEG	105400	1op	NEGB
	005500	1op	ADC	105500	1op	ADCB
	005600	1op	SBC	105600	1op	SBCB
	005700	1op	TST	105700	1op	TSTB

	006000	1op	ROR	106000	1op	RORB
	006100	1op	ROL	106100	1op	ROLB
	006200	1op	ASR	106200	1op	ASRB
	006300	1op	ASL	106300	1op	ASLB

	000300	1op	SWAB	006700	1op	SXT

	075000	1op	FADD	075020	1op	FMUL
	075010	1op	FSUB	075030	1op	FDIV

	010000	2op	MOV	110000	2op	MOVB
	020000	2op	CMP	120000	2op	CMPB
	030000	2op	BIT	130000	2op	BITB
	040000	2op	BIC	140000	2op	BICB
	050000	2op	BIS	150000	2op	BISB

	060000	2op	ADD	160000	2op	SUB

	070000	2opR	MUL	071000	2opR	DIV
	072000	2opR	ASH	073000	2opR	ASHC

	000400	bop	BR
	001000	bop	BNE	001400	bop	BEQ
	100000	bop	BPL	100400	bop	BMI
	102000	bop	BVC	102400	bop	BVS
	103000	bop	BCC	103400	bop	BCS

	002000	bop	BGE	002400	bop	BLT
	003000	bop	BGT	003400	bop	BLE

	101000	bop	BHI	101400	bop	BLOS
	103000	bop	BHIS	103400	bop	BLO

	000100	jop	JMP
				106400	jop	MTPS
	006500	jop	MFPI	106500	jop	MFPD	
	006600	jop	MTPI	106600	jop	MTPD
				106700	jop	MFPS

: SOB ( R n -- )
	77 and
	swap 100 * or 077000 or tw, ;

: MARK ( n -- )
	77 and
	006400 or tw, ;

: RTS ( R -- )	7 and 000200 or tw, ;
: SPL ( n -- )  7 and 000230 or tw, ;

: JSR ( [dest] R dest -- )
	004000 or		\ [dest] R tmp
	swap 7 and 100 * or	\ [dest] code-word
	dup tw,
	?dops if tw, then ;

: XOR  ( [dest] R dest -- )
	074000 or		\ [dest] R tmp
	swap 7 and 100 * or	\ [dest] code-word
	dup tw,
	?dops if tw, then ;

	DECIMAL



\
\ ---------------------------------------------------------------------
\

: TESTOUT			\ to see compiled instructions
				\ as octal words
	TIMAGE 512 + 4+ w@
	TIMAGE 512 + 2+ w@
	TIMAGE 512 + w@
	." \r\n------------\r\n"
	octal . . .      decimal
	." \r\n------------\r\n"
;

\
\ ------------------------ TEST DRIVE ---------------------------------
\

	PDPINIT
	OCTAL	

	1000 177566 # @# MOV		\ MOV #1000, @#177566
	350 EMT

	DECIMAL TESTOUT
	PDPSAVE

\
\ ---------------------------------------------------------------------
\

only forth definitions

\    ЛИТЕРАТУРА
\
\ 1. С.Н. Баранов, Н.Р. Ноздрунов.
\    Язык ФОРТ и его реализации.
\ 2. Ю.А. Семёнов.
\    Программирование на языке ФОРТ.
\ 3. В.Ф. Аникеенко, Б.М. Киселёв, В.И. Убийконь.
\    Программирование на микроЭВМ.
\ 4. Е.В. Бильдюкевич, В.Л. Гурачевский, С.С. Шушкевич.
\    ЭВМ и микропроцессор.