MODULE XPUT ( IDENT = 'X1.2-19' %TITLE 'XPO$PUT - XPORT File Output' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$PUT ),OTS='' ) ) = BEGIN ! ! COPYRIGHT (c) 1982 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module is the XPORT file output module. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHORS: Ward Clark, CREATION DATE: 26 June 1978 ! Linda Duffell ! ! MODIFIED BY: Edward G. Freedman See CMS history for details ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$PUT; ! XPORT File Output Routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11 ) %IF $TOPS10 %THEN REQUIRE 'XT10' ; ! TOPS-10 I/O interface macros %FI %IF $TOPS20 %THEN REQUIRE 'XT20' ; ! TOPS-20 I/O interface macros %FI %IF $VMS %THEN REQUIRE 'XVMS' ; ! XPORT-specific VAX/VMS interface definitions %FI %IF $11M %THEN REQUIRE 'XRSX' ; ! XPORT-specific RSX-11 and FCS-11 interface definitions %FI %IF $RSTS %THEN REQUIRE 'XRSTS' ; ! RSTS system interface definitions %FI %IF $RT11 %THEN REQUIRE 'XRT11' ; ! RT-11 system interface definitions %FI ! ! MACROS: ! %IF $TOPS10 %THEN MACRO put_file( value ) = BEGIN CH$WCHAR_A( value, buffer_cb[$BFPTR] ); ! Place one character/value in the output buffer. buffer_cb[$BFCTR] = .buffer_cb[$BFCTR] - 1; ! Decrement the output buffer count. IF .buffer_cb[$BFCTR] LEQ 0 ! If the output buffer is full, THEN ! IF NOT $T10_OUT( .iob[IOB$H_CHANNEL] ) ! output the buffer and get another. THEN $XPO_QUIT( IO_ERROR ); ! Return an error code if the output fails. END % ; %FI %IF $TOPS20 %THEN MACRO put_file( value ) = BEGIN CH$WCHAR_A( value, buffer_cb[$BFPTR] ); ! Place one character/value in the output buffer. buffer_cb[$BFCTR] = .buffer_cb[$BFCTR] - 1; ! Decrement the output buffer count. IF .buffer_cb[$BFCTR] LEQ 0 ! If the output buffer is full, THEN ! IF NOT X20$OUT( .iob ) ! output the buffer and get another. THEN $XPO_QUIT(); ! Return an error completion code if the output fails. END %; %FI %IF $RSTS %THEN MACRO put_file( value ) = BEGIN CH$WCHAR_A( value, buffer_cb[XRSTS$A_BFPTR] ); ! Place one character/value in the output buffer. buffer_cb[XRSTS$G_BFCTR] = ! Decrement the output buffer count. .buffer_cb[XRSTS$G_BFCTR] - 1; IF .buffer_cb[XRSTS$G_BFCTR] LEQ 0 ! If the output buffer is full, THEN ! IF NOT XRST$OUT( .iob ) ! output the buffer and get another. THEN $XPO_QUIT(); ! Return an error completion code if the output fails. END %; %FI %IF $RT11 %THEN MACRO put_file( value ) = BEGIN CH$WCHAR_A( value, buffer_cb[$BFPTR] ); ! Place one character in the output buffer. buffer_cb[$BFCTR] = .buffer_cb[$BFCTR] - 1; ! Decrement the output buffer count. IF .buffer_cb[$BFCTR] LEQ 0 ! If the output buffer is full, THEN ! IF NOT XRT$OUT( .iob ) ! output the buffer and get another. THEN $XPO_QUIT(); ! Return an error completion code if the output fails. END %; %FI ! ! EQUATED SYMBOLS: ! LITERAL term_buff_len = 132 + 3; ! Length of the local terminal output buffer ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! ! ! EXTERNAL REFERENCES: ! %IF $TOPS20 %THEN EXTERNAL ROUTINE X20$OUT, ! File output routine. X20$ERROR : NOVALUE; ! TOPS-20 to XPORT completion code conversion routine %FI %IF $VMS %THEN EXTERNAL ROUTINE XPO$RMS_ERROR : NOVALUE, ! RMS-to-XPORT completion code conversion routine LIB$GET_EF : ADDRESSING_MODE(GENERAL), ! Event flag allocation LIB$FREE_EF : ADDRESSING_MODE(GENERAL); ! Event flag deallocation %FI %IF $11M %THEN EXTERNAL XRSX$EVENT_FLAG; ! XPORT QIO/FCS event flag number EXTERNAL ROUTINE XRSX$IO_ERROR : NOVALUE; ! RSX-to-XPORT completion code conversion routine %FI %IF $RSTS %THEN EXTERNAL ROUTINE XRST$OUT, ! File output routine XRST$ERROR : NOVALUE; ! RSTS-to_XPORT completion code conversion routine %FI %IF $RT11 %THEN EXTERNAL ROUTINE XRT$OUT; ! File output routine %FI GLOBAL ROUTINE XPO$PUT ( iob, success_action, failure_action ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine outputs a single record into the file described ! by the caller's IOB. ! ! FORMAL PARAMETERS: ! ! iob - address of IOB ! success_action - address of success action routine ! failure_action - address of failure action routine ! ! IMPLICIT INPUTS: ! ! Information contained in or pointed to by the caller's IOB ! ! IMPLICIT OUTPUTS: ! ! Various fields in the caller's IOB are updated to reflect ! the results of the requested I/O function ! ! COMPLETION CODES: (also returned in IOB$G_COMP_CODE) ! ! XPO$_NORMAL - the output operation was successful ! ! XPO$_BAD_IOB - invalid IOB ! (IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid IOB length) ! XPO$_BAD_REQ - invalid output request ! (IOB$G_2ND_CODE = XPO$_BAD_ADDR - invalid memory address ! or completion code from $STR_VALIDATE) ! XPO$_FREE_MEM - I/O buffer deallocation error ! (IOB$G_2ND_CODE = $XPO_FREE_MEM completion code) ! XPO$_GET_MEM - I/O buffer allocation error (TOPS-10) ! (IOB$G_2ND_CODE = $XPO_GET_MEM completion code) ! XPO$_IO_ERROR - I/O error writing file ! XPO$_NOT_OUTPUT - file is not open for output ! XPO$_NOT_OPEN - the file is not opened ! XPO$_TRUNCATED - the output record was truncated ! XPO$_SYS_ERROR - unexpected operating system error (VMS) ! ( IOB$G_2ND_CODE = completion code from LIB$GET_EF or LIB$FREE_EF) ! failure completion code from $XPO_GET_MEM (TOPS-10,TOPS-20,RSTS,RT-11) ! failure completion codes from X20$OUT (TOPS-20) ! failure completion codes from X20$ERROR (TOPS-20) ! failure completion codes from XPO$RMS_ERROR (VMS) ! failure completion codes from XRSX$IO_ERROR (11M) ! failure completion codes from XRST$ERROR (RSTS) ! failure completion codes from XRT$OUT (RT-11) ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); ! Redefine the IOB parameter BIND output = .iob[IOB$A_OUTPUT] : $STR_DESCRIPTOR();! Redefine the output data descriptor LOCAL output_length, ! length of output data pad_length, ! number of pad characters max_output_len; ! total output data length ! ! XPORT routine initialization. ! $XPO_MAIN_BEGIN( IO ) ! Define the MAIN_BLOCK code block ! and validate the caller's IOB. ! ! Validate the caller's IOB. ! IF NOT .iob[IOB$V_OPEN] ! If the file is not open, THEN ! $XPO_QUIT( NOT_OPEN ); ! return an error code to the caller. IF NOT .iob[IOB$V_OUTPUT] ! If the file is not open for output, THEN ! $XPO_QUIT( NOT_OUTPUT ); ! return an error code to the caller. IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] THEN $STR_VALIDATE( .iob[IOB$A_OUTPUT], ! Validate an output string descriptor (XPO$_BAD_REQ) ) ELSE IF output EQL 0 ! Validate an output data descriptor THEN $XPO_QUIT( BAD_REQ ); ! ! Setup for fixed length records. ! IF .iob[IOB$V_RECORD] AND ! If this is a fixed-length record file, .iob[IOB$G_REC_SIZE] GTR 0 ! THEN ! IF .output[STR$H_LENGTH] LEQ ! setup normal record and pad lengths .iob[IOB$G_REC_SIZE] ! THEN ! BEGIN ! output_length = .output[STR$H_LENGTH]; ! pad_length = .iob[IOB$G_REC_SIZE] - ! .output[STR$H_LENGTH]; ! END ! ELSE ! or setup truncated record and pad lengths. BEGIN output_length = .iob[IOB$G_REC_SIZE]; pad_length = 0; END ELSE ! If no output record length exists, BEGIN ! output_length = .output[STR$H_LENGTH]; ! setup the actual record length pad_length = 0; ! and indicate no padding is needed. END; max_output_len = .output_length + .pad_length; ! Calculate the total output length. !+ ! ! System-specific file output processing follows. ! !- %TITLE 'TOPS-10/TOPS-20/RT-11 Terminal PUT' %IF $TOPS10 OR $TOPS20 OR $RT11 %THEN !+ ! ! TOPS-10/TOPS-20/RT-11 PUT Processing ! !- BEGIN BIND buffer_cb = .iob[IOB$A_BUFFER_CB] : VECTOR; ! TOPS-10/TOPS-20 buffer control block LOCAL data_pointer; ! local pointer to output data !+ ! ! TOPS-10/TOPS-20 Terminal Output Processing ! !- IF .iob[IOB$V_TERMINAL] ! If the output file is a terminal, THEN ! perform special output processing. BEGIN LOCAL user_buff_ptr, ! pointer into user's output buffer local_term_buff : ! local terminal output buffer VECTOR[ CH$ALLOCATION(term_buff_len) ], term_buff_ptr; ! pointer to actual output buffer ! ! Output the string in one operation. ! IF .max_output_len LEQ term_buff_len - 3 ! If the local terminal buffer is ! large enough for the output string, THEN ! term_buff_ptr = CH$PTR( local_term_buff ) ! setup to use the local buffer. ELSE $XPO_IF_NOT( $XPO_GET_MEM( ! Otherwise, allocate a dynamic output buffer. CHARACTERS = .max_output_len + 3, RESULT = term_buff_ptr, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); user_buff_ptr = .output[STR$A_POINTER]; ! Setup "from" and "to" buffer pointers. data_pointer = .term_buff_ptr; INCR index FROM 1 TO .output_length DO ! Move the output string into a local buffer. BEGIN LOCAL character; character = CH$RCHAR_A( user_buff_ptr ); IF .character EQL null THEN CH$WCHAR_A( del, data_pointer ) ! Change NULLs to DELETEs. ELSE CH$WCHAR_A( .character, data_pointer ); END; data_pointer = CH$FILL( space, .pad_length, ! Pad the record with spaces if necessary. .data_pointer ); %IF NOT $RT11 %THEN IF .iob[IOB$V_RECORD] ! If this is record-mode output, THEN ! CH$MOVE( 3, CH$PTR( UPLIT( %STRING( ! add the following characters to the string: %CHAR( cr ), ! carriage return %CHAR( lf ), ! line feed %CHAR( null ) ) ) ), ! null .data_pointer ) ! ELSE CH$WCHAR( null, .data_pointer ); ! Otherwise, just add a null to the string. %FI %IF $TOPS10 %THEN $T10_OUTSTR( $XPO_ADDRESS(.term_buff_ptr) ); ! Send the string to the user's terminal. %FI %IF $TOPS20 %THEN IF NOT $T20_PSOUT( .term_buff_ptr ) ! Send the string to the user's terminal. THEN BEGIN LOCAL error; ! Storage area for error code. $T20_GETER( $FHSLF, error ); ! Get the TOPS-20 error code X20$ERROR( .iob, .error ); ! and convert it to the equivalent XPORT completion code, $XPO_QUIT(); ! and return to the caller. END; %FI %IF $RT11 %THEN IF .iob[IOB$V_RECORD] ! If this is record-mode output, THEN ! CH$WCHAR( null, .data_pointer ) ! append a null to the string to automatically get a crlf. ELSE ! CH$WCHAR( %O'200', .data_pointer ); ! Otherwise, indicate that we don't want a crlf. $PRINT( .term_buff_ptr ); ! Send the string to the user's terminal. %FI IF .term_buff_ptr NEQ CH$PTR(local_term_buff) ! If a dynamic output buffer was allocated, THEN ! $XPO_FREE_QUIT( ! free the buffer memory. STRING = (.max_output_len+3, .term_buff_ptr) ); ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after terminal output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'TOPS-10/TOPS-20/RT-11 File PUT' %IF $TOPS10 OR $TOPS20 OR $RT11 %THEN !+ ! ! TOPS-10/TOPS-20/RT-11 File Output Processing ! !- !+ ! Random access i/o has been implemented and tested for VMS. Though some code is in place to ! support random access i/o for TOPS-20 as well, it is NOT COMPLETE and is known to not be ! reliable. Therefor, a conditional check for use of the random attribute is in XPORT.REQ and ! XOPEN.BLI. When the TOPS20 code is completed and tested, this conditional can be changed to ! " %IF NOT $VMS OR NOT $TOPS20 %THEN " for XOPEN.BLI ! " %IF NOT %BLISS(BLISS32) OR NOT %BLISS(BLISS36) %THEN " for XPORT.REQ ! ! See also: ! XPORT.REQ - $XPO_OPEN definition, random disallowed. ! XOPEN.BLI - $IOB initialization, random disallowed. ! XGET.BLI - comments in 'TOPS-10/TOPS-20 Stream-mode and Binary-mode GET' ! XPUT.BLI - comments in 'TOPS-10/TOPS-20/RT-11 File PUT' !- ! ! Output sequenced-file information if necessary. ! %IF NOT $RT11 %THEN IF .iob[IOB$V_SEQUENCED] ! If this is a sequenced output file, THEN ! output form feeds and/or a line number. BEGIN LOCAL seq_number : VECTOR[5], ! sequence number character vector temp; ! temporary value WHILE (.BLOCK[buffer_cb[$BFPTR],0,30,6,0] ! Output nulls to the file until a buffer GTR 1 OR .buffer_cb[$BFCTR] LSS 10) DO ! word boundary is reached and at least put_file( null ); ! 2 unused words remain in the buffer. IF .iob[IOB$G_SEQ_NUMB] EQL 0 AND ! Test for an implicit page mark. .output_length EQL 0 AND CH$RCHAR( .output[STR$A_POINTER] ) EQL ff THEN BEGIN INCR count FROM 1 TO 5 DO ! Output a word of spaces (5) put_file( space ); ! .buffer_cb[$BFPTR] = ..buffer_cb[$BFPTR]+1; ! and turn on bit 35 of this word. ! Output the second word of a page mark: put_file( cr ); ! a single carriage return put_file( ff ); ! a single form feed INCR count FROM 1 TO 3 DO ! put_file( null ); ! 3 nulls $XPO_QUIT( NORMAL ); ! Return to the caller. END; WHILE .buffer_cb[$BFCTR] LSS 10 DO ! If the current buffer does not have 2 words left, put_file( null ); ! fill it with nulls. temp = .iob[IOB$G_SEQ_NUMB]; ! Pickup the current sequence number INCR count FROM 0 TO 4 DO ! and convert it to a vector of characters. BEGIN seq_number[ 4 - .count ] = ! Convert 1 decimal digit to character. .temp MOD 10 + %C'0'; temp = .temp / 10; ! Remove that digit from the number. END; INCR count FROM 0 TO 4 DO ! Output a sequence number word put_file( .seq_number[.count] ); ! .buffer_cb[$BFPTR] = ..buffer_cb[$BFPTR]+1; ! and turn on bit 35 of this word. put_file( ht ); ! Output a tab to follow the sequence number. END; ! ! Setup a character string pointer or binary data pointer. ! IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a character file, THEN ! data_pointer = .output[STR$A_POINTER] ! pickup the pointer to the output string. ELSE data_pointer = ! Otherwise, construct a binary data pointer. CH$PTR( .output[STR$A_POINTER], 0, %BPVAL ); %FI %IF $RT11 %THEN data_pointer = .output[STR$A_POINTER]; ! Always an 8-bit pointer for RT-11. %FI ! ! Position the file for random I/O ! %IF $TOPS20 %THEN IF .iob[IOB$V_RANDOM] THEN BEGIN LOCAL file_pos ; ! IF .iob[IOB$G_REC_NUMB] EQL 0 ! THEN ! BEGIN ! file_pos = .iob[IOB$G_PREV_REC] ; ! Perform sequential I/O because no new record number was given ! iob[IOB$G_PREV_REC] = .iob[IOB$G_PREV_REC ] + .iob[IOB$H_FULLWORDS] ; ! END ! ELSE ! BEGIN ! file_pos = .iob[IOB$G_REC_NUMB] ; ! Go to the indicated record ! iob[IOB$G_PREV_REC] = .iob[IOB$G_REC_NUMB ] + ! .iob[IOB$H_FULLWORDS] ; ! END ; file_pos = .iob[IOB$G_NEXT_POS]; $T20_SFPTR ( .iob[IOB$H_CHANNEL], .file_pos ) ; ! And position file ! ! If the last operation was a GET, then the buffer pointer and address must ! be reset. ! IF .iob[$IOB$FILLER2] EQL 1 THEN BEGIN buffer_cb[$BFPTR] = ! make the pointer a fullword pointer CH$PTR( .buffer_cb[$BFADR], 0, %BPVAL ); ! buffer_cb[$BFCTR] = X20$K_BUFFER_SZ; ! and set the counter in terms of words. END ; ! of IF .iob[IOB$FILLER2] iob[$IOB$FILLER2] = 2 ; ! Indicate the the last operation was a PUT END ; %FI ! ! Output the requested number of characters/units. ! INCR count FROM 1 TO .output_length DO ! Output one character/value at a time. put_file( CH$RCHAR_A( data_pointer ) ); INCR count FROM 1 TO .pad_length DO ! Add any necessary padding characters. put_file( space ); ! ! For RANDOM I/O files, we must "flush" the output buffer after each WRITE ! %IF $TOPS20 %THEN IF .iob[IOB$V_RANDOM] THEN BEGIN X20$OUT ( .iob ) ; iob[IOB$G_CURR_POS] = .iob[IOB$G_NEXT_POS]; iob[IOB$G_NEXT_POS] = .iob[IOB$G_NEXT_POS] + .iob[IOB$H_UNITS]; END; %FI ! ! Add a carriage return and line feed to the end of an output record. ! IF .iob[IOB$V_RECORD] ! If this a character record file, THEN ! BEGIN ! put_file( cr ); ! add a carriage return and put_file( lf ); ! a line feed to the end of the record. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after file output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; ! End of TOPS-10-specific processing !+ ! ! End of TOPS-10/TOPS-20/RT-11 PUT Processing ! !- %FI %TITLE 'VAX/VMS Terminal Output' %IF $VMS %THEN !+ ! ! VAX/VMS PUT Processing ! !- !+ ! ! VAX/VMS Terminal Output Processing ! ! NOTE: This code is very similar to the corresponding code for RSX-11M. ! !- IF .iob[IOB$V_TERMINAL] ! If the output file is a terminal, THEN ! perform special output processing. BEGIN LOCAL control, ! QIO control code status : $IOSB, ! QIO status block event_flag; ! Event flag number for QIOW ! ! Output a single record/string to the terminal. ! IF .iob[IOB$V_RECORD] ! If this is a record-mode file, THEN ! control = %X'80800000' + cr^24 + lf^16 ! setup for single spacing. ELSE control = 0; ! Otherwise, don't do any automatic carriage control. $XPO_IF_NOT ( LIB$GET_EF ( event_flag ) ) ! Allocate an event flag THEN ! If the allocation failed, $XPO_QUIT( SYS_ERROR, (.$XPO_STATUS) ); ! return these codes to the caller. $QIOW( FUNC = IO$_WRITELBLK, ! Write a record/stream to the terminal: EFN = .event_flag, ! Event flag number CHAN = .iob[IOB$H_CHANNEL], ! QIO channel number IOSB = status, ! address of QIO status block P1 = .output[STR$A_POINTER], ! address of output data P2 = .output_length, ! length of output data P4 = .control ); ! carriage control indicator $XPO_IF_NOT ( LIB$FREE_EF ( event_flag ) ) ! Free the allocated event flag THEN ! If the free failed, $XPO_QUIT( SYS_ERROR, (.$XPO_STATUS) ); ! return these codes to the caller. IF NOT .status[IOSB$H_STATUS] ! If the QIO operation failed, THEN ! BEGIN ! XPO$RMS_ERROR( .iob, ! convert the QIO error code into XPORT completion codes .status[IOSB$H_STATUS], 0 ); ! $XPO_QUIT(); ! and return these codes to the caller. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the terminal output was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after successful character output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'VAX/VMS Character-mode File PUT' %IF $VMS %THEN !+ ! ! VAX/VMS Character-mode File PUT Processing ! !- BEGIN BIND rab = .iob[IOB$A_RMS_RAB] : $RAB_DECL; ! Define the IOB's RAB LOCAL sequence_number : WORD; IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a record-mode or stream-mode file, THEN ! execute the following block. BEGIN ! ! Setup a local sequence number. ! IF .iob[IOB$V_SEQUENCED] THEN IF .iob[IOB$G_SEQ_NUMB] EQL 0 AND ! If this is an implicit page mark, .output_length EQL 1 AND ! CH$RCHAR(.output[STR$A_POINTER]) EQL ff ! THEN ! sequence_number = %X'FFFF' ! setup a maximum sequence number. ELSE sequence_number = .iob[IOB$G_SEQ_NUMB]; ! Otherwise, use the caller's sequence number. ! ! Output a single record or character stream. ! ! Setup the RAB for a PUT: rab[RAB$L_RBF] = .output[STR$A_POINTER]; ! address of record text rab[RAB$W_RSZ] = .output_length; ! size of the record rab[RAB$L_RHB] = sequence_number; ! address of sequence number IF NOT $RMS_PUT( RAB = rab ) ! If the output is not successful, THEN ! BEGIN XPO$RMS_ERROR( .iob, ! convert the RMS completion codes .rab[RAB$L_STS], ! into appropriate XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return an error to the caller. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after successful character output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'VAX/VMS Binary-mode File PUT' %IF $VMS %THEN !+ ! ! VAX/VMS Binary-mode File PUT Processing ! !- IF .iob[IOB$V_BINARY] AND NOT .iob[IOB$V_RANDOM] THEN ! If this is a binary-mode file put, BEGIN ! execute the following block. MACRO amt_buff_used = rab[RAB$L_CTX] %; ! Amount used in the XPORT internal output buffer LOCAL amt_buff_left, ! Amount of space left in the XPORT internal output buffer output_address; ! Dynamic pointer to the output data ! ! Move binary output data into the XPORT internal output buffer. ! output_address = .output[STR$A_POINTER]; ! Setup the output data pointer. WHILE .output_length GTR 0 DO ! Loop until all the output data has been processed. BEGIN amt_buff_left = .rab[RAB$W_USZ] - ! Calculate how much space is left in the output buffer. .amt_buff_used; IF .output_length LSS .amt_buff_left ! If the output data will not fill the buffer, THEN ! BEGIN ! CH$MOVE( .output_length, .output_address, ! move the data into the buffer, .rab[RAB$L_UBF] + .amt_buff_used ); ! amt_buff_used = .amt_buff_used + ! increment the buffer used amount, .output_length; ! output_length = 0; ! and indicate all output data has been processed. END ELSE BEGIN CH$MOVE( .amt_buff_left, .output_address, ! Otherwise, fill the output buffer, .rab[RAB$L_UBF] + .amt_buff_used ); ! output_length = .output_length - ! decrement the output data length, .amt_buff_left; ! output_address = .output_address + ! and increment the output data address. .amt_buff_left; ! ! Write out a completed output buffer. ! rab[RAB$W_RSZ] = .rab[RAB$W_USZ]; ! Setup the output block length rab[RAB$L_RBF] = .rab[RAB$L_UBF]; ! and address of the data buffer. IF $RMS_WRITE( RAB = rab ) ! If the write operation is successful, THEN ! amt_buff_used = 0 ! indicate that the output buffer is empty. ELSE BEGIN XPO$RMS_ERROR( .iob, ! Otherwise, convert the RMS completion codes .rab[RAB$L_STS], ! into appropriate XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return an error to the caller. END; END; END; ! End of the output processing loop. ! ! Return to the caller after all binary output data has been processed. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; ! End of binary output processing. %FI %TITLE 'VAX/VMS Random Binary-mode File PUT' %IF $VMS %THEN !+ ! VAX/VMS Random Binary-mode PUT Processing ! ! Implicit inputs: ! IOB$G_NEXT_POS - the byte after the last read/write ! amt_buff_used (rab[RAB$L_CTX]) - indicates modified data in the XPORT internal output buffer ! set by XPO$PUT, cleared by XPO$GET and XPO$CLOSE ! ! Implicit outputs: ! IOB$G_CURR_POS - the byte starting the current write ! amt_buff_used (rab[RAB$L_CTX]) - indicates modified data in the XPORT internal output buffer ! tested by XPO$PUT, XPO$GET and XPO$CLOSE !- IF .iob[IOB$V_RANDOM] THEN BEGIN BIND fab = .iob[IOB$A_RMS_FAB] : $FAB_DECL, ! Define the IOB's FAB rab = .iob[IOB$A_RMS_RAB] : $RAB_DECL; ! and RAB. MACRO amt_buff_used = rab[RAB$L_CTX] %, ! Indicates modified data in the XPORT internal output buffer requested_block = ( ( .next_pos / .rab[RAB$W_USZ] ) + 1 ) %, ! VBN is 1 origin requested_unit = ( .next_pos MOD .rab[RAB$W_USZ] ) %; ! byte in block LOCAL move_amt, ! Amount of data to move after a given $RMS_READ next_pos, ! Position in file of requested characters/units output_address; ! Dynamic pointer to the output data !+ ! Begin executable code !- next_pos = .iob[IOB$G_NEXT_POS]; ! Pickup the position of requested units output_address = .output[STR$A_POINTER]; ! Setup the output data pointer. WHILE .output_length GTR 0 DO ! Loop until all the output data has been processed. BEGIN !+ ! A copy of the disk block is modified in memory, ! so before a block can be written to, it must be read. !- IF requested_block NEQ .rab[RAB$L_RFA0] ! If the block has not been read into the buffer, THEN ! BEGIN ! IF .amt_buff_used NEQ 0 ! and there is modified data in the buffer THEN ! BEGIN ! then flush the buffer to disk. rab[RAB$W_RSZ] = .rab[RAB$W_USZ]; ! Setup the output block length rab[RAB$L_RBF] = .rab[RAB$L_UBF]; ! and address of the data buffer. IF $RMS_WRITE( RAB = rab ) ! If the write operation is successful, THEN ! amt_buff_used = 0 ! indicate that the output buffer is empty. ELSE BEGIN XPO$RMS_ERROR( .iob, ! Otherwise, convert the RMS completion codes .rab[RAB$L_STS], ! into appropriate XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return an error to the caller. END; END; rab[RAB$L_BKT] = requested_block; ! Now specify the block to read $RMS_READ( RAB = rab ); ! and read a single block. IF NOT .rab[RAB$L_STS] ! If there was an RMS read error AND .rab[RAB$L_STS] NEQ RMS$_EOF ! other than end of file, THEN BEGIN ! XPO$RMS_ERROR( .iob, ! Convert the RMS completion codes into .rab[RAB$L_STS], ! equivalent XPORT completion codes .rab[RAB$L_STV] ); ! $XPO_QUIT(); ! and then jump to return to the caller. END; CH$FILL ( 0, ! Initialize buffer beyond EOF .rab[RAB$W_USZ] - .rab[RAB$W_RSZ], .rab[RAB$L_RBF] + .rab[RAB$W_RSZ] ); END; ! ! Move binary output data into the XPORT internal output buffer. ! move_amt = MINU ( ! amount to move is the minimum of .output_length, ! the requested length to write .rab[RAB$W_USZ] - requested_unit ); ! and the amount of space available CH$MOVE( .move_amt, ! move the data .output_address, ! from the user's buffer .rab[RAB$L_UBF] + requested_unit ); ! to the XPORT internal output buffer output_length = .output_length - .move_amt; ! update the pointers to the user's data output_address = .output_address + .move_amt; amt_buff_used = .rab[RAB$W_USZ]; ! Indicate that the output buffer contains modified data, ! so that it will be written to disk next time around. next_pos = .next_pos + .move_amt; ! update the file pointer (requested_block and requested_byte) END; ! of WHILE output processing loop. iob[IOB$G_CURR_POS] = .iob[IOB$G_NEXT_POS]; ! position just written to (in UNITS) iob[IOB$G_NEXT_POS] = .next_pos; ! next position to write to (in UNITS) ! ! Return to the caller after all binary output data has been processed. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; ! End of IF .iob[IOB$V_RANDOM] END; ! End of VAX/VMS PUT processing. !+ ! ! End of VAX/VMS PUT Processing ! !- %FI %TITLE 'RSX-11M Terminal Output' %IF $11M %THEN !+ ! ! RSX-11M PUT Processing ! !- !+ ! ! RSX-11M Terminal Output Processing ! ! NOTE: This code is very similar to the corresponding code for VAX/VMS. ! !- IF .iob[IOB$V_TERMINAL] ! If the output file is a terminal, THEN ! perform special output processing. BEGIN LOCAL control, ! QIO control code status : $QIO_STATUS; ! QIO status block ! ! Output a single record/string to the terminal. ! IF .iob[IOB$V_RECORD] ! If this is a record-mode file, THEN ! control = %O'040' ! setup for single spacing. ELSE control = 0; ! Otherwise, don't do any automatic carriage control. QIOW$S( IO$WVB, ! Write a "virtual block" to the terminal: .iob[IOB$H_CHANNEL], ! LUN .XRSX$EVENT_FLAG,, ! event flag number status,, ! address of QIO status block < .output[STR$A_POINTER], ! address of output data .output_length, ! length of output data .control > ); ! carriage control indicator IF .status[QS$ERR] NEQ IS$SUC ! If writing to the terminal fails, THEN ! BEGIN ! XRSX$IO_ERROR( .iob, .status[QS$ERR] ); ! convert the QIO error code to XPORT completion codes $XPO_QUIT(); ! and return these codes to the caller. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the terminal output was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after successful character output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'RSX-11M Record-mode and Stream-mode File PUT' %IF $11M %THEN !+ ! ! RSX-11M Record-mode and Stream-mode File PUT Processing Processing ! !- BEGIN BIND ! Declare the FCS control blocks fcs_blocks = .iob[IOB$A_FCS_FDB] : $FCS_BLOCKS, fdb = fcs_blocks[FCS$Z_FDB] : FDB$; IF .iob[IOB$V_RECORD] OR .iob[IOB$V_STREAM] ! If this is a record-mode or stream-mode file, THEN ! execute the following block. BEGIN ! ! Setup an appropriate record sequence number in the FAB. ! IF .iob[IOB$V_SEQUENCED] THEN IF .iob[IOB$G_SEQ_NUMB] EQL 0 AND ! If this is an implicit page mark, .output_length EQL 1 AND ! CH$RCHAR(.output[STR$A_POINTER]) EQL ff ! THEN ! fdb[F$SEQN] = %X'FFFF' ! setup a maximum sequence number. ELSE fdb[F$SEQN] = .iob[IOB$G_SEQ_NUMB]; ! Otherwise, use the caller's sequence number. ! ! Output a single record or character stream. ! IF NOT PUT$( fdb, ! Output the record/string: .output[STR$A_POINTER], ! address of the output record/string .output_length ) ! length of the output record/string THEN BEGIN ! If the output fails, XRSX$IO_ERROR( .iob, ! convert the FCS-11 competion code into .fdb[F$ERR] ); ! appropriate XPORT completion codes $XPO_QUIT(); ! and then jump to return an error to the caller. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after successful character output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'RSX-11M Binary-mode PUT' %IF $11M %THEN !+ ! ! RSX-11M Binary-mode PUT Processing ! !- BEGIN LOCAL amt_buff_left, ! Amount of space left in the XPORT internal output buffer output_address; ! Dynamic pointer to the output data ! ! Move binary output data into the XPORT internal output buffer. ! output_address = .output[STR$A_POINTER]; ! Setup the output data pointer. WHILE .output_length GTR 0 DO ! Loop until all the output data has been processed. BEGIN amt_buff_left = .fdb[F$BKDS$S] - ! Calculate how much space is left in the output buffer. .fcs_blocks[FCS$G_BUFF_USED]; IF .output_length LSS .amt_buff_left ! If the output data will not fill the buffer, THEN ! BEGIN ! CH$MOVE( .output_length, .output_address, ! move the data into the buffer, .fdb[F$BKDS$A] + ! .fcs_blocks[FCS$G_BUFF_USED] ); ! fcs_blocks[FCS$G_BUFF_USED] = ! increment the buffer used amount, .fcs_blocks[FCS$G_BUFF_USED] + ! .output_length; ! output_length = 0; ! and indicate all output data has been processed. END ELSE BEGIN CH$MOVE( .amt_buff_left, .output_address, ! Otherwise, fill the output buffer, .fdb[F$BKDS$A] + ! .fcs_blocks[FCS$G_BUFF_USED] ); ! output_length = .output_length - ! decrement the output data length, .amt_buff_left; ! output_address = .output_address + ! and increment the output data address. .amt_buff_left; ! ! Write out a completed output buffer. ! WRITE$( fdb ); IF .fdb[F$ERR] EQL IS$SUC THEN WAIT$( fdb ); IF .fdb[F$ERR] EQL IS$SUC ! If the write operation is successful, THEN ! fcs_blocks[FCS$G_BUFF_USED] = 0 ! indicate that the output buffer is empty. ELSE BEGIN XRSX$IO_ERROR( .iob, .fdb[F$ERR] ); $XPO_QUIT(); END; END; END; ! End of the output processing loop. ! ! Return to the caller after all binary output data has been processed. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; ! End of binary output processing. END; ! End of RSX-11M PUT processing. !+ ! ! End of RSX-11M PUT Processing ! !- %FI %TITLE 'RSTS/E Terminal PUT' %IF $RSTS %THEN !+ ! ! RSTS/E PUT Processing ! ! NOTE: This code is very similar to the TOPS10/TOPS20/RT11 PUT processing code. ! !- BEGIN BIND buffer_cb = .iob[IOB$A_RSTS_CB] : $XRSTS_CB; ! RSTS/E buffer control block LOCAL data_pointer; ! local pointer to output data !+ ! ! RSTS/E Terminal Output Processing ! !- IF .iob[IOB$V_TERMINAL] ! If the output file is a terminal, THEN ! perform special output processing. BEGIN LOCAL local_term_buff : ! local terminal output buffer VECTOR[ CH$ALLOCATION(term_buff_len) ], term_buff_ptr; ! pointer to actual output buffer ! ! Output the string in one operation. ! IF .max_output_len LEQ term_buff_len - 2 ! If the local terminal buffer is ! large enough for the output string, THEN ! term_buff_ptr = CH$PTR( local_term_buff ) ! setup to use the local buffer. ELSE $XPO_IF_NOT( $XPO_GET_MEM( ! Otherwise, allocate a dynamic output buffer. CHARACTERS = .max_output_len + 2, RESULT = term_buff_ptr, FAILURE = 0 ) ) THEN $XPO_QUIT( GET_MEM, (.$XPO_STATUS) ); data_pointer = CH$MOVE( .output_length, ! Move the output string into a buffer. .output[STR$A_POINTER], .term_buff_ptr ); data_pointer = CH$FILL( space, .pad_length, ! Pad the record with spaces if necessary. .data_pointer ); IF .iob[IOB$V_RECORD] ! If this is record-mode output, THEN ! BEGIN ! CH$MOVE( 2, CH$PTR( UPLIT( %STRING( ! add the following characters to the string: %CHAR( cr ), ! carriage return %CHAR( lf ) ) ) ), ! line feed .data_pointer ); max_output_len = .max_output_len +2; END; $XRSTS_INI_FIRQB; ! Initialize the FIRQB. $XRSTS_INI_XRB; ! Initialize the XRB. ! Setup the XRB: $XRSTS_XRB[XRLEN] = .max_output_len; ! length of output buffer $XRSTS_XRB[XRBC] = .max_output_len; ! number of bytes to be written $XRSTS_XRB[XRLOC] = .term_buff_ptr; ! starting address of buffer $XRSTS_XRB[XRCI] = 0; ! channel number times 2 (user's terminal is always 0) $WRITE; ! Output the string. IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0 ! Report any errors. THEN BEGIN XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] ); $XPO_QUIT(); END; ! ! Free the dynamic output buffer ! IF .term_buff_ptr NEQ CH$PTR(local_term_buff) ! If a dynamic output buffer was allocated, THEN ! $XPO_FREE_QUIT( ! free the buffer memory. STRING = (.max_output_len, .term_buff_ptr) ); ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after terminal output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; %FI %TITLE 'RSTS/E File PUT' %IF $RSTS %THEN !+ ! ! RSTS/E File Output Processing ! !- ! ! Setup a character string pointer or binary data pointer. ! data_pointer = .output[STR$A_POINTER]; ! ! Output the requested number of characters/units. ! INCR count FROM 1 TO .output_length DO ! Output one character/value at a time. put_file( CH$RCHAR_A( data_pointer ) ); INCR count FROM 1 TO .pad_length DO ! Add any necessary padding characters. put_file( space ); ! ! Add a carriage return and line feed to the end of an output record. ! IF .iob[IOB$V_RECORD] ! If this a character record file, THEN ! BEGIN ! put_file( cr ); ! add a carriage return and put_file( lf ); ! a line feed to the end of the record. END; ! ! Check for truncated output. ! IF .output[STR$H_LENGTH] GTR .output_length ! If the output record was truncated, THEN ! $XPO_QUIT( TRUNCATED ); ! return an error code to the caller. ! ! Return to the caller after file output. ! $XPO_QUIT( NORMAL ); ! Jump to return to the caller. END; ! End of RSTS/E specific processing !+ ! ! End of RSTS/E PUT Processing ! !- %FI %TITLE 'XPO$PUT Routine Termination' !+ ! ! Continuation of system-independent file open processing ! !- ! ! End of MAIN_BLOCK code block. ! $XPO_MAIN_END; ! Terminate MAIN_BLOCK. ! ! Call an appropriate action routine. ! $XPO_ACTION_RTN( .iob ); ! Call a success or failure action routine. ! ! Free a temporary output string. ! IF ( .iob[IOB$A_OUTPUT] NEQ 0 AND .iob[IOB$V_RECORD] ) OR ( .iob[IOB$A_OUTPUT] NEQ 0 AND .iob[IOB$V_STREAM] ) THEN IF $STR_FREE_TEMP( .iob[IOB$A_OUTPUT] ) THEN iob[IOB$A_OUTPUT] = 0; ! ! Return to the caller. ! RETURN .iob[IOB$G_COMP_CODE] ! Return the IOB completion code to the caller. END; ! End of XPO$PUT routine END ELUDOM