Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/dmlio.mac
There are 22 other files named dmlio.mac in the archive. Click here to see a list.
; UPD ID= 1501 on 1/22/84 at 11:46 PM by MAGRATH                        
	TITLE DMLIO

	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 COPRORATION

; *******************************************************************
; 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 GENDCL,DMLSYM,STRING
	SEGMEN

	IFNDEF $COB,<$COB==0>

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

	IFN $COB,<SEARCH P>		;GET TOPS-10/20 DEFINITION

	IFNDEF TOPS10,<TOPS10==1>
	IFNDEF TOPS20,<TOPS20==0>

	.COPYRIGHT		;Put standard copyright statement in REL file

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


	REG(CHANPT,4)

	IFN $COB,<			;BECAUSE OF IMPURE.MAC
	  DEFINE DATA(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	(<)>)		;[1115] EOS, NOT EOS+EOL
CONTIN:
	STRIPT	(<
	1>)
NEWLIN:
	STRIPT	(<
	>)
	>
	IFN $COB,<
ENDCOM:
	STRIPT	(<.>)		;[1115] EOS, NOT EOS+EOL

CONTIN:
	STRIPT	(<
-	>)
NEWLIN:
	STRIPT	(<
	>)
	>
ENDLIN:				;[1115] SEPERATE END-OF-LINE
	STRIPT	(<
>)				;[1115]
	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	STRINGOUT,<CHANPT,ARGWRI>
	MOVEI	R1,CONTIN
	YOYO	STRINGOUT,<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

	FUNCT	OBJOUT,<ENDCOM>			;[1115] BUFFER END OF COMMAND
	FUNCT	CWRITE,<RELCHAN,OBJPTR>		;PUT AT PARTIAL  LINE
	FUNCT	CWRITE,<RELCHAN,ENDLIN>		;[1115] AND TERMINATE LINE

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

$FUNCT	OBJCNTN			;[%317] FIX COBOL CONTINUATION LINES

	FUNCT	CWRITE,<RELCHAN,OBJPTR>		;PUT AT PARTIAL  LINE
	FUNCT	CWRITE,<RELCHAN,NEWLIN>		;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

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

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

IOEND:	RESTOR	<CHANPT>
	RETURN

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

$YOYO	(STRINGOUT,<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

IFE $COB,<				;FORDML CASE
  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)
  >;END TOPS10
>;END $COB

IFN $COB,<					;COBOL CASE
	HRRZ	R0,BUFPTR+1(CHANPT)		;SETUP WORD CNT
  IFE TOPS20,<					;12B SAME AS FORDML
	IDIVI	R0,5
	SKIPE	R1				;REMAINDER?
	ADDI	R0,1
	MOVE	R1,HDR(CHANPT)
	HRRM	R0,1(R1)
  >;END TOPS20
	XCT	OUTINST(CHANPT)
  IFE TOPS20,<					;12B SAME AS FORDML
	SKIPA
	HALT				;SHOULD'T HAPPEN
  >;END TOPS20
	COPY	BUFPTR(CHANPT),HDR+1(CHANPT)
	HRLZ	R0,HDR+2(CHANPT)		;SET UP MAXIMUM
	MOVEM	R0,BUFPTR+1(CHANPT)
>;END $COB
	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