;++ ; Copyright © 1993 - 1998 by Brian Schenkenberger and TMESIS. ; ALL RIGHTS RESERVED. ; Notice of Disclaimer ; ------------------------- ; ; This Software is provided "AS IS" and is supplied for informational purpose ; only. No warranty is expressed or implied and no liability can be accepted ; for any direct, indirect or consequential damages or for any damage whatso- ; ever resulting in the loss of systems, data or profit from the use of this ; software or from any of the information contained herein. The author makes ; no claims as to the suitablility or fitness of this Software or information ; contain herein for any particular purpose. ; ; ; Software License ; ------------------------- ; This Software is furnished under license. The licensee may not distribute ; any copy of the Software without the prior written consent of the licensor. ; For FIELD TEST releases of this Software, the licensee may install and use ; this software on any machine (CPU) which is held property of the licensee. ; LICENSED USE of this software is provided *ONLY* for use AT YOUR OWN RISK. ; ; ; Title and Ownership ; ------------------------- ; NO TITLE TO AND/OR OWNERSHIP OF THIS SOFTWARE IS HEREBY TRANSFERRED. ANY ; MODIFICATION WITHOUT THE PRIOR WRITTEN CONSENT OF THE COPYRIGHT HOLDER IS ; PROHIBITED. ANY USE, IN WHOLE OR PART, OF THIS SOFTWARE FOR A COMMERCIAL ; PRODUCT WITHOUT THE PRIOR WRITTEN CONSENT OF THE COPYRIGHT HOLDER IS ALSO ; PROHIBITED. THE TECHNIQUES EMPLOYED IN THE SOFTWARE ARE THE INTELLECTUAL ; PROPERTY OF THE COPYRIGHT HOLDER. THIS SOFTWARE CONTAINS "TRADE SECRETS" ; AND PROPRIETARY SOFTWARE TECHNIQUES. REVERSE ENGINEERING OF THE SOFTWARE ; IS STRICTLY PROHIBITED. ;-- .TITLE TMESIS$MILMARK_TIME .IDENT /V1.0 %4.021 BJS/ ;++ .SBTTL Determine the target architecture ;-- .NTYPE ...ON_ALPHA...,R31 .IIF EQ,<...ON_ALPHA...@-4&^XF>-5, ALPHA=0 .IIF DF,ALPHA, .DISABLE FLAGGING ;++ .SBTTL Primitive program datum definitions ;-- ZERO = 0 ; |_ BYTE = 1@0 ; |_|_ WORD = 1@1 ; |___|___ LONG = 1@2 ; |_______|_______ QUAD = 1@3 ; |_______________|_______________ OCTA = 1@4 ; |_______________|_______________| PAGE = 1@9 ; VAX page ; Alpha Pagelet BLOCK= 1@9 ; Standard disk block size ;++ .SBTTL Macro declarations for architectural conditional compilation ;-- .MACRO .ON_AXP OPERATION ; conditional compilation macro .IIF DF,ALPHA, OPERATION ; for code specific to Alpha .ENDM .ON_AXP;OPERATION .MACRO .ON_VAX OPERATION ; conditional compilation macro .IIF NDF,ALPHA, OPERATION ; for code specific to VAX .ENDM .ON_VAX;OPERATION ;++ .SBTTL Macro declarations for 64 bit address conditional compilation ;-- .MACRO .IF_32 OPERATION .IIF NDF,ALPHA, OPERATION .IIF NDF,ALPHA, .MEXIT .IIF NDF,SS$_NORMAL,$SSDEF .IIF NDF,SS$_ARG_GTR_32_BITS, OPERATION .ENDM .IF_32;OPERATION .MACRO .IF_64 OPERATION .IIF NDF,ALPHA, .MEXIT .IIF NDF,SS$_NORMAL,$SSDEF .IIF DF,SS$_ARG_GTR_32_BITS, OPERATION .ENDM .IF_64;OPERATION ;++ .SBTTL Macros to manipulate 64 bit register stack saves and restores ;-- .MACRO $PUSHR64,REGLST .MACRO ...REV,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15 .IRP REG, .IIF NB,REG, EVAX_STQ REG,-(SP) .ENDR .ENDM ...REV ...REV REGLST .MDELETE ...REV .ENDM $PUSHR64 .MACRO $POPR64,REGLST .IRP REG, .IIF NB,REG, EVAX_LDQ REG,(SP)+ .ENDR .ENDM $POPR64 ;++ ; The following macro is used to check the return status of system calls. ; It can take up to three arguments: ; STS ...... register or memory containing the status value ; ERROR .... instruction to execute if an error is detected ; NORMAL ... change status to a success before taking ERROR ;-- .MACRO CHKSTS,STS=,NORMAL=,ERROR=,?LBL .IIF DIF,,, MOVZWL STS,R0 .IIF IDN,,, BLBS R0,LBL .IIF DIF,,, BBSS #0,R0,LBL .IRP ERR, .SHOW MEB ERR .NOSHOW MEB .ENDR LBL: .ENDM CHKSTS ;++ ; The following macro is used to call routine which do not have a Digital ; supplied invocation macro. It takes two arguments: ; ROUTIN ...... routine to be invoked ; ARGUMENTS ... list of arguments and their stack access mechanism. ;-- .MACRO CALL,ROUTIN,ARGUMENTS .SHOW MEB .MACRO ...REV,FUNC,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF ... = 0 .IRP ARG,<,,,,,,,> .IIF NB,, PUSH ARG .ENDR .IRP ARG,<,,,,,,,> .IIF NB,, FUNC ARG .ENDR .ENDM ...REV;FUNC,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF .MACRO .PUSH,ARG,XX PUSH'XX ARG ...=...+1 .ENDM .PUSH .MACRO .CALL,CNT,RTN CALLS #CNT,G^RTN .ENDM .CALL;CNT,RTN ...REV <.PUSH>,ARGUMENTS .MDELETE .PUSH .MDELETE ...REV .CALL \...,ROUTIN .NOSHOW MEB .MDELETE .CALL .ENDM CALL ;++ ; FORMAT TMESIS$MILMARK_TIME int-val, str-val ; ; RETURNS str_length. VMS Usage: longword_unsigned ; type: longword (signed) ; access: write only ; mechanism: by value ; ; ARGUMENTS int-val VMS Usage: longword_signed ; type: longword (signed) ; access: read only ; mechanism: by reference ; ; str-val VMS Usage: char_string ; type: character string ; access: modify ; mechanism: by descriptor ; ; ; DESCRIPTION ; ; This routine will output a translated and formatted integer ; string in the format ±#,###,###,### $sec. String is blanked ; if the passed value is zero. $ is a metric specifier (n,µ,m). ; ;-- .ON_AXP <.LIBRARY "SYS$TMESIS:[UMMAGUMMA]UMMAGUMMA.MLB"> ; for EDITPC def $SSDEF .PSECT TMESIS$MILMARK_TIME_DATA,WRT,NOEXE,5 PACKED: .PACKED 2147483647 ; ED$STR: .ASCII /±#,###,###,### $sec ###/ PSB$DSC: .BLKL 2 EDIT_PATTERN: EO$Adjust_Input 10 ; adjust to 10 signif digits w/o sign EO$Load_Plus <+> ; print a '+' if value is positive EO$Float 1 ; float value to billions placeholder EO$Insert <,> ; insert a ',' EO$Float 3 ; float value to 100, 10 & 1 millions EO$Insert <,> ; insert a ',' EO$Float 3 ; float value to 100,10 & 1 thousand EO$Insert <,> ; insert a ',' EO$Float 2 ; float value to 100's & 10's places EO$End_Float ; end of value float region EO$Move 1 ; move and create 1 significant digit EO$Blank_Zero 2 ; remove sign character if zero EO$Insert < > ; insert a space in string EO$Metric_Sign: EO$Load_Sign ; load 'n' (micro) into sign register EO$Store_Sign ; store sign in string EO$Replace_Sign 1 EO$Load_Sign ; load 's' (seconds) into sign register EO$Store_Sign ; store sign in string EO$Replace_Sign 1 EO$Load_Sign ; load 's' (seconds) into sign register EO$Store_Sign ; store sign in string EO$Replace_Sign 1 EO$Load_Sign ; load 's' (seconds) into sign register EO$Store_Sign ; store sign in string EO$Replace_Sign 1 EO$End ; end pattern edit .PSECT TMESIS$MILMAR_TIME_DATA,NOWRT,EXE,5 .ENTRY TMESIS$MILMARK_TIME,^m $OFFSET 0,POSITIVE,<- ,- ,- ,> MOVL @INT_VAL(AP),R1 ; get value to be formatted CLRL R3 ; MOVAL I^#^A/num /,R4 ; point at metric specifiers 10$: MOVB (R4)+,EO$Metric_Sign+1 ; move metric to sign operand MOVL R1,R2 ; BEQL 20$ ; input was zero, null format EDIV #1000,R2,R1,R0 ; reduce value by 1000 factor TSTL R0 ; if no significance lost BEQL 10$ ; try next metric specifier 20$: CVTLP R2,#10,PACKED ; convert to a packed numeric EDITPC #11,PACKED,EDIT_PATTERN,ED$STR ; edit to ±#,###,###,### $sec SKPC #^A/ /,#19,ED$STR ; find first significant char MOVQ R0,PSB$DSC ; return formatted integer MOVAL PSB$DSC,@STR_VAL(AP) MOVL #SS$_NORMAL,R0 RET .END