	PROGRAM CVTMSG
C
C Version:	'V04-000'
C
C****************************************************************************
C*									    *
C*  COPYRIGHT (c) 1978, 1980, 1982, 1984 BY				    *
C*  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS.		    *
C*  ALL RIGHTS RESERVED.						    *
C* 									    *
C*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED   *
C*  ONLY IN  ACCORDANCE WITH  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE   *
C*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR  ANY  OTHER   *
C*  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY   *
C*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE IS  HEREBY   *
C*  TRANSFERRED.							    *
C* 									    *
C*  THE INFORMATION IN THIS SOFTWARE IS  SUBJECT TO CHANGE WITHOUT NOTICE   *
C*  AND  SHOULD  NOT  BE  CONSTRUED AS  A COMMITMENT BY DIGITAL EQUIPMENT   *
C*  CORPORATION.							    *
C* 									    *
C*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY OF ITS   *
C*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
C* 									    *
C*									    *
C****************************************************************************

C---
C
C Abstract:
C
C The following is a mutation of SYSMSG.FOR for the purpose of translating
C MDL message file data into syntax appropriate for the Message File Compiler
C
C Author: Tim Halvorsen, Dec 1980
C
C Modified by:
C
C	V004	TMH0004		Tim Halvorsen	20-Jan-1981
C		Output /MACRO whenever the macro suffix is non-null
C		as well as when the macro name is different.
C		Use macro name prefix on single C constructs with $C_
C		infix rather than no prefix at all, which is incorrect.
C
C	V003	TMH0003		Tim Halvorsen	19-Jan-1981
C		Accept macro name suffixes and output them correctly
C		when generating a /MACRO=macnam construct.
C
C	V002	TMH0002		Tim Halvorsen	22-Oct-1980
C		Fix OPEN_OUTPUT to extract file name portion of output
C		filespec correctly when no directory portion is present.
C
C	001	TMH0001		Tim Halvorsen	10-Mar-1980
C		Generate .LITERAL statement for MDL C constructs
C---

C
C BASIC VARIABLES USED:
C
C	FACILITIES = ARRAY OF FACILITY NAME STRINGS (INDEXED BY FACNUM)
C	MACRO_NAME = MACRO NAME STRING
C	MACRO_SUFFIX = MACRO SUFFIX STRING
C	PREFIX = SYMBOL PREFIX STRING
C	NAME = NAME RETURNED BY GETIDENT (CURRENT TOKEN)
C	COL = CURRENT COLUMN NUMBER
C	LINE = CURRENT LINE
C	SYMBOL_NAME = MESSAGE GLOBAL SYMBOL NAME
C	NUM = VALUE RETURNED BY GETNUM
C	OUTLINE = OUTPUT LINE (NEW FORMAT)
C	OUTCOL = OUTPUT COLUMN
C
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETNUM,GETIDENT,GENCMP,UNBLNK,GETLIN,NEXTFILE
C
C	READ THE FACILITY NAME TABLE (SUBSYSIDS.DAT)
C
	CALL MAKSUBS
C
C	OPEN THE LIST OF FILE SPECIFICATIONS AND OUTPUT FILE
C
	CALL SETUPFILE
	ERRCNT=0
C
C	OPEN THE NEXT MDL FILE TO PROCESS
C
60	IF (NEXTFILE().EQ..FALSE.) GOTO 2000
	CALL OPEN_OUTPUT
70	MACRO_NAME(1)=0
	LASTPREFIX(1)=0
	LASTFACNUM=-1
C
C	EXAMINE THE NEXT LINE IN THE MDL FILE
C
100	IF (GETLIN().EQ..FALSE.) GOTO 60
	IF (UNBLNK().EQ.';') GOTO 100
	IF (UNBLNK().EQ.0) GOTO 100
	IF (GETIDENT().EQ..FALSE.) GOTO 90
	IF (GENCMP(%REF('$STRUCT'),NAME)) GOTO 200
	IF (GENCMP(%REF('C'),NAME)) GOTO 300
	IF (GENCMP(%REF('K'),NAME)) GOTO 300
	IF (GENCMP(%REF('V'),NAME)) GOTO 400
	IF (GENCMP(%REF('F'),NAME)) GOTO 100
	IF (GENCMP(%REF('S'),NAME)) GOTO 100
	IF (GENCMP(%REF('L'),NAME)) GOTO 100
	IF (GENCMP(%REF('M'),NAME)) GOTO 100
	IF (GENCMP(%REF('P'),NAME)) GOTO 100
