Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/strdcl.mac
There are 27 other files named strdcl.mac in the archive. Click here to see a list.
UNIVERSAL STRDCL
SEARCH COPYRT
SALL
;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, 1984 BY DIGITAL EQUIPMENT CORPORATION
; *******************************************************************
; NOTE!!! This module is shared by the COBOL and DBMS products. Any
; modification by either group should be immediately reflected in the
; copy of the other group.
; *******************************************************************
SALL
NOSYM
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)<
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>
;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,>>
;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 ;MAKE IT AGREE WITH DOC
IGNORE=1B35 ;MAKE IT AGREE WITH DOC
EXACT=1B34 ;MAKE IT AGREE WITH DOC
MIXMODE=1B33 ;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 ;MAKE IT AGREE WITH DOC
TLATE=MIXMOD ;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> ;SUPPORT FUNCTIONS FOR COBOL
END