;NEWPPN -BASIC SUBROUTINE WHICH RETURNS WITH THE USER'S PPN
;	AND OPTIONALLY THE USER'S DEVICE, JOBNAM, TERMINAL NAME,
;	PROGRAM NAME, DATE, TIME
;
;	THIS PROGRAM IS CALLED AS FOLLOWS:
;
;	XCALL NEWPPN,PPN{,DEVICE{,JOBNAM{,TRMNAM{,PRGNAM{,DAY{,TIM{,TDVNAM{,MEMSIZ}}}}}}}}
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;	MAP1 PPN
;		MAP2 PROJECT,B,2
;		MAP2 PROGRAMMER,B,2
;	MAP1 DEVICE,S,6
;	MAP1 JOBNAM,S,6
;	MAP1 TRMNAM,S,6
;	MAP1 PRGNAM,S,6
;	MAP1 DAY,S,8
;	MAP1 TIM,S,8
;	MAP1 TDVNAM,S,6
;	MAP1 MEMSIZ,F,6
;	
;	XCALL PPN,PPN,DEVICE,JOBNAM,TRMNAM,PRGNAM,DAY,TIM,TDVNAM,MEMSIZ
;
;	PRINT
;	PRINT "   LOG: "DEVICE"["STR(PROJECT)","STR(PROGRAMMER)"]"
;	PRINT "JOBNAM: "JOBNAM
;	PRINT "TRMNAM: "TRMNAM
;	PRINT "PRGNAM: "PRGNAM
;	PRINT "DAY   : "DAY
;	PRINT "TIM   : "TIM
;	PRINT "TDVNAM: "TDVNAM
;	PRINT "MEMSIZ: "MEMSIZ
;	PRINT
;	END
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;	NOTE:	THE PPN NUMBERS WILL BE RETURNED AS DECIMAL
;	BUT THEY WILL REPRESENT THE OCTAL NUMBERS, SO NO CONVERSIONS
;	ARE NECCESSARY.
;
;	WRITTEN	BY MIKE SIGONA ON 1-29-79 FOR THE AM100
;	MODIFIED FOR AM 100/L ON 1-24-83 JOHN KEYS 202 872-4538
;		ADDING ARGUMENTS FOR JOB NAME, AND TERMINAL NAME,
;		AND CORRECT PPN IF HEX MODE IS SET
;
;	MODIFIED 18-MAY-86 BY JALAL RAISSI 
;		ADDING ARGUMENTS FOR PROGRAM NAME, DAY, TIME, TDVNAM, MEMSIZ
;
 	SEARCH 	SYS
	SEARCH 	SYSSYM
	SEARCH 	TRM

.OFINI
.OFDEF	XC.ARG,2			;number of arguments
.OFDEF	XC.TY1,2			;type code - arg 1
.OFDEF	XC.AD1,4			;abs addr - arg 1
.OFDEF	XC.SZ1,4			;size - arg 1
.OFDEF	XC.TY2,2			;type code - arg 2
.OFDEF	XC.AD2,4			;abs addr - arg 2
.OFDEF	XC.SZ2,4			;size - arg 2
.OFDEF	XC.TY3,2			;type code - arg 3
.OFDEF	XC.AD3,4			;abs addr - arg 3
.OFDEF	XC.SZ3,4			;size - arg 3
.OFDEF	XC.TY4,2			;type code - arg 4
.OFDEF	XC.AD4,4			;abs addr - arg 4
.OFDEF	XC.SZ4,4			;size - arg 4
.OFDEF	XC.TY5,2			;type code - arg 5
.OFDEF	XC.AD5,4			;abs addr - arg 5
.OFDEF	XC.SZ5,4			;size - arg 5
.OFDEF	XC.TY6,2			;type code - arg 6
.OFDEF	XC.AD6,4			;abs addr - arg 6
.OFDEF	XC.SZ6,4			;size - arg 6
.OFDEF	XC.TY7,2			;type code - arg 7
.OFDEF	XC.AD7,4			;abs addr - arg 7
.OFDEF	XC.SZ7,4			;size - arg 7
.OFDEF	XC.TY8,2			;type code - arg 8 
.OFDEF	XC.AD8,4			;abs addr - arg 8
.OFDEF	XC.SZ8,4			;size - arg 8
.OFDEF	XC.TY9,2			;type code - arg 9
.OFDEF	XC.AD9,4			;abs addr - arg 9
.OFDEF	XC.SZ9,4			;size - arg 9
.OFSIZ	XC.SIZ

	OBJNAM	NEWPPN.SBR

	SPACE=40
	VMAJOR=1
	VMINOR=0
	VEDIT=100.

       	PHDR	-1,0,PH$REE!PH$REU	; MUST BE LOGGED IN
	
