.TITLE	PIN -- PROCEDURE INTERPRETER
	.IDENT	/01.1/
;+
; WRITTEN BY:
;		JAMES G. DOWNWARD
;		KMS FUSION, INC.
;		3941 RESEARCH PARK DR
;		ANN ARBOR, MICH. 48104
;		(313)-769-8500
;		07-JUN-79
;
; PIN IS A PROCEDURE INTERPRETER FOR RSX11M V3.2 WITH SPAWNING AND
; STOP BIT DIRECTIVE SUPPORT.  NORMALLY THE INDIRECT FILE PROCESSOR IS
; USED TO CONTROL ASSEMBLY AND TASK BUILDS.  ITS SIZE IS OVER 8K.  NOW
; THAT SPAWNING EXISTS, A SIMPLE SMALLER TASK COULD READ A COMMAND FILE,
; SPAWN THE MCR COMMANDS, CHECK EXIT STATUS, ETC.  THIS IS THE FUNCTION 
; OF PIN.  WITH PIN IT IS POSSIBLE TO CONTROL AN ASSEMBLY/COMPILE/TASKBUILD
; USING ONLY ABOUT 1/3 THE CORE USED BY ...AT.
;
;-
	.MCALL	QIOW$,EXIT$S,DIR$,EXST$S,STSE$,SPWN$,GLUN$
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2
	.MCALL	FINIT$,FSRSZ$,FDBDF$,FDOP$A,CLOSE$,OFID$R,GET$
	.MCALL	FDBF$R,FDRC$R,NMBLK$
	.MCALL	FHDOF$,FDOF$L,NBOFF$
;
 
	.MACRO	PRINT	STRING
	MOV	#STRING,R0
	CALL	PNTLIN
	.ENDM	PRINT
	FHDOF$	DEF$L		; DEFNE FILE HEADER OFFSETS
	NBOFF$  DEF$L		; DEFINE NAME BLOCK OFFSETS LOCALLY
 
; COMMAND LINE MACROS AND DATA BLOCKS
GCLBLK:	GCMLB$	0,PIN,HEADER,2
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE		; CSI BLOCK
	.EVEN
;
HEADER:	.BLKB	82.
; I/O MACROS AND DATA BLOCKS
	FDOF$L
	FSRSZ$	1			; SET UP FOR 1 LUN
FDB:	FDBDF$				; START OF FDB
	FDOP$A	1,CSIBLK+C.DSDS,DFNB	; LUN 1 FOR FILE
DFNB:	NMBLK$	,PRC,,SY,0		; DEFALTS TO .PRC FILES ON SY0:
 
; LUN VALUES ARE SET UP AT TASK BUILD
; FOR PROGRAM TO WORK
; LUN=1 =>SY: THE .PRC FILE
; LUN=2 =>TI: THE TERMINAL(OR VT:) I/O
 
 
BUFFER:	.BLKB	80.
BUFLEN	=	.-BUFFER
BUFEND:	.WORD	0
CMDLEN:	.WORD	0
TRAFLG:	.WORD	0			; TRACE FLAG(=1 PRINT EACH COMMAND)
DELFLG:	.WORD	0			; DELETE FLAG(=1 DELETE COMMAND FILE AT CLOSE)
 
; DPB'S
QIODPB:	QIOW$	IO.WVB,2,2,,,,<0,0,40> 	; WRITE TO TERMINAL
GETLUN:	GLUN$	2,GLNBUF		; GET TERMINAL INFORMATION
SPAWN1:	SPWN$	...MCR,,,,,1,,IEXBLK	; SPAWN TO TI:
SPAWN2:	SPWN$	MCR...,,,,,1,,IEXBLK	; SPAWN TO TI: VIA MCR...(FINAL V3.2)
STOP:	STSE$	1			; STOP FOR EVENT FLAG
IEXBLK:	.BLKW	8.			; EXIT STATUS BLOCK
GLNBUF:	.BLKW	6			; BUFFER FOR GETLUN DIRECTIVE
VTFLAG:	.WORD	0			; IF FLAG SET , TERMINAL IS A VT:
 
