OBJNAM PHDR.SBR ; Created 26-Oct-85, Last modified 28-Oct-85
; Subroutine to return BASIC program's name and version
; by Irv Bromberg, Medic/OS Consultants, Toronto, CANADA
RADIX 10
VEDIT=5
VMINOR=3
VMAJOR=1
IF EQ,1
Calling syntax: XCALL PHDR {,PRGNAM{,Version}}
where PRGNAM is a string variable and Version is an optional string
variable long enough to hold the unpacked version number (excess will be
truncated). If no parameters are passed the program header will be
output to the user's screen in the format: PRGNAM 1.0A(10) When the
program name has a .RUN extension the extension will not be returned but
when it is other than .RUN it will be returned. The returned program
name is the file name of the compiled program, which may not be the same
as the program name that was declared in the PROGRAM statement (the
COMPIL program ignores the program name following the PROGRAM keyword,
so PHDR.SBR is unable to find out what that name was and therefore has
to use the program's file name instead).
Note that if PHDR is called from Interactive BASIC it cannot determine
the appropriate program header so a dummy header, "PRGNAM A.BC(D)" will
be returned.
MOVW @ArgBas,Pcount ; get parameter count
SUB #IMPSIZ,SP ; get some workspace from user stack
MOV SP,AscBuf
TST @Impure ; in compiled BASIC?
BEQ 5$
LEA AscBuf,Dummy ; yes, just show dummy PHDR
JMP Any
5$: LEA Rad50,448(Impure) ; point to the program name
UNPACK ; convert packed program name to ASCII
UNPACK
10$: CMPB -(AscBuf),#SPACE ; strip trailing blanks
BEQ 10$
INC AscBuf ; undo last pre-decrement
CMPW (Rad50),#[RUN] ; do we have .RUN extension?
BEQ 15$
MOVB #'.,(AscBuf)+ ; no, add "." before ext unpacked
UNPACK ; unpack the extension
13$: CMPB -(AscBuf),#SPACE ; strip trailing blanks again
BEQ 13$ ; (needed if ext <3 characters)
INC AscBuf
15$: MOVB #SPACE,(AscBuf)+ ; insert single space separator
MOV 462(Impure),PRGBAS ; point to .RUN file program base
CLR Number ; pre-clear for byte move
MOVB 3(PRGBAS),Number ; get VMAJOR
DCVT 0,OT$MEM ; output it to workspace
MOVB #'.,(AscBuf)+ ; always need "." separator
MOVB 2(PRGBAS),Number ; get VMINOR
DCVT 0,OT$MEM
MOVB 5(PRGBAS),Number ; get VSUB*16+VWHO
LSRB Number,#4 ; shift down VSUB nibble
BEQ 20$ ; no VSUB
ADDB #64,Char ; convert VSUB value to capital letter
MOVB Char,(AscBuf)+
20$: MOVB 4(PRGBAS),Number ; get VEDIT
BEQ 30$ ; no VEDIT
MOVB #'(,(AscBuf)+
DCVT 0,OT$MEM ; output VEDIT value
MOVB #'),(AscBuf)+
30$: CLRB (AscBuf) ; terminate with NULL
MOV SP,AscBuf ; reset pointer
Any: TSTW Pcount ; any parameters passed?
BNE 40$
35$: TTYL @AscBuf ; no, send PRGNAM and version to
BR Done ; user's screen
40$: MOV 4(ArgBas),String ; get program name string address
MOV 8(ArgBas),Size ; get program name string size
BCALL PreClr ; pre-clear the string
BR MovNam ; enter at end of DBF loop
NamLoop:MOVB (AscBuf)+,Char ; terminate on SPACE separater
CMPB Char,#SPACE
BEQ Version
MOVB Char,(String)+
MovNam: DBF Size,NamLoop ; truncate excess
Version:CMPW Pcount,#2 ; 2nd parameter passed for version?
BLO Done
MOV 14(ArgBas),String ; get version string address
MOV 18(ArgBas),Size
BCALL PreClr ; pre-clear the string
BR MovVer
VerLoop:MOVB (AscBuf)+,Char ; terminate on NULL terminator
BEQ Done
MOVB Char,(String)+
MovVer: DBF Size,VerLoop ; truncate excess
