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

; UPD ID= 3261 on 11/26/80 at 4:42 PM by WRIGHT                         
TITLE	PUTERA FOR COBOL V12B
SUBTTL	PUT OUT A DIAGNOSTIC	AL BLACKINGTON/CAM



;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 CORPORATION

	SEARCH	P
	%%P==:%%P
	DEBUG==:DEBUG

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;********************


TWOSEG
RELOC	400000
SALL

ENTRY FATALW	;PUT OUT A FATAL DIAG FOR CURRENT WORD
ENTRY WARNW	;PUT OUT A WARNING DIAG FOR CURRENT WORD
ENTRY FATAL	;PUT OUT A FATAL DIAG (LN & CP HAVE BEEN SET UP)
ENTRY WARN	;PUT OUT A WARNING DIAG (LN & CP HAVE BEEN SET UP)
ENTRY WARNAD	;PUT OUT A WARNING DIAG WITH APPENDED DATA
ENTRY PUTERA	;PUT OUT "DW" AS IS
IFN ANS74,<
INTERN	FLG.ER	;PUT OUT FIPS FLAGGER WARNING
INTERN	FLG.ES	;DITTO (LN & CP HAVE BEEN SET UP)
INTERN	TST.L,TST.LI,TST.HI,TST.H,TST.RP,TST.DB,TST.68,TST.IB,TST.VX,TST.8,TST.NS
>

EXTERNAL DEVDED	;OUTPUT ERROR
EXTERNAL ERALN, ERAPOS, ERAFAZ, PHASEN
EXTERNAL ERABHO, ERADEV
EXTERNAL WORDLN, WORDCP

;ENTER WITH DIAG NUMBER IN "DW"

FATALW:	MOVE	LN,WORDLN	;SET UP LN &
	MOVE	CP,WORDCP	;  CP
	JRST	FATAL

WARNW:	MOVE	LN,WORDLN
	MOVE	CP,WORDCP
	JRST	WARN


;ENTER WITH DIAG NUMBER IN "DW", LINE NUMBER IN "LN", AND
;	CHARACTER POSITION IN "CP".

FATAL:	IORI	DW,DWFATL	;SET "FATAL" FLAG
	SWON	FFATAL		;SET "FATAL" SWITCH
IFE DEBUG,<SETZM BINDEV##>	;OMIT REL FILE IF FATAL ERROR

WARN:	DPB	LN,ERALN	;INSERT LN INTO DW
	DPB	CP,ERAPOS	;INSERT CP INTO DW
	MOVE	TE,PHASEN	;PUT PHASE NUMBER INTO
	DPB	TE,ERAFAZ	;  DW

;ENTER WITH "DW" ALL SET UP

PUTERA:	SOSG	ERABHO+2	;IS BUFFER FULL?
	JRST	RITERA		;YES--GO WRITE IT OUT
PUTER1:	IDPB	DW,ERABHO+1	;PUT "DW" INTO BUFFER
	POPJ	PP,

IFN ANS74,<
;HERE FOR ERRORS FOUND IN THE SYNTAX SCAN (PHASE B, C, & D)

TST.L:	MOVEI	TA,%LV.L	;LOW
	JRST	TST.ER

TST.LI:	MOVEI	TA,%LV.LI	;LOW-INTERMEDIATE
	JRST	TST.ER

TST.HI:	MOVEI	TA,%LV.HI	;HIGH-INTERMEDIATE
	JRST	TST.ER

TST.H:	MOVEI	TA,%LV.H	;HIGH
	JRST	TST.ER

TST.RP:	MOVEI	TA,%LV.RP	;REPORT WRITER
	JRST	TST.ER

TST.DB:	MOVEI	TA,%LV.DB	;DATA BASE 
	JRST	TST.ER

TST.68:	MOVEI	TA,%LV.68	;COBOL-68 LEFTOVER
	JRST	TST.ER

TST.IB:	MOVEI	TA,%LV.IB	;IBM COMPATIBILITY
	JRST	TST.ER

TST.VX:	MOVEI	TA,%LV.VX	;VAX COBOL-74 COMPATIBLE
	JRST	TST.ER

TST.8:	MOVEI	TA,%LV.8	;COBOL-8x EXTENSION
	JRST	TST.ER

TST.NS:	MOVEI	TA,%LV.NS	;NON-STANDARD
TST.ER:	SKIPN	FLGSW##		;DO WE WANT FIPS FLAGGING?
	POPJ	PP,		;NO
;	JRST	FLG.ER		;YES, TEST LEVEL REQUIRED

;ENTER WITH TA CONTAINING THE LEVEL FLAG

FLG.ER:	MOVE	LN,WORDLN	;SET UP LN &
	MOVE	CP,WORDCP	;  CP
FLG.ES:	ANDCM	TA,FLGSW	;CLEAR THE BITS WE ALLOW
	JUMPE	TA,CPOPJ##	;RETURN IF ITS WITHIN LIMITS
	PUSH	PP,TB		;SAVE NEXT ACC
	MOVE	TB,TA
	JFFO	TB,.+1		;GET LEFT MOST 1
	MOVEI	TB,^D36
	SUB	TB,TA		;GET BIT NUMBER
	MOVS	TA,TB		;LEVEL FOUND IN LHS
	POP	PP,TB
	HRRI	TA,E.507	;WARNING NO. WITH EXTRA DATA
;	JRST	WARNAD		; SO WE CAN GIVE EXACT MESSAGE
>

;PUT OUT A WARNING DIAG WITH APPENDED NAME.
;ENTER WITH LH OF "TA" CONTAINING A TABLE-LINK TO NAME TO BE PRINTED,
;	RH OF "TA" CONTAINING DIAGNOSTIC NUMBER.

WARNAD:	HRRZ	DW,TA		;GET DIAG NUMBER
	PUSHJ	PP,WARN		;WRITE OUT FIRST WORD
	HLRZ	DW,TA		;GET TABLE LINK
	JRST	PUTERA		;WRITE IT OUT AND RETURN

;EMPTY THE BUFFER

RITERA:	OUT	ERA,
	  JRST	PUTER1		;NO ERRORS -- RETURN

	MOVEI	CH,ERADEV	;ERROR -- WE LOSE
	JRST	DEVDED		;NEVER RETURN

	END