Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/lblprm.mac
There are 14 other files named lblprm.mac in the archive. Click here to see a list.
; UPD ID= 3411 on 2/20/81 at 2:06 PM by NIXON
UNIVERSAL LBLPRM FOR LIBOL
SUBTTL PARAMETERS FOR LIBOL /ACK/DAW
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION
EDIT==0
VERSION==12B29
%%LBLP==1 ;TO ASSURE THAT ALL MODULES ARE COMPILED WITH THE
; SAME SWITCHES.
;REVISION HISTORY:
;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 LIBOL
; MODULES RESPECTIVELY TO PICK UP ANY SYMBOLS
NUMSTD==:NUMSTD ;[450]
TOPS20==:TOPS20 ;[431]
DBMS4==:DBMS4 ; [431]
DBMS6==:DBMS6
ONESEG==:ONESEG ; [431]
DEBUG==:DEBUG
RPW==:RPW
ISAM==:ISAM
DBMS==:DBMS
MCS==:MCS
TCS==:TCS
EBCMP.==:EBCMP.
MPWCEX==:MPWCEX
TRAILB==:TRAILB
MPWC.S==:MPWC.S
BIS==:BIS
TOPS20==:TOPS20
ANS68==:ANS68
ANS74==:ANS74
CSTATS==:CSTATS
LSTATS==:LSTATS
IFDEF SUPPTB,<SUPPTB==:SUPPTB> ;Carry over def if given
;but if not given, don't set it:
;some people are used to defining it first
; thing in CBLIO.MAC!!!
;DEFAULT ANY UNDEFINED ASSEMBLY SWITCHES.
SWSET%==SWSET% ;DEFINE COMPILER'S ASSEMBLY SWITCH WORD.
LIBSW%==LIBSW% ;DEFINE LIBOL'S ASSEMBLY SWITCH WORD.
;ACCUMULATIOR DEFINITIONS:
;NOTE:
; ACCUMULATORS 0, 1, 2, 3 AND 12 SHOULD ALWAYS BE PRESERVED ON
; ANY CALL TO LIBOL.
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:
LS==(1B1) ;LEADING SIGN FLAG.
LM==(1B2) ;LEADING MINUS FLAG.
IS==(1B3) ;IMBEDDED OR TRAILING SIGN FLAG:
; 0 ==> NONE OR POSITIVE
; 1 ==> NEGATIVE.
OECNT==(1B4) ;ODD OR EVEN COUNT FLAG.
; 0 ==> CNT WAS ODD.
; 1 ==> CNT WAS EVEN.
SSF==(1B5) ;SEPARATE SIGN FLAG
LSF==(1B6) ;LEADING SIGN FLAG (AS OPPOSED TO TRAILING)
;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
IFN 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 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
; 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 )
> ;END OF BIS
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%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
;CLOSE
CLS%EF==1B4 ;END-OF-FILE LABEL
CLS%EV==1B5 ;END-OF-VOLUME LABEL
CLS%BV==1B6 ;BEGINNING-OF-VOLUME LABEL
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
;WRITE ADVANCING
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 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 METER POINT MACROS
; THE FOLLOWING ARE THE MACROS TO GET TIMING INFO AND COUNT
;BUCKETS FOR LIBOL METERING. L.METR GENERATES THE CALL TO
;LMETR., THE ROUTINE THAT INCREMENTS A BUCKET COUNT AND
;INDICATES WHICH BUCKET IS BEING TIMED. MRTMS. GENERATES THE
;CODE FOR STARTING A TIMING. MRTME. GENERATES THE CODE FOR
;ENDING THE TIMING AND INCREMENTING THE PROPER TIME BUCKET.
;ALL THREE WILL GENERATE NOTHING IF LSTATS IS NOT ON.
DEFINE MRTMS. (A) < ;START MRT PT TIMING, SAVE NOW IN MBTIM.
IFN LSTATS,<
IFE TOPS20,<
SETZ A, ;OUR JOB
RUNTIME A, ;GET FAST 10 TIME
MOVEM A,MBTIM. ;SAVE START TIME
>
IFN TOPS20,<
PUSHJ PP,MRTM.S ;GO SET 20 TIME FOR START
>
>;END LSTATS
>;END MRTMS.
DEFINE MRTME. (A) < ;GET TIME SINCE MRTMS.,ADD TO TIME BUCKET
;ADDRESSED BY MBTMB.
IFN LSTATS,<
IFE TOPS20,<
SETZ A, ;OUR JOB
RUNTIME A, ;GET FAST 10 TIME
SUB A,MBTIM. ;GET TIME SINCE METER PT START
ADDM A,@MRTMB. ;ADD TIME PAST TO TIME BUCKET
>
IFN TOPS20,<
PUSHJ PP,MRTM.E ;GET TIME FOR 20
>
>;END LSTATS
>;END MRTME.
DEFINE L.METR (BKT,FTB) < ;INCRE. MTR BUCKET (BKT)
;FOR FILE WITH FILTAB ADDR FTB
;L.METR USES AC1 AND AC2
IFN LSTATS,<
MOVEI S2,BKT ;SET BUCKET OFFSET WITHIN BKT BLOCK
MOVE S1,FTB ;SET FILTAB ADDRESS
PUSHJ PP,LMETR. ;GO INCREMENT BUCKET
>;END LSTATS
>;END L.METR
IFN LSTATS,<
IFN TOPS20,<
; IF METER% IS UNDEFINED, THIS MONITOR IS BEFORE RELEASE 4.
;THIS MEANS THAT COBLER WILL HAVE TO BE RUN WHEN THE SYSTEM
;IS STARTED UP TO INSTALL THE METER JSYS. THE CALLING SEQUENCE
;IS DIFFERENT FROM RELEASE 4'S IMPLEMENTATION. LBLPRM WILL
;DEFINE THE JSYS AS "MTRJS%". IF THE DEFAULT JSYS NUMBER 776 IS ALREADY USED
;AT THE INSTALLATION FOR SOME OTHER PURPOSE, A FREE
;JSYS NUMBER SHOULD BE PICKED AND THE PARAMETER "MJSYSN"
;SHOULD BE DEFINED IN COBASM.MAC TO BE THIS NUMBER.
SEARCH MONSYM
IFNDEF METER%,<
IFNDEF MJSYSN, MJSYSN==776 ;DEFAULT JSYS COBLER USES
MJSYSN==MJSYSN ;MAKE SURE IT'S DEFINED IN LBLPRM
OPDEF MTRJS% [JSYS MJSYSN] >
>;END IFN TOPS20
>;END IFN LSTATS
IFDEF METER%, OPDEF MTRJS% [METER%]
SUBTTL LSTATS DIRECTORY FILE DEFINITIONS
IFN LSTATS,<
; IN EITHER TOPS10 OR TOPS20 BUCKET-BALL, IT CAN BE SETUP
;HERE TO WRITE THE LSTATS DATA TO THE USER'S DISK AREA OR
;TO A SYSTEM-WIDE OUTPUT DIRECTORY. THE PARAMETERS
;DEFINED HERE TELL LIBOL WHERE THE OUTPUT DIRECTORY IS,
;IF THERE IS ONE.
IFE TOPS20,<
LSPPN==0,,0 ;OUTPUT PPN
;SET TO 0,,0 TO USE DEVICE COB:
; SET TO -1 TO JUST WRITE FILES TO DSK:
IF1,<
IFN <LSPPN+1>,<
FTLSDR==1
PRINTX [LSTATS.DIR WILL BE NEEDED WHEN THIS LIBOL IS USED]
PRINTX [READ CRELD.DOC FOR INSTRUCTIONS]
>;END IFN LSPPN+1
>;END IF1
>;END IFE TOPS20
IFN TOPS20,<
;DEFINE LSDIR IF AN LSTATS.DIR FILE WILL BE USED.
; DON'T DEFINE IT IF YOU WANT ALL USERS' LSTATS DATA TO
; GO TO THEIR OWN DISK AREA.
DEFINE LSDIR,<
ASCIZ/LSTATS:/ ;LOGICAL NAME LSTATS, SHOULD BE
; DEFINED SYSTEM-WIDE TO BE SOME
;DIRECTORY IN PS:
>
IF1,<
IFDEF LSDIR,<
FTLSDR==1 ;NOTE WE HAVE AN LSTATS.DIR
PRINTX [LSTATS.DIR WILL BE NEEDED WHEN THIS LIBOL IS USED]
PRINTX [READ CRELD.DOC FOR INSTRUCTIONS]
>;END IFDEF LSDIR
>;END IF1
>;END IFN TOPS20
IFNDEF FTLSDR, FTLSDR==0 ;IF WE DIDN'T SET TO 1, SET IT TO 0
>;END IFN LSTATS
SUBTTL $ERROR macro definitions
;This is the new $ERROR macro which will be used for 12B and later
; to handle LIBOL 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, LIBOL 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
REPEAT ^D999,<
DEFE(\%%Z)
%%Z==%%Z+1
>
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:
.RCMEM==0 ;TOTAL # WORDS OF MEMORY USED BY $OPEN
.RCFAB==1 ;ADDRESS OF THE FAB
.RCRAB==2 ;ADDRESS OF THE RAB
.RCCRB==3 ;ADDRESS OF CONVERSION RECORD BUFFER
.RCCKB==4 ;ADDRESS OF CONVERSION KEY BUFFER
.RCCRS==5 ;CONVERSION ROUTINES
;LH= ADDR OF ROUTINE TO CONVERT FROM INTERNAL TO
; EXTERNAL RECORDING MODE; RH= THE COMPLEMENT.
.RCXAB==6 ;ADDRESS OF THE FIRST XAB
.RCKIN==7 ;ADDRESS OF KEY INFO
.RCBPR==10 ;BYTE PTR TO THE RECORD
.RCKRF==11 ;CURRENT KEY OF REFERENCE (USUALLY 0)
.RCSTE==12 ;STATE, VALUES ARE ONE OF THE FOLLOWING:
RC.UNF==0 ;UNDEFINED..NOTHING IS "SET UP"
RC.SUR==1 ;SUCCESSFUL READ WAS JUST DONE
RC.ATE==2 ;FILE IS "AT END"
.RCFNM==13 ;START OF FILENAME (ASCIZ STRING)
FNLEN==^D120/5+1 ;LENGTH OF FILENAME FIELD
.RCNXT==.RCFNM+FNLEN
.RCLEN==.RCNXT ;LENGTH OF THE BLOCK
END