; ERROR MESSAGES
;
ERM1:	.ASCIZ	/PIN -- SYNTAX ERROR/
ERM2:	.ASCIZ	/PIN -- ILLEGAL FILE NAME/
ERM3:	.ASCIZ	/PIN -- FILE OPEN ERROR/
ERM4:	.ASCIZ	/PIN -- NO SUCH FILE/
ERM5:	.ASCIZ	/PIN -- SPAWN FAILURE/
ERM6:	.ASCIZ	/PIN -- STOP FOR EVENT FLAG FAILED/
ERM7:	.ASCIZ	/PIN -- WARNING, EXIT WITH NON-FATAL ERROR/
ERM8:	.ASCIZ	/PIN -- FATAL, EXIT WITH SEVERE ERROR/
ERM9:	.ASCIZ	/PIN -- CMD FILE READ ERROR/
ERM10:	.ASCIZ	/PIN -- CMD FILE CLOSE ERROR/
ERM11:	.ASCIZ	/PIN -- EOF/<7>
ERM12:	.ASCIZ	/#<EOF>/
ERM13:	.ASCIZ	<15>/PIN -- ONLY SINGLE LINE MCR COMMANDS ALLOWED/
ERM14:	.ASCIZ	<15>/PIN -- WARNING, UNKNOWN INTERNAL COMMAND/
.EVEN
 
;
; READ AND DECODE THE COMMAND LINE
;
PIN::	FINIT$			; INITIALIZE FSR
	DIR$	#GETLUN		; FIND OUT WHAT KIND OF TERMINAL WE HAVE
	CMP	#"VT,GLNBUF	; IS IT A VT
	BNE	START		; IF NE,NO
	INC	VTFLAG		; SHOW IT'S A VT:
START:	GCML$	#GCLBLK		; GET COMMAND LINE
	BCC	CONTIN		; NO ERROR
;EXIT:	JMP	XIT		; NO INPUT SO EXIT
SERR:	PRINT	ERM1		; SYNTAX ERROR
	JMP	XIT
;
CONTIN:				; REF LABLE
;	TST	<GCLBLK+G.CMLD> ; IS ANYTHING TYPED
	TSTB	<GCLBLK+G.ERR>	; ANY ERRORS ON INPUT
	BEQ	1$		; IF EQ, NO
;	BNE	1$		; YES -- INTERPRET IT
	JMP	ERRXIT		;
1$:				; REF LABLE
	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; CHECK SYNTAX
	BCS	SERR		; ERROR IN SYNTAX FOUND
	TST	<CSIBLK+C.CMLD> ; JUST IN CASE A BUNCH OF SPACES FOLLOWED 
				; BY A ^Z WERE TYPED, CHECK TO BE SURE >0
				; PARSED CHARACTER IS IN THE CSIBLK
	BNE	2$		; ALL IS OK
	JMP	ERRXIT		; ONLY ONE CHARACTER EXIT WITH ERROR
 
; CHECK TO SEE IF SOME ONE TRIED USING THE FILSPEC=FILESPEC TYPE
; COMMAND LINE.  IF SO, THIS IS A SYNTAX ERROR
;
2$:	MOV	#CSIBLK+C.STAT,R0 ; GET ADDRESS OF STATUS WORD
	BITB	#CS.EQU,(R0)	; WAS AN EQUAL SIGN SEEN?
	BNE	SERR		; IF NE, EQUAL SIGN SEEN
	CSI$2	#CSIBLK,OUTPUT 	; DECODE THE FILE NAME
	BCS	SERR		; SYNTAX ERROR IF NOT OKAY
 
