; *****************************************************RELOG.SBR
;
;	RELOG - Log into another account from in BASIC
;             - Returns account you were logged into
;	      - (Useful in getting around BASIC's error 23 -Protection voilation)
;
;	BY DAVE PARKER, SNOWMASS VILLAGE, CO 81615, 303-923-4263
;
;	USAGE XCALL  RELOG,RELOG$,DERR
;	             (RELOG$ Sends acocunt you want to log into)
;	             (RELOG$ Returns account you were logged into)
;		     (DERR   Returns 1 if error occured)
;
;	NOTE: This procedure doesn't change the disk you are logged into,
;             just the account. I usually use this call in pairs surrounding
;	      a write statement to another account. Since RELOG returns the
;	      account you were logged into, you just need to call it again.
;	      RANDOM FILES MUST BE OPENED AS 'RANDOM'FORCED' DGP	
;
;EXAMPLE:	MAP1 TESTREC,X,512
;	        REM --->CURRENT LOG IS [100,1]
;		OPEN #1,"TEST.DAT[101,1]",RANDOM'FORCED,512,R1
;		R1=0
;		RELOG$="[101,1]"
;		REM --->SWITCH ACCOUNTS SO YOU WON'T GET ERROR 23
;		XCALL RELOG,RELOG$
;		REM --->YOU ARE NOW LOGGED INTO [101,1]
;		WRITE #1,TESTREC
;		XCALL RELOG,RELOG$
;		REM --->YOU ARE BACK IN [100,1]
;
;
;Edit History:
;	1.0 24-Feb-86 created. /DGP
;
;
;Program version number
	VMAJOR=1
	VMINOR=0

	OBJNAM	RELOG.SBR

	SEARCH SYS
	SEARCH SYSSYM

			; INDEXES FOR MEMORY USAGE AFTER A4
	PPN.W=0		; WORKSPACE OLD PPN
	PPM.W=1		; WORKSPACE OLD PPN
	WOR.W=2		; WORKSPACE FOR CONVERTING NEW PPN

START:	PHDR	-1,0,PH$REE!PH$REU	; program header
	MOVW	@A3,D1			; TWO ARGUMENTS PASSED      
	CMPW 	D1,#2.
	JNE	GETOUT
	MOV 	#1.,16(A3)		; MOVE ERROR FLAG INTO SECOND ARG


	MOVW	2(A3),D1		; ONLY STRING ALLOWED
	CMPW	D1,#2.
	JNE	GETOUT
	MOV 	10(A3),D1		; CHECK STRING LENGTH AT LEAST 9 BYTES
	CMP	D1,#9.
	JLO	GETOUT

	JOBIDX	
	LEA	A0,JOBUSR(A6)
	MOVW	@A0,PPN.W(A4)		; HOLD OLD PPN FOR LATER

	MOV	4(A3),A1		; A1 POINTS TO INPUT VARIBLE
	LEA	A0,WOR.W(A4)		; A0 POINTS TO FREE MEMORY WORKSPACE
LOOP1:
	MOVB	(A1)+,D1		; MOVE NEXT WORD OF VARIABLE IN D1
	CMP	D1,#133			; SEE IF OPEN BRACKET
	BEQ	LOOP1			; IGNORE IF IT
	CMP	D1,#0.			; SEE IF BLANK
	JEQ	GETOUT			; OOPS IF IT IS       
	CMP	D1,#135			; SEE IF CLOSING BRACKET
	JEQ	GETOUT			; OOPS IF IT IS
	MOVB	D1,(A0)+
	CMP	D1,#54			; IS IT A COMMA
	BNE 	LOOP1			; GET NEXT IF IT IS NOT

					; WRITE PROJECT NUMBER TO JOBIDX
	LEA	A2,WOR.W(A4)
	GTOCT				; D1 NOW HOLDS NEW PROJECT #
	JMI	GETOUT
	JOBIDX	A0
	LEA	A2,JOBUSR(A0)		; A2 POINTS AT CURRENT PPR
	MOVB	D1,1(A2)
	LEA	A0,WOR.W(A4)
LOOP2:
	MOVB	(A1)+,D1		; MOVE NEXT WORD OF VARIABLE IN D1
	CMP	D1,#0.			; SEE IF BLANK
	JEQ	GETOUT			; OOPS IF IT IS
	MOVB	D1,(A0)+
	CMP	D1,#135			; SEE IF CLOSING BRACKET
	BNE	LOOP2			; LOOP IF IT IS NOT

	LEA	A2,WOR.W(A4)
	GTOCT				; D1 NOW HOLDS PRGMR #
	JMI	GETOUT	
	JOBIDX	A0
	LEA	A2,JOBUSR(A0)		; A2 POINTS AT CURRENT PPN
	MOVB	D1,@A2 			; WE ARE NOW LOGGED INTO NEW ACCT

					; WRITE OLD LOG INTO RELOG$
	MOV	4(A3),A2       		; A0 POINTS TO VARIABLE TO FILL UP
	MOVB	#91.,(A2)+		; WRITE BEGINNING BRACKET
	MOVB	PPM.W(A4),D1		; MOVE PPM TO D1
	OCVT	0,OT$MEM		; STORE IT IN RELOG$
	MOVB	#44.,(A2)+		; WRITE THE COMMA
	MOVB	PPN.W(A4),D1		; D1 HOLD OLD PPN
	OCVT	0,OT$MEM		; STORE IT IN RELOG$
	MOVB	#93.,(A2)+		; WRITE CLOSING BRACKET
	MOVB	#0.,(A2)+		; WRITE ZERO BYTE
	CLR	16(A3)
		
GETOUT:
	RTN
	EXIT
	END


.