.title memo_storage	;memo.mar
	.ident "V1.1"
;
;         Digital Equipment Computer Users Society (DECUS)
; This program may be freely distributed or modified by any party, including
; but not limited to DECUS and anyone within DECUS.
;                      USE AT YOUR OWN RISK
; DECUS, DECUServe and the author make NO warranties whatsoever, including
; without limitation, all implied warranties of merchantability and fitness.
;
;             Author:     Jack Harvey   October 14, 1991
;
	$acldef
	$acedef

; Simple macro to pass arguments needed here to LIB$GET_SYMBOL
	.macro	get_symbol	sym,equ,len
      	pushal	len		;resulting length returned here
	pushal	equ		;equivilent string goes here
	pushal	sym		;symbol wanted
	calls	#3,G^lib$get_symbol
	.endm	get_symbol

; Simple macro to pass arguments needed here to LIB$SET_SYMBOL
	.macro	set_symbol	sym,equ
	pushal	equ		;equivilent string goes here
	pushal	sym		;symbol to create
	calls	#2,G^lib$set_symbol
	.endm	set_symbol

; Macro to aid coding error message display
	.macro	error	descrip
	pushal	descrip
	brw	errormsg
	.endm	error

.psect	memo_storage_data noexe,wrt,pic,noshr,long

;This is a generic header, customized at 'target' for our particular ACE
acehed:	.byte 32,ace$c_info		;Declaring the kind of ACE
	.word ace$c_cust!ace$m_protected;and its charactistics.
target:	.blkb	8		;Name bytes for wanted ACE
hedsiz = .-acehed

tbytes = 200				;maximum amount of storage to provide

;Used to access the ACL of the object file.
itmlst:	.word	bufsiz       		;item list for accessing the ACE
cmd:	.word	acl$c_readacl
	.address inbuf
	.long	0,0
inbuf:	.blkb	4			;storage header goes here
acename:.blkb	8			;should equal "target"
memo:	.blkb	tbytes			;stored data in this buffer
bufsiz = .-inbuf
	.blkb	3			;space for sign extention
contxt:	.long	0			;context variable for ACE search

errdspl:.quad	0			;used for error messages

idtext:	.word	8,0			;descriptor for name string
	.address target
idlen:	.long	0			;length of the target name string

file:	.word	256,0			;descriptor for filename string
	.address	filetext
filetext:.blkb	256

dellst:	.word	0              		;ACE deletion item list
	.word	acl$c_delaclent
	.address	delbuf
	.long	0,0
delbuf:	.blkb	hedsiz+tbytes		;exact copy of old ACE for deletion

;used to access MEMO_STORAGE_PROTECTED symbol
protext:.ascid	/            /		;Protection symbol returned here.
protval: .address	protext+8	; text = FALS if protected status turned off
protlen:.long	0			;length of the protection control string

vallst:	.word	tbytes*2,0		;descriptor for returned value string
	.address hexvals
hexvals:.blkb	tbytes * 2		;hex values go here

;This is for the foreign command processing.
cmdlinesiz=255
cmddesc:.word	cmdlinesiz		;descriptor for command line
	.word	0
	.address cmdtext
cmdtext:.blkb	cmdlinesiz		;text on command line, if any
cmdlen:	.word	0			;length of foreign command found
remlen:	.word	0			;remaining length of foreign command 
remtext:.address cmdtext		;pointer to remaining text

;The following is a descriptor of a word in the command line
lword:	.word	0,0			;length of command line word found
pword:	.long	0			;pointer to start of command line word

length:	.long	0			;length of the data segment
offset:	.long	0			;offset from start of the ACL data
lr:	.byte	^A/R/			;left to right or right to left

insym:	.word	tbytes,0		;descriptor for incoming symbol
	.address	intext
intext:	.blkb	tbytes			;equiv text stored here
inlen:	.long	0			;length of equiv text

;Used for decimal data output conversion.
dtext:	.ascid	/           /		;longword to ascii translated
dval:	.long	0

.psect	memo_storage_code exe,nowrt,pic,shr,long

;Foreign Command entry point as a free-standing program.
.entry	memo_storage ^M<>
	pushal	cmdlen				;size of returned argument
	clrl	-(SP)				;null argument for prompt
	pushal	cmddesc				;command line descriptor
	calls	#3,G^lib$get_foreign		;get the foreign line command
	bsbw	check_status			;exit with message if error
	movw	cmdlen,remlen			;copy length for word scan
	bneq	5$				;br if command string present
	error	msg4				;no foreign command
