.TITLE RLON
	.ENABLE LC
	.IDENT /101488/

; NOTE: This module contains code for RLON and TLON
;
;	File:[22,310]RLON.MAC
;	Author: Jim Bostwick  14-MAY-1988 
;
;	Last Edit: 23-JUN-1988 21:42:40 
;
;	History: JMB 14-MAY-1988
;	 23-JUN-1988 21:19:15  - JMB PA3UTL upgrade.
;

.REM |

Procedure RLON(	Log_nam: Packed array [lo..hi:Integer] of char;
		VAR Equ_str: Packed array [elo..ehi:Integer] of char;
	        VAR Equ_length: Integer
	);External;

{*USER*
 Pascal-3 procedure to translate recursively a logical name. All tables
are searched in the following order: task, session, group, system. The
first match terminates the search. As each translation is done, another
search is begun using the latest equivalence string. Translation continues
until: the search fails; a logical with the 'final' attribute is found;
a logical of the form '_xxxx' is found; or ten translations have been made. 
 Log_nam and Equ_str are conformant string parameters. 
Equ_length will always return the actual equivalence string length, even if
greater than that allowed by Equ_str. Equ_str would in this case be filled
with as much of the equivalence string as possible. 
 Equ_length (and the length byte of a type-0 Equ_str actual parameter) will 
be zero if the logical name is not found. 

 Directive Status is available in $DSW on return.
} 

Procedure TLON(	Log_nam: Packed array [lo..hi:Integer] of char;
		VAR Equ_str: Packed array [elo..ehi:Integer] of char; 
	        VAR Equ_length: Integer
	);External;

{*USER*
 Pascal-3 procedure to translate a logical name. Identical to Rlon,
but only performs one translation. 
 Log_nam and Equ_str are conformant string parameters. 
Equ_length will always return the actual equivalence string length, even if
greater than that allowed by Equ_str. Equ_str would in this case be filled
with as much of the equivalence string as possible. 
 Equ_length (and the length byte of a type-0 Equ_str actual parameter) will 
be zero if the logical name is not found. 

 Directive Status is available in $DSW on return.
} 

|

;
; Assemble with PASMAC.MAC as prefix file.
;
; j.m.b.  14-MAY-1988 22:10:03 
;

	.MCALL RLON$S
	.MCALL TLON$S

	PROC RLON
	PARAM lnm, ADDRESS	; pointer to logical name string
	PARAM lnmlo, INTEGER	; low conformant param
	PARAM lnmhi, INTEGER	; hi conformant param
	PARAM enm, ADDRESS	; Pointer to equivalence string
	PARAM enmlo, INTEGER	; low conformant param
	PARAM enmhi, INTEGER	; hi conformant param
	PARAM enmln, ADDRESS	; VAR - actual ens length
	VAR   flag,  INTEGER	; RLON/TLON indicator
	SAVE <R0,R1,R2,R3,R4,R5>
	BEGIN
	clr	flag(sp)	; flag this is RLON
RLEP:	; common entry 
	; get length of lnm
	mov	sp, r0
	mov	lnm(r0), -(sp)		; push address
	mov	lnmlo(r0), -(sp)	; push lo
	mov	lnmhi(r0), -(sp)	; push hi
	call	xxslen
	.globl xxslen
	tst	(sp)+			; forget type
	mov	(sp)+, r1		; get length
	mov	(sp)+, r3		; get address
;
; r1 = lnmln, r3 -> lnm
;

	mov	enm(r0), -(sp)		; get address
	mov	enmlo(r0), -(sp)	; get lo bound
	mov	enmhi(r0), -(sp)	; get hi bound
	call	xxsmax
	.globl xxsmax
	mov	(sp)+, r2		; get max length
	mov	(sp)+, r4		; get addx

500$:	; ref label
;	br	500$
	tst	flag(sp)	; RLON or TLON?
	beq	510$		; RLON - br
	TLON$S  ,,,r3,r1,r4,r2,enmln(r0)	
	br	520$

510$:	RLON$S  ,,,r3,r1,r4,r2,enmln(r0)	
520$:	bcc	600$
	; return some error indications
	clr	@enmln(sp)
	clrb	@enm(sp)	; clr enm length 
				; (harmless if type-1)	
	br	1000$		; and exit

; figure out return length, pad type-1 as necessary

600$:	tst	enmlo(sp)		; type-0
	bne	700$			; no - br
;
; type-0 completion code
;
	cmp	@enmln(sp), enmhi(sp)	; was there room?
	blos	610$			; yes - br
	movb	enmhi(sp), @enm(sp)	; max out enm length

610$:	movb	@enmln(sp), @enm(sp)	; say what we got
	br	1000$			; done
;
; type-1 completion code
;
700$:	cmp	@enmln(sp), r2	; fit?
	bhis	1000$		; nope - we're done
	add	@enmln(sp), r4	; point past real end
	sub	@enmln(sp), r2	; compute padding count
710$:	clrb	(r4)+		; null a byte
	sob	r2, 710$	; ..do several

1000$:
	ENDPR

;
; TLON is identical to RLON, except that it only translates once. 
;
	PROC TLON
	PARAM lnm, ADDRESS	; pointer to logical name string
	PARAM lnmlo, INTEGER	; low conformant param
	PARAM lnmhi, INTEGER	; hi conformant param
	PARAM enm, ADDRESS	; Pointer to equivalence string
	PARAM enmlo, INTEGER	; low conformant param
	PARAM enmhi, INTEGER	; hi conformant param
	PARAM enmln, ADDRESS	; VAR - actual ens length
	VAR   flag,  INTEGER	; RLON/TLON flag
	SAVE <R0,R1,R2,R3,R4,R5>
	BEGIN
	MOV	#1, flag(sp)	; set TLON flag
	JMP 	RLEP		; join common code
; real exit is from RLON above
	ENDPR			

	.END