; NOW CHECK TO SEE IF WILD CARDS ARE SPECIFIED
;
	MOV	#CSIBLK+C.STAT,R0 ; GET ADDRESS OF STATUS WORD
	BITB	#CS.WLD,(R0)	; ANY WILD CARDS
	BEQ	15$		; IF EQ, NO WILD CARDS
	JMP	SERR		; SYNTAX ERROR
 
15$:	MOV	#FDB,R0		; FDB ADRESS IN R0
	MOV	#FDB+F.FNB,R1	; FNB ADDRESS IN R1
	MOV	#CSIBLK+C.DSDS,R2 ; DATASET POINTER IN R2
	MOV	#DFNB,R3	; SETUP THE DEFAULT FILE NAME BLOCK
	CALL	.PARSE		; PARSE THE FDB
	BCC	20$		; ALL OK SO SKIP ERROR MESSAGE
	PRINT	ERM2		; ILLEGAL FILE NAME
	JMP	XIT		; AND EXIT WITH SEVERE ERROR
20$:				; REF LABLE
	CALL	.FIND		; FIND THE FILE
	BCC	OPEN		; IF CC, NO ERROR, SO  OPEN FILE
 
OPNERR:	CMPB	#IE.NSF,FDB+F.ERR ; IS IT NO SUCH FILE?
	BEQ	5$		; YES
3$:	PRINT	ERM3		; FILE OPEN ERROR
	JMP	XIT		; AND RE-START.
5$:	PRINT	ERM4		; NO SUCH FILE
	JMP	XIT		; SO ERRXIT
;
; OPEN THE FILE AND LOOK AT IT.
;
OPEN:				; REF LABLE
	FDRC$R	#FDB		;
20$:	OFID$R	#FDB		; OPEN THE FILE BY ID
	BCC	LOOK		; FILE OPENED WITHOUT ERRORS
	JMP	OPNERR		; WARN USER OF ERROR

LOOK:
	
	GET$	#FDB,#BUFFER,#BUFLEN,FILERR
	MOV	FDB+F.NRBD+2,R2	; GET THE START OF THE BUFFER IN R2.
	CMPB	(R2),#'@	; IS FIRST CHARACTER
	BGE	10$		; OK IF >= AN 'A'
	CMPB	(R2),#';	; OR MAYBE A COMMENT
	BEQ	10$		;  OK IF A ';'
	CMPB	(R2),#'$	; IS IT AN INTERNAL COMMAND
	BNE	5$		; IF NE, NO
	CALL	CHKCMD		; SEE IF ITS A COMMAND
	JMP	LOOK		; GO BACK AND LOOK FOR MORE TO DO
5$:	PRINT	ERM13		; ELSE WARN USER OF ILLEGAL RECORD FORMAT
	CALL	WRTCMD		; SHOW USER OFFENDING LINE
	JMP	ERRXIT		; AND EXIT
10$:	CMPB	(R2),#'Z	; IS IT <='Z'
	BLE	12$		; IF LE,YES IT IS
	PRINT	ERM13		; WARN USER
	CALL	WRTCMD		; SHOW USER OFFENDING LINE
	JMP	ERRXIT		; AND EXIT
12$:				; REF LABLE
	TST	TRAFLG		; IS TRACE SET
	BEQ	15$		; IF EQ 0, NO
	CALL	WRTCMD		; GO DISPLAY COMMAND
15$:				; REF LABLE
	MOV	FDB+F.NRBD,R3	; AND LENGTH OF BUFFER.
	MOV	R3,CMDLEN
	MOV	CMDLEN,R3	; RESTORE IT
	MOV	CMDLEN,SPAWN1+S.PWCL ; GET LENGTH
	MOV	CMDLEN,SPAWN2+S.PWCL ; SET LENGTH HERE ALSO
	MOV	R2,SPAWN1+S.PWCA ; GET ADDRESS
	MOV	R2,SPAWN2+S.PWCA ; SET ADDRESS HERE TOO
	DIR$	#SPAWN2		; FIRST TRY SPAWNING TO MCR...
	BCC	18$		; IF CC, WE GOT IT
	DIR$	#SPAWN1		; THEN TRY SPAWNING TO ...MCR
	BCC	18$		; IF CC IS OK
	PRINT	ERM5		; SPAWN FAILURE
	CALL	WRTCMD		; WRITE OUT COMMAND THAT SPAWN FAILED ON
	JMP	ERRXIT