GETPPN:	JOBIDX
	CLR	D3
	MOVW	JOBTYP(A6),D3	; SAVE OLD JOB TYPE (MAINLY J.HEX) IS SET
	ANDW	#^CJ.HEX,JOBTYP(A6)
	MOVW	JOBUSR(A6),D0   ; GET THE PPN
	MOV	XC.AD1(A3),A5       ; INDEX BASIC VARIABLE (XCALL ARGUMENT)
	CALL	CONVRT
	MOVW	D1,2(A5)        ; PROGRAMMER NUMBER
	RORW	D0,#10          ; GET OTHER BYTE - ROTATE RIGHT 8 BITS
	CALL	CONVRT
	MOVW	D1,@A5          ; PROJECT NUMBER
	
GETDEV:	CMPB	@A3,#1          ; DO THEY WANT THE DEVICE ?
	JLE	BACK            ; - NO
	JOBIDX			; INDEX THE JOB TABLE
	MOV	XC.AD2(A3),A2      ; INDEX BASIC VARIABLE (ASCII DEVICE)
	LEA	A1,JOBDEV(A6)   ; INDEX DEVICE NAME (RAD50)
	UNPACK	                ; DECODE DEVICE NAME A1 -> A2
	CLR	D1
	JOBIDX			; INDEX THE JOB TABLE
	MOVW	JOBDRV(A6),D1   ; GET DRIVE NUMBER
	DCVT	0,OT$MEM        ; ADD DRIVE NUMBER TO BASIC STRING IN A2
 	MOVB	#72,(A2)+	; ADD A COLON TO STRING IN A2
	CLRB	@A2             ; ADD A NULL

GETJOB:	CMPB	@A3,#2		; DO THEY WANT THE JOB NAME?
	JLE	BACK		; - NO
 	JOBIDX			; INDEX THE JOB TABLE
 	LEA	A1,JOBNAM(A6)	; POINT TO THE JOB NAME
	MOV	XC.AD3(A3),A2	; INDEX THE BASIC VARIABLE (ASCII JOBNAM)
	UNPACK			; DECODE THE JOB
	UNPACK			; NAME A1 -> A2
STR1:	CMPB	-(A2),#SPACE	; IS LAST CHAR IN FIELD A SPACE?
	BEQ	STR1		; - YES ...BACKUP, TRY ANOTHER
	CLRB	1(A2)		; - NO ....NULL LAST SPACE IN FIELD

GETTRM:	CMPB	@A3,#3		; DO THEY WANT THE TERMINAL NAME?
	JLE	BACK		; - NO
 	JOBIDX			; INDEX THE JOB TABLE
	MOV	JOBTRM(A6),A1	; POINT TO THE TERMINAL STATUS WORD
	SUB	#4,A1		; NOW POINT TO THE TERMINAL NAME
	MOV	XC.AD4(A3),A2	; INDEX THE BASIC VARIABLE (ASCII TRMNAM)
	UNPACK			; DECODE THE TERMINAL
	UNPACK			; NAME A1 -> A2
STR2:	CMPB	-(A2),#SPACE	; IS LAST CHAR IN FIELD A SPACE?
	BEQ	STR2		; - YES ...BACKUP, TRY ANOTHER
	CLRB	1(A2)		; - NO ....NULL LAST SPACE IN FIELD

GETPRG:	CMPB	@A3,#4		; DO THEY WANT THE PROGRAM NAME?
	JLE	BACK		; - NO
	JOBIDX
	LEA	A1,34(A6)	; POINT TO PROGRAM STATUS WORD
	MOV	XC.AD5(A3),A2	; INDEX THE BASIC VARIABLE (ASCII PRGNAM)
	UNPACK			; DECODE THE PROGRAM
 	UNPACK			; NAME A1  -> A2
 STR3:	CMPB	-(A2),#SPACE	; IS LAST CHAR IN FIELD A SPACE?
	BEQ	STR3		; - YES ...BACKUP, TRY ANOTHER
	CLRB	1(A2)		; - NO ....NULL LAST SPACE IN FIELD
 
