	.title	k11atr	process attribute packets
	.ident	/1.0.01/

;	18-Apr-84  11:20:59 Brian Nelson
;
;	Copyright (C) 1984  Change Software, Inc.
;
;
;	Process attribute packets for RSTS/E and RSX11M/M+
;
;	 This module is intended to be placed into an overlay
;	which MUST be the 'ERROR' cotree as the server, which
;	is overlayed in the  'UTILTY'  cotree can  indirectly
;	call the module through the packet control routines.
;	 This module will also be rather RMS11 dependent.
;
;
;	Get the Kermi-11 common macro definition INCLUDE file

	.include	/IN:K11MAC.MAC/

	.psect	$pdata

watt:	.word	sn.sys	,sn.typ	,sn.fab	,sn.pr0	,sn.pr1	,sn.len	,0

attrty:	.byte	41	,42	,43	,44	,45	,46	,47
	.byte	50	,51	,52	,53	,54	,55	,56
	.byte	57	,60
	.byte	0
	.even

attrds:	.word	at.$$
	.word	at.len	,at.typ	,at.cre	,at.id	,at.bil	,at.area,at.pas
	.word	at.bsiz	,at.acc	,at.enc	,at.dis	,at.pr0	,at.pr1	,at.sys
	.word	at.for	,at.fab

badpak:	.asciz	/Unknown attribute packet type /
	.even

	.psect	$code

	.sbttl	return the next attribute packet to send

;	W $ A T T R
;
;	input:	@r5	filename address
;		2(r5)	lun it's using
;		4(r5)	output packet address
;
;	output:	r0	rms error code, else zero
;		r1	> 0 the packet length, also come back for more later
;		r1	= 0 no more packets or else receiver can't handle them


w$attr::save	<r2,r3,r4>		; save registers that we may use here
	bitb	#capa.a	,conpar+p.capas	; the other system handle 'A' packets?
	beq	90$			; no, exit with 'eof'
10$:	mov	4(r5)	,r4		; point to the packet
	mov	atrctx	,r0		; now dispatch on what to send next
	asl	r0			; simple to do
	tst	watt(r0)		; all done ?
	beq	90$			; yes, just exit then
	jsr	pc	,@watt(r0)	; and do it
	inc	atrctx			; next time, do the next one in the list
	tst	r0			; was it possible to do this attr?
	bne	10$			; no, try the next one then
	strlen	4(r5)			; get the length and return it
	mov	r0	,r1		; and say that this packet is for real
	clr	r0			; exit without error
	br	100$			; bye
	
90$:	clr	r0			; all done, no more attributes to
	clr	r1			; send over
	clr	atrctx			; init for the next file we send

100$:	unsave	<r4,r3,r2>		; pop these and exit
	return				; bye




	.sbttl	dispatch routines for sending 'a' packets

sn.sys:	call	getsys			; get the system type first
	scan	r0	,#200$		; find out what we are
	tst	r0			; did it work ?
	beq	110$			; no
	movb	#'.	,(r4)+		; sys id attr packet
	movb	#'D&137	,(r4)+		; return the vendor code (DEC)
	movb	210$(r0),(r4)+		; and the system type
	clrb	@r4			; .asciz
	clr	r0			; say it worked
	return				; bye

110$:	mov	sp	,r0		; it failed
	return


200$:	.byte	sy$11m	,sy$ias	,sy$rsts,sy$mpl	,sy$rt	,sy$pos	,0
210$:	.byte	0
	.byte	'8	,'9	,'A&137	,'8	,'B&137	,'C&137	,0
	.even


	.sbttl	send a copy of the ifab over


;	 The routine 'GETATR' takes the directory (or file header) information
;	regarding the file format from the IFAB allocated  to the FAB for  the
;	file currently being sent. This data is converted to octal strings and
;	then sent over as an ATTRIBUTE packet with a type of '0', which is the
;	type reserved for system specific data.
;	 The  receiver  KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type
;	attribute packet first so it can decide whether or not it wants to use
;	the data being sent.
;
;	For instance, the file A.A would have a packet sent over as in below
;
; Name .Typ    Size    Prot   Access     Date      Time   Clu  RTS    Pos 
;A     .A         1    < 60> 01-May-84 01-May-84 10:17 AM   4 ...RSX  3493
; RF:VAR=132 FO:SEQ   USED:1:98       RECSI:46       CC:IMP
;
;
;
;SPACK -   Length   78   Type  A    Paknum    3                       
;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000 




sn.fab:	calls	getatr	,<2(r5),#at$fab>; get the ifab stuff now
	tst	r0			; but did it work?
	bmi	100$			; no, it crapped out
	movb	#'0	,(r4)+		; return sys type attr code
	mov	r4	,r0		; fill it with spaces first
	mov	#13*7	,r1		; simple
