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

TITLE	FNDPOP FOR COBOL V12C
SUBTTL	COMMON DATAB SUBROUTINES		W. NEELY/CAM



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	P
	%%P==:%%P

;EDITS
;
;V12B****************
;NAME	DATE		COMMENTS
;JEH	18-NOV-82	[1424] ADD FNDFIL ROUTINE FOR PHASE C USE
;V10*****************
;NAME	DATE		COMMENTS
;********************


TWOSEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

RELOC	400000

ENTRY	FNDPOP, FNDBRO, FNDFIL	;[1424]

;ENTER WITH TB=RELATIVE DATAB ADDR
;EXIT TO CALL+1 IF NO FATHER
;EXIT TO CALL+2 WITH TB=REL DATAB ADDR OF FATHER

FNDPOP:	JUMPE	TB,CPOPJ
	LDB	TC,[POINT	3,TB,20]
	CAIE	TC,CD.DAT
CPOPJ:	POPJ	PP,		;NOT DATTAB ENTRY
POP.0:	HRRZM	TB,TBLOCK##+13
	HRRZ	TA,TB
	PUSHJ	PP,LNKSET##
	LDB	TB,DA.FAL##
	JUMPN	TB,POP.1
	HRRZ	TB,TBLOCK+13
	PUSHJ	PP,FNDBRO
	  POPJ	PP,
	JRST	POP.0

POP.1:	LDB	TB,DA.POP##
	JUMPE	TB,CPOPJ
	POP	PP,TA
	JRST	1(TA)


;ENTER WITH TB=RELATIVE DATAB ADDR
;EXIT TO CALL+1 IF NO BROTHER
;EXIT TO CALL+2 WITH TB=REL DATAB ADDR OF BROTHER

FNDBRO:	JUMPE	TB,CPOPJ
	LDB	TC,[POINT	3,TB,20]
	CAIE	TC,CD.DAT
	POPJ	PP,
	HRRZ	TA,TB
	PUSHJ	PP,LNKSET
	LDB	TC,DA.FAL
	JUMPN	TC,CPOPJ
BRO.1:	LDB	TB,DA.BRO##
	JUMPE	TB,CPOPJ
	POP	PP,TA
	JRST	1(TA)

;[1424] THIS ROUTINE FINDS  THE FILE WHICH CONTAINS THE GIVEN DATAB ITEM

FNDFIL:	JUMPE	TB,CPOPJ	; [1424] NONE - ERROR
	LDB	TC,[POINT 3,TB,20]; [1424] GET TYPE OF ITEM
	CAIN	TC,CD.FIL	; [1424] IS IT A FILE-NAME?
	JRST	FIL.F		; [1424] YES GO IT
	CAIN	TC,CD.DAT	; [1424] IS ITEM A DATA-NAME?
FIL.A:	PUSHJ	PP,FNDPOP	; [1424] GET FATHER OF DATA-ITEM
	  POPJ	PP,		; [1424] NONE- DATA ITEM NOT IN A FILE-ERROR RETURN
	LDB	TC,[POINT 3,TB,20]; [1424] GET TYPE OF FATHER
	CAIN	TC,CD.DAT	; [1424] IF FATHER IS A DATA NAME
	JRST	FIL.A		; [1424] THEN LOOP TO GET NEXT FATHER
	CAIE	TC,CD.FIL	; [1424] IS FATHER A FILE-NAME
	POPJ	PP,		; [1424] NO NOT A FILE OR DATA NAME- ERROR EXIT
FIL.F:	HRRZI	TA,(TB)		; [1424] NOW GET ITS REAL
	PUSHJ	PP,LNKSET	; [1424] ADDRESS
	POP	PP,TC		; [1424] FIND RETURN ADDRESS
	JRST	1(TC)		; [1424] RETURN +2


	END