;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
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
