;*; Updated on 22-May-95 at 1:40 AM by James A. Jarboe I V; edit time: 0:14:45
;****************************************************************************
;*									    *
;*				   RELOGS				    *
;*                AlphaBASIC subroutine to Set and Reset Login		    *
;*									    *
;****************************************************************************
;
;Written by: James A. Jarboe IV
;            Parts taken from RELOG.M68 by Dave Parker
;	     Parts taken from SETLOG.M68 by David Pallmann
;
;Calling Format:  XCALL RELOGS, LOGTO$
;		
;      ! Say that Current login is DSK3:[4,4]"
;      !  
;       MAP1 LOGTO$,S,20,"DSK1234:[106,336]"
;	XCALL RELOGS, LOGTO$       ! will log you to the LOGTO$ argument.
;       XCALL RELOGS, LOGTO$       ! will log you back to "DSK3:[4,4]"
;
;	Where:
;		LOGTO$  = DeviceSpec:[p,pn]  - Will log you to.
;                         Must be at least 20 bytes in size in order
;                         to hold the return to spec maximum+spare.
;                         DSK65535:[376,376]
;		          Once logged to designation, LOGTO$ will contain
;                         the device/drive and ppn you came from
;                         so you just have to call it again or
;			  you can reset it to your liking. After
;	                  the xcall is made, LOGTO$ will always
;                         contain the Device/drive/ppn you came from
;                         in string format.
;
;    -NOTICE- This xcall will not check for available DEVICE/DRIVE/PPN's
;             on a system, so it is quite possible to log somewhere that
;             does not exist. In other words, "ya' gotta' know's what ya'
;             doin' ta' make it right!"
;
;Edit History:
;
;1.0(100)  22-May-95  created James A. Jarboe IV

;***************************************************************************
;                                                                          *
;                                V E R S I O N                             *
;                                                                          *
;***************************************************************************
;
	VMAJOR=1
	VMINOR=0
	VEDIT=100.

	OBJNAM	.SBR

	SEARCH	SYS
	SEARCH	SYSSYM


	PAGE
;***************************************************************************
;                                                                          *
;               I M P U R E    A R E A    A N D   O F F S E T S            *
;                                                                          *
;***************************************************************************
;
; Storage offsets for where we came from.
;
	.OFINI	
	.OFDEF	TO.DEV,2		; Saved to device.
	.OFDEF	TO.DRV,2		; Saved to drive.
	.OFDEF	TO.PPN,2		; Saved to ppn.
	.OFDEF	FR.DEV,2		; Saved from device.
	.OFDEF	FR.DRV,2		; Saved from drive.
	.OFDEF	FR.PPN,2		; Saved from ppn.

; Standard XCALL Offsets.
;
	.OFINI
	.OFDEF	ARGCNT,2		; Argument Count.
	.OFDEF	A1.TYP,2		; Argument 1 Type.
	.OFDEF	A1.ADR,4		; Argument 1 Address.
	.OFDEF	A1.SIZ,4		; Argument 1 Size.

        ARG.STR	=	2		; Argument String type.
	ARG.SZ1	=	20.		; Argument size.


;***************************************************************************
;                                                                          *
;                                R E L O G S                               *
;                                                                          *
;***************************************************************************
;

RELOGS:	PHDR	-1,0,PH$REE!PH$REU	
	CMPW	ARGCNT(A3),#1		; Have at least 1 arguments?
	JNE	CNTERR			;  No..Error.
	CMPW	A1.TYP(A3),#ARG.STR	; Is argument 1 a string?
	JHI	TYPERR			;  No..Error.
	CMP	A1.SIZ(A3),#ARG.SZ1	; Must be 20. bytes.
	JLO	SIZERR


	JOBIDX	A6			; Index JCB
	MOVW	JOBDEV(A6),FR.DEV(A4)	; Store device we are at.
	MOVW	JOBDRV(A6),FR.DRV(A4)	; Store driver we are on.
	MOVW	JOBUSR(A6),FR.PPN(A4)	; Store ppn we are at.
	CLRW	TO.DEV(A4)		; Preclear any junk.
	CLRW	TO.DRV(A4)
	CLRW	TO.PPN(A4)

	MOV	A1.ADR(A3),A2		; Index argument 1.
	BYP				; Skip junk.
	ALF				; Was device specified?
	BNE	DO.PPN			; No..never mind.
	LEA	A1,TO.DEV(A4)		; Save to device.
	PACK				; Set new device.
	GTDEC				; Get drive number.
	MOVW	D1,TO.DRV(A4)		; Set drive number.
	CMPB	@A2,#':			; Colon present?
	JNE	FMTERR			; No..error.
	INC	A2			; Yes..skip colon.

DO.PPN:
	BYP				; Bypass junk.
	CMPB	@A2,#'[			; Got a left bracket?
	BNE	10$			; No..never mind.
	INC	A2			; Yes..skip it.
10$:	NUM				; Got a PPN?
	JNE	FMTERR			; No..error.
	GTPPN				; Yes..get PPN.
	MOVW	D1,TO.PPN(A4)		; Save new PPN.

; Set Return information to argument.
;
	MOV	A1.ADR(A3),A2		; Index argument string.
	LEA	A1,FR.DEV(A4)		; Index stored device.
	UNPACK				; Set it to string.
	CLR	D1			; Clear.
	MOVW	FR.DRV(A4), D1		; Get drive number.
	DCVT	0,OT$MEM		; Set it to string.
	MOVB	#':,(A2)+		; Do seperators.
	MOVB	#'[,(A2)+
	JOBIDX				; Index jcb.
	PUSHW	JOBTYP(A6)		; Save current base.
	ANDW	#^C<J.HEX>,JOBTYP(A6)	; Set octal.
	CLR	D1			; Clear.
	MOVB	FR.PPN+1(A4),D1		; Get p.
	OCVT	0,OT$MEM		; Output to string.
	MOVB	#',,(A2)+		; Set seperator.
	MOVB	FR.PPN(A4), D1		; Get pn.
	OCVT	0,OT$MEM		; Set to string.
	MOVB	#'],(A2)+		; Set seperator.
	CLRB	@A2			; Clear end of string.
	JOBIDX				; Index job.
	TSTW	TO.DEV(A4)		; Any device saved?
	BEQ	30$			; No.
	MOVW	TO.DEV(A4),JOBDEV(A6)	; Yes..set device.
	MOVW	TO.DRV(A4),JOBDRV(A6)	; Set drive.
30$:
	MOVW	TO.PPN(A4),JOBUSR(A6)	; Set ppn always.
	POPW	JOBTYP(A6)		; Reset base.
	RTN				; Return to basic.


;***************************************************************************
;                                                                          *
;                             E R R O R   T E X T                          *
;                                                                          *
;***************************************************************************
;
CNTERR:	TYPESP	?Argument count	(Should be 1)
	BR	ERROR
TYPERR:	TYPESP	?Argument type (Should be String)
	BR	ERROR
SIZERR:	TYPESP	?Argument size (Should be 20)
	BR 	ERROR
FMTERR:	TYPESP	?Command format
ERROR:	TYPECR	error in RELOGS.SBR
	EXIT

	END


.