Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/comuni.mac
There are 16 other files named comuni.mac in the archive. Click here to see a list.
; UPD ID= 3538 on 5/11/81 at 9:23 AM by NIXON
UNIVERSAL COMUNI.MAC FOR LIBOL/COBOL VERSION 12B
SUBTTL COMMON UNIVERSAL FILE FOR COBOL AND LIBOL
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
;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
BIS==:BIS
MCS==:MCS
TCS==:TCS
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
>
;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%% TALLY.,1,<Z>;; THE SPECIAL REGISTER TALLY
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.
IFN ANS74,<
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. AND SO THAT CSORT
;; ; NEEDEN'T BE LOADED IF THE
;; ; PROGRAM DOESN'T DO ANY SORTING.
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.
;;THIS IS A TEMPORARY CROCK TO MAKE DBSTP$ VISIBLE TO DBMS
;;THE PROBLEM IS THAT ITS ADDRESS MUST BE IN THE LOW SEGMENT FOR DBMS
;;BUT VISIBLE TO LIBOL ALSO
;;THIS WILL BE FIXED IN V13
IFN DBMS,< ;[623]
ELMT%% DBSTP%,1,<EXP DBSTP$##>;; ;POINTER TO DBMS CLEANUP ROUTINE
SYML%% LEVEL.,<.-1>
IFNDEF LEVEL.,<PRINTX ?LEVEL. NOT DEFINED!>
> ;[623]
IFE DBMS,< ;[623]
ELMT%% LEVEL.,1,<Z>;; ;[623] PERFORM DEPTH
> ;[623]
ELMT%% METR.,1,<Z>;; ;METER POINT DATA
;;FOR VERSION 13 ADD E0.6 ETC, AND NEW STRING LOCATIONS
>
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
IFN ANS74,<
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%%
IFN ANS74,<
;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
IFN ANS68,<;;TO MAKE COBOL-74 V12A AND V12B COMPATIBLE - THIS LOCATION NEVER USED
ELMT%% OVFLG.,1,<Z >;; OVERLAY CODES
>
IFN BIS,<
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>;;
IFN ANS74,<
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">;;
IFN ANS74,<
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>;;
IFN ANS74,<
ELMT%% ,1,<141>;;
>
>;;END IFN BIS
;;NEW LOCATIONS REQUIRED FOR STRING/UNSTRING REWRITE
;;THESE SHOULD BE IN VISBL% MACRO
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
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. )
;; BLOCK 1;; WRITE BLANK TAPE ( 3 IN.)
;; BLOCK 1;; ADVANCE TO LOGICAL "EOT"
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,2(AC6)>;;
ELMT%% UIBUF.,1,<INBUF 0,2(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
IFN ANS68,<
ELMT%% USEEK.,1,<CALLI 0,56 >;; SEEK UUO
>
IFN ANS74,<
SYML%% USEEK.,-1;; KEEP LINK HAPPY UNTIL VERSION 13
>
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
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
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
ELMT%% FLDCT.,1;; NUMBER OF THE CURRENT ACCEPT FIELD
ELMT%% OVRIX.,1;; POINTER TO INDEX FOR OVERLAY ROUTINE
ELMT%% NOCR.,1;; DURING A WTITE 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
;; 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]
; 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%% FID.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.
;;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.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
;;POINTER TO USER'S LIBOL ROUTINE'S LOW SEGMENT DATA AREA.
ELMT%% USRLO.;;
IFN BIS,<
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!TCS,<
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
IFN MCS!TCS,<
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 TCS
IFN DBMS,<
ELMT%% DBMLOK,1;; SET TO -1 ON FIRST DBMS CALL
>;;END OF IFN DBMS
ELMT%% OSHOOT,1;; [530] SET TO -1 AT END OF RESET
IFE TOPS20,<
ELMT%% M7.00,1;; SET TO -1 IF MONITOR IS 7 SERIES
>
IFN LSTATS,<
ELMT%% MRTMB.,1;; ;ADDR OF MTR PT TIME BUCKET
ELMT%% MROPT.,1;; ;POINTER TO BUCKET AREA
ELMT%% MROPTT,^D16;; ;TABLE INDEXED BY CHANNEL NUMBER--
; POINTS TO START OF BUCKET BLOCK
ELMT%% MRHDBP,1;; ;POINTER TO 128-WORD HEADER BLOCK
ELMT%% MRHDFL,1;; ;-1 WHEN WE HAVE WRITTEN THE HEADER
; BLOCK
ELMT%% MRTDBP,1;; ;POINTER TO TRAILER BLOCK
ELMT%% MRLDBL,1;; ;POINTER TO A BLOCK FROM LSTATS.DIR
; OR BUFFER FOR COPY FROM .TMP TO .MTO
IFN DBMS6,<
ELMT%% MRDDBP,1;; ;POINTER TO DBMS BLOCK
>
ELMT%% MRNM6,1;; ;SIXBIT FILE NAME FOR OUTPUT FILE
ELMT%% MRNMA,3;; ;ASCII FILE NAME FOR OUTPUT FILE
ELMT%% MRAFFT,1;; ;POINTER TO FAKE FILE TABLE
ELMT%% MRFKFT,1;; ;FAKE FILE TABLE ENTRY
IFE TOPS20,<
ELMT%% MBTIM.,1;; ;MTR PT START TIME
ELMT%% MRCHNN,1;; ;CHANNEL NUMBER IN AC POSITION
ELMT%% MRCHCF,1;; ;CHANNEL NUMBER OF APPENDED FILE
ELMT%% MRBLKO,1;; ;START TIME OF DISK METERING OVERHEAD
ELMT%% MRBKO.,1;; ;STATIC OVERHEAD FOR METERING
>
IFN TOPS20,<
ELMT%% MBTIM.,2;; ;MTR PT START TIME,-20 DOUBLE WD
ELMT%% MRJFN,1;; ;JFN OF METER FILE
ELMT%% MRLCJF,1;; ;JFN OF THE CURRENT FILE
ELMT%% MRBLKO,2;; ;START TIME OF DISK METERING OVERHEAD
ELMT%% MRBKO.,2;; ;STATIC OVERHEAD FOR METERING
IFN FTLSDR,<
ELMT%% MRLDNA,^D10;; ;ASCII FOR GTJFN OF LSTATS.DIR
ELMT%% MRLDJF,1;; ;JFN OF LSTATS.DIR
>;END IFN FTLSDR
>;END IFN TOPS20
IFN FTLSDR,<
ELMT%% MRLBPC,1;; ;BYTE PTR TO CURRENT FILE
ELMT%% MRLSZL,1;; ; SIZE LIMIT IN BLOCKS/PAGES
ELMT%% MRLFPR,1;; ;FILE POINTER (WHICH WORD STARTS AT @MRLDBL)
IFE TOPS20,<
ELMT%% MRCHLS,1;; ;TOPS10 CHANNEL FOR LSTATS.DIR
ELMT%% MRLLDR,1;; ;PPN WHERE LSTATS.DIR IS
ELMT%% MRLLDV,1;; ;SIXBIT DEVICE NAME WHERE LSTATS.DIR IS
ELMT%% MRCFNM,1;; ;SIXBIT NAME OF COMMON FILE
ELMT%% MRCFEX,1;; ;SIXBIT EXT OF COMMON FILE
>;END IFE TOPS20
>;END IFN FTLSDR
ELMT%% MRAPN.,1;; ;-1 IF APPENDING TO AN EXISTING FILE
;0 IF FILE IS NEW
ELMT%% MRFPGT,1,;; ;POINTER TO FILE/PAGE/REQ # TABLE
ELMT%% MRKILL,1;; ;-1 IF COBOL PROGRAM ABORTED
ELMT%% MRBNUM,1;; ;BLOCK NUMBER FOR IOHSTR ROUTINE
ELMT%% MRRERN,1;; ;-1 IF WE ARE "RERUN'ING"
; (THUS CAN'T WRITE IN .MTO FILE)
IFN TOPS20, ELMT%% MRPSTM,2;; ;PROGRAM START TIME
IFE TOPS20, ELMT%% MRPSTM,1;; ;(1 WORD FOR THE -10)
>;;END IFN LSTATS
ELMT%% DBSTP.,1;; ;FINAL LOCATION OF DBSTP$
;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
>
IFE TOPS20,<
ELMT%% ER.E10,1;; ;TOPS10 ERROR CODE WHEN MT.E10 IS SET
>
ELMT%% ER.RBG,1;; ;ERROR CODE FOR RMS BUG
;** THE FOLLOWING LOCATIONS SHOULD BECOME "VISIBLE" IN VERSION 13.
; THEY ARE HERE TEMPORARILY FOR 12B SO 12A IS COMPATIBLE.
ELMT%% SLRSW.,1;; ;SET TO -1 IF PROGRAM COMPILED /R
ELMT%% RMFLG.,1;; ;SET TO -1 IF RMS IS NEEDED
;;** END OF "SHOULD BECOME VISIBLE"..
IFN ANS74,<
;USED BY RMSIO
ELMT%% CVPRM.,2;; ;ARGUMENTS FOR CONVERSION ROUTINES
ELMT%% CVARGS,2;; ;CVTDB ARGS INCASE ERROR DETECTED
ELMT%% RMSVR.,1;; ;RMS VERSION NUMBER USER FOR ERROR TYPE-OUT
>
ELMT%% INTRAP,1;; ;-1 IF WE ARE PROCESSING AN APR TRAP
>;;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% TODAY.
DISEL% KDECL.
DISEL% KPROG.
DISEL% DSP.FP
DISEL% LINE.C
DISEL% LINE.D
DISEL% LINE.H
DISEL% LIN.RH
DISEL% CANCL.
IFN ANS74,<
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.1
DISEL% FLOT.2
DISEL% PD6.
DISEL% PD7.
DISEL% GD6.
DISEL% GD7.
DISEL% NEG.
DISEL% MAG.
DISEL% ADD.12
DISEL% ADD.21
DISEL% ADD.22
DISEL% SUB.12
DISEL% SUB.21
DISEL% SUB.22
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.
IFN ANS68,<DISEL% SEEK.>
IFN ANS74,<DISEL% RDNXT.>
DISEL% DELET.
DISEL% RERIT.
DISEL% PURGE.
DISEL% INIT.
DISEL% TERM.
DISEL% COMP.
DISEL% CMP.76
DISEL% SPAC.6
DISEL% NUM.6
DISEL% ALF.6
DISEL% ZERO.6
DISEL% POS.6
DISEL% NEG.6
DISEL% SPAC.7
DISEL% NUM.7
DISEL% ALF.7
DISEL% ZERO.7
DISEL% POS.7
DISEL% NEG.7
DISEL% COMP.D
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
IFN ANS68,<
DISEL% EXAM.
>
IFN ANS74,<
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% POS.9
DISEL% NEG.9
DISEL% ZERO.9
DISEL% ALF.9
DISEL% NUM.9
DISEL% ALF.9
DISEL% SPAC.9
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
IFN ANS74,<
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
IFN BIS,<
DISEL% XTND.E;; ;INLINE EXTEND INST ERROR
DISEL% ALP.66;; ;SIXBIT TO SIXBIT CONVERSION TABLE
DISEL% ALP.67;; ;SIXBIT TO ASCII ...
DISEL% ALP.69;; ;SIXBIT TO EBCDIC ...
DISEL% ALP.76;; ;ASCII TO SIXBIT ...
DISEL% ALP.77;; ;ASCII TO ASCII ...
DISEL% ALP.79;; ;ASCII TO EBCDIC ...
DISEL% ALP.96;; ;EBCDIC TO SIXBIT ...
DISEL% ALP.97;; ;EBCDIC TO ASCII ...
DISEL% ALP.99;; ;EBCDIC TO EBCDIC ...
DISEL% ALPS.6;; ;ALPHABETIC SIXBIT
DISEL% ALPS.7;; ;ALPHABETIC ASCII
DISEL% ALPS.9;; ;ALPHABETIC EBCDIC
DISEL% NUM.66;; ;NUMERIC SIXBIT TO SIXBIT
DISEL% NUM.67;; ;NUMERIC SIXBIT TO ASCII
DISEL% NUM.69;; ;NUMERIC SIXBIT TO EBCDIC
DISEL% NUM.76;; ;NUMERIC ASCII TO SIXBIT
DISEL% NUM.77;; ;NUMERIC ASCII TO ASCII
DISEL% NUM.79;; ;NUMERIC ASCII TO EBCDIC
DISEL% NUM.96;; ;NUMERIC EBCDIC TO SIXBIT
DISEL% NUM.97;; ;NUMERIC EBCDIC TO ASCII
DISEL% NUM.99;; ;NUMERIC EBCDIC TO EBCDIC
DISEL% CVTDB.;; ;CONVERT DECIMAL TO BINARY, SETUP DONE INLINE
DISEL% CBDOV.;; ;HANDLE OVERFLOW FOR BIN-DEC CONVERSION
DISEL% CVBD.6;; ; TRANSLATION TABLES FOR BIN-DEC EXTEND
DISEL% CVBD.7;;
DISEL% CVBD.9;;
DISEL% MUL.41
DISEL% MUL.42
DISEL% DIV.41
DISEL% DIV.42
DISEL% DVI41.;; ;4-WD DIVIDE, SAVE REMAINDER
DISEL% DVI42.;;
>;END IFN BIS
DISEL% KEY.
IFN TOPS20,<
DISEL% PSORT.
DISEL% PMERG.
DISEL% RELES.
DISEL% MERGE.
DISEL% MCLOS.
DISEL% RETRN.
DISEL% ENDS.
>
;;END OF COBOL-68 VERSION 12 RELEASED ITEMS
IFN BIS,<
DISEL% ADD.4R;; ;[540] QUAD-WORD ROUNDING FUNCTION
>;END IFN BIS
IFN TCS,<
DISEL% MBIND;; ;BIND FORM DATA AREA
DISEL% MNAME;; ;SET UP TCS SYSTEM NAME
>
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
DISEL% METER.;; ;I/O PERFORMANCE METER ROUTINE
IFN BIS,< ;[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
>;END IFN BIS ;[554]
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.
DISEL% MROUT.;; ;[621] OUTPUT AN LSTATS BLOCK
;[621] (MUST BE PRESENT IN ALL FLAVORS OF LIBOL)
;V12B RMS ENTRY POINTS
IFN ANS74,<
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% 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
>;END IFN ANS74
;;NEW STRING/UNSTRING ENTRY POINTS TO BE COMPATIBLE WITH V12A
DISEL% %STR.
DISEL% %STR.O
DISEL% %UNS.
DISEL% %UNS.O
IFN ANS74,<
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
>
IFN ANS74,<
IFN BIS,<
DISEL% CVDBT.;; ;[12B] CVTDB. WITH TRAILING SEP. SIGN
DISEL% CVDBL.;; ;[12B] CVTDB. WITH LEADING SEP. SIGN
>;END IFN BIS
>;END IFN ANS74
>;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 LIBSHR.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 DSTBL% (NAM,IR) <JRST 1,@NAM##(IR)>
>
IFN TOPS20,<
DEFINE DISEL% (NAM) <JRST NAM##> ;;PORTALS
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%,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 DSTBL% (NAM,IR) <DISEL% (NAM)>
DISTB% ;;DEFINE ADDRESSES
PURGE DISEL%,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 E0.6, E0.7, E0.9 IN LILOWS
DEFINE ELMT%% (N%,L<1>,V) <
IFIDN <N%><E0.6>,<N%:: E0.6.1=:E0.6+1>
IFIDN <N%><E0.7>,<N%:: E0.7.1=:E0.7+1>
IFIDN <N%><E0.9>,<N%:: E0.9.1=:E0.9+1>
IFIDN <N%><OU.TMP>,<N%::>
IFIDN <N%><DST.BP>,<N%::>
IFIDN <N%><DST.CC>,<N%::>
IFIDN <N%><PT.VAL>,<N%::>
IFIDN <N%><SRC.BP>,<N%::>
IFIDN <N%><SRC.CC>,<N%::>
IFIDN <N%><SR.TMP>,<N%::>
IFIDN <N%><DLM.BP>,<N%::>
IFIDN <N%><DLM.CC>,<N%::>
IFIDN <N%><TMP.DL>,<N%::>
IFIDN <N%><TL.VAL>,<N%::>
IFIDN <N%><CT.VAL>,<N%::>
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
;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