k11atr.mac

	.title	k11atr	process attribute packets
	.ident	/1.0.02/
	.enabl	gbl

;	18-Apr-84  11:20:59 Brian Nelson
;
;	24-Mar-86  12:00:56 BDN	Major revision which has some rather
;				unpleasant compatibility problems with
;				older Kermit-11's.
;
;	12-Sep-86  10:37:04 BDN Convert for I/D space running
;
;	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



	.if ndf, K11INC
	.ift
	.include	/IN:K11MAC.MAC/
	.endc


	.psect	$pdata

watt:	.word	sn.sys	,sn.typ	,sn.fab	,sn.pr0	,sn.pr1	,sn.len	,sn.fty
;-	.word	sn.cdt
	.word	0
attrty:	.byte	41	,42	,43	,44	,45	,46	,47
	.byte	50	,51	,52	,53	,54	,55	,56
	.byte	57	,60	,61
	.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	,at.xle

badpak:	.asciz	/Unknown attribute packet type /
incomp:	.ascii	/?K11-ATR Protocol bugfix detected. Use/<CR><LF> 
	.asciz	/SET NOATT and see K11.BWR, K11INS.DOC./<CR><LF>
	.even

	.psect	tempda	,rw,d,lcl,rel,con
curatr:	.blkb	200

	.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
	.enabl	lsb

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	#42	,(r4)+		; /49/ Length of whats to follow
	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


	.save
	.psect	$PDATA	,D
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
	.restore
	.dsabl	lsb



	.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
	movb	#<13*7>+40,(r4)+	; Length of data to follow.
	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.FTY added /52/

	.enabl	lsb

sn.fty:	movb	#'0	,(r4)+		; Attribute type (SYS type)
	movb	#42	,(r4)+		; Length of data to follow.
	movb	#42	,(r4)+		; Sending extended filetype
	mov	image	,r0		; Index into it
	movb	200$(r0),(r4)+		; Insert it
	clrb	@r4			; .Asciz
	clr	r0			; Success
	return				; Exit

	.ASSUME	TEXT	EQ	0
	.ASSUME	BINARY	EQ	1
	.ASSUME	DECNAT	EQ	2

	.save				; Save, start a DATA psect
	.psect	$pdata	,d
200$:	.byte	'A&137	,'I&137	,'N&137	,'A&137
	.even
	.restore			; Pop old psect
	.dsabl	lsb			; And drop local symbol block



sn.cdt:	movb	#'0	,(r4)+		; System dependent data following
	movb	#41+<6*4>,(r4)+		; Amount of data to follow
	movb	#43	,(r4)+		; Date of creation, 64bit format
	CALLS	getcdt	,<2(r5)>	; Get address of data
	mov	r0	,r2		; Successful (ie, not RT11)
	beq	90$			; No
	mov	#4	,r3		; Number of words
10$:	CALLS	l$otoa	,<r4,(r2)+>	; Do it
	add	#6	,r4		; Move over
	sob	r3	,10$		; Next please
	clrb	@r4			; .ASCIZ
	clr	r0			; Success
	br	100$			; Exit
90$:	mov	#-1	,r0		; Failure
100$:	return				; Exit


sn.typ:	movb	#42	,(r4)+		; attribute type
	movb	#41	,(r4)+		; /49/ Length of what follows
	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:	call	getsys			; /59/ Get system type
	mov	r0	,-(sp)		; /59/ Save it
	calls	getpro	,<2(r5)>	; /59/ Get protection for file
	cmpb	(sp)+	,#4		; /59/ If RSTS, we want to convert
	bne	10$			; /59/ to files11 format.
	call	tof11			; /59/ Yes, convert
