Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/lblprm.mac
There are 14 other files named lblprm.mac in the archive. Click here to see a list.
; UPD ID= 1619 on 5/22/84 at 9:18 AM by HOFFMAN                         
UNIVERSAL	LBLPRM FOR COBOTS
SUBTTL	PARAMETERS FOR COBOTS V13	/ACK/DAW

	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

.DIRECTIVE .NOBIN

	EDIT==0
	VERSION==12B29
	%%LBLP==1	;TO ASSURE THAT ALL MODULES ARE COMPILED WITH THE
			; SAME SWITCHES.
;REVISION HISTORY:
;V13 *****
;	22-MAY-84	;[1126] Add BLANKL switch for ascii text files
;V10 *****
;	13-AUG-76	; [450] ADD NUMSTD SW FOR ANSII STD NUMERIC TEST
;	17-FEB-76	; [431] TOPS20 FIX FOR SIM UPDATE
;	30-JAN-76	FIX ABORT IN TABLES FOR BIS
;	 9-SEP-75	/ACK	CVTNM DOESN'T RETURN THE CODE FOR THE
;				DIGIT WHEN IT IS A SPECIAL CHARACTER
;				FIX IT SO IT DOES.
;	 5-MAY-75	/DBT	ADD SOME THINGS FOR BIS
;	23-APR-75	/DBT	CHANGE CVTNM SO THAT IT RETURNS THE
;				6/7/8 BIT CODE FOR THE DIGIT
;	11-DEC-74	/ACK	CREATION.
;*****
	SEARCH	INTERM	;DEFINE THE ASSEMBLY SWITCHES.
			; ARE DEFAULTED IN INTERM WHICH SEARCHES COBASM AND
			; INTERM IS SEARCHED BY P AND LBLPRM WHICH ARE
			; SEARCHED BY THE COMPILER MODULES AND OTS
			; MODULES RESPECTIVELY TO PICK UP ANY SYMBOLS

	ANS82==:ANS82
	BLANKL==:BLANKL		;[1126]
	DBMS==:DBMS
	DBMS6==:DBMS6
	DEBUG==:DEBUG
	MCS==:MCS
	MPWCEX==:MPWCEX
	MPWC.S==:MPWC.S
	ONESEG==:ONESEG	; [431]
	TOPS20==:TOPS20

;DEFAULT ANY UNDEFINED ASSEMBLY SWITCHES.

	SWSET%==SWSET%		;DEFINE COMPILER'S ASSEMBLY SWITCH WORD.
	LIBSW%==LIBSW%		;DEFINE OTS'S ASSEMBLY SWITCH WORD.

;ADDITIONAL FEATURE TEST FLAGS THAT CAN BE SET BY COBOL SYNTAX
;SOME OF THESE USED TO BE FEATURE TEST SWITCHES SET OFF BY DEFAULT

	SW.A74==SW.A74		;ANS-74 STANDARD WANTED
	SW.A82==SW.A82		;ANS-82 STANDARD WANTED
	SW.STB==SW.STB		;SUPPRESS TRAILING BLANKS ON WRITE

;SYMBOLS FOR RMSIO

	FLGFIL==0		;FLAGS ;FILE TABLE ADDRESS
	KYINFO==1		;KEY REFERENCE ;KEY BUF ADD ;KEY INFO BLOCK
	KEYLNG==2		;OFFSET OF KEY LENGTH
	KY.BUF==0		;TOP OF KEY BUFFER
	RECLNG==1		;OFFSET OF RECORD LENGTH
	NXKEYB==2		;NEXT KEY INFO BLOCK
	SVNOSK==-4		;NON-SKIP RETURN
	DEFADV==-1		;DEFAULT ADVANCING
	OVHEAD==3		;RMS INDEX BUFFER OVERHEAD
	DUPKEY==2		;DUPLICATE KEY
	RMSV20==2		;OFFSET FOR TOPS20 VERSION NUMBER
	RMSV10==4		;OFFSET FOR TOPS10 VERSION NUMBER

	FA%NXT==1B9		;FAKE READ NEXT RECORD
	FA%KYR==1B10		;KEY REFERENCE SPECIFIED FOR FAKE READ
	FA%FAK==1B11		;THIS READ IS A FAKE READ
;ACCUMULATIOR DEFINITIONS:

;NOTE:
;	ACCUMULATORS 0, 1, 2, 3 AND 12 SHOULD ALWAYS BE PRESERVED ON
;	 ANY CALL TO THE OTS.

	S1==1		;SAVE THESE.
	S2==2
	S3==3
	CNT==4		;FIELD WIDTH.
	CH==5		;HOLDS A CHARACTER.
	T1==CH		;TEMPORARY.
	T2==T1+1	;    "
	T3==T2+1	;    "
	T4==T3+1	;    "
	T5==T4+1	;    "
	TAC1==5		;TEMPORARIES - USE THESE NAMES WHEN RENAMEING
	TAC2==6		; THE AC'S OTHERWISE THE ASSEMBLER WILL MESS
	TAC3==7		; THINGS UP.
	TAC4==10
	TAC5==11
	CPTR==T2	;CONVERSION POINTER.
	AC==T3		;THREE AC'S USED IN NUMERIC CONVERSIONS.
	IPTR==13	;THE INPUT BYTE POINTER.
	OPTR==14	;THE OUTPUT BYTE POINTER.
	SW==OPTR	;SWITCHES.
	JAC==15		;HOLDS THE RETURN ADDRESS FOR SUBROUTINES CALLED
			; VIA JSP.
	PARM==16	;POINTS TO THE PARAMETERS.
	PP==17		;PUSH DOWN POINTER.


;CATCH-ALLS.
	AC0=0
	AC1=1
	AC2=2
	AC3=3
	AC4=4
	AC5=5
	AC6=6
	AC7=7
	AC10=10
	AC11=11
	AC12=12
	AC13=13
	AC14=14
	AC15=15
	AC16=16
;FLAGS:

;BITS SET IN SW FOR RUN-TIME USE BY GD.MAC (CVDBT. ETC)
;NOTE 1B0 MUST NOT BE USED, 1B1 IS USED BY ALL THE ROUTINES

SW.SGN==1B1		;SIGNED
SW.2WC==1B2		;2-WORD COMP

;BITS SET IN SW FOR GD, GC, ETC.

	LS==(1B2)	;LEADING SIGN FLAG.
	LM==(1B3)	;LEADING MINUS FLAG.
	IS==(1B4)	;IMBEDDED OR TRAILING SIGN FLAG:
			; 0 ==> NONE OR POSITIVE
			; 1 ==> NEGATIVE.
	SSF==(1B5)	;SEPARATE SIGN FLAG
	LSF==(1B6)	;LEADING SIGN FLAG (AS OPPOSED TO TRAILING)
	OECNT==(1B4)	;ODD OR EVEN COUNT FLAG.
			; 0 ==> CNT WAS ODD.
			; 1 ==> CNT WAS EVEN.


;ASCII CONTROL CHARACTERS

$HT==11
$LF==12
$VT==13
$FF==14
$CR==15
$DLE==20
$DC1==21
$DC2==22
$DC3==23
$DC4==24
$CZ==32
$ALT==33	;ALTMODE
SUBTTL	REGISTERS AND FLAGS FOR BIS

; BASIC REGISTER DEFINITIONS
;INSTRUCTION REGS
BIS0==4
BIS1==5
BIS2==6
BIS3==7
BIS4==10
;TEMPS
BIST0==11
BIST1==12
BIST2==13
IFN	SW-14,<PRINTX BIS REGISTER ERROR>
IFN	JAC-15,<PRINTX BIS REGISTER ERROR>

; MORE MEANINGFUL NAMES FOR THE REGS
BISCH==BIS2	;TEMP REGISTER USED BY BSET1. AND BSET2.
B.FLAG==BIS0	;FLAGS
SRCCNT==BIS0	;SOURCE COUNT
SRCPT==BIS1	;SOURCE POINTER
DSTCNT==BIS3	;DESTINATION COUNT
DSTPT==BIS4	;DESTINATION POINTER
PATRN==BIS0	;PATTERN
MARKAD==BIS3	;ADDRESS OF MARK POINTER
BD.FLG==BIS3	;FLAGS ARE HERE FOR BINARY TO DECIMAL CONVERSION
SRCHI==BIS0	;HIGH ORDER BITS OF SOURCE BINARY
SRCLO==BIS1	;LOW ORDER BITS OF SOURCE BINARY NUMBER
DSTHI==BIS3	;HIGH ORDER BITS OF DESTINATION BINARY NUMBER
DSTLO==BIS4	;LOW ORDER BITS OF DESTINATION BINARY NUMBER

;FLAGS IN LEFT HALF OF B.FLAG
BFLG.S==400000	;SIGNIFICANCE FLAG
BFLG.M==100000	;NEGATIVE FLAG
BFLG.N==200000	;NON-ZERO FLAG
BFLG.==700000	;ALL OF THEM

;NEW NAMES FOR OLD INSTRUCTIONS

OPDEF	PJRST	[JRST]		;JUMP TO POPJ

;NEW KL INSTRUCTIONS

OPDEF	ADJBP	[IBP]		;ADJUST BYTE POINTER
OPDEF	ADJSP	[105B8]		;ADJUST STACK POINTER
OPDEF	DADD	[114B8]		;DOUBLE ADD
OPDEF	DSUB	[115B8]		;
OPDEF	DMUL	[116B8]		;
OPDEF	DDIV	[117B8]		;
OPDEF	DMOVE	[120B8]
OPDEF	DMOVEM	[124B8]
OPDEF	DMOVN	[121B8]
OPDEF	DMOVNM	[125B8]

