Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmsrre.b36
There are 3 other files named rmsrre.b36 in the archive. Click here to see a list.
MODULE RRECORD ( ! DAP Data Record Operations ! (formerly GETPUT)
IDENT = '3(624)'
%BLISS36(,ENTRY(
Dap$Get,
Dap$$Get,
Dap$Put,
Dap$Update,
Dap$$Put,
Dap$Crc,
Dap$Handle
))
) =
BEGIN
!
! COPYRIGHT (c) 1981, 1986 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: DAP
!
! ABSTRACT: Routines to transfer records or blocks of file data.
!
!
! ENVIRONMENT: RMS, BLISSNET, XPORT, Some 36-bit specific code.
!
! AUTHOR: Andrew Nourse, CREATION DATE: 3-Jan-82
!
! 624 - Double-word byte rotations for image $GETs were requiring
! a user buffer to be an even number of words, else end+1
! word was overwritten.
! 613 - Add DIL8 type class to support DIL formatted 8-bit
! records generated (only) by DIU
! 577 - Fix random block mode
! 574 - Clear recordsize at start of remote get
! 573 - Return correct error on invalid access information
! 572 - Handle fatal error better
! 561 - Fix $Update
! 557 - Fix multistream
! 555 - Fix image mode recordsize lossage
! 511 12 - Fix VMS ASCII
! 11 - Remove shell routines and RMS-ify. Implement DAP$UPDATE.
! 10 - Provide dap$$get and dap$$put entry points
! Move all pure data to hiseg
! 07 - Eat residue of message if data-overrun
! 06 - improve record size checking
! 05 - Adjust message size to account for byte size
! 04 - Put in ENTRY points
! 03 - Don't reinit descriptor after setting it up for ASCII
! 02 - Workaround RMS-20/FAL-20 habit of leaving CRLFs on records
! 01 - The beginning
!--
!
! CONDITIONAL COMPILATION:
!
COMPILETIME FTPASSIVE=(%VARIANT AND 2) NEQ 0; ! /VARIANT:2 for FAL
! Interlock. Makes sure all modules compiled correct variant
! Link error (multiply-defined global symbol) if wrong
GLOBAL LITERAL RRE$$P = FTPASSIVE;
!
! INCLUDE FILES:
!
REQUIRE 'RMSREQ';
!LIBRARY 'BLI:XPORT';
!LIBRARY 'RMS';
LIBRARY 'BLISSNET';
LIBRARY 'CONDIT';
!LIBRARY 'DAP';
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
Dap$Get,
Dap$$Get,
Dap$Put,
Dap$$Put,
Dap$Crc: NOVALUE,
Dap$Handle; ! Condition handler
!
! MACROS:
!
MACRO BREAK_CHARACTERS= %O'12' TO %O'14', %O'20' TO %O'24', %O'32', %O'33' %;
! <ESC><^Z><DC1-4><DLE><FF><VT> and <LF>
MACRO ROTC(LOW_AC,BITS)=MACHOP(%O'245',LOW_AC,BITS) %;
! Rotate-combined (LOW_AC is the lower of 2 contiguous accumulators)
!
! EQUATED SYMBOLS:
!
%IF %BLISS(BLISS36)
%THEN
LITERAL Ma_Return = 1;
%FI
!LITERAL $Chcrt=%O'15', ! Carriage return
! $Chlfd=%O'12'; ! Linefeed
LITERAL Loac=6, ! Ac's to user for
Hiac=7; ! ROTC
!
! PURE DATA:
!
PSECT OWN=$HIGH$;
OWN T_Crlf: INITIAL (%ASCII %STRING(%CHAR(13),%CHAR(10))),
D_Crlf: $Str_Descriptor(String=(2,CH$PTR(T_Crlf)));
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
Dap$Get_Byte,
Dap$Put_Byte,
Dap$Get_2Byte,
Dap$Put_2Byte,
Dap$Get_Message,
Dap$Put_Message,
Dap$Get_Variable_String,
Dap$Get_String,
Dap$Get_Status,
Dap$Get_Header,
Dap$Put_String,
Dap$Put_Control,
Dap$Put_Header,
Dap$Get_Ack,
Dap$Unget_Header,
Dap$Error_Dap_Rms,
Dap$Eat_Message,
R$Null,
UAPointer,
TGUPointer,
UAddr;
GLOBAL ROUTINE Dap$Get (P_Rab: REF $Rab_Decl,
Err) = ! Get a record (remote)
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a record from an open file on another system
!
! FORMAL PARAMETERS:
!
! P_RAB: Addr of RAB
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
!--
BEGIN
BIND
Rab=.P_Rab: $Rab_decl,
Rst=.Rab[Rab$a_Isi]: $Rms_Rst;
Dap$$Get(Rab, Rst, .Err) ! Call DAP$$GET to do the work
END; ! using the DIB pointed to by the FAB
GLOBAL ROUTINE Dap$$Get (P_Rab: REF $Rab_Decl,
P_Rst: REF $Rms_Rst,
P_Err) = ! Get a record (remote)
!++
! FUNCTIONAL DESCRIPTION:
!
! Get a record from an open file on another system
!
! FORMAL PARAMETERS:
!
! P_RAB: Address of RAB
! P_RST: Address of RST
! P_ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
!--
BEGIN
BIND
Rab=.P_Rab: $Rab_Decl,
Rst=.P_Rst: $Rms_Rst,
Fst=.Rst[Rst$a_Fst]: $Rms_Fst,
Config=.Fst[Fst$a_Config]: $XabCfg_decl,
Fab=UAddr(.Rab[Rab$a_Fab]): $Fab_decl, !m506
Idd=.Fst[Fst$a_I_Dd]: $Dap_Descriptor,
Odd=.Fst[Fst$a_O_Dd]: $Dap_Descriptor,
Typ=UAddr(.Fab[Fab$a_Typ]): $Typ_Decl; !m506
BIND ROUTINE $$Errrtn=.P_Err: Rms_Ercal;
LOCAL class;
LOCAL Adata: $Str_Descriptor(),
Bdata: $Xpo_Descriptor();
LOCAL Bytes_Per_Word;
LOCAL Display: BITVECTOR[28];
LOCAL Rabsav: VOLATILE;
LOCAL Errsav: VOLATILE;
ENABLE Dap$Handle(Rabsav,Errsav); ! Set up condition handler
Errsav=$$Errrtn; ! Handler will need these
Rabsav=Rab; !
Clearv(Display);
UsrSts = Rms$_Suc; ! Assume success will occur !a560
UsrStv = 0; !a560
class = .Fst[Fst$h_File_Class]; !a541 use FST file class if present
Rab[Rab$h_Rsz] = 0; ! Clear his record size !a574
IF .class EQL 0
THEN
BEGIN
IF Typ NEQ 0
THEN class=.Typ[Typ$h_Class] ! Use TYP block if any
ELSE class= Typ$k_Ascii;
END;
IF (.Rab[Rab$b_Rac] EQL Rab$k_Blk)
OR (.Rab[Rab$b_Rac] EQL Rab$k_Bft)
THEN class = Typ$k_Image;
IF .Rst[Rst$v_No_Send_Control] EQL 0 ! Send control on first GET only
THEN ! if file transfer mode,
BEGIN ! otherwise, on every GET
LOCAL rac;
rac=.Rab[Rab$b_Rac];
Dap$Put_Control( Odd, Rab, Dap$k_Get, Display );
Dap$Put_Message( Odd );
IF (.rac EQL Rab$k_Seq) ! Seq turns to transfer mode if
AND NOT .config[xab$v_sequential_access] ! not supported
THEN rac = Rab$k_Tra; ! It can't, use file xfer mode
SELECT .rac OF
SET
[Rab$k_Tra, Rab$k_Bft]: ! If File transfer mode
Rst[Rst$v_No_Send_Control]=1; ! No more ctl messages
TES;
END;
Bytes_per_Word = %BPUNIT / .Fst[Fst$h_Bsz]; ! How many bytes fit a word
DO BEGIN
SELECT Dap$Get_Header(Idd) OF
SET
[Dap$k_Data]:
BEGIN ! Process data from remote
IF .Fst[Fst$v_Accopt_Crc]
THEN
BEGIN
Dap$Crc( Idd, Rst ); ! Note that this eats the message!
Dap$Unget_Header( Idd ); ! Restore message !a561
Dap$Get_Header( Idd ); ! Re-read header !a561
END;
Rab[Rab$g_Rfa]=Get_Vbn(Idd);
Rab[Rab$a_Rbf]=.Rab[Rab$a_Ubf]; ! Use user's buffer
CASE .class FROM 0 TO Typ$k_Class_Max OF
SET
[Typ$k_Ascii]:
BEGIN ! Ascii File !m560vv
Rst[Rst$h_Record_Size] !m561
= Rab[Rab$h_Rsz]
= .Idd[Dap$h_Length] - .Fab[Fab$b_Fsz];
IF .Rab[Rab$h_Rsz] GTR (.Rab[Rab$h_Usz]*.Bytes_Per_Word)
THEN ![6] record too big
BEGIN
UsrSts = Rms$_Rtb;
UsrStv = .Rab[Rab$h_Rsz]; ! real recsize
Rab[Rab$h_Rsz] = (.Rab[Rab$h_Usz]*.Bytes_Per_Word)
- .Fab[Fab$b_Fsz] ; !what user got
Dap$Eat_Message( Idd ); ![7]
EXITLOOP Rms$_Rtb; ! Exit the loop, don't return
END; !m560^^
$Str_Desc_Init( Descriptor=Adata,
String=(.Rab[Rab$h_Usz]*.Bytes_per_word,
UAPointer(CH$PTR(.Rab[Rab$a_Ubf],
0, !offset!m511
.Fst[Fst$h_Bsz]
)
)
)
);
IF .Fab[Fab$b_Fsz] NEQ 0 !a555vv
THEN
BEGIN
IF .Fab[Fab$v_Rfm] EQL Fab$k_Lsa ! Sequenced
THEN Rab[Rab$h_Lsn] = Dap$Get_2Byte( Idd )
ELSE
BEGIN
LOCAL fhdrbuf: VECTOR[CH$ALLOCATION(20)],
hdrdesc: $Str_Descriptor();
$Str_Desc_Init( Desc=hdrdesc,
String=(20,
CH$PTR(fhdrbuf, 0, 8) ));
Dap$Get_String( Idd, hdrdesc );
END;
END; !a555^^
Dap$Get_String( Idd, Adata );
END; ! Ascii
%IF %BLISS(BLISS36) ! 36-bit dependant code follows
%THEN
[Typ$k_Image, Typ$k_DIL8]:
!+
! 9 bytes for every 2 words packed this way:
! !========================================!
! !..5! 4 ! 3 ! 2 ! 1 !
! !========================================!
! ! 9 ! 8 ! 7 ! 6 ! 5...
! !========================================!
!-
BEGIN ! Binary file
REGISTER
a=Loac,
b=Hiac;
LOCAL ptr: REF VECTOR; ! Pointer to buffer
LOCAL rsizw; !a555
LOCAL uszc; ! USZ range check !624
ptr=UAddr(.Rab[Rab$a_Ubf]);
uszc = .Rab[Rab$h_Usz]; ! 624
!+
! Calculate record size in words
!-
RSizW = (.Idd[Dap$h_Length]/9)
+((.Idd[Dap$h_Length]+4)/9); !m555
IF (.Rab[Rab$b_Rac] EQL Rab$k_Blk) !M566
OR (.Rab[Rab$b_Rac] EQL Rab$k_Bft) !M566
THEN Rab[Rab$h_Rsz] = .RsizW ! block mode
ELSE
!+
! Calculate the record size in record bytes:
!
! Size in words * bytes per word
! less extra bytes at end of last word.
!
! Extra bytes at end of last word is calculated
! from the bitcnt after adjusting it for the extra
! 4 bits we send if the word count is odd, and
! the number of extra bits in every word.
!-
Rab[Rab$h_Rsz]
= .RSizW * (%BPUNIT/.Fst[Fst$h_Bsz])
- ( ( .Idd[Dap$h_Bitcnt]
- (%BPUNIT MOD .Fst[Fst$h_Bsz])
- ((.RSizW AND 1) * 4) )
/ .Fst[Fst$h_Bsz] );
Rst[Rst$h_Record_Size] = .Rab[Rab$h_Rsz]; !a561
IF .RSizW GTR .Rab[Rab$h_Usz] !a560vv
THEN ! record too big
BEGIN
UsrSts = Rms$_Rtb;
UsrStv = .Rab[Rab$h_Rsz]; ! real recsize
Rab[Rab$h_Rsz] =
.Rab[Rab$h_Usz] * (%BPUNIT/.Fst[Fst$h_Bsz])
- ( ( .Idd[Dap$h_Bitcnt]
- (%BPUNIT MOD .Fst[Fst$h_Bsz])
- ((.RSizW AND 1) * 4) )
/ .Fst[Fst$h_Bsz] );
Dap$Eat_Message( Idd );
EXITLOOP Rms$_Rtb;
END;
DECR i FROM (.Idd[Dap$h_Length]/9)-1 TO 0
DO
BEGIN
a=b=0;
DECR j FROM 8 TO 0 ! Do 9 times
DO ( a=.a+Dap$Get_Byte(Idd); ! Get a byte
Rotc(a,-8) ); ! Rotate
ptr[0]=.a; ! Write to user's buffer
ptr[1]=.b; ! two words
ptr=.ptr+2; ! Increment the pointer
uszc=.uszc-2; ! Decrement USZ count !624
END;
a=b=0;
! If the DAP buffer is not even multiple of 9 bytes
! do the last few, and rotate the doubleword
! back to its original orientation
IF .Idd[Dap$h_Length] GTR 0
THEN
BEGIN
LOCAL rotates; ! To make 72 bits of rotation
! when all the data is read
LOCAL temp; ! TGS
rotates=(.Idd[Dap$h_Length]-9)*8;
DECR i FROM .Idd[Dap$h_Length]-1 TO 0
DO ( a=.a+Dap$Get_Byte(Idd); ! Get a byte
Rotc(a,-8) ); ! Rotate
Rotc(a, .Rotates); ! Rotate the bytes
! the rest of the way
ptr[0]=.a; ! Write to user's buffer
uszc=.uszc-1; ! Decrement remaining USZ count !624
IF .uszc LEQ 0 ! Beyond user's USZ? !624
THEN temp=.b ! Yes, don't store more !624
ELSE ptr[1]=.b; ! No, store next word !624
uszc=.uszc-1; !624
END;
END;
[Typ$k_Macy11,
Typ$k_Byte]:
%ELSE ! Non-36-bit machines
[Typ$k_Macy11,
Typ$k_Byte,
Typ$k_Image]:
%FI ! End of system-dependant
BEGIN ! Just copy into buffer
LOCAL ptr: $Byte_Pointer;
Rst[Rst$h_Record_Size] !m561
= Rab[Rab$h_Rsz]
= .Idd[Dap$h_Length] - .Fab[Fab$b_Fsz]; !m560
IF .Rab[Rab$h_Rsz] GTR (.Rab[Rab$h_Usz]*(%BPUNIT/8)) !m560
THEN ! record too big
BEGIN
UsrSts = Rms$_Rtb; !a560
UsrStv = .Rab[Rab$h_Rsz]; ! real recsize !a560
Rab[Rab$h_Rsz] = .Rab[Rab$h_Usz]*(%BPUNIT/8) !a560
- .Fab[Fab$b_Fsz] ; !what user got
Dap$Eat_Message( Idd ); ![7]
EXITLOOP Rms$_Rtb; ! Exit the loop, don't return !m560
END;
ptr=.Rab[Rab$a_Ubf]; ! Make 2-word !m506
TGUPointer(ptr,.Fst[Fst$h_bsz]); ! Byte pointer !m506
DECR i FROM .Rab[Rab$h_Rsz] TO 0 ! Write the data
DO CH$WCHAR_A( Dap$Get_Byte(Idd), ptr );
END;
[INRANGE,OUTRANGE]: SIGNAL(Dap$_Aor);
TES;
EXITLOOP Rms$_Suc; ! WIN !m555
END;
[Dap$k_Status]:
BEGIN
LOCAL e;
e = Dap$Get_Status( Idd ); ! End of file or error
Usrsts = Dap$Error_Dap_Rms(.e);
Usrstv = .e<Dapcode>;
IF .Usrsts GTR Rms$k_Err_Min ! Is this an error
THEN $$Error( Get, Rab ); ! Yes. barf out.
END; ! error code
%IF FTPASSIVE ! Only used by FAL
%THEN
[Dap$k_Access_Complete]:
BEGIN
Dap$Unget_Header( Idd );
RETURN Rab[Rab$h_Sts]=0; ! Not done yet
END;
%FI
[OTHERWISE]: ! somebody screwed up
BEGIN
! DAP Syncronization Error
$$Error( Get,
Rab,
Rms$_Dpe,
Dap$k_Mac_Sync+.Idd[Dap$b_Operator] ); !m577
RETURN .Usrsts
END;
TES
END WHILE 1;
BEGIN
Local Tsts,
Tstv;
Tsts = .UsrSts;
Tstv = .UsrStv;
IF .Rst[Rst$v_No_Send_control] EQL 0 ! If record mode, !a555
THEN
Dap$Get_Ack( Idd ); ! get status
IF .Tsts NEQ Rms$_Suc
THEN
BEGIN
USRSTS = .Tsts;
UsrStv = .Tstv;
END;
END;
Rab[Rab$h_Sts] = .UsrSts;
Rab[Rab$h_Stv] = .UsrStv;
(.UsrSts LSS Rms$k_Err_Min) ! True if not an error
END; !End of DAP$$GET
GLOBAL ROUTINE Dap$Put (P_Rab: REF $Rab_Decl, Err) = ! Put a record (remote)
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a record to an open file on another system.
!
! FORMAL PARAMETERS:
!
! P_RAB: A RAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
!--
BEGIN
BIND
Rab=.P_Rab: $Rab_Decl, !
Rst=.rab[Rab$a_Isi]: $Rms_Rst; ! Rst, to pass to following
Dap$$Put (Rab, Rst, .Err) ! Call DAP$$PUT to do the work, using RST
END; ! pointed to by FAB
GLOBAL ROUTINE Dap$Update (P_Rab: REF $Rab_Decl, Err) = ! Update record
!++
! FUNCTIONAL DESCRIPTION:
!
! $UPDATE a record to an open file on another system.
!
! FORMAL PARAMETERS:
!
! P_RAB: A RAB as defined by RMS
! ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
!--
BEGIN
BIND
Rab=.P_Rab: $Rab_Decl, !
Rst=.Rab[Rab$a_Isi]: $Rms_Rst, ! Rst, to pass to Dap$$Put
Fst=.Rst[Rst$a_Fst]: $Rms_Fst, ! Fst, pointing to dap descrs
Odd=.Fst[Fst$a_O_dd]: $Dap_Descriptor, ! output descriptor
Idd=.Fst[Fst$a_I_dd]: $Dap_Descriptor; ! input descriptor
LOCAL
display: BITVECTOR[28] INITIAL(0), ! DISPLAY field
v; ! Return value goes here
Dap$Put_Control( Odd, Rab, Dap$k_Update, Display );
Rst[Rst$v_No_Send_Control]=1; ! Supress Control $PUT message
v = Dap$$Put( Rab, Rst, .Err ); ! Call DAP$$PUT to do the work, using RST
Dap$Get_Ack( Idd ); ! check for status always !m602
! we must be in record mode for $UPDATE
Rst[Rst$v_No_Send_Control]=0; ! Control messages should be sent
.v ! Return value
END; ! pointed to by FAB
GLOBAL ROUTINE DAP$$PUT (P_Rab: REF $Rab_Decl,
P_Rst: REF $Rms_Rst,
P_ERR) = ! Put a record (remote)
!++
! FUNCTIONAL DESCRIPTION:
!
! Put a record to an open file on another system.
!
! FORMAL PARAMETERS:
!
! P_RAB: Address of RAB
! P_RST: Address of RST
! P_ERR: Address of error routine
!
! COMPLETION CODES:
!
! NONE
!
!--
BEGIN
BIND
Rab=.P_Rab: $Rab_Decl, ! Bind formals so
Rst=.P_Rst: $Rms_Rst; ! they may be accessed
BIND ROUTINE $$Errrtn=.P_Err: Rms_Ercal;
BIND !m506 vv
Fab=UAddr(.Rab[Rab$a_Fab]): $Fab_Decl, ! RMS FAB pointed to by above
Typ=UAddr(.Fab[Fab$a_Typ]): $Typ_Decl, ! Data type
Fst=.Rst[Rst$a_Fst]: $Rms_Fst, !
Odd=.Fst[Fst$a_O_Dd]: $Dap_Descriptor, ! our message descriptor
Idd=.Fst[Fst$a_I_Dd]: $Dap_Descriptor, ! input message descriptor
Config=.Fst[Fst$a_Config]: $XabCfg_decl;! Configuration message data
LOCAL Class;
LOCAL Bdata: $Xpo_Descriptor(); ! will point to binary data
LOCAL S;
LOCAL Adata: $Str_Descriptor(); ! this will point to ascii data
LOCAL Display: BITVECTOR[28] INITIAL(0);
LOCAL unterminated_record: INITIAL(0); ! Ascii record needs CRLF
LOCAL fhdrbuf: VECTOR[CH$ALLOCATION(20)],
hdrdesc: $Str_Descriptor();
LOCAL rabsav: VOLATILE;
LOCAL errsav: VOLATILE;
LOCAL rsizb; ! Record size in bytes !a571
ENABLE Dap$Handle(Rabsav,Errsav); ! Setup condition handler
Errsav=$$Errrtn; ! Handler will need these
Rabsav=Rab; !
class = .Fst[Fst$h_File_Class]; !a541 use FST file class if present
!+
! Default the file class if necessary
! This should have been done already
!-
IF .class EQL 0
THEN
BEGIN
IF Typ NEQ 0
THEN class=.Typ[Typ$h_Class] ! Use TYP block if any
ELSE class= Typ$k_Ascii;
END;
IF (.Rab[Rab$b_Rac] EQL Rab$k_Blk)
OR (.Rab[Rab$b_Rac] EQL Rab$k_Bft)
THEN class = Typ$k_Image;
!+
! Send Control message on first PUT only if file transfer mode,
! If record mode send Control message on every PUT.
!-
IF .Rst[Rst$v_No_Send_Control] EQL 0
THEN
BEGIN
LOCAL rac;
rac=.Rab[Rab$b_Rac];
!+
! If the remote system does not support Sequential Record Access
! Change it to File transfer mode.
!-
IF (.rac EQL Rab$k_Seq)
AND NOT .config[xab$v_sequential_access] ! not supported
THEN Rab[Rab$b_Rac] = Rab$k_Tra; ! It can't, use file xfer mode !m555
!+
! Now send the control message
!-
Dap$Put_Control( Odd, Rab, Dap$k_Put, Display );
!d555
!+
! Remember not to send any more Control Messages after this
! If we are in file transfer mode.
!-
SELECT .Rab[Rab$b_Rac] OF
SET
[Rab$k_Tra, Rab$k_Bft]: ! If File transfer mode
BEGIN
Rst[Rst$v_No_Send_Control]=1; ! No more ctl messages
Rab[Rab$b_Rac] = .rac; ! Restore user-set value
END;
TES;
END;
Init_Message( Odd ); ! Initialize descriptor
Odd[Dap$b_Operator]=Dap$k_Data; ! Set up a DATA message
Odd[Dap$b_StreamId]=.Rst[Rst$v_StreamId]; ! Set up stream id !a557
Odd[Dap$v_Mflags_Length]=1; ! Always send length field
CASE .Class FROM 0 TO Typ$k_Class_Max OF
SET
[Typ$k_Image]:
BEGIN
IF (.Rab[Rab$b_Rac] EQL Rab$k_Bft)
OR (.Rab[Rab$b_Rac] EQL Rab$k_Blk) !m561
THEN
BEGIN
RsizB = (Pagesize/2)*9; ! Block mode, use page size
Odd[Dap$h_BitCnt] = 0; ! 0 bit count !m561
END
ELSE
BEGIN
LOCAL bytesperword,
bitcnt,
rsizw;
bytesperword = (%BPUNIT/.Fst[Fst$h_Bsz]);
rsizw=(.Rab[Rab$h_Rsz]+.bytesperword-1)/.bytesperword;
rsizb= ((.rsizw/2)*9)+ ((.rsizw AND 1)*5);
! 9 bytes per 2 words + 5 bytes for last word
bitcnt = 4*( .rsizw AND 1 ) ! Last byte is only half a byte
+ ( %BPUNIT MOD .Fst[Fst$h_Bsz] ) ! Add in slack per word
+ ( ( ( .bytesperword
- ( .Rab[Rab$h_Rsz] MOD .bytesperword )
) MOD .bytesperword
) *.Fst[Fst$h_Bsz]
) ; ! finally, account for the number of extra bytes
IF (.bitcnt NEQ 0) ! If we have slack at the end !m571
THEN
BEGIN
!+
! If remote system supports bitcnt
! Then send entire word & say how much is slack.
! Otherwise, Don't send slack bytes, remote can't
! tell them from data
!-
IF .Config[Xab$v_BitCnt]
THEN Odd[Dap$v_Mflags_BitCnt] = 1 ! We will send bitcount
ELSE RSizB = .RSizB - ( .bitcnt / 8 ) ;
END;
Odd[Dap$h_Bitcnt] = .bitcnt;
END;
Odd[Dap$h_Length]=1+.rsizb; ! Null recnum (at least) !m571
END;
[Typ$k_DIL8]:
BEGIN
!
! DIL8 mode means we are ALWAYS talking to an 8-bit system, so
! we will NEVER be using block mode -- always record mode.
!
! Copy the record size directly from the RAB. Since we are always
! copying full 8-bit bytes to full 8-bit bytes, there should never
! be any "bitcount".
!
rsizb = .Rab[Rab$h_Rsz]; ! use record size in bytes from the RAB
Odd[Dap$h_Bitcnt] = 0; ! always zero
Odd[Dap$h_Length]=1+.rsizb; ! Null recnum (at least)
END;
[0,
Typ$k_Ascii,
Typ$k_Macy11,
Typ$k_Byte]:
BEGIN ! Record mode
LOCAL tptr,
second_last, ! 2nd-last char
last; ! last char
tptr=UAPointer(CH$PTR(.Rab[Rab$a_Rbf],0,.Fab[Fab$v_Bsz])); !m506
$Str_Desc_Init( Descriptor=Adata, String=(.Rab[Rab$h_Rsz],.tptr));
tptr=CH$PLUS(.tptr,.Rab[Rab$h_Rsz]-2);
second_last=CH$RCHAR_A(tptr);
last=CH$RCHAR_A(tptr);
SELECT .LAST OF
SET
[Break_Characters]: unterminated_record=0; ! Terminator on record
[$CHLFD]:
IF .second_last EQL $Chcrt
THEN unterminated_record=2; ! Default terminator
[OTHERWISE]:
BEGIN
IF (.Rab[Rab$h_Sts] EQL Rms$_Eof)
THEN unterminated_record=4 ! No terminator, End of file
ELSE unterminated_record=1; ! No terminator
END;
TES;
! If Implied CRLF, and CRLF is the terminator, then strip it off
IF .Fab[Fab$v_Cr] AND (.unterminated_record EQL 2)
THEN Adata[Str$h_Length]=.Adata[Str$h_Length]-2;
Odd[Dap$h_Length]=.Adata[Str$h_Length] ! Length of data in record
+ 1 ! Null RECNUM field
+ .Fab[Fab$b_Fsz]; ! Fixed header size
! + null RECNUM field
! ASCII STREAM wants CRLFs in record, adjust count if necessary
IF (.Fab[Fab$v_Rfm] EQL Fab$k_Stm) AND .unterminated_record
THEN Odd[Dap$h_Length]=.Odd[Dap$h_Length]+2;
END; ! End Ascii & Byte mode
[INRANGE, OUTRANGE]: SIGNAL(Dap$_Aor);
TES;
!+
! Check if the record is too big
!-
IF .Odd[Dap$h_Length] GTR .Odd[Dap$h_Message_Length]
THEN
BEGIN
$$Error( Put, Rab, Rms$_Rtb, .Odd[Dap$h_Message_Length]);
RETURN Rms$_Rtb
END;
!+
! Account for the RECNUM field if we need to send it
! It is really only necessary if we are in block file transfer mode
!-
IF (.Rab[Rab$b_Rac] EQL Rab$k_Bft) ! If block mode file transfer
OR (.Rab[Rab$b_Rac] EQL Rab$k_Blk) ! or random block mode !a577
THEN Odd[Dap$h_Length] = .Odd[Dap$h_Length] + %BPVAL/8;
!+
! Build the message header
!-
Put_Header(Odd);
!+
! Put in the (probably null) RECNUM field
!-
IF (.Rab[Rab$b_Rac] EQL Rab$k_Bft) ! If block mode file transfer
OR (.Rab[Rab$b_Rac] EQL Rab$k_Blk) ! or random block mode !a577
THEN Put_Vbn(Odd,.Rab[Rab$g_Bkt]) ! Build record number
ELSE Dap$Put_Byte(Odd,0); ! 0 length if not used
! Note that DAP Bucket numbers start at 1, RMS-36 starts at 0
!Now! At Last! The Data!!!!!
CASE .class FROM 0 TO Typ$k_Class_Max OF
SET
[Typ$k_Ascii]:
BEGIN
IF .Fab[Fab$b_Fsz] NEQ 0 ! Put the fixed header !a555vv
THEN
BEGIN
IF .Fab[Fab$v_Rfm] EQL Fab$k_Lsa ! If sequenced
THEN Dap$Put_2Byte( Odd, .Rab[Rab$h_Lsn] );
! Dap$Put_String( Odd, hdrdesc );
END;
Dap$Put_String(Odd,Adata); ! Put the data in
! ASCII STREAM wants records terminated
IF .unterminated_record AND (.Fab[Fab$v_Rfm] EQL Fab$k_Stm)
THEN Dap$Put_String(Odd,D_Crlf); ! Put back the CRLF
END;
[Typ$k_Image, ! Binary Data or
Typ$k_DIL8]: ! DIL8 format data
BEGIN
LOCAL ptr: REF VECTOR; ! Pointer to buffer
ptr=UAddr(.Rab[Rab$a_Rbf]);
!========================================!
!..5! 4 ! 3 ! 2 ! 1 !
!========================================!
! 9 ! 8 ! 7 ! 6 ! 5...
!========================================!
INCR i FROM 0 TO .RSizB-1
DO BEGIN
REGISTER a=loac;
REGISTER b=hiac;
IF ( .i MOD 9 ) EQL 0
THEN
BEGIN
a=.ptr[0]; ! Get a word of data
b=.ptr[1]; ! and another word
ptr=.ptr+2; ! Increment the pointer
END;
! The following is to convince the BLISS compiler
! not to trash the register. BLISS does not know what
! ROTC does, so it 'optimizes' and steps on register B
! thinking it is unused.
b=.b;
Dap$Put_Byte(Odd,.a); ! Put out a byte
Rotc(a,-8); ! Rotate to next one
END;
END;
[Typ$k_Macy11, ! Conversion has already been done, just send bytes
Typ$k_Byte]: ! Byte image data
BEGIN
LOCAL ptr;
ptr=UAPointer(CH$PTR(.Rab[Rab$a_Rbf],0,8));
DECR i FROM .Rab[Rab$h_Rsz]-1 TO 0
DO Dap$Put_Byte(Odd,CH$RCHAR_A(ptr));
END;
[INRANGE,OUTRANGE]: SIGNAL(Dap$_Aor);
TES;
IF .Fst[Fst$v_Accopt_Crc]
THEN Dap$Crc( Odd, Rst );
IF NOT .Fab[Fab$v_Dfw] ! If write is not deferred
THEN Dap$Put_Message(Odd); ! Send out the message
IF .Rst[Rst$v_No_Send_control] EQL 0 ! If record mode, !a555
THEN Dap$Get_Ack( Idd ) ! check for status
ELSE Rab[Rab$h_Sts]=Rms$_Suc; ! WIN
SS$_NORMAL
END; !End of DAP$$PUT
GLOBAL ROUTINE DAP$CRC ( p_dd: REF $Dap_Descriptor,
p_Rst: REF $Rms_Rst ) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Include message in CRC calculation
!
! FORMAL PARAMETERS:
!
! P_DD: Address of DAP descriptor for data message
! P_RST: Address of RST for stream
!
! SIDE EFFECTS:
!
! Message will be eaten.
! Call Dap$Unget_Header to get it back (must do for input)
!
!--
BEGIN
LITERAL
Dap$m_Crc_Polynomial=%O'164405',
Dap$k_Crc_Initial=%O'177777';
MACRO
$Dap$Crc [ byt ] =
(COMPILETIME crc=byt;
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
$Dap$Crc1
%PRINT( 'Crctab[',%NUMBER(byt),']=',%NUMBER(crc))
crc ) %,
$Dap$Crc1 =
%IF crc
%THEN %ASSIGN( crc, (crc^-1) XOR Dap$m_Crc_Polynomial )
%ELSE %ASSIGN( crc, (crc^-1) )
%FI
%;
%(
$Dap$Bit_Explode (bits)[] =
bits
%IF (%COUNT NEQ 7)
%THEN , $Dap$Bit_Explode( bits^-1 )
%FI %,
$Dap$Integers ( max ) [] =
%IF max GTR 0
%THEN $Dap$Integers( max-1 ),
%FI
max %;
)%
OWN CrcTab: VECTOR[256]
INITIAL( $Dap$Crc( 0,
1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
81, 82, 83, 84, 85, 86, 87, 88, 89, 90,
91, 92, 93, 94, 95, 96, 97, 98, 99, 100,
101, 102, 103, 104, 105,
106, 107, 108, 109, 110,
111, 112, 113, 114, 115,
116, 117, 118, 119, 120,
121, 122, 123, 124, 125,
126, 127, 128, 129, 130,
131, 132, 133, 134, 135,
136, 137, 138, 139, 140,
141, 142, 143, 144, 145,
146, 147, 148, 149, 150,
151, 152, 153, 154, 155,
156, 157, 158, 159, 160,
161, 162, 163, 164, 165,
166, 167, 168, 169, 170,
171, 172, 173, 174, 175,
176, 177, 178, 179, 180,
181, 182, 183, 184, 185,
186, 187, 188, 189, 190,
191, 192, 193, 194, 195,
196, 197, 198, 199, 200,
201, 202, 203, 204, 205,
206, 207, 208, 209, 210,
211, 212, 213, 214, 215,
216, 217, 218, 219, 220,
221, 222, 223, 224, 225,
226, 227, 228, 229, 230,
231, 232, 233, 234, 235,
236, 237, 238, 239, 240,
241, 242, 243, 244, 245,
246, 247, 248, 249, 250,
251, 252, 253, 254, 255 ) );
BIND dd=.p_dd: $Dap_Descriptor;
BIND rst=.p_rst: $Rms_Rst;
LOCAL
check; ! Temp checksum
Dap$Unget_Header( dd ); ! Back up to beginning of message
Dap$Get_Header( dd ); ! Eat the header
Dap$Get_Variable_String( dd, 0, 8 ); ! Eat the recnum
Check = .Rst[Rst$h_Checksum]; ! Copy checksum to temp !m561vv
! Compiler may think it volatile
DECR i FROM .dd[Dap$h_Length]-1 TO 0
DO
BEGIN
Check = .Check XOR Dap$Get_Byte( dd );
Check = .Crctab[.Check AND %O'377'] XOR (.Check ^ -8);
END;
Rst[Rst$h_Checksum] = .Check; ! Store resulting checksum !m561^^
END;
GLOBAL ROUTINE DAP$HANDLE (Signal_Args: REF VECTOR,
Mech_Args: REF VECTOR,
Enable_Args: REF VECTOR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Condition handler for requests
!
! FORMAL PARAMETERS:
!
! SIGNAL_ARGS: addr of vector of SIGNAL arguments,
! MECH_ARGS: not used,
! ENABLE_ARGS: args passed when this handler was established
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! COMPLETION CODES:
!
! 0: Resignal, 1: Continue
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BIND Blk=..Enable_Args[1]: $Rab_Decl; ! RMS block
BIND ROUTINE $$Errrtn=..Enable_Args[2]: Rms_Ercal; ! Error routine
BIND Fab=(IF .Blk[Rab$h_Bid] EQL Rab$k_Bid
THEN UAddr(.Blk[Rab$a_Fab])
ELSE Blk): $Fab_Decl;
BIND Fst=.Fab[Fab$a_Ifi]: $Rms_Fst;
LOCAL Severity;
Severity= .(Signal_Args[1])<0,3>;
SELECT .Signal_Args[1] OF
SET
[SS$_UNWIND]:
BEGIN
RETURN STS$K_NORMAL;
END;
[Rms$k_Suc_Min TO Rms$k_Suc_Max]: Severity=SS$_NORMAL;
[Rms$k_Err_Min TO Rms$k_Err_Max]:
Severity=SS$_ERROR;
[Rms$k_Err_Min TO Rms$k_Err_Max, Rms$k_Suc_Min TO Rms$k_Suc_Max]:
BEGIN
Usrsts=.Signal_Args[1];
Usrstv=.Signal_Args[2];
END;
[Dap$k_Facility_Code TO Dap$k_Facility_Code+%O'7777777']:
BEGIN
! Flag an error unless this is a success code
Fst[Fst$v_Error]=(NOT .Severity);
Usrsts=Dap$Error_Dap_Rms(.Signal_Args[1]);
Usrstv=.(Signal_Args[1])<Dapcode>;
END;
[Dap$_Eof]: Fst[Fst$v_Error]=0; ! End-of-File is special
[Xpn$$Select_Xpn_Errors]:
IF NOT .Severity ! If this is a connect error
THEN ! then change to RMS code
BEGIN
Fab[Fab$v_Drj]=0; ![14] Link is no good any more
Fst[Fst$v_Drj]=0; ! Link no good any more !a521
Fst[Fst$v_File_Open]=Fst[Fst$v_Access_Active]=0;
![14] Abort means it is not open any more
$Xpn_Close( Nlb=.Fst[Fst$a_Nlb], Failure=R$Null );
Usrsts=Rms$_Dcf;
Usrstv=.Signal_Args[1]; ! XPN code
END;
[Xpn$_Aborted, Xpn$_Disconn]:
BEGIN
Severity=STS$K_ERROR; ! Treat as error
Blk[Rab$h_Sts]=Rms$_dcb;
END; ! Network link broken (Abort or Disconnect)
[Xpn$_No_Open, Xpn$_Rejected]:
Usrstv=.Signal_Args[2];
! DECnet reason code will be STV for
! unspecified open error
[Xpn$_No_Access]:
UsrSts=Rms$_Iac; !a573
[OTHERWISE]:
BEGIN
Usrsts=Rms$_Bug; ! Should not occur
Usrstv=.Signal_Args[1]; !
Severity=SS$_FATAL; !
END;
TES;
Blk[Rab$h_Sts]=.Usrsts;
Blk[Rab$h_Stv]=.Usrstv;
CASE .SEVERITY FROM 0 TO 7 OF
SET
[STS$K_FATAL,STS$K_ERROR]: !m572
BEGIN
$$Error(Open,Blk); !? Should get operation too
SETUNWIND();
! Return status code
Mech_Args[Ma_Return]=Blk[Rab$h_Sts]=.UsrSts;
RETURN 0; !Actual return value is ignored here
END;
[STS$K_WARNING]:
BEGIN
$$Error(Open,Blk); !? Should get operation too
RETURN STS$K_NORMAL;
END;
[STS$K_NORMAL, STS$K_INFO]: RETURN STS$K_NORMAL;
[INRANGE]: ;
TES;
SS$_RESIGNAL
END; !End of DAP$HANDLE
END !End of module
ELUDOM