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, 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 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 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 MOVE SYMBLK,@0(AP) ;GET NODE TO DELETE DELLIST SYMBLK SETO R0, ;FOR CONSISTENCY RESTOR 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,) 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,) FREME.=:FREMEM RETURN END