Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/comuni.mac
There are 16 other files named comuni.mac in the archive. Click here to see a list.
; UPD ID= 1514 on 1/30/84 at 6:18 PM by HOFFMAN                         
UNIVERSAL COMUNI.MAC FOR COBOL COMPILER AND OTS VERSION 13
SUBTTL	COMMON UNIVERSAL FILE FOR COBOL AND COBOTS

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

.DIRECTIVE .NOBIN
;V12B*******
;RLF	18-Jan-84	[1106] Define location for NON /R
;JEH	08-Nov-83	[1102] Add location to hold TOPS20 monitor version flag
;SMI	20-May-83	[1066] Fix tape GTJFN to include format
;EGM	09-MAR-83	[1056] Prevent inclusion of DBCS for non DBMS progs.
;V12A*******
;DMN	 3-JUN-80	[635] INCORPORATE MCS-10 FIXES FROM B.C.TEL.
;DMN	 1-APR-80	[624] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DMN	24-MAR-80	[623] DON'T DEFINE DBSTP$ WHEN DBMS IS OFF.
;DAW	29-FEB-80	[621] MAKE MROUT. AN ENTRY POINT
;V12******
;HAM	27-FEB-79	[556] ADD SHARED BUF AREA WITH ISAM FLAG
;DAW	20-FEB-79	[554] ADD QUAD-WORD SIZE ERROR ROUTINES
;MFY	24-JAN-78	[551] FIX E0.6.1,E0.7.1,E0.9.1 NOT FOUND IN /R CASE
;DMN	 6-OCT-78	[540] ADD QUAD-WORD ROUNDING FUNCTION
;DMN	19-SEP-78	[537] ADD TMP.DP FOR STRNGL (BROKEN BY EDIT 521)
;EHM	13-JUN-78	[530] ADD LOCATION TO INDICATE WHEN END OF RESET

;V10******
;	21-FEB-78	[523] ADD ARG-BLK FOR FILOP. .FOURB
;	08-DEC-77	[520] ADD SWITCHES LOCATION FOR DBMS LIB
;	30-DEC-76	[470] ADD ANOTHER MTAPE FUNCTION
;	02-SEP-76	[455] ADD LOCS FOR SIMUL. READ OF RANDOM FILES WITH KEY OF 0
;	27-AUG-76	[454] ADD ZERO CHAR ROUTINES
;	16-AUG-76	[447] ADD LOC TO MARK HIGH VALUES FOR SIMUL UPDATE
;	11-AUG-76	[445] ADD TEMP FOR SIMUL READS OF DISPLAY NUMERIC KEYS
;SSC	2-AUG-76	ADD SU.DBR SO DBMS/LIBOL COMMUN TO AVOID DEADLY EMBRACE
; [431] TOPS20 EDITS
;	5/15/75		/DBT	BIS ADDITIONS
;************

	SEARCH	INTERM
	MCS==:MCS
	DBMS==:DBMS
	TOPS20==:TOPS20
	IFE TOPS20,< SEARCH UUOSYM >


;COMUNI.MAC EDIT NO
%%COMUNI==2

;STARTING ADDRESSES FOR LIBOL.SHR  HIGH AND LOW SEGMENTS
;THESE NUMBERS ARE REQUIRED FOR COMMUNICATION BETWEEN LIBOL AND
;COMPILER PROGRAMS

IFE TOPS20,<HI.ORG==400000	;START OF HIGH SEGMENT OF LIBOL>
IFN TOPS20,<HI.ORG==600000	;START OF HIGH SEGMENT OF LIBOL>

	HI.PUR==HI.ORG+10	;FIRST ABSOLUTE ADDRESS OF LIBOL.EXE
	LO.PUR==140		;FIRST ABSOLUTE ADDRESS OF LIBOL.LOW

IFE TOPS20,<
;PAGE RANGES OF RMS-10
	RMS.FP==526		;FIRST PAGE OF RMS
	RMS.LP==571		;LAST PAGE OF RMS
	RMS$10==:526010		;[1106] DEFINE LOCATION FOR NON /R
>
;THE FOLLOWING SERIES OF MACROS DEFINES THE LOW SEGMENT
;
;	ELMT%% IS A MACRO WITH PARAMETERS  NAME,LENGTH,VALUE
;		NAME	-	LOCATION NAME 
;		LENGTH	-	LENGTH IN WORDS
;		VALUE	-	CONTENTS OF LOCATION
;
;	ALL OF THE PARAMETERS ARE OPTIONAL  THE DEFAULT OF LENGTH IS 1

;	ELMT%% IS REDEFINED ACCORDING TO WHAT ONE WISHES TO KNOW ABOUT
;	THE LOW SEGMENT.
;
;	SYMH%% AND SYML%% ARE MACROS WITH PARAMETERS NAME,VALUE
;		NAME AND VALUE ARE REQUIRED.  THE MACROS ARE REDEFINED IN
;		THE SAME FASHION AS ELMT%%
;		SYMH%%	-	HIGH SEG SYMBOL
;		SYML%%	-	LOW SEG SYMBOL

;
; THE FOLLOWING MACRO DEFINES THE LIBOL LOW SEGMENT LOCATIONS
; WHICH ARE REFERENCABLE AS EXTERNALS BY ROUTINES OUTSIDE OF THE
; LIBOL HIGH SEGMENT.  SYMBOLS TO RESOLVE THE EXTERNAL REFERENCES ARE
; GENERATED BY LILOWS.MAC VIA A REFEENCE TO LOWAD% MACRO.
; THESE ARE THE ONLY EXTERNALLY REFERENCABLE LIBOL LOW SEGMENT 
; ADDRESSES.
;
; ANY ADDITIONAL SUCH LOCATIONS MUST BE ADDED AT THE END OF THE 
; CURRENT SET.  CHANGING THE RELATIVE POSITION OR REMOVING ANY OF
;  THE EXISTING ITEMS WILL PRODUCE INCOMPATABILITIES WITH
; PREVIOUSLY COMPILED AND/OR LOADED COBOL PROGRAMS

;AS OF VERSION 12 THIS IS NO LONGER TRUE
;THE SYMBOLS E0.6, E0.7, AND E0.9 ARE KNOWN TO THE COMPILER ALSO.
;THUS IT IS NO LONGER POSSIBLE TO ADD NEW LOCATIONS TO VISBL%
;NEW ONES MUST BE ADDED AFTER E0.9 

; INITIALIZATION:
;
; THESE LOCATIONS ARE INITIALIZED BY LOADING LILOWS OR LIBREL
; OR BY COBST.


DEFINE	VISBL%<

	ELMT%%	MEMRY%,1;;	POINTER TO MEMRY. - INITIALIZED IN CBLIO
	ELMT%%	SZERA.,1,<Z>;;		"SIZE ERROR" INDICATOR
	ELMT%%	OVFLO.,1,<Z>;;		OVERFLOW INDICATOR

	ELMT%%	TRAC1.,1,<JRST	BTRAC.##>;;	POINTER TO TRACE ROUTINE
	ELMT%%	TRAC2.,1,<JRST	TRPOP.##>;;	POINTER TO TRACE ROUTINE
	ELMT%%	TRAC3.,1,<JRST	TRPD.##>;;	POINTER TO TRACE ROUTINE

	ELMT%%	OPNCH.,1,<XWD	777774,0>;;	OPEN OR CLOSE DEVICE CHANNEL STATUS
	ELMT%%	RN.DEV,1;;		[333] DEVICE FOR OVERLAY FILE
	ELMT%%	RN.PPN,1;;		[333] PPN FOR OVERLAY FILE
	ELMT%%	RN.NAM,1;;		[346] RUN NAME.
	ELMT%%	FSLOC.,1,<Z>;;		[346] FIRST LOCATION USED BY SORT.
	ELMT%%	HLOVL.,1,<Z>;;		[346] HIGH,,LOW LIMITS ON FREE CORE.

	ELMT%%	%REMOV,1,<EXP	REMOV.##>;;		ADDRESS OF REMOV.
	ELMT%%	%ENTOV,1,<EXP	ENTOV.##>;;		ADDRESS OF ENTOV.

	ELMT%%	KEYCV.,1,<Z>;;
	ELMT%%	SAVEF.,1,<Z>;;		;PLACE TO SAVE .JBFF WHILE DOING
;;					; A SORT.  NEED TO PUT IT HERE
;;					; SO THAT COBDDT CAN REFERENCE
;;					; IT IF LINK-10 OVERLAYS ARE ACTIVE.
	ELMT%%	HPRT.,1,<EXP	HSRPT.##>;;	;POINTER TO HISTOGRAM
						; PRINTING ROUTINE.
	ELMT%%	SEGNO.,1,<Z>;;		;CURRENT SEGMENT NUMBER.
	ELMT%%	SNRBP.,1,<EXP	SBPSG.##>;;	;POINTER TO COBDDT ROUTINE
;;						; TO SET BREAKPOINTS IN
;;						; NON RESIDENT SEGMENTS.
	ELMT%%	TRAC4.,1,<EXP	CNTRC.##>;;	;POINTER TO TRACE ROUTINE.
	ELMT%%	CIOTF.,1,<EXP	SFOV.##>;;	;POINTER TO COBDDT'S ROUTINE
;;						; TO INITIALIZE LINK-10 OVERLAYS.
	ELMT%%	LEVEL.,1,<Z>;;		;[623] PERFORM DEPTH
	ELMT%%	DBSTP.,1,<EXP	%DBSTP##>;;	;[1056]POINTER TO DBMS CLEANUP
