.TITLE	CLEXTRACT
;
; THIS PROGRAM EXTRACTS COMMAND DEFINITIONS FROM A COMMAND LANGUAGE TABLES FILE
;   IT WORKS ONLY ON A FILE AND NOT ON THE PROCESS TABLES
;   IT WORKS UNDER VMS V3.0 AND V3.1.  THERE ARE NO GUARANTEES ABOUT ANY 
;	FUTURE VERSIONS! IN PARTICULAR, AS THE INTERNAL IMAGES TABLE IN DCL
;	IS MODIFIED, THE DCLIMAGES MACRO MUST BE MODIFIED TO MATCH THE
;	ORDER OF DCL'S INTIMAGES MACRO. THE MCRIMAGES MACRO MUST MATCH THE ORDER
;	OF DCL'S MCRINTIMG MACRO.
;
;
	.LIBRARY	"CLD"
	.LIBRARY	"SYS$LIBRARY:LIB.MLB"
	.PSECT	CLEXTRACT,LONG
	$IHDDEF
	$ISDDEF
	$CMDDEF
	$ENTDEF
	.ENTRY	CLEXTRACT,^M<R2>
;
; PROCESS /CLI QUALIFIER
;
	PUSHAL	CLIVAL
	PUSHAL	CLILAB	
	CALLS	#2,G^CLI$GET_VALUE
	CLRL	CLIFLG
	CMPW	CLI,DCL
	BEQL	GETTAB
	INCL	CLIFLG
	$FAB_STORE	FAB=FAB,FNA=MCRTAB,FNS=#25.
;
; GET NAME OF INPUT DCL TABLES FILE
;
;
GETTAB:	PUSHAL	TABFIL
	PUSHAL	TABLAB
	CALLS	#2,G^CLI$GET_VALUE
	BLBC	R0,GETOUT			;NOT PRESENT, USE DEFAULT
	MOVL	TABFIL+4,R2
	$FAB_STORE	FAB=FAB,FNA=(R2),FNS=TABFIL
;
; GET OUTPUT FILE NAME
;
GETOUT:	PUSHAL	OUTFILE
	PUSHAL	OUTLAB
	CALLS	#2,G^CLI$GET_VALUE
	MOVL	OUTFILE+4,R2
	$FAB_STORE	FAB=OUTFAB,FNA=(R2),FNS=OUTFILE
;
; CHECK FOR /ALL QUALIFIER (EXTRACT ALL VERBS)
;
	CLRL	ALL
	PUSHAL	ALLAB
	CALLS	#1,CLI$PRESENT
	BBC	#0,R0,10$
	INCL	ALL
	BRB	40$
;
; IF /ALL WAS NOT SPECIFIED /VERB MUST BE SPECIFIED
;
10$:	PUSHAL	IVERB
	PUSHAL	VLAB
	CALLS	#2,G^CLI$GET_VALUE
	BLBS	R0,15$
	MOVL	#^X38048,MSGNUM
	BRW	NOVERB
;
; VERB TABLE HAS ONLY FOUR CHARACTERS/VERB.  
;
15$:	MOVL	#4,R1
	MOVAL	VERB,R2
20$:	CMPB	#^X20,(R2)+
	BEQL	30$
	SOBGTR	R1,20$
30$:	SUBL3	R1,#4,VERBLEN
;
; OPEN THE INPUT TABLES FILE
40$:	$OPEN	FAB=FAB
	BLBS	R0,50$
	BRW	OPERR
50$:	$CONNECT RAB=RAB
;
; READ THE IMAGE HEADER AND SET UP TO READ IN THE TABLES
;
	$RAB_STORE	RAB=RAB,BKT=#1
	$READ	RAB=RAB
	MOVAL	BUFFER,HEADER
	MOVL	HEADER,R1
	MOVZWL	IHD$W_SIZE(R1),R3			;ISD ADDRESS
	CVTWL	R3,R3
	ADDL2	R1,R3
	MOVZWL	ISD$W_PAGCNT(R3),R5
	CVTWL	R5,R5
	MULL	#512,R5					;TABLE SIZE IN BYTES
	MOVAL	RAB,R6
	CLRW	RAB$W_USZ(R6)
	MOVL	ISD$L_VBN(R3),RAB$L_BKT(R6)
