Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - cobole.mac
There are 14 other files named cobole.mac in the archive. Click here to see a list.
; UPD ID= 1760 on 3/8/79 at 3:47 PM by W:<WRIGHT>
TITLE	COBOLE FOR COBOL V12		
SUBTTL	PHASE E - GENERATOR CONTROL	SERG POLEVITSKY/ALB/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, 1979 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P,COMUNI
	%%P==:%%P
	%%COMU==:%%COMU
	STRING==:STRING
	RPW==:RPW
	SERCH==:SERCH
	DBMS==:DBMS
	MCS==:MCS
	TCS==:TCS

;EDITS
;V12A RELEASED  *****
;NAME	DATE		COMMENTS
;DAW	8-MAR-79	[656] FIX PROBLEMS WITH DBMS USE PROCEDURES
;DAW	6-MAR-79	[650] FOR DBMS PROGRAMS WITH USE PROCEDURES,
;			FIX ILL MEM REF WHEN TABLES EXPAND.
;DAW	23-FEB-79	[637] FIX COMPUTE WITH COMP-1 RESULT
;V12 RELEASED   *****
;V10*****************
;	10-AUG-76	[435] ADD OPERATORS FOR BEGIN AND END DECLARITIVES
;GPS	12/23/74	ADD OPERATORS FOR SIMULTANEOUS UPDATE
;DBT	1/14/75		REFERENCE COMUNI.UNV FOR FIXNUM DEFINITION
;DBT	6/24/75		REMOVE REMNENTS OF UUOS
;********************

;DPL	4/11/75		[332] FIX DBARG2 TO OUTPUT CORRECT ARGS IN DBMS USE STATEMENT
;
TWOSEG
SALL
RELOC	400000




;PREAMBLE	
;
;**************************************
;*          NOTE    WELL              *
;* EOPCOD HOLDS SUBROUTINE ADDRESSES  *
;* EOPTAB HOLDS CURRENT OPERANDS ONLY *
;**************************************
;
;
;THE PHASE E STRATEGY IS AS FOLLOWS:

;READ INPUT FROM THE PREVIOUS PHASES STASHING OPERANDS (DISTINGUISHABLE FROM
;OPERATORS BY A 1 IN BIT 0 OF THEIR 1ST WORD) IN EOPTAB (A DYNAMICALLY ALLOCATED
;PUSH-DOWN LIST, WHOSE PRESENT STARTING ADDRESS CAN BE FOUND IN THE RIGHT HALF OF
;EOPLOC) UNTIL AN OPERATOR (BIT 0 OF WORD 1 =0) IS FOUND.

;UPON "SEEING" AN OPERATOR, THE SCANNER ROUTINE WILL CHECK THE OP CODE IN THE
;2ND WORD OF THE ITEM HELD "IN HAND" [W1 & W2 ACCUMULATORS] AGAINST THE HIGHEST
;LEGAL OP CODE KNOWN (ELAST).  IF THE OP CODE IS > ELAST, IT CAN BE EITHER
;(A) AN ILLEGAL OP CODE OR (B) THE ENDIT OPERATOR, DENOTING
;END OF INPUT FROM THE PREVIOUS PHASES.

;IF THE OP CODE IS = TO ENDIT, WRAPUP THE CURRENT PHASE, HOUSE CLEANING FILES, ETC.
;AND JUMP TO NEXT PHASE. IF THE OP-CODE FAILS TO BE ENDIT
;AND IS GREATER THAN ELAST, IT IS A BOGUS OP CODE AND AN ERROR MESSAGE IS GIVEN.
;NOTE THAT IN ALL PROBABILITY, A BOGUS OP CODE OF THIS TYPE (> ELAST AND NOT = ENDIT)
;PROBABLY MEANS A COMPILER ERROR.


;IF THE OP CODE IS < OR = ELAST, JUMP THROUGH EOPCOD ENTRY AS SPECIFIED BY
;THE OFFSET WHICH IS THE OP CODE ITSELF TO THE APPROPRIATE SUBROUTINE.


;TO EMEND THE CURRENT SCHEME, ADDITIONS TO THE OP CODE REPERTOIRE SHOULD BE IN THE
;FORM:
;	<VECTOR		SUBROUTINE ADDRESS>
	DEFINE VECTOR (PARAM),<
	EXP	PARAM
	EXTERNAL PARAM
	>
		;COMMONLY USED PARAMETERS ARE ALREADY DEFINED
		;IN THE FILE "P.MAC"
		;ALSO SEE MEMO 100-350-007 (CODE GENERATION)
		;AND  MEMO 100-350-010     (FILE DESCRIPTIONS)
		;AS TO BIT ASSIGNMENTS AND FILE ORGANIZATION

	INTERN EOPCOD
	INTERN EBADOP
	INTERN ENTERS			;COME BACK FROM A GENERATOR
					;RESETTING EOPTAB.
	INTERN COMEBK			;COME BACK FROM GENERATOR BUT DO NOT
					;RESET EOPTAB.

	INTERN	READEM			;FETCH ALL OPERANDS UP TO
					;AN OPERATOR.  POPJ	PP, BACK
					;TO CALLING ROUTINE WITH OPERATOR IN W1 & W2.

