;	VTAM command processor
;
;	Copyright [c] Noel Alaska Systems Technology, 1983.

	SEARCH	SYS			; AMOSL libraries
	SEARCH	SYSSYM
	SEARCH	TRM
	SEARCH	VTAMEQ			; VTAM library
	COPY	VEXPIR

TRUE	=	0
FALSE	=	^C TRUE
DEBUG	=	FALSE

	INTERN	DOPIC,PSCAN,VCMD0,VCMD1,VCMDA,CMDEXP

	AUTOEXTERN

VCMD0:	CLRB	JINPUT(A4)		; no chars yet
	CLRB	JINPUT+1(A4)
	MOV	JQUE(A4),A6		; point to control block
	BITL	#QBQUIT,QBFLG(A6)	; is it time to quit?
	JNE	VCMDX2			;   YES - quit
	BITL	#QBCHEK,QBFLG(A6)	; have we come back yet?
	BNE	1$			;   NO
	BITL	#QBGOOD,QBFLG(A6)	; is security good?
	JEQ	VCMDX2			;   NO  - quit
	BITL	#QBDATE,QBFLG(A6)	; is it expired?
	JEQ	VCMDX2			;   YES - quit
1$:	JMP	VSTATC			;   NO  - reset display

VCMD1:	SAVE	A0-A5,D0-D5		; save regs
	BITL	#INHELP,JSTAT(A4)	; help active?
	BEQ	1$			;   NO
	CALL	VHLP			;   YES - he handles input
	BITL	#INHELP,JSTAT(A4)	; help active still?
	JEQ	VCMD7			;   NO  - re-init after command
	REST	A0-A5,D0-D5
	RTN				;   YES - back to polling

1$:	TSTB	JINPUT(A4)		; is this first of new command?
	BNE	VCMD3			;   NO
	PUSH	D1			;   YES - clear old msgs
	CRT	23.,1
	CRT	255.,9.
	CRT	22.,13.
	POP	D1
	BR	VCMD3
VCMD2:	REST	A0-A5,D0-D5
	RTN
VCMD3:	CMPB	D1,#3			; ^C ?
	BNE	1$			;    NO  - try next
	MOVB	#7,D1			;    YES - sound bell
	TOUT				;	 - handle as ^U
	JMP	VCMD7
1$:	CMPB	D1,#10			; backspace?
	JEQ	VCMD5			;    YES
	CMPB	D1,#12			; linefeed?
	JEQ	VCMD9			;    YES - same as CR
	CMPB	D1,#15			; carriage return?
	JEQ	VCMD9			;    YES
	CMPB	D1,#25			; ^U ?
	JEQ	VCMD7			;    YES
	CMPB	D1,#33			; ESCAPE ?
	JEQ	VCMD6			;    YES
	CMPB	D1,#22			; ^R ?
	JEQ	SPAGB			;    YES - page status bwd
	CMPB	D1,#24			; ^T ?
	JEQ	SPAGF			;    YES - page status fwd
	CMPB	D1,AESC(A4)		; Alternate ESCAPE ?
	JEQ	VCMD6			;    YES
	CMPB	D1,TCHR(A4)		; Toggle Char?
	JEQ	VCMD6A			;    YES
	CMPB	D1,#40			; char less than space?
	BLO	VCMD2			;    YES - ignore it
	CMPB	D1,#177			; RUBOUT ?
	JEQ	VCMD5			;    YES - same as backspace
	CMPB	D1,#'a			; check for lower case
	BLO	VCMD4
	CMPB	D1,#'z
	BHI	VCMD4
	SUB	#40,D1			; was lower, now upper
VCMD4:	MOVB	JINPUT(A4),D0		; advance char pointer
	AND	#377,D0
	MOV	JTRM(A4),A2		; make sure command string does
	MOV	T.ILS(A2),A2		;   not get longer than 5 less
	SUB	#5,A2			;   than ILS for my terminal, nor
	MOV	A2,D2
	CMPB	D0,D2			;   greater than 65.
	BHI	1$
	CMPB	D0,#65.
	BLO	VCMD4A			;    OK
1$:	MOVB	#7,D1			; echo my dislike with a DING
	TTY
	JMP	VCMD2
VCMD4A:	INC	D0
	MOVB	D0,JINPUT(A4)
	LEA	A2,JINPUT(A4)		; compute new char address
	ADD	D0,A2
	MOVB	D1,@A2			; stash char
	MOVB	#15,1(A2)		; stash terminator(s)
	MOVB	#12,2(A2)
	CLRB	3(A2)
	INC	DCURS(A4)		; move cursor
	TTY				; print char
	CMPB	D0,#1			; is this first character?
	JNE	VCMD2			;   NO
	CMPB	@A2,#'?			; is this a question mark?
	JEQ	VCMD9			;   YES - go for help
	JMP	VCMD2			;   NO  - next char