5$:	movb	#40	,(r0)+		;
	sob	r1	,5$		; next
	mov	#at$fab	,r2		; where we store such things
	mov	#13	,r0		; number of words to send
10$:	calls	l$otoa	,<r4,(r2)+>	; do it
	add	#7	,r4		; skip over it
	sob	r0	,10$		; next
	clr	r0			; say that it worked
	clrb	@r4			; .asciz
100$:	return
	
	.sbttl	send file type (ascii,binary), protection and size

sn.typ:	movb	#42	,(r4)+		; attribute type
	movb	#'A&137	,@r4		; assume ascii
	cmpb	image	,#binary	; already decided that it's binary?
	bne	10$			; no
	movb	#'I&137	,@r4		; yes, say it's image mode today
10$:	clrb	1(r4)			; insure .asciz
	clr	r0			; flag success and exit
	return				; bye


sn.pr0:
sn.pr1:	mov	#-1	,r0
	return


sn.len:	calls	getsiz	,<2(r5)>	; get the size of the file please
	tst	r0			; did this work ?
	bne	100$			; no
	inc	r1			; try to accomodate rounding
	asr	r1			; in 1024 blocks, not 512
	bic	#100000	,r1		; insure no sign bits now
	movb	#41	,(r4)+		; attribute type (file size)
	movb	#45	,(r4)+		; length of the number
	deccvt	r1,r4,#5		; convert to ascii
	mov	#5	,r0		; convert leading spaces to '0'
10$:	cmpb	@r4	,#40		; if a space, then make it a '0'
	bne	20$			; no
	movb	#'0	,@r4		; yes, stuff a space in
20$:	inc	r4			; next please
	sob	r0	,10$		; next please
	clrb	@r4			; insure .asciz
	clr	r0			; to be safe
100$:	return				; bye



	.sbttl	dispatch on the type of attribute packet received
	.psect	$code

;	R $ A T T R
;
;	input:	@r5	the packet address
;	output:	r0	error code, zero for success

r$attr::save	<r1,r2,r3,r4,r5>	; just to be safe
	mov	@r5	,r5
	movb	@r5	,r0
	scan	r0	,#attrty	; look for the attribute packet type?
	asl	r0			; simple to do
	jsr	pc	,@attrds(r0)	; process the attribute packet now
	unsave	<r5,r4,r3,r2,r1>	; bye
	return				; exit


at.$$:	calls	error	,<#1,#badpak>	; send error back to abort things
	mov	#-1	,r0		; return 'abort'
	return

	.sbttl	process specific attribute types


;	File size in 1024 byte chunks (512 would have been better)

at.len:	save	<r1,r2>			; save temps please
	clr	at$len			; assume zero
	mov	r5	,r2		; point to the packet
	tstb	(r2)+			; skip the "!" atttribute type
	movb	(r2)+	,r0		; get the length of the number
	beq	100$			; nothing there ?
	sub	#40	,r0		; convert to a real number
	beq	100$			; nothing to do ?
	clr	r1			; init the accumulator
10$:	tstb	@r2			; eol ?
	beq	30$			; yep
	cmpb	@r2	,#40		; ignore leading spaces please
	beq	20$			; yes, a space
	clr	-(sp)			; get the next digit please
	movb	@r2	,@sp		; and convert to decimal
	sub	#'0	,@sp		; got it
	mul	#12	,r1		; shift accum over 10
	add	(sp)+	,r1		; add in the current digit
20$:	inc	r2			; next ch please
	sob	r0	,10$		; next digit please
30$:	asl	r1			; convert 1024 blocks to 512 blocks
	mov	r1	,at$len		; save it please
100$:	unsave	<r2,r1>			; pop temps and exit
	clr	r0
	return


at.typ:	cmpb	1(r5)	,#'B&137	; 'binary' ?
	beq	10$			; yes
	cmpb	1(r5)	,#'I&137	; 'image'  ?
	bne	100$			; no
10$:	mov	#binary	,image		; flag for image mode then
	mov	#binary	,at$typ		; save it here also
100$:	clr	r0
	return


at.cre:	clr	r0
	return

at.id:	clr	r0
	return

at.bil:	clr	r0
	return

at.area:clr	r0
	return

at.pas:	clr	r0
	return

at.bsiz:clr	r0
	return

at.acc:	clr	r0
	return

at.enc:	clr	r0
	return

at.dis:	movb	1(r5)	,at$dis
	clr	r0
	return

at.pr0:	clr	r0
	return

at.pr1:	clr	r0
	return

at.sys:	movb	1(r5)	,at$sys		; major vendor type
	movb	2(r5)	,at$sys+1	; save the system type
	clr	r0			; no errors
	return				; exit

at.for:	clr	r0
	return


	.sbttl	recieve the ifab data for file attributes from another 11


	fabsiz	=	7*13		; need at least this many 