;****** EXTERNAL ENTRY POINTS ******

	EXTERN XPNEOP		;EXPAND EOPTAB
	EXTERN CMNGEN,XFRGEN,MOVGEN
	EXTERN AS3BUF
	EXTERN LITNXT,LITLOC,EAS1PC,EAS2PC,EAS3PC,EOPLOC,EOPNXT
	EXTERN ETEMPC
	EXTERN EALTPC		;DEFINE SOME PHANTOM PROGRAM COUNTERS
				;FOR RELATIVE LOCATION WITHIN TEMPS,
				;ALTERS > 50, AND ...
	EXTERN PUSH12
	EXTERN PUTASN
	EXTERN SEGCLN
	EXTERN SETGEN
	EXTERN GETGEN
	EXTERN KILL
	EXTERN PUTAS1,PUTAS2,PUTAS3,PUTERA
	EXTERN EINITL,EZEROH
	EXTERN USEBAS
	EXTERN EALTMX	;MAXIMUM SIZE NEEDED FOR ALTERS (SEE TEMPS [ETEMAX]).
	EXTERN TEMBAS
	EXTERN ETEMAX
	EXTERN DATBAS
	EXTERN ALTBAS
	EXTERN RESDNT
	EXTERN IMPPAR
	EXTERN FILTBL
	EXTERN NONRES
	EXTERN A50BAS
	EXTERN HILOC		;SIZE OF LARGEST NON-RESIDENT SEGMENT
	EXTERN SEGFLG		;NON-ZERO IF NON-RESIDENT SEGS IN PROGRAM
	EXTERN CPYBHO		;3-WORD BUFFER INFO FOR OUTPUT CPYFIL

	EXTERN	STASHI,STASHL,AS.LIT,AS.MSC
	;ELAST = SEE LAST ENTRY IN TABLE, EOPCOD.

		;ELAST IS THE LAST VALID OP CODE ENTERED IN
		;THE OP CODE TABLE,EOPCOD,WHICH CONTAINS
		;THE ADDRESSES OF THE SUBROUTINE GENERATOR WITH
		;WHICH THIS OP CODE IS ASSOCIATED.
		;THE OP CODE ITSELF WILL GIVE THE OFFSET IN THE TABLE, EOPCOD,
		;AND THUS POINT TO THE PARTICULAR SUBROUTINE TO
		;BE USED.  THE OP CODE WILL BE PASSED, RIGHT-JUSTIFIED, IN W2.

	ENDIT=377
		;ENDIT IS THE END OF INPUT OPERATOR. UPON SEEING
		;ENDIT, THE CODE GENERATION PHASE WILL CLOSE THE ERROR LISTING
		;FILE AND ALL
		;OPEN AS-TYPE FILES AND JRST TO THE ENTRY POINT OF THE NEXT PHASE
		;
		;
		;
		;
		;PHASE E WILL SCAN INPUT FROM THE PREVIOUS PHASES AND
		;PUSH DOWN OPERANDS FOUND INTO THE LIST, EOPCOD,
		;UNTIL THE OPERATOR ASSOCIATED WITH THESE OPERANDS IS FOUND.
		;"OPERAND" WILL BE UNDERSTOOD TO REFER TO ANY ONE OF THE
		;FOLLOWING THREE ITEMS:
		;A) TW0-WORD OPERANDS
		;B) LITERALS
		;C) FIGURATIVE CONSTANTS
		;ON SEEING AN OPERATOR, JUMP THROUGH THE EOPCOD TABLE
		;TO THE APPROPRIATE SUBROUTINE GENERATOR.
				;EACA WILL HOLD THE PUSH-DOWN XWD FOR THE
				;DYNAMICALLY ALLOCATED PUSH-DOWN LIST, EOPCOD
				;EACB WILL HOLD         W2,(FLOLOC)
				;			^^	    INDEX FIELD
				;			   ^	  ^ ADDRESS FIELD
COBOLE:	JRST	1,.+1		;ENABLE CONCEALED MODE
	SETFAZ	E;		;GENERATE "INTERNAL **COBOLE**"
				;INFORM THE REST OF THE COMPILER THAT
				;PHASE E HAS BEGUN.
	SETOM	@CPYBHO+1	;JAM LAST LINE NUMBER WITH 1'S
	CLOSE	CPY,		;CLOSE OUTPUT CPYFIL
	RELEASE	LIB,		;THROW AWAY ANY LIBRARY FILE

	PUSHJ	PP,SETGEN	;SET UP READS FROM THE FILE, GENFIL,
				;& RETURN IF DEVICE O. K.
				;IF DEVICE BAD, ETC., DON'T RETURN.

	MOVE	TA,AS3BUF	;SET UP AS3 BUFFER
	MOVEM	TA,.JBFF##
	OUTBUF	AS3,2

	SETZM	EINITL		;CLEAR PHANTOM PROGRAM COUNTERS
	MOVE	TE,[XWD	EINITL,EINITL+1]
	BLT	TE,EZEROH
	HRRI	SW,0		;CLEAR RIGHT HALF! OF SWITCH REGISTER.
	SETZM	HILOC		;PRESET SIZE OF NON-RESIDENT
	SETZM	SEGFLG		;CLEAR "THERE ARE NON-RESIDENT SEGMENTS"

	MOVE	TA,LITLOC	;INSURE LITNXT IS RESET
	MOVEM	TA,LITNXT
	MOVEI	TA,2*FIXNUM	;%TEMP GOES ABOVE %FILES, ETC
	MOVEM	TA,TEMBAS
	PUSHJ	PP,POOLINI##	;INITIALIZE LITERAL POOLER
IFN RPW,<
	PUSHJ	PP,SETRPW##
>
IFN ANS74,<
	SKIPN	RELKEY##	;KEY CONVERSION REQUIRED?
	JRST	SELARG		;NO
	AOS	EAS1PC		;RESERVE %PARAM+0
	PUSHJ	PP,PUTOC0##	;PUT 0 IN ASY FILE
>
;PUT SELOTS ARGS IN LITERAL TABLE