GETDAT:	CMPB	@A3,#5		; DO THEY WANT THE DATE?
	JLE	BACK		; - NO
	GDATES	@A4		;get the date
	MOV	XC.AD6(A3),A2	;A2 := index to DAY
	CLR	D1		;clear D1
	MOVB	@A4,D1		;D1 := month
	DCVT	2,OT$MEM	;store month in DAY
	MOVB	#'/,(A2)+	;append "/" to DAY
	MOVB	1(A4),D1	;D1 := day
	DCVT	2,OT$MEM	;append day to DAY
	MOVB	#'/,(A2)+	;append "/" to DAY
	MOVB	2(A4),D1	;D1 := year
	DCVT	2,OT$MEM	;append year to DAY

GETTIM:	CMPB	@A3,#6		; DO THEY WANT THE TIME?
	JLE	BACK		; - NO
	GTIMES	@A4		;get the time
	MOV	XC.AD7(A3),A2	;A2 := index to TIM
	MOVB	@A4,D1		;D1 := hours
	CLRW	D2		;clear D2 (AM/PM flag)
	CMPB	D1,#12.		;is the hour>12 noon?
	BLE	10$		; no
	SUBW	#12.,D1		; yes - adjust for 12 hour time
	SETW	D2		;       and set PM flag
10$:	DCVT	2,OT$MEM!OT$ZER	;store hours in TIM
	MOVB	#':,(A2)+	;append ":" to TIM
	MOVB	1(A4),D1	;D1 := minutes
	DCVT	2,OT$MEM	;append minutes to TIM
	MOVB	#40,(A2)+	;append space to TIM
	MOVB	#'A,D1		;D1 := "A"
	TSTW	D2		;AM or PM?
	BEQ	20$		; AM
	MOVB	#'P,D1		;D1 := "P"
20$:	MOVB	D1,(A2)+	;append D1 to TIM
	MOVB	#'M,(A2)+	;append "M" to TIM

GETTDV:	CMPB	@A3,#7		; DO THEY WANT THE TDVNAM?
	BLE	BACK		; - NO
	JOBIDX
	MOV	JOBTRM(A6),A1	;A1 points to terminal status word
	MOV	T.TDV(A1),A1
	SUB	#4,A1		;A1 points to the terminal driver name
	MOV	XC.AD8(A3),A2	;A2 := index to TDVNAM
	UNPACK		
	UNPACK
 STR4:	CMPB	-(A2),#SPACE	; IS LAST CHAR IN FIELD A SPACE?
	BEQ	STR4		; - YES ...BACKUP, TRY ANOTHER
	CLRB	1(A2)		; - NO ....NULL LAST SPACE IN FIELD

GETSIZ:	CMPB	@A3,#10		; DO THEY WANT THE MEMORY SIZE?
	BLE	BACK		; - NO
	JOBIDX
	MOV	JOBSIZ(A6),D1
	DIV	D1,#1024.
	AND	#177777,D1
	MOV	XC.AD9(A3),A5	;A2 := index to MEMORY
	FLTOF	D1,@A5

BACK:	JOBIDX			; INDEX THE JOB TABLE
	MOVW	D3,JOBTYP(A6)	; RESTORE OLD JOBTYPE
	RTN	                ; RETURN TO BASIC
	
;THE FOLLOWING IS A SUBROUTINE TO SIMULATE OCTAL NUMBERS IN DECIMAL.
;IT PERFORMS THE CONVERSION BY A SNEAKY METHOD -- SSHHH!
;
CONVRT:	LEA	A2,BUF          ; INDEX TEMPORARY STORAGE
	CLR	D1
	MOVB	D0,D1           ; GET PART OF THE PPN
	AND	#377,D1         ; GET RID OF HIGH BYTE
	OCVT	3,50            ; OUTPUT WITH TRAILING SPACE TO BUF IN A2
	LEA	A2,BUF		; A2 POINTS TO BEGINNING OF BUF
	GTDEC	                ; HERE'S THE PART THAT CHEATS! A2 -> D1
	RTN
	
BUF:	BLKB	4               ; STORAGE FOR ASCII NUMBER
	
	END	



.