Trailing-Edge
-
PDP-10 Archives
-
BB-4148F-BM_1984
-
sources/dbcsym.mac
There are 19 other files named dbcsym.mac in the archive. Click here to see a list.
UNIVERSAL DBCSYM ;FOR DBCS, REGS, SYMBOLS, OFFSETS
; Copyright (C) 1974, 1984 by
; Digital Equipment Corporation, Maynard, Mass.
SEARCH GENDCL,DBSDCL
SEGSYM
;;; GLOBAL REGISTERS
GREG(X,15) ;EXTERNAL STATIC BASE REG
GREG(SS,14) ;CURRENT IN-CORE SUBSCHEMA REG
;;; SYSTEM LOCATION(S)
EXTERN DBCS.X,DBCS.R
;;; SUB-SCHEMA DESCRIPTOR
FIELD (SS.PT) ;PTR TO APPROP IN-CORE INFO
FIELD (SS.NLEN) ;LEN OF SS NAME
FIELD (SS.NAME,NAMLEN/CPW)
BLKSIZ (SIZSSD)
;***********************[ XSTAT. BEGINS HERE ]***************************
;;; EXTERNAL STATIC SYMBOLS
FIELD (REGAREA,X+1) ;MUST BE 1ST, DBGATE SAVES ALL REGS
;...SO UNWIND POSSIB
FIELD (USR.P) ;USER RETURN ADDR
FIELD (USEPROC) ;USE PROCEDURE ADDR IF ONE
FIELD (USRID) ;USER-ID FOR LO CKING
FIELD (CALLWD) ;DISPAT,,AP FOR INTERNALLY REPEATED VERB
FIELD (ALL.SS,SIZSSD*MAX.SS) ;THE STRINGS
FIELD (LAST.SS) ;WHEN SEE NEW SBIND, OFFSET IN ALL.
;...WHERE TO PUT INFO
FIELD (CUR.SS) ;SS SET TO THIS IN DBGATE EACH TIME
FIELD (STACKPT) ;WHERE THE TOP OF STACK IS (OFFSET)
ARRAY (DBSTACK,MAX.SS) ;FOR SETDB/UNSET
FIELD (TMPNAM,2) ;FOR CONSTRUCTING CANONICAL NAMES
FIELD (TMPNAREA,NAMLEN/CPW) ;WHEN COPYING IS NECES, DEFAULT DEST
;...IS HERE
;[1105] OTS.ID was unused OTS.CNT
BYTES (OTS,<<BLANK,^D18>,<ID,^D18>>) ;[1105] Which OTS
OTS%FOR==0 ;[1105] FORTRAN
OTS%COB==1 ;[1105] COBOL
FIELD (OTSFUN) ;WHICH FUNCT. ENTRY
FIELD (OTSTAT) ;STATUS RETURNED
FIELD (OTS.A1) ;ARG 1
FIELD (OTS.A2)
FIELD (PID.SELF) ;FOR USE OF IPCF IN TALKING TO DAEMDB
FIELD (PID.DAB) ;SENDER/RECEIVER RESPEC
FIELD (PID.PKT) ;MTA J-OPEN PACKET ADDRESS
FIELD (PAGLST) ;PTR TO STACK OF MODDED
;...PAGES (TOPS-20) FOR EOT BLKING
; *** INTRA-VERB LOCS COULD BE IN SS OR HERE...HERE SAVES SPACE
FIELD (ADDRHUSE) ;ADDR WHERE LH VECTORS START
FIELD (AOBCURN) ;AOBJ PTR FOR THE LIST OF CURNCY
;...SUPPRESS CONDS
FIELD (BUCKET) ;FOR CALC KEYS, WHICH BUCKET ON A PAGE
FIELD (CHK.RB) ;PTR TO PASSED RECBLK FOR CONSIS CHK
FIELD (CURSCA) ;CURR SYSCOM FOR REPORTING ERRORS
FIELD (DBK.HX) ;DBKEY OF NEW (HIGHER KEY) ENTRY IN
;...INDEX STRUCTURE
FIELD (DBK.PX) ;DBKEY OF RECORD PRIOR TO OBJ RECORD
;...BEING INSERTED
FIELD (DBK.NX) ;DBK OF NEXT REC FOR ALC.LN WHEN ORD
;...FIRST
DBK.BUOY=DBK.NX ;DBK OF LAST BUOY STORED
FIELD (DIRITM) ;DISPATCH INSIDE .ITM ENTRIES IN KITM
FIELD (HI.XB) ;PTS INTO TMP.XB AT WHERE HIGH KEY
;...(LOW ADDRESS) OF NEW IDX BLK IS
FIELD (INIDBK) ;SAVE A DBKEY TO CONTROL CLOSED
;...OWNERLESS RINGS (IE. BAD DATA)
FIELD (ITMLST) ;CONTAINS A DATA-CTL LIST AOBJ PTR
FIELD (JBACNT) ;HOW MANY TRANS/COMMANDS TO BACKUP
FIELD (LINHUSE) ;FOR COMPRESSED J IMS--SIZE OF LH VECTOR
FIELD (NUWA) ;0 SAYS KEY GUARAN IN UWA
;-1 SAYS INIT: CALL LOK.BF, ALL ELSE
;...SAYS ALREADY INITED
FIELD (OBJREC) ;TOP LEVEL VAR, REC VERB IS OPERATING ON
FIELD (OWNDBK) ;WHEN RECURSING FOR BTREE, THE ROOT
FIELD (PRIME) ;IN DBKALC, PRIME NUM USED TO TOUCH
;...EACH PAGE
FIELD (TMPDIR) ;DBMIO -1 IF READING .TMP/AID DIRECTORY
;...PAGE
FIELD (PRSTMP) ;IF -1 DONT DELETE TMP FILE
FIELD (DBSTOA) ;ADDR "BH.TOA(BUFHDR)" FOR TMP.IO
FIELD (PAGIOWD,2) ;FOR DUMP MODE I/O
FIELD (RANGBLK) ;FOR WHENEVER AREABLK/WITHIN BLK ARE
;...NEEDED & NEED A LOC
FIELD (RANGWID) ;IN DBKALC, LASP-1STP+1
FIELD (ALCPG) ;THE REQUESTED PAGE FOR ALC.LN
FIELD (ALCPG1) ;REQ PAGE+1
FIELD (ALCTID) ;TYPE-ID FOR ALC.LN
FIELD (ALRTID) ;RECORD (VS BUOY OR IDXBLK) TID
FIELD (RDCODE) ;RECORD DISTRIBUTION CODE
FIELD (RDINC) ;RD NUMBER OF PAGES PER WINDOW
FIELD (RDWNDO) ;RD CURRENT WINDOW
FIELD (RDFWPG) ;RD FIRST WINDOW PAGE
FIELD (RDLWPG) ;RD LAST WINDOW PAGE
FIELD (SETMTY) ;WE ARE VIA THE OWNER REC IE SET
;...IS EMPTY
FIELD (DELDEP) ;CURRENT DEPTH IN DEL.TREE
FIELD (DELMMB) ;NEG IF A MEMBERS CLAUSE
FIELD (DELAPS) ;AOBJ PTR TO SETS TO DELETE FROM
FIELD (TOATMP) ; TMP OR AID TMP -USED IN MIO
FIELD (NOAIDX) ;DBINFO WANTS NO AID FILES
FIELD (NOTMPX) ;DBINFO WANTS NO TMP FILES
FIELD (RETVAL) ;FOR IF-PREDICATES IN F10
FIELD (SAVKEY) ;KEEP A DBKEY AROUND WHILE IN DBKITM
FIELD (SETOCP) ;NON-0 MEANS SETUP CURR PRIOR OF SET
FIELD (SETUPLE) ;ANAL TO RANGBLK--THIS TIME IMAGE OF
;...RB.OBY TUPLE
FIELD (TMPLEFT) ;USED IN DBCHAR IN CONJUNCT WITH PUT.M
FIELD (TMP.SB) ;LAST SET BLK--FOR ERROR DOC--SET AT
;...TOP LEVEL (AN EXPLICIT INPUT ARG)
FIELD (TMP.RB) ;DITTO FOR RECORD BLK
FIELD (STO.RB) ;RECBLK FOR LAST REC STORED
FIELD (XWX.AB) ;AREA CAUSING CALL TO CL.OIP
FIELD (POR1ST) ; -1 IF VIA AND PRIOR OR FIRST
FIELD (PAG.LX) ;DBK OF LAST INDEX BLOCK TOUCHED
FIELD (SET.IS) ;INDEX BLOCK SIZE (WORDS)
FIELD (SET.NS) ;INDEX NODE SIZE (WORDS)
FIELD (XB.MAX) ;LARGEST INDEX BLOCK SIZE
FIELD (XL.MAX) ;MAX NUMBER OF RECS BETWEEN BUOYS
FIELD (XB.TMP) ;ADDR OF TMP IDX BLOCK
FIELD (XN.LOW) ;SAME AS LOW.XN
FIELD (XB.END) ;SAME AS END.XB
FIELD (TMP.XB,MAX.XB) ;CONTAINS WHAT WILL BE SPLIT OFF (HIGHER
;...KEYS) INDEX BLK
LOW.XN=TMP.XB ;...LOW.XN IS ADDR WITHIN (AT BEGIN--
;...HIGHER KEYS) OF THIS AREA--
;...NO OVERLAP GUARANTEED
END.XB=TMP.XB+MAX.XB ;WORD PAST END OF AREA
FIELD (TS.PAG) ;SAVE PAGE DURING TMP I/O
BYTES (TR,<<ID,^D18>,<ACT,^D18>>) ;ID NO. OF CURRENT TRANS.
;...PTR TO CURRENT EB IF A TRN
;...IS ACTIVE.
FIELD (UMKEY) ;FOR OPEN$ PRIVACY KEY
FIELD (VERBID) ;WHICH DML STATEMENT IS ACTIVE (FOR
;... EXCEP CONDS&JOURNAL)
FIELD (VFLAGS) ;THE FLAGS SET IN DBPORT
FIELD (VMODE) ;AREA MODE OF FIRST AREA TOUCHED BY
;...A VERB
FIELD (WINDOW) ;SWITCH THAT, WHEN ON, SAYS EXTERNALLY
;... SUPPLIED KEY
FIELD (XCEPID) ;THE ACTIVE EXCEP CODE, OR 0
; *** TRUE TEMPS
FIELD (FND.1) ;TEMP IN DBFIND
FIELD (FND.2) ;TEMP IN FIND6
FIELD (LINK.N) ;INSERT/REMOVE INHER MUTUALLY EXCLUSIVE
FIELD (LINK.P) ;...L.P/L.N ARE USED IN BOTH FOR DBKEYS
FIELD (OP.1)
FIELD (KERN.1) ;TEMP IN OUTER KERNEL
FIELD (KERN.2) ;ADDITIONAL TEMP
FIELD (KERN.3) ;ADDITIONAL TEMP
FIELD (AOBDATA) ;PTR TO DATA LIST ARG.
FIELD (PSIMFG) ;PATH SIMULATION FLAG
FIELD (CCLUSZ) ;CURRENT CLUSTER SIZE
FIELD (RK.ERRDAT) ;FINS6 RANGE KEY RESULTS
;[6%457] 0 = Exact match
;[6%457] 1 = Partial (generic) match
;[6%457] 2 = Non match
FIELD (RNGKEY) ;[6%457] Sorted set member
;[6%457] being sought has at
;[6%457] least one range key
FIELD (PV.FLG) ;[1105] extended per-verb flags
PV%XWX=1B35 ;[1105] XWX actually in progress
PV%UPD=1B34 ;[1105] update AREA-NAME, RECORD-NAME
;[1105] on exit
FIELD (XTMP3) ; UNUSED TMP AS OF 24-AUG-81
FIELD (XTMP4) ; UNUSED TMP AS OF 24-AUG-81
FIELD (XTMP5) ; UNUSED TMP AS OF 24-AUG-81
BLKSIZ (SIZ.X)
; *** CONTINUE WITH NON-ZERO STUFF...ALLOCATED ENUMERATIVELY WITHIN DBGATE
; *** THERE IS A DISAGREEMENT POSSIB HERE AS REGARDS OFFSETS
OFFS.==SIZ.X
VT.TMP==2*<CODE.V>
FIELD (VERBTEXT,VT.TMP)
FIELD (TIMTMP) ;CUMUL JOB (MS) SET AT ENTRY INTO DBCS
FIELD (TMPUSE) ;KLUDGE NECES BECAUSE OF INABILITY TO
;...DELAY USE.INIT CALL
;BUT IF 0, TIME-GATHERING IS SUPPRESSED
FIELD (TMPNLEN)
FIELD (TMPNUM,2)
FIELD (OTS.AC)
FIELD (OTSLIST,5)
FIELD (MEXBLK,3) ;PSEUDO-MEMBER-BLK FOR INDEX-LEAF
FIELD (FOPARG) ;PTS AT FOPBLK
FIELD (FOPBLK,FOPSIZ)
ALK.SIZ==LK.ALK+SIZ.MSK ;SIZE TO ALLOCATE FOR LOCK CONSTR.
FIELD (ARELK,ALK.SIZ) ;AREA TO CONSTRUCT AREA LOCKS IN
;...(REF'D BY LK BLK SYMS IN DBSDCL)
BYTES (LK,<<TIM,^D18>,<NRTRY,^D18>>) ;TIME TO WAIT FOR LOCK,
;...NUMBER OF TIMES TO RE-TRY.
FIELD (TBLOK) ;MODE OF PAGE LOCKS (SEE XSTAT.)
FIELD (LRUR) ;LRU REGARDLESS BUFFERING
FIELD (ENQ.HD,HDR.RS) ;ENQ/DEQ CTL FOR USAGE MODES
FIELD (ENQ.R,SIZ.RS) ;BLK FOR RETRIEVAL
FIELD (ENQ.U,SIZ.RS) ;BLK FOR UPDATE RESOURCE
FIELD (ENQ.HAR,HDR.RS) ;AREA LOCK BLOCK HDR
FIELD (EQSAFL) ;FLAGS,,CHAN
FIELD (EQSABD) ;PTR TO STRING
FIELD (EQSAPS) ;POOL SIZE
FIELD (EQSAMS) ;ADDX OF LOCK MASK
FIELD (EQEAFL) ;FLAGS,,CHAN (FOR EXC. LOCK)
FIELD (EQEABD) ;PTR TO STRING
FIELD (EQEAPS) ;POOL SIZE
FIELD (EQEAMS) ;LEN,,MASK ADDX FOR AREAS
FIELD (ENQ.ST,HDR.RS) ;SHARED TABLE LOCK BLK
FIELD (EQSTFL) ;FLAGS,,CHAN(SKECHAN)
FIELD (EQSTBD) ;PTR TO STRING(SKENAM)
FIELD (EQSTPS) ;POOL SIZE (UNU)
FIELD (EQSTMS) ;MASK ADDX (UNU)
BYTES (EQS,<<TLEN,^D18>,<TADX,^D18>>) ;TABLE LEN,,ADDX
;...(SEE DBSDCL-ST.XXX FOR
;...TABLE DEF'N)
FIELD (ENQ.PA,HDR.RS) ;PAGE LOCK BLOCK
FIELD (EQPAFL) ;FLAGS,,CHAN OF AREA
FIELD (EQPABD) ;500000+PAGE NUMBER
FIELD (EQPAPS) ;POOL SIZE,,NUM (UNU)
FIELD (ENQ.HJ,HDR.RS) ;BLK FOR JRN ENQS/DEQS
FIELD (ENQ.JX,SIZ.RS)
FIELD (ENQ.HC,HDR.RS) ;DITTO FOR CRU
FIELD (ENQCRU,SIZ.RS)
FIELD (TMPIOB,TIOSIZ) ;FOR OPEN OF TMP AREAS
FIELD (USI) ;USETI INSTRUC EXCEP FOR CHANNEL
FIELD (USO) ;USETO DITTO
FIELD (ININST) ;IN DITTO
FIELD (OUTINST) ;OUT DITTO
FIELD (RENAM) ;FOR .TMP FILE
FIELD (RELEES) ;RELEAS DITTO
FIELD (GSTAT) ;GETSTS
FIELD (FUSI,2) ; FILOP USETI ARG BLOCK
FIELD (FUSIA) ; ARG BLOCK LEN,,ADR
FIELD (FUSO,2) ; FILOP USETO ARG BLOCK
FIELD (FUSOA) ; ARG BLOCK LEN,,ADR
FIELD (FINP,2) ; FILOP INPUT AGR BLOCK
FIELD (FINPA) ; ARG BLOCK LEN,,ADR
FIELD (FOUT,2) ; FILOP OUTPUT AGR BLOCK
FIELD (FOUTA) ; ARG BLOCK LEN,,ADR
FIELD (FGTS) ; FILOP GETSTS ARG BLOCK
FIELD (FGTSA) ; ARG BLOCK LEN,,ADR
FIELD (FRLS) ; FILOP RELEAS AGR BLOCK
FIELD (FRLSA) ; ARG BLOCK LEN,,ADR
; *** NOW THE TOPS20 ONES...FEWER SINCE NO CHANNEL PROB
FIELD (JS.SIN)
FIELD (JS.SOUT)
FIELD (SKESPC,MAXFS20) ;SPACE FOR FULL FILE SPEC FOR SCH
BLKSIZ (SIZ.NZ)
SUBTTL IN-CORE SUB-SCHEMA SYMBOLS
;************************[ SS BEGINS HERE ]************************
; *** JOURNAL IN-CORE SYMBOLS
FIELD (JR.FIL) ;PTR TO THE (POSSIB EMPTY) FILBLK
;...FOR JOURNAL
FIELD (JR.CHAN) ;IO CHANNEL FOR JOURNAL, IF ONE
FIELD (JR.BUF) ;PTS TO I/O BUFFER OF JOURNAL, OR 0
FIELD (JR.BCUR) ;PTR TO WHERE TO CONTIN FILLING JOUR BUF
FIELD (JR.PCUR) ;PREVIOUS BCUR FOR WASTE CALCULATION
FIELD (JR.1STP) ;ADDR OF 1ST OF JBUFS
;ALSO CONTAINS FLAG TELLING
;...WHETHER JBUFS MOD'D SINCE LAST FLSH.
FIELD (JR.DNBUF) ;ADDR OF DATANAME FOR # OF BUF'S
FIELD (JR.BAFT) ;ADDR 1 PAST END OF JBUFS
FIELD (JR.JLP) ;ADDX OF J LBL BUF.
FIELD (JR.BKB) ;BACKUP BUFFER (WILL POINT AT
;(JR.BAFT-MAX.PS-JPSIZ)
FIELD (JR.PAREA) ;AREA FOR RE-CONSTRUCTING DB PAGE
;DURING BACKUP - WILL BE COINCIDENT WITH
;JOURNAL PAGE BUFFERS.
FIELD (JR.LEFT) ;HOW MUCH OF CURR BUFF STILL EMPTY
FIELD (JR.RNID) ;THE RUN-UNIT ID FOR THIS SS, SET
;...FROM JP.RNID
FIELD (JR.NEED) ;THE SPACE REQUIR OF LAST LOG BLK PUT
;...IN JOUR BUF
FIELD (JR.TLIM) ;TRANSAC LIM, IE. MAX NUM OF TRANSAC
;...THAT CAN BE IN JOURN AT ONCE
;NO LIM = 0
;0,,X = VALID LIMIT / -1,,X = IGNORE
;...BECAUSE MTA JRN
FIELD (JR.VIDX) ;INDEX/CNT OF VERBS PROCESSED WHILE
;...JOURNALING
FIELD (JR.BLOCK,MAX.JB) ;EXCEPT FOR PAGE IMAGES, LOG BLKS
;...COPIED FROM HERE TO JOURN
; *** OTHERS ARE SOMEWHAT MISCEL
FIELD (ACT.XC) ;FROM SL.XACT, FOR INTERCEPTS/NOTES
FIELD (AREALST) ;PTS TO EACH AREABLK
FIELD (SLLOK) ; ADMINISTRATIVE KEY
;*****************************************************************
;
; THE FOLLOWING IE CL.XXX AND CNT.XX ARE POSITION SENSITIVE
;
CNT.START==CL.COUNT ; FOR DBSTAT.MAC
FIELD (CL.COUNT,CODE.V) ;FOR STATISTICS
FIELD (CL.TIM,CODE.V)
FIELD (CNT.GET) ;NUM OF TIMES ENTERED GETREC/GETPAG
FIELD (CNT.GAM) ;TIMES LAST PAGE SAME AS CURR PAGE
;...(NO AREA SEL NECES)
FIELD (CNT.CRP) ;# OF CREATED DB PAGES
FIELD (CNT.GOS) ; NUM OF READS IO
FIELD (CNT.POS) ; NUM OF WRITES IO
FIELD (CNT.PPT) ; NUM OF PAGES READ (CLUS)
FIELD (CNT.CLR) ; NUM OF FREE READS DUE TO CLUSTERING
FIELD (CNT.TOS) ;# OF ACCESSES TO A-I DIRECTORY
FIELD (CNT.JPO) ;# OF J PAGES OUTPUT
FIELD (CNT.JQF) ;PERMATURE FLUSH - DB BUFS FULL
FIELD (CNT.JBF) ;PREMATURE FLUSH - JR BUFS FULL
FIELD (CNT.CJOUR) ; CONFLICT COUNT JOURNAL LOCKS
FIELD (CNT.CAREA) ; CONFLICT COUNT AREA LOCKS
FIELD (CNT.DEAD) ; NUM OF DEADLY EMBRACES
FIELD (CNT.TIMO) ; NUM OF LOCK TIME OUTS
FIELD (CNT.FPS) ; FIND PATH SIMULATIONS
FIELD (CNT.PIO) ; # OF IOS CAUSED BY PATH SIMULATIONS
FIELD (CNT.NLK) ; # OF LOCKS ACTIVE AT EACH ACCESS
FIELD (CNT.2LK) ; SQUARE OF NUM. OF LOCKS ACTIVE AT EACH
FIELD (CNT.ALK) ;COUNT OF LOCK ACCESSES
FIELD (CNT.T1) ; DBSTAT/DBCHAR TMP
FIELD (CNT.T2) ; DBSTAT/DBCHAR TMP
CNT.END==CNT.T2 ; FOR DBSTAT.MAC
CNT.SIZ==CNT.T2-CL.COUNT+1
;*****************************************************************
FIELD (PADFLG) ;DBCHAR NO PAD OR FILL IF -1
FIELD (CUR.RU) ;DBKEY OF CUR REC OF RUN-UNIT
FIELD (TSC.RU) ;DBK OF CRU AT TRANSACTION START
FIELD (CUR.RB) ;PTS TO RECBLK OF CUR.RU (ACCESSED BY
;...VERTYP)
FIELD (TSC.RB) ;RECBLK OF CRU AT TRANSACTION START
FIELD (DATCHK) ;USED DURING BINDING TO CHK FIELD SIZES
FIELD (HASHVEC) ;FOR SYMBOL TABLE (ALL AREAS,SETS,RECS)
FIELD (HASHLEN) ;NUM ENTRIES IN HASHVEC
;MOVED HERE FROM XSTAT
BYTES (LK,<<MAX,^D18>,<JFN,^D18>>) ;MAX NUM. OF LOCKS(20)
;JFN OF SHARED LOCK FILE
BYTES (LK,<<ACC,^D18>,<BLK,^D18>>) ;ACCESS CONTROL TYPE
;ADDX OF LOCK PAGE (20 ONLY)
;END OF MOVE FROM XSTAT
FIELD (LOKNAM,SHORT/CPW) ;RES. NAME FOR LOCKING (FROM SETDB)
FIELD (IDVEC) ;EACH AREA/SET/REC/DATAM/TRN HAS ENTRY
FIELD (IDHIGH) ;HIGHEST ID IN THIS SCHEMA
FIELD (LASBUF) ;FOR MAXING IN CORE ACCESSES WITHOUT
;...AREA SEARCH
FIELD (LAS.AB) ;LAST AREA REFERENCED (IN KERNEL)
FIELD (MAX.PS) ;MAX PAGE SIZE OF AREAS IN SS, USED TO
;...HELP ALLOC JOUR BUFS
FIELD (NEEDBIND) ;FOR INVOKE'S IN SUBPROGS, THIS TELLS
;...WHETHER 1ST TIME THRU
FIELD (NUMRESH) ;CTLS WHETHER PSW.RESH ON
FIELD (NUMUPSH) ;CTLS WHETHER PSW.UPSH ON
FIELD (PSW) ;PROGRAM STATUS WORD (INTRA-VERB LOC IS ;...LEFT-SIDE(X))
FIELD (RECCUR) ;FOR A DBKEY DURING BINDING WHICH MAY
;...NEED TO BE CURR AGAIN
FIELD (RECDOFF) ;FOR FINALIZING DB.OFF
FIELD (RECLIST) ;AOBJ FOR TIDVEC
FIELD (SAVBAS) ;DURING BINDING, SCHIO'S BASE REG
SKEDIT==JR.VIDX ;KLUDGE A LITTLE, NEEDED ONLY FOR DBINFO
FIELD (SKENAM,SHORT/CPW) ;SCHEMA OF THIS SS
FIELD (SKECHAN) ;TO SUPPORT SIMUL UPD...A DB CHANNEL
FIELD (SKERUN) ;DET FROM .SCH FILE, PUT INTO JOURNAL
;...LAB BLK
FIELD (SSMASK) ;BETWEEN CALLS TO BIND HOLDS WHICH
;...SUB-SCHEMA
;ONCE BINDING IS FINISHED, PERM IDENTS
;...SS BP PTING TO INTO ALL.SS
FIELD (SYSREC) ;DESCRIPTOR FOR SYSTEM RECORD=
;...AREABLK,,RECBLK OF IT
FIELD (SYSCOM) ;PTR TO USER'S SYSCOM AREA
FIELD (TIDVEC) ;PTR (ADJUSTED BY SYSTID) TO RECTYP-ID
;...VECTOR FOR RECS IN SS
FIELD (TIDHIGH) ;ANAL IDHIGH
FIELD (TIM.SS) ;DITTO ... FOR THE PT IN TIME SS INVOKED
FIELD (TIMDBCS) ;ACCUM MS IN DBCS
FIELD (TRNLIST) ;POINTS TO LIST OF TRANSACTIONS
FIELD (USEVEC) ;PTR TO THE LIST OF USE CONDS SPEC
FIELD (USELAST) ;FOR FORTRAN, WHERE WITHIN USEVEC TO
;...ALLOC A NEW COND
FIELD (VERBIX) ;KEEP CNT OF # OF VERBS EXEC
FIELD (SSTMP1) ; UNUSED AS OF 24-AUG-81
FIELD (SSTMP2) ; UNUSED AS OF 24-AUG-81
FIELD (SSTMP3) ; UNUSED AS OF 24-AUG-81
FIELD (SSTMP4) ; UNUSED AS OF 24-AUG-81
FIELD (SSTMP5) ; UNUSED AS OF 24-AUG-81
BLKSIZ (SIZ.SS)
;************************** END (SS) ********************************
; *** EACH FIELD WHICH IS A LIST PTR HAS ASSOC WITH IT
; *** SYMBOLS WHICH DENOTE ENTRIES IN THE LIST
WORD (ADR,<<NAB,^D18>,<AB,^D18>>)
;NEW AB, FOR V3TOV5
;PTR TO EACH AREA BLK (VIA AREALST)
WORD (ADR,<<RB,^D36>>) ;TIDVEC
WORD (UV,<<XCEP,^D18>,<PROC,^D18>>)
;THE EXCEPTION CODE
;THE ADDR TO GO TO IF IT OCCURS
;PTR TO EACH RECBLK IN SS
WORD (ADR,<<EB,^D36>>) ;TRANSACTION BLOCK PTR
WORD (ADR,<<KB,^D36>>) ;THE TRANSACTION AREA BLOCK PTR
; ******************** THE SYSCOM SUBSTRUCTURE ****************
FIELD (ARNAM,NAMLEN/CPW)
FIELD (RECNAM,NAMLEN/CPW)
FIELD (ERSTAT)
FIELD (ERSET,NAMLEN/CPW)
FIELD (ERREC,NAMLEN/CPW)
FIELD (ERAREA,NAMLEN/CPW)
FIELD (ERCNT)
FIELD (DBKREG)
FIELD (ERDREG) ;ERROR DATA REG
BLKSIZ (SIZ.SC)
SUBTTL ENTRY. POINT DEFINITION
DEFINE ENTRYS<
ENTRY. (CLOSED,CLOSE$,C.CLOSE,ENQ.ALT) ;ENQ.X SINCE PLAYS WITH
;...J LABEL PAGE
;EAV IS STRONGER THAN
;...X SINCE LIKE OPEN
ENTRY. (CLOTR,CLOTR$,C.CLOTR,JR.OVU!JR.UPD!ENQ.J)
ENTRY. (DELETR,DELET$,C.DELETE,JR.UPD!ENQ.X!CRU.MUST!VAC.UPD)
ENTRY. (DELTR,DELTR$,C.DELTR,JR.UPD!ENQ.X!OK.SUS) ;IS JR.OVU,
; BUT WANT A CMD HDR
; FOR IT!
ENTRY. (FIND1,FIND1$,C.FIND,ENQ.SH)
ENTRY. (FIND2,FIND2$,C.FIND,ENQ.SH)
ENTRY. (FIND3,FIND3$,C.FIND,ENQ.SH)
ENTRY. (FINDO,FINDO$,C.FIND,ENQ.SH)
ENTRY. (FIND4,FIND4$,C.FIND,ENQ.SH)
ENTRY. (FIND5,FIND5$,C.FIND,ENQ.SH)
ENTRY. (FIND6,FIND6$,C.FIND,ENQ.SH)
ENTRY. (FINS6,FINS6$,C.FIND,ENQ.SH)
ENTRY. (<GETS,GET>,GET$,C.GET,CRU.MUST!ENQ.SH)
ENTRY. (<INSRT,INSERT>,INSER$,C.INSERT,JR.UPD!ENQ.X!CRU.MUST!VAC.UPD)
ENTRY. (<MODIF,MODIFY>,MODIF$,C.MODIFY,JR.UPD!ENQ.X!CRU.MUST!VAC.UPD)
ENTRY. (OPEND,OPEN$,C.OPEN,ENQ.ALT) ;ENQ.ALT PLAYS SAFE SINCE OPEN
;...CAN INCREASE SIMULTANEITY
ENTRY. (OPENT,OPENT$,C.OPNT,JR.OVU!JR.UPD!ENQ.J)
ENTRY. (<REMOV,REMOVE>,REMOV$,C.REMOVE,JR.UPD!ENQ.X!CRU.MUST!VAC.UPD)
ENTRY. (<STORE,STORED>,STORE$,C.STORE,JR.UPD!ENQ.X!VAC.UPD)
;;; NON-VERB ENTRY. POINTS
; *** CONTEXT AFFECTING ENTRY. PTS
COMMENT \[1105] Change the entry SBIND to %SBIND. Compilers will still refer
to SBIND, but during the link, ots.REL will resolve 'SBIND==%SBIND'
and request DBMS.REL.
\
ENTRY. (%SBIND,SBIND$,C.BIND,OK.NOSS!VAC.BIND!OK.SUS!SCH.IO) ;[1105]
; *** OK.SUS ON IN 2 BELOW SO THAT THE BINDING EXCEP WILL
; BE CORRECTLY RETURNED
; *** BUT NO OTHER VERBS AFTER THE FAULTY BINDING WILL SUCCEED
ENTRY. (BIND,BIND$,C.BIND,VAC.BIND!OK.SUS!SCH.IO)
ENTRY. (EBIND,EBIND$,C.BIND,VAC.BIND!OK.SUS!SCH.IO)
COMMENT \[1105] Make INITDB and SETUSE share an entry, and decide which
is which in the USE$ code. In DBGATE, 'SETUSE==INITDB'.
This is an interim fix, until more entries
can be added. At that time, make it look like this:
ENTRY. (INITDB,USEC$,C.BIND,VAC.BIND!OK.NOSS)
ENTRY. (SETUSE,USEF$,C.BIND,VAC.BIND)
\
ENTRY. (INITDB,USE$,C.BIND,VAC.BIND!OK.NOSS) ;[1105]
ENTRY. (SETDB,SETDB$,C.CALL,VAC.CALL!OK.SUS)
ENTRY. (UNSET,UNSET$,C.CALL,VAC.CALL!OK.SUS)
ENTRY. (SAVESS,SAVES$,C.CALL,VAC.CALL)
; *** JOURNAL ENTRY. PTS
ENTRY. (JMNAME,JMNAM$,C.CALL,VAC.CALL)
ENTRY. (JMDISK,JMDIS$,C.CALL,VAC.CALL)
ENTRY. (JMAFT,JMAFT$,C.CALL,VAC.CALL)
ENTRY. (JMBEF,JMBEF$,C.CALL,VAC.CALL)
ENTRY. (JMBOTH,JMBOT$,C.CALL,VAC.CALL)
ENTRY. (JMNONE,JMNON$,C.CALL,VAC.CALL)
ENTRY. (JSTRAN,JSTRN$,C.CALL,VAC.CALL!JR.OVU!JR.UPD!ENQ.X)
ENTRY. (JETRAN,JETRN$,C.CALL,VAC.CALL!JR.OVU!JR.UPD!ENQ.X)
ENTRY. (JBTRAN,JBTRN$,C.CALL,VAC.CALL!JR.OVU!JR.UPD!ENQ.X!OK.SUS)
ENTRY. (JRDATA,JRDAT$,C.CALL,VAC.CALL!JR.OVU!JR.UPD!ENQ.X)
ENTRY. (JRTEXT,JRTEX$,C.CALL,VAC.CALL!JR.OVU!JR.UPD!ENQ.X)
; *** STATISTICS
ENTRY. (STATS,STATS$,C.CALL,VAC.CALL)
; *** PSEUDO-HOST ACTIONS: PREDICATES & COPY
ENTRY. (MOVEC,MOVE$,C.HOST)
ENTRY. (<EMPTY,SETCON>,EMPTY$,C.HOST,ENQ.SH) ;KEEP LOUSY NAMES RATHER
;...THAN CHANGE COMPILER
ENTRY. (<RECMO,TENANT>,TENAN$,C.HOST,ENQ.SH)
ENTRY. (<RECMEM,MEMBER>,MEMB$,C.HOST,ENQ.SH)
ENTRY. (<RECOWN,OWNER>,OWNER$,C.HOST,ENQ.SH)
ENTRY. (CALCHN,CALCH$,C.CALL,VAC.CALL)
ENTRY. (GETUID,GETUI$,C.CALL,VAC.CALL)
; *** USER DEFINABLE ENTRY POINTS
ENTRY. (DBUSR1,SAVES$,C.USER,VAC.CALL) ;NOOPS
ENTRY. (DBUSR2,SAVES$,C.USER,VAC.CALL)
ENTRY. (DBUSR3,SAVES$,C.USER,VAC.CALL)
ENTRY. (DBUSR4,SAVES$,C.USER,VAC.CALL)
ENTRY. (DBUSR5,SAVES$,C.USER,VAC.CALL)
; *** COBOL PANIC EXIT
ENTRY. (DBSTP$,DBPST$,C.CALL,OK.SUS!OK.NOSS)
>
COMMENT\ [1105] add third expansion for this macro, used to resolve
DBMS entry points in code that does not support DBMS
\
DEFINE ENTRY.(USERN.,OTSN.,VERB.,ACT..)<
IFN MODE.-DUMGAT,<
ACT.==0
IFNB <ACT..>,<ACT.==ACT..>
>
IFE MODE.-PORTAL,<<VERB.>B<EV%VERB>+<ACT.>B<EV%FLAG>+ OTSN.##>
IFN MODE.-PORTAL,<
IRP USERN.,<
USERN.:
ENTRY USERN.
>
IFE MODE.-GATE,<
PUSHJ P,OTSCALL
>
>
>
PORTAL==1
GATE==2
DUMGAT==3
;[1105] end
SUBTTL MACROS
DEFINE EXNODE(CODE.,ADR.)<
XC.'CODE.::
XC%'CODE.==:XC.'CODE.-VEC.XC+1
IFNB <ADR.>,<PUSHJ P,XC'ADR.>
IFB <ADR.>,<PUSHJ P,DBSABORT>
>
DEFINE EXVAL(STAT.,CODE.)<C.'STAT.*^D100 + EXCODE(CODE.)>
DEFINE EXVALL(STAT.,CODE.)<C.'STAT.*^D100 + XC%'CODE.>
DEFINE EXACT(CODE.)<XC'CODE.:>
DEFINE EXMIDX(CODE.)<XC$'CODE.>
DEFINE EXMSG(CODE.)<XC$'CODE.##>
; OR
; EXCEP (OS,1536,(1))
; SUBCD. IS THE UNIQUE POSITION LOCATING CODE WHICH WILL END
; UP IN THE RIGHT HALF OF ERREG(SYSCOM),
; LFTCD.IS MEANS OF FOLDING IN YET ANOTHER CODE (INTO THE
; LEFT HALF OF ERREG(SYSCOM)) SUCH AS THE MONITOR RETURNED
; ERROR CODE.
DEFINE XSYM(CODE.) <IFDEF X'CODE.,<IF1 <PRINTX X'CODE. PREVIOUSLY DEFINED>>
IFNDEF X'CODE.,<
LALL
X'CODE.=CODE.
SALL>>
DEFINE XP(CODE.,NUM.,NAM.)<
IF2 <PRINTX ;!*;'CODE. X'NUM. NAM.>>
DEFINE EXCEP(CODE.,SUBCD.,LFTCD.)<
TCOD.=MODCD.+^D<'SUBCD.'>
RADIX 10
XP(CODE.,\TCOD.)
XSYM(\TCOD.)
RADIX 8
JRST [HRRZI R0,TCOD. ;[6%520]FOR SUBSID ERR REG
IFNB <LFTCD.>, ;[6%520]
<HRL R0,LFTCD.>
PUSHJ P,ERRRG.##
PUSHJ P,XC.'CODE.##]> ;ERROR PATH TO DBCS.X
DEFINE EXMODL(MODNM.)<
MODCD.=E$'MODNM.
MDDCD.==^D500>
; (E.G. IN DBBIND: EXMODL(BIND))
DEFINE EXJRST(CODE.,SUBCD.,LFTCD.)<EXJ'SUBCD.
TCOD.=MODCD.+^D<'SUBCD.'>
RADIX 10
XP(CODE.,\TCOD.)
XSYM(\TCOD.)
RADIX 8
DEFINE EXJ'SUBCD.
<[HRRZI R0,MODCD.+^D<'SUBCD.'> ;[6%543] error data nmbr
IFNB <LFTCD.>, <HRL R0,LFTCD.> ;[6%543] jsys error code
PUSHJ P,ERRRG.##
PUSHJ P,XC.'CODE.##]>> ;ERROR PATH TO DBCS.X
DEFINE ERC(CODE.,SUBCD.,LFTCD.)<
ERCAL [HRRZI R1,400000 ;PROCESS HANDLE
GETER ; GET THE ERROR
MDDCD.=MDDCD.+1
EXCEP (CODE.,MDDCD.,R2)]>
;USED IN -20 VERSIONS TO BYP SOFT INTERR
DEFINE EXCODE(CODE.)<XC%'CODE.##>
E$AR.W==^D1000
E$CALC==^D2000
E$BIND==^D3000
E$CLC.==^D4000
E$CHAR==^D5000
E$CLOS==^D6000
E$CURN==^D7000
E$DEL==^D8000
E$FIND==^D9000
E$GAT==^D10000
E$GET==^D11000
E$IF==^D12000
E$JOUR==^D13000
E$KALC==^D14000
E$KIO==^D15000
E$KITM==^D16000
E$LEAV==^D17000
E$MANY==^D18000
E$MIO==^D19000
E$MLOK==^D20000
E$MOC==^D21000
E$MOD==^D22000
E$MOVE==^D23000
E$OPEN==^D24000
E$OTSI==^D25000
E$PORT==^D26000
E$REM==^D27000
E$SET==^D28000
E$STAT==^D29000
E$STOR==^D30000
E$TRAN==^D31000
E$WITH==^D32000
E$ID.I==^D33000 ;IN DBBIND
E$REC.==^D34000 ;IN DBBIND
E$SCH.==^D35000 ;IN DBBIND
E$SCHI==^D36000 ;IN DBBIND
E$SETD==^D37000 ;IN DBBIND
E$STAT==^D38000 ;IN DBBIND
E$TID.==^D39000 ;IN DBBIND
E$TRN.==^D40000 ;IN DBBIND
E$TRU.==^D41000 ;IN DBBIND
E$UPD.==^D42000 ;IN DBBIND
E$XSTA==^D43000 ;IN DBGATE
E$INS==^D44000
E$IIDB==^D45000 ;IN DBINFO
E$IMES==^D46000 ;IN DBINFO
E$MIDB==^D47000 ;IN MNDIDB
E$MCOM==^D48000 ;IN MNDCOM
E$MUTL==^D49000 ;IN MNDUTL
E$DMAN==^D50000 ;IN MNDMAN
E$GMEM==^D51000 ;IN GENMEM
DEFINE TRACE<
>
DEFINE RANGMAK(RANG.,AB.)<
MOVE R1,AB.
MOVEI R0, AB.1STP(R1)
ST R1, RB,RAB,+RANG.
ST R0, RB,RWB,+RANG.
>
; *** THE SET OF LOAD MACROS EACH TAKE A DBNAME INDEX
; *** AND CONVERT IT TO AN IN-CORE BLOCK PTR
DEFINE LOAD(REG,IDX,TEST,TREG.,%EX)<
TREG==R0
IFNB <TREG.>,<TREG==TREG.>
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
SKIPL REG,IDX ;;SHOULD RUN FROM 0 TO N
CAMLE REG,IDHIGH(SS)
LINK ARG.SYM ;;VERY SPECIAL, SEE CODE IN DBCHAR
SKIPN TREG,REG ;;TRICKY...WANT TREG 0 IF REG 0 BUT
;;...ONLY IF EXPLIC TREG (IE. GTR 0)
JRST %EX
ADD REG,IDVEC(SS) ;;ADDR NOT KNOWN TILL RUN-TIME
IFN TREG,<HLRZ TREG,0(REG)>
IFNB <TEST>,<
IFE TREG,<HLRZ TREG,0(REG)>
CAIE TREG,TEST
EXCEP (ARG,MDDCD.)
>
HRRZ REG,0(REG) ;;HORRIBLE KLUDGE TO MAKE 0TH ELEM LT 0
IFB <TEST>,<JUMPE REG,EXJRST (ARG,<MDDCD.>)> ;;EMPTY SLOT ILLEGAL
%EX:
>
DEFINE LOADEE(REG,IDX,TEST,TREG.)< ;;MAKE 1 ILLEGAL ALSO
TREG==R0
IFNB <TREG.>,<TREG==TREG.>
SKIPLE REG,IDX ;;SHOULD RUN FROM 0 TO N
CAMLE REG,IDHIGH(SS)
LINK ARG.SYM ;;VERY SPECIAL, SEE CODE IN DBCHAR
ADD REG,IDVEC(SS) ;;ADDR NOT KNOWN TILL RUN-TIME
IFN TREG,<HLRZ TREG,0(REG)>
IFNB <TEST>,<
IFE TREG,<HLRZ TREG,0(REG)>
CAIE TREG,TEST
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (ARG,<MDDCD.>)
>
HRRZ REG,0(REG)
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
JUMPE REG,EXJRST (ARG,<MDDCD.>) ;EMPTY SLOT ILLEGAL
>
DEFINE LOADE(REG,IDX,TEST,TREG.,%EX)< ;;MAKE IT A "SKIP INSTRUCTION"
TREG==R0
IFNB <TREG.>,<TREG==TREG.>
SKIPL REG,IDX ;;SHOULD RUN FROM 0 TO N
CAMLE REG,IDHIGH(SS)
LINK ARG.SYM ;;VERY SPECIAL, SEE CODE IN DBCHAR
SKIPN TREG,REG ;;TRICKY...WANT TREG 0 IF REG 0 BUT
;;...ONLY IF EXPLIC TREG (IE. GTR 0)
JRST %EX+1
ADD REG,IDVEC(SS) ;;ADDR NOT KNOWN TILL RUN-TIME
IFN TREG,<HLRZ TREG,0(REG)>
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
IFNB <TEST>,<
IFE TREG,<HLRZ TREG,0(REG)>
CAIE TREG,TEST
EXCEP (ARG,<MDDCD.>)
>
HRRZ REG,0(REG) ;;HORRIBLE KLUDGE TO MAKE 0TH ELEM LT 0
IFB <TEST>,<JUMPE REG,EXJRST (ARG,<MDDCD.>)> ;EMPTY SLOT ILLEGAL
%EX:
>
DEFINE LOADN(REG,IDX,TEST,TREG.,%EX)< ;;MAKE IT A "SKIP INSTRUCTION"
TREG==R0
IFNB <TREG.>,<TREG==TREG.>
SKIPL REG,IDX ;;SHOULD RUN FROM 0 TO N
CAMLE REG,IDHIGH(SS)
LINK ARG.SYM ;;VERY SPECIAL, SEE CODE IN DBCHAR
SKIPN TREG,REG ;;TRICKY...WANT TREG 0 IF REG 0 BUT
;;...ONLY IF EXPLIC TREG (IE. GTR 0)
JRST %EX
ADD REG,IDVEC(SS) ;;ADDR NOT KNOWN TILL RUN-TIME
IFN TREG,<HLRZ TREG,0(REG)>
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
IFNB <TEST>,<
IFE TREG,<HLRZ TREG,0(REG)>
CAIE TREG,TEST
EXCEP (ARG,<MDDCD.>)
>
HRRZ REG,0(REG) ;;HORRIBLE KLUDGE TO MAKE 0TH ELEM LT 0
IFB <TEST>,<JUMPE REG,EXJRST (ARG,<MDDCD.>)> ;EMPTY SLOT ILLEGAL
SKIPA
%EX:
>
DEFINE VERTYP(IDX)<
LOADN RECBLK,IDX
MOVE RECBLK,CUR.RB(SS) ;;NEXT INSTRUCT SUPERF WHEN THIS PATH
;;...(IE. NO-NAME) TAKEN
CAME RECBLK,CUR.RB(SS)
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (RWT,<MDDCD.>)
>
DEFINE AROFKEY(PAG.,ARLIS.,ABLK.)<
MOVE ARLIS.,AREALST(SS)
LD ABLK., ADR,AB,(ARLIS.) ;;BEGIN LOOP
CAMLE PAG.,AB.LASP(ABLK.)
AOBJN ARLIS.,.-2
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
JUMPGE ARLIS.,EXJRST (KIA,<MDDCD.>) ;;EXHAUSTED LIST?
CAMGE PAG.,AB.1STP(ABLK.) ;;HAVE UPPER-BOUNDED ALREADY
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (KIA,<MDDCD.>) ;;...IF BELOW LOWER-BOUND, KEY
;;...IS BAD
>
DEFINE ENQ.IT(BLK.,TYP.,RNA.)<
IFN TOPS10,<
MOVSI R1,TYP.
HRRI R1,BLK.
ENQ. R1,
JRST [CAIN R1,ENQRU%
RNA.
CAIN R1,ENQDR%
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (DOR,<MDDCD.>)
CAIE R1,ENQQE%
CAIN R1,ENQNC%
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (RSX,<MDDCD.>) ;MONITOR RAN OUT OF ROOM IN SOME WAY
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (QOS,<MDDCD.>)] ;ALL OTHERS
> ;END IFN TOPS10
IFN TOPS20,<
MOVEI R1,TYP.
MOVEI R2,BLK.
ENQ
JRST [CAIN R1,ENQX6 ;[6%520] fixed elsewhere
RNA.
CAIN R1,OPNX9 ;[1160] CFS; ENQued on other CPU
MDDCD.=MDDCD.+1 ;[1160] CFS; Next instance
EXCEP (RNA,<MDDCD.>) ;[1160] CFS; RNA
CAIN R1,ENQX5
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (DOR,<MDDCD.>,R1) ;[6%520]
CAIE R1,ENQX18
CAIN R1,IPCFX8 ;NO MONITOR CORE
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (RSX,<MDDCD.>,R1) ;[6%520]
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
EXCEP (QOS,<MDDCD.>,R1)] ;[6%520]ALL ELSE
> ;END IFN TOPS20
>
DEFINE DEQ.IT(BLK.,TYP.)<
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
IFN TOPS10<
MOVSI R1,TYP.
HRRI R1,BLK.
DEQ. R1,
EXCEP (QOS,<MDDCD.>,(R1))
>
IFN TOPS20<
MOVEI R1,TYP.
MOVEI R2,BLK.
DEQ
EXCEP (QOS,<MDDCD.>,(R1))
>
>
DEFINE ENQC.IT(BLK.)<
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
IFN TOPS10,<
MOVEI R0,BLK.
MOVEI R1,OTSTAT(X) ;(MUST BE AC+1)USE THESE 3 WDS
ENQC. R0,
EXCEP (QOS,<MDDCD.>,(R0))
HRRE R0,OTSTAT(X)
>
IFN TOPS20,<
MOVEI R1,.ENQCS
MOVEI R2,BLK.
MOVEI R3,OTSTAT(X)
ENQC
EXCEP (QOS,<MDDCD.>,(R1))
HRRE R0,OTSTAT(X)
>
>
;;; BINDING MACROS
DEFINE ALCBLK(TYP.)<
IFNDEF TYP.'L.NAM,<
FUNCT ALC.M,<[SIZ.'TYP.'B]>
MOVEM R0,CIC
>
IFDEF TYP.'L.NAM,<
HRRZ R0,TYP.'L.NLEN(CRU)
MOVEI CIC,SIZ.'TYP.'B
GLOYO TRU.BLK ;;SETS CIC & R0
MOVSI R1,TYP.'L.NLEN(CRU)
HRRI R1,TYP.'B.NLEN(CIC)
BLT R1,@R0
FUNCT UPDSY.,<TYP.'B.ID(CIC)>
>
IFDEF TYP.'L.NMID,<
LD R1, TYP.'L,NMID,(CRU)
ADD R1,IDVEC(SS)
HRLI CIC,TID.'TYP.'L
MOVEM CIC,0(R1)
IFDEF TYP.'L.NAM,<MOVEM R1,TYP.'B.ID(CIC)>
HRRZS CIC ;;NO TYPE ID EXCEPT IN VECTOR
>
>
DEFINE LOADBN(REG,TEST,TREG.)< ;;USED DURING BINDING
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
TREG==R0
IFNB <TREG.>,<TREG==TREG.>
JUMPLE REG,EXJRST (SOB,<MDDCD.>)
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
CAMLE REG,IDHIGH(SS)
EXCEP (SOB,<MDDCD.>)
ADD REG,IDVEC(SS)
IFN TREG,<HLRZ TREG,0(REG)>
IFNB <TEST>,<
IFE TREG,<HLRZ TREG,0(REG)>
CAIE TREG,TEST
MDDCD.=MDDCD.+1 ;EXCEPTION CODE
JUMPN TREG,EXJRST (SOB,<MDDCD.>) ;;IF ENTRY 0, WILL/SHOULD TAKE
;;...NON-SKIP BELOW
>
HRRZ REG,0(REG)
SKIPG REG
>
DEFINE DO.F3(SET.,FAIL.)<
FUNCT FIND3%,<KEY NEXT,ZERO,[SET.],KEY SET>
JUMPE R0,FAIL.
MOVEM R1,CRU
>
END