Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/dbmall/dbdml.mac
There are 22 other files named dbdml.mac in the archive. Click here to see a list.
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,<TOPS20==0>
IFE TOPS20,<SEARCH UUOSYM>
IFN TOPS20,<SEARCH MONSYM,MACSYM>
.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<D>
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 <R0,R1,2,3,4,5> ;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,<RELCHAN>
FUNCT BUFINI,<VOKCHAN>
;NOW, WE'RE READY TO START READING THE SCHEMA FILE...
SAVE <BAS> ;SCHIO EXPECTS BAS TO BE A SYSTEM REG
FUNCT DMLVOK
RESTOR <BAS>
DMLEND:
FUNCT BUFINI,<RELCHAN>
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 <?CBLOEF--OPEN >
MOVE TB,[POINT 6,RELENT+.RBNAM]
JRST FILET
E.OVOK: PRINT <?CBLOEF--OPEN >
MOVE TB,[POINT 6,VOKENT+.RBNAM]
JRST FILET
E.EREL: PRINT <?CBLEEF--ENTER >
MOVE TB,[POINT 6,RELENT+.RBNAM]
JRST FILET
E.EVOK: PRINT <?CBLEEF--ENTER >
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 <ERROR ON FILE >
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