5$:	cmpb	cmdtext+4,#^A/H/		;alternate form hex?
	bneq	10$				;br if not
	movb	#^A/X/,cmdtext+4		;force to X 
10$:	cmpb	cmdtext+5,#^A/S/		;Symbol transfer mode?
	beql	15$				;br if "S"
	cmpb	cmdtext+5,#^A/L/		;Literal transfer mode?
	beql	15$				;br if "L"
	error	msg15				;invalid transfer mode
15$:	bsbw	getword				;skip the command word
	bsbw	symbols				;get the DCL symbols
	bsbw	offlen
20$:	cmpl	cmdtext,#^A/GET3/
	bneq	30$				;br if not reading ACE
	bsbw	get
	$exit_s	#ss$_normal			;exit with success

30$:	cmpl	cmdtext,#^A/PUT3/
	beql	50$				;br if writing ACE
	error	msg3				;invalid command
50$:	bsbw	put
	$exit_s	#ss$_normal			;exit with success



;get offset and length from command line
offlen:	bsbw	offl			;convert a value
	movl	length,offset		;move temp to final
	bsbw	offl			;now do length for real
	addl3	offset,length,R0	;error check
	cmpl	R0,#tbytes
	blequ	30$			;br if length and offset will fit
	error	msg8
30$:	rsb

offl:	bsbw	getword			;find text
	cmpb	@pword,#^A/9/		;decimal digit?
	blequ	50$			;br if numeric and convert to bin
	get_symbol	lword, insym, inlen  ;assume it's a symbol
	cmpl	R0,#ss$_normal			;found symbol okay?
	beql	10$
	error	msg1			;expected symbol
10$:	moval	intext,pword		;point to the translated text
	movw	inlen,lword		;length for conversion
50$:	bsbw	dig10			;check that it is a good literal
	pushal	length			;setup to get value
	pushl	pword			;push address of value text
	cvtwl	lword,R0		
	pushl	R0			;push length of word 
	calls	#3,G^lib$cvt_dtb	;convert to binary
	rsb

dig10:	movl	pword,R0		;text in word should be decimal digits
	movl	lword,R1		;setup for check
10$:	cmpb	(R0),#^A/0/		;what kind of character?
	blssu	nerr			;br if below "0"
	cmpb	(R0)+,#^A/9/		;decimal digit?
	bgtru	nerr			;br if above "9"
	sobgtr	R1,10$
	rsb				;success, all characters digits
nerr:	error	msg9			;invalid decimal number

getword:clrw	lword			;flag for word not found
	tstw	remlen			;anything to search?
	bgtr	10$			;br if over zero
	error	msg7			;operand missing
10$:	locc	#^A/ /,remlen,@remtext	;scan text for a space
	movl	remtext,pword	;point to start of word found
	subw3	r0,remlen,lword	;length of word found
	subw2	lword,remlen	;update remaining text
	decw	remlen		;correct for space found
	cvtwl	lword,r0
	addl2	r0,remtext	;update remaining text pointer
	incl	remtext		;skip space
30$:	rsb		;exit with pword and lword describing word found

symbols:cmpb	cmdtext+3,#^A/5/		;five argument command?
	beql	50$				;br if five
	get_symbol	name, idtext, idlen	;get the name symbol
	cmpl	R0,#ss$_normal			;found symbol okay?
	beql	10$				;br if found
5$:	error	msg5				;something wrong with symbol
10$:	cmpl	idlen,#8			;check the length
	bgtru	5$				;must be 8 bytes or less
	get_symbol	filesym,file,file	;get the file name
	cmpl	R0,#ss$_normal			;found symbol okay?
	beql	30$				;br if found
	error	msg6				;not found
30$:	rsb

50$:	movb	#^A/3/,cmdtext+3		;satisfy GET3, PUT3 following
	bsbw	getword				;point to the filespec
	movw	lword, file			;built descriptor for file
	movl	pword,file+4
    	set_symbol	filesym, file		;create file symbol
	cmpb	R0,#ss$_normal			;created?
	beql	70$
60$:	$exit_s	R0				;failed, return with error
70$:	bsbw	getword				;point to the ACE name
	cmpw	lword,#8			;error check
	blequ	80$				;requiring 8 or less
	brw	5$				;report error
80$:	movc5	lword,@pword,#^A/ /,#8,target	;move for ACE get/put
	set_symbol	name, idtext		;create name symbol
	cmpb	R0,#ss$_normal			;created?
	bneq	60$
	rsb

