UNIVERSAL STRDCL FOR COBOL 12 ;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,1975,1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION SALL NOSYM SUBTTL REVISION HISTORY ;[%11] FIX CHKSTR/CMBSTR TO CLEAR UP SOME MINOR INCONSISTENCIES ; INVOLVED IN HANDLING THE EXCEEDING OF DESTINATION STRING ; MAXIMUM. ;[%12] THE LEFT MOST BYTE OF THE (I)TH WORD, IF THE DESTINATION ; OF A COPCHR, WOULD BE SET TO JUNK. FIX IS TO MOVE THE ; "DONE" LABELS UP ONE INSTRUCTION. ;[%13] MAKE STRLIB MORE USABLE FROM COBOL: ; (1) ADD PSEUDO REGISTERS(SETPSU MACRO,PSEUDO SWITCH, AND ROUTINE(DATA) PSUREG) FOR FUNCTION SUPPORT ; (2) ADD INISTR TO INIT PSEUDO-REGS ; (3) HAVE DP INTEGERS BE STRING PTRS ; (4) HAVE BYTE DESCRIPTORS, COBOL STRINGS, ALWAYS SET MAX TO MAX-MAX ;[%14] USE HEAD AND RECOGNIZE THAT FNDSTR CREATES AND DYNAMICALLY ADDS ; TO STACK FRAME. ; IN PROCESS, FIX PROBLEM WITH STACK FRAME TRUNCATION THAT ; OCCURS UNDER CERTAIN FAILURE CONDITION: POS1 AND ; POS2 INCONSISTENT. ;[%15] MAKE ZERO-LENGTH HOST STRING NOT-ALWAYS-FAIL/ ; MATCH-NULL-STRING. ;[%16] IN PARELLEL WITH [%14] CLEANUP "WHICH" LOGIC ;[%17] INSERT CHECK AT CMB.LP FOR NULL SOURCE/FULL DEST ;[%20] NEED TO CHECK AGAINST MAX RATHER THAN LEN FOR MODE=NOFILL ; IN CNVSTR ;[%21] MAKE CNVSTR TYPE HIGH-ORDER DIGITS WHEN NUMBER TOO BIG ; RATHER THAN NOT POP DIGITS AND BOMB WITH A BAD STACK ;[%22] CORRECT DRIVER BITS THAT DISAGREE WITH DOC, MOSTLY CMPSTR ;[%23] HANDLE SIXBIT TO ASCII CONV AUTOMAT IN CMBSTR ;[%24] REDO HASHING ALGORITHM IN STRSYM FOR BETTER COVERAGE OF SYMBOL STRING. ;[%25] DO NOT SPLIT QUOTED STRINGS IN CMBSTR (DBMS EDIT 317/377) SUBTTL MACROS (USED BY THE LIBRARY ROUTINES) ; USED TO GENERATE FORTRAN COMPAT. CALLS ; 3 TYPES OF ARGS ; $1 = INDIRECT ; $2 = CONSTANT COMPILE TIME LOCATION ; NULL = REGISTER ; AS WRITTEN, DECR WILL CORRECTLY HANDLE ONLY 7-BIT BYTES ; IN NORMAL ALIGNMENT DEFINE DECR(INSTR,BYTE,BP) < IFN ANYSIZ,< SKIPGE BP ;THIS IS IMPERFECT JRST [HRLI BP,RMBYTE ;HERE IF "440700" BP SOJA BP,.+1] INSTR BYTE,BP CAML BP,[MAXBP,,0] JRST [HRLI BP,RMBYTE SOJA BP,.+2] ADD BP,[SIZ2PF,,0]> IFE ANYSIZ,< IFNDEF SIZ, IFNDEF POZ, ;REGS 15 AND 16 SAVE LDB SIZ,[BPSIZ1,,BP] LDB POZ,[BPPOS,,BP] CAIN POZ,44 ;CHARS ASSUMED LEFT ALIGNED JRST [IDIV POZ,SIZ MOVE POZ,SIZ LDB SIZ,[BPSIZ1,,BP] DPB POZ,[BPPOS,,BP] SOJA BP,.+1] INSTR BYTE,BP ADD POZ,SIZ CAIN POZ,44 ;CHARS ASSUMED LEFT ALIGNED JRST [IDIV POZ,SIZ DPB SIZ,[BPPOS,,BP] SOJA BP,.+2] DPB POZ,[BPPOS,,BP] RESTOR > > DEFINE TTC(I),< IFE MESSAG, > DEFINE DETDIF(TOTLEN) < IFN ANYSIZ,< HRRZ TOTLEN,R1 SUB TOTLEN,LEN1 HRRZ T2,R0 SUBI T2,0(BP1) ;GIVES WORD DIF OF THE 2 BP IMULI T2,CPW ADD TOTLEN,T2 ;T2 IS NEG LDB T1,[BPPOS,,R0] LDB T2,[BPPOS,,BP1] SUB T2,T1 IDIVI T2,BYTSIZ ADD TOTLEN,T2> IFE ANYSIZ,< IFNDEF SIZ, SAVE LDB SIZ,[BPSIZ1,,BP1] HRRZ TOTLEN,R1 SUB TOTLEN,LEN1 HRRZ T2,R0 SUBI T2,0(BP1) IMUL T2,CPW$##(SIZ) ADD TOTLEN,T2 LDB T1,[BPPOS,,R0] LDB T2,[BPPOS,,BP1] SUB T2,T1 IDIV T2,SIZ ADD TOTLEN,T2 RESTOR > > DEFINE INDIR(A) <$1,A> DEFINE CONST(A) <$2,A> DEFINE ERROR (A,B) < IFNB ,< JRST [PUSH P,[B] JRST A]> IFB ,< PUSHJ P,A>> DEFINE LOCSUB (A,B) < C.....=0 IFNB ,< IRP B,> PUSHJ P,A IFN C.....,< SUB P,[C.....,,C.....]> > DEFINE STRARG(OFFS,REG,BP$,LEN$,MAX$) < LDB R0,[TYPCOD+REG,,OFFS] MOVEI R1,@OFFS(REG) LOCSUB CANON$## IFNB , IFNB , IFE BND.CH,< IFNB , > > DEFINE FUNCT(A,B)< ; SALL T.....=0 ST....=1 IF2,> IFNB ,< PUSH P,AP IRP B, <$1>, IFIDN <$2>, IFDIF <$1>,< IFDIF <$2>,< IFG ST...., ST....=1>>> R.....=0 IRP B, <$1>, IFIDN <$2>, IFDIF <$1>,< IFDIF <$2>,< IFE ST...., IFL ST...., IFG ST...., ST....=1>>>> MOVEI AP,-T.....+R.....+1(P) PUSHJ P,A IFNB ,< SUB P,[T.....,,T.....] POP P,AP>> DEFINE SAVE (A)< IRP A,< PUSH P,A>> DEFINE RESTOR (A)< IRP A,< POP P,A>> DEFINE SAVALL < HRRZ R0,P ADD R0,[2,,1] BLT R0,16(P) ADD P,D13D13##> DEFINE RETURN < JRST RAX$##> DEFINE POPALL < SUB P,D13D13## HRLZ AP,P ADD AP,[1,,2] BLT AP,16> ;[13] ADD SET PSU MACRO TO SUPPORT FUNCTIONS FOR COBOL DEFINE SETPSU< IFE PSEUDO,< SKIPN PSU.R0## ;0 MEANS INISTR NOT CALLED POPJ P, MOVEM R0,@PSU.R0## MOVEM R1,@PSU.R1## POPJ P,> IFN PSEUDO,< POPJ P,>> ; DEFINE HELLO (A,B)< ; SALL ; IFNB ,,<.>, ; IFDIF ,<.>, ;MODULE WIDE NAMES R0=0 ;FUNCT RET REG R1=1 ;DITTO (FOR DP) R2=2 ;MAXLEN IN EXPANDED (UBS) -- A TEMP BP1=3 ;BYTE PTR (THE MORE PERM. IF A DIFFERENCE) LEN1=4 ;LEN OF STRING 1 ML1=5 ;MAX LEN OF STR 1 BP2=6 POS1=BP2 LEN2=7 POS2=LEN2 MODE=10 ;CONTROL WORD CNT=11 ;FOR VAR LEN ARG LISTS C1=12 ;CHAR REG T1=13 ;RENAMED AS NEEDED BASP=T1 T0=14 MASK=T0 ST.IBP=T0 CAP=T0 ;CURR ARG PTR SVP=15 ;SAVE PC REG, USED FOR SIDE ENTRY POINTS AP=16 ;ARG LIST PTR (IN FORTRAN SENSE) P=17 ;PDL PTR ;BIT PATTERNS APPEND=1B35 CHKPNT=1B34 OCTAL=1B33 PAD=1B32 TRACE=1B32 ;[%22] MAKE IT AGREE WITH DOC IGNORE=1B35 ;[%22] MAKE IT AGREE WITH DOC EXACT=1B34 ;[%22] MAKE IT AGREE WITH DOC MIXMODE=1B33 ;[%22] MAKE IT AGREE WITH DOC IDX.E=1B35 ANCHOR=1B34 ;INTERNALLY ANCHOR IS HALF-IN-HALF-OUT HIHO=1B34 ;HALF IN HALF OUT PARTIA=1B33 ENTIRE=1B33 ;SEE CODE FOR WHY SAME BAKWDS=1B32 MORE.1=1B32 WHICH=1B31 RETUBS=1B30 ;USED BY SIDE ENTRY POINTS TO.ASCII=1B35 Z.PAD=1B34 NOFILL=1B33 ALWAYS=1B32 LB.UB=1B34 ;[%22] MAKE IT AGREE WITH DOC TLATE=MIXMOD ;[%22] MAKE IT AGREE WITH DOC YES.IN=1B32 ;OTHER CONSTANTS TABSIZ=200 ;TAZSTR AND TAOSTR ASSUME ASCII CPW=5 ;CHARS PER WORD IPOSIZ=440700 ;INITIAL POS/SIZE BYTSIZ=7 BPPOS=360600 BPSIZ1=300600 BPSIZ2=300615 ;INDEX OFF SVP IN REL$ SIZ2PF=70000 MAXBP=350000 PAD.CH=40 EQL=0 TYPCOD=270400 ;POSIT./SIZE OF ARG LIST TYPE CODE RMBYTE=010700 ;ASSEMBLY/LOAD PARAMETERS IFNDEF BND.CH, IFNDEF ANYSIZ, IFNDEF HIGH, IFNDEF CHECK, IFNDEF MESSAG, IFNDEF STR.NW, IFNDEF PSEUDO, ;[13] SUPPORT FUNCTIONS FOR COBOL END