18$:	DIR$	#STOP		; STOP FOR EFN 1
	BCC	20$		; IF CC ALL OK
	PRINT	ERM6		; STOP FOR EVENT FLAG FAILURE
	CALL	WRTCMD		; WRITE OUT COMMAND STOP FAILED ON
	JMP	ERRXIT		; ERRXIT
20$:	CMP	#2,IEXBLK	; IS IT A WARNING
	BNE	22$		; NO
	PRINT	ERM7		; WARNING, EXIT WITH NON-FATAL STATUS
	CALL	WRTCMD		; WRITE OUT OFFENDING COMMNAD
	JMP	LOOK		; CONTINUE
22$:	CMP	#4,IEXBLK	; IS IT A SEVERE ERROR
	BNE	24$		; IF NE , NO
	CALL	WRTCMD		; WRITE OUT OFFENDING COMMAND
	PRINT	ERM8		; EXIT WITH SEVERE ERROR
	JMP	ERRXIT		; ERRXIT
24$:	JMP	LOOK		; AGAIN
 
 
;+
; WRTCMD -- ISSUE QIO TO WRITE OUT OFFENDING COMMAND
;
;-
WRTCMD:				;
	MOV	FDB+F.NRBD+2,QIODPB+Q.IOPL; GET ADDRESS OF COMMAND
	MOV	FDB+F.NRBD,QIODPB+Q.IOPL+2; SET COMMAND LENGTH
	DIR$	#QIODPB		; ISSUE QIO
	RETURN			;
;
;+
; CHKCMD
;	A COMMAND BEGINNING WITH '$' IS AN INTERNAL PIN COMMAND
; SO SEE IF THE ENTERED LINE IS SUCH A COMMAND
; IF IT IS, DO WHAT IS NEEDED AND RETURN
; IF IT ISN'T PRINT A NASTY MESSAGE, AND RETURN
;
;	INPUT: R2 POINT TO COMMAND BUFFER
;		DON'T FIDDLE WITH ANYTHING ELSE
; ALLOWED COMMANDS
;		$DELETE	- DELETE THIS COMMAND FILE ON EXIT
;		$TRACT 	- PROVIDE A TRACING OF THE COMMANDS SPAWNED
;		$NODEL  - DON'T DELETE THE FILE(IS INITIAL DEFAULT)
;		$NOTR	- NO TRACE(SET BY DEFAULT)
CHKCMD:
	MOV	R2,R4		; SAVE R4
	INC	R2		; POINT TO NEXT CHARACTER
	CMPB	(R2),#'D	; IS IT DELETE?
	BNE	20$		; NO, SO CHECK SOME MORE
	INC	R2		; NEXT LETTER PLEASE
	CMPB	(R2),#'E	; IS IT AN 'E'
	BNE	200$		; IF NE, ERROR RETURN
	INC	DELFLG		; SET DELETE FLAG
	RETURN			; AND RETURN
20$:	CMPB	(R2),#'N	; MAYBE A 'NO'
	BNE	40$		; IF NE, NO
	INC	R2		; MAYBE EITHER A NOTR OR NODE
	CMPB	(R2),#'O	; IS IT NO
	BNE	200$		; IF NE, ERROR RETURN WITH NASTY MESSAGE
	INC	R2		; BUMP TO NEXT CHARACTER
	CMPB	(R2),#'D	; IS IT DELETE
	BNE	25$		; IF NE, CHECK 'NOTR'
	INC	R2		; SEE IF 'E'
	CMPB	(R2),#'E	; AN 'E' PERHAPS
	BNE	200$		; NO, ERROR RETURN
	CLR	DELFLG		; RESET DELETE FLAG
	RETURN			; AND RETURN