;
; GET VIRTUAL MEMORY TO HOLD THE TABLES
;
	MOVL	R5,SIZE
	PUSHAL	TABLES
	PUSHAL	SIZE
	CALLS	#2,G^LIB$GET_VM
	MOVL	TABLES,RAB$L_UBF(R6)
;
; LOOP READING A MAX OF 128 BLOCKS AT A TIME UNTIL ALL TABLES ARE IN
;
LOOP:
	MOVZWL	RAB$W_USZ(R6),R7		;SIZE OF LAST READ
	ADDL2	R7,RAB$L_UBF(R6)		;UPDATE BUFFER ADDRESS
	DIVL2	#512,R7				;NUMBER OF BLOCKS IN LAST READ
	ADDL2	R7,RAB$L_BKT(R6)		;UPDATE START BLOCK NUMBER
	MOVL	R5,R9				;ASSUME READ ALL REMAINING BYTES
	CMPL	R5,MAXREAD			;IF MORE THAN 64K BYTES
	BLEQ	10$
	MOVL	MAXREAD,R9			; THEN READ 64K BYTES
10$:
	MOVW	R9,RAB$W_USZ(R6)		;SET SIZE OF READ
	$READ	RAB=RAB
	SUBL	R9,R5				;UPDATE BYTES REMAINING
	BNEQ	LOOP				;AND LOOP IF NONZERO
	$CLOSE	FAB=FAB
;
; OPEN THE OUTPUT FILE
;
	$CREATE	FAB=OUTFAB
	BLBS	R0,12$
	BRW	OPERR
12$:	$CONNECT	RAB=OUTRAB
;
; INITIALIZE TABLE POINTERS
;
	MOVL	TABLES,R8
	ADDL3	28.(R8),R8,R7
	MOVL	R7,PTRTAB			;SAVE POINTER TABLE ADDRESS
	SUBL3	12(R8),16(R8),R0
	DIVL3	#4,R0,R6			;R0=TABLE LENGTH
	MOVL	R6,VERBNUM			;NUMBER OF VERBS
	ADDL3	12(R8),R8,R1
	MOVL	R1,VERBTAB			;SAVE VERB TABLE ADDRESS
;
	TSTL	ALL
	BEQL	15$
	MOVL	(R1),VERB
	MOVL	#4,VERBLEN
	CLRL	R8
	CLRL	IVERB
	BRB	BLOOP
;
; LOCATE VERB IN THE TABLE
;
15$:	MOVAL	VERB,R5
	BISB	#^X80,(R5)
	MOVL	#4,R4
	MATCHC	R4,(R5),R0,(R1)
	BEQL	OK
	MOVL	#^X38090,MSGNUM
	BRW	NOVERB
;
OK:	ADDL	#4,R2
	DIVL3	#4,R2,R8
	SUBW3	R8,R6,R8
;
; START OF MAIN LOOP WHICH IS EXECUTED ONCE FOR EACH VERB
;
BLOOP:	BICB	#^X80,VERB
	CLRL	SYNNUM
	CLRL	KEYNUM
	MOVAL	(R7)[R8],R0
	MOVL	(R0)+,R8
	ADDL	R0,R8
	$RAB_STORE	RAB=OUTRAB,RBF=SEP,RSZ=#80.
	$PUT	RAB=OUTRAB				;WRITE SEPARATOR RECORD
;
; ADD A WARNING LINE FOR IMMEDIATE COMMANDS AND FOR FOREIGN COMMANDS
;
	BITB	#CMD_M_IMMED!CMD_M_FOREIGN,CMD_B_FLAGS(R8)
	BEQL	PRE
	$RAB_STORE	RAB=OUTRAB,RBF=WARREC,RSZ=#80
	$PUT	RAB=OUTRAB
