TITLE DMLIO

;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 CORPORATION


	SEARCH GENDCL,DMLSYM,STRING,STRDCL ;[M575] STRDCL INCL FOR DEFN
					   ;[575] OF CONSTANT BYTSIZ
	SEGMEN

	IFNDEF TOPS10,<TOPS10==1>

;EDITS
;V12A******************
;NAME	DATE		COMMENTS
;JSM	3-FEB-81	[575] DO NOT INTERPOLATE THE DASH CONTINUATION
;			CHARACTER ON A CONTINUATION LINE OF A COBOL BIND
;			STATEMENT IF THE TERMINATING CHARACTER OF THE
;			PREVIOUS LINE IS A COMMA. 
;**********************
;V12*******************
;NAME	DATE		COMMENTS
;HRB	JUN-7-79	[317/377/421] FIX COBOL CONTINUATION LINES
;
;********************
;V10*****************
;NAME	DATE		COMMENTS
;SSC	MAR-5-75	PLACED 6A EDIT %316 DIRECTLY IN V10
;			NOTE THIS IS A NEW MODULE FOR COBOL
;********************


	ENTRY OBJOUT,OWRITE,VOKOUT,VWRITE,BUFINI,OBJFLU,CWRITE

	IFNDEF $COB,<$COB==0>

	IFE $COB,<PRINTX <ASSEMBLING FOR FORTRAN>>
	IFN $COB,<PRINTX <ASSEMBLING FOR COBOL>>


	REG(CHANPT,4)

	IFN $COB,<			;BECAUSE OF IMPURE.MAC
	  DEFINE DATA(NAM,LEN)<
	  EXTERN NAM
	  >
	  DEFINE GDATA (NAM,LEN)<
	  EXTERN NAM
	  >
	>

	DATA(OBJAREA,^D14)		;STORAGE FOR .FOR LINES
	DATA(VOKAREA,^D14)
	DATA(TEMPBP,2)		;USED IN WRITE
	DATA(BUF.CP,2)	;ARG TO CHKSTR IN WRITE
	DATA(LINCHK,2)		;DITTO FOR OBJOUT
	DATA(NLEFT)		;FOR CHKSTR, IN OBJOUT
	DATA(NN)
	DATA(BUF.CN)		;DITTO FOR WRITE
	DATA(B.OR.L)		;BUF OR LINE
	DATA(ARG.T1)		;ONLY HISEG ARG-LISTS

	IFE $COB,<
OBJPTR::	POINT 7,OBJAREA
	XWD	LOUTMAX,0
VOKPTR::	POINT	7,VOKAREA
	XWD	LOUTMAX,0


	0
ARGWRI:
	0			;FILLED IN AT RUNTIME
	[APPEND]
	LINCHK
	NLEFT
	NN
WRIFILL:				;8 ARGS
	0
	0
	0
	0
	0
	0
	0
	0
	>

	SUBTTL CONSTANT DATA

$FUNCT	(DMLIO)			;FORCE HIGH SEG

	IFE $COB,<
ENDCOM:
	STRIPT	(<)
>)
CONTIN:
	STRIPT	(<
	1>)
	>
	IFN $COB,<
ENDCOM:
	STRIPT	(<.
>)
CONTIN:
	STRIPT	(<
-	 >)
NEWLIN:				;[A421] INSIDE THE IFN $COB
	STRIPT	(<
	>)
	>
	SUBTTL VARIOUS I/O ROUTINES

$FUNCT	(OBJOUT)				;VARIABLE NUMBER
	MOVEI	R1,RELCHAN
	SETOM	B.OR.L			;SET LINE
	COPI	ARGWRI,OBJPTR
	JRST	LINOUT
$FUNCT	(OWRITE)
	MOVEI	R1,RELCHAN
	SETZM	B.OR.L
	COPI	ARGWRI,BUFPTR(R1)
	JRST	LINOUT
$FUNCT	(VOKOUT)
	MOVEI	R1,VOKCHAN
	SETOM	B.OR.L			;SET LINE
	COPI	ARGWRI,VOKPTR
	JRST	LINOUT
$FUNCT	(VWRITE)
	MOVEI	R1,VOKCHAN
	SETZM	B.OR.L
	COPI	ARGWRI,BUFPTR(R1)
;	JRST	LINOUT

LINOUT:
	SAVE	<CHANPT>
	MOVE	CHANPT,R1
	MOVEI	R1,WRIFILL
	SETZM	NLEFT			;INIT FOR CHKSTR
	SETZM	NN			;FOR ARGCOPY
	YOYO	ARGCOPY,<WRIFILL,NN,AP>