;EXTENDED INSTRUCTION SET OP CODES

OPDEF	EXTEND	[123B8]		;EXTENDED INSTRUCTION
OPDEF	CMPSL	[001B8]		;COMPARE STRINGS, SKIP IF LESS
OPDEF	CMPSE	[002B8]		;COMPARE STRINGS, SKIP IF EQUAL
OPDEF	CMPSLE	[003B8]		;COMPARE STRINGS, SKIP IF LESS OR EQUAL
OPDEF	CMPSGE	[005B8]		;COMPARE STRINGS, SKIP IF GREATER OF EWQUAL
OPDEF	CMPSN	[006B8]		;COMPARE STRINGS, SKIP IF NOT EQUAL
OPDEF	CMPSG	[007B8]		;COMPARE STRINGS, SKIP IF GREATER

OPDEF	EDIT	[004B8]		;PROCESS STRING ACCORDING TO MINI-PROGRAM PATTERN

OPDEF	CVTBO	[010B8]		;CONVERT DECIMAL TO BINARY BY OFFSET
OPDEF	CVTDBT	[011B8]		;CONVERT DECIMAL TO BINARY BY TRANSLATION
OPDEF	CVTBDO	[012B8]		;CONVERT BINARY TO DECIMAL BY OFFSET
OPDEF	CVTBDT	[013B8]		;CONVERT BINARY TO DECIMAL BY TRANSLATION

OPDEF	MOVSO	[014B8]		;MOVE STRING WITH BYTE OFFSET
OPDEF	MOVST	[015B8]		;MOVE STRING WITH BYTE TRANSLATION
OPDEF	MOVSLJ	[016B8]		;LEFT JUSTIFIED
OPDEF	MOVSRJ	[017B8]		;RIGHT JUSTIFIED

OPDEF	XBLT	[020B8]		;EXTENDED BLT

;EXTENDED ADDRESSING SYMBOLS

OPDEF	IFIW	[1B0]
	.NODDT	IFIW

; E0 BLOCK INDICES

E0.INS==0	;INSTRUCTION CODE
E0.OFF==0	;OFFSET
E0.TBL==0	;TRANSLATION TABLE ADDRESS
E0.FIL==1	;FILL CHARACTER
E0.FLT==2	;FLOAT CHARACTER
E0.$==3		;DOLLAR SIGN
E0.COM==4	;COMMA
E0..==5		;PERIOD
E0.BL==6	;BLANK
E0.0==7		;ZERO
E0.PL==10	;PLUS
E0.MI==11	;MINUS
E0.C==12	;"C"
E0.R==13	;"R"
E0.D==14	;"D"
E0.B==15	;"B"
E0.SL==16	;[-74] "/"

;TRANSLATION TABLE CODES

T.SBIT==400000		;SET S AND N FLAGS
T.ABRT==100000		;ABORT
T.MCLR==200000		;CLEAR M FLAG
T.MSET==300000		;SET M FLAG
T.ABIS==14		; [425] ABORT IF SIGNIFICANCE IS ON (ONLY FOR CVDBO/T )
SUBTTL	FLAGS FOR COBOL VERBS

