Trailing-Edge
-
PDP-10 Archives
-
BB-4148D-BM
-
dbms-v5a/source/dbgetf.mac
There are 23 other files named dbgetf.mac in the archive. Click here to see a list.
TITLE DBGETF FOR COBOL 12
;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,1975,1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION
SUBTTL GET NEXT FILE FOR DBMS (PHASE D)
SEARCH P
TWOSEG
RELOC 400000
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
SETOM FINVOK## ;SET INVOKE FLAG
SETZM SRCCOL##
TLZE SW,20 ;[453] IS /S SWITCH ON--IF YES TURN IT OFF
SETOM DBONLY## ;[453] 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
>
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
MOVE TA,@SIZE(AP)
HRLI TA,CD.DBD
FUNCT GETENT
HRRZM TA,R0
RETURN
$FUNCT (FREMEM,<WHERE,SIZE>)
FREME.=:FREMEM
RETURN
END