Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
dbdml.mac
There are 22 other files named dbdml.mac in the archive. Click here to see a list.
TITLE DBDML FOR COBOL V12
SUBTTL DBMS DATA MANIPULATION LANG. SCANNER S.BLOUNT
;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, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH UUOSYM
SEARCH DMLSYM,GENDCL,DBSDCL,STRING,P ;FOR THE DML MODULE ONLY
SEGMEN
ENTRY DDL.
DBMS==:DBMS
;EDITS
;V10*****************
;NAME DATE COMMENTS
;COHEN 2-5-75 COMPLETELY RE-ORGANIZED THIS MODULE:
; KEEP ONLY INIT AND FINISH CODE AND DO
; REAL WORK IN DMLVOK AND SCHIO
;********************
$FUNCT (DBDML) ;FORCE HISEG
DEFINE DATA(NAM,LEN)<
EXTERN NAM
>
DEFINE GDATA (NAM,LEN)<
EXTERN NAM
>
DEFINE PRINT (.G)<
TTCALL 3,[ASCIZ/.G/]
>
;;; 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
HO.AS3:
14
XWD 'DSK',0
XWD AS3BHO##,AS3BHI##
HE.AS3:
4
0
XWD 0,'AS3'
XWD 'TMP',0
0
BHI.NZ:
;BUFFER (ALA DMLIO) BLKS
EXP RELCHN
OUT RELCHN,
0
0
XWD 400000,DBUFF1##+1
POINT 7,DBUFF1+3
0
0
EXP VOKCHN
OUT VOKCHN,
0
0
XWD 400000,SBUFF1##+1
POINT 7,SBUFF1+3
0
0
;OPEN BLKS
EXP 1B31 ;EXPLICIT WORD CNT
XWD 'DSK',0
XWD RELHDR##,0
EXP 1B31
XWD 'DSK',0
XWD VOKHDR##,0
;ENTER BLKS
4
0
0 ;JOB-NO,,DB<D>
XWD 'TMP',0
0
4
0
'DBC' ;JOB-NO,,DBC
XWD 'TMP',0
0
POINT 7,OBJAREA##
XWD LOUTMAX,0
POINT 7,VOKAREA##
XWD LOUTMAX,0
0
A%W: ;A VISUAL MARKER (ARGWRI)
0
[APPEND]
LINCHK##
NLEFT##
NN##
W%F:
0
0
0
0
0
0
0
0
POINT 7,SCHASC##
0
POINT 7,SSASC##
0
POINT 7,PKASC##
0
POINT 7,SIZAREA##
XWD 8,0
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
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
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>
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
RESTOR <5,4,3,2,R1,R0>
POPJ PP, ;BACK TO COBOLC
SUBTTL INPUT-OUTPUT ROUTINES FOR DDL PROCESSOR
;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: CLEAR TD,
CLEAR 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
TTCALL 3,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