WRI.LP:
	MOVEI	AP,ARGWRIT
	PUSHJ	P,CHKSTR##
	JUMPL	R0,IOEND
	SKIPE	B.OR.L		;SKIP SAYS BUFFER
	JRST	WRI.L1		;[M575]
;[575] THE FOLLOWING CODE IS COMMENTED OUT BECAUSE IT NEEDED TO BE EXPANDED
;[575] AND I DIDN'T WANT TO PUT A JRST [LITERAL INSIDE ANOTHER ONE.
;[D575]	JRST	[
;[D575]	MOVE	R1,ARGWRI
;[D575]	YOYO	OUTSTR,<CHANPT,ARGWRI>
;[D575]	MOVEI	R1,CONTIN
;[D575]	YOYO	OUTSTR,<CHANPT,R1>
;[D575]	MOVE	R1,ARGWRI
;[D575]	HLLZS	1(R1)		;RESET LENGTH TO ZERO
;[D575]	JRST	WRI.LP]
	YOYO	BUFOUT		;BUFOUT RESETS STRING PTR
	JRST	WRI.LP

WRI.L1:	;[575] THE FOLLOWING CODE HAS BEEN MOVED DOWN FROM ABOVE, AND
	;[575] THE NEW CODE IS COMMENTED WITH THE FLAG [A575].
	;[575] THE OLD CODE MERELY ASSUMED THAT IT SHOULD INCLUDE A DASH
	;[575] FOR EVERY CONTINUATION LINE OF A DBMS BIND STATEMENT. 
	;[575] HOWEVER, IF A DBMS DATA-NAME IS TERMINATED AT THE END OF
	;[575] LINE, THE DASH IS NOT NEEDED ON THE CONTINUATION LINE.
	;[575] THE NEW CODE LOCATES THE LAST CHARACTER IN THE BUFFER,
	;[575] WHICH IS KNOWN AT THIS POINT TO BE THE LAST CHARACTER IN
	;[575] THE INTERPOLATED LINE. IF THIS CHARACTER IS A COMMA, THE
	;[575] THE CONTINUATION DASH IS NOT NEEDED.
	;[575]
	MOVE	R1,ARGWRI		;[575]
	YOYO	OUTSTR,<CHANPT,ARGWRI>	;[575]
	MOVEI	R1,CONTIN	;[575] PUT CONTINUATION FLAG INTO R1 AS
				;[575] AS DEFAULT ACTION.
	PUSH	P,R2		;[A575] GET 4 AC'S TO WORK WITH
	PUSH	P,R3		;[A575]
	PUSH	P,R4		;[A575]
	PUSH	P,R5		;[A575]
	MOVE	R2,ARG.T1	;[A575] GET PTR TO OUTPUT DBMS BUFFER
	MOVE	R3,0(R2)	;[A575] GET "BYTE PTR" TO 1ST CHAR - 1.
	HRRZ	R4,1(R2)	;[A575] GET CHAR CNT CURRENTLY IN BUFFER
		;[A575] SINCE THIS OUTPUT FILE IS SINGLE-BUFFERED, WE HAVE
		;[A575] TO MAKE SURE THAT WE ARE GOING TO BE WORKING ONLY
		;[A575] WITHIN THAT BUFFER.
	CAIG	R4,0		;[A575] ZERO OR LESS?
	JRST	WRI.L2		;[A575] YES, TOO BAD, CANT TEST FOR ","
	HLRZ	R5,1(R2)	;[A575] GET BUFFER SIZE
	CAMLE	R4,R5		;[A575] STILL INSIDE BUFFER?
	JRST	WRI.L2		;[A575] NO, TOO BAD, ...
		;[A575] NEXT WE CREATE THE BYTE POINTER TO THE CURRENT
		;[A575] CHARACTER POSITION IN THE BUFFER - 1.
	IDIVI	R4,CPW		;[A575] DIVIDE BY CNT OF ASCII BYTES IN 
				;[A575] A WORD
	ADD	R3,R4		;[A575] ADD QUOT TO WORD PART OF BYTE PTR
	ADDI	R3,1		;[A575] BUMP UP BY ONE WORD
	MOVEI	R4,CPW+1	;[A575] SET UP FOR DIFFERENTIAL FOR BYTE
				;[A575] POS CALCULATION
	SUB	R4,R5		;[A575] SUB BYTE REMAINDER
	IMULI	R4,BYTSIZ	;[A575] MULT IT BY SIZE OF ASCII BYTE
	ADDI	R4,1		;[A575] ALIGN ON ASCII BYTE POS
	LSH	R4,14		;[A575] SHIFT IT TO "P" LOC FOR BYTE PTR
	HLRZ	R2,R3		;[A575] GET "S" LOC FOR BYTE PTR
	ADD	R2,R4		;[A575] ADD IN "P" LOC
	HRL	R3,R2		;[A575] MOVE TO LH OF BYTE PTR. NOW HAVE
				;[A575] CREATED ENTIRE BYTE PTR TO CURRENT
				;[A575] CHAR POS -1
		;[A575] THEN WE GET THE CHARACTER AND TEST IT AND IF NEC-
		;[A575] ESSARY SET UP THE ARGUMENT TO GENERATE A NEW LINE
		;[A575] WITHOUT THE CONTINUATION CHARACTER.
	ILDB	R4,R3		;[A575] GET CURRENT CHAR FROM BUFFER
	CAIN	R4,","		;[A575] IS IT A ","?
	MOVEI	R1,NEWLIN	;[A575] YES, WE SHOULD START A NEW LINE
				;[A575] IN THE OUTPUT TEXT.
				;[A575] IF NOT, JUST LEAVE CONTINUATION
				;[A575] FLAG IN R1.
