TITLE DMLERR

	SEARCH COPYRT
	SALL

;     This software is furnished under a license and may only be used
;       or copied in accordance with the terms of such license.

COPYRIGHT (C) 1974, 1984 BY DIGITAL EQUIPMENT COPRORATION


; *******************************************************************
; NOTE!!! This module is shared by the COBOL and DBMS products. Any
; modification by either group should be immediately reflected in the
; copy of the other group.
; *******************************************************************

; ****
;Append TOPS20==0 to beginning of module for COBOL68/74-12B
; ****

	SEARCH GENDCL,DMLSYM,STRING
	SEGMEN

	IFNDEF $COB,<$COB==0>

	IFE $COB,<PRINTX <ASSEMBLING FOR FORTRAN>>
	IFN $COB,<PRINTX <ASSEMBLING FOR COBOL>>

	IFN $COB,<SEARCH P>		;GET TOPS-10/20 DEFINITION

	IFNDEF TOPS20,<TOPS20==0>

	IFN TOPS20,<SEARCH MONSYM,MACSYM>

	.COPYRIGHT		;Put standard copyright statement in REL file


	ENTRY TYPOUT


	IFN $COB,<
	DEFINE DATA(NAM,SIZ)<
	EXTERN NAM
	>
	>

	REG(CAP,3)
	REG(ELEMPT,4)

	DATA(ERRAREA,16)
	DATA(ARG.T1)			;COBOL USED ROUTINES MAY NOT HAVE
					; WRITABLE ARGLISTS

	IFE $COB,<
ERRPTR:	POINT	7,ERRAREA
	XWD	16*5,0

	DATA(TEMPBP,2)
	DATA(ARG.T2)			;EVEN THO TURNED OFF FOR COBOL, WILL
					; ENFORCE NON-WRITABLE ARGLSTS
	DATA(TEMPNO)
	DATA(NUMAREA)
	EXP 0				;MAKE INHERENTLY ASCIZ
NUMTXT:	POINT	7,NUMAREA
	XWD	5,5			;THE WIDTH OF A LINE NUMBER

	>			;IFE $COB

	SUBTTL MISC CONSTANTS

$FUNCT	(DMLERR)			;FORCE HISEG

CRLF:	ASCIZ/
/

ANULL:	POINT	7,ZERO
	XWD	1,1

BLANK:	STRIPT	< >
	SUBTTL MESSAGE TEXTS

	MSG..=0				;USED IN MESSAG MACRO