90	CALL ERROR(1,SYNTAX)
	GOTO 100

200	CALL STRUCT
	GOTO 70

300	CALL EVALC
	GOTO 100

400	CALL SKIPV
	GOTO 100

2000	CLOSE (UNIT=3)
	IF (ERRCNT.NE.0) THEN
		TYPE 2299,ERRCNT
	END IF
	CALL EXIT

2299	FORMAT(' Errors detected:',I5)
	END

C
C	CONSTRUCT THE FACILITIES ARRAY BY READING THE
C	FILE 'SUBSYSIDS'
C
	SUBROUTINE MAKSUBS
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 FACNAM(MAXSYMSIZ)

	DO 10 I=1,MAXFAC+1
10	FACILITIES(1,I)=0

	OPEN (UNIT=1,NAME='SUBSYSIDS',TYPE='OLD',READONLY,ERR=900)

100	READ(1,99,END=400) FACNUM,FACLEN,(FACNAM(I),I=1,FACLEN)
99	FORMAT(I5,Q,120A1)
	IF(FACLEN.GT.MAXSYMSIZ-1) THEN
		FACNAM(MAXSYMSIZ)=0
		CALL ERROR(14,SUBNAMLONG)
	END IF
	FACNAM(FACLEN+1)=0
	CALL MOVNAM(FACNAM,FACILITIES(1,FACNUM+1))
	GOTO 100

400	CLOSE(UNIT=1)
	RETURN

900	CALL ERROR(15,FILNOTFND)
	RETURN
	END

C
C	OPEN THE FILE CONTAINING THE LIST OF FILES
C
	SUBROUTINE SETUPFILE
	INCLUDE 'SRC$:CVTMSGCOM'
	OPEN (UNIT=3,NAME='FILES',TYPE='OLD',READONLY,ERR=100)
	RETURN
100	CALL ERROR(9,FILNOTFND)
	RETURN
	END

C
C	OPEN THE NEXT FILE IN THE LIST OF FILES TO PROCESS
C
	LOGICAL FUNCTION NEXTFILE*1
	INCLUDE 'SRC$:CVTMSGCOM'
50	CLOSE (UNIT=1)
	NEXTFILE=.FALSE.
	READ(3,99,END=300) I,FSPEC
99	FORMAT(Q,80A1)
	FSPEC(I+1)=0
	OPEN (UNIT=1,NAME=FSPEC,TYPE='OLD',READONLY,ERR=100)
	NEXTFILE=.TRUE.
300	RETURN
100	CALL ERROR(10,FILNOTFND)
	GOTO 50
	END

C
C	PROCESS MESSAGE DEFINITION LINE
C
	SUBROUTINE GETMSG
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 TEXT(128)
	LOGICAL*1 GETNUM,GETIDENT,GENCMP,UNBLNK,IDENT
	LOGICAL*1 IDSTR(20)
	LOGICAL*1 VECT(7)
	LOGICAL*1 NEED_BLANK
	LOGICAL*1 FACNAM(MAXSYMSIZ)
	LOGICAL*1 LITERAL_NAME(MAXSYMSIZ)
C
C	OUTPUT .LITERAL IF ";MSG" NOT FOUND TO SIGNIFY MESSAGE DEFINITION
C
	CALL CONCAT(PREFIX,SYMBOL_NAME,LITERAL_NAME)
	COL=COL+1
	IF (.NOT.GETIDENT().OR..NOT.GENCMP(NAME,%REF('MSG'))) THEN
		CALL CONCAT(PREFIX,%REF('FACILITY'),NAME)
		IF(IDENT(NAME,LITERAL_NAME)) RETURN
		CALL BUFFER(%REF('	.LITERAL	'))
		CALL BUFFER(LITERAL_NAME)
		CALL BUFFER(%REF('='))
		CALL BUFNUM(CODE)
		CALL OUTPUT_LINE
		RETURN
	END IF
