Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/pure.mac
There are 9 other files named pure.mac in the archive. Click here to see a list.
; UPD ID= 1440 on 11/15/83 at 3:33 PM by HOFFMAN                        
SUBTTL	PURE CONSTANTS FOR COBOL		A.BLACKINGTON/CAM/SEB

	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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P
	ONESEG==:ONESEG
	MCS==:MCS
	DBMS6==:DBMS6
	DBMS==:DBMS
	DEBUG==:DEBUG
	MPWCEX==:MPWCEX

	SEARCH	TABLES

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000

;EDITS
;NAME	DATE		COMMENTS

;V12B****************
;SMI	29-Jan-82	[1451] Make RPWTAB table size be 377777 words.

;V12A****************
;DMN	 1-APR-80	[1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.

;V12*****************
;DAW	20-FEB-79	[634] ADD QUAD-WORD SIZE ERROR ROUTINES.
;DMN	 4-DEC-78	[605] ADD FILE-TABLE OFFSET FOR VAR. LEN. READ
;DMN	 6-OCT-78	[570] ADD QUAD-WORD ROUNDING FUNCTION.

;V10*****************
;SSC	28-SEPT-77	ADD NEW DBMS-V6 ENTRY PTS: OPENT,FIND6,DELTR,CLOTR
;	27-AUG-76	; [441] ADD ZERO COMPARE ROUTINES, NEEDS 454 IN LIBOL
;SSC	29-JUL-76	ADD ENTRY POINTS FOR DBMS S. U.
;ACK	12-JAN-75	ADDED CAPABILITY TO HANDLE DIAGS UP TO 1023.
;ACK	12-JAN-75	CHANGED FILE TABLE STRUCTURE:
;			1.  MOVED EXTERNAL RECORDING MODE FIELD FROM
;				WORD 6 BITS 0-1 TO WORD 5 BITS 5-7.
;			2.  ADDED A WORD (20) FOR SIMULTANEOUS ACCESS.
;			3.  ADDED FOUR WORDS (21-24) FOR I/O ERROR HANDLING
;				RE THE FILE-STATUS CLAUSE.
;ACK	31-JAN-75	MOVED INTERNAL RECORDING MODE FIELD FROM WORD 6
;				BITS 14-15 TO WORD 5 BITS 8-10.
;ACK	10-MAR-75	ADDED AN ASSEMBLY CODE FOR EBCDIC LITERALS.
;ACK	13-APR-75	MOVED TABLE DESCRIPTIONS TO UNIVERSAL TABLES.
;DBT	5/5/75		ADD EDIT.B - BIS EXTERNAL EDIT ROUTINE
;********************

; EDIT 263 MAKE TALLY RECOGNIZABLE IN PHASE F 
; [201] ADDED EXTERNAL COBST.
; THIS LOCATION IS DEFINED SO THAT ANY GIVEN COBOL COMPILER SEGMENT
; CAN BE EXAMINED TO SEE WHAT FEATURE TEST SWITCHES WERE USED
; TO BUILD IT
;     EXAMINE   400010

COBSW%::	EXP	SWSET%

;THIS SOURCE IS IDENTICAL FOR PROGRAMS PURAB, PUREC, PURED, PUREE, PUREO & PURFG
;	EXCEPT FOR THE VALUE OF MLOAD.

;ASSEMBLE WITH THE APPROPRIATE PARAMETER FILE PURAB.MAC,
;    PUREC.MAC, PURED.MAC, PUREE.MAC, PUREO.MAC, OR PURFG.MAC TO MAKE THE
;    CORRESPONDING REL FILE

	SALL

	DEFINE .TITLE (X),<TITLE X FOR COBOL 13		>
A.==1
B.==2
C.==4
D.==10
E.==20
F.==40
G.==100
O.==200

AB.==A.!B.
ABC.==A.!B.!C.
ABCD.==A.!B.!C.!D.
ABCDE.==A.!B.!C.!D.!E.
ABCDEO.==A.!B.!C.!D.!E.!O.
ADEFG.==A.!D.!E.!F.!G.!O.
CDE.==C.!D.!E.
BC.==B.!C.
BCE.==B.!C.!E.
BCD.==B.!C.!D.
BCDE.==B.!C.!D.!E.
BCDEFG==B.!C.!D.!E.!F.!G.!O.
BD.==B.!D.
BDE.==B.!D.!E.
CD.==C.!D.
DE.==D.!E.
DEFG.==D.!E.!F.!G.!
EO.==E.!O.
EOG.==E.!O.!G.
EG.==E.!G.
FG.==F.!G.
OG.==O.!G.

IFNDEF %MLOAD,< %MLOAD=="A">		;GIVE THIS A VALUE FOR ONE-SEG COMPILER

IFE %MLOAD-"A",<MLOAD==A.!B.>
IFE %MLOAD-"C",<MLOAD==C.>
IFE %MLOAD-"D",<MLOAD==D.>
IFE %MLOAD-"E",<MLOAD==E.>
IFE %MLOAD-"F",<MLOAD==F.!G.>
IFE %MLOAD-"O",<MLOAD==O.>
IFE ONESEG,<

	IFN MLOAD&AB.,	<.TITLE PURAB
		SUBTTL CONSTANTS USED BY PHASE A & B
		ENTRY PUREA
		PUREA:
		ENTRY PUREB
		PUREB:
		>

	IFN MLOAD&C.,	<.TITLE PUREC
		SUBTTL CONSTANTS USED BY PHASE C
		ENTRY PUREC
		PUREC:
	>

	IFN MLOAD&D.,	<.TITLE PURED 
		SUBTTL CONSTANTS USED BY PHASE D
		 ENTRY PURED
		 PURED:>

	IFN MLOAD&E.,	<.TITLE PUREE
		 SUBTTL CONSTANTS USED BY PHASE E
		 ENTRY PUREE
		 PUREE:>

	IFN MLOAD&O.,	<.TITLE PUREO
		 SUBTTL CONSTANTS USED BY PHASE O
		 ENTRY PUREO
		 PUREO:>

	IFN MLOAD&FG.,	<.TITLE PURFG
		 SUBTTL CONSTANTS USED BY PHASES F & G
		ENTRY PUREF
		PUREF:
		ENTRY PUREG
		PUREG:
		>
>
IFN ONESEG,<
	.TITLE	PURE
	ENTRY	PUREA,PUREB,PUREC,PURED,PUREE,PUREO,PUREF,PUREG
PUREA: PUREB: PUREC: PURED: PUREE: PUREF: PUREG: PUREO:
>


	INTERNAL MLOAD1
	MLOAD1=="B"	;HIGHEST PHASE IN FIRST MACHINE LOAD
IFE ONESEG,<
;GET NEXT MACHINE LOAD

 IFN MLOAD&AB.,<INTERNAL COBOLC
COBOLC:	MOVE	TA,['COBOLC']
 >

 IFN MLOAD&C.,<INTERNAL COBOLD
COBOLD:	MOVE	TA,['COBOLD']
 >

 IFN MLOAD&D.,<INTERNAL COBOLE
COBOLE:	MOVE	TA,['COBOLE']
 >

 IFN MLOAD&E.,<INTERNAL COBOLO
COBOLO:	SKIPA	TA,['COBOLO']
 >

 IFN MLOAD&EO.,<INTERNAL COBOLF
COBOLF:	MOVE	TA,['COBOLF']
 >

	MOVEM	TA,GETFNM##+1
	SETZM	GETFST##		;STARTING ADDRESS INCREMENT
	JRST	GETLOD##

>;END IFE ONESEG


	DEFINE SETUP (A,B), <
		INTERNAL A
		A: B
	>

	DEFINE SETVAL (A,B), <
		INTERNAL A
		A==B>
;CONSTANTS USED BY ALL PHASES


	SETUP ERAPOS,<POINT 7,DW,21>;  CHARACTER POSITION FIELD IN DIAG WORD
	SETUP ERALN,<POINT 13,DW,14>;  LINE NUMBER FIELD IN DIAG WORD
	SETUP ERANUM,<POINT 10,DW,35>;  DIAG NUMBER FIELD IN DIAG WORD
	SETUP ERAFAZ,<POINT 3,DW,24>;  PHASE NUMBER FIELD IN DIAG WORD
	SETUP OUTBOP,<OUTBUF 2>;	OUTBUF UUO
	SETUP INBOP,<INBUF 2>;		INBUF UUO

	SETVAL LINPAG,^D56	;LINES PER PRINTED PAGE
	SETVAL CPMAXN,^D122	;CHARACTERS PER PRINTED LINE
				; CALCULATED FROM 132 LINE PER PAGE
				; MINUS 2 FOR SPACE BETWEEN COL. 7 AND COL. 8
				; MINUS 8 FOR POSSIBLE SOS LINE NUMBER.

	SETVAL MAXWSS,777777	;SIZE OF LARGEST ALLOWED ITEM IN WORKING-STORAGE
	SETVAL MAXFSS,7777	;SIZE OF LARGEST ALLOWED ITEM IN FILE SECTION
	SETVAL MAXOCC,77777	;GREATEST NUMBER OF OCCURENCES ALLOWED
	SETVAL WRKSIZ,^D6*2000	;SIZE OF IMPURE AREA
	SETVAL NAMCST,2		;A CONSTANT USED BY TRYNAM&BLDNAM

EXTERNAL NNDLNT,NODLST,NSVLNT,SAVLST
EXTERNAL ARGLST,ARGLSZ,ARGL2,ARG2SZ,PPSIZE,PPLIST

	SETUP INDPTR,<XWD NNDLNT,NODLST-1>
	SETUP ISVPTR,<XWD NSVLNT,SAVLST-1>
	SETUP IARGL,<XWD ARGLSZ,ARGLST-1>
	SETUP IARGL2,<XWD ARG2SZ,ARGL2-1>
	SETUP PPOINT,<XWD PPSIZE,PPLIST-1>
;PARAMETERS USED WHEN PLAYING WITH TABLE LINKS

	SETUP LNKCOD,<POINT 3,TA,20>	;CODE IN A TABLE LINK
	SETVAL LMASKB,77777	;MASK OF LINK BITS FOR TABLE-LINK OF BIG TABLE
	SETVAL LMASKS,77777	;SAME FOR SMALL TABLE
	SETVAL LMASKR,377777	;[1451] MASK FOR REPORT WRITER TABLE ENTRY
	DEFINE TABVAL (NAME,CODE),<
	INTERNAL TB.'NAME,TC.'NAME,TM.'NAME
	TB.'NAME==CODE
	TC.'NAME==CODE'*100000
	TM.'NAME==77777
	>

	TABVAL FIL,0
	TABVAL DAT,1
	TABVAL CON,2
	TABVAL LIT,3
	TABVAL PRO,4
	TABVAL EXT,5
	TABVAL VAL,6
	TABVAL MNE,7

	SETVAL TM.TAG,77777
;CONSTANTS USED BY PHASE A

	IFN MLOAD&A.!ONESEG,<

	SETUP ENTROP,<ENTER I1>;  ENTER UUO


;QUANTUM VALUES FOR SIZES OF NM1TAB&NM2TAB.
;SEE 'NTNSIZ' IN IMPURE FOR NUMBER OF ENTRIES.

	SETVAL NTSIZE,.
	DEC	1009
	DEC	1499
	DEC	1999
	DEC	2503
	DEC	3001
	DEC	3499
	DEC	4001
	DEC	4507
	DEC	5003
	DEC	5501
	DEC	6007
	DEC	6491
	DEC	7001
	DEC	7499
	DEC	8009
	DEC	8501
	DEC	9001
	DEC	9497
	DEC	10007

>
;CONSTANTS USED BY PHASES A,B,C,D

	IFN MLOAD&ABCD.!ONESEG,<

	SETUP I0CHAN,<POINT 4,I0,12>;  AC FIELD OF "I0"
	SETUP OPENOP,<OPEN I1>;		OPEN UUO
	SETUP LOOKOP,<LOOKUP I1>;	LOOKUP UUO

	SETUP NAMVAL,<POINT 15,(TA),17>;VALUE OF RESERVED WORD IN NAMTAB ENTRY

	>

;CONSTANTS USED BY PHASES B,C,D

	IFN MLOAD&BCD.!ONESEG, <

	SETVAL COLNWD,GWRESV+764;	"W1" VALUE FOR COLON
	SETVAL COMWD,GWRESV+765;	"W1" VALUE FOR COMMA
	SETVAL SEMIWD,GWRESV+766;	"W1" VALUE FOR SEMI-COLON
	SETVAL LPARWD,GWRESV+767;	"W1" VALUE FOR LEFT-PAREN
	SETVAL PERWD,GWRESV+771;	"W1" VALUE FOR PERIOD
	SETVAL PLUSWD,GWRESV+772;	"W1" VALUE FOR PLUS
	SETVAL MINWD,GWRESV+773;	"W1" VALUE FOR MINUS OR HYPHEN
	SETVAL MULWD,GWRESV+775;	"W1" VALUE FOR STAR
	SETVAL EXPWD,GWRESV+776;	"W1" VALUE FOR "**"
	SETVAL ENDIT,GWRESV+777;	"W1" VALUE FOR END-OF-SOURCE
	SETUP RPARWD,<XWD GWRESV+770,")">	;W1 VALUE FOR RIGHT PAREN
	XWD GWRESV+774,"/"	;W1 VALUE FOR SLASH
	XWD GWRESV+342,74	;W1 VALUE FOR LESS
	XWD GWRESV+322,"="	;W1 VALUE FOR EQUAL
	XWD GWRESV+332,76	;W1 VALUE FOR GREATER
	XWD GWRESV+776,"^"	;W1 VALUE FOR EXPONENTIATION "^"

	SETUP PUNPTR,<XWD RPARWD-.,RPARWD>

	SETUP GWNAMP,<POINT 15,W2,15>;	NAMTAB POINTER FIELD IN "W2"
	SETUP GWLN,<POINT 13,W2,28>;	LINE-NUMBER FIELD IN "W2"
	SETUP GWCP,<POINT 7,W2,35>;	CHARACTER-POSITION FIELD IN "W2"
	SETUP GWVAL,<POINT 9,W1,17>;	RESERVED-WORD VALUE IN "W1"

>
;FILTAB DEFINITIONS

	IFN MLOAD&BCDEFG!ONESEG,<

	FITB%C

	SETVAL FI.CLR,-^O34	;[605] REL. LOC. OF NO. OF CHAR. LAST READ

>


;DATAB DEFINITIONS

	IFN MLOAD&BCDEFG!ONESEG,<

	DATB%C

	SETVAL DA.EDW,^D10-1	;RELATIVE LOC OF FIRST EDIT WORD
	SETVAL DA.RKL,^D14-1	;RELATIVE LOC FOR FIRST KEY

>


;EXTAB DEFINITIONS

	IFN MLOAD&BDE.!ONESEG,<

	EXTB%C

>


;LITAB DEFINITIONS

	IFN MLOAD&C.!ONESEG,<

	LITB%C

>
;VALTAB DEFINITIONS

	IFN MLOAD&CDE.!ONESEG,<

	VATB%C
>
;CONTAB DEFINITIONS

	IFN MLOAD&CDE.!ONESEG,<

	COTB%C


>


;HLDTAB DEFINITIONS

	IFN MLOAD&BCDE.!ONESEG,<

	HLTB%C

	SETVAL HL.XBY,^O20	;CODE FOR 'INDEXED BY' ENTRY

>


;USETAB DEFINITIONS

	IFN MLOAD&DEFG.!ONESEG,<

	USTB%C

>
;FLOTAB DEFINITIONS

	IFN MLOAD&BCDEFG!ONESEG,<

	FLTB%C


;PROTAB DEFINITIONS

	PRTB%C

>


;CDTAB DEFINITIONS

IFN MCS,<

	CDTB%C

>	;END OF IFN MCS


;MNTAB DEFINITIONS.

	IFN MLOAD&BDE.!ONESEG,<

	MNTB%C

>

;AKTTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	AKTB%C

>

;DEBTAB DEFINITIONS.

	IFN MLOAD&DE.!ONESEG,<

	DBTB%C

>

;RENTAB DEFINITIONS.

	IFN MLOAD&CF.!ONESEG,<

	RNTB%C

>

;PRGTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	PGTB%C

>

;RESTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	RETB%C

>

;TAGTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	TATB%C

>

;ALTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	ALTB%C

>

;SECTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	SETB%C

>

;DBDTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	DDTB%C

>

;EOPTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	EOTB%C

>

;TEMTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	TMTB%C

>

;CPYTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	CPTB%C

>

;RCOTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	RCTB%C

>


;RPWTAB DEFINITIONS.

	IFN MLOAD&ABCDE.!ONESEG,<

	RWTB%A

>

	IFN MLOAD&CDE.!ONESEG,<

	RWTB%B

>
;FLAGS AND BITS IN GENFIL OPERATORS

	RADIX	10

	IFN MLOAD&D.!ONESEG,<

	EXTERNAL OPRTR


OBIT9:	POINT 1,OPRTR,9
OBIT10:	POINT 1,OPRTR,10
OBIT11:	POINT 1,OPRTR,11
OBIT12:	POINT 1,OPRTR,12
OBIT13:	POINT 1,OPRTR,13
OBIT14:	POINT 1,OPRTR,14
OBIT15:	POINT 1,OPRTR,15
OBIT16:	POINT 1,OPRTR,16
OBIT17:	POINT 1,OPRTR,17

	DEFINE OPBIT (X,Y),<SETVAL OP.'X,OBIT'Y>
	DEFINE OPFLD (W,X,Y,Z),<SETUP OP.'W,<POINT X,OPRTR+Z,Y>>

;FIELDS IN OPRTR WORD

	OPFLD LN,13,28,0
	OPFLD CP,7,35,0
	OPFLD LNC,20,35,0
	OPFLD OPC,9,8,0
	OPFLD IO,2,10,0
	SETVAL OP.USE,OP.IO
	SETVAL OP.INO,OP.IO
	SETVAL OP.AAD,OP.IO
	OPFLD OP2,8,35,1
	OPFLD COB,5,13,0
	OPFLD TRG,15,17,1
	OPFLD SWT,6,35,0
	OPFLD IFT,3,11,0	;IFT CODES
	SETVAL OP.ILZ,OP.IFT	;INITIALIZE REPLACING


;MASKS  IN OPRTR WORD

	SETVAL OPM.IF,^O700
	SETVAL OPM.IZ,^O700
;FLAG SETTINGS IN OPRTR WORD

	OPBIT INP,10
	OPBIT OUT,9
	OPBIT AFT,11
	OPBIT XTD,14	;USE ... EXTEND
	OPBIT OPN,15
	OPBIT TRC,9
	OPBIT RUN,9
	OPBIT PD,9	;ENTRY
	OPBIT MAC,9	;ENTER
	OPBIT USI,11	;  (ALSO USED BY ENTRY)
	OPBIT CAL,12
	OPBIT F10,13
	OPBIT CLN,9
	OPBIT UPO,9
	OPBIT ATE,9
	OPBIT SZE,10
	OPBIT INK,11
	OPBIT OVR,13
	OPBIT EOP,15	;END OF PAGE
	OPBIT SPI,9
	OPBIT SPN,10	;SPECIAL IF, NOT I-O
	OPBIT REE,9
	OPBIT NRW,11
	OPBIT EXT,13	;OPEN EXTEND
	OPBIT REV,14	;OPEN REVERSED
	OPBIT LCK,10
	OPBIT REM,13	;FOR REMOVAL
	OPBIT LEA,9
	OPBIT FIR,10
	OPBIT UFR,11
	OPBIT RPL,12
	OPBIT IAB,13	;INSPECT AFTER  XX BEFORE YY
	OPBIT CHR,11
	OPBIT IBF,14
	OPBIT IAF,15
	OPBIT EIN,12	;"LAST INSPECT ARG"
	OPBIT BAD,9
	OPBIT ADV,9	;ADVANCING.
	OPBIT FRM,11
	OPBIT PSG,12	;POSITIONING.
	OPBIT IN2,9
	OPBIT NXT,10
	OPBIT KIS,11	;KEY IS
	OPBIT UNM,9
	OPBIT FLS,14
	OPBIT LES,9
	OPBIT GRT,10
	OPBIT EQU,11
	OPBIT APK,12	;START APPROX KEY
	OPBIT NOT,15
	OPBIT ON,9
	OPBIT OFF,10
	OPBIT COR,12
	OPBIT ASC,9
	OPBIT DNA,10
	OPBIT WDL,12
	OPBIT ALL,9	;USED BY UDELIM AND OTHERS
	OPBIT PGM,10
	OPBIT WSC,9	;WITH SEQUENCE CHECK FOR MERGE
IFN DBMS,<
	OPBIT EMP,9	;IFDB
	OPBIT MEM,10
	OPBIT OWN,11
	OPBIT MOO,12
>
	OPBIT	DSZ,9	;SDELIM
	OPBIT	OVF,9	;STRNG,UNSTR
	OPBIT	PTR,10	;STRNG,UNSTR
	OPBIT	DEL,9	;UNSDES: DELIMITER IN
	OPBIT	COU,10	;UNSDES: COUNT IN
	OPBIT	TLG,11	;UNSTR: TALLYING IN

IFN MCS,<
	OPBIT	IFM,9		;IF MESSAGE
	OPBIT	ENA,9
	OPBIT	TRM,10
	OPBIT	OT2,11
	OPBIT	AF2,9
	OPBIT	PAG,10
	OPBIT	SEG,9
	OPBIT	NDP,10		;NO DATA PHRASE
	>

;INDEX VALUES FOR IFT CODES - TOO MANY TO USE ONE BIT EACH

	SETVAL	OP%NUM,1	;IF ... NUMERIC
	SETVAL	OP%ALF,2	;IF ... ALPHABETIC
	SETVAL	OP%POS,3	;IF ... POSITIVE
	SETVAL	OP%NEG,4	;IF ... NEGATIVE
	SETVAL	OP%ZER,5	;IF ... ZERO
	SETVAL	OP%LCA,6	;IF ... LOWER-CASE ALPHABETIC
	SETVAL	OP%UCA,7	;IF ... UPPER-CASE ALPHABETIC

;Index values for INITIALIZE ... REPLACING statement
	SETVAL	OP%NUM,1	;NUMERIC
	SETVAL	OP%ALF,2	;ALPHABETIC
	SETVAL	OP%ANM,3	;ALPHANUMERIC
	SETVAL	OP%AED,4	;ALPHANUMERIC-EDITED
	SETVAL	OP%NED,5	;NUMERIC-EDITED
	RADIX 8

;CONSTANTS USED BY B,C,D,E,F,G

	IFN MLOAD&BCDEFG!ONESEG,<

	SETUP TABCOD,<POINT 3,0(DT),2>	;TABLE CODE IN MAJOR TABLES

	SETUP PTSEGN,<POINT 7,2(DT),24>	;SEGMENT NUMBER FOR PROTAB
	SETVAL PTFLAG,2		;PROTAB WORD WHICH CONTAINS FLAGS

	>

;HERE TO KEEP LINK HAPPY WHILE LOADING CBL74 AND CBL74D
IFE ONESEG,<
 IFN MLOAD&BD.,<
	SETUP	PSCAN,<HALT>	;CAN NEVER GET HERE
>>
;ASSEMBLY CODES

	IFN MLOAD&BCDEFG!ONESEG,<

	SETVAL AC.CNS,0	;ADDRESS IS A CONSTANT .LT. 100000
	SETVAL AC.DAT,1	;ADDRESS IS A DATA-NAME
	SETVAL AC.PRO,2	;ADDRESS IS A PROCEDURE NAME
	SETVAL AC.EXT,3	;ADDRESS IS AN EXTERNAL NAME
	SETVAL AC.FIL,4	;ADDRESS IS A FILE-NAME
	SETVAL AC.TAG,5	;ADDRESS IS A TAG (%N)
	SETVAL AC.CNB,6	;ADDRESS IS A CONSTANT .GT. 77777
	SETVAL AC.MSC,7	;ADDRESS IS MISCELLANEOUS

	SETVAL AC.MS1,71 ;ADDRESS IS EXTENDED MISCELLANEOUS.
	SETVAL AC.MS2,72 ;ADDRESS IS MISC WITH NEGATIVE INCREMENT

	SETVAL AS.CNS,<AC.CNS*1B20>
	SETVAL AS.DAT,<AC.DAT*1B20>
	SETVAL AS.PRO,<AC.PRO*1B20>
	SETVAL AS.EXT,<AC.EXT*1B20>
	SETVAL AS.FIL,<AC.FIL*1B20>
	SETVAL AS.TAG,<AC.TAG*1B20>
	SETVAL AS.CNB,<AC.CNB*1B20>
	SETVAL AS.MSC,<AC.MSC*1B20>

	SETVAL AS.MS1,<AC.MS1*1B23>
	SETVAL AS.MS2,<AC.MS2*1B23>

	SETVAL AC.ABS,0	;INCREMENT IS ABSOLUTE NUMBER
	SETVAL AC.PAR,1	;INCREMENT TO %PARAM
	SETVAL AC.FLS,2	;FILES.
	SETVAL AC.LIT,3	;INCREMENT TO %LIT
	SETVAL AC.GO,4	;GOTO.
	SETVAL AC.DOT,5	;CURRENT PC
	SETVAL AC.TMP,6	;INCREMENT TO %TEMP
	SETVAL AC.ALT,7	;INCREMENT TO %ALT

	SETVAL AC.BSA,0 ;BASE ADDRESS OF PROGRAM
	SETVAL AC.PFF,1 ;IF LISTING ASSEMBLED CODE, PUT OUT A FORM FEED HERE.

	SETVAL AS.ABS,<AC.ABS*1B20>
	SETVAL AS.PAR,<AC.PAR*1B20>
	SETVAL AS.FLS,<AC.FLS*1B20>
	SETVAL AS.LIT,<AC.LIT*1B20>
	SETVAL AS.GO,<AC.GO*1B20>
	SETVAL AS.DOT,<AC.DOT*1B20>
	SETVAL AS.TMP,<AC.TMP*1B20>
	SETVAL AS.ALT,<AC.ALT*1B20>

	SETVAL AS.BSA,AC.BSA
	SETVAL AS.PFF,AC.PFF
	SETVAL LAS.M1,AS.PFF ;LAST EXTENDED MISCELLANEOUS OF TYPE 1.
	SETVAL AS.BYT,4B20	;BYTE POINTER
	SETVAL AS.XWD,5B20	;XWD
	SETVAL AS.ASC,6B20+1B21	;ASCII
	SETVAL AS.SIX,6B20+1B22	;SIXBIT
	SETVAL AS.D1,6B20+1B23	;1-WORD DECIMAL
	SETVAL AS.D2,6B20+1B24	;2-WORD DECIMAL
	SETVAL AS.FLT,6B20+1B25	;COMP-1
	SETVAL AS.OCT,6B20+1B26	;OCTAL
	SETVAL AS.EBC,6B20+1B27	;EBCDIC

	SETVAL AS.PN,7B20+1B21	;PROCEDURE NAME
	SETVAL AS.%X,7B20+1B22	;TAG DEFINITION
	SETVAL AS.REL,7B20+1B23	;RELOC
	SETVAL AS.ENT,7B20+1B24	;ENTRY
	SETVAL AS.SMC,7B20+1B25 ;SPECIAL MISCELLANEOUS STUFF.

	>
;TABLE OF PRESET EXTERNAL NAMES

	IFN	MLOAD&ADEFG.!ONESEG,<

	NUMEXT==0
	USRNO==0
	USRFLG==0

	DEFINE EXTAB (X),<
	IFN MLOAD&A.!ONESEG,<
	SIXBIT "X"
	>
	IFN MLOAD&EOG.!ONESEG,<
	SETVAL X,NUMEXT*2+AS.EXT+1
	>
	NUMEXT==NUMEXT+1
IFN USRFLG,<USRNO==USRNO+1>
	>

	DEFINE OLDUUO (X,Y),<
	IFN MLOAD&A.!ONESEG,<
	SIXBIT "X'.'Y"
	>
	IFN MLOAD&EOG.!ONESEG,<
	SETVAL X'%'Y,NUMEXT*2+AS.EXT+1
	>
	NUMEXT==NUMEXT+1
IFN USRFLG,<USRNO==USRNO+1>
	>

	DEFINE	NEWPJ	(X,Y)<OLDUUO	(X,Y)>

EXTNAM:

USR:	USRFLG==1		;ALL EXTERNALS NOW - NO MORE UUO'S

	OLDUUO	FIX,
	OLDUUO	PERF,
	IFN MLOAD&D.!ONESEG,<SETVAL PERF%,NUMEXT*2+AS.EXT-1>
	OLDUUO	FLOT,2
	OLDUUO	PD6,
	OLDUUO	PD7,
	OLDUUO	GD6,
	OLDUUO	GD7,
	OLDUUO	MUL,12
	OLDUUO	MUL,21
	OLDUUO	MUL,22
	OLDUUO	DIV,11
	OLDUUO	DIV,12
	OLDUUO	DIV,21
	OLDUUO	DIV,22
	OLDUUO	C,OPEN
	OLDUUO	C,CLOS
	OLDUUO	DSPLY,
	OLDUUO	ACEPT,
	OLDUUO	READ,
	OLDUUO	WRITE,
	OLDUUO	WADV,
	OLDUUO	RDNXT,
	OLDUUO	DELET,
	OLDUUO	RERIT,
	OLDUUO	PURGE,
	OLDUUO	INIT,
	OLDUUO	TERM,
	OLDUUO	DSPL,6
	OLDUUO	DSPL,7
	OLDUUO	COMP,
	OLDUUO	CMP,76
	OLDUUO	NUM,6
	OLDUUO	ALF,6
	OLDUUO	ZERO,6
	OLDUUO	POS,6
	OLDUUO	NEG,6
	OLDUUO	NUM,7
	OLDUUO	ALF,7
	OLDUUO	ZERO,7
	OLDUUO	POS,7
	OLDUUO	NEG,7
	OLDUUO	COMP,D		;OBSOLETE
	OLDUUO	MOVE,
	OLDUUO	C,D6D7
	OLDUUO	C,D7D6
	OLDUUO	CMP,E
	OLDUUO	CMP,G
	OLDUUO	CMP,GE
	OLDUUO	CMP,L
	OLDUUO	CMP,LE
	OLDUUO	CMP,N
	OLDUUO	EDIT,S
	OLDUUO	EDIT,U
	OLDUUO	INSP,
	OLDUUO	SUBSC,
	OLDUUO	SIZE,1
	OLDUUO	SIZE,2
	OLDUUO	SIZE,3
	OLDUUO	E,C3C1
	OLDUUO	E,C3C3
	OLDUUO	OVLAY,
	OLDUUO	C,EXIT
	OLDUUO	ARGS,
	OLDUUO	PUTF,
	OLDUUO	RESF,
	OLDUUO	GETNM,
	OLDUUO	ILLC,
	
	NEWPJ	C,D6D9
	NEWPJ	C,D7D9
	NEWPJ	C,D9D6
	NEWPJ	C,D9D7
	NEWPJ	PC3,
	NEWPJ	PD9,
	NEWPJ	GC3,
	NEWPJ	GD9,
	NEWPJ	POS,9
	NEWPJ	NEG,9
	NEWPJ	ZERO,9
	NEWPJ	ALF,9
	NEWPJ	NUM,9
	NEWPJ	CMP,96
	NEWPJ	CMP,97
;;	NEWPJ	MUL,41
;;	NEWPJ	MUL,42
	NEWPJ	DIV,41
	NEWPJ	DIV,42
	NEWPJ	NUM,3		;COMP-3 NUMERIC TEST

	EXTAB C.RSET
	EXTAB STOPR.
	EXTAB C.STOP
	EXTAB KILL.
	EXTAB GOTO.
	EXTAB KDECL.
	EXTAB KPROG.
	EXTAB SZERA.
	EXTAB PSORT.
	EXTAB RELES.
	EXTAB RETRN.
	EXTAB MERGE.
	EXTAB ENDS.
	EXTAB KEY.
	EXTAB PMERG.
	EXTAB MCLOS.
	EXTAB DSP.FP
	EXTAB DSP.F2
	EXTAB OVFLO.
	EXTAB LINE.C
	EXTAB LINE.D
	EXTAB LINE.H
	EXTAB LIN.RH
IFN MCS,<
	EXTAB	M.INIT
	EXTAB	M.RMW
	EXTAB	M.RSW
	EXTAB	M.RMNW
	EXTAB	M.RSNW
	EXTAB	M.SEND
	EXTAB	M.AC
	EXTAB	M.IFM
	EXTAB	M.DI
	EXTAB	M.DIT
	EXTAB	M.DO
	EXTAB	M.EI
	EXTAB	M.EIT
	EXTAB	M.EO
	>
	EXTAB	STR.
	EXTAB	STR.O
	EXTAB	UNS.
	EXTAB	UNS.O
; LIBOL LOW SEG LOCS FOR STRING THAT COBOL PROGRAMS KNOW ABOUT
	EXTAB	OU.TMP
	EXTAB	DST.BP
	EXTAB	DST.CC
	EXTAB	PT.VAL
	EXTAB	SRC.BP
	EXTAB	SRC.CC
	EXTAB	SR.TMP
	EXTAB	DLM.BP
	EXTAB	DLM.CC
	EXTAB	TMP.DL
	EXTAB	TL.VAL
	EXTAB	CT.VAL
	EXTAB	C.STRT
	EXTAB	DATE.
	EXTAB	DAY.
	EXTAB	TIME.
	EXTAB	CANCL.
	EXTAB	S.CALL;		;CALL TO RUNTIME NAMED SUBROUTINE
	EXTAB	EDIT.B;		;BIS EDIT ROUTINE
	EXTAB	PUTF$;		;PUTF WHEN $ HAS BEEN CHANGED
	EXTAB	RESF$;		RESF WHEN "$" HAS BEEN CHANGED
	EXTAB	LFENQ.
	EXTAB	LRENQ.
	EXTAB	LRDEQ.
	EXTAB	(CNTAI.)		;NON-DBMS PART OF COMPOUND RETAIN
	EXTAB	PTFLG.
	EXTAB	C.TRCE
	EXTAB	CBDDT.
	EXTAB	COBST.
	EXTAB	LEVEL.
	EXTAB	TRAC1.
	EXTAB	TRAC2.
	EXTAB	TRAC3.

IFN DBMS,<
	EXTAB	SETCON
	EXTAB	RECMEM
	EXTAB	RECOWN
	EXTAB	RECMO
	EXTAB	INITDB
	>


DEFINE EXTABN(DBROUT),<
	EXTAB	DBROUT
	IFN MLOAD&D.!ONESEG,<%'DBROUT==:500000+NUMEXT*2-1>
	>

IFN DBMS,<
	EXTABN CLOSED
	IFN DBMS6,<EXTABN (CLOTR)>
	EXTABN	STORED
	EXTABN INSRT
	EXTABN	MODIF
	EXTABN GETS
	EXTABN REMOV
	EXTABN DELETR
	IFN DBMS6,<EXTABN (DELTR)>
	EXTABN	MOVEC
	EXTABN	FIND1
	EXTABN	FIND2
	EXTABN	FIND3
	EXTABN	FINDO		;SEP OUT FIND OFFSET.
	EXTABN	FIND4
	EXTABN	FIND5
	IFN DBMS6,<EXTABN (FIND6)>
	EXTABN	OPEND
	IFN DBMS6,<EXTABN (OPENT)>
	EXTABN	SBIND
	EXTABN	BIND
	EXTABN	RCLAIM
	EXTABN	DBMLOK		; LIBOL location used as arg to INITDB
	>

	EXTAB	SUBE1.		;INLINE SUBSCRIPT ERROR ROUTINES
	EXTAB	SUBE2.
	EXTAB	SUBE3.
	EXTAB	EXIT.E		;INLINE ERROR FROM PERFORM EXIT
	EXTAB	XTND.E		;INLINE ERROR FROM EXTEND INST
	EXTAB	ALP.66		;SIXBIT TO SIXBIT CONVERSION TABLE
	EXTAB	ALP.67		;SIXBIT TO ASCII ...
	EXTAB	ALP.69		;SIXBIT TO EBCDIC ...
	EXTAB	ALP.76		;ASCII TO SIXBIT ...
	EXTAB	ALP.77		;ASCII TO ASCII
	EXTAB	ALP.79		;ASCII TO EBCDIC ...
	EXTAB	ALP.96		;EBCDIC TO SIXBIT ...
	EXTAB	ALP.97		;EBCDIC TO ASCII ...
	EXTAB	ALP.99		;EBCDIC TO EBCDIC
	EXTAB	ALPS.6		;ALPHABETIC SIXBIT
	EXTAB	ALPS.7		;ALPHABETIC ASCII
	EXTAB	ALPS.9		;ALPHABETIC EBCDIC
	EXTAB	NUM.66		;NUMERIC SIXBIT TO SIXBIT
	EXTAB	NUM.67		;NUMERIC SIXBIT TO ASCII
	EXTAB	NUM.69		;NUMERIC SIXBIT TO EBCDIC
	EXTAB	NUM.76		;NUMERIC ASCII TO SIXBIT
	EXTAB	NUM.77		;NUMERIC ASCII TO ASCII
	EXTAB	NUM.79		;NUMERIC ASCII TO EBCDIC
	EXTAB	NUM.96		;NUMERIC EBCDIC TO SIXBIT
	EXTAB	NUM.97		;NUMERIC EBCDIC TO ASCII
	EXTAB	NUM.99		;NUMERIC EBCDIC TO EBCDIC
	EXTAB	CVTDB.		;BIS CONVERT DECIMAL TO BINARY
	EXTAB	CBDOV.		;OVERFLOW ROUTINE TO CONVERT BINARY-DECIMAL
	EXTAB	CVBD.6		;LIBOL TRANSLATION TABLES
	EXTAB	CVBD.7		; FOR BINARY-DECIMAL CONVERSION
	EXTAB	CVBD.9
	EXTAB	E0.6		;LIBOL SIXBIT EDIT TABLE
	EXTAB	E0.7		;LIBOL ASCII EDIT TABLE
	EXTAB	E0.9		;LIBOL EBCDIC EDIT TABLE
	EXTAB	E0.6.1		;E0.6+1
	EXTAB	E0.7.1		;E0.7+1
	EXTAB	E0.9.1		;E0.9+1
	EXTAB	DVI41.		;FOR 4-WD DIVIDE, SAVING REMAINDER IN 1ST
	EXTAB	DVI42.		; OPERAND

	EXTAB	ADD.4R		;[570] QUAD-WORD ROUNDING FUNCTION
IFN MCS,<
 IFN TOPS20,<
	EXTAB	MBIND
	EXTAB	MNAME
 >
>;END IFN MCS
	EXTAB	MVD.AL		;MOVE ALL "LIT" TO DEPENDING VARIABLE
	EXTAB	WADVV.		;WRITE ADVANCING, VARIABLE LENGTH RECORDS
	EXTAB	WRITV.		;WRITE, VARIABLE LENGTH RECORDS
	EXTAB	SIZE.4		;[634] 4-WORD SIZE ERROR CHECKS
	EXTAB	SIZE.5		;[634] . .
	EXTAB	FLT.12		;FLOAT 1-WORD COMP TO COMP-2
	EXTAB	FLT.22		;FLOAT 2-WORD COMP TO COMP-2
	EXTAB	FLT.42		;FLOAT 4-COMP TO COMP-2
	EXTAB	FIX.2		;FIX COMP-2 TO 2-WORD COMP
	EXTAB	E.F2D1		;EXPONENTIATE, BASE COMP-2, POWER 1-WORD COMP
	EXTAB	E.F2D2		;EXPONENTIATE, BASE COMP-2, POWER 2-WORD COMP
	EXTAB	E.F2FP		;EXPONENTIATE, BASE COMP-2, POWER COMP-1
	EXTAB	E.F2F2		;EXPONENTIATE, BASE COMP-2, POWER COMP-2
	EXTAB	PPOT4.;;	;USED BY COBDDT TO PRINT WHERE WE ARE
	EXTAB	ISBPS.;;	;USED BY COBDDT TO INCREMENT SBPSA.
	EXTAB	DEBST.;;	;INITIALIZE DEBUG MODULE ENTRY POINT
	EXTAB	DEBUG.;;	;-1 IF DEBUGGING WANTED, 0 OTHERWISE
	EXTAB	DBALT.;;	;DEBUG MODULE ALTER STATEMENT
	EXTAB	DBIO.;;		;DEBUG MODULE I/O STATEMENTS (OPEN, CLOSE)
	EXTAB	DBRD.;;		;DEBUG MODULE READ STATEMENT
	EXTAB	DBCD.;;		;DEBUG MODULE CD-NAME
	EXTAB	DBDA.;;		;DEBUG MODULE DATA-NAME

;RMS ENTRY POINTS DEFINED IN 12B
	EXTAB	OP.MIX;;	;OPEN RMS INDEXED FILE
	EXTAB	CL.MIX;;	;CLOSE RMS INDEXED FILE
	EXTAB	WT.MIR;;	;WRITE RMS INDEXED, ACCESS RANDOM
	EXTAB	WT.MIS;;	;WRITE RMS INDEXED, ACCESS SEQ.
	EXTAB	WT.MSV;;	;WRITE RMS SEQ ASCII STM VAR LENGTH REC
	EXTAB	RD.MIR;;	;READ RMS INDEXED, ACCESS RANDOM
	EXTAB	RD.MIS;;	;READ RMS INDEXED, ACCESS RANDOM
	EXTAB	DL.MIR;;	;DELETE RMS INDEXED, ACCESS RANDOM
	EXTAB	DL.MIS;;	;DELETE RMS INDEXED, ACCESS SEQUENTIAL
	EXTAB	RW.MIR;;	;REWRITE RMS INDEXED, ACCESS RANDOM
	EXTAB	RW.MIS;;	;REWRITE RMS INDEXED, ACCESS SEQUENTIAL
	EXTAB	ST.MEQ;;	;START RMS FILE, EQUAL
	EXTAB	ST.MGT;;	;START RMS FILE, KEY GREATER
	EXTAB	ST.MNL;;	;START RMS FILE, KEY NOT LESS THAN

	EXTAB	SWT.ON;;	;SOFTWARE SWITCH ON TEST
	EXTAB	SWT.OF;;	;SOFTWARE SWITCH OFF TEST
	EXTAB	CMP.67;;	;[1004] COMPARE SIXBIT TO ASCII IN EBCDIC.
	EXTAB	CMP.69;;	;[1004] COMPARE SIXBIT TO EBCDIC IN ASCII.
	EXTAB	CMP.79;;	;[1004] COMPARE ASCII  TO EBCDIC IN ASCII.
	EXTAB	COMP.6;;	;[1004] COMPARE TWO SIXBIT FIELDS IN EBCDIC.
	EXTAB	COMP.7;;	;[1004] COMPARE TWO ASCII  FIELDS IN EBCDIC.
	EXTAB	COMP.9;;	;[1004] COMPARE TWO EBCDIC FIELDS IN ASCII.
	EXTAB	SU.S69;;	;[1004] POINTER TO CONVERTION TABLE FOR SIXBIT TO EBCDIC
	EXTAB	SU.S79;;	;[1004] POINTER TO CONVERTION TABLE FOR ASCII  TO EBCDIC
	EXTAB	SU.S97;;	;[1004] POINTER TO CONVERTION TABLE FOR EBCDIC TO ASCII
	EXTAB	CVDBT.;;	;[12B] CONVERT D TO B, TRAILING SEP. SIGN
	EXTAB	CVDBL.;;	;[12B] CONVERT D TO B, LEADING SEP. SIGN

	EXTAB	D.O.W.;;	;DAY-OF-WEEK routine
	EXTAB	SSW.ON;;	;SET SOFTWARE SWITCH ON
	EXTAB	SSW.OF;;	;SET SOFTWARE SWITCH OFF
	EXTAB	ALPL.7		;LOWER-CASE ALPHABETIC ASCII
	EXTAB	ALPL.9		;LOWER-CASE ALPHABETIC EBCDIC
	EXTAB	ALPU.7		;UPPER-CASE ALPHABETIC ASCII
	EXTAB	ALPU.9		;UPPER-CASE ALPHABETIC EBCDIC
	EXTAB	INITL.		;Routine to re-initialize subroutine data

; THESE POINTERS ARE IN EASTBL.MAC, ALL USE AC1 INDIRECTLY
	EXTAB	IPT671		;SIXBIT TO ASCII
	EXTAB	IPT691		;SIXBIT TO EBCDIC
	EXTAB	IPT791		;ASCII TO EBCDIC
	EXTAB	IPT971		;EBCDIC TO ASCII

	IFN MLOAD&A.!ONESEG,<
	SETUP EXTPTR,<XWD -NUMEXT,EXTNAM>
	>

	SETVAL NUMEXT,<<NUMEXT-USRNO>*2>

	>
;CONSTANTS USED BY PHASE F

	IFN MLOAD&F.!ONESEG,<

	SETUP ERALNA,<POINT 14,DW,14>;	LINE NUMBER IN "DW" PLUS "IMBED" BIT

>

;CONSTANTS USED BY PHASE G

	IFN MLOAD&OG.!ONESEG, <

	SETUP	ASOP,<POINT 7,W1,8>;	INSTRUCTION OP-CODE
	SETUP	INCTYP,<POINT 3,W2,20>;	INCREMENT CODE TYPE
	SETUP	ADRTYP,<POINT 3,W1,20>;	ADDRESS CODE TYPE
	SETUP	MSC.CL,<POINT 3,W1,23>; EXTENDED MISCELLANEOUS TYPE

>

	END