;;					;[1056] ROUTINE, REVOLVES TO DBSTP$
	ELMT%%	SLRSW.,1,<Z>;;		;SET TO -1 IF PROGRAM COMPILED /R
	ELMT%%	RMFLG.,1,<Z>;;		;SET TO -1 IF RMS IS NEEDED

	ELMT%%	E0.6,1,<EDIT	0>;;	SIXBIT E0 TABLE
	ELMT%%	E0.6.1,1,<0>;;		[551] FILL CHAR
	ELMT%%	,1,<0>;;		FLOAT CHAR
	ELMT%%	,1,<"$"-40>
	ELMT%%	,1,<","-40>;;
	ELMT%%	,1,<"."-40>;;
	ELMT%%	,1,<" "-40>;;
	ELMT%%	,1,<"0"-40>;;
	ELMT%%	,1,<"+"-40>;;
	ELMT%%	,1,<"-"-40>;;
	ELMT%%	,1,<"C"-40>;;
	ELMT%%	,1,<"R"-40>;;
	ELMT%%	,1,<"D"-40>;;
	ELMT%%	,1,<"B"-40>;;
	ELMT%%	,1,<"/"-40>;;

	ELMT%%	E0.7,1,<EDIT	0>;;	ASCII E0 TABLE
	ELMT%%	E0.7.1,1,<0>;;		[551] FILL CHAR
	ELMT%%	,1,<0>;;		FLOAT CHAR
	ELMT%%	,1,<"$">
	ELMT%%	,1,<",">;;
	ELMT%%	,1,<".">;;
	ELMT%%	,1,<" ">;;
	ELMT%%	,1,<"0">;;
	ELMT%%	,1,<"+">;;
	ELMT%%	,1,<"-">;;
	ELMT%%	,1,<"C">;;
	ELMT%%	,1,<"R">;;
	ELMT%%	,1,<"D">;;
	ELMT%%	,1,<"B">;;
	ELMT%%	,1,<"/">;;

	ELMT%%	E0.9,1,<EDIT	0>;;	EBCDIC E0 TABLE
	ELMT%%	E0.9.1,1,<0>;;		[551] FILL CHAR
	ELMT%%	,1,<0>;;		FLOAT CHAR
	ELMT%%	,1,<133>;;
	ELMT%%	,1,<153>;;
	ELMT%%	,1,<113>;;
	ELMT%%	,1,<100>;;
	ELMT%%	,1,<360>;;
	ELMT%%	,1,<116>;;
	ELMT%%	,1,<140>;;
	ELMT%%	,1,<303>;;
	ELMT%%	,1,<331>;;
	ELMT%%	,1,<304>;;
	ELMT%%	,1,<302>;;
	ELMT%%	,1,<141>;;

;;NEW LOCATIONS REQUIRED FOR STRING/UNSTRING REWRITE
	ELMT%%	OU.TMP,5		;FOR STRING
	ELMT%%	DST.BP,1		;DESTINATION BYTE POINTER
	ELMT%%	DST.CC,1		;DESTINATION CHAR COUNT
	ELMT%%	PT.VAL,1		;'POINTER' VALUE
	ELMT%%	SRC.BP,1		;SOURCE BYTE PTR
	ELMT%%	SRC.CC,1		;CC OF SOURCE
	ELMT%%	SR.TMP,5		;TEMP HOLD FOR NUMERIC SOURCE
	ELMT%%	DLM.BP,1		;BYTE PTR TO DELIMITER
	ELMT%%	DLM.CC,1		;CC OF DELIMITER
	ELMT%%	TMP.DL,5		;TEMP HOLD FOR NUMERIC DELIMITER
	ELMT%%	TL.VAL,1		;TALLY VALUE
	ELMT%%	CT.VAL,1		;COUNT VALUE
IFN DBMS,<				; make DBMLOK visible at link time
	ELMT%% DBMLOK,1;;		SET TO -1 ON FIRST DBMS CALL
>;;END OF IFN DBMS

;;Add new items here
> ; end VISBL%
SUBTTL	HEADER BLOCK OF COBOL PROGRAMS


; DEFINITION OF THE INFORMATION HEADER BLOCK GENERATED
; AT THE BEGINNING OF EACH COBOL PROGRAM

DEFINE	INFBK% <
	ELMT%%	FILES.;;	FILES.
	ELMT%%	USES.;;		USES.
	ELMT%%	SEGWD.;;	SEGWD.
	ELMT%%	ALTER.;;	ALTER.
	ELMT%%	OVRFN.;;	OVRFN.
	ELMT%%	POINT.;;	POINT.
	ELMT%%	COMMA.;;	COMMA.
	ELMT%%	MONEY.;;	MONEY.
	ELMT%%	MEMRY.;;	MEMRY.	
	ELMT%%	%NM.;; 
	ELMT%%	%DT.;;	 
	ELMT%%	%PR.;;	 
	ELMT%%	COBVR.;;	COMPILER VERSION NUMBER
	ELMT%%	COBSW.;;	COMPILER FEATURE TEST SWITCHES
	ELMT%%	PUSHL.;;	SIZE OF THE PUSH DOWN LIST
	ELMT%%	SURRT.;;	SIZE OF THE RETAINED RECORDS TABLE
	ELMT%%	SUEQT.;;	SIZE OF THE ENQUEUE/DEQUEUE TABLES
	ELMT%%	SUFBT.;;	SIZE OF THE FILL/FLUSH BUFFER TABLE
	ELMT%%	%DB.;;		DEBUG-ITEM
>


; DEFINE THE VALUE OF FIXNUM AS THE LENGTH OF THIS AREA

	FIXNUM==0
DEFINE	ELMT%%	(N%,L<1>,V) <
	FIXNUM==FIXNUM+1	>
	INFBK%
	PURGE	ELMT%%

;In COBOL-74 version 12A and earlier FIXNUM was one word less (%DB.)
;Define FIXNMA to be the previous size of FIXNUM so that old programs
;can run with 12B OTS.

	FIXNMA==FIXNUM-1
SUBTTL	PRESET SECTION OF LIBOL LOW SEGMENT

DEFINE	PREST%	<
	SYML%%	IFRST.,.;;	LOW SEG PRESET POINTER
	SYMH%%	PFRST.,.;;	HIGH SEG PRESET  POINTER

	SYML%%	FRSTIC,.
	ELMT%%	IIN,1,<IN 0,CMDLST	>;;		INDEX FILE UUOS
	ELMT%%	IOUT,1,<OUT 0,CMDLST	>;;		
	ELMT%%	ISETI,1,<USETI 0,(AC1)	>;;		
	ELMT%%	ISETO,1,<USETO 0,(AC1)	>;;		
	ELMT%%	ICLOS,1,<CLOSE 0,0	>;;		
	ELMT%%	IRELE,1,<RELEAS 0,0	>;;		
	ELMT%%	IGETS,1,<GETSTS 0,AC2	>;;		
	ELMT%%	ISETS,1,<SETSTS 0(AC2)>;;
	ELMT%%	IWAIT,1,<CALLI 0,10	>;;		
	ELMT%%	IRNAM,1,<RENAME 0,UEBLK.	>;;		
	SYML%%	LASTIC,<.-1>

	SYML%%	UFRST.,.
	ELMT%%	MWAIT.,1,<MTAPE 0,0	>;;		WAIT
	ELMT%%	MREW.,1,<MTAPE 0,1	>;;		REWIND
	ELMT%%	MREWU.,1,<MTAPE 0,11	>;;		REWIND AND UNLOAD
	ELMT%%	MBSPR.,1,<MTAPE 0,7	>;;		BACKSPACE RECORD
	ELMT%%	MBSPF.,1,<MTAPE 0,17	>;;		BACKSPACE FILE
	ELMT%%	MADVR.,1,<MTAPE 0,6	>;;		ADVANCE RECORD
	ELMT%%	MADVF.,1,<MTAPE 0,16	>;;		ADVANCE FILE
	ELMT%%	MWEOF.,1,<MTAPE 0,3	>;;		WRITE "EOF
	ELMT%%	MTIND.,1,<MTAPE 0,101	>;;		SET INDUSTRY COMPATIBLE MODE FOR EBCDIC
	ELMT%%	MERAS.,1,<MTAPE 0,13	>;;	[470]	WRITE BLANK TAPE ( 3 IN. )
	ELMT%%	SOBOT.,1,<STATO 0,4000	>;;		SKIP IF "BOT"
	ELMT%%	SZBOT.,1,<STATZ 0,4000	>;;		SKIP IF NOT "BOT"
	ELMT%%	SZEOF.,1,<STATZ 0,20000	>;;		SKIP IF NOT "EOF"
	ELMT%%	SZEOT.,1,<STATZ 0,2000	>;;		SKIP IF NOT "EOT"
	ELMT%%	UOPEN.,1,<OPEN 0,UOBLK.	>;;		BLOCK 3 (INITIALZE FOR TTY)
	ELMT%%	UENTR.,1,<ENTER 0,UEBLK.>;;		BLOCK 4
	ELMT%%	ULKUP.,1,<LOOKUP 0,ULBLK.>;;		BLOCK 4
	ELMT%%	UOBUF.,1,<OUTBUF 0,(AC6)>;;		
	ELMT%%	UIBUF.,1,<INBUF 0,(AC6)	>;;		
	ELMT%%	UCLOS.,1,<CLOSE 0,0	>;;		
	ELMT%%	URELE.,1,<RELEAS 0,0	>;;		
	ELMT%%	USETI.,1,<USETI 0,(AC1)	>;;		
	ELMT%%	USETO.,1,<USETO 0,(AC1)	>;;		
	ELMT%%	UOUT.,1,<OUT 0,0		>;;		
	ELMT%%	UIN.,1,<IN 0,0		>;;		
	ELMT%%	USETS.,1,<SETSTS 0,(AC2)	>;;		FROM AC2
	ELMT%%	UGETS.,1,<GETSTS 0,AC2	>;;		INTO AC2
	ELMT%%	UWAIT.,1,<CALLI	0,10	>;;		WAIT UNTIL DEVICE INACTIVE
	ELMT%%	URNAM.,1,<RENAME 0,UEBLK.>;;		RENAME FOR PURGE.
	SYML%%	ULAST.,<.-1>
	SYML%%	ULEN.,<UFRST.-ULAST.>;;			LENGTH OF TABLE NEGATED

	ELMT%%	UOCAL.,1,<EXP C.RSET##+1>;;		RETURN ADR OF LAST COBOL UUO
	ELMT%%	UOBLK.,3,<EXP 0		>;;		OPEN BLOCK
	ELMT%%	TMP.PT,1,<POINT 7,TMP.BK>;; TEMP PTR TO HANDLE V1-V2
IFN TOPS20,<
	ELMT%%  FID.PT,1,<POINT 7,FID.BK>;; [431] POINTER TO TOPS20 FILE DESCRIPTOR
>
	ELMT%%	FUSIA.,2,<EXP 11	>;;		ARG-BLK FOR FILOP. USETI
	ELMT%%	FUSOA.,2,<EXP 12	>;;		ARG-BLK FOR FILOP. USETO
	ELMT%%	FUSCP.,1,<EXP 10	>;;	[523]	ARG-BLK FOR FILOP. .FOURB
	ELMT%%	ARGBK.,6,<EXP 5		>;;		EXTENDED LOOKUP BLOCK
	SYML%%	ILAST.,<.-6>

	>
SUBTTL	NON-PRESET SECTION OF LIBOL LOW SEGMENT

; DEFINE THE NON-PRESET SECTION OF THE LIBOL LOW SEGMENT
; ALL NEW WORDS ADDED TO THIS MACRO MUST CONTAIN A PERIOD.

