;	VTAM (release 2.2) version of PEXPND.LIT
;
;       Copyright [c] Noel Alaska Systems Technology, 1985.
 
VMAJOR	=	2.			; version equates
VMINOR	=	2.
VSUB	=	0.
VEDIT	=	1.			; CHANGE EACH EDIT <-----------
VWHO	=	0.
 
        SEARCH  SYS                     ; AMOS librarys
        SEARCH  SYSSYM
	SEARCH	TRM
	SEARCH	MFN			; My library
 
        DSECT
        .=0				; define impure area
PTBL:	BLKL	10.			; parm pointer table
ORG:	BLKW	1.			; original ext for fspec
CTL:	BLKW	1.			; #[CTL]
IDDB:	BLKB	D.DDB+6.		; input  DDB
ODDB:	BLKB	D.DDB+6.		; output DDB
LPPN:	BLKB	16.			; current login PPN
LDVC:	BLKB	8.			; current login device/driver
FILB:	BLKB	120.			; parm defaults line from file
TRYLIB:	BLKB	1			; switch
        EVEN
IMPURE  =       .
        .=0
        PSECT

LF	=	12
CR	=	15
SPACE	=	40
DOLLAR	=	44
COMMA	=	54
BRAKL	=	74
BRAKR	=	76


BEGIN:  PHDR    -1,-1,PH$REE!PH$REU
        GETIMP  IMPURE,A5               ; get memory

	PUSH	A2			; save cmd line pointer

	LEA	A1,JOBDEV(A0)		; set current login into buffer
	LEA	A2,LDVC(A5)
	UNPACK
	CLR	D1
	MOVB	JOBDRV(A0),D1
	PUSHW	JOBTYP(A0)		; save JOBTYP
	ANDW	#^C<J.HEX>,JOBTYP(A0)	; turn off HEX in JOBTYP
	DCVT	0,OT$MEM		; set drv number into buffer
	MOVB	#':,(A2)+		; followed by colen
	MOVB	#CR,(A2)+		; followed by CR
	MOVB	JOBUSR+1(A0),D1		; set up the PPN
	AND	#377,D1
	LEA	A2,LPPN(A5)
	OCVT	0,OT$MEM
	MOVB	#COMMA,(A2)+
	MOVB	JOBUSR(A0),D1
	AND	#377,D1
	OCVT	0,OT$MEM!OT$TSP
	POPW	JOBTYP(A0)		; restore the JOBTYP

	POP	A2			; restore ILB pointer
	PUSH	A2
	FSPEC	IDDB(A5),DO		; spec the DO file
	MOVW	#[DO ],IDDB+D.EXT(A5)
	INIT	IDDB(A5)
	POP	A2
	FSPEC	ODDB(A5),CTL
	MOVW	#[CTL],ODDB+D.EXT(A5)
	INIT	ODDB(A5)

	LOOKUP	ODDB(A5)
	BNE	3$
	DSKDEL	ODDB(A5)
3$:	OPENO	ODDB(A5)

	PUSHW	IDDB(A5)		; save flags/error

TRYIT:	BISB	#3,IDDB+D.FLG(A5)	; nomsg/noabort
	OPENI 	IDDB(A5)		; attempt open
	TSTB	IDDB+D.ERR(A5)		; check results
	BEQ	GOTIT			; good - 
	CMMW	#1002,IDDB+D.PPN(A5) 	; bad - this [2,2] ?
	JEQ	NFND			;	 yah - quit
	TSTB	TRYLIB(A5)		;      - tried lib yet?
	BNE	1$			;	 yah - try [2,2] next
	MOVB	#1,TRYLIB(A5)
	JOBIDX	A0
	MOVW	JOBUSR(A0),IDDB+D.PPN(A5)
	CLRB	IDDB+D.PPN(A5)
	BR	TRYIT
1$:	MOVW	#1002,IDDB+D.PPN(A5)  	; try [2,2]
	MOVW	#[DSK],IDDB+D.DEV(A5) 	; on DSK0:
	CLRW	IDDB+D.DRV(A5)	  	; (also known as CMD:)
	CLRW	IDDB+D.DRV(A5)
	CLR	IDDB+D.DVR(A5)
	BR	TRYIT

GOTIT:	POPW	IDDB(A5)		; restore flags/error
	MOV	#10.,D1			; clear the pointer table
	LEA	A0,PTBL(A5)
1$:	CLR	(A0)+
	DEC	D1
	BNE	1$
	LEA	A0,PTBL(A5)		; point to cleared storage
	CALL	GPARMS			; analysis of cmd line parms
	BR	EDITIT			; go merge defaults/edit file

