%TITLE 'DUMPER_CVT - Conversion routines' MODULE DUMPER_CVT (IDENT = '1.0.001', LANGUAGE (BLISS32) ) = BEGIN ! !++ ! FACILITY: ! ! DUMPER-32 ! ! ABSTRACT: ! ! This module will provide the data conversion routines required to ! munge the 36 bit into something that this small machine can deal with. ! ! AUTHORS: ! ! Robert C. McQueen ! ! CREATION DATE: 15-April-1985 ! ! MODIFICATION HISTORY: !-- %SBTTL 'Table of Contents' ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! Start of Version 1. ! ! 1.0.000 By: Robert C. McQueen On: 15-Apr-1985 ! Create this Module. !-- %SBTTL 'Library/Require files' ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; REQUIRE 'CHARACTER_DEFINITIONS'; REQUIRE 'DUMPER_SYMBOLS'; REQUIRE 'TAPE_FORMAT'; ! ! Module wide definitions ! STRUCTURE NIBBLE_VECTOR [I; N] = [(N + 1)/2] (NIBBLE_VECTOR + I/2)<(I AND 1)*4, 4>; %SBTTL 'CVT_INITIALIZE' GLOBAL ROUTINE CVT_INITIALIZE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the data conversion routines. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! Module initialized. ! ! COMPLETION_CODES: ! ! SS$_NORMAL - Module initialized correctly ! Others - Problem initializing the module. ! ! SIDE EFFECTS: ! ! None !-- BEGIN RETURN SS$_NORMAL END; %SBTTL 'CVT_CONVERT_RECORD - Convert a record according to table' GLOBAL ROUTINE CVT_CONVERT_RECORD ( ! Routine to convert record data CONVERSION_TABLE : REF CVT_TABLE_STR FIELD (RECORD_FORMAT_CONVERSION_FIELDS), ! Pointer to conversion table RECORD_36BIT : REF DEC_36_BIT_RECORD, ! Pointer to record data INITIAL_WORD_INDEX ! Index for first word in record to convert ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to process a record according to the conversion ! table. It will process all the fields in the table, storing the results ! into the specified storage locations. ! ! FORMAL PARAMETERS: ! ! CONVERSION_TABLE Pointer to the conversion table built by the ! $FORM_BUILD_TABLE macro ! RECORD_36BIT Pointer to a record of 36-bit words containing ! the data to be converted ! INITIAL_RECORD_INDEX Value to add to record offsets from table to ! access correct words from record. This is the ! structure index for the first 36-bit word that ! makes up this portion of the record. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! Values described by conversion table will be stored ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL ROUTINE LIST_FAO; EXTERNAL GQ_QUAL_VALUE_CNTS : VECTOR [, LONG, SIGNED]; EXTERNAL LITERAL GQ$K_DEBUG_QUAL_INDEX; LOCAL TABLE_SIZE; ! Holds size of table TABLE_SIZE = .CONVERSION_TABLE [0, -1] / ! Table is in PLIT (RFM_CONV_ENTRY_SIZE); ! so calculate size in entries INCR TABLE_INDEX FROM 0 TO .TABLE_SIZE - 1 DO ! For each entry BEGIN LOCAL WORD_OFFSET; WORD_OFFSET = ! Get offset to correct word .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_WORD_OFFSET]; (.CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_CONVERSION_ROUTINE]) ( ! Call routine RECORD_36BIT [.INITIAL_WORD_INDEX + .WORD_OFFSET, FRAME_ALL], ! 36-bit word .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_FIELD_SIZE], ! Byte size .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_FIELD_OFFSET], ! Byte position .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_STORAGE_ADDRESS], ! Result storage .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_STORAGE_SIZE], ! Result size RECORD_36BIT [.INITIAL_WORD_INDEX, FRAME_ALL]); ! Address of record ! ! Do debug typeout here ! IF .GQ_QUAL_VALUE_CNTS [GQ$K_DEBUG_QUAL_INDEX] GEQ 0 THEN LIST_FAO (.CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_DEBUG_TEXT], (IF (.CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_FLAGS] AND FORM_M_DESCRIPTOR) NEQ 0 OR .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_STORAGE_SIZE] GTR 4 THEN .CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_STORAGE_ADDRESS] ELSE ..CONVERSION_TABLE [.TABLE_INDEX, RFM_CONV_STORAGE_ADDRESS])); END; ! ! If we fall out of loop, all is fine, so just return ! RETURN ! Return END; %SBTTL 'CVT_SIXBIT_2_ASCID - Convert a sixbit word to ASCID' GLOBAL ROUTINE CVT_SIXBIT_2_ASCID ( ! SIXBIT to ASCID conversion WORD_36BIT : REF DEC_36_BIT_WORD, ! SIXBIT word to convert BYTE_SIZE, ! Byte size (36) BYTE_POSITION, ! Byte position (0) STORAGE : REF $DESCRIPTOR_DECL, ! Pointer to storage (a descriptor) STORAGE_SIZE, ! Size of storage (6) RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will convert a SIXBIT word into an ASCID string. It ! will return the updated descriptor. ! ! FORMAL PARAMETERS: ! ! WORD_36BIT - 36 bit data word containing the sixbit information. ! ! BYTE_SIZE - Not used in this routine. ! ! BYTE_POSITION - Not used in this routine. ! ! STORAGE - ASCID descriptor to store information into ! ! STORAGE_SIZE - Length of the string pointed to by STORAGE. This must ! be at least 6 characters. ! ! RECORD_BUFFER - address of buffer for this data ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Define external routines and literals ! EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE(GENERAL) NOVALUE; EXTERNAL LITERAL DMPR_INTERNALERR; ! Internal error staus ! ! Local variables ! LOCAL CHARACTER_POINTER, ! Pointer to where we store ! the characters CHARACTER : VAX_SIXBIT_CHARACTER_DECL, ! Where we build the character CHARACTER_COUNT : INITIAL(0); ! Cound of character we have gotten ! ! Check to make sure that we are called with valid arguments ! IF .STORAGE_SIZE LSS 6 THEN LIB$SIGNAL(DMPR_INTERNALERR, 1, %ASCID'SIXBIT not 6 characters'); ! ! Here if the storage is large enough to hold the characters ! CHARACTER_POINTER = CH$PTR (.STORAGE[DSC$A_POINTER]); ! ! Now loop processing the characters ! WHILE .CHARACTER_COUNT LSS 6 AND .CHARACTER_COUNT LSS .STORAGE_SIZE DO BEGIN CASE .CHARACTER_COUNT FROM 0 TO 5 OF SET [0 ]: CHARACTER [VAX_SIXBIT_CHAR_0] = .WORD_36BIT[SIXBIT_CHAR_0]; [1 ]: BEGIN CHARACTER [VAX_SIXBIT_CHAR_1_L] = .WORD_36BIT[SIXBIT_CHAR_1_L]; CHARACTER [VAX_SIXBIT_CHAR_1_H] = .WORD_36BIT[SIXBIT_CHAR_1_H] END; [2 ]: BEGIN CHARACTER [VAX_SIXBIT_CHAR_2_L] = .WORD_36BIT[SIXBIT_CHAR_2_L]; CHARACTER [VAX_SIXBIT_CHAR_2_H] = .WORD_36BIT[SIXBIT_CHAR_2_H] END; [3 ]: CHARACTER [VAX_SIXBIT_CHAR_3] = .WORD_36BIT[SIXBIT_CHAR_3]; [4 ]: CHARACTER [VAX_SIXBIT_CHAR_4] = .WORD_36BIT[SIXBIT_CHAR_4]; [5 ]: BEGIN CHARACTER [VAX_SIXBIT_CHAR_5_L] = .WORD_36BIT[SIXBIT_CHAR_5_L]; CHARACTER [VAX_SIXBIT_CHAR_5_H] = .WORD_36BIT[SIXBIT_CHAR_5_H] END; TES; IF (.CHARACTER EQL CHR_NUL) THEN EXITLOOP; ! ! Write the character after converting to ASCII. SIXBIT has same collating !sequence, but the space character equals 0. ! CH$WCHAR_A(.CHARACTER + %C' ', CHARACTER_POINTER); CHARACTER_COUNT = .CHARACTER_COUNT + 1; END; ! ! Now store the number of characters we stored into the descriptor ! STORAGE [DSC$W_LENGTH] = .CHARACTER_COUNT; RETURN END; %SBTTL 'CVT_FETCH_7BIT_CHARACTER - Get a DEC-10/20 character' GLOBAL ROUTINE CVT_FETCH_7BIT_CHARACTER ( ! Get 7-bit character ASCII_STRING : REF DEC_36_BIT_RECORD, ! Start of string CHARACTER_OFFSET, ! Offset to character LSN_FLAG ! Flag to handle LSN bits ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return a character from the string pointed to by ! the ASCII_STRING argument. It will use the CHARACTER_OFFSET to determine ! which of the characters to return to the caller. ! ! FORMAL PARAMETERS: ! ! ASCII_STRING - Block of 36 bit words containing the string. ! ! CHARACTER_OFFSET - 7bit byte offset into the string of the character ! to return to the caller. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE_VALUE: ! ! Character found at the word offset. ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL CHARACTER : VAX_7BIT_CHARACTER_DECL, WORD_INDEX; ! Index into the word with ! the characters WORD_INDEX = .CHARACTER_OFFSET/5; CASE .CHARACTER_OFFSET MOD 5 FROM 0 TO 4 OF SET [0] : CHARACTER [VAX_CHAR_0] = .ASCII_STRING [.WORD_INDEX, CHAR_0]; [1] : BEGIN CHARACTER [VAX_CHAR_1_L] = .ASCII_STRING [.WORD_INDEX, CHAR_1_L]; CHARACTER [VAX_CHAR_1_H] = .ASCII_STRING [.WORD_INDEX, CHAR_1_H] END; [2] : BEGIN CHARACTER [VAX_CHAR_2_L] = .ASCII_STRING [.WORD_INDEX, CHAR_2_L]; CHARACTER [VAX_CHAR_2_H] = .ASCII_STRING [.WORD_INDEX, CHAR_2_H] END; [3] : BEGIN CHARACTER [VAX_CHAR_3_L] = .ASCII_STRING [.WORD_INDEX, CHAR_3_L]; CHARACTER [VAX_CHAR_3_H] = .ASCII_STRING [.WORD_INDEX, CHAR_3_H] END; [4] : BEGIN CHARACTER [VAX_CHAR_4_L] = .ASCII_STRING [.WORD_INDEX, CHAR_4_L]; CHARACTER [VAX_CHAR_4_H] = .ASCII_STRING [.WORD_INDEX, CHAR_4_H]; IF .LSN_FLAG THEN CHARACTER [VAX_LSN_BIT] = .ASCII_STRING [.WORD_INDEX, LSN_BIT]; END; TES; RETURN .CHARACTER END; %SBTTL 'CVT_WORD_2_LONGWORD - Attempt to convert a word into a long word' GLOBAL ROUTINE CVT_WORD_2_LONGWORD ( ! Convert 36-bit word to 32 bits WORD_36BIT : REF DEC_36_BIT_WORD, ! Word to convert BYTE_SIZE, ! Byte size (36) BYTE_POSITION, ! Byte position (0) LONG_WORD : REF $LONGWORD, ! Pointer to result STORAGE_SIZE, ! Length of result (4 bytes) RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will attempt to convert a word (36-bit) into a VAX long word ! data item. It will return an error status if the high order four bits ! of the word is non-zero. ! ! FORMAL PARAMETERS: ! ! WORD_36BIT - Address of the 36-bit word ! ! LONG_WORD - Long word to return the information in ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL LITERAL DMPR_INTERNALERR; ! Internal error status EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; ! ! First determine if there is anything in the high-order four bits of ! the 36bit word. If there is, then return the internal error code ! IF (.WORD_36BIT [FRAME_0] AND %O'7700') NEQ 0 THEN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Value too big for a LONG word'); ! ! Build the long word valud by shifting the frames and adding them together ! to form the 32 bit number ! LONG_WORD<28, 4> = .WORD_36BIT [FRAME_0]; ! B4-7 => bits 31-28 LONG_WORD<20, 8> = .WORD_36BIT [FRAME_1]; ! B8-15 => bits 27-20 LONG_WORD<12, 8> = .WORD_36BIT [FRAME_2]; ! B16-23 => bits 19-12 LONG_WORD<04, 8> = .WORD_36BIT [FRAME_3]; ! B24-31 => bits 11-4 LONG_WORD<00, 4> = .WORD_36BIT [FRAME_4]; ! B32-35 => bits 3-0 ! ! Give a normal return from the routine ! RETURN END; %SBTTL 'CVT_ASCIZ_2_ASCID - Convert an 10/20 ASCIZ string to ASCID' GLOBAL ROUTINE CVT_ASCIZ_2_ASCID ( ! Convert 7-bit ASCIZ to 8-bit ASCID ASCIZ_STRING : REF DEC_36_BIT_RECORD, ! Pointer to source BYTE_SIZE, ! Byte size (max # chars * 7) BYTE_POSITION, ! Byte position (0) ASCID_STRING : REF $DESCRIPTOR_DECL, ! Descriptor for result STORAGE_SIZE, ! Max size of result RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will take the address of an ASCIZ string and convert the ! information into the ASCID descriptor that was given. ! ! FORMAL PARAMETERS: ! ! ASCIZ_STRING - Address of the 10/20 ASCIZ string dta. ! ASCID_STRING - Address of the descriptor for the returned ASCII string. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL CHARACTER : BYTE, ! Character we are processing ASCID_STRING_POINTER, ! Pointer into ASCID string ASCIZ_STRING_LENGTH : INITIAL (0); ! ! Set up the pointer to the string initially ! ASCID_STRING_POINTER = CH$PTR (.ASCID_STRING [DSC$A_POINTER]); ! ! Now fetch a character and store it into the ASCID string ! DO BEGIN CHARACTER = CVT_FETCH_7BIT_CHARACTER (ASCIZ_STRING [0, FRAME_ALL], .ASCIZ_STRING_LENGTH, FALSE); CH$WCHAR_A (.CHARACTER, ASCID_STRING_POINTER); ASCIZ_STRING_LENGTH = .ASCIZ_STRING_LENGTH + 1 END WHILE (.CHARACTER NEQ 0) AND (.ASCIZ_STRING_LENGTH LEQ .STORAGE_SIZE); IF .CHARACTER EQL 0 THEN ASCIZ_STRING_LENGTH = .ASCIZ_STRING_LENGTH - 1; ASCID_STRING [DSC$W_LENGTH] = .ASCIZ_STRING_LENGTH; RETURN END; %SBTTL 'CVT_FIELD - Fetch arbitrary data item' GLOBAL ROUTINE CVT_FIELD ( ! Fetch an arbitrary field WORD_36BIT : REF NIBBLE_VECTOR [], ! Source for fetch BYTE_SIZE, ! Size of byte in bits BYTE_POSITION, ! Position of byte (36 bit bit number) STORAGE : REF BLOCK [,BYTE], ! Place to store result STORAGE_SIZE, ! Size of storage RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will fetch an arbitrary data item and convert it to a ! VAX data item. ! ! This routine will only handle data that is 36bits long or 32 and less. ! ! FORMAL PARAMETERS: ! ! WORD_36BIT - Address of the 36-bit data item. ! ! BYTE_SIZE - Size of the data item. ! ! BYTE_POSITION - High order bit number (DEC-10/20 numbering). ! ! STORAGE - Address of the place to store this into ! ! STORAGE_SIZE - Size of the storage in bytes ! ! RECORD_BUFFER - address of buffer for this data ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL LITERAL DMPR_INTERNALERR; ! Some internal calling error EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; LOCAL VALUE_BLOCK : NIBBLE_VECTOR [9]; ! 36 bit value ! ! First check for an item that is zero bits in length - Internal error ! IF (.BYTE_SIZE LEQ 0) OR (.BYTE_SIZE GTR 36) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal byte size'); BYTE_SIZE = 36; ! Assume full 36-bit word END; ! ! Check for illegal bit numberings ! IF (.BYTE_POSITION LSS 0) OR (.BYTE_POSITION GTR 35) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal bit numbering'); BYTE_POSITION = 0; END; ! ! Now check to see if the bit and size cause the byte to be across a ! word boundary ! IF (.BYTE_POSITION + .BYTE_SIZE) GTR 36 THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal byte size/position'); BYTE_POSITION = 36 - .BYTE_SIZE; ! Assume right justified END; ! ! Now check for the cases we currently don't handle ! IF (.BYTE_SIZE GTR 32) AND (.BYTE_SIZE LSS 36) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Byte size too big'); BYTE_SIZE = 32 ! Assume right size END; ! ! Now process the information ! VALUE_BLOCK [0] = .WORD_36BIT [8]; ! B32-35 VALUE_BLOCK [1] = .WORD_36BIT [6]; ! B28-31 VALUE_BLOCK [2] = .WORD_36BIT [7]; ! B24-27 VALUE_BLOCK [3] = .WORD_36BIT [4]; ! B20-23 VALUE_BLOCK [4] = .WORD_36BIT [5]; ! B16-19 VALUE_BLOCK [5] = .WORD_36BIT [2]; ! B12-15 VALUE_BLOCK [6] = .WORD_36BIT [3]; ! B8-11 VALUE_BLOCK [7] = .WORD_36BIT [0]; ! B4-7 VALUE_BLOCK [8] = .WORD_36BIT [1]; ! B0-3 IF .BYTE_SIZE EQL 36 ! If full word fetch THEN STORAGE [0, 0, .STORAGE_SIZE*%BPUNIT, 0] = .VALUE_BLOCK ! Get low 32 bits ELSE STORAGE [0, 0, .STORAGE_SIZE*%BPUNIT, 0] = ! Store value in correct size .VALUE_BLOCK<(36 - .BYTE_POSITION - .BYTE_SIZE), .BYTE_SIZE>; ! From correct byte RETURN END; %SBTTL 'CVT_BPT_2_ASCID - Convert relative byte pointer to ASCID' GLOBAL ROUTINE CVT_BPT_2_ASCID ( ! Get string from byte pointer WORD_36BIT : REF DEC_36_BIT_RECORD, ! Address of byte pointer BYTE_SIZE, ! Size of pointer (36 bits) BYTE_POSITION, ! Position of pointer (0) STORAGE : REF $DESCRIPTOR_DECL, ! Descriptor for resulting string STORAGE_SIZE, ! Max length of resulting string RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will convert a relative byte pointer to an ASCIZ string in ! the current tape record to an ASCID string. ! If all fields are zero, it will assume no string. ! ! FORMAL PARAMETERS: ! ! WORD_36BIT - Address of the first 36 bit word in the block. ! ! BYTE_SIZE - Not used in this routine. ! ! BYTE_POSITION - Not used in this routine. ! ! STORAGE - Address of the descriptor to use to store the string. ! ! STORAGE_SIZE - Number of bytes the string descriptor can hold. ! ! RECORD_BUFFER - address of buffer for this data. This is the word ! that is the base for the relative byte pointer ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Define the local storage for this block. ! LOCAL ZERO_STORAGE, ! Should have a zero fetched into it WORD_OFFSET, ! Word offset from the byte pointer BPT_POSITION, ! Byte pointer offset ASCID_STRING_POINTER, ! Pointer into the descriptor ASCIZ_STRING_LENGTH : INITIAL (0), ! Length of the string CHARACTER; ! Character we are processing ! ! External status codes and signalling routine ! EXTERNAL LITERAL DMPR_INTERNALERR; EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE(GENERAL) NOVALUE; ! ! First do validation checking of the byte pointer ! CVT_FIELD ( WORD_36BIT [0, FRAME_ALL], BPT_ZERO_SIZE, BPT_ZERO_POS, ZERO_STORAGE, 4); IF .ZERO_STORAGE NEQ 0 THEN LIB$SIGNAL(DMPR_INTERNALERR, 1, %ASCID'Byte pointer field not zero'); ! ! Get the byte size field ! CVT_FIELD ( WORD_36BIT [0, FRAME_ALL], BPT_SIZE_SIZE, BPT_SIZE_POS, ZERO_STORAGE, 4); ! ! Get the position field ! CVT_FIELD ( WORD_36BIT [0, FRAME_ALL], BPT_POSITION_SIZE, BPT_POSITION_POS, BPT_POSITION, 4); ! ! Now get the offset into the block ! CVT_FIELD ( WORD_36BIT [0, FRAME_ALL], BPT_ADDRESS_SIZE, BPT_ADDRESS_POS, WORD_OFFSET, 4); ! ! Check for good byte size or completely zero pointer ! IF .ZERO_STORAGE NEQ 7 THEN IF .ZERO_STORAGE EQL 0 AND .BPT_POSITION EQL 0 AND .WORD_OFFSET EQL 0 THEN BEGIN STORAGE [DSC$W_LENGTH] = 0; ! No string if pointer was zero RETURN ! All done END ELSE LIB$SIGNAL(DMPR_INTERNALERR, 1, %ASCID'Byte size not 7'); ! ! Here if the byte size is 7 and not a global byte pointer and the ! index and indirect fields are zero ! ! ! Now convert the byte position into an index. ! BPT_POSITION = (36 - .BPT_POSITION)/7; ! Calculate character number ! ! Now move the characters from the ASCIZ string to the final storage. ! ASCID_STRING_POINTER = CH$PTR (.STORAGE [DSC$A_POINTER]); ! ! Now fetch and store characters ! DO BEGIN CHARACTER = CVT_FETCH_7BIT_CHARACTER ( ! Fetch character RECORD_BUFFER [.WORD_OFFSET, FRAME_ALL], ! from correct word .BPT_POSITION, ! and position FALSE); CH$WCHAR_A (.CHARACTER, ASCID_STRING_POINTER); BPT_POSITION = .BPT_POSITION + 1; ASCIZ_STRING_LENGTH = .ASCIZ_STRING_LENGTH + 1 END WHILE (.CHARACTER NEQ CHR_NUL) AND (.ASCIZ_STRING_LENGTH LEQ .STORAGE_SIZE); ! ! Here after the string is completely moved. Determine if we should back ! up the count by one if the last character was a null ! IF .CHARACTER EQL 0 THEN ASCIZ_STRING_LENGTH = .ASCIZ_STRING_LENGTH - 1; STORAGE [DSC$W_LENGTH] = .ASCIZ_STRING_LENGTH; RETURN END; %SBTTL 'CVT_UDT_2_DATE_TIME' GLOBAL ROUTINE CVT_UDT_2_DATE_TIME ( ! Convert 36-bit UDT to 8-byte date/time UDT_ADDRESS : REF DEC_36_BIT_WORD, ! 36-bit UDT BYTE_SIZE, ! Byte size (36 bits) BYTE_POSITION, ! Byte position (0) DATE_TIME : REF VECTOR [2,LONG], ! Quadword result STORAGE_SIZE, ! Size of result (8 bytes) RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will convert a universal date/time (TOPS-10/20 fmt) to ! the VAX format for Date/Time. ! ! FORMAL PARAMETERS: ! ! UDT_ADDRESS - Address in the buffer of the 36-bit word containing the ! DEC-10/20 UDT. ! DATE_TIME - VAX format date/time. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Conversion value for days to VAX 100 nano-second date/time format ! LITERAL DAYS_2_MILLI_SECONDS = 24* ! Hours in day 60* ! Minutes in hour 60* ! Seconds in minute 1000, ! Milli-seconds in second MILLI_2_100_NANO_SECONDS = 1000* ! Micro-seconds in milli-second 10; ! 100 nano-seconds in micro-second ! ! Locals used in this routine ! LOCAL UDT_QLOW : VECTOR [2, LONG], ! Low order quad-word UDT_QHIGH : VECTOR [2, LONG], ! High order quad-word UDT_QUAD : VECTOR [2, LONG] ! Quadword time INITIAL(REP 2 OF LONG (0)), ! initially zero UDT_LOW_ORDER, ! Fractions of a day (-10 UDT) UDT_HIGH_ORDER; ! Days (UDT) BUILTIN ASHQ, ! Quadword ASH insturction ADDM, ! Multiword addition EMUL; ! Extended multiply ! ! First fetch the UDT days and the fractions of days ! CVT_FIELD (UDT_ADDRESS [FRAME_ALL], 18, 0, UDT_HIGH_ORDER, 4); CVT_FIELD (UDT_ADDRESS [FRAME_ALL], 18, 18, UDT_LOW_ORDER, 4); ! ! Now start the conversion into usuable units. We do this in multiple !steps to make it a little easier and avoid overflow problems. ! EMUL(UDT_LOW_ORDER, %REF (DAYS_2_MILLI_SECONDS), ! Convert to milli-seconds %REF (0), UDT_QLOW); ! As first step ASHQ (%REF (-18), UDT_QLOW, UDT_QLOW); ! Turn into real milliseconds ! ! Compute high order in milli-seconds ! EMUL(UDT_HIGH_ORDER, %REF (DAYS_2_MILLI_SECONDS), ! To milli-seconds %REF (0), UDT_QHIGH); ! so both pieces are in same ! units ADDM (2, UDT_QLOW, UDT_QHIGH, UDT_QUAD); ! Get sum in milli-seconds ! ! Now multiply the quadword time to produce 100-nanosecond units ! EMUL(UDT_QUAD, %REF (MILLI_2_100_NANO_SECONDS), ! Get low order of %REF (0), DATE_TIME [0]); ! Final result UDT_QHIGH = .UDT_QUAD [1] * MILLI_2_100_NANO_SECONDS; ! Get high half IF .UDT_QUAD [0] LSS 0 ! If low order of milli-seconds THEN ! is negative UDT_QHIGH = .UDT_QHIGH + MILLI_2_100_NANO_SECONDS; ! Need one more DATE_TIME [1] = .DATE_TIME [1] + .UDT_QHIGH; ! Get final result RETURN END; %SBTTL 'CVT_NEG_FIELD - Convert a negative field into a LONG word' GLOBAL ROUTINE CVT_NEG_FIELD ( ! Fetch negative field WORD_36BIT : REF NIBBLE_VECTOR [9], ! Source word BYTE_SIZE, ! Byte size BYTE_POSITION, ! Byte position STORAGE : REF BLOCK [, BYTE], ! Pointer to result STORAGE_SIZE, ! Size of result RECORD_BUFFER : REF DEC_36_BIT_RECORD ! Base of record ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will convert a negative number (36 bit) into a single long ! value. ! ! FORMAL PARAMETERS: ! ! WORD_36BIT - Address of the 36-bit data item. ! ! BYTE_SIZE - Size of the data item. ! ! BYTE_POSITION - High order bit number (DEC-10/20 numbering). ! ! STORAGE - Address of the place to store this into ! ! STORAGE_SIZE - Size of the storage in bytes ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL LITERAL DMPR_INTERNALERR; ! Some internal calling error EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; LOCAL VALUE_BLOCK : NIBBLE_VECTOR [9]; ! 36 bit value ! ! First check for an item that is zero bits in length - Internal error ! IF (.BYTE_SIZE LEQ 0) OR (.BYTE_SIZE GTR 36) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal byte size'); BYTE_SIZE = 36; ! Assume full word END; ! ! Check for illegal bit numberings ! IF (.BYTE_POSITION LSS 0) OR (.BYTE_POSITION GTR 35) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal bit numbering'); BYTE_POSITION = 0; ! Assume left justified END; ! ! Now check to see if the bit and size cause the byte to be across a ! word boundary ! IF (.BYTE_POSITION + .BYTE_SIZE) GTR 36 THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Illegal byte size/position'); BYTE_POSITION = 36 - .BYTE_SIZE; ! assume right justified END; ! ! Now check for the cases we currently don't handle ! IF (.BYTE_SIZE GTR 32) AND (.BYTE_SIZE LSS 36) THEN BEGIN LIB$SIGNAL (DMPR_INTERNALERR, 1, %ASCID'Byte size too big'); BYTE_SIZE = 36; ! Assume full word END; ! ! Now process the information ! VALUE_BLOCK [0] = .WORD_36BIT [8]; ! B32-35 VALUE_BLOCK [1] = .WORD_36BIT [6]; ! B28-31 VALUE_BLOCK [2] = .WORD_36BIT [7]; ! B24-27 VALUE_BLOCK [3] = .WORD_36BIT [4]; ! B20-23 VALUE_BLOCK [4] = .WORD_36BIT [5]; ! B16-19 VALUE_BLOCK [5] = .WORD_36BIT [2]; ! B12-15 VALUE_BLOCK [6] = .WORD_36BIT [3]; ! B8-11 VALUE_BLOCK [7] = .WORD_36BIT [0]; ! B4-7 VALUE_BLOCK [8] = .WORD_36BIT [1]; ! B0-3 ! ! Check to make sure it is a negative number we can return ! IF .BYTE_SIZE EQL 36 ! If full word fetch THEN BEGIN BYTE_POSITION = 4; ! Just get low 32 bits BYTE_SIZE = 32; ! for right justified value END; STORAGE [0, 0, .STORAGE_SIZE*%BPUNIT, 0] = ! Store value in correct size .VALUE_BLOCK<(36 - .BYTE_POSITION - .BYTE_SIZE), .BYTE_SIZE>; ! From correct byte END; END ! End of module ELUDOM