DEFINE	LIDAT%	<
	ELMT%%	UEBLK.,4;;		ENTER BLOCK
	ELMT%%	ULBLK.,4;;		LOOKUP BLOCK
	ELMT%%	TTOBP.,1;;		TTY BYTE POINTER
	ELMT%%	TTOBC.,1;;		TTY BYTE COUNT
	ELMT%%	TTOBF.,^D27;;		TTY ASCIZ TTCALL BUFFER
	ELMT%%	STDLB.,16;;		STANDARD LABEL IN 6IXBIT

	ELMT%%	RRFLG.,1;;		SET IF RERUN CLAUSE WAS USED
	ELMT%%	REDMP.,1;;		IF NEG FORCE A DUMP
	ELMT%%	SHRDX.,1;;		[556] SHARED ISAM BUF AREA FLAG
	ELMT%%	TEMP.,1;;		
	ELMT%%	TEMP.1,1;;		TEMP.1 MUST = TEMP.+1
	ELMT%%	JSARR.,1;;		.JBSA SAVED FOR RERUN,  LOCATION MUST = TEMP.+2
	ELMT%%	TEMP.2,1;;		TEMP.2
	ELMT%%	AINFO.,1;;		WORK LOCATION FOR OVERLAY
	ELMT%%	OVRBF.,3;;		BUFFER HEADER FOR OVERLAY FILE
IFN TOPS20,<
	ELMT%%	OVRJFN,1;;		JFN OF SEGMENTATION OVERLAY FILE
>
	ELMT%%	FLDCT.,1;;		NUMBER OF THE CURRENT ACCEPT FIELD
	ELMT%%	OVRIX.,1;;		POINTER TO INDEX FOR OVERLAY ROUTINE
	ELMT%%	NOCR.,1;;		DURING A WRITE SKIP <CR> IF -1
	ELMT%%	PRGFLG,1;;		CLOSE FLAG - RENAME TO ZERO IF -1
	ELMT%%	TTYOPN,1;;		FILE-TABLE ADR OF OPEN TTY-FILE

	ELMT%%	ACSAV0,17;;		SAVED AC'S
	ELMT%%	MXIE,1;;		MAX INDEX ENTRY SIZE
	ELMT%%	IESAVE,1;;		INDEX ENTRY WHEN SPLITTING TOP BLOCK
	ELMT%%	MXBUF,1;;		MAX BUFFER SIZE FOR AUX BLOCK
	ELMT%%	AUXBUF,1;;		ADDRESS OF AUX BLOCK
	ELMT%%	AUXIOW,1;;		AUX BLOCK IOWD
	ELMT%%	AUXBNO,1;;		AUX BLOCK NUMBER
	ELMT%%	CMDLST,2;;		COMMAND LIST FOR IDXFILE
	ELMT%%	NEWBK1,1;;		FIRST
	ELMT%%	NEWBK2,1;;		SECOND RELATIVE DATA BLOCK NUMBER JUST ALLOCATED
	ELMT%%	OLDBK,1;;		BLOCK TO BE FREED
	ELMT%%	MXBF,1;;		MAX-BLOCKING-FACTOR
	ELMT%%	DRTAB,1;;		LOC OF DATA REC-TABLE
	ELMT%%	LRWA,1;;		LAST RECORD WORD OF AUXBUF
	ELMT%%	CORPT.,1;;		[346] FREE CORE POINTER.
	ELMT%%	HLOTC.,1;;		HIGH,,LOW LIMITS ON CORE BETWEEN .JBFF AND THE OVERLAY AREA.
	ELMT%%	OTCPT.,1;;		POINTER TO FREE CORE IN HLOTC.
	ELMT%%	RUN.TM,1;;		[346] INITIAL RUN TIME.

	ELMT%%	CB.DDT,1;;		NONE-ZERO IF COBDDT IS PRESENT
	ELMT%%	SBPSA.,1;;		SUBPROGRAM'S STARTING ADDRESS
	ELMT%%	%F.PTR,1;;		POINTS TO POINTER TO FILES. I.E. XWD %LIT00,%FILES

	ELMT%%	INTBLK,4;;		; [414] INTERUPT BLOCK.

;;THE FS.??? VARIABLES ARE FOR CBLIO ERROR RECOVERY
	ELMT%%	FS.ZRO,1;;		THE BLT ZERO WORD - FS.FS TO FS.IF
	ELMT%%	FS.FS,1;;		FILE-STATUS WORD
	ELMT%%	FS.EN,1;;		ERROR-NUMBER
	ELMT%%	FS.BN,1;;		BLOCK-NUMBER
	ELMT%%	FS.RN,1;;		RECORD-NUMBER
	ELMT%%	FS.UPD,1;;		USER-PROCEDURE-DONE FLAG
	ELMT%%	FS.IGE,1;;		IGNORE-ERROR FLAG
	ELMT%%	FS.IF,1;;		IDX-FILE VS IDA
	ELMT%%	FS.IEC,1;;		IGNORED ERROR COUNT

;; ARGUMENT BLOCK FOR PATH. UUO (USED FOR SMU FILOP. OPEN ON TOPS10)

IFE TOPS20,<
	ELMT%%	PTH.BK,.PTMAX;;		; [644] PATH BLOCK
>

;; ARGUMENT BLOCK FOR THE FILOP. UUO
	ELMT%%	FOP.BK,1;;		CHANNEL ,, FUNCTION
	ELMT%%	FOP.IS,1;;		IO STATUS BITS
	ELMT%%	FOP.DN,1;;		DEVICE NAME
	ELMT%%	FOP.BH,1;;		ADR OF BUFFER HEADERS
	ELMT%%	FOP.BN,1;;		NUMBER OF BUFFERS
	ELMT%%	FOP.LB,1;;		ADR OF LOOKUP BLOCK
	ELMT%%	FOP.PP,1;;		PATH POINTER

IFN TOPS20,<
;; ARGUMENT BLOCK FOR DEC-SYS-20 COMPT. UUO
	ELMT%%	CP.BLK,1;;		; [431]	ARG,,FUNCTION
	ELMT%%	CP.BK1,1;;		; [431]
	ELMT%%	CP.BK2,1;;		; [431]
	ELMT%%	CP.BK3,1;;		; [431]
	ELMT%%	CP.BK4,1;;		; [431]
	ELMT%%	CP.BK5,1;;		; [431]
	ELMT%%	CP.BK6,1;;		; [431]
	ELMT%%	CP.BK7,1;;		; [431]
	ELMT%%	CP.BK8,1;;		; NO. OF BUFFERS

	ELMT%%	GJ.BLK,.GJATR+1;;	; [1066] BLOCK FOR LONG FORM GTJFN
	ELMT%%	GJ.ATR,4;;		; [1066] ATTRIBUTE BLOCK FOR GTJFN

	ELMT%%	FID.BK,15;;		; STRING FOR VALUE OF ID (SHOULD BE 52 WORDS)

;; STORAGE FOR FILE SPEC DEFAULTS
	ELMT%%	DF.DEV,2;;		; DEVICE IN ASCIZ
	ELMT%%	DF.DIR,6;;		; DIRECTORY ASCIZ (UP TO 39 CHARS)
	ELMT%%	DF.NAM,2;;		; FILE NAME IN ASCIZ
	ELMT%%	DF.EXT,1;;		; EXTENSION IN ASCIZ
	ELMT%%	DF.PRO,2;;		; PROTECTION IN ASCIZ

	ELMT%%	CMPTER,1;;		;HOLD ERROR CODE FROM COMPT. UUO

>
	
	ELMT%%	DF.PRG,1;;		; CURRENT PROGRAM NAME IN SIXBIT

;; MAKE TMP.BK AT LEAST AS BIG AS .TPLEN ON TOPS10

IFN TOPS20,<	ELMT%%	TMP.BK,15;;>
IFE TOPS20,<	
 IFNDEF .TPLEN,<ELMT%%	TMP.BK,15;;>
 IFDEF .TPLEN,<
  IFL <15-.TPLEN>,< ELMT%%	TMP.BK,.TPLEN;;>
  IFGE <15-.TPLEN>,< ELMT%%	TMP.BK,15;;>
 >
>

	ELMT%%	NRSAV.,5;;	TEMP STORAGE FOR D.BPNR,FS.RN,D.RP, D.RCL AND REL. KEY.

	ELMT%%	AUTOLB,1;;	NON-ZERO IF MONITOR HAS AUTO LABEL PROCESSING
	ELMT%%	DELSIZ,1;;	DELIMITER SIZE
	ELMT%%	LNKNO.,1;;	LINK# ARGUMENT TO REMOVL (CANCEL)
	ELMT%%	RELEN.,1;;	SIZE OF RELEASED RECORD FOR STANDALONE SORT

;;TEMPORARY STORAGE FOR STRING/UNSTRING.

	ELMT%%	SRC.MD,1;;	;SOURCE ITEM'S MODE.
	ELMT%%	DLM.MD,1;;	;DELIMITER MODE.
	ELMT%%	DST.MD,1;;	;DESTINATION'S MODE.
	ELMT%%	NX.SSA,1	;ADDRESS OF NEXT SOURCE SERIES ITEM
	ELMT%%	CV.DLM,1	;INSTRUCTION TO CONVERT DELIMITER
	ELMT%%	SSACB.,16	; SAVED AC'S WHEN CALLING A TAG
	ELMT%%	TAG.PT,1	;ADDR OF ROUTINE TO STORE POINTER VALUE
	ELMT%%	TAG.DL,1	;ADDR OF ROUTINE TO GET NUMERIC DELIMITER
	ELMT%%	TAG.SR,1	;ADDR OF ROUTINE TO GET NUMERIC SOURCE
	ELMT%%	SS.CNT,1	;SOURCE-SERIES ITEM COUNTER
	ELMT%%	DLM.TP,1	;ADDR OF %TEMP OR %LIT FOR DELIMITER
	ELMT%%	SRC.TP,1	;ADDR OF %TEMP OR %LIT FOR SOURCE
	ELMT%%	NX.SRC,1	;ADDR OF NEXT SOURCE ITEM
	ELMT%%	NUM.SR,1	;NUMBER OF SOURCES IN THIS SS
	ELMT%%	NUM.RC,1	;NUMBER OF RECEIVING ITEMS FOR UNSTRING
	ELMT%%	CT.DLM,1	;COUNT OF DELIMITERS
	ELMT%%	SRD.BP,1	;HOLDS BP FOR SOURCE - START OF 1ST MATCH
	ELMT%%	SRD.CC,1	;HOLDS CC FOR SOURCE - START OF 1ST MATCH
	ELMT%%	SRA.BP,1	;HOLDS BP FOR SOURCE AFTER LAST MATCH
	ELMT%%	SRA.CC,1	;HOLDS CC FOR SOURCE AFTER LAST MATCH
	ELMT%%	CV.SDS,1	;CONVERSION FROM SOURCE TO DEST
	ELMT%%	TAG.ST,1	;GET %TEMP SET UP FOR DEST.
	ELMT%%	NX.DLM,1	;NEXT DELIMITER
	ELMT%%	NUM.DL,1	;NUMBER OF DELIMITERS
	ELMT%%	TAG.CT,1	;TAG TO STORE COUNT ITEM
	ELMT%%	TAG.DA,1	;TAG TO STORE AWAY DEST FROM OU.TMP
	ELMT%%	DST.TP,1	;%LIT OR %TEMP FOR DEST.
	ELMT%%	TAG.TL,1	;TAG TO STORE TALLY ITEM

	ELMT%%	BS.AGL,1;;	;BASE ADDRESS OF ARG LIST FOR RMS VERB CALLS
	ELMT%%	RMS.RL,1;;	;RMS RECORD LENGTH (IN WORDS)
	ELMT%%	SM.ARG,3;;	;TWO-WORD ARG LIST FOR CALL TO RMS FAKE READS
	ELMT%%	SM.RLN,1;;	;TO HOLD LENGTH OF RECORD FOR RMS SHADOW RAB
	ELMT%%	SM.BUF,1;;	;ADDRESS OF BUFFER FOR RMS SMU OPTION 1 FAKE READS
	ELMT%%	SM.BN,1;;	;TO HOLD BUCKET NUMBER FOR RMS SMU OPTION 1 FAKE READS
	ELMT%%	SM.BSZ,1;;	;BYTE SIZE OF RMS RECORD PASSED TO LSU BY FAKE SEQ READ
	ELMT%%	SM.KBF,1;;	;ADDRESS OF RMS FAKE KEY BUFFER FOR SMU OPTION 1
	ELMT%%	SM.KRF,1;;	;KEY-OF-REFERENCE NUMBER PASSED TO LSU BY FAKE SEQ RMS READ
	ELMT%%	SMU.AG,1;;	;SMU FLAGS FOR RMS OPEN FAC AND SHR
	ELMT%%	RMVTBF,1;;	;BUFFER FOR RMS ASCII STREAM VERTICAL POSITIONING STUFF