put:	bsbw	getword				;scan for the data string
	cvtwl	lword,R0			;get length of data string
	bneq	5$
	error	msg7				;data missing
5$:	bsbw	symchk			;check if transfer via symbol
	bsbw	loadace		;load previous ACE or setup to create new ACE
	cmpb	cmdtext+4,#^A/A/		;ascii data to store?
	bneq	10$
	moval	memo,R1				;address of data buffer
	addl	offset,R1
	movc3	length,@pword,(R1)	;Just move ascii text to ACE data
	cvtlw	length,vallst			;setup descriptor
	brb	50$
10$:	cmpb	cmdtext+4,#^A/D/		;decimal data?
	bneq	30$
	bsbw	decimali
	brb	50$
30$:	cmpb	cmdtext+4,#^A/X/		;hex?
	beql	40$
	brw	badtype				;br if not X
40$:	bsbw	hexbin				;convert hex to binary
50$:	bsbw	update				;update or create the ACE
	rsb

decimali:cmpl	length,#1		;validate length
	beql 40$
	cmpl	length,#2		;validate length
	beql 40$
	cmpl	length,#4		;validate length
	beql 40$
	brw	baddec			;length NG
40$:	bsbw	dig10			;check that text is decimal digits
   	pushal	dval			;longword for converted result
	pushal	lword			;descriptor of signed integer text
	calls	#2,G^ots$cvt_ti_l		;translate ascii to longword
	moval	memo,R1				;address of data buffer
	addl	offset,R1
	movc3	length,dval,(R1)	;move binary bytes to ACE data
	cvtlw	length,vallst			;setup descriptor
	rsb
valsym:	error	msg14				;no value symbol

symchk:	cmpb	cmdtext+5,#^A/S/		;symbol data?
	bneq	30$				;br if data in command line
	get_symbol	lword, insym, inlen	;get the equiv text
	cmpl	R0,#ss$_normal			;found symbol okay?
    	beql	10$
	brw	valsym
10$:	moval	intext,pword		;point to the translated text
	movw	inlen,lword
30$:	rsb

loadace:bsbw	getace			;get our current ace (if any)
	movw	#acl$c_modaclent,cmd	;assume modify ACE with new values
	cmpl	R0,#ss$_normal		;did we find it?
	beql 	10$			;br if found
	movw	#acl$c_addaclent,cmd	;switch to add ACE with new values
	movc3	#hedsiz,acehed,inbuf	;create new protected header
	rsb
10$:	movzbw	inbuf,dellst		;Save exact copy of ACE in case
	movc3	dellst,inbuf,delbuf	;we end up deleting this ACE.
	moval	memo,R1			;address of binary data buffer
	addl2	offset,R1		;point to start of altered area
	movc5	#0,0,#0,length,(R1)	;clear old data
	rsb

update:	movl	#tbytes,R1		;buffer size
10$:	tstb	memo-1[R1]		;find highest address non-zero data byte
	bneq	30$			;stop at first non-zeor
	sobgtr	R1,10$			;scan backword to first non-zero
	cmpw	cmd,#acl$c_modaclent	;no data, does ACE exist?
	bneq	20$			;br if no existing ACE
	brw	70$			;br if ACE exists
20$:	movl	#ss$_normal,R0		;no ACE, just exit, no data to write
	rsb
30$:	addb3	#hedsiz,R1,inbuf		;size of the ACE
	movzbw	inbuf,itmlst			;size to item list
	get_symbol	prot, protext, protlen	;get the protection status
	cmpl	R0,#lib$_nosuchsym		;protection symbol not found?
	beql	50$				;make no change in status
	bisw2	#ace$m_protected,inbuf+2	;assume the ACE to be protected
	cmpl	protval,#^A/FALS/		;translates as FALSE?
	bneq	50$				;br if not FALS
	bicw2	#ace$m_protected,inbuf+2	;clear the protected bit
50$:	$change_acl_s objtyp=#acl$c_file,-	;object type is a file
		objnam=file,-			;file name 
		itmlst=itmlst,-
		contxt=contxt
	rsb

;Alteration left the ACE empty (all nulls), so delete it.
70$:	$change_acl_s objtyp=#acl$c_file,-	;object type is a file
		objnam=file,-			;file name 
		itmlst=dellst,-			;delete saved copy of old ACE
		contxt=contxt
	rsb

