Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - dmlio.mac
There are 22 other files named dmlio.mac in the archive. Click here to see a list.
	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,1975,1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH GENDCL,DMLSYM,STRING
	SEGMEN

	IFNDEF TOPS10,<TOPS10==1>

;EDITS
;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	(<
-	 >)
;[A421] INSERT AFTER THE ROUTINE CONTIN: INSIDE THE IFN $COB CONDITIONAL
NEWLIN:
	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	[
	MOVE	R1,ARGWRI
	YOYO	OUTSTR,<CHANPT,ARGWRI>
	MOVEI	R1,CONTIN
	YOYO	OUTSTR,<CHANPT,R1>
	MOVE	R1,ARGWRI
	HLLZS	1(R1)		;RESET LENGTH TO ZERO
	JRST	WRI.LP]
	YOYO	BUFOUT		;BUFOUT RESETS STRING PTR
	JRST	WRI.LP

$FUNCT	BUFINI,<CHAN>
	SAVE	<CHANPT>
	MOVEI	CHANPT,@CHAN(AP)
	YOYO	BUFOUT				;FRIST SETS UP BUFHDR
	JRST	IOEND

$FUNCT	OBJFLUSH

	;[607] at OBJFLUSH
	FUNCT	OBJOUT,<ENDCOM>	;[607] insure room on line for <end-of-call>
	FUNCT	CWRITE,<RELCHAN,OBJPTR>		;PUT AT PARTIAL  LINE
;[607]	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.
;

$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