Google
 

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