;
; PRE-PROCESS FOR THE SYNTAX STATEMENTS AND KEYWORDS
;	BECAUSE THEY MUST BE DEFINED BEFORE THEY ARE REFERENCED
;
;
PRE:	CLRL	R10
	MOVZWL	CMD_W_PARMS(R8),R7		;START WITH PARAMETERS
	CVTWL	R7,R7
	BEQL	40$
10$:	ADDL	R8,R7
;
20$:	PUSHL	R7
	CALLS	#1,RECUR			;RECURSIVELY PROCESS KEYWORD STATEMENTS
	PUSHL	R7
	CALLS	#1,RECUR1			;RECURSIVELY PROCESS SYNTAX STATEMENTS
	MOVZBL	ENT_B_NEXT(R7),R9		;ANY MORE OF THIS TYPE?
	BEQL	30$
	ADDL	R9,R7
	BRW	20$
30$:	BBSS	#0,R10,50$			;AFTER PARAMETERS DO
40$:	MOVZWL	CMD_W_QUALS(R8),R7		;  QUALIFIERS
	CVTWL	R7,R7
	BNEQ	10$
50$:
;
; NOW DO THE VERB DEFINITION
;
	ADDL3	#12,VERBLEN,R6
	$RAB_STORE	RAB=OUTRAB,RBF=VERBREC,RSZ=R6
	$PUT	RAB=OUTRAB
	BITB	#CMD_M_FOREIGN,CMD_B_FLAGS(R8)
	BNEQ	70$					;SKIP IMAGE/ROUTINE
	MOVZWL	CMD_W_IMAGE(R8),R7
	CVTWL	R7,R7
	BGTR	60$
	PUSHL	R7
	CALLS	#1,ROUTINE
	BRB	70$
60$:	ADDL	R8,R7				;ADDRESS OF IMAGE NAME
	MOVZBL	(R7)+,R6			;LENGTH OF NAME
	MOVC3	R6,(R7),IMAGE
	ADDL	#13,R6
	$RAB_STORE	RAB=OUTRAB,RBF=IMGREC,RSZ=R6
	$PUT	RAB=OUTRAB
;
; PROCESS ANY AND ALL PARAMETERS 
;
70$:	MOVZWL	CMD_W_PARMS(R8),R7
	CVTWL	R7,R7
	BNEQ	80$
	BRW	QUALIFS
80$:	ADDL	R8,R7				;ADDRESS OF FIRST ENTITY DESC
	PUSHL	R7
	CALLS	#1,DOPARMS			;INTERNAL ROUTINE 
;
; DO ANY AND ALL QUALIFIERS
;
QUALIFS:
	MOVZWL	CMD_W_QUALS(R8),R7
	CVTWL	R7,R7
	BNEQ	10$
	BRW	DOOUTS
10$:	ADDL	R8,R7
	PUSHL	R7
	CALLS	#1,DOQUALS			;INTERNAL ROUTINE
;
DOOUTS:
	TSTL	CLIFLG				;TEST WHICH CLI
	BEQL	5$
	BRW	END				;NO OUTPUTS ON /CLI=MCR
5$:	MOVZWL	CMD_W_OUTPUTS(R8),R7
	CVTWL	R7,R7
	BNEQ	10$
	BRW	END
10$:	MOVAL	OUTREC+18.,R10			;OUTPUT RECORD
	CLRL	R11
;
	MOVL	R8,-(SP)
	ADDL	R8,R7
	MOVZBL	(R7)+,R9
15$:	MOVL	(SP),R8		;RESTORE R8
	MOVZBL	(R7)+,R6
	CVTBL	R6,R6
	BLSS	40$
	MOVZWL	CMD_W_QUALS(R8),R5
	ADDL	R8,R5
	DECL	R6
	BEQL	30$
20$:	MOVZBL	ENT_B_NEXT(R5),R0
	ADDL	R0,R5
	SOBGTR	R6,20$
30$:	MOVZWL	ENT_W_NAME(R5),R6
	ADDL	R5,R6
	BBCS	#0,R11,35$
	MOVB	COMMA,(R10)+
35$:	MOVZBL	(R6)+,R8
	MOVC3	R8,(R6),(R10)
	ADDL	R8,R10
	BRB	50$
