TITLE DBDML FOR COBOL SUBTTL DBMS DATA MANIPULATION LANG. SCANNER S.BLOUNT 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 ; **** SEARCH DMLSYM,GENDCL,DBSDCL,STRING SEGMEN ; THIS MODULE IS FOR COBOL ONLY SO NO TESTS NEEDED (AS IF $COB=1) SEARCH P ;FOR THE DML MODULE ONLY IFNDEF TOPS20, IFE TOPS20, IFN TOPS20, .COPYRIGHT ;Put standard copyright statement in REL file ENTRY DDL. DBMS==:DBMS $FUNCT (DBDML) ;FORCE HISEG DEFINE DATA(NAM,LEN)< EXTERN NAM > DEFINE PRINT (.G)< IFE TOPS20,< OUTSTR [ASCIZ/.G/] > IFN TOPS20,< HRROI T1,[ASCIZ/.G/] PSOUT% > > ;;; SYMBOL CODES (NOTE DIFFERENT VALS THAN IN FORDML) $IDENT=:10 $DBNAME=:20 $DBID=:30 ;IS UNION SUBTTL DECLARATIONS REG(X,2) ; NON-ZERO DATA MAPPED INTO LOW SEG IFE TOPS20,< HO.AS3: ;VOKOPN: 14 XWD 'DSK',0 XWD AS3BHO##,AS3BHI## HE.AS3: ;VOKENT: 4 0 XWD 0,'AS3' XWD 'TMP',0 0 > BHI.NZ: ;BL.NZ: ;BUFFER (ALA DMLIO) BLKS ;RELCHAN: IFE TOPS20,< EXP RELCHN OUT RELCHN, > IFN TOPS20,< 0 PUSHJ PP,PUTDBD## > 0 0 ;RELHDR: IFE TOPS20,< XWD 400000,DBUFF1##+1 POINT 7,DBUFF1+3 > IFN TOPS20,< 0 0 > 0 0 ;VOKCHAN: IFE TOPS20,< EXP VOKCHN OUT VOKCHN, > IFN TOPS20,< 0 PUSHJ PP,PUTDBC## > 0 0 ;VOKHDR; IFE TOPS20,< XWD 400000,SBUFF1##+1 POINT 7,SBUFF1+3 > IFN TOPS20,< 0 0 > 0 0 ;OPEN BLKS ;RELOPN; EXP 1B31 ;EXPLICIT WORD CNT XWD 'DSK',0 XWD RELHDR##,0 ;VOKOPN: EXP 1B31 XWD 'DSK',0 XWD VOKHDR##,0 ;ENTER BLKS ;RELENT; 4 0 0 ;JOB-NO,,DB XWD 'TMP',0 0 ;VOKENT; 4 0 'DBC' ;JOB-NO,,DBC XWD 'TMP',0 0 ;OBJPTR: POINT 7,OBJAREA## XWD LOUTMAX,0 ;VOKPTR: POINT 7,VOKAREA## XWD LOUTMAX,0 ;FILLER: 0 ;ARGWRI: A%W: ;A VISUAL MARKER (ARGWRI) 0 [APPEND] LINCHK## NLEFT## NN## ;WRIFILL: W%F: 0 0 0 0 0 0 0 0 ;SCH.PT: POINT 7,SCHASC## 0 ;SS.PT: POINT 7,SSASC## 0 ;KEY.PT: POINT 7,PKASC## 0 ;SIZONL: POINT 7,SIZAREA## XWD 8,0 ;ERRPTR: POINT 7,ERRAREA## XWD 16*5,0 SUBTTL MAIN CONTROL PROGRAM FOR DML PROCESSOR $FUNCT (DDL.) ;CALLED FROM COBOLC SAVE ;SINCE GOING TO DPSS MORE/LESS ; SAVE 2-5 ALSO ; GENERAL PURPOSE INITS MOVE R0,[BHI.NZ,,BL.NZ##] BLT R0,EL.NZ## HLLZS OBJPTR+1 ;CLEAR ANY LINE CRUFT HLLZS VOKPTR+1 FUNCT VOKINI IFN TOPS20,< PUSHJ PP,OPNDBC## ;OPEN INVOKE FILE FOR PHASE C PUSHJ PP,OPNDBD## ;OPEN INVOKE FILE FOR PHASE D DMOVE TD,DBCPTR## ;SET UP INITIAL BYTE POINTER AND SIZE DMOVEM TD,VOKHDR+1 DMOVE TD,DBDPTR## DMOVEM TD,RELHDR+1 >;END TOPS20 IFE TOPS20,< PUSHJ PP,SETUPB ;SET UP ALL I/O CONTROL BLOCKS OPEN RELCHN,RELOPN JRST E.OREL ;CAN'T DO IT. ENTER RELCHN,RELENT ;TRY TO "ENTER" IT. JRST E.EREL ; MUST TIME SHARE THIS CHANNEL PUSH P,AS3BHI## ;SAVE CURRENT STATE PUSH P,AS3BHI+1 PUSH P,AS3BHI+2 PUSH P,AS3BHO## PUSH P,AS3BHO+1 PUSH P,AS3BHO+2 OPEN VOKCHN,VOKOPN JRST E.OVOK ;CAN'T DO IT. ENTER VOKCHN,VOKENT ;TRY TO "ENTER" IT. JRST E.EVOK MOVE TA,[400000,,DBUFF1##+1] MOVEM TA,RELHDR ;FILL IN OUTPUT BUFFER ADDR MOVE TA,[400000,,SBUFF1##+1] MOVEM TA,VOKHDR >;END TOPS20 FUNCT BUFINI, FUNCT BUFINI, ;NOW, WE'RE READY TO START READING THE SCHEMA FILE... SAVE ;SCHIO EXPECTS BAS TO BE A SYSTEM REG FUNCT DMLVOK RESTOR DMLEND: FUNCT BUFINI, IFN TOPS20,< PUSHJ PP,CLSDBC## ;CLOSE PHASE C TEMP FILE PUSHJ PP,CLSDBD## ;CLOSE PHASE D TEMP FILE >;END TOPS20 IFE TOPS20,< RELEAS RELCHN, ;CLOSE THE CREATED .TMP FILES ;VOKCHN CLOSED BY DMLVOK ; RESTORE XXXAS3.TMP TO CHANNEL MOVE R0,[HO.AS3,,VOKOPN] BLT R0,VOKOPN+2 MOVE R0,[HE.AS3,,VOKENT] BLT R0,VOKENT+4 MOVE R0,RELENT+.RBNAM ;GET JOB NO HLLM R0,VOKENT+.RBNAM OPEN AS3,VOKOPN JRST E.OVOK ENTER AS3,VOKENT JRST E.EVOK POP P,AS3BHO+2 POP P,AS3BHO+1 POP P,AS3BHO POP P,AS3BHI+2 POP P,AS3BHI+1 POP P,AS3BHI >;END TOPS20 RESTOR <5,4,3,2,R1,R0> POPJ PP, ;BACK TO COBOLC SUBTTL INPUT-OUTPUT ROUTINES FOR DDL PROCESSOR IFE TOPS20,< ;INITIALIZE ALL I/O CONTROL BLOCKS SETUPB: CALLI TC,$PJOB ;GET ASCII JOB NUMBER MOVEI TD,3 IDIVI TC,^D10 ADDI TB,"0"-40 LSHC TB,-6 SOJG TD,.-3 HLLM TA,VOKENT+.RBNAM HRRI TA,'DB0' ADD TA,DBCNTC## ;ADD LAST DIGIT MOVEM TA,RELENT+.RBNAM MOVE TA,[XWD 201,DBUFF1##+1] ;SET UP ONLY 1 BUFFER MOVEM TA,DBUFF1+1 MOVE TA,[XWD 201,SBUFF1##+1] MOVEM TA,SBUFF1+1 POPJ PP, SUBTTL ERROR PROCESSING FOR DDL PROCESSOR E.OREL: PRINT MOVE TB,[POINT 6,RELENT+.RBNAM] JRST FILET E.OVOK: PRINT MOVE TB,[POINT 6,VOKENT+.RBNAM] JRST FILET E.EREL: PRINT MOVE TB,[POINT 6,RELENT+.RBNAM] JRST FILET E.EVOK: PRINT MOVE TB,[POINT 6,VOKENT+.RBNAM] JRST FILET ;PRINTS SCHEMA FILE NAME FILE6: SETZB TD,TC MOVE TA,[POINT 7,TD] MOVEI TE,6 FILE6A: ILDB R0,TB ADDI R0,40 CAIE R0,40 ;IGNORE IF SPACE IDPB R0,TA SOJG TE,FILE6A OUTSTR TD ;PRINT FILE-NAME POPJ PP, FILET: PRINT PUSHJ PP,FILE6 PRINT <.TMP> JRST DMLEND IFN 0,< ;NOOP BUT KEEP ;THIS SUBROUTINE PRINTS THE VALUE OF A PPN ;ENTER: TA=PPN PUTPPN: SKIPN TA ;IS THERE A PPN? POPJ PP, ;NO, DON'T PRINT ANYTHING MOVE R0,[POINT 7,TC] ;R0 IS THE ASCII PTR MOVE R3,[POINT 3,TA] ;R3 IS THE SOUCE PTR MOVEI R1,6 ;R1 IS COUNTER MOVEI R2,"[" IDPB R2,R0 PUSHJ PP,SIXNUM ;PRINT PROJECT # MOVEI R2,"," IDPB R2,R0 MOVEI R1,6 PUSHJ PP,SIXNUM MOVEI R2,"]" IDPB R2,R0 SETZ R2,0 ;LAST BYTE IDPB R2,R0 TTCALL 3,TC ;PRINT IT POPJ PP, ;OUTPUT A HALF OF A PPN SIXNUM: ILDB R4,R3 ;GET DIGIT JUMPE R4,SIX2 ;DON'T STORE ZERO BYTES ADDI R4,"0" IDPB R4,R0 SIX2: SOJG R1,SIXNUM POPJ PP, > >;END IFE TOPS20 END