Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
fndpop.mac
There are 5 other files named fndpop.mac in the archive. Click here to see a list.
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