.TITLE	PRUN -- RUN PROGRAM AT MC0511 PPU
	.IDENT	/V02.00/

;+
; Copyright (c) 2010,2016 Oleg Safiullin <form@pdp-11.org.ru>
;
; Permission to use, copy, modify, and distribute this software for any
; purpose with or without fee is hereby granted, provided that the above
; copyright notice and this permission notice appear in all copies.
;
; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;-

PPCSR	=:	176674			;PPU CSR

$JSX	=:	4			;EXTENDED JOB STATUS WORD
NOVBG$	=:	100			;DISABLE VBGEXE BIT

$USRPC	=:	40			;USER PROGRAM COUNTER
$USRSP	=:	42			;USER STACK POINTER
$USRTO	=:	50			;USER TOP ADDRESS
$USRRB	=:	53			;USER ERROR BYTE
FATAL$	=:	10			;FATAL ERROR STATUS

RL.RID	=:	60			;REL FILE ID (REL IN RADIX-50)
RL.RDB	=:	62			;RELATIVE BLOCK OF RELOCATION TABLE
RL.OVR	=:	64			;ADDRESS OF OVERLAY HANDLER TABLE

BUFF	=:	512			;COMMAND LINE BUFFER
EOL	=:	200			;END OF LINE (NO CRLF)

	.MCALL	.CSISPC,.EXIT,.FETCH	;SYSTEM MACROS
	.MCALL	.GTLIN,.LOOKUP,.MTPS	;
	.MCALL	.PRINT,.READW,.SERR	;
	.MCALL	.SETTOP,.TRPSET		;
	.MCALL	ISTAT$,STATE$,TRAN$	;TABLE DRIVEN PARSER MACROS

	.ASECT
	.=$JSX
	.WORD	NOVBG$			;DISABLE VBGEXE ;)

	.PSECT	CODE,I,RO
START::	MOV	#BUFF,R3		;POINT TO COMMAND LINE BUFFER
	MOV	R3,R4			;COPY IT
	.GTLIN	R3,#PROMP		;GET COMMAND LINE
10$:	TSTB	(R3)+			;COMPUTE STRING LENGTH
	BNE	10$			;
	DEC	R3			;
	SUB	R4,R3			;
	MOV	#1*400,R1		;SET MINIMUM NUMBER OF MATCHED CHARS
	MOV	#KEYTB,R2		;POINT TO KEY TABLE
	MOV	#P.MAIN,R5		;POINT TO THE STARTING STATE
	CALL	.TPARS			;PARSE COMMAND LINE
	BCC	40$			;IF CC OK
14$:	MOV	#ESYNT,R3		;ASSUME INVALID OPTION ERROR
	TST	OPTS			;REALLY?
	BPL	20$			;IF PL YES
15$:	MOV	#EINOP,R3		;NO, INVALID OPTION ERROR

20$:	MOV	#MFATL,R1		;SET FATAL ERROR MESSAGE TYPE
	BISB	#FATAL$,@#$USRRB	;SET FATAL ERROR STATUS
30$:	MOV	#BUFF,R0		;SET BUFFER ADDRESS
	CALL	$EDMSG			;EDIT MESSAGE
	MOV	R3,R1			;SET MESSAGE ADDRESS
	MOV	#MARGS,R2		;SET ARGUMENT BLOCK ADDRESS
	CALL	$EDMSG			;EDIT MESSAGE
	CLRB	@R0			;MAKE IT ASCIZ
	.PRINT	#BUFF			;PRINT IT
35$:	.SETTOP	#0			;AVOID SWAPPING ON EXIT
	CLR	R0			;FORCE HARD RESET
	.EXIT				;EXIT

40$:	TST	FNAM			;FILE SPECIFIED?
	BNE	50$			;IF NE YES
	TST	OPTS			;OPTIONS SPECIFIED?
	BNE	60$			;IF NE YES
	BR	START			;NO COMMAND LINE, LOOP

50$:	CLRB	@FEND			;MAKE FILENAME ASCIZ
60$:	MOV	#ENPPU,R3		;ASSUME NO PPU DEVICE
	CALL	CKPPU			;CHECK FOR PPU INTERFACE
	BCS	20$			;IF CS ERROR
	MOV	FNAM,R5			;FILE NAME SPECIFIED?
	BNE	80$			;IF NE YES
	TSTB	OPTS			;/PAUSE SPECIFIED?
	BMI	15$			;IF MI YES, INVALID OPTION
	BIT	#O.STA,OPTS		;/START SPECIFIED?
	BEQ	14$			;IF EQ NO, ERROR
	BIC	#O.INF,OPTS		;DISABLE PRINTING OF INFO
	MOV	SADR,R1			;GET TRANSFER ADDRESS
	BIT	#1,R1			;ODD?
	BEQ	70$			;IF EQ NO
	MOV	#EINSA,R3		;YES, ERROR
	MOV	R1,MARGS		;
	BR	20$			;

