Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE DMLERR

;     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, 1981 BY DIGITAL EQUIPMENT COPRORATION, MAYNARD, MASS.


	SEARCH GENDCL,DMLSYM,STRING
	SEGMEN

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;SSC	MAR-5-75	PLACED 6A EDIT %316 DIRECTLY IN V10
;			NOTE THIS IS A NEW MODULE FOR COBOL
;********************


	ENTRY TYPOUT

	IFNDEF $COB,<$COB==0>		;FORDML/COBOL?

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


	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,.>)	;[6%222]
	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
	OUTSTR	0(R2)				;GT 0 IMPLIES PTS AT ASCIZ STRING
	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:
	OUTSTR	ERRAREA
	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:
	OUTSTR	CRLF
	RETURN

	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

;$UTIL	APPSIX,<SOURCE,LENMAX>
;
;	MOVEI	R0,@SOURCE(AP)
;	HRLI	R0,440600
;APP.LP:
;	ILDB	C1,R0
;	RETURN	E,C1
;	ADDI	C1,40
;	IDPB	C1,TEMPBP
;	CAMGE	CURLEN,@LENMAX(AP)
;	AOJA	CURLEN,APP.LP
;	RETURN

	>

	END