10$:	movb	#54	,(r4)+		; /59/ Sending internal protection
	movb	#40+6	,(r4)+		; /59/ Field is six characters
	calls	l$otoa	,<r4,r0>	; /59/ Convert to octal
	add	#6	,r4		; /59/ Always leave pointing to end
	clrb	@r4			; /59/ And make it .asciz
	clr	r0			; /59/ Success
	return				; /59/ Exit

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		; /49/ Get packet data address
10$:	movb	(r5)+	,r0		; /49/ Attribute type code
	beq	90$			; /49/ Nothing there ???
	movb	(r5)+	,r1		; /49/ Get length field next
	beq	90$			; /49/ Nothing there ?
	cmpb	r0	,#'.		; /49/ If this is an OLD kermit-11
	bne	20$			; /49/ with the invalid packet fmt
	cmpb	r1	,#'D&137	; /49/ then we will have to make a
	bne	20$			; /49/ note of it and try to fix it
	mov	sp	,oldatt		; /49/ up.

20$:	call	200$			; /49/ Perhaps fix packets from old K11
	sub	#40	,r1		; /49/ Convert length to integer
	bmi	90$			; /49/ Again, nothing was there
	mov	#curatr	,r2		; /49/ Copy current attribute argument
40$:	movb	(r5)+	,(r2)+		; /49/ over to a save area now.
	sob	r1	,40$		; /49/ Next please
	clrb	(r2)+			; /49/ Insure .asciz please
	mov	r5	,-(sp)		; /49/ Make sure the r5 context saved
	scan	r0	,#attrty	; look for the attribute packet type?
	asl	r0			; simple to do
	jsr	pc	,@attrds(r0)	; process the attribute packet now
	mov	(sp)+	,r5		; /49/ Restore the R5 context now.
	tst	r0			; Success
	beq	10$			; Yes
	br	100$			; No, exit
90$:	clr	r0			; Packet format error or end of data
100$:	unsave	<r5,r4,r3,r2,r1>	; bye
	return				; exit


200$:	mov	r0	,-(sp)		; /49/ Fix bad attribute data up (?)
	cmpb	r0	,#41		; /49/ The old (and incorrect) K11's
	beq	220$			; /49/ did the filesize format ok
	tst	oldatt			; /49/ Is this a fubarred old Kermit-11
	beq	220$			; /49/ No
	dec	r5			; /49/ Yes, we had been forgetting to
	strlen	r5			; /49/ include the length field before 
	mov	r0	,r1		; /49/ the actual attribute data.
	add	#40	,r1		; /49/ Convert to char format.
220$:	mov	(sp)+	,r0		; /49/ So backup one char and reset the
	return				; /49/ Length.

at.$$:	clr	r0			; /49/ Ignore unknown attribute types
	return				; /49/ Exit
;-	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	#curatr	,r2		; /49/ Where we saved attributes
	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
	br	10$			; /49/ Next 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


;	Exact size in bytes (type '1')

at.xlen:save	<r1,r2,r4,r4,r5>	; /49/ Save temps please
	asl	r1			; /49/ Convert 1024 blocks to 512 blocks
	clr	at$len			; /49/ Assume zero
	mov	#curatr	,r5		; /49/ Point to attribute save area
	clr	r3			; /49/ Init the accumulator
	clr	r2			; /49/ Double precision please
10$:	tstb	@r5			; /49/ Eol ?
	beq	30$			; /49/ Yep
	cmpb	@r5	,#40		; /49/ Ignore leading spaces please
	beq	20$			; /49/ Yes, a space
	mov	#12	,r0		; /49/ Setup for call to $DMUL
	call	$dmul			; /49/ Do it please
	mov	r0	,r2		; /49/ Restore accumulator values now
	mov	r1	,r3		; /49/ Ditto....
	clr	-(sp)			; /49/ Get the next digit please
	movb	@r5	,@sp		; /49/ And convert to decimal
	sub	#'0	,@sp		; /49/ Got it
	add	(sp)+	,r3		; /49/ Add in the current digit
	adc	r2			; /49/ Add carry bit in also please
20$:	inc	r5			; /49/ Next ch please
	br	10$			; /49/ Next please