70$:	MOV	R1,PDESC+P.ADDR		;SET TRANSFER ADDRESS
	MOVB	#PF.RUN,PDESC+P.FUNC	;UPDATE FUNCTION CODE
	MOV	#ESTRT,R3		;ASSUME STARTUP ERROR
	CALL	PPURQ			;RUN PROGRAM
	BCS	20$			;IF CS ERROR
	BIT	#O.INF,OPTS		;PRINT INFO
	BEQ	35$			;IF EQ NO
75$:	MOV	#ISTRT,R3		;SET INFO MESSAGE
	MOV	#MINFO,R1		;
	BR	30$			;PRINT AND EXIT

80$:	.CSISPC	#CSISP,#DFEXT,R5	;PARSE FILE NAME
	MOV	#CSISP+<3*5*2>+10,R4	;POINT TO FILE DESCRIPTOR
	MOV	#MARGS+10,R2		;POINT TO ARGUMENT BLOCK
	MOV	-(R4),-(R2)		;MOVE FILENAME
	MOV	-(R4),-(R2)		;
	MOV	-(R4),-(R2)		;
	MOV	-(R4),-(R2)		;
	MOV	@#$USRTO,R5		;GET ADDRESS OF FILE BUFFER
	TST	(R5)+			;SKIP OVER LAST WORD
	.FETCH	R5,R4			;FETCH HANDLER
	BCC	90$			;IF CC OK
	CLR	2(R2)			;CLEAR FILE NAME
	MOV	#ENDEV,R3		;SET ERROR MESSAGE
85$:	BR	20$			;ERROR PROCESSING

90$:	MOV	R0,R5			;UPDATE BUFFER ADDRESS
	.SERR				;DON'T ABORT ON DIRECTORY ERROR
	MOV	#ELOOK,R3		;ASSUME LOOKUP ERROR
	.LOOKUP	#AREA,#0,R4		;LOOKUP THE FILE
	BCS	20$			;IF CS ERROR
	MOV	#ELARG,R3		;ASSUME FILE TOO LARGE
	BIT	#^C77,R0		;CHECK FILE SIZE
	BNE	20$			;IF NE TOO LARGE
	SWAB	R0			;CONVERT BLOCK COUNT TO WORDS
	MOV	R0,R1			;SAVE FOR USE
	MOV	R0,R2			;
	ASL	R2			;CONVERT TO BYTES
	TST	-(R2)			;COMPUTE TOP ADDRESS
	ADD	R5,R2			;
	.SETTOP	R2			;REQUEST BUFFER SPACE
	MOV	#ENMEM,R3		;ASSUME NOT ENOUGH MEMORY
	CMP	R0,R2			;HAVE ENOUGH MEMORY?
	BLO	85$			;IF LO NO
	MOV	#EREAD,R3		;ASSUME READ ERROR
	.READW	#AREA,#0,R5,R1,#0	;READ FILE INTO BUFFER
	BCS	85$			;IF CS ERROR
	MOV	#EBFMT,R3		;ASSUME BAD FILE FORMAT
	CALL	CKREL			;CHECK REL FILE FORMAT
	BCS	85$			;IF CS ERROR
	CALL	CKTAB			;CHECK RELOCATION TABLE
	BCS	85$			;IF CS BAD
	MOV	$USRPC(R5),R1		;GET TRANSFER ADDRESS
	BIT	#O.STA,OPTS		;/START SPECIFIED?
	BEQ	100$			;IF EQ NO
	MOV	SADR,R1			;GET SPECIFIED ADDRESS
100$:	CALL	CKADR			;CHECK IT
	BCC	110$			;IF CC OK
	MOV	#EINSA,R3		;ASSUME INVALID ADDRESS
	MOV	R1,MARGS		;UPDATE ARGUMENT BLOCK
	BR	85$			;ERROR PROCESSING