C
C	IF THE FACILITY LINE HAS NOT YET BEEN OUTPUT, THEN
C	OUTPUT IT NOW.
C
	NEED_BLANK=.FALSE.
	FACNUM=(CODE.AND.'0FFF0000'X)/2**16
	CALL MOVNAM(FACILITIES(1,FACNUM+1),FACNAM)
	IF(FACNUM.EQ.LASTFACNUM.AND.IDENT(PREFIX,LASTPREFIX)) GOTO 20
	IF(IDENT(MACRO_NAME,%REF('SHR'))) CALL MOVNAM(MACRO_NAME,FACNAM)
	CALL BUFFER(%REF('	.FACILITY	'))
	CALL BUFFER(FACNAM)
	CALL BUFFER(%REF(','))
	CALL BUFNUM(FACNUM)
	IF ((CODE.AND.'8000'X).EQ.0) CALL BUFFER(%REF(' /SHARED'))
	IF (CODE.GE.0) CALL BUFFER(%REF(' /SYSTEM'))
	CALL CONCAT(FACNAM,%REF('$_'),NAME)
	IF (.NOT.IDENT(NAME,PREFIX)) THEN
		CALL BUFFER(%REF(' /PREFIX='))
		CALL BUFFER(PREFIX)
	END IF
	IF (.NOT.IDENT(FACNAM,MACRO_NAME).OR.LENGTH(MACRO_SUFFIX).NE.0) THEN
		CALL BUFFER(%REF(' /MACRO='))
		CALL BUFFER(%REF('$'))
		CALL BUFFER(MACRO_NAME)
		IF (LENGTH(MACRO_SUFFIX).NE.0) THEN
			CALL BUFFER(MACRO_SUFFIX)
		ELSE
			CALL BUFFER(%REF('DEF'))
		END IF
	END IF
	CALL OUTPUT_LINE
	CALL MOVNAM(PREFIX,LASTPREFIX)
	LASTFACNUM=FACNUM
	CURNUM=1
	CURSEV=7
	NEED_BLANK=.TRUE.
20	CONTINUE
C
C	IF THE SEVERITY HAS CHANGED, OUTPUT A SEVERITY STATEMENT
C
	IF ((CODE.AND.7).NE.CURSEV) THEN
		CURSEV=CODE.AND.7
		IF (.NOT.NEED_BLANK) CALL OUTPUT_LINE
		CALL BUFFER(%REF('	.SEVERITY	'))
		IF (CURSEV.EQ.0) CALL BUFFER(%REF('WARNING'))
		IF (CURSEV.EQ.1) CALL BUFFER(%REF('SUCCESS'))
		IF (CURSEV.EQ.2) CALL BUFFER(%REF('ERROR'))
		IF (CURSEV.EQ.3) CALL BUFFER(%REF('INFORMATIONAL'))
		IF (CURSEV.EQ.4) CALL BUFFER(%REF('FATAL'))
		IF (CURSEV.GE.5 .AND. CURSEV.LE.7) CALL BUFFER(%REF('?UNKNOWN?'))
		CALL OUTPUT_LINE
		NEED_BLANK=.TRUE.
	END IF
C
C	IF THE MESSAGE NUMBER IS NOT PREV+1, THEN OUTPUT A .BASE STATEMENT
C
	IF ((CODE.AND.'7FF8'X)/2**3.NE.CURNUM) THEN
		CURNUM = (CODE.AND.'7FF8'X)/2**3
		IF (.NOT.NEED_BLANK) CALL OUTPUT_LINE
		CALL BUFFER(%REF('	.BASE		'))
		CALL BUFNUM(CURNUM)
		CALL OUTPUT_LINE
		NEED_BLANK=.TRUE.
	END IF
	CURNUM = CURNUM + 1

	IF(NEED_BLANK) CALL OUTPUT_LINE

	DO 50 I=1,7
50	VECT(I)=0
	GOTO 200
150	IF (UNBLNK().NE.',') GOTO 1000
	COL=COL+1
200	IF (UNBLNK().EQ.'<') GOTO 800
	IF (GETIDENT()) GOTO 300
250	CALL ERROR(11,BADMSGSYNTAX)
	GOTO 2000
300	IF (GENCMP(NAME,%REF('IDENT'))) GOTO 500
C	IF (GENCMP(NAME,%REF('DETAIL'))) GOTO 550
C	IF (GENCMP(NAME,%REF('USERVAL'))) GOTO 600
	IF (GENCMP(NAME,%REF('FAOCNT'))) GOTO 650
C	IF (GENCMP(NAME,%REF('LANG'))) GOTO 700
	GOTO 250
500	IF (UNBLNK().NE.'=') GOTO 250
	COL=COL+1
	IF (GETIDENT().EQ..FALSE.) GOTO 250
	VECT(7)=LENGTH(NAME)
	CALL MOVNAM(NAME,IDSTR)
	GOTO 150