30$:	mov	r2	,r1		; /49/ Setup for call to $DDIV now
	mov	r3	,r2		; /49/ Ditto....
	mov	#1000	,r0		; /49/ Convert to 512 byte blocks now
	call	$ddiv			; /49/ Simple
	mov	r2	,at$len		; /49/ Save it please
	tst	r0			; /49/ Was there a remainder ?
	beq	40$			; /49/ No, exit
	inc	at$len			; /49/ Yes, len++
40$:	call	getsys			; /61/ See if RT11, since a UNIX system
	cmpb	r0	,#SY$RT		; /61/ will send the wrong size, ie, RT
	bne	100$			; /61/ needs CrLf rather than Lf at eol
	mov	at$len	,r1		; /61/ So we will add a small fudge 
	ash	#-5	,r1		; /61/ factor in (len += len/32)
	bic	#174000	,r1		; /61/ ...
	add	r1	,at$len		; /61/ Tacky, but effective I guess
100$:	mov	at$len	,at$xlen	; /61/ Save
	unsave	<r5,r4,r3,r2,r1>	; /49/ Pop temps and exit
	clr	r0
	return


	global	<$ddiv	,$dmul>
	global	<at.xlen>



	.sbttl	more attribute receive options


at.typ:	cmpb	curatr	,#'B&137	; 'binary' ?
	beq	10$			; yes
	cmpb	curatr	,#'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	curatr	,at$dis
	clr	r0
	return

at.pr0:	call	ispdp			; /59/ Is this another Kermit-11
	tst	r0			; /59/ sending us protection in
	beq	100$			; /59/ internal (Files11) format?
	call	getsys			; /59/ If it's RSTS, convert from
	mov	r0	,r2		; /59/ F11 format to RSTS format.
	calls	octval	,<#curatr>	; /59/ Convert from octal string.
	cmpb	r2	,#4		; /59/ Is it RSTS ?
	bne	10$			; /59/ No, can use as is
	mov	r1	,r0		; /59/ We are running on a RSTS
	call	torsts			; /59/ system, convert it.
10$:	mov	r1	,at$pr0		; /59/ Save the protection.
100$:	clr	r0			; /59/ Success
	return				; /59/ And exit

at.pr1:	clr	r0
	return

at.sys:	movb	curatr	,at$sys		; major vendor type
	movb	curatr+1,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
	.enabl	lsb

	fabsiz	=	7*13		; need at least this many 

at.fab:	mov	#curatr	,r5		; /49/ Save area for current attr's
	call	ispdp			; are we compatible today?
	tst	r0			; no if eq
	beq	100$			; no, ignore the system dep attr's
	strlen	r5			; packet size ok
	cmp	r0	,#fabsiz	; well....
	bge	40$			; Ok, must be a IFAB
	mov	r5	,r3		; /53/ Not an IFAB, perhaps other sys
	cmpb	(r3)	,#43		; /54/ Date info?
	bne	30$			; /54/ No
	inc	r3			; /54/ Yes, process 4 octal words
	mov	sp	,at$cdt		; /54/ Flag we have been here
	mov	#4	,-(sp)		; /54/ Number of words
	mov	#at$klu	,r2		; /54/ Destination
10$:	clr	r1			; /54/ Accumulator
	mov	#6	,r0		; /54/ Number of itmes
20$:	movb	(r3)+	,r4		; /54/ The next character
	sub	#'0	,r4		; /54/ Convert to a number
	asl	r1			; /54/ Multiply by 8
	asl	r1			; /54/ ...
	asl	r1			; /54/ ......
	add	r4	,r1		; /54/ Put in current result
	sob	r0	,20$		; /54/ Next please
	mov	r1	,(r2)+		; /54/ Copy the word
	dec	(sp)			; /54/ More to do
	bne	10$			; /54/ Yep
	tst	(sp)+			; /54/ All done
	br	100$			; /54/ Exit
					;
30$:	cmpb	(r3)+	,#42		; /53/ File type subfunction?
	bne	100$			; /53/ No, ignore for now
	movb	(r3)+	,r0		; /53/ Get the file type
	SCAN	r0	,#200$		; /53/ Look for it
	asl	r0			; /53/ Word addressing
	mov	210$(r0),image		; /53/ Set it
	mov	210$(r0),at$typ		; /53/ Here also.
	br	100$			; /53/ Exit

