UNIVERSAL GENDCL FOR COBOL 11(460) ;COPYRIGHT (C) 1974,1975, 1976, 1977, 1978, 1979 BY ;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. SUBTTL LINKAGE MACROS DEFINE SEGSYM< ;;; EXISTS SO THAT PASS 2 RE-INITS WILL OCCUR OFFS.==0 LMREG.==0 LGREG.==16 ;;; ALLOW GROUP OF MODULES TO HAVE SOME COMMON REGS (MU=MOD UNIV) IFDEF MUREG., IFNDEF MUREG., HMREG.==MREG. HIGH==1 > DEFINE SEGMEN< TWOSEG RELOC 0 GDATA.==0 ;;FOR GDATA'S IFDEF TEST SEGSYM > DEFINE SAVE (A)< IRP A,< PUSH P,A>> DEFINE RESTOR (A)< IRP A,< POP P,A>> DEFINE BLTSAV(LO.,HI.)< HRRZ R0,P ADD R0,[LO.,,1] ;;THE 1 GETS YOU TO 1ST UNUSED WORD ON STACK BLT R0,HI.(P) T1.==HI.-LO.+1 ADD P,[T1.,,T1.] ;;THE PUSH SIMULATION > DEFINE BLTPOP(LO.,HI.)< T1.==HI.-LO.+1 SUB P,[T1.,,T1.] HRLZ AP,P ADD AP,[1,,LO.] BLT AP,HI. > DEFINE SAVTMPS> DEFINE POPTMPS> DEFINE SAVALL < IFN HMREG.-MREG.,< ;;ONLY DO SELF, IF CAN'T DO IN COM T1.==TREG. REPEAT ,< T1.==T1.+1 SAVE T1. > IFDEF UNWIND, IFDEF MY.INI, > IFE HMREG.-MREG., ;; HRRZ R0,P ;; ADD R0,[2,,1] ;; BLT R0,16(P) ;; ADD P,D13D13## > DEFINE POPALL < T1.==MREG. REPEAT ,< RESTOR T1. T1.=T1.-1 > ;; SUB P,D13D13 ;; HRLZ AP,P ;; ADD AP,[1,,2] ;; BLT AP,16 > DEFINE LEAVE DEFINE RETURN< IFN MREG.-TREG., IFE MREG.-TREG., > DEFINE $FUNCT(NAME,ARGLST)< IFG HIGH,< RELOC 400000 HIGH==-1 IFG MREG.-TREG.,< SAV$A: T1.==TREG. REPEAT ,< T1.==T1.+1 SAVE T1. > IFDEF UNWIND,< MOVEM P,UNWIND IFDEF UNWEXIT,< IFDEF MY.EXIT, IFNDEF MY.EXIT, > > IFDEF MY.INI, ;;MUST RETURN WITH JRST 0(R1) IFNDEF MY.INI, > IFDEF UNWEXIT,> POP$A: POPALL POPJ P, > NAME: ENTRY NAME IFN LMREG., AOFF.=0 IFNB ,< IRP ARGLST,< ARGLST=AOFF. AOFF.=AOFF.+1 > > IFN MREG.-TREG., ;;KEYED BY MREG. IFE MREG.-TREG.,< IFDEF UNWIND, IFDEF MY.INI, > > DEFINE $UTIL(NAME,ARGLST)< NAME: IFE LMREG., MREG.=TREG. ;;UTIL'S DON'T AFFECT MOD REGS AOFF.=0 IFNB ,< IRP ARGLST,< ARGLST=AOFF. AOFF.=AOFF.+1 > > > DEFINE $GLOYO(NAME,ARGLST)< IFG HIGH,< RELOC 400000 HIGH==-1 MREG.==TREG. ;;IF A GLOYO FIRST GLOBAL ENTRY, THERE CAN BE NO FUNCTS HMREG.==MREG. ;;...AND THEREFORE NO MODULE REGS POP$A: POPJ P, > NAME: ENTRY NAME IFE LMREG., MREG.=TREG. ;;YOYO'S DON'T AFFECT MOD REGS > DEFINE $YOYO(NAME,ARGLST)< NAME: IFE LMREG., MREG.=TREG. ;;YOYO'S DON'T AFFECT MOD REGS > DEFINE GLOYO(PROG,ARGLST)< IF2, > PUSHJ P,PROG ;;ARGLST JUST FOR DOC > DEFINE YOYO(PROG,ARGLST)< PUSHJ P,PROG ;;ARGLST JUST FOR DOC > ;;; SAME EXCEPT MUST PRESERVE SUBSYS (IE. SAVE R2-R5) SYN $FUNCT,$LINK SYN FUNCT,LINK DEFINE FUNCT(PROG,ARGLST)< SALL ARGS.=0 IF2, > IFB ,< PUSHJ P,PROG> IFNB ,< IRP ARGLST, MOVEI AP,[-ARGS.,,0 IRP ARGLST, ]+1 PUSHJ P,PROG > > DEFINE UTIL(PROG,ARGLST)< SALL ARGS.=0 IFB ,< PUSHJ P,PROG> IFNB ,< IRP ARGLST, MOVEI AP,[-ARGS.,,0 IRP ARGLST, ]+1 PUSHJ P,PROG > > SYN $UTIL,$ULINK SYN UTIL,ULINK SUBTTL DECLARATIVE MACROS FOR USER VARIABLES DEFINE GDATA(NAME,LEN)< IFNDEF GDATA., IFDEF GDATA.,< IFB, IFNB, > > DEFINE DATA(NAME,LEN)< IFB,< NAME: BLOCK 1> IFNB,< NAME: BLOCK LEN> > DEFINE GREG(NAME,VALUE)< ;;GLOBAL REG IFB , IFNB , IFL GREG.-LGREG., NAME=GREG. IFDEF .'NAME,< IFN .'NAME+GREG.,< PRINTX "NAME" ALTER-EGO ALREADY IN USE > > IFNDEF .'NAME,< .'NAME==-GREG.> > DEFINE MREG(NAME,VALUE)< ;;MODULE REG IFN LMREG., IFB , IFNB , IFB , IFG MREG.-HMREG., IFNB ,< NAME=MREG. IFDEF .'NAME,< IFN .'NAME+MREG.,< PRINTX "NAME" ALTER-EGO ALREADY IN USE > > IFNDEF .'NAME,< .'NAME==-MREG.> > > DEFINE REG(NAME,VALUE)< NAME=VALUE IFDEF .'NAME,< IFN .'NAME+VALUE,< PRINTX "NAME" ALTER-EGO ALREADY IN USE > > IFNDEF .'NAME,< .'NAME==-VALUE> > DEFINE ASP(NAM.,SIZ.,INIT.)< GETLEN NAM.: POINT 7,.+2 XWD SIZ.,LEN. ASCII\INIT.\ T1.==/5 T1.==T1.*5 T1.==SIZ.-T1. BLOCK </5> > DEFINE BP(STRUC.,FIELD.,BASE.)< POINT STRUC.'$'FIELD.,STRUC.'.'FIELD.'BASE.,STRUC.'%'FIELD. > DEFINE DUMMY(STRUC.,FIELDS,PFX.)< ONEBYT(STRUC.,FIELDS,PFX.) > DEFINE ONEBYT(STRUC.,FIELD.,SIZE.,PFX.)< IFNB , STRUC.'.'FIELD.==OFFS. STRUC.'$'FIELD.==SIZE. POS.==POS.+SIZE. STRUC.'%'FIELD.==POS. > DEFINE BYTES(STRUC.,FIELDS)< POS.==-1 IRP FIELDS, OFFS.==OFFS.+1 > DEFINE BYTPFX(STRUC.,PFX.,FIELDS)< POS.==-1 IRP FIELDS, OFFS.==OFFS.+1 > DEFINE WORD(STRUC.,FIELDS)< BYTES(STRUC.,) OFFS.==0 > DEFINE FIELD(FIELD.,SIZE.)< T1.=1 IFNB ,< T1.==SIZE. IFN 100000*T1.-100000*SIZE., > FIELD.=OFFS. OFFS.==OFFS.+T1. > DEFINE PREFIX(STRUC.,PFX.,FIELD.,SIZE.)< PFX.'.'FIELD.==OFFS.-STRUC.'.'PFX. FIELD (STRUC.'.'FIELD.,SIZE.) > DEFINE ARRAY(FIELD.,SIZE.)< T1.==1 IFNB ,< T1.==SIZE. IFN 100000*T1.-100000*SIZE., > FIELD.==OFFS. - 1 OFFS.==OFFS.+T1. > DEFINE BLKSIZ(SIZID.)< SIZID.==OFFS. OFFS.==0 > ;;; BORROWED FROM MACTEN... ;MACRO TO COMPUTE THE WIDTH OF A MASK ; "WID" RETURNS THE LENGTH OF THE LEFTMOST STRING OF ; CONSECUTIVE ONES IN THE WORD. DEFINE WID(MASK),<<^L<-<_<^L>>-1>>> ;MACRO TO COMPUTE THE POSITION OF A MASK DEFINE POS(MASK),<<^L+^L<-<_<^L>>-1>-1>> ;MACRO TO BUILD A POINTER TO A MASKED QUANTITY ; POINTR LOCATION,MASK DEFINE POINTR(LOC,MASK),<> ;MACRO TO BUILD A MASK "WID" BITS WIDE, WITH ITS RIGHTMOST BIT ; IN THE BIT POSITION "POS". (I.E. A MASK FOR THE BYTE ; POINTED TO BY THE BYTE POINTER "POINT WID,LOC,POS") DEFINE MASK.(WID,POS),<<<<1_>-1>B>> ;MACRO TO DEFINE A SYMBOL IF NOT ALREADY DEFINED ; ND SYMBOL,VALUE DEFINE ND(SYMBOL,VALUE),< IFNDEF SYMBOL, > SUBTTL DECLARATIVE MACROS FOR CONSTANT DATA DEFINE PATTRN(NAM.,STR.)< STR.ST=. BYTE (12)STR. LEN.==0 IRP STR., NAM.: POINT ^D12,STR.ST XWD 0,LEN. > DEFINE MESSAG(NAM,ELEM)< EXP [ IRP ELEM,< ACT..=0 IRPC ELEM,, STOPI> IFN ACT..,< ELEM > IFE ACT..,< GETLEN ADDR.==[EXP LEN. ASCIZ\ELEM\] EXP > > 0 ] NAM:: MSG.. MSG..=MSG..+2 > DEFINE GETLEN(STRING)< LEN.=0 IRPC STRING, > DEFINE SETADDR(STRING)< GETLEN STRING ADDR.=1B12 + [ LEN. ASCII/STRING/]+1 > DEFINE VARY(NAM)<1B12+NAM> DEFINE INT(WORD)<2B12+WORD> DEFINE ASZ(NAM.)<17B12+NAM.> DEFINE ZERO<[0]> DEFINE ONE<[1]> DEFINE TWO<[2]> DEFINE THREE<[3]> DEFINE FOUR<[4]> DEFINE FIVE<[5]> DEFINE SIX<[6]> DEFINE MLIT(STRIN)< 17B12+[ASCIZ\STRIN\] > DEFINE STRIVRY(NAM,STRING)< GETLEN () EXP LEN. NAM: ASCII/STRING/ > DEFINE STRIPT(STRING)< GETLEN () POINT 7,[ASCII\STRING\] EXP LEN. > SUBTTL PROCEDURAL MACROS DEFINE WHATYP(SYM)< SYM..==0 IRPC SYM,< IFIDN <@>, IFIDN <(>, IFIDN <[>, IFIDN <+>, IFIDN <->, > IFE SYM..,< IFDEF .'SYM, > > DEFINE CASE(REG,VECTOR)< JRST @[EXP .+1,VECTOR](REG) > DEFINE DBP(BP,BCNT)< ;;ASCII ONLY REPEAT 5-BCNT, SOS BP > DEFINE TURNON(REG.,VAL.) DEFINE TURNOFF(REG.,VAL.) DEFINE TX(DESIG.,REG.,BIT.)< IFE BIT.&777777, IFN BIT.&777777, > DEFINE TXNE(A,B) DEFINE TXNN(A,B) DEFINE TXOA(A,B) DEFINE TXOE(A,B) DEFINE TXON(A,B) DEFINE TXO(A,B) DEFINE TXZA(A,B) DEFINE TXZE(A,B) DEFINE TXZN(A,B) DEFINE TXZ (A,B) DEFINE TXC (A,B) DEFINE COPY(DEST,SORCE)< WHATYP IFE SYM..+1,< MOVE DEST,SORCE> IFN SYM..+1,< WHATYP IFN SYM..+1,< MOVE 0,SORCE MOVEM 0,DEST> IFE SYM..+1,< MOVEM SORCE,DEST> > > DEFINE COPI(DEST,SORCE)< WHATYP IFE SYM..+1,< MOVEI DEST,SORCE> IFN SYM..+1,< MOVEI 0,SORCE MOVEM 0,DEST> > DEFINE DMOVEM(REGIS,MEM)< MOVEM REGIS,MEM MOVEM REGIS+1,1+MEM > DEFINE DCOPY(DEST,SORCE)< WHATYP IFE SYM..+1,< MOVE DEST,SORCE MOVE DEST+1,1+SORCE > IFN SYM..+1,< WHATYP IFN SYM..+1,< MOVE 0,SORCE MOVEM 0,DEST MOVE 0,1+SORCE MOVEM 0,1+DEST > IFE SYM..+1,< MOVEM SORCE,DEST MOVEM SORCE+1,1+DEST > > > DEFINE LD(REG.,STRUC.,FIELD.,BASE.)< IFNDEF STRUC.'$'FIELD., IFDEF STRUC.'$'FIELD., IFE T1.-^D36, IFN T1.-^D36,< IFN T1.-^D18, IFE T1.-^D18,< T1.==STRUC.'%'FIELD. IFE T1.-^D17, IFE T1.-^D35, > > > DEFINE LDEX(REG.,STRUC.,FIELD.,BASE.)< ;;SIGNED-NESS IS A PROP OF A FIELD SO... IFNDEF STRUC.'$'FIELD., IFDEF STRUC.'$'FIELD., IFE T1.-^D36, IFN T1.-^D36,< IFN T1.-^D18, IFE T1.-^D18,< T1.==STRUC.'%'FIELD. IFE T1.-^D17, IFE T1.-^D35, > > > DEFINE ST(REG.,STRUC.,FIELD.,BASE.)< IFNDEF STRUC.'$'FIELD., IFDEF STRUC.'$'FIELD., IFE T1.-^D36, IFN T1.-^D36,< IFN T1.-^D18, IFE T1.-^D18,< T1.==STRUC.'%'FIELD. IFE T1.-^D17, IFE T1.-^D35, > > > DEFINE STFIX(REG.,STRUC.,FIELD.,BASE.)< ;;PROVIDE SPECIAL CASE SUPPORT FOR THIS COMMON CASE T1.==STRUC.'%'FIELD. IFE T1.-^D17, IFE T1.-^D35,> > SUBTTL EXCEPTION HANDLING MACROS DEFINE SETABORT(ADDR.)< MOVEM P,FRAMCON COPI PARSCON,ADDR. > DEFINE ERRS(ARGS.,REENT.)< JRST [FUNCT TYPOUT, JRST REENT.] > SYN ERRS,WARNS SYN ERRS,SYSERS SYN ERRS,USRERS SYN ERRS,SYNERS SYN ERRS,FILERS DEFINE ERR(ARGS.,REENT.)< FUNCT TYPOUT, IFNB , > SYN ERR,WARNJ ;;FOR THE .+1 CASE SYN ERR,SYSERR SYN ERR,USRERR SYN ERR,SYNERR SYN ERR,FILERR DEFINE WARN(ARGS.)< FUNCT TYPOUT, > ;;; GENMSG INTERFACE MACROS DEFINE CASLAB(NUM.) DEFINE SETCAS(NAM.)< CA.'NAM.==CA.USR CASLAB(\CA.USR) CA.USR==CA.USR+1 > DEFINE OTHCAS< REPEAT ,< CASLAB(\CA.USR) CA.USR==CA.USR+1 > > SUBTTL NEEDED SYMBOLS, REGISTERS, ETC. REG(R0,0) REG(R1,1) REG(R2,2) REG(R3,3) REG(R4,4) REG(R5,5) REG(AP,16) REG(TAP,AP) ;GIVE DIF NAME FOR USE AS TEMP REG(P,17) ;;; GENMSG DEFINED MESSAGE CASES CA.VAR==1 CA.ASZ==2 CA.PAD==3 CA.PT==4 CA.SIX==5 CA.CRLF==6 CA.NUM==7 CA.NOCR==10 CA.FF==11 CA.DBK==12 CA.COL==13 ;LIMITED CONTROL OF WHAT COLUMN TO START NEXT FIELD ;;; UNDEFINED AND LIMIT CASES CA.UNU==14 CA.SMAX==14 CA.UMAX==24 ;;; GENIO MODES GENIN==1 GENOUT==2 GENAPP==3 GENIO==4 ; *** SWITCH COMPON GENASZ==0 GENBIN==1B32 ;IE. 10 ; *** CONSTANT CHANNEL DEFS DEFINE CHAN(CHAN.,VAL.)< CHAN.'CHAN==VAL. $$$'CHAN.==1B<^D35-VAL.> INI.CH==INI.CH ! $$$'CHAN. > ;;; SCAN BLK OFFSETS OFFS.==0 ;0 EXPLIC SINCE HERE FIELD (F.DEV) ;DEVICE NAME FIELD (F.NAME) ;FILE NAME FIELD (F.NAMM) ;MASK FIELD (F.EXT) ;EXT/MASK FIELD (F.MOD) ;VARIOUS JUNK FIELD (F.MODM) FIELD (F.DIR) ;DIRECTORY WORD FIELD (F.DIRM) FIELD (F.SFD,^D12) BLKSIZ (F.SLEN) F.LEN==F.SLEN ;;; ENQ/DEQ RESOURCE BLK ; *** THE HEADER PORTION BYTES (RS,<,>) ;NUM OF LOCKS/SIZ OF BLK BYTES (RS,<,>) ;INTERRUPT CHAN/REQ ID BLKSIZ (HDR.RS) ; *** PER-LOCK BLK BYTES (RS,<,,,,>) ;SHARED?,IGNOR LEV?,LEV#,JFN/CHAN OF RES FIELD (RS.LOCK) ;5B2+NUM OR BYTE PTR BYTES (RS,<,>) ;POOL SIZE/SHAR GROUP BLKSIZ (SIZ.RS) ;;; IPCF ARG BLKS ; *** PACKET DESCRIPTOR BYTES (PD,<,,,>) ;1 BIT FLAGS, REF DIRECTLY ;IPCF RETURNED ERROR CODE ;SYS SENDER CODE, FOR COMMUN WIHT INFO ;WAS AN UNANSWERED MSG RETURNED FIELD (PD.SEND) FIELD (PD.CEIV) BYTES (PD,<,>) FIELD (PD.DIR) FIELD (PD.CAPAB) BLKSIZ (SIZ.PD) ; *** [SYS]INFO DATA PACKET BYTES (INP,<,>) FIELD (INP.CPID) ;COPY PID FIELD (INP.ARG) ;BEGIN OF VAR LEN ARG BLKSIZ (SIZ.INP) ;;; MGRMEM ARG BLK FIELD (MM.CUR) ;-LEFT,,START -- SORT OF PSEUDO AOBJ PTR FOR STORBLK FIELD (MM.SIZ) ;AMOUNT USER WANTS FIELD (MM.ALC) ;AMOUNT TO GRAB IF RUN OUT BLKSIZ (SIZ.MM) ;;; VARIOUS STANDARD WAYS OF BREAKING UP A WORD INTO SUB-FIELDS WORD (UUO,<,,>) WORD (BP,<,,,>) WORD (INS,<,,,,>) WORD (ARG,<,,>) ;;; MISCELLANEOUS SYMBOLS TREG.==5 ;MORE OR LESS IN ACCORD WITH DPSS CPW==5 ;ASCII--CHARS PER WORD DEFINE CFOPF<^D36B5+OF%NWT+OF%PLN> ;THIS WAY SINCE OTHERWISE O/S DEP (COMMON FLAGS FOR OPENF) END