110$:	MOV	R1,$USRPC(R5)		;UPDATE TRANSFER ADDRESS
	MOV	$USRSP(R5),R4		;R4=BUFF
	ADD	R5,R4			;
	MOV	$USRTO(R5),R2		;R2=WCNT
	ADD	R5,R2			;
	SUB	R4,R2			;
	ASR	R2			;
	MOV	#EPMEM,R3		;ASSUME NOT ENOUGH PPU MEMORY
	MOV	R2,PDESC+P.BUFF		;ALLOCATE PPU MEMORY
	CALL	PPURQ			;
	BCS	85$			;IF CS NOT ENOUGH PPU MEMORY
	MOV	PDESC+P.ADDR,R3		;GET PPU BOTTOM ADDRESS
	CALL	RELOC			;RELOCATE THE PROGRAM
	SUB	#1000,R1		;RELOCATE TRANSFER ADDRESS
	ADD	R3,R1			;
	MOVB	#PF.WLB,PDESC+P.FUNC	;UPDATE FUNCTION CODE
	ADD	#1000,R5		;SET BUFFER ADDRESS
	MOV	R5,PDESC+P.BUFF		;
	MOV	R2,PDESC+P.WCNT		;SET WORD COUNT
	MOV	#ELOAD,R3		;ASSUME WRITE ERROR
	CALL	PPURQ			;WRITE TO PPU MEMORY
	BCS	85$			;IF CS ERROR (XXX PPU BLOCK ALLOCATED)
	MOV	PDESC+P.ADDR,MARGS	;SET ARGUMENT BLOCK FOR /INFO
	MOV	R1,MARGS+2		;
	TSTB	OPTS			;START PROGRAM AT PPU?
	BMI	120$			;IF MI NO
	JMP	70$			;ELSE START
120$:	BIS	#O.INF,OPTS		;NO, FORCE /INFO
	JMP	75$			;PRINT INFO

RELOC::	CALL	$SAVAL			;SAVE REGISTERS
10$:	CMP	#-2,@R0			;END OF TABLE REACHED?
	BNE	20$			;IF EQ YES
	RETURN				;RETURN
20$:	MOV	R3,R2			;GET BASE ADDRESS
	MOV	(R0)+,R1		;GET RELATIVE OFFSET
	ASL	R1			;
	BCC	30$			;IF CC ADD RELOCATION BASE
	NEG	R2			;ELSE SUBTRACT
30$:	ADD	R5,R1			;RELOCATE ADDRESS
	ADD	#1000,R1		;
	MOV	(R0)+,@R1		;
	SUB	#1000,@R1		;
	ADD	R2,@R1			;
	BR	10$			;TO NEXT ADDRESS

PPURQ::	JSR	R2,$SAVVR		;SAVE REGISTERS 0-2
	MOV	#PIPKT,R0		;POINT TO I/O PACKET
	MOV	#4+1,R1			;SET I/O PACKET LENGTH
	.MTPS	#340			;RAISE CPU PRIORITY
	BR	20$			;TRANSFER I/O PACKET
10$:	MOVB	(R0)+,@#PPCSR+2		;SEND BYTE
20$:	TSTB	@#PPCSR			;READY?
	BPL	20$			;IF PL NO
	SOB	R1,10$			;LOOP
	.MTPS	#0			;LOWER CPU PRIORITY
	CMPB	#0,PDESC+P.STAT		;CHECK I/O STATUS
	RETURN				;RETURN

CKTAB::	JSR	R5,.SAVR1		;SAVE REGISTERS 1-5
	ADD	R5,R0			;POINT TO RELOCATION TABLE
	MOV	R0,R3			;
10$:	MOV	(R3)+,R1		;GET RELATIVE OFFSET
	CMP	#-2,R1			;END OF TABLE?
	BEQ	20$			;IF EQ YES
	ASL	R1			;CONVERT TO ADDRESS
	ADD	#1000,R1		;
	CALL	CKADR			;CHECK ADDRESS
	BCS	20$			;IF CS BAD
	TST	(R3)+			;SKIP ORIGINAL CONTENTS
	CMP	R3,R2			;TOP OF MEMORY REACHED?
	BLOS	10$			;IF LOS NO
	SEC				;FLAG ERROR
20$:	RETURN