VCMD5:	MOVB	JINPUT(A4),D0		; get char pointer
	AND	#377,D0
	LEA	A2,JINPUT(A4)		; compute address
	ADD	D0,A2
	CLRB	@A2			; backup terminator
	DEC	D0			; backup pointer
	JMI	VCMD2			; BUT NOT PAST START!!!
	MOVB	D0,JINPUT(A4)		; stash pointer
	DEC	DCURS(A4)		; backup cursor
	TTYI				; fixup screen
	BYTE	10,40,10,0
	JMP	VCMD2
VCMD6:	TSTB	JINPUT(A4)		; any chars entered first?
	JEQ	VCMDGO			;    NO - ok to exit to cur job
	BR	VCMD7
VCMD6A:	TSTB	JINPUT(A4)		; any chars entered first?
	JEQ	VCMDT			;    NO - ok to toggle cur job
VCMD7:	CALL	VCMD0			; reinit the process
	JMP	VCMD2

SPAGF:	MOV	CFRAM(A4),D1		; get current frame
	ADD	#1,D1			; advance to next
	CMP	D1,NFRAM(A4)		; check for overflow
	BLE	1$			;   NO
	CLR	D1			;   YES - wrap
1$:	MOV	D1,CFRAM(A4)		; else update frame
	TST	NFRAM(A4)		;  when possible
	JEQ	VCMD2
	CALL	CHGFRM
	JMP	VCMD2

SPAGB:	MOV	CFRAM(A4),D1		; get current frame
	SUB	#1,D1			; backup to prior
	BGE	1$			; check for underflow
	MOV	NFRAM(A4),D1		;   YES - wrap
1$:	MOV	D1,CFRAM(A4)		; else update frame
	TST	NFRAM(A4)		;  when possible
	JEQ	VCMD2
	CALL	CHGFRM
	JMP	VCMD2

; Command decoder...
VCMD9:	TSTW	JINPUT(A4)		; anything entered?
	BEQ	VCMD7			;   NO
	LEA	A2,JINPUT+1(A4)		;   YES - point to it
	BYP				; bypass spaces...
	CMMB	#'?,@A2			; special test for HELP command
	BNE	0$
	MOVB	#'H,@A2			; make it abbrieviated HELP
	MOVB	#15,1(A2)		; stash terminator(s)
	MOVB	#12,2(A2)
	CLRB	3(A2)
0$:	PUSH	A2			; save line pointer
	LEA	A3,CMDTBL-14.		; init cmd table pointer
	PUSH	A3			; save it
VCMD10:	POP	A3			; recover cmd table ptr
	ADD	#14.,A3			; increment it
	POP	A2			; recover line pointer
	PUSH	A2			; restack pointers
	PUSH	A3
	BICL	#MATCH,JSTAT(A4)	; say no match
	CMMW	#-1,@A3			; end of cmd table?
	BEQ	VCMD13			;    YES
VCMD11:	CMPB	@A2,#'A			; line char alphabetic?
	BLO	VCMD12			;    NO
	CMPB	@A2,#'Z
	BHI	VCMD12			;    NO
	CMMB	@A2,@A3			; line char match table?
	BNE	VCMD10			;    NO
	BISL	#MATCH,JSTAT(A4)	; tentative match found
	INC	A2			; advance both ptrs
	INC	A3
	BR	VCMD11
VCMD12:	BITL	#MATCH,JSTAT(A4)	; have a match?
	BEQ	VCMD10			;    NO
	MOV	@SP,A0			;    YES - check for min length
	SUB	A0,A3			; A3 has # chars matched
	MOVW	12(A0),D6
	ANDW	#377,D6
	CMPW	A3,D6			; enought?
	BLO	VCMD10			;    NO
	POP	A3			;    YES - recover tbl ptr
	POP				; clean off stack
	ADD	#14,A3			; point to offset
	SUB	A1,A1
	MOVW	@A3,A1			; get offset
	ADD	A3,A1			; get abs address
	PUSH	A1			; exec appropiate routine
	MOVW	12(A0),D5		; after checking to see
	BITW	#400,D5			; if this clears security
	BEQ	1$
	MOV	JQUE(A4),A6
	BICL	#QBCHEK,QBFLG(A6)
1$:	CALL	VSTATU			; after a screen update
	RTN
VCMD13:	ADD	#8.,SP			; clean off stack
	CRT	23.,1			; msg and abort command
	CRT	255.,9.
	TYPE	<Undefined command, press ? for HELP.>
	JMP	VCMD7