GPARMS:	CMPB	@A2,#CR			; end-of-line?
	BEQ	5$			;  YES - done
	CMPB	(A2)+,#SPACE		; space or less?
	BLOS	GPARMS			;  YES - bypass
	DEC	A2
	CMPB	@A2,#DOLLAR		; dollar sign?
	BEQ	4$			;  YES - leave a hole in table
	TST	@A0			;  NO  - is this filled in yet?
	BNE	1$			;	 YES - ignore second
	MOV	A2,@A0			;	 NO  - fill in
1$:	ADD	#4,A0			; advance table pointer
	INC	A2			; advance line  pointer
	CMPB	-1(A2),#BRAKL		; is this opening bracket?
	BEQ	3$			;  YES - special handling
2$:	CMPB	@A2,#CR			; is this end-of-line
	BEQ	5$			;  YES - done
	CMPB	(A2)+,#SPACE		; space or less
	BLOS	GPARMS			;  YES - do next
	BR	2$			; loop until either of above...
3$:	CMPB	@A2,#CR			; is this end-of-line
	BEQ	5$			;  YES - done
	CMPB	(A2)+,#BRAKR		; closing bracket
	BEQ	GPARMS			;  YES - do next
	BR	3$			; loop until either of above...
4$:	INC	A2			; leave hole in table
	ADD	#4,A0
	BR	GPARMS
5$:	RTN

EDITIT:	USRFRE	A3			; put edited file at USRFRE
	CALL	BYTIN			; get first byte
	CMPB	D1,#DOLLAR		; is it dollar sign
	BNE	3$			;  NO  - no parms
	CALL	BYTIN			; get second byte
	CMPB	D1,#DOLLAR		; is it dollar sign
	BEQ	3$			;  YES - no parms ($ is escaped)
	CMPB	D1,#'D			; is it D
	BNE	4$			;  NO  - no parms (whatever goes away)
	LEA	A2,FILB(A5)		;  YES - parms exist
1$:	CALL	BYTIN			; copy parm line to core
	MOVB	D1,(A2)+
	CMPB	D1,#LF
	BNE	1$
	LEA	A2,FILB(A5)		; point to in-core parm line
	LEA	A0,PTBL(A5)		; point to parm list (again)
	CALL	GPARMS			; fill in any defaults

2$:	CALL	BYTIN			; *** main loop *** 
	CMPB	D1,#DOLLAR		; this starting a parm?
	BEQ	4$			;  YES - go handle

3$:	FILOTB	ODDB(A5)		;  NO  - copy to OUT
	BR	2$

4$:	CALL	BYTIN			; get parm arg
	CMPB	D1,#DOLLAR		; is it second dollar?
	BEQ	3$			;  YES - allow as escape
	UCS				;  NO  - force upper case
	CMPB	D1,#'P			; asks for current PPN?
	BEQ	8$			;  YES - go handle
	CMPB	D1,#':			; asks for current DVC/DRV?
	BEQ	9$			;  YES - go handle
	SUB	#60,D1			; make arg numeric
	BMI	2$			; invalids get ignored
	CMPB	D1,#11
	BHI	2$
	LEA	A0,PTBL(A5)		; use arg as index to table
	ASL	D1
	ASL	D1
	ADD	D1,A0
	TST	@A0
	BEQ	2$
	MOV	@A0,A0			; table entry points to parm
	CMPB	@A0,#BRAKL		; is parm opening bracket?
	BEQ	6$			;  YES - special handling

5$:	CMPB	@A0,#SPACE		; is this char space or less
	BLOS	2$			;  YES - end of parm
	MOVB	(A0)+,D1
	FILOTB	ODDB(A5)
	BR	5$			;	 loop till end of parm

6$:	INC	A0			; advance past opening bracket
7$:	CMPB	@A0,#BRAKR		; this trailing bracket?
	BEQ	2$			;  YES - end of parm
	CMPB	@A0,#CR			; this end-of-line
	BEQ	2$			;  YES - end of parm
	MOVB	(A0)+,D1
	FILOTB	ODDB(A5)
	BR	7$			;	 loop until end of parm

8$:	LEA	A0,LPPN(A5)		; copy login PPN
	BR	5$
9$:	LEA	A0,LDVC(A5)		; copy login device,drive
	BR	5$

DOIT:	CLOSE	IDDB(A5)		; close the file
	CLOSE	ODDB(A5)
EXIT:	EXIT				; exit will then fire it up

BYTIN:	FILINB	IDDB(A5)
	TST	IDDB+D.SIZ(A5)
	BEQ	DOIT
	AND	#377,D1
	RTN

NFND:	TYPE	<?>			; gives AMOS "can't find it" msg
	LEA	A2,FILB(A5)
	LEA	A1,IDDB+D.FIL(A5)
	UNPACK
	UNPACK
	CLRB	@A2
	MOV	#5.,D1
1$:	DEC	A2
	CMPB	@A2,#40
	BNE	2$
	CLRB	@A2
	SOB	D1,1$
2$:	TTYL	FILB(A5)
	TYPE	<?>
	CRLF
	EXIT

	EVEN
	END