550	ASSIGN 570 TO RETURN
	GOTO 750
570	VECT(1)=NUM
	GOTO 150
600	ASSIGN 620 TO RETURN
	GOTO 750
620	VECT(3)=NUM
	GOTO 150
650	ASSIGN 670 TO RETURN
	GOTO 750
670	VECT(2)=NUM
	GOTO 150
700	ASSIGN 720 TO RETURN
	GOTO 750
720	VECT(5)=NUM
	GOTO 150

750	IF (UNBLNK().NE.'=') GOTO 250
	COL=COL+1
	IF (GETNUM().EQ..FALSE.) GOTO 250
	GOTO RETURN

800	COL=COL+1
	IF (IDFLAG.EQ..FALSE..OR.VECT(7).NE.0) GOTO 830
	VECT(7)=LENGTH(SYMBOL_NAME)
	DO 820 I=1,MAXSYMSIZ
	IDSTR(I)=SYMBOL_NAME(I)
	IF (IDSTR(I).EQ.0) GOTO 830
820	CONTINUE
	CALL ERROR(12,IDTOOLONG)
830	TMPPTR=1
845	IF (LINE(COL).EQ.'>') GOTO 900
850	TEXT(TMPPTR)=LINE(COL)
	TMPPTR=TMPPTR+1
	COL=COL+1
	IF (COL.LE.120) GOTO 845
	GOTO 250
900	COL=COL+1
	IF (LINE(COL).EQ.'>') GOTO 850
	TEXT(TMPPTR)=0
	GOTO 150

1000	IF (UNBLNK().NE.';'.AND.UNBLNK().NE.0) GOTO 250
	CALL BUFFER(%REF('	'))
	CALL BUFFER(SYMBOL_NAME)
	IF (OUTCOL.LT.9) THEN
		CALL BUFFER(%REF('		'))
	ELSE
		CALL BUFFER(%REF('	'))
	END IF
	DO 1010 I=1,LENGTH(TEXT)
	IF (TEXT(I).EQ.'>'.OR.TEXT(I).EQ.'<') GOTO 1020
1010	CONTINUE
	CALL BUFFER(%REF('<'))
	CALL BUFFER(TEXT)
	CALL BUFFER(%REF('>'))
	GOTO 1030
1020	CALL BUFFER(%REF('"'))
	CALL BUFFER(TEXT)
	CALL BUFFER(%REF('"'))
1030	IF (VECT(2).NE.0) THEN
		CALL BUFFER(%REF(' /FAO='))
		CALL BUFNUM(VECT(2))
	END IF
	IF (VECT(7).NE.0) THEN
		CALL BUFFER(%REF(' /IDENT='))
		CALL BUFFER(IDSTR)
	END IF
	CALL OUTPUT_LINE

2000	RETURN
	END

C
C	PROCESS MDL $STRUCT STATEMENT
C
	SUBROUTINE STRUCT
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETIDENT,UNBLNK,GETNUM,GETLIN
	IF (GETIDENT().EQ..FALSE.) GOTO 100
	CALL MOVNAM(NAME,MACRO_NAME)
	MACRO_SUFFIX(1)=0
100	IF (UNBLNK().EQ.';'.OR.UNBLNK().EQ.0) GOTO 300
	IF (UNBLNK().NE.',') GOTO 200
	COL=COL+1
	IF (GETIDENT().EQ..FALSE.) GOTO 200
	CALL MOVNAM(NAME,MACRO_SUFFIX)
	IF (UNBLNK().EQ.';'.OR.UNBLNK().EQ.0) GOTO 300
200	CALL ERROR(1,SYNTAX)
300	IF (GETLIN().EQ..FALSE.) GOTO 800
	IF (UNBLNK().EQ.';') GOTO 300
	IF (UNBLNK().EQ.0) GOTO 300
	IF (UNBLNK().EQ.'E') GOTO 900
	IF (UNBLNK().EQ.'C') GOTO 500
	IF (UNBLNK().EQ.'K') GOTO 500
	IF (UNBLNK().EQ.'V') GOTO 600
	IF (UNBLNK().EQ.'F') GOTO 300
	IF (UNBLNK().EQ.'S') GOTO 300
	IF (UNBLNK().EQ.'L') GOTO 300
	IF (UNBLNK().EQ.'M') GOTO 300
	IF (UNBLNK().EQ.'P') GOTO 300
	CALL ERROR(7,UNRECOGNIZE)
	GOTO 300

