Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE	DBDML

;     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, 1981 BY DIGITAL EQUIPMENT COPRORATION, MAYNARD, MASS.


SUBTTL	DBMS DATA MANIPULATION LANG. SCANNER		S.BLOUNT

	SEARCH	UUOSYM				;[6%203] UUOSYM NOT C
	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