;convert hexadecimal string to binary bytes, overlaying old ACE
hexbin:	movl	pword,R6			;point to hex field
	movl	lword,R9			;get size of hex field
	blbc	R9,10$				;br if an even number
	decl	R6				;point to previous byte
	movb	#^A/0/,(R6)			;force to "0"
	incl	R9				;round size to even number
10$:	cmpb	lr,#^A/R/			;convert right to left?
	bneq	35$				;br if left to right
	addl	R9,R6				;point to end of hex area
35$:	ashl	#-1,R9,R9			;divide by 2 for number of bytes
	movl	R9,R8				;loop counter for below
	moval	memo,R7				;binary data pointer
	addl	offset,R7			;include the offset
40$:	movzbl	-(R6),R9			;get a hex digit
	bsbw	binit				;convert to binary
	movzbl	R9,R1				;save low four bits
	movzbl	-(R6),R9			;get next higher hex digit
	bsbw	binit				;convert to binary
	ashl	#4,R9,R9			;shift to high nibble position
	bisb3	R1,R9,(R7)+			;store in binary byte
	sobgtr	R8,40$
	rsb

binit:	cmpb	R9,#^A/9/			;result greater than nine?
	blequ	10$				;br if 0-9 range
	cmpb	R9,#^A/A/			;make sure in A-F range
	blssu	30$				;br if between 9 and A
	cmpb	R9,#^A/F/			;make sure in A-F range
	bgtru	30$				;br if past F
	subb2	#^A/A/-^A/:/,R9			;correct A-F range
	bicb2	#^XF0,R9			;strip to four bits
	rsb
10$:	cmpb	R9,#^A/0/			;make sure it's in 0-9 range
	blssu	30$				;br if below 0 character
	bicb2	#^XF0,R9			;strip to four bits
	rsb
30$:	error	msg2				;invalid hex char


;branch/jump here with error text message descriptor address pushed on stack.
errormsg:calls	#1,G^lib$put_output		;output error text message
	$exit_s	#16				;exit with bad parameter


check_status:	;report an error status message to sys$output and quit
	cmpl	R0,#SS$_NORMAL		;normal successful completion?
	beql	50$			;just exit if normal
	movl	#1,errdspl		;setup for error display
	movl	R0,errdspl+4
	$putmsg_s	msgvec = errdspl	;display error text to terminal
	$exit_s				;abort job

50$:	rsb				;no error, just return

get:	cmpb	cmdtext+5,#^A/S/		;symbol transfer mode?
	beql	5$				;br if output to symbol
	error	msg13				;require symbol
5$:	bsbw	getace				;get our ace 		
	cmpb	cmdtext+4,#^A/A/		;ascii output?
	bneq 	10$				;br if not
	bsbw	asciio
	brb	50$
10$:	cmpb	cmdtext+4,#^A/D/		;decimal output?
	bneq 	20$				;br if not
	bsbw	decimalo
	brb	50$
20$:	cmpb	cmdtext+4,#^A/X/		;hex?
	bneq	badtype				;br if not X here
	cmpl	length,#128			;will it fit in symbol?
	blss	30$				;br if less than 128
	error	msg10
30$:	bsbw	hexer				;convert data to hex
50$:	bsbw	getword				;find the data symbol
	set_symbol	lword, vallst	;create the returned value symbol
	cmpb	R0,#ss$_normal			;created?
	beql	70$
	$exit_s	R0				;failed, return with error
70$:	rsb

badtype:error	msg12

asciio:	moval	memo,R1				;address of data buffer
	addl	offset,R1
	movc3	length,(R1),hexvals		;Just move ascii text to symbol
	cvtlw	length,vallst			;setup descriptor
	rsb

hexer:	movl	length,R8			
    	ashl	#1,R8,R0			;2x #bytes in R0 = #hex digits
	movw 	R0,vallst			;length of string
	moval	hexvals,R6			;point to hex buffer
	cmpb	lr,#^A/R/			;convert right to left?
	bneq	30$				;br if left to right
	addl	R0,R6				;point to end of hex data
30$:	moval	memo,R7				;binary data buffer
	addl	offset,R7			;add in amount of offset
40$:	movb	(R7),R0				;get a byte 
	bsbw	hexit				;store low hex digit in buffer
	movb	(R7)+,R0			;now do the high digit
	ashl	#-4,R0,R0			;shift left
	bsbw	hexit				;store high hex digit in buffer
	sobgtr	R8,40$
	rsb