;FLAGS IN AC16 FOR DURATION OF CURRENT COBOL VERB
V%WADV==1B0		;WRITE ADVANCING
V%WRIT==1B1		;WRITE
V%READ==1B2		;READ
V%OPEN==1B3		;OPEN
V%RTAN==1B4		;[-74/-82] SMU RETAIN ACTIVE
V%FREE==1B5		;[-74/-82] SMU FREE ACTIVE
V%RNXT==1B10		;[-74] READ NEXT RECORD
V%STRT==1B11		;[-74] FAKE READ FOR START VERB (DON'T BLT DATA TO BUFFER)
V%CLOS==1B12		;CLOSE
V%RWRT==1B14		;ISAM REWRITE
V%DLT==1B15		;ISAM DELETE
FL%WRC==1B16		;WRITE REEL CHANGE, RESTORE THE RECORD AREA
FL%EOT==1B17		;MTA END-OF-TAPE

;ACCEPT
ACP%NM==1B6		;NUMERIC
ACP%LF==1B7		;LAST FIELD, SKIP TO AN EOL CHARACTER
ACP%SZ==1777B17		;FIELD SIZE, CHAR IF ALPHA, WORDS IF NUMERIC
ACP%P9==400000		;PIC WAS PPPP...999
ACP%FP==200000		;FLOATING POINT INPUT
ACP%SF==40		;SCALE FLAG

;DISPLAY
DIS%NM==1B6		;NUMERIC, SUPPRESS LEADING SPACES AND TABS
DIS%LF==1B7		;LAST FIELD, APPEND "CRLF"

;OPEN
OPN%OU==1B9		;OPEN FOR OUTPUT
OPN%IN==1B10		;OPEN FOR INPUT
OPN%NR==1B11		;NO REWIND
OPN%EX==1B13		;[-74] OPEN EXTEND (APPEND)
OPN%RV==1B14		;[-74] OPEN REVERSED
OP%SU1==1B15		;OPEN WITH SMU OPTION 1 (FOR RMS FILES ONLY)
OPN%UN==1B17		;SMU OPTION 1 OPEN HAS UNAVAILABLE CLAUSE

;CLOSE
CLS%EF==1B4		;END-OF-FILE LABEL
CLS%EV==1B5		;END-OF-VOLUME LABEL
CLS%BV==1B6		;BEGINNING-OF-VOLUME LABEL
CLS%IC==1B7		;INVALID USER-SUPPLIED CLAUSE
CLS%RO==1B8		;OPEN CALL GENERATED BY CLOSE REEL
CLS%CF==1B9		;CLOSE FILE = 0
CLS%CR==1B9		;CLOSE REEL = 1
CLS%LK==1B10		;LOCK, LOCKED FILES MAY NOT BE REOPENED
CLS%NR==1B11		;NO REWIND
CLS%UN==1B13		;UNLOAD

;READ
RD%NXT==1B9		;READ NEXT RECORD

;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

;START
STA%AP==1B8		;START WITH APPROX KEY.
STA%EQ==3B13		;EQUAL TO (IF 0)
STA%NL==1B12		;NOT LESS THAN
STA%GT==1B13		;GREATER THAN
SUBTTL SIMULTANEOUS UPDATE FLAGS

;THE FOLLOWING SYMBOLS DEFINE THE QUEUE TECHNIQUES FOR ENTRIES
;IN THE RETAINED RECORDS TABLE. (SEE LSU)

QT%NOQ==0		;NO QUEUEING
QT%SHR==1		;SHARED
QT%EXC==2		;EXCLUSIVE
QT%IEX==3		;INDEX-EXCLUSIVE
QT%SHI==4		;SHARED, BUT COVERED BY OTHER INDEX-EXCLUSIVE
QT%EXI==5		;EXCLUSIVE, COVERED BY OTHER INDEX-EXCLUSIVE
QT%KY0==7		;RANDOM "KEY 0" RETAIN, WHOLE FILE EXCLUSIVE

REPEAT 0,<;FOR NOW
;THE VALUES FOR ENQUEUEING FLAGS

EF%RD==1B0		;READ
EF%RWT==1B1		;REWRITE
EF%WRT==1B2		;WRITE
EF%DLT==1B3		;DELETE
EF%UF==1B4		;UNTIL FREED
EF%KS==1B5		;KEY SPECIFIED
>
SUBTTL	FILE STATUS word 1

;FILE STATUS error codes.
;These are the values stored in FILE STATUS word 1

COMMENT	$
In COBOL-74 only the following were allowed FILE STATUS error codes

FS%00==00	;Successful Completion.
FS%10==^D10	;AT END.
FS%21==^D21	;Sequence error, primary key has changed.
FS%22==^D22	;Attempt to create a duplicate key.
FS%23==^D23	;Random access record does not exist.
FS%24==^D24	;Attempt to write beyond relative file boundary.
FS%30==^D30	;Permanent Error.
FS%34==^D34	;Boundary Violation.
$

;These are the ANS-8x FILE STATUS values

FS%00==00	;Successful Completion.
FS%02==02	;Successful but duplicate key detected.
FS%04==04	;Successful but length of record not as expected.
FS%05==05	;Optional file not present at OPEN time.
FS%07==07	;MTA OPEN/CLOSE clauses for non mta device.

FS%10==^D10	;AT END.
FS%14==^D14	;Relative record key too big.
FS%15==^D15	;Sequential READ attempted for first time on absent optional file.
FS%16==^D16	;Sequential READ attempted when AT END already exists.

FS%20==^D20	;Lower Boundary for Invalid Key class test.
FS%21==^D21	;Sequence error, primary key has changed.
FS%22==^D22	;Attempt to create a duplicate key.
FS%23==^D23	;Random access record does not exist.
FS%24==^D24	;Attempt to write beyond relative file boundary.
FS%25==^D25	;START or random READ to optional file not present.
FS%29==^D29	;Upper Boundary for Invalid Key class test.

FS%30==^D30	;Permanent Error.
FS%34==^D34	;Boundary Violation.
FS%35==^D35	;Missing file.
FS%36==^D36	;Multiple reel error.
FS%37==^D37	;OPEN I-O attempted to non-disk.
FS%38==^D38	;OPEN attempted to LOCKed file.
FS%39==^D39	;OPEN attribute conflict.

FS%41==^D41	;OPEN to already open file.
FS%42==^D42	;CLOSE to already closed file.
FS%43==^D43	;Last verb was not a successful READ.
FS%44==^D44	;Boundary Violation.
FS%46==^D46	;No valid record for READ.
FS%47==^D47	;READ on file not OPEN for INPUT or I-O.
FS%48==^D48	;WRITE on file not OPEN for OUTPUT or EXTEND.
FS%49==^D49	;REWRITE on file not OPEN for I-O.

		;Implementor defined.
FS%90==^D90
FS%91==^D91
FS%92==^D92
FS%93==^D93
FS%94==^D94
FS%95==^D95
fs%96==^D96
FS%97==^D97
FS%98==^D98
SUBTTL	FILE STATUS word 2.

;These are the values stored in bytes 1 and 2 (AB) of FILE STATUS word 2.

;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS
E.VOPE==^D100000000	;COBOL VERB OPEN
E.VCLO==^D200000000	;	CLOSE
E.VWRI==^D300000000	;	WRITE
E.VREW==^D400000000	;	REWRITE
E.VDEL==^D500000000	;	DELETE
E.VREA==^D600000000	;	READ
E.VRET==^D700000000	;	RETAIN
E.VEXT==^D800000000	;	OPEN EXTEND
E.VSTR==^D900000000	;	START

;These are the values stored in bytes 3 and 4 (CD) of FILE STATUS word 2.

E.MINP==^D1000000	;MONITOR INPUT ERROR
E.MOUT==^D2000000	;	OUTPUT
E.MLOO==^D3000000	;	LOOKUP
E.MENT==^D4000000	;	ENTER
E.MREN==^D5000000	;	RENAME
E.MOPE==^D6000000	;	OPEN
E.MFOP==^D7000000	;	FILOP.
E.MTAP==^D8000000	;	TAPOP.
E.MCPT==^D9000000	;[1007]	COMPT.

E.JGTJ==^D10000000	;TOPS-20 GTJFN ERROR
E.JOPN==^D11000000	;	OPENF
E.JCLS==^D12000000	;	CLOSF
E.JSIN==^D13000000	;	SIN
E.JSOU==^D14000000	;	SOUT

;These are the values stored in bytes 5 and 6 (EF) of FILE STATUS word 2.

E.FIDX==^D10000		;ISAM INDEX FILE
E.FIDA==^D20000		;ISAM DATA FILE
E.FSEQ==^D30000		;SEQUENTIAL FILE
E.FRAN==^D40000		;RANDOM FILE
E.FMTA==^D50000		; LABEL PROCESSING ERROR (MTA FILE)

;These are the values stored in byte 7 (G) of FILE STATUS word 2.

E.BSTS==^D1000		;ISAM STATISTICS BLOCK
E.BSAT==^D2000		;ISAM SAT BLOCK
E.BIDX==^D3000		;ISAM INDEX BLOCK
E.BDAT==^D4000		;ISAM DATA BLOCK

;These are the values stored in bytes 8 - 10 (HIJ) of FILE STATUS word 2
;if CD contains a value between 1 or 2 (i.e. a TOPS-10 I/O UUO error).

EU%18==^D18	;Improper mode
EU%19==^D19	;Device error
EU%20==^D20	;Data error
EU%21==^D21	;Quota exceeded, structure full, RIB full
EU%22==^D22	;End of file
;These are the values stored in bytes 8 - 10 (HIJ) of FILE STATUS word 2
;if CD contains zero (i.e. not a monitor error).
;These bytes may also contain RMS error codes which start at 500.

FE%0==0		;None of the following
FE%1==1		;RECORD KEY must not equal LOW-VALUES
FE%2==2		;No more index levels available
FE%3==3		;Insufficient memory while attempting to split the top index block
FE%4==4		;Version number discrepancy
FE%5==5		;Allocation failure#-#all blocks are in use
FE%6==6		;The maximum record size can not be exceeded
FE%7==7		;Cannot expand memory while sort is in progress
FE%8==8		;Insufficient memory for buffer requirements
FE%9==9		;Blocking-factor differs between index file and file-table
FE%10==^D10	;File cannot be opened, already open
FE%11==^D11	;Locked file cannot be opened
FE%12==^D12	;File cannot be opened shares buffer area with opened file
FE%13==^D13	;File cannot be opened device is not available to this job
FE%14==^D14	;File cannot be opened device is assigned to another file
FE%15==^D15	;File cannot be opened device cannot Input/Output
FE%16==^D16	;File cannot be opened device cannot input
FE%17==^D17	;File cannot be opened device cannot output
FE%18==^D18	;File cannot be opened device is not a device
FE%19==^D19	;File cannot be opened directory device must have standard labels
FE%20==^D20	;File cannot be closed because it is not open
FE%21==^D21	;File cannot be closed. The CLOSE REEL option can not be used with a multi-file-tape.
FE%22==^D22	;File is not open for output
FE%23==^D23	;Zero length records are illegal.
FE%24==^D24	;"AT END" path has been taken
FE%25==^D25	;Encountered an "EOF" in the middle of a record
FE%26==^D26	;Record-Sequence-Number n should be m
FE%27==^D27	;File-name on device-name should be reorganized, the top index block was just split
FE%28==^D28	;Not Used
FE%29==^D29	;Either the ISAM file does not exist or the VALUE OF ID changed during the program
FE%30==^D30	;Attempt to do I/O from a subroutine called by a nonresident subroutine.
FE%31==^D31	;I/O cannot be done from an overlay File.
FE%32==^D32	;Read an "EOF" instead of a label
FE%33==^D33	;CLOSE REEL is legal only for magnetic tape
FE%34==^D34	;File is not open for input
FE%35==^D35	;Not enough free memory between .JBFF and overlay area
FE%36==^D36	;Insufficient memory while attempting to split the top index block
FE%37==^D37	;STANDARD ASCII recording mode and density of 1600 BPI require the device to be a TU70
FE%38==^D38	;TAPOP. failed - unable to set STANDARD-ASCII mode
FE%39==^D39	;Got an EOF in middle of block/record descriptor word
FE%40==^D40	;Block descriptor word byte count is less than five
FE%41==^D41	;Error#-#got another buffer instead of "EOF"
FE%42==^D42	;Error#-#record extends beyond the end of the logical block
FE%43==^D43	;It is illegal to change the record size of an EBCDIC I/O record
FE%44==^D44	;The two low-order bytes of RDW/BDW must be zero, spanned EBCDIC not supported.
FE%45==^D45	;TAPOP. failed - Unable to set hardware data mode
FE%46==^D46	;Unable to get mag tape status information.
FE%47==^D47	;Cannot set requested density
FE%48==^D48	;TAPOP. failed - unable to get/set label type/information
FE%49==^D49	;Unable to set requested density for OPEN EXTEND
FE%50==^D50	;error processing OPEN EXTEND for mag tape
FE%51==^D51	;Unable to set requested data mode for OPEN EXTEND 
FE%52==^D52	;Improper tape label format for indicated recording mode
FE%53==^D53	;Improper default hardware data mode for ASCII system-labeled tape
FE%54==^D54	;ANSI-labeled "S" and "D" mag tape not supported
FE%55==^D55	;Program can not have OPEN I/O and OPEN EXTEND for same file FD
FE%56==^D56	;TAPOP. failed, unable to switch mag tape reels
FE%57==^D57	;Unable to set READ REVERSED.
FE%58==^D58	;Magtape OPEN/CLOSE functionality requested for non-magtape device.
FE%59==^D59	;Attribute conflict on OPEN statement.
FE%60==^D60	;Sequential READ attempted but no valid next record established.
FE%61==^D61	;A successful READ must precede a DELETE or REWRITE for SEQUENTIAL access.
SUBTTL	MACROS

;THIS MACRO IS USED BY THE OTHER MACROS TO GENERATE "LDB AC1,[POINT ?,?(AC2),?]"
; WHERE THE ?'S ARE DETERMINED BY THE STRUCTURE OF EASTBL, WHERE THE EXTERNALS
; ?'FLD'? ARE DEFINED.

	DEFINE	PICKUP	(FLD,N,AC1,AC2,%LH,%RH,%A,%B)<
		.XCREF
		;;DO DEFAULTS THIS WAY SINCE MACRO DOESN'T WORK RIGHT.
		%A==N
		IFB <N>,<%A==6>
		%B==AC1
		IFB <AC1>,<%B==CH>
		%C==AC2
		IFB <AC2>,<%C==%B>
		%B==%B&17
		%LH==S'FLD'L.##
		%RH==S'FLD'R.##
		IFE %A-7,<%LH==A'FLD'L.##
			%RH==A'FLD'R.##>
		IFE %A-^D9,<%LH==E'FLD'L.##
			%RH==E'FLD'R.##>
		LDB	%C,	[XWD	%LH+%B,%RH]
		.CREF
		LIST
>	;END OF DEFINE PICKUP.





COMMENT	\

MACRO TO DETERMINE IF A CHARACTER REPRESENTS A DIGIT WITH AN OVERPUNCHED "-".

CALL:
	SIGN	N,AC1,AC2;
WHERE:
	N=6 ==> THE INPUT CHAR IS SIXBIT
	N=7 ==> THE INPUT CHAR IS ASCII
	N=9 ==> THE INPUT CHAR IS EBCDIC
	(AC1) = THE INPUT CHAR
	(AC2) = 1 IF THE CHAR HAS AN OVERPUNCHED "-", OTHERWISE 0.
DEFAULTS:
	N:	6	(OMITTED OR NEITHER 7 NOR 9)
	AC1:	CH	(THIS IS NOT NECESSARILY THE CH DEFINED IN LBLPRM)
	AC2:	AC1

\

	DEFINE	SIGN	(N,AC1,AC2)<PICKUP	SGN,N,AC1,AC2
			PURGE	%A,%B,%C
			>
COMMENT	\

MACRO TO CONVERT A CHARACTER TO A DIGIT.

CALL:
	CVTNM	N,AC1,AC2;
WHERE:
	N=6 ==> THE INPUT CHAR IS SIXBIT
	N=7 ==> THE INPUT CHAR IS ASCII
	N=9 ==> THE INPUT CHAR IS EBCDIC
	(AC1) = THE INPUT CHAR
	(AC2) = THE DIGIT
DEFAULTS:
	N:	6	(OMITTED OR NEITHER 7 NOR 9)
	AC1:	CH	(THIS IS NOT NECESSARILY THE CH DEFINED IN LBLPRM)
	AC2:	AC1

\

	DEFINE	CVTNM	(N,AC1,AC2)<
			PICKUP	DGT,N,AC1,AC2
			TRNN	%C,IBNCH.##
			TRZE	%C,SPCCH.##
			CAIE	%C,3
			TRZA	%C,777600
			TRZ	%C,-1
			IFE	N-6,<ADDI %C,20>
			IFE	N-7,<ADDI %C,60>
			IFE	N-^D9,<ADDI %C,360>
			PURGE	%C
			>
COMMENT	\

MACRO TO CONVERT A CHARACTER TO A DIGIT AND SET BIT 0 TO 1 IF THE CHARACTER
REPRESENTS A DIGIT WITH AN OVERPUNCHED "-".

CALL:
	CVTSNM	N,AC1,AC2;
WHERE:
	N=6 ==> THE INPUT CHAR IS SIXBIT
	N=7 ==> THE INPUT CHAR IS ASCII
	N=9 ==> THE INPUT CHAR IS EBCDIC
	(AC1) = THE INPUT CHAR
	(AC2) = THE DIGIT
DEFAULTS:
	N:	6	(OMITTED OR NEITHER 7 NOR 9)
	AC1:	CH	(THIS IS NOT NECESSARILY THE CH DEFINED IN LBLPRM)
	AC2:	AC1

\

	DEFINE	CVTSNM	(N,AC1,AC2)<
		PICKUP	SDG,N,AC1,AC2;
		TRNE	%C,IBNCH.##
		TLOA	%C,(1B0)
		TRZE	%C,SPCCH.##
		CAIE	%C,3
		TRZA	%C,777600
		TRZ	%C,-1
		IFE	N-6,<ADDI %C,20>
		IFE	N-7,<ADDI %C,60>
		IFE	N-^D9,<ADDI %C,360>
		PURGE	%C
>
SUBTTL	$ERROR macro definitions

;This is the new $ERROR macro which will be used for 12B and later
; to handle OTS errors.

DEFINE $ERROR (ERRNUM,SEVER,MTYPES,RETADR,MONCAL<0>),<

MMT==MTYPES
IFN <MTYPES>&MT.FIL,< MMT==MTYPES!MT.IVB> ;IF FILE ERROR, SET "I-O VERB"

	MOVE	2,[<SEVER>B2+<MMT>B17+<ERRNUM>B35]
	MOVEI	3,MONCAL
	JSP	1,LBLERR
IFE <SEVER-SV.KIL>,<	;DON'T LET HIM GET AWAY WITH CONFUSION
	IFNB <RETADR>,<	PRINTX ?$ERROR may not specify RETADR
		PRINTX when SEVERITY = SV.KIL
		PASS2
		END >>

IFNB <RETADR>,< JRST	RETADR>

>;END DEFINE $ERROR

;SEVERITY LEVELS
	SV.KIL==1	;FATAL ERROR, OTS ALWAYS ABORTS THE PROGRAM
	SV.FAT==2	;FATAL ERROR, A USE PROCEDURE IS CALLED IF THERE
			; IS ONE, THEN CONTROL IS RETURNED TO THE RETURN-ADDR
			; IF SPECIFIED, ELSE CONTROL RETURNS TO THE CODE
			; FOLLOWING THE $ERROR MACRO.
	SV.WRN==3	;WARNING.
	SV.INF==4	;INFORMATIONAL.

;MESSAGE TYPE CODES
	MT.FIL==1B35	;TYPE THE CURRENT FILENAME
	MT.BLO==1B34	;TYPE THE BLOCK #, RECORD #
	MT.JSE==1B33	;(TOPS20) TYPE THE JSYS ERROR IN ER.JSE
	MT.E10==1B33	;(TOPS10) TYPE THE TOPS10 ERROR IN ER.E10
	MT.IVB==1B32	; ERROR DURING AN I-O VERB
	MT.OER==1B31	;CALL THE "OPEN" USE PROCEDURE

;MONITOR CALL CODES
	MC.NON==0	;NO MONITOR CALL
	MC.INP==1	;INPUT
	MC.OUT==2	;OUTPUT
	MC.LKP==3	;LOOKUP
	MC.ENT==4	;ENTER
	MC.REN==5	;RENAME
	MC.INI==6	;INIT
	MC.FLP==7	;FILOP

;DEFINE ERROR NUMBERS
DEFINE DEFE(NUM),<
	E.'NUM==NUM
>
RADIX 10
%%Z==1

XLIST
.XCREF
REPEAT ^D999,<
	DEFE(\%%Z)
	%%Z==%%Z+1
>
.CREF
LIST
RADIX 8
SUBTTL	DEFINITIONS - RMSIO DATA STRUCTURES

;The following definitions are used for RMS files.
;In each file-table there is an offset D.RMSP.  In this word,
; there is an address of an RMS-block if the file is open
;The RMS block contains pointers to the RMS control
; structures and other relevant RMS runtime information.
;The offsets in that block are described below:

;THE FOLLOWING "RBLADR" MACRO IS SIMILAR TO THE "TABADR" MACRO IN FTDEFS.
;IT ALLOWS US TO DEFINE A NEW ENTRY IN THE TABLE IN ONE STATEMENT INSTEAD
;OF HAVING TO MODIFY A SECOND STATEMENT AS WE DID IN V12B. HOWEVER, IT
;WORKS ENTIRELY ON POSITION AND IS NOT VERY BRIGHT. SO, IF YOU WANT TO
;ADD A NEW WORD TO THIS CONTROL BLOCK JUST PUT IT IN ABOVE THE COMMENT
;LINE BELOW WHICH IS ABOVE THE LINE DEFINING THE NAME FIELD ".RCFNM".
;.RCFNM IS A SPECIAL CASE BECAUSE IT CONTAINS MORE THAN ONE WORD, YET
;WE WANT ITS ADDRESS AT THE FIRST WORD OF THE NAME FIELD.

ADDR==0

DEFINE RBLADR (N,L) <
N==ADDR
ADDR==ADDR+L
>


RBLADR .RCMEM,1		;NUMBER OF WORDS ALLOCATED FOR RMS BLOCK DURING $OPEN
RBLADR .RCFAB,1		;ADDRESS OF THE FAB
RBLADR .RCRAB,1		;ADDRESS OF THE RAB
RBLADR .RCCRB,1		;ADDRESS OF CONVERSION RECORD BUFFER
RBLADR .RCCKB,1		;ADDRESS OF CONVERSION KEY BUFFER
RBLADR .RCCRS,1		;CONVERSION ROUTINES
		;LH= ADDR OF ROUTINE TO CONVERT FROM INTERNAL TO
		;    EXTERNAL RECORDING MODE;  RH= THE COMPLEMENT.
RBLADR .RCXAB,1		;ADDRESS OF THE FIRST XAB
RBLADR .RCKIN,1		;ADDRESS OF KEY INFO
RBLADR .RCBPR,1		;BYTE PTR TO THE RECORD
RBLADR .RCKRF,1		;NUMBER OF CURRENT KEY OF REFERENCE IN CASE OF 
			; SUBSEQUENT SEQUENTIAL READ
RBLADR .RCSTE,1		;STATE, VALUES ARE GIVEN IN "STATE TABLE" BELOW
RBLADR .RCFAK,1		;ADDRESS OF FAKE RAB FOR SMU OPTION 1
RBLADR .RCFCB,1		;CONVERSION BUFFER FOR RECORD FOR FAKE READS
RBLADR .RCFKC,1		;ADDRESS OF CONVERSION BUFFER FOR KEYS FOR FAKE READS
RBLADR .RCFKR,1		;NUMBER OF KEY OF REFERENCE FOR SEQUENTIAL FAKE READ
RBLADR .RCRLN,1		;RECORD LENGTH IN WORDS

;PUT ANY NEW RMS FILE CONTROL BLOCK ENTRIES ABOVE THIS COMMENT

RBLADR .RCFNM,1		;START OF FILENAME (ASCIZ STRING)

	RBLKLN==ADDR	;SIZE OF BLOCK TO THIS POINT

	FNLEN==^D120/5	;LENGTH OF FILENAME FIELD - TRUNCATED BECAUSE FIRST
			; WORD IS INCLUDED IN .RCFNM

.RCLEN==RBLKLN+FNLEN	;TOTAL LENGTH OF THE BLOCK


;	"STATE TABLE"
;
;TABLE OF VALUES WHICH ARE USER IN RMSIO FOR COBOL IN THE FIELD .RCSTE
; OF THE RMS BLOCK FOR THE FILE.

	RC.UNF==0	;UNDEFINED..NOTHING IS "SET UP"
	RC.SUR==1	;SUCCESSFUL READ WAS JUST DONE
	RC.ATE==2	;FILE IS "AT END"
	RC.INV==3	;INVALID KEY PATH WAS TAKEN
	RC.FAI==4	;HARD FILE I-O FAILURE ENCOUNTERED

;END OF STATE TABLE

	END