Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/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