MSGLIST:
	IFE $COB,<

	MESSAG(DMLXIS,<-8,%DMLXIS. EXTRA INPUT SPECS ARE IGNORED.>)
	MESSAG(DMLXOS,<-8,%DMLXOS. EXTRA OUTPUT SPECS ARE IGNORED.>)
	MESSAG(DMLFSU,<-1,-7,?DMLFSU. SYMBOL AFTER "FIND" IS UNRECOGNIZABLE.>)
	MESSAG(DMLELW,<-1,-7,?DMLELW. ENCOUNTERED [,-4,] WHILE ,-2,-2>)
	MESSAG(DMLASI,<-8,%DMLASI. ALL MEANINGLESS SWITCHES ARE IGNORED.>)
	MESSAG(DMLWCD,<-7,?DMLWCD. WILD CARDING IN OUTPUT DIRECTORY.>)
	MESSAG(DMLPAU,<-1,-7,?DMLPAU. PHRASE AFTER "FIND IDENTIFIER" UNRECOGNIZABLE.>)
	MESSAG(DMLSUM,<[DMLSUM. ,-6,	,-3, ERRORS AND ,-3, WARNINGS.]>)
	MESSAG(DMLNAM,<-6>)
	MESSAG(DMLNIS,<-8,%DMLNIS. NO INVOKE SEEN BEFORE FIRST DML STATEMENT.>)
	MESSAG(DMLOIA,<-7,-1,?DMLOIA. ONLY ONE INVOKE ALLOWED PER PROGRAM-UNIT>)
	MESSAG(DMLSTL,<-1,-7,?DMLSTL. STATEMENT TOO LONG OR "." MISSING.>)
	MESSAG(DMLLSN,<-8,%DMLLSN. STATEMENT NUMBER GREATER THAN 99999 -- TRUNCATED.>)
	MESSAG(DMLLTL,<-8,%DMLLTL. LINE,-3, TOO LONG.>)
	MESSAG(DMLLSE,<-8,%DMLLSE. LINE SEQUENCE NUMBER ,-3, NOT FOLLOWED BY "TAB">)
	MESSAG(DMLOPF,<-7,?DMLOPF. OPEN FAILURE FOR ",-5,".>)
	MESSAG(DMLWNI,<-7,?DMLWNI. WILD-SPEC = NON-WILD-SPEC IS UNDEFINED.>)
	MESSAG(DMLCFE,<-8,%DMLCFE. DBMS COMMENT FOLLOWED BY IMMEDIATE EOF.>)
	MESSAG(DMLESP,<-1,-8,%DMLESP. EXTRA SYMBOLS AFTER "* DBMS">)
	MESSAG(DMLICI,<-8,%DMLICI. ILLEGAL CHARACTER IN INPUT ON LINE,-3>)
	MESSAG(DMLSIE,<-7,?DMLSIE. SOURCE FILE INPUT ERROR--TRY AGAIN>)
	>				;END IFE $COB

	MESSAG(DMLANN,<-7,?DMLANN ALIASED NAME NOT IN SUB-SCEHEMA>)
	MESSAG(DMLCOS,<-1,-7,?DMLCOS. CANNOT OPEN SCHEMA OR LOCK FILE ,-6,.>)
	MESSAG(DMLNSB,<-1,-7,?DMLNSB. NO SCHEMA BLOCK IN .SCH FILE--REBUILD IT>)
	MESSAG(DMLNWP,<-8,%DMLNWP DATA-NAMES WITHOUT PSEUDONYMS ENCOUNTERED>)
	MESSAG(DMLSAF,<-7,?DMLSAF SCHEMA ACCESS FAILURE--CHECK SCHEMA FILE BEFORE RETRYING>)
	MESSAG(DMLSSI,<-1,-7,?DMLSSI. SUB-SCHEMA SPECIFIED NOT IN SCHEMA.>)
	MESSAG(DMLBDK,<-1,-7,?DMLBDK. BAD PRIVACY KEY GIVEN.>)
	MESSAG(DMLINP,<-8,%DMLINP. REFERENCED NON-DATA-BASE ITEM ,-6, HAS NO PSEUDONYM>)
	MESSAG(DMLDUP,<-7,?DMLDUP. DATA BASE NAME ,-6, MULTIPLY DEFINED>)
	SUBTTL MESSAGE PROCESSOR

$FUNCT	(TYPOUT,<MIDX>)

	MOVE	CAP,AP
	MOVE	ELEMPT,@MIDX(CAP)
	ADDI	CAP,1			;UPDATE CUR ARG
	MOVE	ELEMPT,MSGLIST(ELEMPT)	;NOW CONTAINS PTR TO 1ST ELEM OF
					; THE MESSAG

MSG.LOOP:
	MOVE	R2,0(ELEMPT)		;GET ELEMENT -- EITHER ADDR OF
					; ASCIZ STRING
					;ACTION INDEX (NEGATIVE)
					;OR ZERO. END OF MESSAGE
	JUMPE	R2,MSGEND		;ZERO IS END COND
	JUMPL	R2,MSGCASES
IFE $COB,<				;FORDML CASE
	OUTSTR	0(R2)			;GT 0 IMPLIES PTS AT ASCIZ STRING
>; END $COB

IFN $COB,<				;COBOL CASE
  IFE TOPS20,<				;12B SAME AS FORDML
	OUTSTR	0(R2)			;GT 0 IMPLIES PTS AT ASCIZ STRING
  >; END TOPS20
  IFN TOPS20,<				;13 IS NATIVE
	PUSH	PP,R1			;Save ac1
	MOVE	R1,R2			;Set up for PSOUT
	PSOUT%				;Print it
	POP	PP,R1			;Restore ac1
  >; END TOPS20
>; END $COB

	AOJA	ELEMPT,MSG.LOOP
MSGCASES:
	MOVNS	R2
	JRST	@CASVEC(R2)
CASVEC:
	[HALT]
	CAS1				;TYPES LINE# AND LINE IN ERROR
	CAS2				;TYPES ASCIZ STRING
	CAS3				;TYPES A NUMBER (BLANK PADDED)
	CAS4				;TYPES TEXT OF TWO TOKENS
	CAS5				;USES SCAN TO TYPE FILE BLK
	CAS6				;TYPES STRING PTED AT BY STRING PTR
	CAS7				;INTERNALLY KEEPS TRACK OF ERRORS
	CAS8				;DITTO FOR WARNINGS

	IFE $COB,<			;MUCH SIMPLER