500	COL=COL+1
	CALL EVALC
	GOTO 300

600	CALL SKIPV
	GOTO 300

800	CALL ERROR(8,MISSINGEND)
	RETURN

900	CALL BUFFER(%REF('	.END'))
	CALL OUTPUT_LINE
	RETURN
	END

C
C	EVALUATE MDL C STATEMENT
C
	SUBROUTINE EVALC
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GENCMP,UNBLNK
	IF (UNBLNK().EQ.'<') GOTO 100
	CALL GETCVAL
	RETURN
100	COL=COL+1
	CALL GETCLST
	RETURN
	END

C
C	ROUTINE TO HANDLE MDL C<[NAME][,[CON][,[BASE][,INCR]]] SYNTAX
C
	SUBROUTINE GETCLST
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETIDENT,UNBLNK,GETNUM,GETLIN
	BASE=0
	INCR=1
	CALL MOVNAM(MACRO_NAME,PREFIX)
	IF (GETIDENT().EQ..FALSE.) GOTO 100
	CALL MOVNAM(NAME,PREFIX)
100	IF (UNBLNK().NE.',') GOTO 200
	COL=COL+1
	IF (GETIDENT().EQ..FALSE.) GOTO 200
	IF (LENGTH(PREFIX)+LENGTH(NAME).GE.MAXSYMSIZ) THEN
		CALL ERROR(2,NAMTOOLONG)
		PREFIX(1)=0
	END IF
	CALL CONCAT(PREFIX,NAME,PREFIX)
	GOTO 250
200	CALL CONCAT(PREFIX,%REF('$C_'),PREFIX)
250	IF (UNBLNK().NE.',') GOTO 400
	COL=COL+1
	IF (GETNUM()) BASE=NUM
	IF (UNBLNK().NE.',') GOTO 400
	COL=COL+1
	IF (GETNUM().EQ..FALSE.) GOTO 500
	INCR=NUM
400	IF (UNBLNK().EQ.';'.OR.UNBLNK().EQ.0) GOTO 700
500	CALL ERROR(1,SYNTAX)
700	IF (GETLIN().NE..TRUE.) GOTO 1500
	IF (UNBLNK().EQ.'>') GOTO 1600
C	IF (GETIDENT().NE..TRUE.) GOTO 900
	IF (.NOT.GETIDENT()) GOTO 700
	CALL MOVNAM(NAME,SYMBOL_NAME)
	IF (UNBLNK().EQ.',') GOTO 800
	CODE=BASE
	BASE=BASE+INCR
	GOTO 850
800	IF (BASE.NE.0.OR.INCR.NE.1) CALL ERROR(5,BASE)
	COL=COL+1
	IF (GETNUM()) GOTO 820
	CALL ERROR(3,NONUMBER)
820	CODE=NUM
850	CONTINUE
900	IF (UNBLNK().NE.';'.AND.UNBLNK().NE.0) GOTO 500
	CALL GETMSG
	GOTO 700
1500	CALL ERROR(6,NOCLOSEANGLE)
1600	RETURN
	END

C
C	ROUTINE TO HANDLE MDL "C SYMBOL,VALUE" SYNTAX
C
	SUBROUTINE GETCVAL
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETIDENT,UNBLNK,GETNUM
	CALL CONCAT(MACRO_NAME,%REF('$C_'),PREFIX)
	IF (GETIDENT().EQ..FALSE.) GOTO 100
	CALL MOVNAM(NAME,SYMBOL_NAME)
	IF (UNBLNK().NE.',') GOTO 100
	COL=COL+1
	IF (GETNUM().EQ..FALSE.) GOTO 100
	CODE=NUM
	IF (UNBLNK().NE.';'.AND.UNBLNK().NE.0) GOTO 100
	CALL GETMSG
	RETURN
100	CALL ERROR(1,SYNTAX)
	RETURN
	END

C
C	SKIP ALL LINES WHICH ARE PART OF THE MDL V STATEMENT
C
	SUBROUTINE SKIPV
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETLIN,UNBLNK
100	IF (GETLIN().NE..TRUE.) GOTO 300
	IF (UNBLNK().EQ.'>') RETURN
	GOTO 100
300	CALL ERROR(6,NOCLOSEANGLE)
	RETURN
	END

C
C	OUTPUT AN ERROR MESSAGE
C
	SUBROUTINE ERROR(MSGID)
	INCLUDE 'SRC$:CVTMSGCOM'