;;TEMPORARY STORAGE FOR OLD STRING/UNSTRING FROM VERSION 12A.
;;NOTE, DO NOT CHANGE THE ORDER OF ITEMS IN EACH GROUP (DMOVE DEPEND UPON IT)

	ELMT%%	SRC.PT,1;;	;TEMP STORE FOR SOURCE POINTER.
	ELMT%%	SRC.CT,1;;	;TEMP STORE FOR SOURCE COUNT.

	ELMT%%	TMP.DP,1;;	;[537] HOLD NUMBER OF DECIMAL PLACES

	ELMT%%	OU.ARP,1;;	;ARG POINTER TO OUTPUT ARG'S PARAMS.
	ELMT%%	OU.MDE,1;;	;MODE OF OUTPUT ARG.

	ELMT%%	TL.ARG,1;;	;TALLYING ITEM'S ARG.
	ELMT%%	TL.VLU,1;;	;TALLYING ITEM'S VALUE.

	ELMT%%	PT.ARG,1;;	;POINTER ITEM'S ARG.
	ELMT%%	PT.VLU,1;;	;POINTER ITEM'S VALUE.

	ELMT%%	AP.TMP,1;;	;PLACE TO SAVE ARG POINTER WHILE SUBSCRIPTING.
	ELMT%%	DW.TMP,1;;	;PLACE TO SAVE DESCRIPTOR WORD WHILE SUBSCRIPTING.

	ELMT%%	SE.DLM,1;;	;START AND END POSITIONS OF DELIMITER IN SOURCE.

	ELMT%%	PF.MDE,1;;	;MODE TO DEFAULT TO.

	ELMT%%	PT.AGL,1;;	;POINTER TO NEXT ARG.
	ELMT%%	TP.AGL,1;;	;TOP OF ARG LIST.

	ELMT%%	SU.AGL,1;;	;POINTER OR INDEX INTO PART OF ARG LIST.

	ELMT%%	BS.DLM,1;;	;BASE OF DELIMITERS IN ARG LIST.
	ELMT%%	TP.DLM,1;;	;TOP OF DELIMITERS IN ARG LIST.
;;	TEMPORARY STORAGE FOR SIMULTANEOUS UPDATE

	ELMT%%	SU.RR;;		COUNT OF RECORDS RETAINED BY THE USER
	ELMT%%	SU.DBR;;	COUNT OF USER-RETAINED DBMS RESOURCES
	ELMT%%	SU.EQ;;		COUNT OF ENTRIES IN THE ENQUEUE TABLE
				;;(AS OPPOSED TO THE DEQUEUE TABLE OR THE MODIFY TABLE)
	ELMT%%	SU.DQ;;		COUNT OF ENTRIES IN THE DEQUEUE TABLE
	ELMT%%	SU.MQ;;		COUNT OF ENTRIES IN THE MODIFY TABLE
	ELMT%%	SU.RRT;;	LOCATION OF THE RETAINED RECORDS TABLE
	ELMT%%	SU.T1;;		TEMP ONE
	ELMT%%	SU.T2;;		TEMP TWO
	ELMT%%	SU.T3;;		TEMP THREE
	ELMT%%	SU.T4;;		TEMP FOUR
	ELMT%%	SU.T5;;		TEMP FIVE
	ELMT%%	SU.T6;;		TEMP SIX
	ELMT%%	SU.T7;;		TEMP SEVEN
	ELMT%%	SU.T8;;		TEMP EIGHT
	ELMT%%	SU.T9;;		[445] TEMP NINE
	ELMT%%	SU.FKR;;		IF -1, FAKE READ IS FROM BLKNUM ROUTINE
	ELMT%%	SU.CRH;;	USED TO STORE THE HIGHEST VALUE OF ACRR
				;;(TOTAL LENGTH OF THE RETAINED RECORDS TABLE)
	ELMT%%	SU.EQT;;	LOCATION OF THE ENQUEUE TABLE
	ELMT%%	SU.DQT;;	LOCATION OF THE DEQUEUE TABLE
	ELMT%%	SU.MQT;;	LOCATION OF THE MODIFY TABLE
	ELMT%%	SU.Y;;		FLAG
	ELMT%%	SU.RBP;;	RECORD BYTE POINTER - SPECIAL POINTER
				;;TO HANDLE LOW-VALUES (SEE CBLIO INTERFACE)
	ELMT%%	SU.MRR;;	MORE RETAINED RECORDS FLAG
	ELMT%%	SU.SBD;;	SAME BLOCK, DIFFERENT QUEUEING  TECHNIQUE FLAG
	ELMT%%	SU.RLV;;	[455] RANDOM KEY OF 0 FLAG
	ELMT%%	SU.RND;;	[455] FILE IS RANDOM FLAG
	ELMT%%	SU.SFQ;;	SAME FILE FLAG
	ELMT%%	SU.SFS;;	SAME FILE, SAME QUEUEING TECHNIQUE FLAG
	ELMT%%	SU.SBS;;	SAME BLOCK, SAME QUEUEING TECHNIQUE FLAG
	ELMT%%	SU.NR;;		NOT RETAINED FLAG
	ELMT%%	SU.FR;;		COUNT OF FILES CURRENTLY OPENED FOR SIMULTANEOUS UPDATE
	ELMT%%	SU.AK;;		TEMPORARY USED FOR ABSOLUTE KEY
	ELMT%%	SU.FBT;;	LOCATION OF THE FILL/FLUSH BUFFER TABLE
	ELMT%%	SU.CFB;;	COUNT OF ENTRIES IN THE FILL/FLUSH BUFFER TABLE
	ELMT%%	SU.VRB;;	INDICATOR OF CURRENT VERB BEING EXECUTED
				;;10 = READ, 4 = REWRITE, 2 = WRITE, 1 = DELETE
	ELMT%%	SU.HV;;		[447] THIS = -1 IF HIGH VALUES IS BEING USED
	ELMT%%	SU.CK;;		COMPARISON KEY
	ELMT%%	SU.SVK;;	TEMP USED TO SAVE KEY
	ELMT%%	SU.CL1;;
	ELMT%%	SU.CL2;;
	ELMT%%	SU.CLR;;
	ELMT%%	SU.CLS;;	TEMPS FOR SU.CL - SU.CL1 AND SU.CL2 MUST BE CONTIGUOUS
	ELMT%%	SU.SAV,5;;	AREA TO SAVE REGISTERS 1,2,3,0, AND 12

	ELMT%%	FET1,1;;	FILE ENQUEUE TEMP ONE
	ELMT%%	FET2,1;;	FILE ENQUEUE TEMP TWO
	ELMT%%	FET3,1;;	FILE ENQUEUE TEMP THREE
	ELMT%%	FET4,1;;	FILE ENQUEUE TEMP FOUR

	ELMT%%	SU.FRF;;	FAKE READ FLAG FOR LSU/CBLIO COMMUNICATION
	ELMT%%	RMKCUR;;	TO HOLD ADDR OF CURRENT RMS INDEX KEY DESCRIP
	ELMT%%	RVLRSZ;;	TO HOLD LEN OF RMS ASCII STREAM VAR LEN REC FOR WRITE
	ELMT%%	QCODE;;		TO HOLD 33-BIT USER CODE FOR ENQ REQUESTS
	ELMT%%	QCDLTL;;	;LONG-TERM-LOCK FLAG SET BY QONFIL ROUTINE
	ELMT%%	SU.ACR;;	TO HOLD POINTER TO CURRENT RRT ENTRY


;;POINTER TO USER'S LIBOL ROUTINE'S LOW SEGMENT DATA AREA.
	ELMT%%	USRLO.;;
	ELMT%%	MRKPTR,2;;	MARK POINTER STORAGE

;;STORAGE FOR INTERNAL FUNCT. CALLS
	ELMT%%	FUN.A0,1;;	FUNCT. ARG.
	ELMT%%	FUN.ST,1;;	STATUS
	ELMT%%	FUN.A1,1;;	ARG 1
	ELMT%%	FUN.A2,1;;	ARG 2
	ELMT%%	FUN.A3,1;;	ARG 3

;;IMPURE STORAGE FOR MCS
IFN MCS,<
 IFE TOPS20,<
	ELMT%%	SNDMSG,10;;	STORAGE FOR LCMIPC
	ELMT%%	MCSTN,1;;	TRANSACTION NUMBER
	ELMT%%	M.TMP1,1;;	DESTINATION COUNT,,TEXT LENGTH
	ELMT%%	M.TMP2,1
	ELMT%%	M.ATCT,1;;	ACTIVE TRANSACTION COUNT
	ELMT%%	MCSPT,1;;	PAGE TABLE POINTER
	ELMT%%	PIDMCP,1;;	PID OF MCP
	ELMT%%	PIDLCM,1;;	OUT PID
	ELMT%%	IPCFLG,1;;	NEXT PACK IN INPUT QUEUE
	ELMT%%	PAKSND,4;;	SEND PACKET
	ELMT%%	MSGSND,10;;	MESSAGE SEND
	ELMT%%	PAKREC,4;;	RECEIVE PACK
	ELMT%%	MSGREC,10;;	MESSAGE RECEIVED

