Google
 

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