at.fab:	strlen	r5			; packet size ok
	dec	r0			; less the attribute type ('system')
	cmp	r0	,#fabsiz	; well....
	blo	100$			; too small, ignore the fab data
	call	ispdp			; are we compatible today?
	tst	r0			; no if eq
	beq	100$			; no, ignore the system dep attr's

	mov	#at$fab	,r4		; copy the packet over now
	mov	r5	,r3		; and the source please
	inc	r3			; skip the attribute type header
	mov	#-1	,(r4)+		; flag that the attributes are for real
	mov	#13	,r2		; number of words to convert back
10$:	clrb	6(r3)			; insure .asciz now
	calls	octval	,<r3>		; simple
	tst	r0			; successfull?
	bne	90$			; no, clear flag and exit
	mov	r1	,(r4)+		; and save the value now
	add	#7	,r3		; point to the next octal number
	sob	r2	,10$		; next please
	mov	sp	,at$val		; it's ok to use the attributes
	br	100$			; bye
90$:	clr	at$fab			; error exit (conversion error)
100$:	clr	r0			; always flag success and exit
	return



	.sbttl	utility routines

	pd$rsx	=	'8
	pd$ias	=	'9
	pd$rsts	=	'A&137
	pd$rt	=	'B&137
	pd$pos	=	'C&137

;	I S P D P
;
;	input:	nothing
;	output:	r0 <> 0 if the other system is a KERMIT-11 system
;	errors:	none


	.psect	$pdata

pdplst:	.byte	pd$rsx	,pd$ias	,pd$rsts,pd$rt	,pd$pos	,0
	.even
	.psect	$code

ispdp::	clr	r0			; presume failure
	cmpb	at$sys	,#'D&137	; a DEC system ?
	bne	100$			; no, exit
	scan	<at$sys+1>,#pdplst
100$:	return

clratr::clr	at$len	
	clr	at$typ	
	clr	at$cre	
	clr	at$id	
	clr	at$bil	
	clr	at$area
	clr	at$pas
	clr	at$bsiz	
	clr	at$acc	
	clr	at$enc	
	clr	at$dis	
	clr	at$pr0	
	clr	at$pr1	
	clr	at$sys
	clr	at$for	
	clr	at$fab
	clr	atrctx
	return

	.sbttl	finish up the update of rms file attributes to output

;	A T R F I N
;
;	If the file was send in image mode, and we have been sent
;	valid attributes (basically, the sender's IFAB), then call
;	PUTATR to place these attributes into our output file's
;	IFAB so they will get updated.
;
;
;	Note: 11-Jul-84  17:12:49  BDN,  edit /19/
;
;	 Note that for RSTS/E, we have an unusual problem in that if
;	the sender sent a stream ascii file (most likely a file with
;	NO attributes)  over and the sender  said it's binary,  then
;	RMS-11 sends GARBAGE for the VFC header size. When this data
;	is wriiten  into the output file's IFAB, RMS11 finds invalid
;	data in the IFAB and writes attributes to disk with the last
;	block field (F$HEOF and F$LEOF)  equal to ZERO.  Such a file
;	would thus be unreadable to PIP, RMS and other programs that
;	look at the file attributes.  The fix  is one of two things.
;	One, we can clear the invalid  VFC size and fudge the record
;	size and maximum record size to something usable (like 512),
;	or  we can simply ignore  the senders attributes and let the
;	file  stand as a  FIXED, NO CC, recordsize 512 file.  Rather
;	than to try to fix the attributes, we will simple ignore the
;	attributes  if the sender said that the file is stream ascii
;	with a garbage VFC.  Since  the attributes  are only used if
;	the transfer was in image moed, this will not  affect normal
;	files, only files like DMS-500 files that have no attributes
;	but must be sent in image mode.
;	Of course, the sending Kermit-11 can always be given the SET
;	ATT OFF and SET FIL BIN and the receiving Kermit-11 be given
;	the SET FIL BIN and the issue will never arise.
;
;	The mods are noted with /19/ after the statement.

atrfin::save	<r1,r2,r3>		; just in case please
	tst	@r5			; lun zero ?
	beq	100$			; yep
	tst	at$val			; valid attributes to write ?
	beq	100$			; no
	cmpb	at$typ	,#binary	; did we get this as a binary file?
	bne	100$			; no
	mov	#at$fab	,r1		; yes
	tst	(r1)+			; valid data present ?
	beq	100$			; no
	cmp	@r1	,#2000		; /19/ stream ascii ?
	bne	30$			; /19/ no
	cmp	16(r1)	,#177400	; /19/ garbage for the vfc header size?
	beq	90$			; /19/ yes, forget about the attributes
30$:	calls	putatr	,<@r5,r1>	; /19/ update the ifab for the file
90$:	clr	at$typ			; /19/ no longer valid please
	clr	at$fab			; no longer valid please
	clr	at$val			; no longer valid please
100$:	unsave	<r3,r2,r1>		; output file and exit
	return

200$:	.byte	40,0

	.end
