Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	DBGETF FOR COBOL
	SUBTTL	GET NEXT FILE FOR DBMS (PHASE D)

	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.
; *******************************************************************

; ****
;Append TOPS20==0 to beginning of module for COBOL68/74-12B
; ****

;	THIS MODULE IS FOR COBOL ONLY SO NO TESTS NEEDED (AS IF $COB=1)

	SEARCH	P

	IFNDEF TOPS20,<TOPS20==0>

	TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
	RELOC	400000


IFE TOPS20,<
IFN DBMS,<
	ENTRY	DBGTF.

DBGTF.:	CALLI	TC,$PJOB		;GET JOB #
	MOVEI	TD,3			;CONVERT JOB NUMBER TO DECIMAL
	IDIVI	TC,^D10
	ADDI	TB,"0"-40
	LSHC	TB,-6
	SOJG	TD,.-3
	HRRI	TA,'DB0'
	AOS	DBCNTD##		;BUMP COUNT OF INVOKES
	ADD	TA,DBCNTD		;STORE IN FILE-NAME
	MOVEM	TA,DBBLCK##
	HRLZI	TA,'TMP'		;WE'RE SETTING UP THE FILE-NAME AND
	MOVEM	TA,DBBLCK+1		;...AND EXTENSION
	SETZM	DBBLCK+2
	SETZM	DBBLCK+3
	SETZM	DBOPBK##
	HRLZI	TA,'DSK'
	MOVEM	TA,DBOPBK+1
	HRRZI	TA,DBBUFH##		;NOW WE ARE DOING THE OPEN BLOCK.
	MOVEM	TA,DBOPBK+2
	OPEN	DBCHAN,DBOPBK		;CAN WE OPEN IT?
	  JRST	OPNERR			;NO, ABORT
	LOOKUP	DBCHAN,DBBLCK		;IS THE DAMN THING THERE?
	  JRST	NOTFND			;NO
	MOVE	TA,[XWD	400000,DBUFF1##+1]
	MOVEM	TA,DBBUFH
	IN	DBCHAN,			;GET A BUFFER FULL
	SKIPA
	  JRST	INPERR
IFN FT68274,<				;[6%462]
	PUSHJ	PP,CVTCCL##		;[6%462] REPLACE PREVIOUS LINE WITH
					;[6%462]  CURRENT LINE
	PUSHJ	PP,CVTDPL##		;[6%462] COPY PREVIOUS LINE TO CVT FILE
	SETZM	CVTPLF##		;[6%462] SIGNAL PREVIOUS LINE NOT WANTED
>					;[6%462]
	SETOM	FINVOK##		;SET INVOKE FLAG
	SETZM	SRCCOL##
	TLZE	SW,20			;IS /S SWITCH ON--IF YES TURN IT OFF
	SETOM	DBONLY##		;IT WAS ON, REMEMBER IT
	POPJ	PP,

OPNERR:	TTCALL	3,[ASCIZ /?FATAL--OPEN/]
ALLERR:	TTCALL	3,[ASCIZ / ERROR ON FILE /]
	SETZ	TA,
	MOVEI	TE,3			;CONVERT JOB NUMBER TO ASCII
	MOVE	TD,[POINT	7,TA]
	MOVE	TC,[POINT	6,DBBLCK]
ALL2:	ILDB	TB,TC			;GET SIXBIT DIGIT
	ADDI	TB,40
	IDPB	TB,TD
	SOJG	TE,ALL2			;DONE 3 DIGITS?
	TTCALL	3,TA			;PRINT 3 DIGITS
	TTCALL	3,[ASCIZ /DB/]
	HRRZ	TA,DBBLCK
	TRZ	TA,777770
	ADDI	TA,"0"			;PRINT LAST DIGIT
	TTCALL	1,TA
	TTCALL	3,[ASCIZ /.TMP
?CANNOT CONTINUE
/]
	CALLI	$EXIT
NOTFND:	TTCALL	3,[ASCIZ /?FATAL--LOOKUP/]
	JRST	ALLERR
INPERR:	TTCALL	3,[ASCIZ /?FATAL--INPUT/]
	JRST	ALLERR

	>
>;END TOPS20
	PRGEND

	TITLE CMLNAM			;STRSYM BUT USES OFFSETS & KNOWS ABOUT
					; DBDLOC--TO GET AROUND GETENT PROB
	SEARCH STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

	;THIS ROUTINE IS A HASH/SYMBOL TABLE UTILITY
	;IT ALLOCATES NO STORAGE AND DEALS WITH SYMBOL BLOCKS
	;PASSED BY THE USER.
	;IT SELECTS/INSERTS A SYMBOL BLOCK BY USING A HASH TABLE
	;STORE PASSED/CREATED BY THE USER.
	;THE USER MAY SPECIFY ANY SIZE TABLE HE WISHES SO LONG
	;AS TABLE SIZE IS PRIME.
	;IF TWO ENTRIES HASH TO THE SAME OFFSET WITHIN THE
	;HASH TABLE, STRSYM WILL CREATE/ADD TO A LINKED LIST
	;OF SYMBOL BLOCKS FOR THAT BUCKET.
	;
	;THE FORM OF A SYMBOL BLOCK IS:
	;
	;0	PREV		NEXT
	;1	STRING POINTER FOR
	;2		SYMBOL
	;3	USER SPECIFIC BLOCK

	ENTRY BLDSYM,BLDSY.
	ENTRY INISYM,INISY.
	ENTRY APPSYM,APPSY.
	ENTRY INSSYM,INSSY.
	ENTRY UPDSYM,UPDSY.
	ENTRY DELSYM,DELSY.
	ENTRY FNDSYM,FNDSY.
	ENTRY LATSYM,LATSY.
	ENTRY REMSYM,REMSY.

	;LOCAL REGS

	C2=R2
	TAB.ST=T0			;START ADDR OF HASH TABLE
	TABLEN=T1			;LEN OF SAME
	SYMBLK=ML1			;PTR TO CURRENT USER SYMBOL BLOCK
	BUCKET=MODE			;PTR TO THE CURRENT BUCKET

	;SYMBOL BLOCK OFFSETS

	PREV=0
	NEXT=0
	SM.BP==:1			;SYMBOL-BYTE-PTR
	SM.BPL==:2			;SYMBOL-BYTEPTR-LENGHT
	SM.USR==:3			;SYMBOL-USER-INFO-STARTING-OFFSET

	;LOCAL MACROS

	DEFINE DELLIST(CURNOD)<
	MOVE	R1,0(SYMBLK)
	HLRM	R1,PREV(R1)		;NEXT OF CUR SHOULD PT. AT PREV OF CUR
	MOVSS	R1			;AND VICE VERSA
	HLRM	R1,NEXT(R1)
>

BLDSYM:
BLDSY.:
	;USAGE: TABLE-DESC=BLDSYM(TABLE,SIZE-IN-WORDS)
	;	TABLE-DESC IS 1-WORD QUANTITY. IS PASSED TO OTHER
	;	ENTRIES TO ACCESS A PARTICULAR TABLE.

	SAVE	<TABLEN>
	MOVEI	R1,@0(AP)		;GET START OF HASH TABLE
	MOVE	TABLEN,@1(AP)
	MOVE	R0,R1			;RET VAL
	HRL	R0,TABLEN

BLD.LP:
	SETZM	0(R1)			;ZERO TAB ENTRIES
	ADDI	R1,1
	SOJG	TABLEN,BLD.LP
	RESTOR	<TABLEN>
	SETPSU				;RET TO USER

INISYM:
INISY.:
	;USAGE: CALL INISYM(TAB-DESC,BLOCK-1,BLK-LAST,BLK-SIZE)
	;	APPEND A CONSECUTIVE GROUP OF SYMBOL BLOCKS TO SYMBOL TABLE
	;	BLOCK-1 IS 1ST BLK, BLK-LAST IS
	;	BEGINNING OF LAST BLOCK.
	;	BLK-SIZE IS SIZE OF EACH BLOCK (EG. 4)

	SAVALL
	HRRZ	SVP,DBDLOC##
	HRRZ	TAB.ST,@0(AP)
	HLRZ	TABLEN,@0(AP)
	MOVEI	SYMBLK,@1(AP)
INI.LP:
	MOVE	BP1,1(SYMBLK)
	ADD	BP1,SYMBLK		;EXPRESSED SELF RELATIVE
	MOVE	LEN1,2(SYMBLK)
	PUSHJ	P,SYMHASH
	PUSHJ	P,INSLIST
	SUB	BP1,SVP			;NOW MAKE RELAT TO AREA
	MOVEM	BP1,1(SYMBLK)
	ADD	SYMBLK,@3(AP)		;THE SIZE OF EACH BLOCK
	CAIG	SYMBLK,@2(AP)		;ARE WE PAST LAST BLOCK?
	JRST	INI.LP
	RETURN

INSSYM:
INSSY.:
	;USAGE:	CALL INSSYM(TAB-DESC,SYMBOL,SYM-BLK)
	;	INSERTS BLOCK AT BEGINNING OF LIST
	;	SYMBOL IS ANY LEGAL STRING
	;	SYM-BLK IS A STORAGE BLOCK OF USER SPECIFIC SIZE

	JSP	R1,COMARGS		;SAV REGS AND INIT
	PUSHJ	P,SYMHASH		;FIND OR GET NEXT TO SYMBOL
					;RETURN FND/NO FND IN R0
	MOVE	BUCKET,NEXT(BUCKET)	;INSERT AT FRONT
	JRST	INSLEAVE

APPSYM:
APPSY.:
	;USAGE: CALL APPSYM(TAB-DESC,SYMBOL SYM-BLK)
	;	INSERT AT END OF LIST

	JSP	R1,COMARGS
	PUSHJ	P,SYMHASH
	JRST	INSLEAVE

UPDSYM:
UPDSY.:
	;USAGE: SYMPTR=UPDSYM(TABDESC,SYMBOL,SYM-BLK)
	;	SYMPTR IS PTR TO A USER SYMBOL BLOCK IF FOUND
	;		ELSE IT IS 0 & SYM-BLK WAS INSERTED

	JSP	R1,COMARGS		;SAV REGS AND INIT
	PUSHJ	P,SYMNABOR		;FIND SYMBOL IF THERE
	JUMPE	R0,INSLEAVE		;NOT THERE IF JUMP
	MOVE	R0,SYMBLK
	RETURN

;	***	COMMON INSERT EXIT	***

INSLEAVE:
	MOVE	SYMBLK,@2(AP)		;ARG
	PUSHJ	P,INSLIST
	SUB	BP1,SVP			;MAKE OFFSET
	MOVEM	BP1,SM.BP(SYMBLK)
	MOVEM	LEN1,SM.BPL(SYMBLK)
	SETZM	R0			;FOR CONSIS AND UPDSYM
	RETURN

;	***	***	***	***	***

FNDSYM:
FNDSY.:
	;USAGE: SYMPTR=FNDSYM(TABDESC,SYMBOL)

	JSP	R1,COMARGS		;SAV REGS AND INIT
	PUSHJ	P,SYMNABOR
FNDLEAVE:
	JUMPE	R0,RAX$##		;RETURN
	MOVE	R0,SYMBLK
	RETURN

LATSYM:
LATSY.:
	;USAGE: SYMPTR=LATSYM(TABDESC,SYMBOL,SYM-BLK)
	;	STARTING AT SYM-BLK, IT FINDS THE NEXT (IF ANY) SYMBOL

	JSP	R1,COMARGS
	PUSHJ	P,SYMHASH		;DETERM BUCKET
	MOVE	SYMBLK,@2(AP)		;START IN MIDDLE
	PUSHJ	P,NABNEX
	JRST	FNDLEAVE

DELSYM:
DELSY.:
	;USAGE:	TRUTH=DELSYM(TABDESC,SYMBOL)
	;	TRUTH = -1 IF FOUND (AND DELETED)
	;	TRUTH = 0 IF COULD NOT FIND

	JSP	R1,COMARGS
	PUSHJ	P,SYMNABOR
	JUMPE	R0,RAX$##		;RETURN
	DELLIST	SYMBLK
	RETURN

REMSYM:
REMSY.:
	;USAGE: TRUTH=REMSYM(NODE-PTR)

	SAVE	<SYMBLK>
	MOVE	SYMBLK,@0(AP)		;GET NODE TO DELETE
	DELLIST	SYMBLK
	SETO	R0,			;FOR CONSISTENCY
	RESTOR	<SYMBLK>
	SETPSU				;BACK TO USER

;	****************************

SYMNABOR:				;SECTION TO FIND SYMBOL OR WHERE
					; WOULD FIT
	PUSHJ	P,SYMHASH		;DO THE AHS
	MOVE	SYMBLK,BUCKET		;FOR LOOP
NABNEX:
	HRRZ	SYMBLK,NEXT(SYMBLK)	;INIT SYMBLK
	JUMPE	SYMBLK,NABFAIL
	ADD	SYMBLK,SVP		;OFFSET TO ADDR
	CAME	LEN1,SM.BPL(SYMBLK)	;NOT=, CANT BE SAME SYM
	JRST	NABNEX
	MOVE	LEN2,LEN1		;DON'T OVERWRITE LEN1
	MOVE	R0,BP1			;NOW COMPARE =LEN STR., BUT NEED TEMP
	MOVE	R1,SM.BP(SYMBLK)
	ADD	R1,SVP			;OFFSET TO ADDR
NABLOOP:
	ILDB	C1,R0
	ILDB	C2,R1
	CAME	C1,C2			;SO FAR EQUAL?
	JRST	NABNEX
	SOJG	LEN2,NABLOOP		;MORE TO CHECK
	SETO	R0,			;NOTE FOUND
	POPJ	P,			;RETURN

NABFAIL:
	SETZ	R0,
	POPJ	P,

;	***************************

COMARGS:
	SAVALL
	MOVE	SVP,R1			;YOU CANT WIN THEM ALL
	STRARG	1,AP,BP1,LEN1
	HRRZ	TAB.ST,@0(AP)
	HLRZ	TABLEN,@0(AP)		;HASH TABLE SIZE
	MOVE	R1,SVP
	HRRZ	SVP,DBDLOC##
	JRST	0(R1)

;	********************

SYMHASH:
	MOVE	R1,BP1			;STILL NEED BP1
	ILDB	C1,R1			;FOR HASH CODE
	MOVS	R0,C1			;FOR DISPERSION'S SAKE
	ADD	R0,LEN1			;DITTO
	ILDB	C1,R1			;ONCE AGAIN
	CAILE	LEN1,1			;DON'T MERGE WHAT DOESN'T EXIST
	XOR	R0,C1
	IDIV	R0,TABLEN		;TABLEN SHOULD BE PRIME

	MOVM	BUCKET,R1		;REMAINDER BECOMES OFFSET IN TAB
$CHK:
	ADD	BUCKET,TAB.ST		;MAKE IT A PTR
	POPJ	P,

;	**********************

INSLIST:
	HLRZ	R1,PREV(BUCKET)
	MOVSM	R1,0(SYMBLK)		;INIT SYS PART OF SYMBOL BLOCK

	SKIPN	R1			;0 IS EQUIV TO BUCKET ITSELF
	SKIPA	R1,BUCKET
	ADD	R1,SVP			;MAKE ADDR
	SUB	SYMBLK,SVP		;MAKE OFFSET
	HRRM	SYMBLK,NEXT(R1)		;RESET EXISTING PTRS
	HRLM	SYMBLK,PREV(BUCKET)
	ADD	SYMBLK,SVP		;COWARDICE AND CONSISTENCY
	POPJ	P,

	PRGEND

	TITLE CMLMEM
	SEARCH	GENDCL,P
	SEGMEN

	;;;	ENCODE DIFS IN MEM MANAGEMENT IN DUMMY MODULES
	;;;	THIS IS ONE FOR COBOL
	;;;	CALLING SEQUENCES ARE AS FOR THE REAL GENMEM MODULE

	MREG	(DUMMY,15)		;ASSUME GETENT IS A CLOBBERER

$FUNCT	(ALCMEM,<SIZE>)
ALCME.=:ALCMEM
ALCPA.=:ALCMEM				;[1467]COBOL,[6%535]DBMS, Make ALCPA.
					;[1467][6%535] equal ALCME.

	MOVE	TA,@SIZE(AP)
	HRLI	TA,CD.DBD
	FUNCT	GETENT
	HRRZM	TA,R0
	RETURN

$FUNCT	(FREMEM,<WHERE,SIZE>)
FREME.=:FREMEM
	RETURN

	END