;;FREE PAGE BIT TABLE
;;EACH BIT REPRESENTS A PAGE ON FREE CORE
;;0=PAGE AVAILABLE
;;1=PAGE IS IN USE
	ELMT%%	PAGOFF,1;;	OFFSET TO THE PAGE TABLE
	ELMT%%	PAGBIT,1;;	PAGE TABLE FOR FREE TABLES
	ELMT%%	PAGLST,1;;	[635] LINKED LIST HDR OF CACHED PAGES
	ELMT%%	PAGCNT,1;;	[635] COUNT OF ACTIVE CACHED PAGES
>>
 IFE TOPS20,<
	ELMT%%	PAGTBL,20;;		[472] PAGE TABLE TO RETURN CORE
	ELMT%%	T1SAV,1;;		[472] PAGE UUO SWITCH(COBFUN)
>
	ELMT%%	DBMLOC,1;;		[520] DBMS LIBOL INFORMATION

;;TCS-20 IMPURE STORAGE LOCATIONS
REPEAT 0,<
 IFN MCS,<
  IFN TOPS20,<
	ELMT%% TP.RG1,1;;		FIRST ARGUMENT IN LIST
	ELMT%% TP.RG2,1;;		SECOND ARGUMENT
	ELMT%% TP.RG3,1;;		THIRD ARGUMENT
	ELMT%% TP.RG4,1;;		FOURTH ARGUMENT
	ELMT%% TP.RG5,1;;		FIFTH ARGUMENT
	ELMT%% TP.ID,1;;		ID RETURNED TO LCM FROM TCSCON
	ELMT%% TP.CRP,1;;		POINTER TO THAT PAGE IN CORE
	ELMT%% TP.IPC,1;;		PAGE NUMBER OF COMMUNICATION PARTITION IN FILE
	ELMT%% TP.CPP,1;;		POINTER TO THAT PAGE IN CORE
	ELMT%% TP.JFN,1;;		JFN OF COMMUNICATION FILE
	ELMT%% TP.WNS,1;;		SIZE OF COMMUNICATION PARTITION
	ELMT%% TP.TMP,3;;		USED FOR EXTENDED INSTRUCTIONS IN LCM
	SYML%% TP.PDS,^D10;;		SIZE OF THE PACKET DESC BLOCK
	ELMT%% TP.PDB,TP.PDS;;		PACKET DESCRIPTOR BLOCK
	SYML%% TP.PKS,^D30;;		SIZE OF THE PACKET TO RECEIVE TCSCON DATA
	ELMT%% TP.PKT,TP.PKS;;		PACKET BUFFER FOR IPCF
	SYML%% TP.NAM,TP.PKT+2;;	NAME OF TCS IS READ INTO PACKET BUFFER
	ELMT%% TP.TPD,1;;		PID OF THE TCS CONTROLLER
	ELMT%% TP.LPD,1;;		PID OF LCM
	ELMT%% TP.HDS,1;;		SIZE OF HIDDEN DATA IN WORDS
	ELMT%% TP.HDP,1;;		PTR TO HIDDEN DATA DESCRIPTOR
	ELMT%% TP.DVP,1;;		ADDR OF DISPATCH VARIABLE
	ELMT%% TP.BTP,1;;		PTR TO BIND TABLE
	ELMT%% TP.PAT,^D10;;		PATCH AREA
 >>;;END OF IFN MCS
>;END REPEAT 0

	ELMT%% INRST.,1;;		[530] SET TO -1 AT END OF RESET 

;THE FOLLOWING ARE USED FOR $ERROR PROCESSING
	ELMT%%	ER.PC,1;;		;PC WHEN $ERROR IS INVOKED
	ELMT%%	ER.FLG,1;;		;FLAGS & ERROR-NUMBER
	ELMT%%	ER.MCL,1;;		;MONITOR CALL THAT CAUSED THE ERROR
	ELMT%%	ER.HIJ,1;;		;"HIJ" FOR LIBOL ERROR-NUMBER
					; SOMETIMES SET UP BEFORE THE $ERROR
					; CALL.
IFN TOPS20,<
	ELMT%%	ER.JSE,1;;		;JSYS ERROR WHEN MT.JSE IS SET
	ELMT%%	MNTR5,1;;		[1102] SET TO -1 IF MONITOR LESS V5
>
IFE TOPS20,<
	ELMT%%	ER.E10,1;;		;TOPS10 ERROR CODE WHEN MT.E10 IS SET
>
	ELMT%%	ER.RBG,1;;		;ERROR CODE FOR RMS BUG

	ELMT%%	CVPRM.,2;;		;ARGUMENTS FOR CONVERSION ROUTINES
	ELMT%%	CVARG.,2;;		;CVTDB ARGS INCASE ERROR DETECTED
	ELMT%%	RMSVR.,1;;		;RMS VERSION NUMBER USER FOR ERROR TYPE-OUT
	ELMT%%	INTRP.,1;;		;-1 IF WE ARE PROCESSING AN APR TRAP
	ELMT%%	SUPTB.,1;;		;SUPPRESS TRAILING BLANKS ON SEQ. WRITE
	ELMT%%	WANT8.,1;;		;-1 IF DIFFERENCE IS ANS-82, 0 IF ANS-74
