$	SAVE_IMAGE_VERIFY = F$ENVIRONMENT("VERIFY_IMAGE")
$	SAVE_PROC_VERIFY = F$VERIFY(0,0)
$!	SET VERIFY
$!
$! Create C header (.H) files for $*DEF modules in .MLB files.
$! Assumes that the macro contains lines in the form:
$!
$!	$DEF FAC$xxxx value
$! OR	FAC$xxxx'..equ'value
$!
$! but NOT a mixture of the two.
$!
$! value forms <^Xvalue>, <^Dvalue> etc. should be handled properly, as should
$! comments. But other strange formats may produce unusable results. Please
$! report any that do.
$!
$! NOTE that the final output file is given READ access to WORLD. This is
$! normally what is wanted, since the main use is to put things in SYS$LIBRARY.
$! See label OK if you want to remove this.
$!
$! Author: Chris Doran, Sira Ltd., South Hill, Chislehurst, Kent, England, BR7 5EH
$!	   Tel: +44 1 467 2636,  Telex: 896649,  Fax: +44 1 467 6515
$!
$	SET NOON
$	MSGMASK=F$GETJPI("","MSGMASK")
$	RESETMSG = ""
$	IF MSGMASK THEN RESETMSG=RESETMSG+"/TEXT"
$	IF MSGMASK/2 THEN RESETMSG=RESETMSG+"/ID"
$	IF MSGMASK/4 THEN RESETMSG=RESETMSG+"/SEVERITY"
$	IF MSGMASK/8 THEN RESETMSG=RESETMSG+"/FACILITY"
$	IF P1.EQS."" THEN INQUIRE/NOPUNCT P1 "Library, [CR = SYS$LIBRARY:STARLET.MLB]: "
$	IF P1.EQS."" THEN P1:=SYS$LIBRARY:STARLET.MLB
$	P1=F$PARSE(P1,".MLB",,,"SYNTAX_ONLY")-";"
$	IF P2.EQS."" THEN INQUIRE/NOPUNCT P2 -
		"Module, [* = ALL $*DEF's, ^ = update existing files only]: "
$	IF P2.EQS."" THEN GOTO DONE
$	UPDATE=P2.EQS."^"
$	IF UPDATE THEN GOTO Update_all
$	IF P2.EQS."*" THEN GOTO Do_all
$	FILE=P2-"$"-"$"
$	IF P3.EQS."" THEN INQUIRE/NOPUNCT P3 "File, [CR = ''FILE'.H]: "
$	IF P3.EQS."" THEN P3=FILE
$	FILE=F$PARSE(P3,".H",,,"SYNTAX_ONLY")-";"
$	CALL EXTRACT 'P1' 'P2' 'FILE' 'RESETMSG'
$DONE:	SAVE_PROC_VERIFY = F$VERIFY(SAVE_PROC_VERIFY,SAVE_IMAGE_VERIFY)
$	EXIT
$!
$Do_all:
$	WRITE SYS$OUTPUT "*** This takes a LONG time ***"
$Update_all:
$	LIBRARY/LIST=SYS$SCRATCH:TOH.TMP/ONLY=$*DEF 'P1'
$	OPEN/READ NAMES SYS$SCRATCH:TOH.TMP
$SKIP:	READ/END=DONE NAMES NAME
$	IF F$EXTRACT(0,1,NAME).NES."$" THEN GOTO SKIP	! Skip header lines
$AGAIN:	FILE=NAME-"$"-"$"+".H"
$	IF UPDATE .AND. F$SEARCH(FILE).EQS."" THEN GOTO NEXT
$	WRITE SYS$OUTPUT "%TOH-I-MODULE, Processing module ",NAME," to file ",FILE
$	CALL EXTRACT 'P1' 'NAME' 'FILE' 'RESETMSG'
$	IF .NOT.UPDATE THEN GOTO NEXT
$	MSG = "CHANGED, Module ''NAME' has changed. Review differences"
$	DIFF/IGNORE=(SPACING,TRAILING,BLANK)/OUT=NL: 'FILE';0 ;-1
$	IF $SEVERITY.NE.1 THEN GOTO REPORT
$	DELETE 'FILE';-1
$	MSG = "NOCHANGE, Module ''NAME' is unchanged"
$REPORT: WRITE SYS$OUTPUT "%TOH-I-",MSG
$NEXT:	READ/END=DONE NAMES NAME
$	GOTO AGAIN
$DONE:	CLOSE NAMES
$	DEL SYS$SCRATCH:TOH.TMP;0
$	SAVE_PROC_VERIFY = F$VERIFY(SAVE_PROC_VERIFY,SAVE_IMAGE_VERIFY)
$	EXIT
$!
$EXTRACT: SUBROUTINE
$	NAME=F$PARSE(P3,,,"NAME","SYNTAX_ONLY")
$	LIBRARY/EXTRACT='P2'/OUT=SYS$SCRATCH:'NAME'.TMP 'P1'
$	IF .NOT.$STATUS THEN EXIT
$	SET MESSAGE/NOFAC/NOID/NOSEV/NOTEXT
$	SEARCH/OUT=SYS$SCRATCH:'NAME'.TMP SYS$SCRATCH:'NAME'.TMP;-1 "$EQU"
$	IF $SEVERITY.NE.1 THEN GOTO NO$EQU
$	XSE -O'P3' -FSYS$INPUT: SYS$SCRATCH:'NAME'.TMP
s/^*$EQU\t/#define /+
s@;\(*\)$@/* \(1 */@+
s/<\^X0^/0x/+
s/<\^D0^//+
s/<\^O0^/0/+
s/>//
$	GOTO OK
$NO$EQU:
$	DELETE SYS$SCRATCH:'NAME'.TMP;0
$	SEARCH/OUT=SYS$SCRATCH:'NAME'.TMP SYS$SCRATCH:'NAME'.TMP;-1 "'..equ'"
$	IF $SEVERITY.NE.1 THEN GOTO NO__EQU
$	XSE -O'P3' -FSYS$INPUT: SYS$SCRATCH:'NAME'.TMP
s/^/#define /+
s/'..equ'/	/+
s@;\(*\)$@/* \(1 */@+
s/<\^X0^/0x/+
s/<\^D0^//+
s/<\^O0^/0/+
s/>//
$OK:	SET FILE/PROT=W:R 'P3'
$	GOTO DONE
$NO__EQU:
$	WRITE SYS$OUTPUT "%TOH-F-NODEF, No definitions in module, no file produced"
$DONE:	SET MESSAGE'P4'				! Reset error message format
$	DELETE SYS$SCRATCH:'NAME'.TMP;0,;0
$	EXIT
$ ENDSUBROUTINE