;
; **********************************************************************
		.TITLE	CARRIAGE
; this is a program to change the carriage control attributes of a file
; to fortran or to carriage return control
; must be linked with sys$useful:error
;
;***********************************************************************
;
$DSCDEF
$FIBDEF
$ATRDEF
.PSECT DATA,LONG
GATTR:	.WORD 32
	.WORD ATR$C_RECATTR
	.LONG GETATTR
	.LONG 0
GETATTR::	.BLKB 32
;
; the attribute block is defined as follows (by RMS):
;
;	file org and record format  (byte)
;	rec attr (byte)
;	mrs (word)
;	hi'est vbn allocated (longword)
;	eof vbn (longword)
;	ffb (word)
;	bkt sz (byte)
;	fsz (byte)
;	mrs (word)
;	deq (word)
;
DISK:	.LONG 0,0				;descriptor for device
IOSB::	.LONG 0
	.LONG 0
.ALIGN LONG
FAB::	$FAB	NAM=NAM,FOP=NAM
NAM::	$NAM	RSA=RESULT,RSS=NAM$C_MAXRSS
RESULT:	.BLKB NAM$C_MAXRSS
FIB_BLOCK:	.BLKB	FIB$K_LENGTH
FIB_DESC:	.LONG FIB$K_LENGTH
		.LONG FIB_BLOCK
FILE:	.LONG	0,0			;descriptor for filename
CHAN:	.LONG 0
GETCMD:	$CLIREQDESC -
			RQTYPE = CLI$K_GETCMD
DESC:	.BLKL 2
FIRST:	.BLKB 30
PROMPT1:	.ASCID /$_File name:/
PROMPT_CR:	.ASCID /$_Carriage Control (F for Fortran, C for Carriage Return)/
CARR_CONT:	.BYTE 0
.PSECT CODE
START::
	.WORD 0
	PUSHAB	W^GETCMD
	CALLS	#1,@CLI$A_UTILSERV(AP)
	MOVQ	W^GETCMD+CLI$Q_RQDESC,DESC
	TSTL	DESC
	BEQL	PROMPT_FIRST
;
; have one file spec, get it
;
	MOVL	DESC+4,FAB+FAB$L_FNA
	MOVB	DESC,FAB+FAB$B_FNS
;
	BRW	ON_WITH_IT
	BRW	ON_WITH_IT
;
; need to get file -- prompt away
;
PROMPT_FIRST:
	CLRQ	DESC
	MOVB	#DSC$K_CLASS_D,DESC+DSC$B_CLASS
	PUSHAL	PROMPT1
	PUSHAL	DESC
	CALLS	#2,LIB$GET_INPUT
	BLBS	R0,A
A1:	BRW	ERR
A:
	MOVZWL	DESC,R0
	MOVB	R0,FAB+FAB$B_FNS
	MOVAL	FIRST,FAB+FAB$L_FNA
	PUSHL	R0
	PUSHL	DESC+4
	CALLS	#2,UPPER
	MOVC3	R0,@DESC+4,FIRST
;
; got file spec, open the file and away we go
;
ON_WITH_IT:
;
; prompt for the type of carriage control
;
PROMPT_ATTR:
	CLRQ	DESC
	MOVB	#DSC$K_CLASS_D,DESC+DSC$B_CLASS
	PUSHAL	PROMPT_CR
	PUSHAL	DESC
	CALLS	#2,LIB$GET_INPUT
	BLBC	R0,A1
	MOVZWL	DESC,R0
	TSTL	R0
	BEQL	PROMPT_ATTR
	MOVZBL	@DESC+4,R0
	CMPB	R0,#^A/a/			;is it lower case?
	BLSS	10$				;if not, branch
	SUBL2	#32,R0				;if it is, make uppercase
10$:
	CMPB	R0,#^A/F/
	BEQL	FORTRAN
	CMPB	R0,#^A/C/
	BEQL	CR
	BRB	PROMPT_ATTR
FORTRAN:
	MOVB	#FAB$M_FTN,CARR_CONT
	BRB	COMMON
CR:
	MOVB	#FAB$M_CR,CARR_CONT
COMMON:
	$OPEN FAB=FAB,ERR=REPORT_ERROR
	MOVZBL	NAM+NAM$B_RSL,R6
	LOCC	#^A/:/,R6,RESULT
	MOVAL	RESULT,DISK+4
	SUBL3	R0,R6,R1
	ADDL3	#1,R1,DISK
	LOCC	#^A/]/,R6,RESULT
	ADDL3	#1,R1,FILE+4
	DECL	R0
	MOVL	R0,FILE
	MOVW	NAM+NAM$W_FID,FIB_BLOCK+FIB$W_FID
	MOVW	NAM+NAM$W_FID+2,FIB_BLOCK+FIB$W_FID+2
	MOVW	NAM+NAM$W_FID+4,FIB_BLOCK+FIB$W_FID+4
	MOVW	NAM+NAM$W_DID,FIB_BLOCK+FIB$W_DID
	MOVW	NAM+NAM$W_DID+2,FIB_BLOCK+FIB$W_DID+2
	MOVW	NAM+NAM$W_DID+4,FIB_BLOCK+FIB$W_DID+4
CONT:
	$CLOSE FAB=FAB,ERR=REPORT_ERROR
	$ASSIGN_S DEVNAM=DISK,CHAN=CHAN
	BLBS	R0,B
C:	BRW	ERR
B:
	MOVL	#FIB$M_WRITE,FIB_BLOCK+FIB$L_ACCTL
	$QIOW_S FUNC=#IO$_ACCESS!IO$M_ACCESS,IOSB=IOSB,CHAN=CHAN,P1=FIB_DESC,-
	P2=#FILE,P5=#GATTR
	BLBC	R0,C
	CMPL	IOSB,#SS$_NORMAL
	BNEQ	IO_ERR
	MOVB	CARR_CONT,GETATTR+1
	$QIOW_S	FUNC=#IO$_MODIFY,IOSB=IOSB,CHAN=CHAN,P1=FIB_DESC,-
		P2=#FILE,P5=#GATTR
	BLBC	R0,ERR
	CMPL	IOSB,#SS$_NORMAL
	BNEQ	IO_ERR
	$QIOW_S FUNC=#IO$_DEACCESS,CHAN=CHAN
	$DASSGN_S CHAN=CHAN
	RET
IO_ERR:
	PUSHL	IOSB
	BRB	C_ERR
ERR:
	PUSHL	R0
C_ERR:
	CALLS	#1,LIB$SIGNAL
	RET
.END START