40$:	MNEGL	R6,R6
	ADDL	#48,R6
	BBCS	#0,R11,45$
	MOVB	COMMA,(R10)+
45$:	MOVB	#^A/P/,(R10)+
	MOVB	R6,(R10)+
50$:	SOBGTR	R9,15$
	MOVB	PAREN,(R10)+
	SUBL	#OUTREC,R10
	$RAB_STORE	RAB=OUTRAB,RBF=OUTREC,RSZ=R10
	$PUT	RAB=OUTRAB
;
;
END:	TSTL	ALL
	BEQL	EXIT
;
; FOR /ALL SET THINGS UP FOR LOOPING BACK
;
	DECL	VERBNUM				;ANY VERBS LEFT?
	BEQL	EXIT				;IF NOT, QUIT
	MOVL	VERBNUM,R6
	ADDL	#4,VERBTAB
	MOVL	@VERBTAB,VERB
	TSTL	VERB
	BEQL	EXIT
	MOVL	#4,VERBLEN
	CMPB	#^X20,VERB+3
	BNEQ	10$
	DECL	VERBLEN
	CMPB	#^X20,VERB+2
	BNEQ	10$
	DECL	VERBLEN
	CMPB	#^X20,VERB+1
	BNEQ	10$
	DECL	VERBLEN
10$:
	MOVL	PTRTAB,R7
	INCL	IVERB
	MOVL	IVERB,R8
	BRW	BLOOP
;
EXIT:	$CLOSE	FAB=OUTFAB
	$EXIT_S
;
; ERROR OPENING INPUT FILE
;
OPERR:	MOVL	R0,MSGNUM
	$PUTMSG_S	MSGVEC=MSG
	$EXIT_S
;
; BAD OR MISSING VERB SPECIFICATION
;
NOVERB:	
	MOVW	#1,MSG
	$PUTMSG_S	MSGVEC=MSG
	$EXIT_S
;
; DOPARMS - SUBROUTINE TO PROCESS A PARAMETER LIST
;
	.ENTRY	DOPARMS,^M<R6,R7,R8,R9,R10,R11>
;
	MOVL	4(AP),R7

	MOVL	#2,NAMLEN
	MOVB	P,NAME
;
;  PARAMETER LOOP, EXECUTED ONCE PER PARAMETER
;
PLOOP:
	ADDB3	ENT_W_NAME(R7),#48,NAME+1
	MOVB	NAME+1,PNUM
	$RAB_STORE	RAB=OUTRAB,RBF=PRMREC,RSZ=#19.
	$PUT	RAB=OUTRAB				;PARAMETER STATEMENT
;
;    PROCESS LABEL
;
	MOVZWL	ENT_W_LABEL(R7),R9			
	CVTWL	R9,R9
	BEQL	DOPROMPT
	ADDL	R7,R9					;LABEL ADDRESS
	MOVZBL	(R9)+,R6
	MOVC3	R6,(R9),LABEL				;MOVE TO LABEL FIELD
	ADDL	#23,R6
	$RAB_STORE	RAB=OUTRAB,RBF=LABREC,RSZ=R6
	$PUT	RAB=OUTRAB
;
;    PROCESS PROMPT
;
DOPROMPT:
	MOVZWL	ENT_W_PROMPT(R7),R9			;PROMPT OFFSET
	CVTWL	R9,R9
	BEQL	DOSYNT
	ADDL	R7,R9
	MOVZBL	(R9)+,R6
	MOVAL	PROMPT,R10
	MOVC3	R6,(R9),(R10)				;MOVE TO PROMPT FIELD
	ADDL	R6,R10
	MOVB	QUOTE,(R10)
	ADDL	#26,R6
	$RAB_STORE	RAB=OUTRAB,RBF=PRMPTR,RSZ=R6
	$PUT	RAB=OUTRAB
;
;    PROCESS THE SYNTAX
;
DOSYNT:
	PUSHL	#0
	PUSHL	R7
	CALLS	#2,SYNTAX
;
;    PROCESS VALUE CHARACTERISTICS
;
DOVALUE:
	CLRL	R10
	JSB	VALUE