CAS1:
	DCOPY	TEMPBP,LIN1BP
	COPY	TEMPNO,L1.NUM
	YOYO	LINTXT,<LIN1BP,L1.NUM>
	SKIPE	R1,LN.NUM
	JRST	[COPY	TEMPNO,R1
		 DCOPY	TEMPBP,LINNBP
		 YOYO	LINTXT,<LINNBP,LN.NUM>
		 JRST	.+1]
	AOJA	ELEMPT,MSG.LOOP
CAS2:
	OUTSTR	@0(CAP)
	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP
CAS3:
	COPY	ARG.T1,@0(CAP)
	LINK	CNVSTR,<NUMTXT,ARG.T1,[12],[TOASCI]>
	OUTSTR	NUMAREA
	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP
CAS4:
	MOVE	R1,@0(CAP)
	CAML	R1,TOKCNT		;CAN'T PRINT 2 TOKS IF CUR IS LAST
	JRST	[COPI	TOKVEC(R1),BLANK
		 JRST	.+1]
	HRRZ	R0,TOKORI(R1)
	MOVEM	R0,ARG.T1
	HRRZ	R0,TOKVEC(R1)
	MOVEM	R0,ARG.T2
	LINK	CATSTR,<ERRPTR,FOUR,@ARG.T1,BLANK,@ARG.T2,ANULL>
	JRST	C6END
CAS5:
	SAVE	<R2,CAP,ELEMPT>
	MOVE	R1,@0(CAP)
	MOVE	R2,@1(CAP)
	PUSHJ	P,.TOLEB##		;ENTRY WITHIN SCAN TO TYPE FILE SPEC
	RESTOR	<ELEMPT,CAP,R2>
	ADDI	CAP,2
	AOJA	ELEMPT,MSG.LOOP
	>				;END IFE $COB

CAS6:
	COPI	ARG.T1,@0(CAP)
	LINK	CATSTR,<ERRPTR,TWO,@ARG.T1,ANULL>
C6END:
IFE $COB,<				;FORDML CASE
	OUTSTR	ERRAREA
>; END $COB

IFN $COB,<				;COBOL CASE
  IFE TOPS20,<				;12B SAME AS FORDML
	OUTSTR	ERRAREA
  >; END TOPS20
  IFN TOPS20,<				;13 NATIVE
	PUSH	PP,R1			;
	HRROI	R1,ERRAREA		;
	PSOUT%				;
	POP	PP,R1			;
  >; END TOPS20
>; END $COB

	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP

	IFE $COB,<
CAS7:
	AOS	ERRCNT
	AOJA	ELEMPT,MSG.LOOP
CAS8:
	AOS	WARNCNT
	AOJA	ELEMPT,MSG.LOOP
	>

	IFN $COB,<
	CAS1:
	CAS2:
	CAS3:
	CAS4:
	CAS5:
	CAS7:
	CAS8:
	AOJA	ELEMPT,MSG.LOOP
	>

MSGEND:
IFE $COB,<				;FORDML CASE
	OUTSTR	CRLF
	RETURN
>; END $COB

IFN $COB,<				;COBOL CASE
  IFE TOPS20,<				;12B SAME AS FORDML
	OUTSTR	CRLF
	RETURN
  >; END TOPS20
  IFN TOPS20,<				;13 NATIVE
	PUSH	PP,R1
	HRROI	R1,CRLF
	PSOUT%		
	POP	PP,R1
	HALTF%
	 JRST	RESTRT##
  >; END TOPS20
>; END $COB
	SUBTTL ROUTINES NEEDED BY THE MESSAGE CASES

	IFE $COB,<

$YOYO	LINTXT,<TEMPBP,TEMPNO>

	LINK	CNVSTR,<NUMTXT,TEMPNO,[12],[TOASCI+ZEROPA]>
	OUTSTR	NUMAREA			;PUT OUT LINE NUMBER
	LINK	FNDCHR,<TEMPBP,[BACKWA],LEXTAB,NOTEOL>
	MOVEM	R0,TEMPBP+1		;SET LENGTH BEFORE EOL CHARS
	LINK	CATSTR,<ERRPTR,TWO,TEMPBP,ANULL>
	OUTSTR	[ASCIZ/ /]
	OUTSTR	ERRAREA
	OUTSTR	CRLF
	RETURN

	>

	END