;*; Updated on 29-Nov-89 at 11:00 AM by Creed A. Erickson; edit time: 0:19:19
;
; XPPN.M68 (XPPN.SBR)
;
; AlphaBasic XCALL subroutine which returns the user's ppn
; and optionally the user's device, job name, and terminal name.
; This program is called as follows:
;
; XCALL XPPN,PPN{,DEVICE{,JOBNAM{,TRMNAM}}}
;
; Where the arguments are set up as follows:
;
; 10 MAP1 PPN
; 20 MAP2 PROJECT,B,2
; 30 MAP2 PROGRAMMER,B,2
; 40 MAP1 DEVICE,S,6
; 50 MAP1 JOBNAM,S,6
; 60 MAP1 TRMNAM,S,6
; 70
; 80 XCALL XPPN,PPN,DEVICE,JOBNAM,TRMNAM
; 90
; 100 PRINT
; 110 PRINT " LOG: "DEVICE"["STR(PROJECT)","STR(PROGRAMMER)"]"
; 120 PRINT "JOBNAM: "JOBNAM
; 130 PRINT "TRMNAM: "TRMNAM
; 140 PRINT
; 200 END
;
; NOTE: The ppn numbers will be returned as decimal
; but they will represent the octal numbers, so no conversions
; are neccessary.
;
; Edit History (most recent first):
;
; Edit Date What, who, why
; ==== ========= ===================================================
; 101 28-Nov-89 Modified to correct bugs:
;
; 1) Was not reentrant, corrected CONVRT subroutine
; to use a stack based buffer for reentrancy.
; 2) Termination of names (job name, terminal name)
; could walk on byte following the return
; variable IF unpacked name was 6 bytes long.
;
; Creed Erickson, PACE, Inc.
;
; 100 24-Jan-83 Converted to AM100/L:
;
; 1) Added args for job name and trm name.
; 2) Correct PPN if J.HEX is correct.
;
; John Keys, (202) 872-4538
;
; Orig 29-Jan-79 Written by Mike Sigona for the AM100.
;
SEARCH SYS
SEARCH SYSSYM
OBJNAM XPPN.SBR
; Version specification for the program header...
;
VMAJOR = 1
VMINOR = 0
VEDIT = 101.
; Handy little equates...
;
SPACE$ = 40 ; ASCII space character
COLON$ = 72 ; ASCII colon character (:).
; Define argument offsets from A3 argument list index.
;
OFINI
; Start of code...
;
GETPPN: PHDR -1,0,PH$REE!PH$REU ; Logged in, re-entrant, re-usable.
JOBIDX A0 ; Index this job's JCB.
MOV A1.IDX(A3), A5 ; Get argument #1's address.
MOVW JOBUSR(A0), D0 ; Get the currently logged in PPN.
CALL CONVRT ; Convert number.
MOVW D1, 2(A5) ; Store in result variable.
LSRW D0, #8. ; Shift high byte to low byte.
CALL CONVRT ; Convert number.
MOVW D1, @A5 ; Store in result variable.
; Check for a second argument and return device/drive if provided.
; NOTE: This code assumes the result is big enough.
;
GETDEV: CMPW ARGCNT(A3), #2 ; Second arg provided?
BLO BACK ; No, all done.
MOV A2.IDX(A3), A2 ; Index the result variable.
LEA A1, JOBDEV(A0) ; Index the RAD50 device name.
UNPACK ; Unpack to ASCII (A1 to A2).
CLR D1 ; Preclear unit number.
MOVW JOBDRV(A0), D1 ; Get the unit (drive) number.
DCVT 0,OT$MEM ; Cvt to ASCII @A2.
MOVB #COLON$, (A2)+ ; Append a colon character.
MOV A2, D7 ; Take string ending address.
SUB A2.IDX(A3), D7 ; Less string starting address.
CMPW D7, A2.SIZ(A3) ; Compare str size to variable size.
BHIS GETJOB ; No more space left.
CLRB @A2 ; Space left, terminate string.
GETJOB: CMPW ARGCNT(A3), #3 ; Third argument provided?
BLO BACK ; No, all done.
LEA A1, JOBNAM(A0) ; Index the JCB name.
MOV A3.IDX(A3), A2 ; Index the result variable.
MOVW A3.SIZ(A3), D0 ; Get the size.
CALL UPCKIT ; Unpack the job name.
GETTRM: CMPW ARGCNT(A3), #4 ; 4th argument?
BLO BACK ; No, all done.
MOV JOBTRM(A0), A1 ; Index the job's TCB.
SUB #4, A1 ; Index the job's terminal name.
MOV A4.IDX(A3), A2 ; Index the result variable.
MOVW A4.SIZ(A3), D0 ; Get the size.
CALL UPCKIT ; Unpack the terminal name.
BACK: RTN ; Return to caller.
; CONVRT
;
; Subroutine to simulate octal numbers in decimal.
; Performs conversion by a) converting octal to string, b) GTDEC on string.
;
; Passed:
;
; A0 => This job's JCB.
; D0 := Byte to be converted.
;
; Returns:
;
; D1 := Converted value (entire longword is valid).
;
; Registers A0-A5, D0, D2-D5 are all preserved.
;
CONVRT: SAVE A2, D5 ; Save caller's registers.
MOVW JOBTYP(A0), D5 ; Save job type flags.
ANDW #^C<J.HEX>, JOBTYP(A0) ; Clear hex flag.
PUSH #0 ; Push dummy to stack (alloc buff).
MOV SP, A2 ; Index the buffer.
MOVB D0, D1 ; Get the number to convert.
AND #377, D1 ; Mask off low byte.
OCVT 3, OT$MEM ; Output as ASCII to buffer.
CLRB @A2 ; Terminate the buffer.
MOV SP, A2 ; Reindex the buffer.
GTDEC ; Get as decimal number.
POP ; Pop dummy off stack (zap buffer).
MOVW D5, JOBTYP(A0) ; Restore job type word.
REST A2, D5 ; Restore caller's registers.
RTN ; Return to caller.
; UPCKIT
; Subroutine to unpack a LWORD RAD50 name to ASCII.
; Result is stripped of trailing spaces.
;
; Passed:
;
; A1 => RAD50 LWORD value to unpack.
; A2 => Buffer to receive the ASCII string.
; D0 := Size of the destination buffer (word value).
;
; Returned:
;
; Buffer @A2 has been loaded with the unpacke string.
;
; All registers A0-A5, D0-D5 are preserved.
;
UPCKIT: SAVE A1, A2 ; Save caller's registers.
UNPACK ; Unpack to ASCII.
UNPACK ; Both halves of it.
CMPW D0, #6 ; More than six characters?
BLOS 20$ ; No.
10$: CLRB @A2 ; Terminate the string.
20$: CMPB -(A2), #SPACE$ ; Is last character a space?
BEQ 10$ ; Yes, keep stripping.
REST A1, A2 ; Restore caller's registers.
RTN ; Return to caller.