;
; MOVE TO NEXT PARAMETER 
;
	MOVZBL	ENT_B_NEXT(R7),R9
	BEQL	PRMRET				;NO MORE PARAMETERS
	ADDL	R9,R7
	BRW	PLOOP
PRMRET:	RET
;
; DOQUALS - ROUTINE TO PROCESS A QUALIFIER LIST
;
	.ENTRY	DOQUALS,^M<R6,R7,R8,R9,R10,R11>
	MOVL	4(AP),R7
;
;  QUALIFIER LOOP, EXECUTED ONCE PER QUALIFIER
;
QLOOP:
	MOVZWL	ENT_W_NAME(R7),R9
	CVTWL	R9,R9
	ADDL	R7,R9
	MOVZBL	(R9)+,R6
	MOVC3	R6,(R9),QUALNAM
	MOVC3	R6,(R9),NAME
	MOVL	R6,NAMLEN
	ADDL	#17,R6
	$RAB_STORE	RAB=OUTRAB,RBF=QUAREC,RSZ=R6
	$PUT	RAB=OUTRAB				;QUALIFIER STATEMENT
;
;    PROCESS LABEL
;
	MOVZWL	ENT_W_LABEL(R7),R9
	CVTWL	R9,R9
	BEQL	DEFTR
	ADDL	R7,R9
	MOVZBL	(R9)+,R6
	MOVC3	R6,(R9),LABEL
	ADDL	#23,R6
	$RAB_STORE	RAB=OUTRAB,RBF=LABREC,RSZ=R6
	$PUT	RAB=OUTRAB
;
;    PROCESS DEFAULT, BATCH, NEGATABLE AND PLACEMENT STATEMENTS
;
DEFTR:	BITL	#ENT_M_DEFTRUE,ENT_L_FLAGS(R7)
	BEQL	BATCH
	$RAB_STORE	RAB=OUTRAB,RBF=DEFREC,RSZ=#24
	$PUT	RAB=OUTRAB
BATCH:	BITL	#ENT_M_BATDEF,ENT_L_FLAGS(R7)
	BEQL	NEGAT
	$RAB_STORE	RAB=OUTRAB,RBF=BATREC,RSZ=#22
	$PUT	RAB=OUTRAB
NEGAT:	BITL	#ENT_M_NEG,ENT_L_FLAGS(R7)
	BNEQ	OPTD
	$RAB_STORE	RAB=OUTRAB,RBF=NEGREC,RSZ=#29.
	$PUT	RAB=OUTRAB
OPTD:	TSTL	CLIFLG			;MCROPTDLM NOT ALLOWED
	BEQL	MCRIG				;FOR DCL 
	BITL	#ENT_M_MCROPTDLM,ENT_L_FLAGS(R7)
	BEQL	MCRIG
	$RAB_STORE	RAB=OUTRAB,RBF=OPTREC,RSZ=#26.
	$PUT	RAB=OUTRAB
MCRIG:	BITL	#ENT_M_MCRIGNORE,ENT_L_FLAGS(R7)
	BEQL	PLACE
	$RAB_STORE	RAB=OUTRAB,RBF=IGNREC,RSZ=#26.
	$PUT	RAB=OUTRAB
PLACE:	BITL	#ENT_M_PARM,ENT_L_FLAGS(R7)
	BEQL	DOSYN
	BITL	#ENT_M_VERB,ENT_L_FLAGS(R7)
	BNEQ	10$
	$RAB_STORE	RAB=OUTRAB,RBF=LOCREC,RSZ=#32
	BRB	20$
10$:	$RAB_STORE	RAB=OUTRAB,RBF=POSREC,RSZ=#37
20$:	$PUT	RAB=OUTRAB
;
;    PROCESS SYNTAX
;
DOSYN:	
	PUSHL	#0
	PUSHL	R7
	CALLS	#2,SYNTAX
;
;    PROCESS VALUE CHARACTERISTICS
;
DOVAL:
	CLRL	R10
	JSB	VALUE