VCMDA:	SAVE	A0-A5,D0-D5		; ENTRY POINT FOR INIT
VCMDA2:	CALL	JAUTO			; automatic job acquistion
	MOV	JCUR(A4),D7		; decide if status screen
	BEQ	1$			; must change frame due to 
	MOV	D7,A5			; change in current job...
	CMM	JFRAM(A5),CFRAM(A4)
	BEQ	1$
	MOV	JFRAM(A5),CFRAM(A4)
	CALL	CHGFRM
1$:	MOV	VCLK(A4),A2		; see if <= 31 days before expires
	ADD	#14,A2
	MOV	@A2,D2
	JMI	VCMD7
	VDATEI	D1
	SUB	D1,D2
	JLE	VCMD7			; no msg if expired
	CMP	D2,#31.
;	JLE	VH80			; warn if <= 31 days 
	JMP	VCMD7

VCMDAT:	MOV	JCUR(A4),A5		; attach real terminal to another
	MOV	A5,D7
	JEQ	VH70			; job - leaves VTAM detached...
	BYP
	LIN
	BEQ	1$
	CALL	JDET			; detach VTAM
	MOV	JJCB(A4),A1	
	MOV	JOBTRM(A1),D7
	BNE	1$
	REST	A0-A5,D0-D5
	RTN
1$:	JMP	VCMD7

VCAMOS:	BYP				; send AMOS shell a command
	CMM	DFMEM(A4),#4000.	; verify enought memory
	JLO	VH74
	USRFRE	A3			; find free memory
	LEA	A1,AMOS1		; point to initial stuff
	CLR	D0			; clear char count
1$:	MOVB	(A1)+,(A3)+		; move initial stuff, counting
	INC	D0
	TSTB	@A1
	BNE	1$
	CLR	D1
	CMPB	@A2,#15			; force CRLF after :T
	BNE	21$