C OUTPUT CONTENTS OF 'LINE' VIA PRINT
C AND ERROR MESSAGE
	TYPE 99
99	FORMAT('$%SYSMSG-E-')
	GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15),MSGID
	TYPE 1000
	GOTO 200
1000	FORMAT('+error in error processing')
1	TYPE 101
	GOTO 200
101	FORMAT('+syntax error')
2	TYPE 102
	GOTO 200
102	FORMAT('+symbol or string too long')
3	TYPE 103
	GOTO 200
103	FORMAT('+missing value')
4	TYPE 104
	GOTO 200
104	FORMAT('+line too long')
5	TYPE 105
	GOTO 200
105	FORMAT('+start or increment value error')
6	TYPE 106
	GOTO 200
106	FORMAT('+missing close angle bracket')
7	TYPE 107
	GOTO 200
107	FORMAT('+unrecognizable statement type')
8	TYPE 108
	GOTO 200
108	FORMAT('+missing end statement')
9	TYPE 109
	GOTO 210
109	FORMAT('+can''t open FILES.DAT')
10	TYPE 110,FSPEC
	GOTO 210
110	FORMAT('+can''t open ',80A1)
11	TYPE 111
	GOTO 200
111	FORMAT('+syntax error in message definition')
12	TYPE 112
	GOTO 200
112	FORMAT('+message identifier too long')
13	TYPE 113
	GOTO 200
113	FORMAT('+message identified by value is already in use')
14	TYPE 114
	GOTO 200
114	FORMAT('+facility name too long')
15	TYPE 115
	GOTO 210
115	FORMAT('+can''t open SRCD$:[1,2]SUBSYSIDS.DAT')
200	TYPE 97,FSPEC
97	FORMAT(11X,'in file ',80a1)
	TYPE 98,(LINE(K),K=1,LENGTH(LINE))
98	FORMAT(11X,120A1)
210	ERRCNT=ERRCNT+1
	END

C
C	EVALUATE A CONSTANT EXPRESSION
C
	LOGICAL FUNCTION GETNUM*1
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 GETVAL
	LOGICAL*1 BINOPS(8)
	DATA BINOPS/'+','-','*','/','&','!','\','@'/
	GETNUM=.FALSE.
	NUM=0
	IF (GETVAL().EQ..FALSE.) GOTO 300
	GETNUM=.TRUE.
	NUM=BINVAL
100	DO 200 I=1,8
	IF (LINE(COL).EQ.BINOPS(I)) GOTO 400
200	CONTINUE
300	RETURN
400	COL=COL+1
	IF (GETVAL().EQ..TRUE.) GOTO 500
	CALL ERROR(3,MISSINGVALUE)
	GOTO 300
500	GOTO (610,620,630,640,650,660,670,680),I
610	NUM=NUM+BINVAL
	GOTO 100
620	NUM=NUM-BINVAL
	GOTO 100
630	NUM=NUM*BINVAL
	GOTO 100
640	NUM=NUM/BINVAL
	GOTO 100
650	NUM=NUM.AND.BINVAL
	GOTO 100
660	NUM=NUM.OR.BINVAL
	GOTO 100
670	NUM=NUM.XOR.BINVAL
	GOTO 100
680	NUM=NUM*2**BINVAL
	GOTO 100
	END

C
C	GET A TERM VALUE (USED BY GETNUM)
C
	LOGICAL FUNCTION GETVAL*1
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 UNBLNK,TMP
	SIGN=0
	BINVAL=0
	GETVAL=.FALSE.
	IF (UNBLNK().NE.'-') GOTO 100
	SIGN=1
	COL=COL+1
100	IF (LINE(COL).NE.'^') GOTO 180
	IF (LINE(COL+1).NE.'X') GOTO 180
	DO 150 COL=COL+2,120
	TMP=LINE(COL)
	IF ((TMP.LE.'9').AND.(TMP.GE.'0')) GOTO 130
	IF ((TMP.GT.'F').OR.(TMP.LT.'A')) GOTO 400
	TMP=TMP-'A'+'9'+1
130	GETVAL=.TRUE.
	BINVAL=BINVAL*16+(TMP-'0')
150	CONTINUE
	GOTO 300
180	DO 200 COL=COL,120
	IF (LINE(COL).LT.'0') GOTO 400
	IF (LINE(COL).GT.'9') GOTO 400
	GETVAL=.TRUE.
	BINVAL=BINVAL*10+(LINE(COL)-'0')