CKREL::	CMP	#^RREL,RL.RID(R5)	;REL FILE FORMAT?
	BNE	10$			;IF NE NO, ERROR
	TST	RL.OVR(R5)		;HAVE OVERLAYS?
	BNE	10$			;IF NE YES, ERROR
	CMP	#^RVIR,@R5		;LINKED WITH /V?
	BEQ	10$			;IF EQ YES, ERROR
	SWAB	R1			;CONVERT WORD COUNT TO BLOCKS
	MOV	RL.RDB(R5),R0		;GET BLOCK NUMBER OF RELOCATION TABLE
	CMP	R0,R1			;OUT OF FILE?
	BHIS	10$			;IF HIS YES, ERROR
	SWAB	R0			;CONVERT BLOCK TO ADDRESS
	ASL	R0			;
	MOV	$USRTO(R5),R1		;CHECK TOP ADDRESS
	CALL	CKADR			;
	BCS	10$			;ERROR
	MOV	$USRSP(R5),R1		;GET BOTTOM/STACK ADDRESS
	CMP	R1,$USRTO(R5)		;ABOVE TOP ADDRESS?
	BHIS	10$			;IF HIS YES, ERROR
	BR	CKADR			;VALIDATE THE ADDRESS AND RETURN
10$:	SEC				;SET CARRY
	RETURN				;RETURN

CKADR::	CMP	#1000,R1		;BELOW PROGRAM TEXT?
	BHI	10$			;IF HI YES, ERROR
	CMP	R1,R0			;ABOVE PROGRAM TEXT?
	BHIS	10$			;IF HIS YES, ERROR
	BIT	#1,R1			;CHECK IF ADDRESS IS ODD
	BNE	10$			;IF NE YES
	TST	(PC)+			;CLEAR CARRY, SKIP SEC
10$:	SEC				;SET CARRY
	RETURN				;RETURN

	.ENABL	LSB
SETDN::	MOV	#3,R1			;SET MAXIMUM LENGTH
	BR	SETDF			;TO COMMON DEVICE/NAME CODE
SETFN::	MOV	#6,R1			;SET MAXIMUM LENGTH
	TST	FNAM			;DEVICE NAME PRESENT?
	BNE	10$			;IF EQ YES
SETDF:	MOV	.PSTPT,FNAM		;SAVE FILENAME ADDRESS
10$:	MOV	.PSTCN,R0		;GET CHARACTER COUNT
	BEQ	20$			;IF EQ NO NAME TOO SHORT
	CMP	R0,R1			;NAME TOO LONG?
	BLE	30$			;IF LE NO
20$:	ADD	#2,@SP			;REJECT TRANSITION
30$:	RETURN				;RETURN
	.DSABL	LSB

SETFT::	MOV	R4,FEND			;SAVE ADDDRESS OF NEXT CHAR
	CMP	.PSTCN,#3		;TYPE TOO LONG?
	BLE	10$			;IF LE NO
	ADD	#2,@SP			;REJECT TRANSITION
10$:	RETURN				;RETURN

SETSA::	MOV	.PNUMB,SADR		;SAVE TRANSFER ADDRESS
EMPTY::	RETURN				;RETURN

OPERR::	BIS	#O.ERR,OPTS		;FLAG OPTION ERROR
	ADD	#2,@SP			;REJECT TRANSITION
	RETURN				;RETURN

UPPER::	TST	R3			;HAVE STRING?
	BEQ	30$			;IF EQ NO
	MOV	R3,-(SP)		;SAVE REGISTERS
	MOV	R4,-(SP)		;
10$:	BITB	#'@,@R4			;LETTER?
	BEQ	20$			;IF EQ NO
	BICB	#<' >,@R4		;CONVERT TO UPPER CASE
20$:	INC	R4			;TO NEXT CHARACTER
	DEC	R3			;HAVE MORE CHARS?
	BNE	10$			;IF NE YES
	MOV	(SP)+,R4		;RESTORE REGISTERS
	MOV	(SP)+,R3		;
30$:	RETURN				;RETURN

CKPPU::	.TRPSET	#AREA,#10$		;CATCH TRAPS THRU 4/10
	TST	@#PPCSR			;CHECK FOR PPU INTERFACE
	ROL	-(SP)			;SAVE C
	.TRPSET	#AREA,#0		;RESET TRAPS
	ROR	(SP)+			;RESTORE C
	RETURN				;RETURN
10$:	BIS	#1,2(SP)		;SET CARRY FOR TRAPPED JOB
	RTI				;RETURN FROM INTERRUPT

;
;COMMAND LINE PARSER RULES
;
	ISTAT$	ISTAT,KEYTB

;
;TOP LEVEL COMMAND PARSING
;
	STATE$	P.MAIN
	TRAN$	$LAMDA,,UPPER

	STATE$
	TRAN$	!P.OPTS,$EXIT
	TRAN$	$LAMDA,,EMPTY