WRI.L2:				;[A575]
	POP	P,R5		;[A575] GIVE BACK THE 4 AC'S
	POP	P,R4		;[A575]
	POP	P,R3		;[A575]
	POP	P,R2		;[A575]
	YOYO	OUTSTR,<CHANPT,R1>	;[575]
	MOVE	R1,ARGWRI		;[575]
	HLLZS	1(R1)		;RESET LENGTH TO ZERO ;[575]
	JRST	WRI.LP			;[575]
	;[575] END OF EDIT 575
$FUNCT	BUFINI,<CHAN>
	SAVE	<CHANPT>
	MOVEI	CHANPT,@CHAN(AP)
	YOYO	BUFOUT				;FRIST SETS UP BUFHDR
	JRST	IOEND

$FUNCT	OBJFLUSH

	FUNCT	CWRITE,<RELCHAN,OBJPTR>		;PUT AT PARTIAL  LINE
	FUNCT	CWRITE,<RELCHAN,ENDCOM>		;ENDCOM IS <END OF CALL><CRLF> SO OBJOUT CAN'T BE
						;USED FOR DUMPING ARBITRARY STATS

	HLLZS	OBJPTR+1			;PRESERVE MAX, SET LEN DOWN
	RETURN

;
;OBJCNTN - FIX COBOL CONTINUATION PROBLEM WITH ENTER MACRO SBIND
;THIS IS EDIT 317/377/421.  NOTE - THIS EDIT ALREADY APPEARS IN THE
;V6 SOURCES.
;

$FUNCT	(OBJCNTN)

IFN $COB,<
	FUNCT	CWRITE,<RELCHAN,OBJPTR>
	FUNCT	CWRITE,<RELCHAN,NEWLIN>
	HLLZS	OBJPTR+1
>
	RETURN

;END EDIT 317/377/421

$FUNCT	(CWRITE,<CHAN,OUTBP>)		;AT SOME POINT MUST BE GENERALIZED
	
	SAVE	<CHANPT>
	MOVEI	CHANPT,@CHAN(AP)
	MOVEI	R1,@OUTBP(AP)
	YOYO	OUTSTR,<CHANPT,OUTBP>
	JRST	IOEND

	;;;;;;;;;;;;;;;;

IOEND:	RESTOR	<CHANPT>
	RETURN

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

$YOYO	(OUTSTR,<CHANPT,OUTBP>)

	DCOPY	TEMPBP,0(R1)		;TO PASS ON
	SETZM	BUF.CN
	COPI	ARG.T1,BUFPTR(CHANPT)
BUF.LP:
	FUNCT	CHKSTR,<@ARG.T1,[APPEND],BUF.CP,BUF.CN,ONE,TEMPBP>
	JUMPL	R0,LEAVE
	YOYO	BUFOUT
	JRST	BUF.LP

$YOYO	BUFOUT

	IFN TOPS10,<
	HRRZ	R0,BUFPTR+1(CHANPT)		;SETUP WORD CNT
	IDIVI	R0,5
	SKIPE	R1				;REMAINDER?
	ADDI	R0,1
	MOVE	R1,HDR(CHANPT)
	HRRM	R0,1(R1)
	XCT	OUTINST(CHANPT)
	SKIPA
	HALT				;SHOULD'T HAPPEN
	COPY	BUFPTR(CHANPT),HDR+1(CHANPT)
	HRLZ	R0,HDR+2(CHANPT)		;SET UP MAXIMUM
	MOVEM	R0,BUFPTR+1(CHANPT)
	>
	RETURN

$YOYO	ARGCOPY,<R1,NN,AP>

	HRL	R1,AP		;FOR BLT
	HLRE	AP,-1(AP)
	MOVMS	AP
	ADDM	AP,NN
	ADDI	AP,0(R1)
	BLT	R1,-1(AP)
	RETURN

	END