Trailing-Edge
-
PDP-10 Archives
-
DBMS-20_V6.0_bin_9-25-81
-
sources/strdcl.mac
There are 27 other files named strdcl.mac in the archive. Click here to see a list.
UNIVERSAL STRDCL FOR COBOL 11(460)
; COPYRIGHT (C) 1974,1981 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.
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.
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,<SIZ=AP>
IFNDEF POZ,<POZ=SVP> ;REGS 15 AND 16
SAVE <SIZ,POZ>
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 <POZ,SIZ> >
>
DEFINE TTC(I),<
IFE MESSAG, <TLNN P,STR.NW
TTCALL 3,M.'I>>
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,<SIZ=AP>
SAVE <SIZ>
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 <SIZ>>
>
DEFINE INDIR(A) <$1,A>
DEFINE CONST(A) <$2,A>
DEFINE ERROR (A,B) <
IFNB <B>,<
JRST [PUSH P,[B]
JRST A]>
IFB <B>,<
PUSHJ P,A>>
DEFINE LOCSUB (A,B) <
C.....=0
IFNB <B>,< IRP B,<C.....=C.....+1
PUSH P,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 <BP$>, <MOVEM R0,BP$>
IFNB <LEN$>, <HRRZM R1,LEN$>
IFE BND.CH,<
IFNB <MAX$>, <HLRZM R1,MAX$>>
>
DEFINE FUNCT(A,B)<
; SALL
T.....=0
ST....=1
IF2,<IFNDEF A,<EXTERNAL A>>
IFNB <B>,<
PUSH P,AP
IRP B,<IFIDN <B> <$1>, <ST....=0>
IFIDN <B> <$2>, <ST....=-1>
IFDIF <B> <$1>,<
IFDIF <B> <$2>,<
IFG ST....,<PUSH P,B
T.....=T.....+1
>
ST....=1>>>
R.....=0
IRP B,<IFIDN <B> <$1>, <ST....=0>
IFIDN <B> <$2>, <ST....=-1>
IFDIF <B> <$1>,<
IFDIF <B> <$2>,<
IFE ST....,<T......=T......+1
PUSH P,B>
IFL ST....,<T.....=T.....+1
PUSH P,[B]>
IFG ST....,<T......=T......+1
R.....=R.....+1
HRRZI AP,-T.....+R.....+1(P)
PUSH P,AP
>
ST....=1>>>>
MOVEI AP,-T.....+R.....+1(P)
PUSHJ P,A
IFNB <B>,<
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 <B>,<IFIDN <B>,<.>,<SIXBIT /A/
; ENTRY A'.
; A'.:>
; IFDIF <B>,<.>,<SIXBIT /B/
; ENTRY A
; A:>
;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,<BND.CH==0>
IFNDEF ANYSIZ,<ANYSIZ==0>
IFNDEF HIGH,<HIGH==0>
IFNDEF CHECK,<CHECK==0>
IFNDEF MESSAG,<MESSAG==0>
IFNDEF STR.NW,<STR.NW==:0>
IFNDEF PSEUDO,<PSEUDO==1> ;[13] SUPPORT FUNCTIONS FOR COBOL
END