2$:	MOVB	(A2)+,D1		; move users stuff, counting
	BEQ	4$			; (and subing pseudo CR's)
	CMPB	D1,#'|
	BNE	3$
21$:	MOVB	#15,(A3)+
	MOVB	#12,(A3)+
	ADD	#2,D0
	BR	2$
3$:	MOVB	D1,(A3)+
	INC	D0
	BR	2$
4$:	USRFRE	A3			; point back to start
	JOBIDX	A0
;	TSTW	JOBCMZ(A0)		; in command file? 
;	BNE	5$			;   YES 
	MOVW	#5000,JOBCMS(A0)	;   NO  - we are now 
5$:	MOV	JOBBAS(A0),A2		; get mem begin addr 
	ADD	JOBSIZ(A0),A2		; point to  end addr 
	ADDW	D0,JOBCMZ(A0)		; store cmd size 
	SUBW	JOBCMZ(A0),A2		; point to where cmd goes 
6$:	MOVB	(A3)+,(A2)+		; move it there...
	SUB	#1,D0
	BNE	6$
	CLR	JINPUT(A4)
	BISL	#TEMPX,JSTAT(A4)	; allow restart
	MOV	JQUE(A4),A3		; tell HPO we gone...
	BISL	#QBGONE,QBFLG(A3)
	CRT	255.,0			; clear screen
	CRT	255.,132.		; clear msg
	CRT	24.,1.			; to line 24 incase no line 25
	CRT	255.,128.		; begin line 25
	TTYI				; send  line 25
	ASCII	\        \
	ASCII	\     now at AMOS/L command level - type 'VTAM' to return...\
	BYTE	0
	EVEN
	CRT	255.,129.		; end line 25
	CRT	1,1			; home cursor
	MOV	OSTACK(A4),SP
	EXIT 

VCMDJ:	BYP				; acquire or make a job current
	LIN
	BEQ	1$
	CALL	JINIT
	MOV	JCUR(A4),D7		; decide if status screen
	BEQ	1$			; must change frame due to 
	MOV	D7,A5			; change in current job...
	CMM	JFRAM(A5),CFRAM(A4)
	BEQ	1$
	MOV	JFRAM(A5),CFRAM(A4)
	CALL	CHGFRM
1$:	JMP	VCMD7

VCMDNJ:	BYP				; release a job
	LIN
	BEQ	1$
	CALL	JTERM
	MOV	JCUR(A4),D7		; decide if status screen
	BEQ	1$			; must change frame due to 
	MOV	D7,A5			; change in current job...
	CMM	JFRAM(A5),CFRAM(A4)
	BEQ	1$
	MOV	JFRAM(A5),CFRAM(A4)
	CALL	CHGFRM
1$:	JMP	VCMD7

VCMDEB:	BISL	#BADENA,JSTAT(A4)	; say "CRT 255.,13." doesn't work
	JMP	VCMD7

VCMDEG:	BICL	#BADENA,JSTAT(A4)	; say "CRT 255.,13." works
	JMP	VCMD7

VCMDX1:	MOV	JQUE(A4),A6		; signal for a quit
	BISL	#QBQUIT,QBFLG(A6)
	JMP	VCMD7

VCMDX2:	MOV	@A4,A5			; exit vtam to AMOS
1$:	BITL	#VACT,JSTAT(A5)		; first release any acquired jobs
	BEQ	2$
	CALL	JTXXXX
2$:	MOV	@A5,A5
	MOV	A5,D7
	BNE	1$
	VLOK				; lock for queue search
	MOV	QBAS(A4),A3		; point to queue
11$:	MOV	A3,A2			; save old pointer
	MOV	@A3,A3			; advance pointer
12$:	MOV	A3,D7
	BEQ	15$			;   No more in queue
	BITL	#QBCTLG,QBFLG(A3)	; this a controlling job entry?
	BEQ	14$			;   NO
	CMM	QBJCB(A3),JJCB(A4)	; is it for this job?
	BNE	11$			;   NO  - continue scan
	MOV	QBTDV(A3),A0		;   YES - check for queue block
	MOV	#4,D1			;	  group being used for
	MOV	A0,D0			;	  TDV header - delete 
	BEQ	13$			;	  if so
121$:	QRET	A0
	ADD	#32.,D0
	MOV	D0,A0
	SOB	D1,121$
13$:	MOV	QBFLG(A3),D5		;	- save flags
	QRET	A3			;	- release it
	MOV	A3,@A2			;	- rechain the rest
	BR	12$			;	- continue scan
14$:	TST	QBFLG(A3)		; a controlled job?
	BNE	11$			;   NO
	CMM	QBCJCB(A3),JJCB(A4)	; a controlled job for me?
	BEQ	13$			;   YES - go remove it
	BR	11$			;   NO  - continue scan
15$:	VUNLK				; finished messing with queues
	SLEEP	#10000.
	CALL	VSTATU
	MOVW	#[VTA],JDDB+D.FIL(A4)
	MOVW	#[RUN],JDDB+D.FIL+2(A4)
	MOVW	#[LIT],JDDB+D.EXT(A4)
	SRCH	JDDB+D.FIL(A4),A0,F.USR
	BNE	16$
	CLR	-14(A0)			; wipe out VTARUN and all above it
16$:	MOVW	#[VTA],JDDB+D.FIL(A4)
	MOVW	#[M  ],JDDB+D.FIL+2(A4)
	MOVW	#[MEM],JDDB+D.EXT(A4)
	SRCH	JDDB+D.FIL(A4),A0,F.USR
	BNE	17$
	CLR	-14(A0)			; wipe out VTAM.MEM and all above it
17$:	CRT	255.,132.		; clear out the msg line
	BITL	#QBDATE,D5		; quit due to expired?
;	JEQ	EXPIRX			;   YES - say so
	BITL	#QBGOOD,D5		; quit due to invalid security?
;	JEQ	DEMO			;   YES - say so
	MOV	VCLK(A4),A2		; see if <= 31 days before expires
	ADD	#14,A2
	MOV	@A2,D2
	JMI	NORMAL
	VDATEI	D1
	SUB	D1,D2
	CMP	D2,#31.
;	JLE	WILEXP			; warn if <= 31 days 
	JMP	NORMAL

VCMDT:	CALL	JTOG			; toggle to next current job
	MOV	JCUR(A4),A5
	MOV	A5,D7
	JEQ	VH70
	CMM	JFRAM(A5),CFRAM(A4)
	BEQ	1$
	MOV	JFRAM(A5),CFRAM(A4)
	CALL	CHGFRM
1$:	MOV	JQUE(A4),A6
	BICL	#QBCHEK,QBFLG(A6)
	JMP	VCMD7

VCMDGO:	MOV	JCUR(A4),A5		; connect to current job
	MOV	A5,D7
	JEQ	VH70
	MOV	JQUE(A4),A6
	BICL	#QBCHEK,QBFLG(A6)
	CALL	VUNLD
	BICL	#CTLMOD,JSTAT(A4)
	REST	A0-A5,D0-D5
	RTN

VCMDHE:	CALL	VHLP			; list help...
	BITL	#INHELP,JSTAT(A4)
	JEQ	VCMD7
	REST	A0-A5,D0-D5
	RTN

VCMDTC:	MOV	JTRM(A4),A6
	BITW	#T$AB,@A6
	JNE	VH75
	BYP				; set toggle rqst char
	MOVB	@A2,D1
	AND	#37,D1
	BEQ	VCMDTX
	CMMB	D1,AESC(A4)
	JEQ	VCMD7
	CMMB	D1,PCHR(A4)
	JEQ	VCMD7
VCMDTX:	MOVB	D1,TCHR(A4)
	JMP	VCMD7

VCMDPC:	MOV	JTRM(A4),A6
	BITW	#T$AB,@A6
	JNE	VH75
	BYP				; set picture rqst char
	MOVB	@A2,D1
	AND	#37,D1
	BEQ	VCMDPX
	CMMB	D1,AESC(A4)
	JEQ	VCMD7
	CMMB	D1,TCHR(A4)
	JEQ	VCMD7
VCMDPX:	MOVB	D1,PCHR(A4)
	JMP	VCMD7

VCMDES:	MOV	JTRM(A4),A6
	BITW	#T$AB,@A6
	JNE	VH75
	BYP				; set alternate escape char
	MOVB	@A2,D1
	AND	#37,D1
	BEQ	VCMDE2
	CMMB	D1,PCHR(A4)
	JEQ	VCMD7
	CMMB	D1,TCHR(A4)
	JEQ	VCMD7
VCMDE2:	MOVB	D1,AESC(A4)
	JMP	VCMD7

VCMDBL:	BICL	#VQUIET,JSTAT(A4)	; BELL on
	JMP	VCMD7

VCMDNB:	BISL	#VQUIET,JSTAT(A4)	; BELL off
	JMP	VCMD7

VCMDL:	MOV	JCUR(A4),A5		; open standard log file
	MOV	A5,D7
	JEQ	VH70
	CALL	VCMDL1
	BICL	#MOVIE!LINPT,JSTAT(A5)
	JMP	VCMD7

VCMDMV:	MOV	JCUR(A4),A5		; open log as movie
	MOV	A5,D7
	JEQ	VH70
	CALL	VCMDL1
	BISL	#MOVIE,JSTAT(A5)
	BICL	#LINPT,JSTAT(A5)
	JMP	VCMD7

VCMDIL:	MOV	JCUR(A4),A5		; open input only log
	MOV	A5,D7
	JEQ	VH70
	CALL	VCMDL1
	BISL	#LINPT,JSTAT(A5)
	BICL	#MOVIE,JSTAT(A5)
	JMP	VCMD7

VCMDL1:	BITL	#LOGOP,JSTAT(A5)	; routine to open a log
	BNE	VCMDL2
	CLR	JDDB+D.FIL(A5)
	BYP
	LIN
	BEQ	VCMDL2
	MOVB	#3,JDDB+D.FLG(A5)
	FSPEC	JDDB(A5),LOG
VCMDL2:	JMP	OPELOG

VCMDNL:	MOV	JCUR(A4),A5		; LOG off
	MOV	A5,D7
	JEQ	VH70
	BITL	#LOGOP,JSTAT(A5)
	JEQ	VH71
	CALL	CLOLOG
	JMP	VCMD7

VCMDV:	MOV	JCUR(A4),A5		; Virtual Screen on
	MOV	A5,D7
	JEQ	VH70
	CALL	ALLCON
	JMP	VCMD7

VCMDNV:	MOV	JCUR(A4),A5		; Virtual Screen off
	MOV	A5,D7
	JEQ	VH70
	BITL	#VCON,JSTAT(A5)
	JEQ	VH72
	CALL	RELCON
	JMP	VCMD7

VCMDR:	MOV	JCUR(A4),A5		; turn on run-on
	MOV	A5,D7
	JEQ	VH70
	BISL	#RUNON,JSTAT(A5)
	JMP	VCMD7

VCMDNR:	MOV	JCUR(A4),A5		; turn off run-on
	MOV	A5,D7
	JEQ	VH70
	BICL	#RUNON,JSTAT(A5)
	JMP	VCMD7

VCMDI:	MOV	JCUR(A4),A5		; turn on image mode logging
	MOV	A5,D7
	JEQ	VH70
	BITL	#LOGOP,JSTAT(A5)
	JEQ	VH71
	BISL	#IMILG,JSTAT(A5)
	JMP	VCMD7

VCMDNI:	MOV	JCUR(A4),A5		; turn off image mode logging
	MOV	A5,D7
	JEQ	VH70
	BITL	#LOGOP,JSTAT(A5)
	JEQ	VH71
	BICL	#IMILG,JSTAT(A5)
	JMP	VCMD7

VCMDFO:	BYP				; force input to current job
	MOV	JCUR(A4),A5
	MOV	A5,D7
	JEQ	VH70
	BISL	#RUNON,JSTAT(A5)
VCMDFX:	MOVB	@A2,D1
	PUSH	D1
	CMPB	D1,#'|
	BNE	1$
	MOVB	#15,D1
1$:	CALL	TTYPUT
	INC	A2
	POP	D1
	CMPB	D1,#15
	BNE	VCMDFX
	JMP	VCMD7

VCABRT:	MOV	JCUR(A4),A5		; abort current job
	MOV	A5,D7
	JEQ	VH70
	VLOK				; lock for safety
	MOV	JJCB(A5),A0		; address JCB
	LEA	A3,JOBRNQ(A0)		; address scheduling area
	MOV	10(A3),A1		; get system stack pointer
	MOV	434,76(A1)		; point return PC to 'USER INT LVL 7'
	CLR	JOBERC(A0)		; remove various traps
	CLR	JOBBPT(A0)
	CLR	JOBTRC(A0)
	CLRW	JOBCMZ(A0)		; zap any command file
	MOV	JOBBAS(A0),A1		; clear any mem mods out
	CLR	@A1
	PUSH	A5			; clean up terminal
	MOV	JTRM(A5),A5
	CALL	DRAINO
	CLRW	@A5
	POP	A5
	BISW	#J.CCA,JOBTYP(A0)	; enable ^C interrupt
	BISL	#RUNON,JSTAT(A5)	; set RUNON
	MOVB	#3,D1			; send ^C
	CALL	TTYPUT
	CLR	D6			; funny JRUN to fire him up
	MOVW	@A0,D6
	ANDW	#J.TIW!J.TOW!J.SLP!J.IOW!J.EXW!J.SMW!J.SUS,D6
	SVCA	36
	VUNLK
	JMP	VCMD7

VCMDKI:	MOV	JCUR(A4),A5		; kill current job
	MOV	A5,D7
	JEQ	VH70
	MOV	JJCB(A5),A0
	BISW	#J.CCA,JOBTYP(A0)
	BISL	#RUNON,JSTAT(A5)
	MOVB	#3,D1
	CALL	TTYPUT
	JMP	VCMD7

VCMDPI:	MOV	JCUR(A4),A5		; make picture of virtual screen
	MOV	A5,D7
	JEQ	VH70
	BITL	#VCON,JSTAT(A5)
	JEQ	VH72
	BYP
	LIN
	BNE	VCMDP2
	CALL	DOPIC
	JMP	VCMD7
VCMDP2:	CALL	DOPIC2
	JMP	VCMD7

DOPIC:	LEA	A2,JINPUT+1(A4)
	LEA	A1,PICPRE(A5)
	MOVB	(A1)+,(A2)+
	BEQ	1$
	MOVB	(A1)+,(A2)+
	BEQ	1$
	MOVB	(A1)+,(A2)+
	BEQ	1$
	MOVB	(A1)+,(A2)+
	BNE	2$
1$:	SUB	#1,A2
2$:	MOV	PICNUM(A5),D1
	DCVT	2,OT$MEM
	CLRB	@A2
	INC	PICNUM(A5)
	LEA	A2,JINPUT+1(A4)
DOPIC2:	MOV	JME(A4),A0
	MOVB	#1,JDDB+D.FLG(A0)
	PUSH	A2
	FSPEC	JDDB(A0),PIC
	BEQ	1$
	POP	A2
	RTN
1$:	CALL	PRTPIC
	POP	A2
	CMMW	#[TRM],JDDB+D.DEV(A0)	; was the output to TRM?
	BNE	DOPIC3			;   YES - just return to status
	RTN

; ----------------------------------------------------------------------;
;	this code drops us to AMOS level to execute VPIC.DO		;
;	to do whatever picture processing the user wants...		;
; ----------------------------------------------------------------------;

DOPIC3:	USRFRE	A3			; find free memory
	CLR	D0			; clear char count
	LEA	A1,AMOS2		; point to initial stuff
2$:	MOVB	(A1)+,(A3)+		; move initial stuff, counting
	INC	D0
	TSTB	@A1
	BNE	2$
3$:	MOVB	(A2)+,D1		; move users stuff, counting
	BEQ	4$			; (and subing pseudo CR's)
	MOVB	D1,(A3)+
	INC	D0
	BR	3$
4$:	MOVB	#15,(A3)+
	MOVB	#12,(A3)+
	ADD	#2,D0
	USRFRE	A3			; point back to start
	JOBIDX	A0
;	TSTW	JOBCMZ(A0)		; in command file? 
;	BNE	5$			;   YES 
	MOVW	#5000,JOBCMS(A0)	;   NO  - we are now 
5$:	MOV	JOBBAS(A0),A2		; get mem begin addr 
	ADD	JOBSIZ(A0),A2		; point to  end addr 
	ADDW	D0,JOBCMZ(A0)		; store cmd size 
	SUBW	JOBCMZ(A0),A2		; point to where cmd goes 
6$:	MOVB	(A3)+,(A2)+		; move it there...
	SUB	#1,D0
	BNE	6$
	CLR	JINPUT(A4)
	BISL	#TEMPX,JSTAT(A4)	; allow restart
	MOV	JQUE(A4),A3		; tell HPO we gone...
	BISL	#QBGONE,QBFLG(A3)
	CRT	255.,0			; clear screen
	CRT	255.,132.		; clear msg
	CRT	24.,1.			; to line 24 incase no line 25
	CRT	255.,128.		; begin line 25
	TTYI				; send  line 25
	ASCII	\        \
	ASCII	\     now at AMOS/L command level - type 'VTAM' to return...\
	BYTE	0
	EVEN
	CRT	255.,129.		; end line 25
	CRT	1,1			; home cursor
	MOV	OSTACK(A4),SP
	EXIT 

VCMDPF:	MOV	JCUR(A4),A5		; set the picture prefix
	MOV	A5,D7
	JEQ	VH70
	BITL	#VCON,JSTAT(A5)
	JEQ	VH72
	BYP
	LIN
	BNE	2$
	CRT	23.,1
	TYPE	<Current picture prefix is >
	MOV	#4,D2
	LEA	A3,PICPRE(A5)
1$:	MOVB	(A3)+,D1
	TTY
	SOB	D2,1$
	TYPE	<, next picture will be #>
	CALL	PSCAN
	MOV	PICNUM(A5),D1
	DCVT	2,OT$TRM
	TYPE	<.>
	JMP	VCMD7
2$:	MOV	#4,D1
	LEA	A3,PICPRE(A5)
	CLR	@A3
	BYP
3$:	LIN
	BEQ	4$
	MOVB	(A2)+,(A3)+	
	SOB	D1,3$
4$:	CLRB	@A2
	JMP	VCMDPF

VEXPIR:	CRT	23.,1
	CRT	255.,9.
	CRT	23.,25.
	TYPESP	<VTAM expires>
	MOV	CMDEXP,D1
	BMI	1$
	MOV	#8.,D2
	ROL	D1,D2
	AND	#377,D1
	DCVT	2,OT$TRM
	TYPE	<->
	MOV	CMDEXP,D1
	MOV	#16.,D2
	ROL	D1,D2
	AND	#377,D1
	SUB	#1,D1
	LEA	A0,MTBL
	ADD	D1,D1
	ADD	D1,D1
	ADD	D1,A0
	TTYL	@A0	
	TYPE	<->
	MOV	CMDEXP,D1
	AND	#377,D1
	DCVT	2,OT$TRM
1$:	JMP	VH99

VH70:	CRT	23.,1
	TYPE	<No current job.>
	JMP	VH99
VH71:	CRT	23.,1
	TYPE	<No open log for current job.>
	JMP	VH99
VH72:	CRT	23.,1
	TYPE	<No virtual crt for current job.>
	JMP	VH99
VH74:	CRT	23.,1
	TYPE	<Insufficent storage for AMOS command.>
	JMP	VH99
VH75:	CRT	23.,1
	TYPE	<ESC, TCHR, PCHR commands invalid with your terminal.>
	JMP	VH99
VH80:	CRT	23.,1
	CALL	EXPMSG

VH99:	CRT	255.,9.
	JMP	VCMD7

; subroutine to set next picture number.
PSCAN:	CLR	PICNUM(A5)		; zero it initially
	USRFRE	A0			; get mem end into A0
	SAVE	A0-A5,D0-D5		; save regs
	MOVB	#3,JDDB+D.FLG(A4)	; setup utility DDB
	JOBIDX	A0
	MOVW	JOBDEV(A0),JDDB+D.DEV(A4)
	MOVW	JOBDRV(A0),JDDB+D.DRV(A4)
	MOVW	JOBUSR(A0),JDDB+D.PPN(A4)
	INIT	JDDB(A4)
	JNE	PSDONE
PMFD:	CLR	D1
	MOVW	JDDB+D.PPN(A4),D1
	LEA	A2,JDDB(A4)
	CALL	$FNPPN
	BNE	PSDONE
	CLR	D1
	MOVW	2(A1),D1
	MOV	D1,JDDB+D.REC(A4)	; get first UFD record
	BEQ	PSDONE
PUFD:	READ	JDDB(A4)		; get it into storage
	BNE	PSDONE
	MOV	JDDB+D.BUF(A4),A1	; address UFD in storage
	ADD	#2,A1			; bypass link word
	MOV	#42.,D0			; there are 42 entries/UFD block
0$:	TSTW	@A1			; logical end of UFD?
	BEQ	PSDONE			;    YES
	CMMW	#-1,@A1			; erased file?
	BEQ	2$			;    YES
	CMMW	#[PIC],4(A1)		; right kind of file?
	BNE	2$			;    NO
	LEA	A2,JWRK(A4)		;    YES - unpack name
	UNPACK
	UNPACK
	CLRB	@A2			; delimit
	SUB	#4,A1			; fixup A1 after unpacks
	LEA	A2,JWRK(A4)		; point to unpacked name
	LEA	A3,PICPRE(A5)		; point to picture prefix
	MOV	#4,D1			; prefix max 4 chars
1$:	TSTB	@A3			; end of prefix?
	BEQ	11$			;   YES - go check number
	CMMB	(A3)+,(A2)+		; equal so far?
	BNE	2$			;   NO
	SOB	D1,1$			; check up to 4 of 'em
11$:	GTDEC				; get number into D1
	BMI	2$			;    BAD???
	CMP	D1,PICNUM(A5)		; less than we have so far?
	BLO	2$			;    YES
	MOV	D1,PICNUM(A5)		;    NO  - update what we have
2$:	ADD	#12.,A1			; point to next one
	SOB	D0,0$			; go process rest of logical rec
	MOV	JDDB+D.BUF(A4),A2	; get link to next physical  rec
	CLR	D0
	MOVW	@A2,D0
	MOV	D0,JDDB+D.REC(A4)
	BNE	PUFD			; and go read it
PSDONE:	INC	PICNUM(A5)		; advance number past whatever...
	REST	A0-A5,D0-D5		; restore regs
	CLR	-4(A0)			; wipe out the buffer and goback
	RTN

DEFINE	CMD	TEXT,SUBR,MIN,SEC
1$$:	ASCII	/TEXT/
	.=1$$+10.
2$$	=	1
	IF	NB,MIN,2$$=MIN
2$$	=	2$$!^O400
	IF	NB,SEC,2$$=2$$&^O377
	WORD	2$$
	OFFSET	SUBR
	ENDM

; command table...
CMDTBL:	CMD	ABORT,VCABRT,2
	CMD	ATTACH,VCMDAT,2,A
	CMD	AMOS,VCAMOS,2,A
	CMD     BELL,VCMDBL,,A
	CMD	ENABAD,VCMDEB,6,A
	CMD	ENAGOOD,VCMDEG,7,A
        CMD     ESC,VCMDES,2,A
;	CMD	EXPIRE,VEXPIR,2,A
        CMD     FORCE,VCMDFO
	CMD	GET1,VCMDA2,2
        CMD     GO,VCMDGO,2
        CMD     HELP,VCMDHE,,A
        CMD     IMAGE,VCMDI,2,A
        CMD     INPLOG,VCMDIL,2,A
        CMD     JOB,VCMDJ
        CMD     KILL,VCMDKI
        CMD     LOG,VCMDL,,A
        CMD     MOVIE,VCMDMV,,A
        CMD     NBELL,VCMDNB,2
        CMD     NIMAGE,VCMDNI,2
        CMD     NJOB,VCMDNJ,2
        CMD     NLOG,VCMDNL,2
        CMD     NOBELL,VCMDNB,3
        CMD     NOIMAGE,VCMDNI,3
        CMD     NOJOB,VCMDNJ,3
        CMD     NOLOG,VCMDNL,3
        CMD     NORUNON,VCMDNR,3
        CMD     NOVCRT,VCMDNV,3
        CMD     NRUNON,VCMDNR,2
        CMD     NVCRT,VCMDNV,2
        CMD     PCHAR,VCMDPC,2,A
        CMD     PCHR,VCMDPC,2,A
        CMD     PIC,VCMDPI,2
        CMD     PREFIX,VCMDPF,2,A
        CMD     QUIT,VCMDX1,4
        CMD     RUNON,VCMDR,,A
	CMD	TCHAR,VCMDTC,2,A
	CMD	TCHR,VCMDTC,2,A
	CMD	TOGGLE,VCMDT,2
        CMD     VCRT,VCMDV,,A
	WORD	-1

NORMAL:	CRT	22.,1.
	CRT	255.,10.
	TYPE	<Bye...>
	CRT	24.,1.
	MOV	OSTACK(A4),SP
	EXIT

DEMO:	CRT	22.,1.
	CRT	255.,10.
	TYPE	<Bye - VTAM in demo mode ->
	CRT	24.,1.
	MOV	OSTACK(A4),SP
	EXIT

WILEXP:	CRT	22.,1.
	CRT	255.,10.
	TYPE	<Bye - >
	CALL	EXPMSG
	TTYI
	BYTE	7,0
	CRT	24.,1.
	MOV	OSTACK(A4),SP
	EXIT

EXPMSG:	TYPE	<VTAM expires in >
	MOV	D2,D1
	DCVT	0,OT$TRM
	TYPE	< day>
	CMP	D2,#1
	BLE	1$
	TYPE	<s>
1$:	TYPE	< - have you reordered?>
	RTN

EXPIRX:	CRT	22.,1.
	CRT	255.,10.
	TYPE	<Bye - VTAM has expired ->
	CRT	24.,1.
	MOV	OSTACK(A4),SP
	EXIT

CMDEXP:	LWORD	EXPIRE

AMOS1:	ASCII	/:T/
	BYTE	0

AMOS2:	ASCII	/VPIC /
	BYTE	0

	EVEN
	END