SELARG:
REPEAT 0,<
	TSWF	FREENT		;/R ON?
	JRST	CALLS		;YES, FORGET IT
	MOVE	TA,[SIXLIT##,,1]	;ARG 1 IS COMPILER NAME
	PUSHJ	PP,STASHI
IFN ANS68,<
	MOVE	TA,['COBOL ']
>
IFN ANS74,<
	MOVE	TA,['CBL74 ']
>
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVE	TA,[OCTLIT,,1]	;ARG 2 IS COMPILER VERSION NUMBER
	PUSHJ	PP,STASHI
	MOVE	TA,.JBVER##
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVE	TA,[OCTLIT,,1]	;PUT OUT ARG COUNT PRIOR TO LIST
	PUSHJ	PP,STASHI
	MOVSI	TA,-2
	PUSHJ	PP,STASHL

	AOS	TA,ELITPC	;SAVE ADDR OF FIRST WORD OF LIST
	MOVEM	TA,COBVER##

	MOVE	TA,[XWDLIT,,4]	;MAKE ARG LIST ENTRIES
	PUSHJ	PP,STASHI

	MOVEI	TA,0		;ENTRY1=0,,ARG1-PTR
	PUSHJ	PP,STASHL
	MOVE	TA,COBVER
	HRLZI	TA,-3(TA)
	TLO	TA,AS.LIT##
	HRRI	TA,AS.MSC##
	PUSHJ	PP,STASHL
	AOS	ELITPC

	MOVEI	TA,0		;ENTRY2=0,,ARG2-PTR
	PUSHJ	PP,STASHL
	MOVE	TA,COBVER
	HRLZI	TA,-2(TA)
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL
	AOS	ELITPC
>;END REPEAT 0
;PUT IN LITERAL TABLE A LIST OF ALL PROGRAMS CALLED BY "CALL"
;SO LIBOL CAN CHAIN THE FILE TABLES

CALLS:	HRRZ	TA,ELITPC##	;SAVE LITERAL ADDR OF LIST FOR ENTRIES
	MOVEM	TA,SUBLST##

	HRRZI	TA,<CD.EXT>B20+1	;REL ADDR OF 1ST ENTRY IN EXTAB
	HRLZM	TA,CUREXT##
	PUSHJ	PP,LNKSET##	;MAKE ABS PTR
	HRRM	TA,CUREXT

CALLS1:	LDB	TE,EX.CAL##	;THIS ENTRY REFERENCED BY A CALL
	JUMPE	TE,CALLS2	;NO

	LDB	TE,EX.ENT##	;THIS AN ENTRY IN CURRENT PROGRAM?
	JUMPN	TE,CALLS2	;YES, ERROR FLAGGED LATER BY IPCGEN

	MOVE	TA,[XWDLIT##,,2]	;MAKE ENTRY IN LITTAB
	PUSHJ	PP,STASHI
	MOVEI	TA,0		;LEFT HALF = 0
	PUSHJ	PP,STASHL
	HLRZ	TA,CUREXT	;RT HALF = EXT ADDR
	ANDI	TA,77777
	IORI	TA,AS.EXT
	PUSHJ	PP,STASHL
	AOS	ELITPC

CALLS2:	MOVE	TA,CUREXT	;GET BACK EXTAB PTR
	LDB	TA,EX.CNT##	;GET COUNT OF EXTRA WORDS IN ENTRY
	ADDI	TA,2		;BUMP UP TO NEXT ENTRY
	HRLI	TA,(TA)
	ADDB	TA,CUREXT

	HRRZ	TE,EXTNXT##	;END OF EXTAB YET?
	CAILE	TE,(TA)
	JRST	CALLS1		;NO

	MOVE	TA,[OCTLIT##,,1]	;PUT 0 AT END OF LIST
	PUSHJ	PP,STASHI
	MOVEI	TA,0
	PUSHJ	PP,STASHL
	AOS	ELITPC
IFN DBMS,<

;SET UP ARGUMENTS FOR INITDB CALL (GENERATED IN START-UP CODE)

DBARGS:	HRRZ	CH,ELITPC	;SAVE ADDR OF ERROR-STAT PROC TABLE
	MOVEM	CH,DBLITP##	;[656] STORE IN RH (DBLITP)

	HRRZ	TA,USELOC##	;[650] GET START ADDRESS NOW
	HRRZ	TB,USENXT##	;[650] GET END ADDRESS NOW 
	SUBI	TB,1(TA)	;[650] TB = LEN OF USE TABLE - 1
	SETZM	CTR##		;INIT ENTRY COUNTER
	JUMPLE	TB,DBARG6	;[650] IF TABLE IS EMPTY, SKIP THIS
	MOVEI	TA,1		;[650] INITIAL RELATIVE ADDRESS

DBARG1:	CAILE	TA,(TB)		;END OF TABLE?
	JRST	DBARG6		;YES

	PUSH	PP,TB		;[650] SAVE RELATIVE NUMBERS
	PUSH	PP,TA		;[650] CURRENT OFFSET
	HRRZ	TB,USELOC##	;[650] GET CURRENT ABSOLUTE START OF TABLE
	ADD	TA,TB		;[650] CURRENT ABSOLUTE ADDRESS

	LDB	TC,US.TYP##	;ERROR-STATUS ENTRY?
	CAIE	TC,%UT.ES
	JRST	DBARG3		;NO
	LDB	TC,US.XTR##	;EXTRA WORDS ALLOCATED?
	JUMPE	TC,DBARG5	;NO, BAD ENTRY

	LDB	TC,US.CNT##	;GET COUNT OF BYTES IN ENTRY
	MOVE	TD,[POINT 18,1(TA),17]	;SETUP PTR TO CODES
DBARG2:	SOJL	TC,DBARG4	;CK CODE COUNTER
	MOVE	TA,[XWDLIT,,2]	;OUTPUT "XWD ERROR-CODE,%TAG-OF-PROC-PERF"
	PUSHJ	PP,STASHI
	HRRZ	TA,USELOC##	;[650] COMPUTE ABSOLUTE ADDRESS
	ADD	TA,(PP)		;[650]
	ILDB	TA,TD		;GET NEXT ERROR-CODE
	CAIN	TA,-1		;[332] -1 MEANS USE FOR ALL E-S CODES
	MOVEI	TA,0
	AOS	CTR
	HRLZI	TA,(TA)
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL
	HRRZ	TA,USELOC##	;[650] COMPUTE ABSOLUTE ADDRESS
	ADD	TA,(PP)		;[650]
	LDB	TA,US.PRO##	;GET TAG ADDR
	IORI	TA,AS.TAG##
	PUSHJ	PP,STASHL
	AOS	ELITPC		;BUMP PC
	JRST	DBARG2

DBARG3:	LDB	TC,US.XTR	;ANY EXTRA WORDS?
	JUMPE	TC,DBARG5	;NO
DBARG4:	HRRZ	TA,USELOC##	;[650] COMPUTE ABSOLUTE ADDRESS AGAIN
	ADD	TA,(PP)		;[650]
	LDB	TC,US.CNT	;BUMP USETAB PTR OVER EXTRA WORDS
;[656] @ DBARG4 + 3  DELETED 4 INSTRUCTIONS
;[656]	ADDI	TC,5
;[656]	MOVEI	CH,5
;[656]	IDIVM	TC,CH
;[656]	ADDM	CH,(PP)		;[650] BUMP REL ADDRESS
	LSH	TC,-1		;[656] TWO BYTES PER WORD
	ADDI	TC,1		;[656] ACCOUNT FOR HEADER WORD
	ADDM	TC,(PP)		;[656] BUMP REL ADDRESS
DBARG5:	POP	PP,TA		;[650] POP ACS AND LOOP
	POP	PP,TB		;[650]
	AOJA	TA,DBARG1	;[650] GO ON TO NEXT ENTRY
>
IFN DBMS,<

DBARG6:	HRRZ	TC,ELITPC	;SAVE ADDR OF ARRAY PTR
	HRLM	TC,DBLITP	;[656] IN LH (DBLITP)

	MOVE	TA,[XWDLIT,,2]	;PUT OUT HALF-WORD ARRAY DESCRIPTOR
	PUSHJ	PP,STASHI
	HRLZ	TA,CTR		;LEFT HF = # WORDS IN ARRAY
	LSH	TA,1		;WORD COUNT * 2
	HRRI	TA,AS.CNB##
	PUSHJ	PP,STASHL
	HRLZ	TA,DBLITP	;[656] RT HF = ADDR OF ARRAY
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	SKIPN	CTR		;IF CTR = 0, RT HF = 0 ALSO
	MOVEI	TA,AS.CNB
	PUSHJ	PP,STASHL
	AOS	ELITPC		;BUMP PC

	MOVE	TA,[OCTLIT,,1]	;PUT OUT ARG-COUNT FOR ARG-LIST
	PUSHJ	PP,STASHI
	MOVSI	TA,-1
	PUSHJ	PP,STASHL

	AOS	TC,ELITPC	;SAVE ADDR OF ARG LIST
	HRRZM	TC,DBUSES##

	MOVE	TA,[XWDLIT,,2]	;PUT OUT ARG LIST ENTRY
	PUSHJ	PP,STASHI
	HRLZI	TA,(ARGHWA)	;LEFT = ARG TYPE
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL
	HLLZ	TA,DBLITP	;[656] RIGHT = ADDR OF ARRAY DESCRIPTOR
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL
	AOS	ELITPC

	>
IFN MCS!TCS,<

;SET UP CALL TO INITIALIZE "INTITIAL" CD ENTRY--

	SKIPN	FINITL##		;IS THERE ONE?
	JRST	MCSEND			;NO
	MOVE	TA,[OCTLIT,,1]
	PUSHJ	PP,STASHI
	MOVSI	TA,-1
	PUSHJ	PP,STASHL
	AOS	TA,ELITPC			;XWD	-1,0
	HRRZM	TA,M.IARG##		;SAVE ARG PTR

	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHI
	MOVEI	TA,640
	PUSHJ	PP,STASHL
	MOVE	TA,ELITPC
	HRLZI	TA,1(TA)		;GET ADDRESS OF .+1
	TLO	TA,AS.LIT
	HRRI	TA,AS.MSC
	PUSHJ	PP,STASHL
	AOS	ELITPC			;XWD	640,,.+1

	MOVE	TA,[BYTLIT##,,2]
	PUSHJ	PP,STASHI
	HLRZ	TB,FINITL##
	ADD	TB,CDLOC##		;GET ADDRESS OF CD ENTRY
	HLRZ	TA,2(TB)		;GET CD-REC ADDR
	TLO	TA,1B18			;BITS 0-2 = 4
	TRO	TA,1B20			;SET BIT 20
	PUSHJ	PP,STASHL
	MOVSI	TA,440700		;SET BYTE POINTER
	PUSHJ	PP,STASHL
	AOS	ELITPC			;POINT 7,CD-REC

	MOVE	TA,[OCTLIT,,1]
	PUSHJ	PP,STASHI
	MOVEI	TA,^D87			;SIZE OF INPUT RECORD
	PUSHJ	PP,STASHL
	AOS	ELITPC			;XWD	0,,SIZE

MCSEND:
	>
IFN ANS74,<

;SET UP COLLATING SEQUENCE LITERALS FOR ALPHABET-NAMES

	HRRZ	TA,MNELOC##
	ADDI	TA,1		;BYPASS ZERO
CSMNEL:	MOVEM	TA,CURMNE##	;SAVE IT
	MOVE	TB,1(TA)	;GET 2'ND WORD
	TLNE	TB,(1B5)	;RD CODE?
	JRST	CSMNED		;YES
	TLNN	TB,(1B6)	;ALPHABET-NAME?
	JRST	CSMNEE		;NO
	ANDI	TB,777		;YES, BUT IS IT A LITERAL?
	JUMPE	TB,CSMNEE	;NO
	MOVE	TC,[COLTMP##,,COLTMP+1]
	SETOM	COLTMP
	BLT	TC,COLZRL##	;INITIALIZE ALL OF TABLE
	MOVN	TB,TB
	HRL	TA,TB		;SETUP AOBJN POINTER
	SETO	TC,		;STORE POINTER (INCREMENTED BEFORE STORE)
	SETZB	TD,ILCSIX##	;ALSO COUNT AND SIXBIT OFFSET
	SETZM	EXCEBC##	;CLEAR EBCDIC ONLY COUNT
CSMNEN:	MOVE	TB,3(TA)	;GET LITERAL
	TRZE	TB,1B18		;THRU?
	JRST	CSMNET		;YES
	TRZE	TB,1B19		;ALSO?
	JRST	CSMNEA		;YES
	ADDI	TC,1(TD)	;IN CASE ALSO
	SETZ	TD,
	PUSHJ	PP,CSMTST	;STORE IF FIRST TIME
	JRST	CSMNEJ		;GET NEXT

CSMNEA:	PUSHJ	PP,CSMTST	;STORE IF FIRST TIME
	AOJA	TD,CSMNEJ	;GET NEXT

CSMNET:	ADDI	TC,0(TD)	;INCASE ANY ALSO
	MOVE	TD,TB		;SAVE THRU LIT
	MOVE	TB,2(TA)	;GET PREVIOUS LITERAL
	SUBM	TB,TD		;GET -NO. TO DO
	JUMPG	TD,CSMNER	;ORDER IS REVERSED
	ADDI	TB,1		;GET NEXT
	HRL	TB,TD		;AOBJN POINTER
	SETZ	TD,
CSMNEU:	ADDI	TC,1		;POINT TO CURRENT
	PUSHJ	PP,CSMTST	;STORE IF FIRST TIME
	AOBJN	TB,CSMNEU	;LOOP
	JRST	CSMNEJ

CSMNER:	SUBI	TB,(TD)		;GET OTHER END
	MOVN	TD,TD		;GET - LENGTH
	HRL	TB,TD		;AOBJN LOOP PTR
	MOVN	TD,TD		;+ SIZE
	ADDI	TC,1(TD)	;GET LAST FIRST
	SUBI	TD,1		;WHAT TO ADD ON WHEN FINISHED
CSMNEV:	SUBI	TC,1		;POINT TO CURRENT
	PUSHJ	PP,CSMTST	;STORE IF FIRST TIME
	AOBJN	TB,CSMNEV	;LOOP

CSMNEJ:	AOBJN	TA,CSMNEN	;NOT YET

;NOW LOOP THROUGH TABLE FILLING IN MISSING VALUES

	ADDI	TC,1(TD)	;IN CASE ANY ALSO'S LEFT
	MOVSI	TA,-40		;SCAN FIRST PART OF TABLE
	PUSH	PP,TC		;SAVE NUMBER KNOWN
CSMNEH:	SKIPL	COLTMP(TA)
	JRST	CSMNEI
	HRLM	TC,COLTMP(TA)	;STORE ASCII ONLY
	ADDI	TC,1
CSMNEI:	AOBJN	TA,CSMNEH
	ADDM	TA,ILCSIX	;ACCOUNT FOR NO SIXBIT HERE
	HRLI	TA,-100		;SCAN REST OF SIXBIT TABLE
CSMNEF:	SKIPL	COLTMP(TA)	;ALREADY SET
	JRST	CSMNEG		;YES
	HRLM	TC,COLTMP(TA)	;STORE NEW VALUE
	SUB	TC,ILCSIX	;REMOVE EFFECT OF NO SIXBIT
	HRLM	TC,COLTMP+200(TA)
	ADD	TC,ILCSIX
	ADDI	TC,1
CSMNEG:	AOBJN	TA,CSMNEF	;TRY NEXT
	HRLI	TA,-40		;SCAN LAST PART OF TABLE
CSMNEK:	SKIPL	COLTMP(TA)
	JRST	CSMNEM
	HRLM	TC,COLTMP(TA)	;NO SIXBIT
	ADDI	TC,1
CSMNEM:	AOBJN	TA,CSMNEK
	POP	PP,TC		;RESTORE COUNT
	MOVSI	TA,-400		;SCAN EBCDIC TABLE
CSMNEO:	HRRE	TB,COLTMP(TA)	;GET EBCDIC PART
	JUMPGE	TB,CSMNEP	;ALREADY SET UP
	HRRM	TC,COLTMP(TA)
	ADDI	TC,1
CSMNEP:	AOBJN	TA,CSMNEO

;IF THIS IS THE PROGRAM COLLATING SEQUENCE SETUP VARIOUS POINTER

	MOVE	TA,CURMNE
	HLRZ	TB,(TA)		;GET NAMTAB ENTRY
	ANDI	TB,77777
	CAME	TB,COLSEQ##	;PROGRAM COLLATING SEQUENCE?
	JRST	CSMNEQ		;NO
	MOVE	TB,ELITPC	;WHERE IT WILL START
	IORI	TB,AS.LIT	;SET TYPE BIT
	MOVEM	TB,COLSQA##	;ASCII
	ADDI	TB,200
	MOVEM	TB,COLSQS##	;SIXBIT
	ADDI	TB,100
	MOVEM	TB,COLSQE##	;EBCDIC
CSMNEQ:
	HRRZ	TB,1(TA)	;GET SIZE
	ADDM	TB,CURMNE	;ACCOUNT FOR ALL BUT FIRST 2 WORDS
	MOVE	TB,ELITPC	;WHERE WE WILL STORE SEQUENCE
	HRRM	TB,1(TA)	;CHANGE TO BE LITTAB NOW

	HRRZ	TA,MNELOC
	MOVN	TA,TA
	ADDM	TA,CURMNE	;IN CASE EXPANSION

	PUSH	PP,W1		;NEED A SAFE AC
;NOW TO OUTPUT THE ASCII COLLATING SEQUENCE
	MOVE	TA,[OCTLIT,,200]
	PUSHJ	PP,STASHI
	MOVSI	W1,-200
	HLRZ	TA,COLTMP(W1)
	PUSHJ	PP,STASHL
	AOS	ELITPC
	AOBJN	W1,.-3

;NOW TO OUTPUT THE SIXBIT COLLATING SEQUENCE
	MOVE	TA,[OCTLIT,,100]
	PUSHJ	PP,STASHI
	MOVSI	W1,-100
	HLRZ	TA,COLTMP+240(W1)
	PUSHJ	PP,STASHL
	AOS	ELITPC
	AOBJN	W1,.-3

;NOW TO OUTPUT THE EBCDIC COLLATING SEQUENCE
	MOVE	TA,[OCTLIT,,400]
	PUSHJ	PP,STASHI
	MOVSI	W1,-400
	HRRZ	TA,COLTMP(W1)
	PUSHJ	PP,STASHL
	AOS	ELITPC
	AOBJN	W1,.-3

	POP	PP,W1
	HRRZ	TA,MNELOC
	ADDB	TA,CURMNE	;PUT BASE BACK
	JRST	CSMNEE		;ADD IN FIRST 2 WORDS

CSMNED:	MOVE	TA,CURMNE
	ADDI	TA,-1(TB)	;ADD IN SIZE OF RD CODE -1
CSMNEE:	ADDI	TA,SZ.MNE+1	;ADD IN NORMAL SIZE + <LN,,CP> IF ALPHABET-NAME
	HRRZ	TB,MNENXT##
	CAIGE	TA,(TB)		;FINISHED?
	JRST	CSMNEL		;NO

;NOW SEE WHAT PROGRAM COLLATING SEQUENCE IS
	HRRZ	TA,COLSEQ
	CAIN	TA,%AN.AS
	SETZB	TA,COLSEQ	;ASCII IS A NO-OP
	CAIN	TA,%AN.EB
	HALT	.+1		;FOR NOW
	HRRM	TA,COLSEQ	;PUT BACK OR SET TO ZERO
	JRST	CSMEND		;ALL DONE

CSMNEZ:	HRRZI	DW,E.719	;ERROR #
	MOVE	CP,CURMNE	;GET BASE
	HLRZ	LN,2(CP)	;RESTORE LN
	HRRZ	CP,2(CP)	;AND CP
	PJRST	WARN##

CSMTST:	SKIPGE	DEFDSP##	;IS THE DEFAULT DISPLAY-9
	JRST	CSMSTX		;YES
	SKIPL	COLTMP(TB)	;ALREADY SETUP?
	JRST	CSMNEZ		;YES, ERROR
	PUSH	PP,TB		;SAVE TB
CSMSTR:	CAIL	TB,200		;IN ASCII RANGE?
	SOJA	TC,CSMSNA	;NO
	HRLM	TC,COLTMP(TB)	;STORE NEW ASCII VALUE
	HRRZ	TB,TB		;INCASE AOBJN PTR
	CAIL	TB,40		;IS IT IN SIXBIT RANGE?
	CAIL	TB,140		;...
	JRST	CSMSNS		;NO
	SUB	TC,ILCSIX	;REMOVE NON-SIXBIT COUNT
	HRLM	TC,COLTMP+200(TB)	;STORE SIXBIT
	ADD	TC,ILCSIX	;RESTORE COUNT
CSMSTE:	SKIPGE	DEFDSP		;IS THE DEFAULT DISPLAY-9
	JRST	CSMSTZ		;YES, WE'RE ALL DONE

				;ROUTINE TO CONVERT AN ASCII CHAR TO EBCDIC.
	CAIL	TB,200		;IS IT OUTSIDE ASCII RANGE?
	JRST	CSMSTG		;YES, USE AS IS
	ROT	TB,-2		;FORM THE INDEX INTO THE TABLE.
	JUMPL	TB,CSMSTF	;LEFT OR RIGHT HALF?
	HLR	TB,ASEBC.##(TB)	;LEFT.
	CAIA
CSMSTF:	HRR	TB,ASEBC.##(TB)	;RIGHT.
	TLNN	TB,(1B1)	;IS THE CHAR RIGHT JUSTIFIED?
	LSH	TB,-^D9		;IT IS NOW.
	ANDI	TB,377		;CLEAR JUNK
CSMSTG:	ADD	TC,EXCEBC	;ADD IN EXCESS COUNT
	HRRM	TC,COLTMP(TB)	;STORE EBCDIC
	SUB	TC,EXCEBC
CSMSTZ:	POP	PP,TB		;RESTORE
	POPJ	PP,

CSMSNA:	AOSA	EXCEBC		;ONE MORE THAT IS ONLY EBCDIC
CSMSNS:	AOS	ILCSIX		;ONE MORE THAT ISN'T SIXBIT
	JRST	CSMSTE		;TRY EBCDIC

CSMSTX:	HRL	TC,COLTMP(TB)	;GET CURRENT CHAR.
	JUMPGE	TC,CSMNEZ	;ALREADY EXISTS
	HRRZ	TC,TC		;CLEAR LHS.
	ADD	TC,EXCEBC	;ADD EXCESS
	HRRM	TC,COLTMP(TB)	;SAVE EBCDIC CHAR
	SUB	TC,EXCEBC
	PUSH	PP,TB		;SAVE CHAR
	HRRZ	TB,TB		;INCASE AOBJN PTR
				;ROUTINE TO CONVERT AN EBCDIC CHAR TO ASCII.
	ROT	TB,-2		;FORM THE INDEX INTO THE TABLE.
	JUMPL	TB,CSMSTY	;LEFT OR RIGHT HALF?
	HLR	TB,EBASC.##(TB)	;LEFT.
	CAIA
CSMSTY:	HRR	TB,EBASC.##(TB)	;RIGHT.
	TLNN	TB,(1B1)	;IS THE CHAR RIGHT JUSTIFIED?
	LSH	TB,-^D9		;IT IS NOW.
	ANDI	TB,177		;CLEAR JUNK
	CAIE	TB,134		;\ IS SPECIAL
	JRST	CSMSTR		;NOW STORE ASCII
	HRRZ	TB,0(PP)	;AS IT MIGHT BE ILLEGAL CHAR
	CAIE	TB,340		;UNLESS EBCDIC \
	SOJA	TC,CSMSNA	;ILLEGAL SO DON'T STORE
	MOVEI	TB,134		;RESTORE \
	JRST	CSMSTR		;AND STORE IT

CSMEND:
>

;SEE IF START ADDRESS IS IN NON-RESIDENT SEGMENT

	HRRZS	TA,PROGST##		;GET START ADDRESS 
	TRC	TA,200000
	TRCE	TA,200000
	JRST	GO			;LEAVE IT ALONE
	TRC	TA,600000		;CHANGE 2 TO 4 (???)
	PUSHJ	PP,LNKSET
	LDB	CH,PR.PRI##		;GET LEVEL
	CAMGE	CH,SEGLIM##		;IN RESIDENT SECTION?
	JRST	GO			;YES
	PUSHJ	PP,GETTAG##		;NO
	HRL	CH,PROGST
	MOVEM	CH,PROGST		;NON-RES ADDRESS,,TAG
	LDB	TA,[POINT 15,CH,35] ;MAKE SURE THE TAG IS REFERENCED
	PUSHJ	PP,REFTAG##
EXTERNAL ACEPT.,DSPLY.,EDIT.U,EDIT.S,FLOT.2,C.D6D7,C.D7D6,C.DD
EXTERNAL PD6.,PD7.,MUL.21,DIV.21
EXTERNAL PRODSW

;NOW WE ARE READY FOR ACTION

GO:	SETZM	EINTO##		;IN CASE PHASE C OR D LEFT TRASH HERE
	PUSHJ	PP,ENTERS	;SET UP PP LIST WITH ENTERS AS RETURN WITH FINAL
				;RETURN [POPJ	PP,]

	AOBJP	PP,KILL		;RESET PP TO LOOK AT ENTERS ON FINAL POPJ
ENTERS:	MOVE	EACA,EOPLOC	;MOVE PUSHDOWN XWD TO KEEP TRACK OF MOVING TABLES
				;REMEMBER! TABLES DYNAMICALLY ALLOCATED!.
				;RETURNS FROM SUBROUTINES WILL GENERALLY BE
				;TO THE TAG, "ENTERS:"
	MOVEM	EACA,EOPNXT

	SETZB	EACC,ETEMPC	;ZERO OUT OPERAND TALLY-ER & 
				;CURRENT TEMP STORAGE REQUIRED
				;BY A PARTICULAR GENERATOR DURING OBJECT TIME.


COMEBK:	PUSHJ	PP,READEM	;READ OPERAND PAIR(S) UNTIL OP-CODE FOUND

				;POPJ	PP, IS EXPECTED TO RETURN YOU HERE
				;OR TO CALLING GENERATOR






	MOVEI	EACD,(W2)	;SEE IF OP-CODE IS WITHIN RANGE OF TABLE
	CAIG	EACD,ELAST
	JRST	@EOPCOD(W2)		; _ YES !


					; _ NO !!

	CAIE	EACD,ENDIT	;NO--IS IT "ENDIT"?
	JRST	EBADOP			;NOPE, BAD OPCODE
;END OF PHASE E -- WRAP UP

ERAPUP:	MOVEI	EACA,0		;SET 'NO OPERANDS'
	PUSHJ	PP,SEGCLN		;CLEAN UP ANY DANGLING EXITS
					;AND DUMP ALTERS > 50.


					;SET UP OFFSET POINTER FOR PHASE F-G.
	MOVE	TA,TEMBAS
	ADD	TA,ETEMAX
	MOVEM	TA,DATBAS		;DATBAS = TEMBAS + LARGEST TEMP AREA REQUIRED 
					;BY OBJECT TIME PROGRAM.
					;[ETEMAX]


	ADDB	TA,FILTBL		;FILTBL = FILTBL + DATBAS

	ADDB	TA,USEBAS		;USEBAS = USEBAS + FILTBL
	ADDB	TA,IMPPAR		;IMPPAR = IMPPAR + USEBAS


	ADD	TA,EAS1PC		;A50BAS = IMPPAR + EAS1PC
	MOVEM	TA,A50BAS		;A50BAS NOW UPDATED

	ADD	TA,EALTMX
	MOVEM	TA,RESDNT		;RESDNT = A50BAS + EALTMX
	ADD	TA,EAS2PC		;NONRES = RESDNT + EAS2PC
	MOVEM	TA,NONRES
;PARAGRAPH & SECTION "DANGLING EXITS" CLEANED UP
;OFFSETS UPDATED,
;NOW CLOSE OUT YOUR FILES

	MOVEI	CH,0		;EOF FOR AS1 = A HEADER WORD OF 0....
	PUSHJ	PP,PUTAS1
	CLOSE	AS1,		;AS1 CLOSED OUT






	MOVSI	CH,177740	;PUT OUT
	PUSHJ	PP,PUTASN	;  'END-FILE' ON CURRENT FILE
	MOVEI	CH,0		;PUT OUT
	PUSHJ	PP,PUTAS2	;  END-OF-DATA ON AS2
	CLOSE	AS2,		;AS2 CLOSED OUT....





	MOVEI	CH,0		;PUT OUT
	PUSHJ	PP,PUTAS3	;  END-OF-DATA ON AS3
	CLOSE	AS3,		;AS3 CLOSED OUT....



	SETOI	DW,		;ALL 1'S ON ERA FILE = EOF
	PUSHJ	PP,PUTERA
	CLOSE	ERA,		;ERROR FILE CLOSED OUT!!!!!!
				;ALL FILES CLOSED THAT THIS PHASE CLOSES!!!!!!!!





	ENDFAZ	E;		;THAT'S ALL FOLKS/////------->
				;GONE TO PHASE F-G---------------->
READEM:	PUSHJ	PP,GETGEN	;READ TWO 36-BIT WORDS FROM
				;GENFIL. ALL ITEMS ARE TREATED AS TWO
				;36-BIT WORDS: FIGURATIVE 
				;CONSTANTS WILL CONTAIN  MEANINGLESS
				;INFORMATION IN THEIR 2ND WORDS.
				;W1_FIRST WORD
				;W2_SECOND WORD
	SKIPL	W1		;SEE MEMO 100-350-010, PAGES 5 THROUGH 6. OPERATORS
				;WILL HAVE BIT 0 OF W1 = 0, AND ACCUMULATOR
				;W2 WILL CONTAIN RIGHT JUSTIFIED, THE OP CODE
				;OPERANDS WILL HAVE BIT 0 OF ACCUMULATOR W1 = 1.
GOBACK:	POPJ	PP,		;IF IT'S AN OPERATOR, POPJ	PP,
	PUSHJ	PP,PUSH12	;STASH W1&W2 IN EOPTAB
	AOJA	EACC,READEM	;KEEP TRACK OF # OF COUPLETS STASHED IN OPERAND
				;TEMPORARY TABLE, EOPTAB.
				;GET MORE INPUT AND KEEP STASHING OPERANDS
				;IN EOPTAB UNTIL YOU FIND AN OPERATOR.
;THE GENERATOR DISPATCH TABLE

EOPCOD:	EXP	EBADOP		;  0	SUBROUTINE ADDRESSES FOR THE VARIOUS OP CODES 
	VECTOR	MOVGEN		;  1
	VECTOR	ADDGEN		;  2
	VECTOR	ADDTGN		;  3
	VECTOR	SUBGEN		;  4
	VECTOR	SUBFGN		;  5
	VECTOR	MULGEN		;  6
	VECTOR	MULBGN		;  7
	VECTOR	DIVGEN		; 10
	VECTOR	RESGEN		; 11
	VECTOR	REMGEN		; 12
	VECTOR	DIVBGN		; 13
	VECTOR	DECLST		;[435]  14 START DECLARITIVES
	VECTOR	DECLEN		;[435]  15 END DECLARITIVES
	EXP	EBADOP		; 16
	EXP	EBADOP		; 17
	VECTOR	IFGEN		; 20
	VECTOR	IFCGEN		; 21
	VECTOR	IFTGEN		; 22
	VECTOR	SPIFGN		; 23
	VECTOR	ELSEGN		; 24
	EXP	EBADOP		; 25
	VECTOR	ENDIFG;		; 26
	EXP	EBADOP		; 27
	VECTOR	GOGOGN		; 30
	VECTOR	GODPGN		; 31
	VECTOR	PERFGN		; 32
	VECTOR	PRFYGN		; 33
	VECTOR	ALTGEN		; 34
IFN SERCH,<VECTOR SRCHGN
            VECTOR SINCGN>
IFE SERCH,<EXP NOTIMP
            EXP NOTIMP>
	VECTOR	GOBKGN		; 37
	VECTOR	STOPGN		; 40
	EXP	EBADOP		; 41
IFN ANS68,<
	VECTOR	EXAMGN		; 42
>
IFN ANS74,<
	VECTOR	INSPGN		; 42
>
	VECTOR	SETTGN		; 43
	VECTOR	SETDGN		; 44
	VECTOR	SETUGN		; 45
	VECTOR	ARGGEN		; 46
	VECTOR	ENTRGN		; 47
	VECTOR	COMPGN		; 50
	VECTOR	CADDGN		; 51
	VECTOR	CSUBGN		; 52
	VECTOR	CMULGN		; 53
	VECTOR	CDIVGN		; 54
	VECTOR	CEXPGN		; 55
	EXP	EBADOP		; 56
	VECTOR	CENDGN		; 57
;THE GENERATOR DISPATCH TABLE (CONT'D).

	VECTOR	ACCGEN		; 60
	VECTOR	DISPGN		; 61
	VECTOR	OPENGN		; 62
	VECTOR	CLOSGN		; 63
	VECTOR	READGN		; 64
	VECTOR	RITEGN		; 65
	VECTOR	REWGEN		; 66
IFN ANS68,<
	VECTOR	SEEKGN		; 67
>
IFN ANS74,<
	VECTOR	STRTGN		; 67
>
	VECTOR	LPARGN		; 70
	VECTOR	RPARGN		; 71
	VECTOR	EXPRGN		; 72
	VECTOR	ENDXGN		; 73
	VECTOR	JUMPTO;		; 74
	EXP	EBADOP		; 75
	EXP	GOBACK		; 76
	VECTOR	NTRYGN		; 77
	VECTOR	SECGEN		;100
	VECTOR	PARGEN		;101
	VECTOR	TAGGEN		;102
	EXP	EBADOP		;103
	VECTOR	SEGBRK;		;104
	EXP	YECCH		;105
	EXP	EBADOP		;106
IFN ANS68,<
	EXP	EBADOP		;107
>
IFN ANS74,<
	VECTOR	SCOLGN		;107
>
	VECTOR	SORTGN		;110
	VECTOR	SKEYGN		;111
	VECTOR	SINGN		;112
	VECTOR	SOUTGN		;113
	VECTOR	SGIVGN		;114
	VECTOR	SUSEGN		;115
	VECTOR	SENDGN		;116
	VECTOR	MERGGN		;117
	VECTOR	RELSGN		;120
	VECTOR	RETNGN		;121
	VECTOR	DELGEN		;122
IFN RPW,<VECTOR INITRW		;123
         VECTOR GENRW		;124
         VECTOR TERMRW>		;125
IFE RPW,<EXP NOTIMP
         EXP NOTIMP
         EXP NOTIMP>
	VECTOR	TRCGEN		;126
	EXP	EBADOP		;127
	VECTOR	CANGEN		;130
IFN DBMS,<VECTOR IFDBGN>	;131
IFE DBMS,<EXP	NOTIMP>
IFN MCS!TCS,<VECTOR	DISGEN		;132
	VECTOR	ACTGEN		;133
	VECTOR	SNDGEN		;134
	VECTOR	RCVGEN>		;135
IFE MCS!TCS,<EXP	NOTIMP
	EXP	NOTIMP
	EXP	NOTIMP
	EXP	NOTIMP>

	VECTOR STRGEN		;136=SDELIM
	EXP	GOBACK		;STRNG - MUST HAVE BEEN A SYNTAX ERROR
				; IT SHOULD BE READ IN BY STRGEN.
	VECTOR	UNSGEN		;140=UDELIM
	VECTOR	UNSGEN		;141=UNSDES
	EXP	GOBACK		;UNSTR - MUST HAVE BEEN A SYNTAX ERROR
				; IT SHOULD BE READ IN BY STRGEN.

	VECTOR	FENQGN	;143 FILE ENQUEUE
	VECTOR	FUNAVG	;144 FILE UNAVAILABLE
	VECTOR	EFUNAV	;145 END FILE UNAVAILABLE
	VECTOR	EFENQG	;146 END FILE ENQUEUE
	VECTOR	RENQGN	;147 RECORD ENQUEUE
	VECTOR	ERENQG	;150 END RECORD ENQUEUE
	VECTOR	ERUNAV	;151 END RECORD UNAVAILABLE
	VECTOR	RDEQGN	;152 RECORD DEQUEUE
	VECTOR	ERDEQG	;153 END RECORD DEQUEUE
	VECTOR	ENRGEN	;154 END NOT RETAINED
IFN CSTATS,<
	VECTOR	METGEN	;155 METER--JSYS
>
IFE CSTATS,<
	EXP	NOTIMP	; (NOT IMPLEMENTED IN THIS VERSION)
>
IFN ANS74,<
	VECTOR	INSPTG	;156 INSPECT TALLYING
	VECTOR	INSPRG	;157 INSPECT REPLACING
>
IFE ANS74,<
	EXP	NOTIMP	;156 NOT IMPLEMENTED
	EXP	NOTIMP	;157 NOT IMPLEMENTED
>

	ELAST=.-1-EOPCOD
;TROUBLE WITH SYNTAX

YECCH:	SETZM	TAGTRU
	SETZM	ECXTRA
	SETZM	EMULSZ
	SETZM	ERESDP
	SETZM	FLTDIV##	;[637] INCASE OF EXPRESSION SCREW-UP
IFN ANS74,<
	SETZM	CMPLVL##	;INCASE IN COMPUTE
>
	POPJ	PP,

EXTERNAL TAGTRU,ECXTRA,ERESDP,EMULSZ,AS.EXT


EBADOP:	TTCALL	3,[ASCIZ "?COMPILER ERROR: BAD GENFIL OPERATOR
"]
	JRST	READEM		;DIE AND DUMP EVERYTHING.


;PUT OUT DIAG 'NOT IMPLEMENTED IN THIS VERSION'

	EXTERNAL W1LN,W1CP,FATAL
NOTIMP:	LDB	LN,W1LN
	LDB	CP,W1CP
	MOVEI	DW,E.91
	JRST	FATAL

	END	COBOLE