25$:	CMPB	(R2),#'T	; IS IT 'NOTR'
	BNE	200$		; IF NE, NO, ERROR
	INC	R2		; BUMP COUNTER
	CMPB	(R2),#'R	; IS IT 'TR'
	BNE	200$		; IF NE, NO , ERROR
	CLR	TRAFLG		; YES, RESET TO NO TRACE
	RETURN
40$:	CMPB	(R2),#'T	; IS IT 'TRACE'
	BNE	200$		; ERROR RETURN IF NO
	INC	R2		;
	CMPB	(R2),#'R	; IS IT 'R'
	BNE	200$		; NO ERROR
	INC	TRAFLG		; SET TRACE FLAG
	RETURN
200$:	MOV	R4,R2		; RESTORE POINTER
	CALL	WRTCMD		; WRITE IT OUT
	PRINT	ERM14		; PRINT OUT WARNING THAT IT IS AN UNKNOWN COMMAND
	RETURN
 
 
 
; EXIT AND ERROR ROUTINES
;
;
ERRXIT:				; REF LABLE
	TST	VTFLAG		; IS IT A VT:
	BNE	10$		; IF NE, YES
	PRINT	ERM11		; END OF FILE
	BR	XIT		; AND EXIT
10$:	PRINT	ERM12		; PRINT @<EOF> SO BATCH WILL CATCH EXIT
XIT:				;
	TST	VTFLAG		;
	BEQ	20$		; NOT A VT:, DON'T PRINT #<EOF>
	PRINT	ERM12		; PRINT IT
20$:	EXST$S	#4		; EXIT WITH SEVERE ERROR
SUCXIT:				; REF LABLE
	TST	VTFLAG		; IS TI: A VT:?
	BEQ	10$		; IF EQ,NO
	PRINT	ERM12		; IT IS A VT:, PRINT #<EOF> ON EXIT
	BR	20$		; EXIT WITH STATUS
10$:	PRINT	ERM11		; NORMAL EXIT MESSAGE
20$:	 EXST$S	#1		; EXIT WITH SUCCESS
FILERR:	TST	(SP)+		; POP OFF RETURN ADDR
	CMPB	F.ERR(R0),#IE.EOF ; IS IT EOF?
	BEQ	10$		; NO -- ERROR
	PRINT	ERM9		; CMD FILE READ ERROR
	JMP	ERRXIT		; EXIT WITH SEVERE ERROR
10$:				; REF LABLE 
	TST	DELFLG		; SHOULD WE DELETE THIS FILE WHEN WE CLOSE
	BEQ	15$		; IF EQ 0 NO
	MOV	#FDB,R0		; YES WE SHOULD
	CALL	.DLFNB		; DELET BY FILE NAME BLOCK
	BR	16$		; LOOP THROUGH COMMON CODE
15$:	CLOSE$	#FDB		; CLOSE THE FILE.
16$:	BCS	20$		; FILE CLOSE ERROR
	JMP	SUCXIT		; EXIT WITH SUCCESS
20$:	PRINT	ERM10		; FILE CLOSE ERROR
	JMP	ERRXIT		; EXIT WITH SEVERE STATUS
 
 
 
;+
; PNTLIN
;
; THIS ROUTINE WILL PRINT AN ASCIZ LINE
;-
PNTLIN:	MOV	#-1,R1		; GET COUNT INITIALIZED
	MOV	R0,QIODPB+Q.IOPL ; STORE BUFFER ADDRESS
170$:	INC	R1		; INCREMENT COUNTER
	TSTB	(R0)+		; IS THIS THE LAST BYTE?
	BNE	170$		; NO. KEEP GOING
	MOV	R1,QIODPB+Q.IOPL+2 ; STORE BYTE COUNT
	DIR$	#QIODPB
	RETURN
 
 
	.END	PIN