;
; MOVE TO NEXT QUALIFIER
;
	MOVZBL	ENT_B_NEXT(R7),R9
	BEQL	QUARET
	ADDL	R9,R7
	BRW	QLOOP
QUARET:	RET
;
;
;
; INPUT TABLES CONTROL BLOCKS AND QUALIFIER PROCESSING INFO
;
	.ALIGN	LONG
FAB:	$FAB	FAC=<GET,BRO>,SHR=GET,FNM=<SYS$LIBRARY:DCLTABLES.EXE>
	.ALIGN	LONG
RAB:	$RAB	FAB=FAB,UBF=BUFFER,USZ=512.
;
MCRTAB:	.ASCII	/SYS$LIBRARY:MCRTABLES.EXE/
;
TABLAB:	.ASCID	/TABLES/
TABFIL:	.WORD	0
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_D
	.LONG	0
;
; OUTPUT FILE RMS CONTROL BLOCKS AND QUALIFIER PROCESSING INFO
;
	.ALIGN	LONG
OUTFAB:	$FAB	FAC=<PUT>,MRS=80.,ORG=SEQ,RAT=CR,RFM=VAR
	.ALIGN	LONG
OUTRAB::	$RAB	FAB=OUTFAB,RAC=SEQ,RSZ=80.
;
OUTLAB:	.ASCID	/OUTPUT/
OUTFILE:	.WORD	0
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_D
	.LONG	0
;
; STUFF FOR PROCESSING OTHER QUALIFIERS
;
ALLAB:	.ASCID	/ALL/
;
IVERB:	.WORD	9,0
	.LONG	VERB
VLAB:	.ASCID	/VERB/
;
CLIVAL:	.WORD	3,0
	.LONG	CLI
CLILAB:	.ASCID	/CLI/
CLI:	.ASCII	/   /
;
;
; MISCELLANEOUS JUMBLE OF LOCAL/GLOBAL DATA
;
CLIFLG::	.LONG	0
DCL:	.ASCII	/DC/
MSG:	.WORD	2,15
MSGNUM:	.LONG	0,0
ALL:	.LONG	0
FLAG:	.LONG	0
NAMLEN::	.LONG	0
NAME::	.BLKB	32.
P:	.ASCII	/P/
;
; OUTPUT RECORD DATA
;
VERBREC:	.ASCII	/define verb /
VERB::	.ASCII	/         /
VERBLEN::	.LONG	0
IMGREC:	.ASCII	/       image /
IMAGE:	.BLKB	80.
PRMREC:	.ASCII	/       parameter P/
PNUM:	.ASCII	/1/
QUAREC:	.ASCII	/       qualifier /
QUALNAM:	.BLKB	31.
OUTREC:	.ASCII	/       outputs (/
	.BLKB	80.
LABREC:	.ASCII	/                 label=/
LABEL:	.BLKB	31.
PRMPTR:	.ASCII	/                 prompt="/
PROMPT:	.BLKB	80.
QUOTE:	.ASCII	/"/
COMMA:	.ASCII	/,/
PAREN:	.ASCII	/)/
DEFREC::	.ASCII	/                 default/
BATREC:	.ASCII	/                 batch/
OPTREC:	.ASCII	/                 mcroptdlm/
IGNREC:	.ASCII	/                 mcrignore/
NEGREC:	.ASCII	/                 nonnegatable/
LOCREC:	.ASCII	/                 placement=local/
POSREC:	.ASCII	/                 placement=positional/
SEP:	.ASCII	/!***************************************/
	.ASCII	/****************************************/
WARREC:	.ASCII	/!!!! WARNING !!!! DO NOT USE THIS COMMAN/
	.ASCII	/D AS COMMAND LANGUAGE EDITOR INPUT      /
;
; DCL TABLES STORAGE AND TABLE POINTERS
;
PTRTAB:	.LONG	0
VERBTAB:	.LONG	0
VERBNUM:	.LONG	0
HEADER:	.LONG	0
MAXREAD:	.LONG	64*512
BUFFER:	.BLKB	512.
SIZE:	.LONG	0
TABLES:	.LONG	0
;
	.END	CLEXTRACT