40$:	mov	#at$fab	,r4		; copy the packet over now
	mov	r5	,r3		; and the source please
	mov	#-1	,(r4)+		; flag that the attributes are for real
	mov	#13	,r2		; number of words to convert back
50$:	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	,50$		; next please
	mov	sp	,at$val		; it's ok to use the attributes
	br	100$			; bye
90$:	clr	at$fab			; error exit (conversion error)
	message	<Fab attribute error>,cr; /49/
100$:	clr	r0			; always flag success and exit
	return

	.save
	.psect	$pdata	,d
200$:	.byte	'A	,'I	,'N	,0
210$:	.word	TEXT
	.word	TEXT	,BINARY	,DECNAT	,0
	.even
	.restore
	.dsabl	lsb


	.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$xlen
	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
	clr	at$klu+0
	clr	at$klu+2
	clr	at$klu+4
	clr	at$klu+6
	clr	at$cdt
	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
	tst	at$cdt			; Ever set the creation date/time?
	beq	10$			; No
	calls	putcdt	,<@r5,#at$klu>	; Yes, update it
10$:	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$:	clr	at$cdt
	unsave	<r3,r2,r1>		; output file and exit
	return



	.sbttl	Map RSTS protection codes to Files-11 codes and back


;	/59/  9-OCT-1987 08:11 BDN
;
;	 Use the files11 format for transfering protection code
;	between two kermit-11's, thus it will work even for RSX
;	to RSTS transfer.

	.Save
	.Psect	$Pdata	,d


dflt.f:	.word	^B1100110000000000	; Default to no world, group
rsts.p:	.word	1*20			; If 0 set, no owner read
	.word	2*20			; If 1 set, no owner write
	.word	1*400			; If 2 set, no group read
	.word	2*400			; If 3 set, no group write
	.word	1*10000			; If 4 set, no world read
	.word	2*10000			; If 5 set, no world write

	.Restore

torsts:	mov	#77	,r1		; Start with no access
	clr	r2			; Current bit to set
	mov	#6	,r3		; Six times please
	clr	r4			; Indexing into bit table
	mov	#1	,r2		; Start with bit one
10$:	bit	rsts.p(r4),r0		; Check for F11 bit set
	bne	20$			; Set, implies access
	bic	r2	,r1		; So clear it here
20$:	asl	r2			; Shift it
	tst	(r4)+			; Next bit pattern
	sob	r3	,10$		; Loopback
	return				; Exit

tof11:	mov	dflt.f	,r1		; Default Files-11 bitmask
	clr	r2			; Start with bit zero of RSTS
	mov	#6	,r3		; Loop six times
10$:	bit	#1	,r0		; Check for bit being set in RSTS
	beq	20$			; code. Not set, leave alone
	bis	rsts.p(r2),r1		; Set, so set the Files-11 prot
20$:	tst	(r2)+			; Next
	asr	r0			; Get the next bit moved over
	sob	r3	,10$		; And loop back
	mov	r1	,r0		; Return in r0
	return				; Exit



	.sbttl	32 bit arithmetic modules from RSX Syslib.olb

$DMUL:	MOV	R0,-(SP)
	CLR	R0
	CLR	R1
10$:	TST	(SP)
	BEQ	30$
	ROR	(SP)
	BCC	20$
	ADD	R3,R1
	ADC	R0
	ADD	R2,R0
20$:	ASL	R3
	ROL	R2
	BR	10$
30$:	TST	(SP)+
	RETURN

$DDIV:	MOV	R3,-(SP)
	MOV	#40,R3
	MOV	R0,-(SP)
	CLR	R0
10$:	ASL	R2
	ROL	R1
	ROL	R0
	CMP	R0,(SP)
	BCS	20$
	SUB	(SP),R0
	INC	R2
20$:	DEC	R3
	BGT	10$
	TST	(SP)+
	MOV	(SP)+,R3
	RETURN


	.end