Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/dmlerr.mac
There are 22 other files named dmlerr.mac in the archive. Click here to see a list.
; UPD ID= 1500 on 1/22/84 at 11:46 PM by MAGRATH
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
;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
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
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
;$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