hexit:	bicb2	#^XF0,R0			;get low four bits
	addb2	#^A/0/,R0			;convert to ascii digit
	cmpb	R0,#^A/9/			;digit over nine?
	bleq	10$				;br if not
	addb2	#^A/A/-^A/:/,R0			;convert to A-F range
10$:	cmpb	lr,#^A/R/			;convert right to left?
	bneq	15$				;br if left to right
	movb	R0,-(R6)			;store in hex buffer
	rsb
15$:	movb	R0,(R6)+			;store in hex buffer
	rsb

decimalo:moval	memo,R6				;address of data buffer
	addl2	offset,R6			;address of data
	clrl	R2				;assume positive for 1 and 2
	cmpl	length,#4				
	beql	40$				;br if 4 bytes
	cmpl	length,#2
	beql	20$				;br if 2 bytes
	cmpl	length,#1				
	bneq	baddec				;br if not 1 byte
10$:	tstb	(R6)				;test sign of byte
	bgtr	12$				;br if positive
	decl	R2				;-1
12$:	movc5	#0,0,R2,#3,1(R6)		;fill three high bytes
	brb	40$
20$:	tstw	(R6)				;test sign of word
	bgtr	22$				;br if positive
	decl	R2				;-1
22$:	movw	R2,2(R6)			;fill two high bytes
40$:	pushal	dtext				;address of ascii translation
	pushl	R6
	calls	#2,G^ots$cvt_l_ti		;convert long to ascii, signed
	skpc	#^A/ /,dtext,dtext+8		;find first non-space
	cvtlw	R0,vallst			;setup descriptor
	movc3	R0,(R1),hexvals			;move ascii text to symbol
	rsb

baddec:	error	msg11				;invalid length

getace:	movw	#acl$c_readace,cmd		;read an ace from the acl
	clrl	contxt				;starting with the first
	movw	#bufsiz,itmlst			;set the input buffer size
10$:	$change_acl_s objtyp=#acl$c_file,-	;object type is a file
		objnam=file,-			;file name
		itmlst=itmlst,-
		contxt=contxt
	movl	R0,R8				;save for later
	cmpl	#ss$_normal,R0
	bneq	20$				;br if not target ace
	cmpc3	#8,target,acename		;found our ace?
	bneq	10$				;br if not and try next
20$:	movl	R8,R0				;restore status
	cmpl	#ss$_normal,R0
	beql	40$
	cmpl	#ss$_aclempty,R0
	beql	30$
	cmpl	#ss$_nomoreace,R0
	beql	30$
	bsbw	check_status			;report strange errors and quit
30$:	pushl	R0
	movc5	#0,0,#0,#tbytes,memo	;clear any garbage loaded by V5.3
	popl	R0
40$:	rsb

;Texts
;		DCL symbols for control and data passing
filesym:.ascid	/MEMO_STORAGE_FILE/	;file to which the ACE is applied
name:	.ascid	/MEMO_STORAGE_NAME/	;8 character ACE name
PROT:	.ascid	/MEMO_STORAGE_PROTECTED/	;if = FALSE, ACE not protected.

;		Special error message texts to sys$output
msg1:	.ascid /%MEMO-F-OFFSYM - Symbol for offset or length not found/
msg2:	.ascid /%MEMO-F-NOTHEX - Invalid hexadecimal character found/
msg3:	.ascid /%MEMO-F-INVCMD -Invalid command/
msg4:	.ascid /%MEMO-F-NOCMD - No foreign command line found/
msg5:	.ascid /%MEMO-F-NAME - MEMO_STORAGE_NAME incorrectly defined/
msg6:	.ascid /%MEMO-F-FILE - MEMO_STORAGE_FILE symbol not defined/
msg7:	.ascid /%MEMO-F-NODATA - Command line data operand missing/
msg8:	.ascid /%MEMO-F-TOOBIG - Offset + length exceeds storage area size/
msg9:	.ascid /%MEMO-F-BADCHR - Invalid character in decimal number/
msg10:	.ascid /%MEMO-F-BIGSYM - Hexadecimal data too large for symbol/
msg11:	.ascid /%MEMO-F-BADDEC - Invalid length for decimal value/
msg12:	.ascid /%MEMO-F-BADTYPE - Invalid data radix or format/
msg13:	.ascid /%MEMO-F-BADMODE - Transfer mode must be Symbol on GET/
msg14:	.ascid /%MEMO-F-VALSYM - Symbol for transfer value not found/
msg15:	.ascid /%MEMO-F-NGMODE - Transfer mode not Literal or Symbol/
	.end memo_storage