200	CONTINUE
300	CALL ERROR(4,TOOLONG)
	GETVAL=.FALSE.
400	IF (SIGN.EQ.1) BINVAL=-BINVAL
	RETURN
	END

C
C	GET THE NEXT STRING TOKEN IN THE LINE, FALSE IF NONE
C
	LOGICAL FUNCTION GETIDENT*1
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 UNBLNK
	I=1
	GETIDENT=.FALSE.
	IF (UNBLNK().EQ.';'.OR.UNBLNK().EQ.0) GOTO 400
	DO 200 COL=COL,120
	IF (LINE(COL).EQ.'$') GOTO 100
	IF (LINE(COL).EQ.'_') GOTO 100
	IF ((LINE(COL).GE.'A').AND.(LINE(COL).LE.'Z')) GOTO 100
	IF (GETIDENT.EQ..FALSE.) GOTO 400
	IF ((LINE(COL).LT.'0').OR.(LINE(COL).GT.'9')) GOTO 400
100	GETIDENT=.TRUE.
C	TRUNCATE ANY TOKENS GREATER THAN MAXTOKSIZ
	IF (I.GE.MAXTOKSIZ) GOTO 200
	NAME(I)=LINE(COL)
	I=I+1
200	CONTINUE
	CALL ERROR(4,TOOLONG)
400	NAME(I)=0
	RETURN
	END

C
C	FUNCTION TO COMPARE 2 STRINGS GENERICALLY
C
	LOGICAL FUNCTION GENCMP*1(STRNG1,STRNG2)
	LOGICAL*1 STRNG1(100),STRNG2(100)
	GENCMP=.FALSE.
	IF (STRNG1(1).EQ.0.OR.STRNG2(1).EQ.0) GOTO 300
	DO 100 I=1,100
	IF (STRNG1(I).EQ.0.OR.STRNG2(I).EQ.0) GOTO 200
	IF (STRNG1(I).NE.STRNG2(I)) GOTO 300
100	CONTINUE
200	GENCMP=.TRUE.
300	RETURN
	END

C
C	FUNCTION TO COMPARE 2 STRINGS EXACTLY
C
	LOGICAL FUNCTION IDENT*1(STRNG1,STRNG2)
	LOGICAL*1 STRNG1(100),STRNG2(100)
	IDENT=.FALSE.
	DO 100 I=1,100
	IF (STRNG1(I).NE.STRNG2(I)) GOTO 300
	IF (STRNG1(I).EQ.0.AND.STRNG2(I).EQ.0) GOTO 200
	IF (STRNG1(I).EQ.0.OR.STRNG2(I).EQ.0) GOTO 300
100	CONTINUE
200	IDENT=.TRUE.
300	RETURN
	END

C
C	CONCATINATE 2 STRINGS TOGETHER, OUTPUT IN THIRD ARGUMENT
C
	SUBROUTINE CONCAT(STRNG1,STRNG2,STRNG3)
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 STRNG1(100),STRNG2(100),STRNG3(100),STRNG4(100)
	DO 100 I=1,99
	STRNG4(I)=STRNG2(I)
	IF (STRNG4(I).EQ.0) GOTO 200
100	CONTINUE
	CALL ERROR(2,TOOLONG)
	GOTO 600
200	DO 300 I=1,99
	STRNG3(I)=STRNG1(I)
	IF (STRNG3(I).EQ.0) GOTO 400
300	CONTINUE
	CALL ERROR(2,TOOLONG)
	GOTO 600
400	DO 500 J=1,99
	STRNG3(I-1+J)=STRNG4(J)
	IF (STRNG3(I-1+J).EQ.0) GOTO 600
500	CONTINUE
	CALL ERROR(2,TOOLONG)
600	RETURN
	END

C
C	RETURN THE LENGTH OF AN ASCIZ STRING
C
	INTEGER FUNCTION LENGTH(STRNG)
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 STRNG(100)
	DO 100 LENGTH=1,100
	IF (STRNG(LENGTH).EQ.0) GOTO 200
100	CONTINUE
	CALL ERROR(2,TOOLONG)
200	LENGTH=LENGTH-1
	RETURN
	END

C
C	MOVE AN ASCIZ STRING TO ANOTHER BUFFER
C
	SUBROUTINE MOVNAM(STRNG1,STRNG2)
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 STRNG1(100),STRNG2(100)
	DO 100 I=1,100
	STRNG2(I)=STRNG1(I)
	IF (STRNG2(I).EQ.0) GOTO 200