IFN TOPS20,<
	ELMT%%	EXJFN.,1;;		;INITIALLY <-1,,TEXT STRING TO ORIGINAL .EXE FILE>
					;;LATER <SECTION ##,,JFN OF ORIGINAL .EXE FILE>
	SYML%%	MY.EVC,CVARG.;;		;My saved entry vector info (temp)
	ELMT%%	RMS.BK,.GBASE+1;;	;.GBASE contains section #
	SYML%%	RMS.SC,.-1;;		;.GBASE (RMS's section number)
	ELMT%%	OTS.SC,1;;		;OTS's section number (should be zero for v13)

	ELMT%%	ICVTB.,^D128;;		;USED BY INSPECT CONVERTING
>
>;;END OF NON-PRESET AREA
SUBTTL	LIBOL DISPATCH TABLE
	DEFINE	DISTB%	<

	DISEL%	C.RSET;;		MUST APPEAR AT 400010
	DISEL%	STOPR.;;		MUST APPEAR AT 400011
	DISEL%	C.STOP
	DISEL%	KILL.
	DISEL%	GOTO.
	DISEL%	KDECL.
	DISEL%	KPROG.
	DISEL%	DSP.FP
	DISEL%	DSP.F2
	DISEL%	LINE.C
	DISEL%	LINE.D
	DISEL%	LINE.H
	DISEL%	LIN.RH
	DISEL%	CANCL.
	DISEL%	S.CALL
	DISEL%	M.INIT
	DISEL%	M.RMW
	DISEL%	M.RSW
	DISEL%	M.RMNW
	DISEL%	M.RSNW
	DISEL%	M.SEND
	DISEL%	M.AC
	DISEL%	M.IFM
	DISEL%	M.DI
	DISEL%	M.DIT
	DISEL%	M.DO
	DISEL%	M.EI
	DISEL%	M.EIT
	DISEL%	M.EO
	DISEL%	STR.
	DISEL%	STR.O
	DISEL%	UNS.
	DISEL%	UNS.O
	DISEL%	FUNCT.
	DISEL%	FIX.
	DISEL%	PERF.
	DISEL%	FLOT.2
	DISEL%	PD6.
	DISEL%	PD7.
	DISEL%	GD6.
	DISEL%	GD7.
	DISEL%	MUL.12
	DISEL%	MUL.21
	DISEL%	MUL.22
	DISEL%	DIV.11
	DISEL%	DIV.12
	DISEL%	DIV.21
	DISEL%	DIV.22
	DISEL%	C.OPEN
	DISEL%	C.CLOS
	DISEL%	DSPLY.
	DISEL%	ACEPT.
	DISEL%	READ.
	DISEL%	WRITE.
	DISEL%	WADV.
	DISEL%	RDNXT.
	DISEL%	DELET.
	DISEL%	RERIT.
	DISEL%	PURGE.
	DISEL%	INIT.
	DISEL%	TERM.
	DISEL%	COMP.
	DISEL%	CMP.76
	DISEL%	SPAC.6
	DISEL%	SPAC.7
	DISEL%	SPAC.9
	DISEL%	NUM.6
	DISEL%	NUM.7
	DISEL%	NUM.9
	DISEL%	ZERO.6
	DISEL%	ZERO.7
	DISEL%	ZERO.9
	DISEL%	POS.6
	DISEL%	POS.7
	DISEL%	POS.9
	DISEL%	NEG.6
	DISEL%	NEG.7
	DISEL%	NEG.9
	DISEL%	DBMS.
	DISEL%	MOVE.
	DISEL%	LFENQ.;;	FILE ENQUEUE
	DISEL%	LRENQ.;;	RECORD ENQUEUE
	DISEL%	LRDEQ.;;	RECORD DEQUEUE
	DISEL%	C.D6D7
	DISEL%	C.D7D6
	DISEL%	CMP.E
	DISEL%	CMP.G
	DISEL%	CMP.GE
	DISEL%	CMP.L
	DISEL%	CMP.LE
	DISEL%	CMP.N
	DISEL%	EDIT.S
	DISEL%	EDIT.U
	DISEL%	INSP.
	DISEL%	SUBSC.
	DISEL%	SIZE.1
	DISEL%	SIZE.2
	DISEL%	SIZE.3
	DISEL%	E.C3C1
	DISEL%	E.C3C3
	DISEL%	OVLAY.
	DISEL%	C.EXIT
	DISEL%	ARGS.
	DISEL%	PUTF.
	DISEL%	RESF.
	DISEL%	GETNM.;;	GETNM. IS USED BY COBDDT
	DISEL%	ILLC.
	DISEL%	C.D6D9
	DISEL%	C.D7D9
	DISEL%	C.D9D6
	DISEL%	C.D9D7
	DISEL%	PC3.
	DISEL%	PD9.
	DISEL%	GC3.
	DISEL%	GD9.
	DISEL%	CMP.96
	DISEL%	CMP.97
	DISEL%	EDIT.B
	DISEL%	RSTAB.
	DISEL%	ZERC.6;; [454] SIXBIT ZERO CHAR COMPARE
	DISEL%	ZERC.7;; [454] ASCII ZERO CHAR COMPARE
	DISEL%	ZERC.9;; [454] EBCDIC ZERO CHAR COMPARE
	DISEL%	C.STRT
	DISEL%	DATE.
	DISEL%	DAY.
	DISEL%	TIME.

	DSTBL%	USRTB.,15;;	USER LIBOL ROUTINE DISPATCH TABLE

;;START OF VERSION 12 NEW ITEMS

	DISEL%	DSPL.6
	DISEL%	DSPL.7

	DISEL%	SUBE1.;;	;INLINE SUBSCRIPT ERRORS
	DISEL%	SUBE2.
	DISEL%	SUBE3.
	DISEL%	EXIT.E;;	;PERFORM EXIT ERROR
	DISEL%	XTND.E;;	;INLINE EXTEND INST ERROR
	DIDDR%	ALP.66;;	;SIXBIT TO SIXBIT CONVERSION TABLE
	DIDDR%	ALP.67;;	;SIXBIT TO ASCII ...
	DIDDR%	ALP.69;;	;SIXBIT TO EBCDIC ...
	DIDDR%	ALP.76;;	;ASCII TO SIXBIT ...
	DIDDR%	ALP.77;;	;ASCII TO ASCII ...
	DIDDR%	ALP.79;;	;ASCII TO EBCDIC ...
	DIDDR%	ALP.96;;	;EBCDIC TO SIXBIT ...
	DIDDR%	ALP.97;;	;EBCDIC TO ASCII ...
	DIDDR%	ALP.99;;	;EBCDIC TO EBCDIC ...
	DIDDR%	ALPS.6;;	;ALPHABETIC SIXBIT
	DIDDR%	ALPS.7;;	;ALPHABETIC ASCII
	DIDDR%	ALPS.9;;	;ALPHABETIC EBCDIC
	DIDDR%	NUM.66;;	;NUMERIC SIXBIT TO SIXBIT
	DIDDR%	NUM.67;;	;NUMERIC SIXBIT TO ASCII
	DIDDR%	NUM.69;;	;NUMERIC SIXBIT TO EBCDIC
	DIDDR%	NUM.76;;	;NUMERIC ASCII TO SIXBIT
	DIDDR%	NUM.77;;	;NUMERIC ASCII TO ASCII
	DIDDR%	NUM.79;;	;NUMERIC ASCII TO EBCDIC
	DIDDR%	NUM.96;;	;NUMERIC EBCDIC TO SIXBIT
	DIDDR%	NUM.97;;	;NUMERIC EBCDIC TO ASCII
	DIDDR%	NUM.99;;	;NUMERIC EBCDIC TO EBCDIC
	DISEL%	CVTDB.;;	;CONVERT DECIMAL TO BINARY, SETUP DONE INLINE
	DISEL%	CBDOV.;;	;HANDLE OVERFLOW FOR BIN-DEC CONVERSION
	DIDDR%	CVBD.6;;	; TRANSLATION TABLES FOR BIN-DEC EXTEND
	DIDDR%	CVBD.7;;
	DIDDR%	CVBD.9;;
;;	DISEL%	MUL.41
;;	DISEL%	MUL.42
	DISEL%	DIV.41
	DISEL%	DIV.42
	DISEL%	DVI41.;;	;4-WD DIVIDE, SAVE REMAINDER
	DISEL%	DVI42.;;
	DISEL%	KEY.
REPEAT 0,<			;SORT IS NOW IN ITS OWN SECTION
	DISEL%	PSORT.
	DISEL%	PMERG.
	DISEL%	RELES.
	DISEL%	MERGE.
	DISEL%	MCLOS.
	DISEL%	RETRN.
	DISEL%	ENDS.
>
;;END OF COBOL-68 VERSION 12 RELEASED ITEMS

	DISEL%	ADD.4R;;	;[540] QUAD-WORD ROUNDING FUNCTION
REPEAT 0,<
 IFN MCS,<
	DISEL%	MBIND;;		;BIND FORM DATA AREA
	DISEL%	MNAME;;		;SET UP TCS SYSTEM NAME
 >
>;END REPEAT 0
	DISEL%	MVD.AL;;	;MOVE ALL "LIT" TO <DEPENDING VARIABLE>
	DISEL%	NUM.3;;		;COMP-3 NUMERIC TEST
	DISEL%	WADVV.;;	;WRITE ADVANCING, VARIABLE LENGTH RECORDS
	DISEL%	WRITV.;;	;WRITE, VARIABLE LENGTH RECORDS
;;END OF COBOL-74 VERSION 12 RELEASED ITEMS

				;[554] QUAD-WORD SIZE ERROR ROUTINES
	DISEL%	SIZE.4;;	;[554] SIZE ERROR TEST FOR 4-WORD NUMBERS, 1 WORD LIT
	DISEL%	SIZE.5;;	;[554] ANOTHER ONE, 2-WORD LIT THIS TIME
	DISEL%	FLT.12;;	;FLOAT 1-WORD COMP TO COMP-2
	DISEL%	FLT.22;;	;FLOAT 2-WORD COMP TO COMP-2
	DISEL%	FIX.2;;		;FIX COMP-2 TO 2-WORD COMP
	DISEL%	E.F2D1;;	;EXPONENTIATE, BASE COMP-2, POWER 1-WORD COMP
	DISEL%	E.F2D2;;	;EXPONENTIATE, BASE COMP-2, POWER 2-WORD COMP
	DISEL%	E.F2FP;;	;EXPONENTIATE, BASE COMP-2, POWER COMP-1
	DISEL%	E.F2F2;;	;EXPONENTIATE, BASE COMP-2, POWER COMP-2
	DISEL%	PPOT4.;;	;USED BY COBDDT TO PRINT WHERE WE ARE
	DISEL%	ISBPS.;;	;USED BY COBDDT TO INCREMENT SBPSA.

;V12B RMS ENTRY POINTS
	DISEL%	OP.MIX;;	;OPEN RMS INDEXED FILE
	DISEL%	CL.MIX;;	;CLOSE RMS INDEXED FILE
	DISEL%	WT.MIR;;	;WRITE RMS INDEXED, ACCESS RANDOM
	DISEL%	WT.MIS;;	;WRITE RMS INDEXED, ACCESS SEQ.
	DISEL%	WT.MSV;;	;WRITE RMS ASCII STREAM SEQ FOR VAR LEN RECS
	DISEL%	RD.MIR;;	;READ RMS INDEXED, ACCESS RANDOM
	DISEL%	RD.MIS;;	;READ RMS INDEXED, ACCESS RANDOM
	DISEL%	DL.MIR;;	;DELETE RMS INDEXED, ACCESS RANDOM
	DISEL%	DL.MIS;;	;DELETE RMS INDEXED, ACCESS SEQUENTIAL
	DISEL%	RW.MIR;;	;REWRITE RMS INDEXED, ACCESS RANDOM
	DISEL%	RW.MIS;;	;REWRITE RMS INDEXED, ACCESS SEQUENTIAL
	DISEL%	ST.MEQ;;	;START RMS FILE, EQUAL
	DISEL%	ST.MGT;;	;START RMS FILE, KEY GREATER
	DISEL%	ST.MNL;;	;START RMS FILE, KEY NOT LESS THAN
	DISEL%	FA.MIR;;	;FAKE KEYED READ FOR SMU OPTION 1
	DISEL%	FA.MIS;;	;FAKE SEQ READ FOR SMU OPTION 1

;;NEW STRING/UNSTRING ENTRY POINTS TO BE COMPATIBLE WITH V12A
	DISEL%	STR.
	DISEL%	STR.O
	DISEL%	UNS.
	DISEL%	UNS.O

	DISEL%	SWT.ON;;	;SOFTWARE SWITCH ON TEST
	DISEL%	SWT.OF;;	;SOFTWARE SWITCH OFF TEST
	DISEL%	CMP.67;;	;[624] COMPARE SIXBIT TO ASCII IN EBCDIC.
	DISEL%	CMP.69;;	;[624] COMPARE SIXBIT TO EBCDIC IN ASCII.
	DISEL%	CMP.79;;	;[624] COMPARE ASCII  TO EBCDIC IN ASCII.
	DISEL%	COMP.6;;	;[624] COMPARE TWO SIXBIT FIELDS IN EBCDIC.
	DISEL%	COMP.7;;	;[624] COMPARE TWO ASCII  FIELDS IN EBCDIC.
	DISEL%	COMP.9;;	;[624] COMPARE TWO EBCDIC FIELDS IN ASCII.
	DISEL%	SU.S69;;	;[1004] POINTER TO CONVERTION TABLE FOR SIXBIT TO EBCDIC
	DISEL%	SU.S79;;	;[1004] POINTER TO CONVERTION TABLE FOR ASCII  TO EBCDIC
	DISEL%	SU.S97;;	;[1004] POINTER TO CONVERTION TABLE FOR EBCDIC TO ASCII
	DISEL%	CVDBT.;;	;[12B] CVTDB. WITH TRAILING SEP. SIGN
	DISEL%	CVDBL.;;	;[12B] CVTDB. WITH LEADING SEP. SIGN
;;END OF COBOL-68/74 VERSION 12B RELEASED ITEMS

;;New item defined for version 13

	DISEL%	D.O.W.;;	;DAY-OF-WEEK routine
	DISEL%	SSW.ON;;	;SET SOFTWARE SWITCH ON
	DISEL%	SSW.OF;;	;SET SOFTWARE SWITCH OFF
	DIDDR%	ALPL.7;;	;LOWER-CASE ALPHABETIC ASCII
	DIDDR%	ALPL.9;;	;LOWER-CASE ALPHABETIC EBCDIC
	DIDDR%	ALPU.7;;	;UPPER-CASE ALPHABETIC ASCII
	DIDDR%	ALPU.9;;	;UPPER-CASE ALPHABETIC EBCDIC
	DISEL%	INITL.;;	;INITIAL PROGRAM entry point
	DISEL%	FLT.42;;	;FLOAT 4-WORD COMP TO COMP-2
; THESE POINTERS ARE IN EASTBL.MAC, ALL USE AC1 INDIRECTLY
	DISEL%	IPT671;;	;SIXBIT TO ASCII
	DISEL%	IPT691;;	;SIXBIT TO EBCDIC
	DISEL%	IPT791;;	;ASCII TO EBCDIC
	DISEL%	IPT971;;	;EBCDIC TO ASCII

>;END OF DISPATCH TABLE
SUBTTL	MACRO DEFINITIONS -- DEFBYT

;DEFBYT IS A MACRO TO DEFINE A BYTE IN A WORD.
;THE MACRO DEFINES TWO SYMBOLS X'SYM AND Y'SYM  WHICH ARE USED
; BY LOAD AND STORE
; MACROS.

;FLAG VALUES.
DFB.FW==0		;FULL-WORD INSTRUCTION NEEDED
DFB.RH==1		;RIGHT HALF-WORD INSTRUCTION NEEDED
DFB.LH==2		;LEFT HALF-WORD INSTRUCTION NEEDED
DFB.BT==3		;BYTE INSTRUCTION NEEDED

DEFINE DEFBYT(SYM,NBITS,OFFSET),<

IFNDEF .BITST,<	.BITST==0>	;START AT 0

IF1,<			;ALL THIS STUFF HAPPENS ONLY IN PASS 1

;ERROR CHECKS
IFDEF Y'SYM,<	PRINTX ?SYM ALREADY DEFINED WITH DEFBYT
	>

IFG <.BITST+'NBITS-^D36>,< PRINTX ?DEFBYT: SYM DOES NOT FIT IN WORD>
; END OF ERROR CHECKS

;DEFINE Y'SYM TO BE THE WORD OFFSET
	Y'SYM==OFFSET

	DFENDP=='NBITS+.BITST-1	;END POSITION

;COMPUTE FLAGS
	DFBF==DFB.BT		;ASSUME BYTE INSTRUCTION NEEDED
IFE NBITS-^D36,<
	DFBF==DFB.FW> ;FULL WORD
IFE NBITS-^D18,<
	IFE DFENDP-^D17,<
	DFBF==DFB.LH>		;LEFT HALF-WORD INSTRUCTION NEEDED
	IFE DFENDP-^D35,<
	DFBF==DFB.RH>		;RIGHT HALF-WORD INSTRUCTION NEEDED
	>

	X'SYM==<DFBF>B21+NBITS,,DFENDP

	.BITST=='NBITS+.BITST

IFE <.BITST-^D36>,<.BITST==0>	;.BITST IS NEW STARTING POSITION
>;END IF1
>;END DEFBYT MACRO
SUBTTL	MACRO DEFINITIONS -- SAMBYT

;SAMBYT MACRO DEFINES NM1 EQUIVALENT TO NM2 (AS FAR AS LOAD AND STORE
; MACROS ARE CONCERNED)

DEFINE SAMBYT(NM1,NM2),<

IF1,<				;ONLY HAPPENS ON PASS 1
;ERROR CHECKS
IFNDEF X'NM2,<	PRINTX ? SAMBYT: NM2 NOT PREVIOUSLY DEFINED WITH DEFBYT>

X'NM1==X'NM2
Y'NM1==Y'NM2
>;END IF1
>;END SYMBYT MACRO DEFINITION
SUBTTL	MACRO DEFINITIONS -- FINBYT

; This macro resets the bit position of the DEFBYT macro so that the next
; DEFBYT will start at bit position 0 again

DEFINE FINBYT,<
IF1,<
	.BITST==0	; Reset bit position to 0
>; END if1	
>;END DEFINE FINBYT				
SUBTTL	MACRO DEFINITIONS -- ENDDFB

;THIS MACRO HAS NO ARGUMENTS.. IT MAY BE CALLED AFTER ALL THE
; DEFBYT'S ARE GIVEN, TO MAKE SURE THAT THINGS COME OUT TO AN
; EVEN # OF BITS

DEFINE ENDDFB,<
IF1,<
IFN .BITST,<
	.BITLFT==^D36-.BITST	;COMPUTE # OF FREE BITS
	RADIX 10		;MAKE IT COME OUT IN DECIMAL.
	ENDDF1 (\.BITLFT)	;CALL MACRO TO PRINT NUMBER
	RADIX 8			;BACK TO OCTAL
>
>;END IF1
>;END ENDDFB MACRO DEFINITION


;PRINT WARNING ABOUT "N FREE BITS LEFT"

DEFINE ENDDF1(NUMBER),<
PRINTX % ENDDFB: THERE ARE NUMBER BITS STILL UNASSIGNED BY "DEFBYT"
>
SUBTTL	MACRO DEFINITIONS -- LOAD

DEFINE LOAD(AC,SYM,EXTRA),<

;ERROR CHECKS
IF1,<
	IFNDEF X'SYM,<PRINTX ? SYM NOT DEFINED WITH "DEFBYT">
>;END PASS 1 ERROR CHECKS

DFBF==X'SYM_-^D32		;GET FLAG WORDS
IFE DFBF-DFB.FW,<		;GEN FULL WORD INSTRUCTION
	MOVE	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.RH,<		;GEN RIGHT HALF WORD INSTRUCTION
	HRRZ	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.LH,<		;GEN LEFT HALF WORD INSTRUCTION
	HLRZ	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.BT,<
..X==X'SYM_^D18
..X==..X_-^D18			;GET RID OF LH, = ENDING BIT POSITION 
..Y==<X'SYM_-^D18>&^O77		;GET LH, JUST # OF BITS
	..LIT==<Y'SYM+EXTRA>	;FIRST PART OF LITERAL BEING BUILT
	..LIT==..LIT+<..Y_^D24> ;# OF BITS IN BYTE PTR
	..LIT==..LIT+<<^D36-..X-1>_^D30> ;FINAL BIT POSITION IN BYTE PTR
	LDB	AC,[..LIT]
	>
>;END "LOAD" MACRO DEFINITION
SUBTTL	MACRO DEFINITIONS -- ZLOAD

;SAME AS LOAD, EXCEPT THE OFFSET IS NOT ADDED
; THIS IS USEFUL IF THE WHOLE WORD HAS BEEN MOVED INTO AN AC,
; AND YOU JUST WANT A FIELD OF IT.

DEFINE ZLOAD(AC,SYM,EXTRA),<

;ERROR CHECKS
IF1,<
	IFNDEF X'SYM,<PRINTX ? SYM NOT DEFINED WITH "DEFBYT">
>;END PASS 1 ERROR CHECKS

DFBF==X'SYM_-^D32		;GET FLAG WORDS
IFE DFBF-DFB.FW,<		;GEN FULL WORD INSTRUCTION
	MOVE	AC,EXTRA
	>
IFE DFBF-DFB.RH,<		;GEN RIGHT HALF WORD INSTRUCTION
	HRRZ	AC,EXTRA
	>
IFE DFBF-DFB.LH,<		;GEN LEFT HALF WORD INSTRUCTION
	HLRZ	AC,EXTRA
	>
IFE DFBF-DFB.BT,<
..X==X'SYM_^D18
..X==..X_-^D18			;GET RID OF LH, = ENDING BIT POSITION 
..Y==<X'SYM_-^D18>&^O77		;GET LH, JUST # OF BITS
	..LIT==<EXTRA>		;FIRST PART OF LITERAL BEING BUILT
	..LIT==..LIT+<..Y_^D24> ;# OF BITS IN BYTE PTR
	..LIT==..LIT+<<^D36-..X-1>_^D30> ;FINAL BIT POSITION IN BYTE PTR
	LDB	AC,[..LIT]
	>
>;END "ZLOAD" MACRO DEFINITION
SUBTTL	MACRO DEFINITIONS -- STORE

DEFINE STORE(AC,SYM,EXTRA),<

;ERROR CHECKS
IF1,<
	IFNDEF X'SYM,<PRINTX ? SYM NOT DEFINED WITH "DEFBYT">
>;END PASS 1 ERROR CHECKS

DFBF==X'SYM_-^D32		;GET FLAG WORDS
IFE DFBF-DFB.FW,<		;GEN FULL WORD INSTRUCTION
	MOVEM	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.RH,<		;GEN RIGHT HALF WORD INSTRUCTION
	HRRM	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.LH,<		;GEN LEFT HALF WORD INSTRUCTION
	HRLM	AC,Y'SYM+EXTRA
	>
IFE DFBF-DFB.BT,<
..X==X'SYM_^D18
..X==..X_-^D18			;GET RID OF LH, = ENDING BIT POSITION 
..Y==<X'SYM_-^D18>&^O77		;GET LH, JUST # OF BITS
	..LIT==<Y'SYM+EXTRA>	;FIRST PART OF LITERAL BEING BUILT
	..LIT==..LIT+<..Y_^D24> ;# OF BITS IN BYTE PTR
	..LIT==..LIT+<<^D36-..X-1>_^D30> ;FINAL BIT POSITION IN BYTE PTR
	DPB	AC,[..LIT]
	>
>;END STORE MACRO DEFINITION
SUBTTL	MACRO DEFINITIONS -- ZSTORE

DEFINE ZSTORE(AC,SYM,EXTRA),<

;ERROR CHECKS
IF1,<
	IFNDEF X'SYM,<PRINTX ? SYM NOT DEFINED WITH "DEFBYT">
>;END PASS 1 ERROR CHECKS

DFBF==X'SYM_-^D32		;GET FLAG WORDS
IFE DFBF-DFB.FW,<		;GEN FULL WORD INSTRUCTION
	MOVEM	AC,EXTRA
	>
IFE DFBF-DFB.RH,<		;GEN RIGHT HALF WORD INSTRUCTION
	HRRM	AC,EXTRA
	>
IFE DFBF-DFB.LH,<		;GEN LEFT HALF WORD INSTRUCTION
	HRLM	AC,EXTRA
	>
IFE DFBF-DFB.BT,<
..X==X'SYM_^D18
..X==..X_-^D18			;GET RID OF LH, = ENDING BIT POSITION 
..Y==<X'SYM_-^D18>&^O77		;GET LH, JUST # OF BITS
	..LIT==<EXTRA>		;FIRST PART OF LITERAL BEING BUILT
	..LIT==..LIT+<..Y_^D24> ;# OF BITS IN BYTE PTR
	..LIT==..LIT+<<^D36-..X-1>_^D30> ;FINAL BIT POSITION IN BYTE PTR
	DPB	AC,[..LIT]
	>
>;END "ZSTORE" MACRO DEFINITION
SUBTTL	RANDOM USEFUL MACROS

;DEFINITION OF LIBOL LOW SEGMENT

DEFINE	%LOSEG	<
	VISBL%		;;EXTERNALLY VISABLE SECTION
	INFBK%		;;FIXNUM BLOCK
	PREST%	;;PRESET AREA
	LIDAT%		;;NON-PRESET AREA
>

;DEFINE A BLOCK STATEMENT WITHOUT REGARD TO VALUE

DEFINE	BLKDF	(NAME,LEN<1>)	<
	IFNB	<NAME>,<NAME::>
	BLOCK	LEN
>

;DEFINE A BLOCK STATEMENT OR VALUE

DEFINE	BLKDFV	(NAME,LEN<1>,VAL)	<
	IFNB	<NAME>,<NAME::>
	IFN	LEN,<IFB	<VAL>,<BLOCK	LEN>
		    IFNB	<VAL>,<REPEAT	LEN,<
					VAL>>
		>
>

;MACRO TO DEFINE A SYMBOL

DEFINE	SYM%%	(NAME,VAL)	<NAME==:VAL>
SUBTTL	MACROS FOR C8XSHR.MAC

;DEFINE THE BEGINNING OF THE LIBOL.SHR HIGH SEGMENT

DEFINE	PURHI%	<

	;;FIRST THE DISPATCH TABLE
IFE TOPS20,<
	DEFINE	DISEL%	(NAM)	<JRST	1,NAM##>	;;PORTALS
	DEFINE	DIDDR%	(NAM)	<IFIW	NAM##>		;;TABLE ADDRESSES
	DEFINE	DSTBL%	(NAM,IR)	<JRST	1,@NAM##(IR)>
>
IFN TOPS20,<
	DEFINE	DISEL%	(NAM)	<JRST	NAM##>	;;PORTALS
	DEFINE	DIDDR%	(NAM)	<IFIW	NAM##>	;;TABLE ADDRESSES
	DEFINE	DSTBL%	(NAM,IR)	<JRST	@NAM##(IR)>
>
	RELOC	HI.ORG			;;START AT THE TOP
	DISTB%				;;DISPATCH TABLE

	;; NOW THE VALUES TO BE BLT INTO THE LIBOL.LOW PRESET AREA
	DEFINE	SYMH%%	(N%,V)	<SYM%%	N%,V>	;;ONLY HIGH SEG SYMBOLS
	DEFINE	SYML%%	(N%,V)	< >		;;NO LOW SEG SYMBOLS
	DEFINE	ELMT%%	(N%,L<1>,V)	<BLKDFV	,L,<V>>	;;GET THE VALUES ONLY
	PREST%				;;PRESET SECTION

	PURGE	ELMT%%,SYMH%%,SYML%%,DISEL%,DIDDR%,DSTBL%
>

;NOW THE LOW SEGMENT WITH NO VALUES

DEFINE	PURLO%	<

	DEFINE	ELMT%%	(N%,L<1>,V)	<BLKDF	N%,L>	;;JUST SYMBOLS
	LOC	LO.PUR			;;ACTUAL LOSEG STARTING ADDRESS
	DEFINE	SYML%%	(N%,V)	<SYM%%	N%,V>	;;LO SEG SYMBOLS ONLY
	DEFINE	SYMH%%	(N%,V)	< >	;;NO HIGH SEG SYMBOLS

	%LOSEG			;;LO SEG DEFINITIONS

	COMCHK	.-LO.PUR	;; HAVE WE EXCEEDED MAX LOSEG SIZE

	PURGE	ELMT%%,SYMH%%,SYML%%
>
SUBTTL	MACROS FOR IMPURE LOSEG - LIBREL.MAC

;IMPURE LOSEGMENT WITH VALUES PRESET AT LOAD TIME

DEFINE	IMPLO%	<
	
	DEFINE	SYMH%%	(N%,V)	<N%==:0>	;;SET TO ZERO TO CANCEL BLT
	DEFINE	SYML%%	(N%,V)	<SYM%%	N%,V>	;;DO LOSEG SYMBOLS
	DEFINE	ELMT%%	(N%,L<1>,V)	<BLKDFV	N%,L,<V>>	;;WITH VALUES

	RELOC	0
	CHK==.

	%LOSEG

	COMCHK	.-CHK		;;HAVE WE EXCEEDED THE MAX LOW SEG SIZE

	PURGE	SYML%%,SYMH%%,ELMT%%
>

; THERE IS NO DISPATCH TABLE WHEN LIBOL.SHR IS NOT USED
SUBTTL	COBOL PROGRAM INTERFACE MACROS

;THESE ARE REFERENCED BY LILOWS.MAC
;THEY WILL DEFINE THE ADDRESSES OF THE DISPATCH TABLE
;AND ADDRESSES OF SELECTED LOW SEGMENT LOCATIONS

;DISPATCH TABLE ADDRESSES

DEFINE	DISAD%	<
	ADR==HI.PUR	;;ACTUAL HIGH SEG BEGINNING ADDRESS
	DEFINE	DISEL%	(N%)	<
	N%=:ADR		;;MAKE SYMBOL VISIBLE TO DDT
	ADR==ADR+1
	>
	DEFINE	DIDDR%	(N%)	<
	N%=:ADR
	ADR==ADR+1
	>
	DEFINE	DSTBL%	(NAM,IR)	<DISEL%	(NAM)>

	DISTB%				;;DEFINE ADDRESSES

	PURGE	DISEL%,DIDDR%,DSTBL%,ADR
>

;MACRO TO DEFINE SELECTED LOW SEGMENT ADDRESSES

DEFINE	LOWAD%		<
	DEFINE	SYMH%%	(N%,V)	< >
	DEFINE	SYML%%	(N%,V)	<SYM%%	N%,V>	;;LO SEG SYMBOLS ONLY
	DEFINE	ELMT%%	(N%,L<1>,V)	<BLKDFV	N%,L,<V>>
	LOC	LO.PUR			;;ACTUAL LO SEG STARTING ADDRESS

	VISBL%

	DEFINE	ELMT%%	(N%,L<1>,V) <BLOCK L>

	INFBK%

	DEFINE	ELMT%%	(N%,L<1>,V) <BLOCK L>

	DEFINE	SYML%%	(N%,V)	< >

	PREST%

	COMCHK	.-LO.PUR	;;HAVE WE EXCEEDED MAX LO SEG SIZE?

	PURGE	ELMT%%,SYMH%%,SYML%%,ADR
>
SUBTTL	COMPILER INFORMATION

;COMSIZ IS THE AMOUNT OF SPACE ALLOCATED BY THE COMPILER
;FOR THE LIBOL LOW SEGMENT
;IF THIS NUMBER IS EXCEEDED BY EXPANDING THE LOW SEG THEN
;COBOLG.MAC MUST BE RECOMPILED AND THE COMPILER RELOADED
;NOTE THAT ALL PREVIOUSLY COMPILED PROGRAMS WILL BE INCOMPATABLE
;WITH THE NEW LARGER LIBOL.SHR

COMSIZ==1340

;TELL SOMEONE IF COMSIZ HAS BEEN EXCEEDED

DEFINE	COMCHK	(LEN)	<
	IFG	LEN-COMSIZ,<
	XXX.==LEN-COMSIZ
  DEFINE PEXCS(OVRFLO),<
	PRINTX	?COMSIZ EXCEEDED BY 'OVRFLO (OCTAL) WORDS - REGENERATE THE COMPILER
   >
	PEXCS(\XXX.)
>;END IFG LEN-COMSIZ
>;END DEFINE COMCHK

;INDICES OF THE INFORMATION HEADER BLOCK

DEFINE	INFIX%		<
	INC==0		;;STARTING INDEX
	DEFINE	ELMT%%	(N%,L<1>,V)	<
	IFNB	<N%>,<%'N%==:INC>
	INC==INC+1
	>
	DEFINE	SYML%%	(N%,L<1>,V)	<
	IFNB	<N%>,<%'N%==:INC>
	>
	INFBK%

	PURGE	ELMT%%,SYML%%,INC

>

; DEFINE THEM
	INFIX%
SUBTTL	IOFLAG DEFINITIONS

;** V13 IO FLAG BITS **
;
; SOME OF THESE WILL BE USED FOR 12B (THE MULTI-KEY ISAM ENTRY POINTS
; WILL FOLLOW THE V13 STANDARD).


;THE FIRST ARGUMENT TO ALL LIBOL I-O ENTRY POINTS (AFTER 12A) IS A WORD
; FORMATTED AS FOLLOWS:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
; WHERE THE LEFTMOST 4 FLAG BITS FOR ALL ARE DEFINED TO BE:
;	O%BOPR==POINT 4,AC16,3	;THE LIBOL OPERATION CODE
; VALUES:
;	V%OPEN==1		;OPEN
;	V%CLOS==2		;CLOSE
;	V%READ==3		;READ
;	V%WRIT==4		;WRITE
;	V%RWRT==5		;REWRITE
;	V%DELT==6		;DELETE
;	V%STRT==7		;START
;	V%ACPT==10		;ACCEPT
;	V%DPLY==11		;DISPLAY

;OPEN FLAG BITS
;13:
;	OPN%IN==1B9		;OPEN FOR INPUT
;	OPN%OU==1B10		;OPEN FOR OUTPUT
;	OPN%IO==1B11		;OPEN FOR IO
;				;All bits 9-11 on for OPEN I-O
;	OPN%NR==1B12		;No rewind
;	OPN%EX==1B13		;Open Extend (Append)
;	OPN%RV==1B14		;Open Reversed
;	OPN%UN==1B17		;OPEN HAS UNAVAILABLE CLAUSE
;12A:
	OPN%OU==1B9		;OPEN FOR OUTPUT
	OPN%IN==1B10		;OPEN FOR INPUT
	;BOTH OPN%OU AND OPN%IN ARE ON FOR OPEN I-O

;CLOSE FLAG BITS
;V13:
;	CLS%EF==1B9		;END-OF-FILE label
;	CLS%EV==1B10		;END-OF-VOLUME label
;	CLS%BV==1B11		;BEGINNING-OF-VOLUME label
;	CLS%CF==1B12		;CLOSE FILE= 0
;	CLS%CR==1B12		;CLOSE REEL= 1
;	CLS%LK==1B13		;LOCK, LOCKED files may not be reopened
;	CLS%NR==1B14		;No rewind
;	CLS%UN==1B15		;UNLOAD
;	CLS%DL==1B16		;CLOSE WITH DELETE
;V12A:
	CLS%LK==1B10
	CLS%DL==1B7

;WRITE FLAG BITS
;V13:
;	V%WADV==1B10		;WRITE ADVANCING
;	WAD%RP==1B11		;REPORT WRITER ENTRY, NO CRLF
;	WAD%AD==1B12		;USE 18-35 AS AN ADDRESS
;	WAD%BF==1B13		;WRITE BEFORE ADVANCING
;	WAD%CH==17B17		;ADVANCE VIA THIS LPT CHANNEL


;READ FLAG BITS
;V12A AND V13:
	RD%NXT==1B9		;READ NEXT RECORD

;DELETE FLAG BITS
	;;** NONE **;;

;REWRITE FLAG BITS
	;;** NONE **;;

;START FLAG BITS
;V12A AND V13:
	STA%EQ==3B13		;EQUAL TO (IF 0)
	STA%NL==1B12		;NOT LESS THAN
	STA%GT==1B13		;GREATER THAN
	STA%AK==1B14		;START WITH APPROXIMATE KEY

;SEEK FLAG BITS
	;;** NONE **;;

;ACCEPT AND DISPLAY
;	[NOT USED IN V12B]

	END