;****************************************************************************
;* *
;* GETLOG *
;* AlphaBASIC subroutine to Get Login *
;* *
;****************************************************************************
;Copyright (C) 1988 UltraSoft Corp. All Rights Reserved.
;
;Written by: David Pallmann
;
;Calling Format: XCALL GETLOG, StringVar
;
;Returned: format is "Devn:[p,pn]", as in "DSK3:[100,1]"
;
;Compatibility: all releases of AMOS/L and AMOS/32
;
;Edit History:
;1.0(100) 06-Aug-88 created. /DFP
;****************************************
;* XCALL argument list, indexed by A3 *
;****************************************
.OFINI
.OFDEF COUNT,2 ; number of arguments
.OFDEF TYPE1,2 ; type of first argument
.OFDEF ADDR1,4 ; address of first argument
.OFDEF SIZE1,4 ; size of first argument
STRING=2 ; code for STRING argument
;*****************
;* Entry Point *
;*****************
GETLOG: PHDR -1,0,PH$REE!PH$REU ; reentrant, reusable
CMPW COUNT(A3),#1 ; exactly one argument specified?
JNE CNTERR ; no - error
CMPW TYPE1(A3),#STRING ; is argument a string?
JNE TYPERR ; no - error
CMP SIZE1(A3),#16. ; is variable at least 16 bytes long?
JLO SIZERR ; no - error
;**********************
;* Set up registers *
;**********************
SETUP: MOV ADDR1(A3),A2 ; point A2 to argument
JOBIDX A4 ; point A4 to Job Control Block
;********************************
;* Save Radix and Force Octal *
;********************************
;It is necessary to work in octal so that the OCVT call outputs PPNs in
;octal. Save the user's original radix and restore it later to make this
;transparent.
SAVRDX: MOVW JOBTYP(A4),D5 ; save job type word
ANDW #^C<J.HEX>,JOBTYP(A4) ; turn off hex bit
DEVICE: LEA A1,JOBDEV(A4) ; convert
UNPACK ; device code to ASCII
CLR D1 ; clear all of D1
MOVW JOBDRV(A4),D1 ; get drive number
DCVT 0,OT$MEM ; and output as printable decimal
MOVB #':,(A2)+ ; output colon
;****************
;* Return PPN *
;****************
;A2 indexes current location in the return variable
;A4 indexes JCB
PPN: MOVB #'[,(A2)+ ; output left bracket
CLR D1 ; clear all of D1 again
MOVB JOBUSR+1(A4),D1 ; get first part of PPN
OCVT 0,OT$MEM ; output project number
MOVB #<',>,(A2)+ ; output comma
MOVB JOBUSR(A4),D1 ; get second part of PPN
OCVT 0,OT$MEM ; output programmer number
MOVB #'],(A2)+ ; output right bracket
CLRB @A2 ; mark end of string
;****************************
;* Restore Original Radix *
;****************************
;D5 is original job type word
RESRDX: MOVW D5,JOBTYP(A4) ; back to hex or octal
RTN ; return to BASIC program