;
;FILE NAME PARSING
;
	STATE$
	TRAN$	!P.DEVN,P.NAME
	TRAN$	$LAMDA,,EMPTY

	STATE$	P.NAME
	TRAN$	$STRNG,,SETFN

	STATE$
	TRAN$	$EOS,$EXIT,SETFT
	TRAN$	$LAMDA,,EMPTY

	STATE$
	TRAN$	!P.OPTS,$EXIT
	TRAN$	$LAMDA,,EMPTY

	STATE$
	TRAN$	'.,,SETFT

	STATE$
	TRAN$	!P.OPTS,$EXIT
	TRAN$	$LAMDA,,EMPTY

	STATE$
	TRAN$	$EOS,$EXIT,SETFT
	TRAN$	$STRNG,,SETFT

	STATE$	P.OPTS
	TRAN$	$EOS,$EXIT
	TRAN$	'/

	STATE$
	TRAN$	"INFO",P.OPTS,,O.INF,OPTS
	TRAN$	"PAUSE",P.OPTS,,O.PAU,OPTS
	TRAN$	"START",P.STRT,,O.STA,OPTS
	TRAN$	$LAMDA,,OPERR

	STATE$	P.STRT
	TRAN$	':,P.STAD
	TRAN$	$LAMDA,,OPERR

	STATE$	P.STAD
	TRAN$	$NUMBR,P.OPTS,SETSA
	TRAN$	$LAMDA,,OPERR

	STATE$	P.DEVN
	TRAN$	$STRNG,P.COLN,SETDN
	TRAN$	$LAMDA,$EXIT

	STATE$	P.COLN
	TRAN$	':,$EXIT

	STATE$

	.PSECT	DATA,D,RW
AREA:	.BLKW	5			;EMT AREA
FNAM::	.WORD	0			;POINTER TO FILE NAME
FEND:	.WORD	0			;POINTER TO NEXT CHAR AFTER FILE NAME
SADR::	.WORD	0			;SPECIFIED TRANSFER ADDRESS
OPTS::	.WORD	0			;OPTION BITS
O.ERR	=:	100000			;INVALID OPTION FLAG
O.PAU	=:	200			;/PAUSE OPTION
O.INF	=:	2			;/INFO OPTION
O.STA	=:	1			;/START OPTION

PIPKT::	.WORD	PDESC,-1		;PPU I/O PACKET
PDESC::	.BYTE	0,PF.ALL		;STATUS, FUNCTION CODE
	.WORD	32			;DEVICE CODE
	.BLKW				;PPU ADDRESS
	.BLKW				;BUFFER ADDRESS
	.BLKW				;WORD COUNT
P.STAT	=:	0			;I/O STATUS
P.FUNC	=:	1			;FUNCTION CODE
P.ADDR	=:	4			;PPU ADDRESS
P.BUFF	=:	6			;CPU BUFFER ADDRESS
P.WCNT	=:	10			;WORD COUNT
PF.ALL	=:	1			;ALLOCATE FUNCTION
PF.DEA	=:	2			;DEALLOCATE FUNCTION
PF.RLB	=:	10			;READ FUNCTION
PF.WLB	=:	20			;WRITE FUNCTION
PF.RUN	=:	30			;RUN FUNCRION

DFEXT::	.RAD50	/PPU         /		;DEFAULT FILE TYPES
MARGS:	.BLKW	4			;EDMSG ARGUMENT BLOCK
CSISP:	.BLKW	39.			;CSI FILE DESCRIPTORS

PROMP:	.ASCII	/File? /<EOL>
MFATL:	.ASCIZ	/?PRUN-F-/
MINFO:	.ASCIZ	/?PRUN-I-/
ESYNT:	.ASCIZ	/Command syntax error/
EINOP:	.ASCIZ	/Invalid option/
ENDEV:	.ASCIZ	/Invalid device - %X/
ELOOK:	.ASCIZ	/File open error - %X/
ELARG:	.ASCIZ	/File too large - %X/
ENMEM:	.ASCIZ	/Not enough memory/
EREAD:	.ASCIZ	/Error reading file - %X/
EBFMT:	.ASCIZ	/Bad file format - %X/
EINSA:	.ASCIZ	/Invalid transfer address - %P/
EPMEM:	.ASCIZ	/Not enough PPU memory/
ELOAD:	.ASCIZ	/Failed to load program to PPU memory/
ESTRT:	.ASCIZ	/Failed to start program at PPU/
ISTRT:	.ASCIZ	/Loaded at %P, trabsfer address %P/
ENPPU:	.ASCIZ	/PPU interface not available/

	.END	START