100	CONTINUE
	CALL ERROR(2,TOOLONG)
200	RETURN
	END

C
C	SEARCH FOR THE NEXT NONBLANK CHARACTER
C
	LOGICAL FUNCTION UNBLNK*1
	INCLUDE 'SRC$:CVTMSGCOM'
	IF (COL.GT.120) GOTO 150
	DO 100 COL=COL,120
	IF (LINE(COL).GE."11.AND.LINE(COL).LE."14) GOTO 100
	IF (LINE(COL).NE.' ') GOTO 200
100	CONTINUE
150	COL=121
200	UNBLNK=LINE(COL)
	RETURN
	END

C
C	GET THE NEXT LINE FROM THE INPUT FILE
C
	LOGICAL*1 FUNCTION GETLIN
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 UNBLNK
	READ(1,99,END=100) LEN,(LINE(K),K=1,LEN)
99	FORMAT(Q,120A1)
	LINE(LEN+1)=0
	COL=1
	GETLIN=.TRUE.
C
C	OUTPUT THE LINE IF COMMENT OR NULL LINE
C
	IF (UNBLNK().EQ.';'.OR.UNBLNK().EQ.0) THEN
		BIAS=OUTCOL+1-COL
		CALL BUFFER(LINE)
		IF (UNBLNK().EQ.';') OUTLINE(BIAS+COL) = '!'
		CALL OUTPUT_LINE
	END IF
	RETURN

100	GETLIN=.FALSE.
	RETURN
	END

C
C	OUTPUT AN ASCIZ STRING TO THE OUTPUT LINE BUFFER
C
	SUBROUTINE BUFFER(STRING)
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 STRING(128)
	DO 10 I=1,128
	IF (STRING(I).EQ.0) GOTO 100
	IF (OUTCOL.GT.132) GOTO 200
	OUTCOL = OUTCOL+1
	OUTLINE(OUTCOL)=STRING(I)
10	CONTINUE
100	RETURN
200	CALL ERROR(4,LINE_OVERFLOW)
	RETURN
	END

C
C	OUTPUT A DECIMAL NUMBER TO THE OUTPUT LINE BUFFER
C
	SUBROUTINE BUFNUM(NUMBER)
	LOGICAL*1 CHARS(9)
	CHARACTER*8 STRING
	EQUIVALENCE (STRING(1:1),CHARS)
	CALL FOR$CNV_OUT_I(%VAL(NUMBER),STRING)
	CHARS(9)=0
	DO 10 I=1,8
	IF (CHARS(I).NE.' ') GOTO 20
10	CONTINUE
20	CALL BUFFER(%REF(CHARS(I)))
	RETURN
	END

C
C	OUTPUT THE CURRENT OUTPUT LINE BUFFER TO THE OUTPUT FILE
C
	SUBROUTINE OUTPUT_LINE
	INCLUDE 'SRC$:CVTMSGCOM'
	WRITE(2,100)(OUTLINE(K),K=1,OUTCOL)
100	FORMAT(128A1)
	OUTCOL=0
	RETURN
	END

C
C	OPEN THE OUTPUT FILE
C
	SUBROUTINE OPEN_OUTPUT
	INCLUDE 'SRC$:CVTMSGCOM'
	LOGICAL*1 STRING(128)
	CLOSE (UNIT=2)
	CALL MOVNAM(FSPEC,STRING)
	DO 10 POS=LENGTH(STRING),1,-1
	IF (STRING(POS).EQ.'.') GOTO 20
10	CONTINUE
20	IF(STRING(POS).EQ.'.') CALL MOVNAM(%REF('.MSG'),STRING(POS))
	DO 30 POS=POS,1,-1
	IF (STRING(POS).EQ.']'.OR.STRING(POS).EQ.'>'
	1	.OR.STRING(POS).EQ.':') GOTO 40
30	CONTINUE
40	POS=POS+1
C	THE OUTPUT FILE WILL BE PUT IN THE DEFAULT DIRECTORY, SAME NAME, .MSG
	OPEN(UNIT=2,NAME=STRING(POS),TYPE='NEW',CARRIAGECONTROL='LIST',ERR=100)
	OUTCOL=0
	RETURN
100	CALL ERROR(9,FILNOTFND)
	RETURN
	END
