2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
10 * http://www.apache.org/licenses/LICENSE-2.0
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
22 unit Thrift.Protocol.Compact;
36 ICompactProtocol = interface( IProtocol)
37 ['{C01927EC-021A-45F7-93B1-23D6A5420EDD}']
40 // Compact protocol implementation for thrift.
41 // Adapted from the C# version.
42 TCompactProtocolImpl = class( TProtocolImpl, ICompactProtocol)
45 TFactory = class( TInterfacedObject, IProtocolFactory)
47 function GetProtocol( const trans: ITransport): IProtocol;
53 static TStruct ANONYMOUS_STRUCT = new TStruct("");
54 static TField TSTOP = new TField("", TType.Stop, (short)0);
57 PROTOCOL_ID = Byte( $82);
59 VERSION_MASK = Byte( $1F); // 0001 1111
60 TYPE_MASK = Byte( $E0); // 1110 0000
61 TYPE_BITS = Byte( $07); // 0000 0111
62 TYPE_SHIFT_AMOUNT = Byte( 5);
65 // All of the on-wire type codes.
83 ttypeToCompactType : array[TType] of Types = (
84 Types.STOP, // Stop = 0,
85 Types(-1), // Void = 1,
86 Types.BOOLEAN_TRUE, // Bool_ = 2,
87 Types.BYTE_, // Byte_ = 3,
88 Types.DOUBLE_, // Double_ = 4,
90 Types.I16, // I16 = 6,
92 Types.I32, // I32 = 8,
94 Types.I64, // I64 = 10,
95 Types.BINARY, // String_ = 11,
96 Types.STRUCT, // Struct = 12,
97 Types.MAP, // Map = 13,
98 Types.SET_, // Set_ = 14,
99 Types.LIST // List = 15,
102 tcompactTypeToType : array[Types] of TType = (
104 TType.Bool_, // BOOLEAN_TRUE
105 TType.Bool_, // BOOLEAN_FALSE
106 TType.Byte_, // BYTE_
110 TType.Double_, // DOUBLE_
111 TType.String_, // BINARY
115 TType.Struct // STRUCT
119 // Used to keep track of the last field for the current and previous structs,
120 // so we can do the delta stuff.
121 lastField_ : TStack<Integer>;
122 lastFieldId_ : Integer;
124 // If we encounter a boolean field begin, save the TField here so it can
125 // have the value incorporated.
126 private booleanField_ : TThriftField;
128 // If we Read a field header, and it's a boolean field, save the boolean
129 // value here so that ReadBool can use it.
130 private boolValue_ : ( unused, bool_true, bool_false);
133 constructor Create(const trans : ITransport);
134 destructor Destroy; override;
139 procedure WriteByteDirect( const b : Byte); overload;
141 // Writes a byte without any possibility of all that field header nonsense.
142 procedure WriteByteDirect( const n : Integer); overload;
144 // Write an i32 as a varint. Results in 1-5 bytes on the wire.
145 // TODO: make a permanent buffer like WriteVarint64?
146 procedure WriteVarint32( n : Cardinal);
149 // The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
150 // of the type header. This is used specifically in the boolean field case.
151 procedure WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
154 procedure WriteMessageBegin( const msg: TThriftMessage); override;
155 procedure WriteMessageEnd; override;
156 procedure WriteStructBegin( const struc: TThriftStruct); override;
157 procedure WriteStructEnd; override;
158 procedure WriteFieldBegin( const field: TThriftField); override;
159 procedure WriteFieldEnd; override;
160 procedure WriteFieldStop; override;
161 procedure WriteMapBegin( const map: TThriftMap); override;
162 procedure WriteMapEnd; override;
163 procedure WriteListBegin( const list: TThriftList); override;
164 procedure WriteListEnd(); override;
165 procedure WriteSetBegin( const set_: TThriftSet ); override;
166 procedure WriteSetEnd(); override;
167 procedure WriteBool( b: Boolean); override;
168 procedure WriteByte( b: ShortInt); override;
169 procedure WriteI16( i16: SmallInt); override;
170 procedure WriteI32( i32: Integer); override;
171 procedure WriteI64( const i64: Int64); override;
172 procedure WriteDouble( const dub: Double); override;
173 procedure WriteBinary( const b: TBytes); overload; override;
176 class function DoubleToInt64Bits( const db : Double) : Int64;
177 class function Int64BitsToDouble( const i64 : Int64) : Double;
179 // Abstract method for writing the start of lists and sets. List and sets on
180 // the wire differ only by the type indicator.
181 procedure WriteCollectionBegin( const elemType : TType; size : Integer);
183 procedure WriteVarint64( n : UInt64);
185 // Convert l into a zigzag long. This allows negative numbers to be
186 // represented compactly as a varint.
187 class function longToZigzag( const n : Int64) : UInt64;
189 // Convert n into a zigzag int. This allows negative numbers to be
190 // represented compactly as a varint.
191 class function intToZigZag( const n : Integer) : Cardinal;
193 //Convert a Int64 into little-endian bytes in buf starting at off and going until off+7.
194 class procedure fixedLongToBytes( const n : Int64; var buf : TBytes);
197 function ReadMessageBegin: TThriftMessage; override;
198 procedure ReadMessageEnd(); override;
199 function ReadStructBegin: TThriftStruct; override;
200 procedure ReadStructEnd; override;
201 function ReadFieldBegin: TThriftField; override;
202 procedure ReadFieldEnd(); override;
203 function ReadMapBegin: TThriftMap; override;
204 procedure ReadMapEnd(); override;
205 function ReadListBegin: TThriftList; override;
206 procedure ReadListEnd(); override;
207 function ReadSetBegin: TThriftSet; override;
208 procedure ReadSetEnd(); override;
209 function ReadBool: Boolean; override;
210 function ReadByte: ShortInt; override;
211 function ReadI16: SmallInt; override;
212 function ReadI32: Integer; override;
213 function ReadI64: Int64; override;
214 function ReadDouble:Double; override;
215 function ReadBinary: TBytes; overload; override;
218 // Internal Reading methods
220 // Read an i32 from the wire as a varint. The MSB of each byte is set
221 // if there is another byte to follow. This can Read up to 5 bytes.
222 function ReadVarint32 : Cardinal;
224 // Read an i64 from the wire as a proper varint. The MSB of each byte is set
225 // if there is another byte to follow. This can Read up to 10 bytes.
226 function ReadVarint64 : UInt64;
231 // Convert from zigzag Integer to Integer.
232 class function zigzagToInt( const n : Cardinal ) : Integer;
234 // Convert from zigzag Int64 to Int64.
235 class function zigzagToLong( const n : UInt64) : Int64;
237 // Note that it's important that the mask bytes are Int64 literals,
238 // otherwise they'll default to ints, and when you shift an Integer left 56 bits,
239 // you just get a messed up Integer.
240 class function bytesToLong( const bytes : TBytes) : Int64;
242 // type testing and converting
243 class function isBoolType( const b : byte) : Boolean;
245 // Given a TCompactProtocol.Types constant, convert it to its corresponding TType value.
246 class function getTType( const type_ : byte) : TType;
248 // Given a TType value, find the appropriate TCompactProtocol.Types constant.
249 class function getCompactType( const ttype : TType) : Byte;
257 //--- TCompactProtocolImpl.TFactory ----------------------------------------
260 function TCompactProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
262 result := TCompactProtocolImpl.Create( trans);
266 //--- TCompactProtocolImpl -------------------------------------------------
269 constructor TCompactProtocolImpl.Create(const trans: ITransport);
271 inherited Create( trans);
274 lastField_ := TStack<Integer>.Create;
276 Init( booleanField_, '', TType.Stop, 0);
277 boolValue_ := unused;
281 destructor TCompactProtocolImpl.Destroy;
284 FreeAndNil( lastField_);
292 procedure TCompactProtocolImpl.Reset;
296 Init( booleanField_, '', TType.Stop, 0);
297 boolValue_ := unused;
301 // Writes a byte without any possibility of all that field header nonsense.
302 // Used internally by other writing methods that know they need to Write a byte.
303 procedure TCompactProtocolImpl.WriteByteDirect( const b : Byte);
305 Transport.Write( @b, SizeOf(b));
309 // Writes a byte without any possibility of all that field header nonsense.
310 procedure TCompactProtocolImpl.WriteByteDirect( const n : Integer);
312 WriteByteDirect( Byte(n));
316 // Write an i32 as a varint. Results in 1-5 bytes on the wire.
317 procedure TCompactProtocolImpl.WriteVarint32( n : Cardinal);
321 SetLength( i32buf, 5);
324 ASSERT( idx < Length(i32buf));
327 if ((n and not $7F) = 0) then begin
328 i32buf[idx] := Byte(n);
333 i32buf[idx] := Byte((n and $7F) or $80);
338 Transport.Write( i32buf, 0, idx);
342 // Write a message header to the wire. Compact Protocol messages contain the
343 // protocol version so we can migrate forwards in the future if need be.
344 procedure TCompactProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
345 var versionAndType : Byte;
349 versionAndType := Byte( VERSION and VERSION_MASK)
350 or Byte( (Cardinal(msg.Type_) shl TYPE_SHIFT_AMOUNT) and TYPE_MASK);
352 WriteByteDirect( PROTOCOL_ID);
353 WriteByteDirect( versionAndType);
354 WriteVarint32( Cardinal(msg.SeqID));
355 WriteString( msg.Name);
359 // Write a struct begin. This doesn't actually put anything on the wire. We use it as an
360 // opportunity to put special placeholder markers on the field stack so we can get the
361 // field id deltas correct.
362 procedure TCompactProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
364 lastField_.Push(lastFieldId_);
369 // Write a struct end. This doesn't actually put anything on the wire. We use this as an
370 // opportunity to pop the last field from the current struct off of the field stack.
371 procedure TCompactProtocolImpl.WriteStructEnd;
373 lastFieldId_ := lastField_.Pop();
377 // Write a field header containing the field id and field type. If the difference between the
378 // current field id and the last one is small (< 15), then the field id will be encoded in
379 // the 4 MSB as a delta. Otherwise, the field id will follow the type header as a zigzag varint.
380 procedure TCompactProtocolImpl.WriteFieldBegin( const field: TThriftField);
383 TType.Bool_ : booleanField_ := field; // we want to possibly include the value, so we'll wait.
385 WriteFieldBeginInternal(field, $FF);
390 // The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
391 // of the type header. This is used specifically in the boolean field case.
392 procedure TCompactProtocolImpl.WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
393 var typeToWrite : Byte;
395 // if there's a type override, use that.
396 if typeOverride = $FF
397 then typeToWrite := getCompactType( field.Type_)
398 else typeToWrite := typeOverride;
400 // check if we can use delta encoding for the field id
401 if (field.ID > lastFieldId_) and ((field.ID - lastFieldId_) <= 15)
403 // Write them together
404 WriteByteDirect( ((field.ID - lastFieldId_) shl 4) or typeToWrite);
407 // Write them separate
408 WriteByteDirect( typeToWrite);
412 lastFieldId_ := field.ID;
416 // Write the STOP symbol so we know there are no more fields in this struct.
417 procedure TCompactProtocolImpl.WriteFieldStop;
419 WriteByteDirect( Byte( Types.STOP));
423 // Write a map header. If the map is empty, omit the key and value type
424 // headers, as we don't need any additional information to skip it.
425 procedure TCompactProtocolImpl.WriteMapBegin( const map: TThriftMap);
429 then WriteByteDirect( 0)
431 WriteVarint32( Cardinal( map.Count));
432 key := getCompactType(map.KeyType);
433 val := getCompactType(map.ValueType);
434 WriteByteDirect( (key shl 4) or val);
439 // Write a list header.
440 procedure TCompactProtocolImpl.WriteListBegin( const list: TThriftList);
442 WriteCollectionBegin( list.ElementType, list.Count);
446 // Write a set header.
447 procedure TCompactProtocolImpl.WriteSetBegin( const set_: TThriftSet );
449 WriteCollectionBegin( set_.ElementType, set_.Count);
453 // Write a boolean value. Potentially, this could be a boolean field, in
454 // which case the field header info isn't written yet. If so, decide what the
455 // right type header is for the value and then Write the field header.
456 // Otherwise, Write a single byte.
457 procedure TCompactProtocolImpl.WriteBool( b: Boolean);
461 then bt := Types.BOOLEAN_TRUE
462 else bt := Types.BOOLEAN_FALSE;
464 if booleanField_.Type_ = TType.Bool_ then begin
465 // we haven't written the field header yet
466 WriteFieldBeginInternal( booleanField_, Byte(bt));
467 booleanField_.Type_ := TType.Stop;
470 // we're not part of a field, so just Write the value.
471 WriteByteDirect( Byte(bt));
476 // Write a byte. Nothing to see here!
477 procedure TCompactProtocolImpl.WriteByte( b: ShortInt);
479 WriteByteDirect( Byte(b));
483 // Write an I16 as a zigzag varint.
484 procedure TCompactProtocolImpl.WriteI16( i16: SmallInt);
486 WriteVarint32( intToZigZag( i16));
490 // Write an i32 as a zigzag varint.
491 procedure TCompactProtocolImpl.WriteI32( i32: Integer);
493 WriteVarint32( intToZigZag( i32));
497 // Write an i64 as a zigzag varint.
498 procedure TCompactProtocolImpl.WriteI64( const i64: Int64);
500 WriteVarint64( longToZigzag( i64));
504 class function TCompactProtocolImpl.DoubleToInt64Bits( const db : Double) : Int64;
506 ASSERT( SizeOf(db) = SizeOf(result));
507 Move( db, result, SizeOf(result));
511 class function TCompactProtocolImpl.Int64BitsToDouble( const i64 : Int64) : Double;
513 ASSERT( SizeOf(i64) = SizeOf(result));
514 Move( i64, result, SizeOf(result));
518 // Write a double to the wire as 8 bytes.
519 procedure TCompactProtocolImpl.WriteDouble( const dub: Double);
522 fixedLongToBytes( DoubleToInt64Bits(dub), data);
523 Transport.Write( data);
527 // Write a byte array, using a varint for the size.
528 procedure TCompactProtocolImpl.WriteBinary( const b: TBytes);
530 WriteVarint32( Cardinal(Length(b)));
534 procedure TCompactProtocolImpl.WriteMessageEnd;
540 procedure TCompactProtocolImpl.WriteMapEnd;
546 procedure TCompactProtocolImpl.WriteListEnd;
552 procedure TCompactProtocolImpl.WriteSetEnd;
558 procedure TCompactProtocolImpl.WriteFieldEnd;
564 // Abstract method for writing the start of lists and sets. List and sets on
565 // the wire differ only by the type indicator.
566 procedure TCompactProtocolImpl.WriteCollectionBegin( const elemType : TType; size : Integer);
569 then WriteByteDirect( (size shl 4) or getCompactType(elemType))
571 WriteByteDirect( $F0 or getCompactType(elemType));
572 WriteVarint32( Cardinal(size));
577 // Write an i64 as a varint. Results in 1-10 bytes on the wire.
578 procedure TCompactProtocolImpl.WriteVarint64( n : UInt64);
579 var varint64out : TBytes;
582 SetLength( varint64out, 10);
585 ASSERT( idx < Length(varint64out));
588 if (n and not UInt64($7F)) = 0 then begin
589 varint64out[idx] := Byte(n);
594 varint64out[idx] := Byte((n and $7F) or $80);
599 Transport.Write( varint64out, 0, idx);
603 // Convert l into a zigzag Int64. This allows negative numbers to be
604 // represented compactly as a varint.
605 class function TCompactProtocolImpl.longToZigzag( const n : Int64) : UInt64;
607 // there is no arithmetic right shift in Delphi
609 then result := UInt64(n shl 1)
610 else result := UInt64(n shl 1) xor $FFFFFFFFFFFFFFFF;
614 // Convert n into a zigzag Integer. This allows negative numbers to be
615 // represented compactly as a varint.
616 class function TCompactProtocolImpl.intToZigZag( const n : Integer) : Cardinal;
618 // there is no arithmetic right shift in Delphi
620 then result := Cardinal(n shl 1)
621 else result := Cardinal(n shl 1) xor $FFFFFFFF;
625 // Convert a Int64 into 8 little-endian bytes in buf
626 class procedure TCompactProtocolImpl.fixedLongToBytes( const n : Int64; var buf : TBytes);
629 buf[0] := Byte( n and $FF);
630 buf[1] := Byte((n shr 8) and $FF);
631 buf[2] := Byte((n shr 16) and $FF);
632 buf[3] := Byte((n shr 24) and $FF);
633 buf[4] := Byte((n shr 32) and $FF);
634 buf[5] := Byte((n shr 40) and $FF);
635 buf[6] := Byte((n shr 48) and $FF);
636 buf[7] := Byte((n shr 56) and $FF);
641 // Read a message header.
642 function TCompactProtocolImpl.ReadMessageBegin : TThriftMessage;
643 var protocolId, versionAndType, version, type_ : Byte;
649 protocolId := Byte( ReadByte);
650 if (protocolId <> PROTOCOL_ID)
651 then raise TProtocolExceptionBadVersion.Create( 'Expected protocol id ' + IntToHex(PROTOCOL_ID,2)
652 + ' but got ' + IntToHex(protocolId,2));
654 versionAndType := Byte( ReadByte);
655 version := Byte( versionAndType and VERSION_MASK);
656 if (version <> VERSION)
657 then raise TProtocolExceptionBadVersion.Create( 'Expected version ' +IntToStr(VERSION)
658 + ' but got ' + IntToStr(version));
660 type_ := Byte( (versionAndType shr TYPE_SHIFT_AMOUNT) and TYPE_BITS);
661 seqid := Integer( ReadVarint32);
663 Init( result, msgNm, TMessageType(type_), seqid);
667 // Read a struct begin. There's nothing on the wire for this, but it is our
668 // opportunity to push a new struct begin marker onto the field stack.
669 function TCompactProtocolImpl.ReadStructBegin: TThriftStruct;
671 lastField_.Push( lastFieldId_);
677 // Doesn't actually consume any wire data, just removes the last field for
678 // this struct from the field stack.
679 procedure TCompactProtocolImpl.ReadStructEnd;
681 // consume the last field we Read off the wire.
682 lastFieldId_ := lastField_.Pop();
686 // Read a field header off the wire.
687 function TCompactProtocolImpl.ReadFieldBegin: TThriftField;
692 type_ := Byte( ReadByte);
694 // if it's a stop, then we can return immediately, as the struct is over.
695 if type_ = Byte(Types.STOP) then begin
696 Init( result, '', TType.Stop, 0);
700 // mask off the 4 MSB of the type header. it could contain a field id delta.
701 modifier := ShortInt( (type_ and $F0) shr 4);
703 then fieldId := ReadI16 // not a delta. look ahead for the zigzag varint field id.
704 else fieldId := SmallInt( lastFieldId_ + modifier); // add the delta to the last Read field id.
706 Init( result, '', getTType(Byte(type_ and $0F)), fieldId);
708 // if this happens to be a boolean field, the value is encoded in the type
709 // save the boolean value in a special instance variable.
710 if isBoolType(type_) then begin
711 if Byte(type_ and $0F) = Byte(Types.BOOLEAN_TRUE)
712 then boolValue_ := bool_true
713 else boolValue_ := bool_false;
716 // push the new field onto the field stack so we can keep the deltas going.
717 lastFieldId_ := result.ID;
721 // Read a map header off the wire. If the size is zero, skip Reading the key
722 // and value type. This means that 0-length maps will yield TMaps without the
724 function TCompactProtocolImpl.ReadMapBegin: TThriftMap;
726 keyAndValueType : Byte;
729 size := Integer( ReadVarint32);
731 then keyAndValueType := 0
732 else keyAndValueType := Byte( ReadByte);
734 key := getTType( Byte( keyAndValueType shr 4));
735 val := getTType( Byte( keyAndValueType and $F));
736 Init( result, key, val, size);
737 ASSERT( (result.KeyType = key) and (result.ValueType = val));
741 // Read a list header off the wire. If the list size is 0-14, the size will
742 // be packed into the element type header. If it's a longer list, the 4 MSB
743 // of the element type header will be $F, and a varint will follow with the
745 function TCompactProtocolImpl.ReadListBegin: TThriftList;
746 var size_and_type : Byte;
750 size_and_type := Byte( ReadByte);
752 size := (size_and_type shr 4) and $0F;
754 then size := Integer( ReadVarint32);
756 type_ := getTType( size_and_type);
757 Init( result, type_, size);
761 // Read a set header off the wire. If the set size is 0-14, the size will
762 // be packed into the element type header. If it's a longer set, the 4 MSB
763 // of the element type header will be $F, and a varint will follow with the
765 function TCompactProtocolImpl.ReadSetBegin: TThriftSet;
766 var size_and_type : Byte;
770 size_and_type := Byte( ReadByte);
772 size := (size_and_type shr 4) and $0F;
774 then size := Integer( ReadVarint32);
776 type_ := getTType( size_and_type);
777 Init( result, type_, size);
781 // Read a boolean off the wire. If this is a boolean field, the value should
782 // already have been Read during ReadFieldBegin, so we'll just consume the
783 // pre-stored value. Otherwise, Read a byte.
784 function TCompactProtocolImpl.ReadBool: Boolean;
786 if boolValue_ <> unused then begin
787 result := (boolValue_ = bool_true);
788 boolValue_ := unused;
792 result := (Byte(ReadByte) = Byte(Types.BOOLEAN_TRUE));
796 // Read a single byte off the wire. Nothing interesting here.
797 function TCompactProtocolImpl.ReadByte: ShortInt;
799 Transport.ReadAll( @result, SizeOf(result), 0, 1);
803 // Read an i16 from the wire as a zigzag varint.
804 function TCompactProtocolImpl.ReadI16: SmallInt;
806 result := SmallInt( zigzagToInt( ReadVarint32));
810 // Read an i32 from the wire as a zigzag varint.
811 function TCompactProtocolImpl.ReadI32: Integer;
813 result := zigzagToInt( ReadVarint32);
817 // Read an i64 from the wire as a zigzag varint.
818 function TCompactProtocolImpl.ReadI64: Int64;
820 result := zigzagToLong( ReadVarint64);
824 // No magic here - just Read a double off the wire.
825 function TCompactProtocolImpl.ReadDouble:Double;
826 var longBits : TBytes;
828 SetLength( longBits, 8);
829 Transport.ReadAll( longBits, 0, 8);
830 result := Int64BitsToDouble( bytesToLong( longBits));
834 // Read a byte[] from the wire.
835 function TCompactProtocolImpl.ReadBinary: TBytes;
836 var length : Integer;
838 length := Integer( ReadVarint32);
839 SetLength( result, length);
841 then Transport.ReadAll( result, 0, length);
845 procedure TCompactProtocolImpl.ReadMessageEnd;
851 procedure TCompactProtocolImpl.ReadFieldEnd;
857 procedure TCompactProtocolImpl.ReadMapEnd;
863 procedure TCompactProtocolImpl.ReadListEnd;
869 procedure TCompactProtocolImpl.ReadSetEnd;
876 // Read an i32 from the wire as a varint. The MSB of each byte is set
877 // if there is another byte to follow. This can Read up to 5 bytes.
878 function TCompactProtocolImpl.ReadVarint32 : Cardinal;
885 b := Byte( ReadByte);
886 result := result or (Cardinal(b and $7F) shl shift);
887 if ((b and $80) <> $80)
894 // Read an i64 from the wire as a proper varint. The MSB of each byte is set
895 // if there is another byte to follow. This can Read up to 10 bytes.
896 function TCompactProtocolImpl.ReadVarint64 : UInt64;
903 b := Byte( ReadByte);
904 result := result or (UInt64(b and $7F) shl shift);
905 if ((b and $80) <> $80)
912 // Convert from zigzag Integer to Integer.
913 class function TCompactProtocolImpl.zigzagToInt( const n : Cardinal ) : Integer;
915 result := Integer(n shr 1) xor (-Integer(n and 1));
919 // Convert from zigzag Int64 to Int64.
920 class function TCompactProtocolImpl.zigzagToLong( const n : UInt64) : Int64;
922 result := Int64(n shr 1) xor (-Int64(n and 1));
926 // Note that it's important that the mask bytes are Int64 literals,
927 // otherwise they'll default to ints, and when you shift an Integer left 56 bits,
928 // you just get a messed up Integer.
929 class function TCompactProtocolImpl.bytesToLong( const bytes : TBytes) : Int64;
931 ASSERT( Length(bytes) >= 8);
932 result := (Int64(bytes[7] and $FF) shl 56) or
933 (Int64(bytes[6] and $FF) shl 48) or
934 (Int64(bytes[5] and $FF) shl 40) or
935 (Int64(bytes[4] and $FF) shl 32) or
936 (Int64(bytes[3] and $FF) shl 24) or
937 (Int64(bytes[2] and $FF) shl 16) or
938 (Int64(bytes[1] and $FF) shl 8) or
939 (Int64(bytes[0] and $FF));
943 class function TCompactProtocolImpl.isBoolType( const b : byte) : Boolean;
944 var lowerNibble : Byte;
946 lowerNibble := b and $0f;
947 result := (Types(lowerNibble) in [Types.BOOLEAN_TRUE, Types.BOOLEAN_FALSE]);
951 // Given a TCompactProtocol.Types constant, convert it to its corresponding TType value.
952 class function TCompactProtocolImpl.getTType( const type_ : byte) : TType;
955 tct := Types( type_ and $0F);
956 if tct in [Low(Types)..High(Types)]
957 then result := tcompactTypeToType[tct]
958 else raise TProtocolExceptionInvalidData.Create('don''t know what type: '+IntToStr(Ord(tct)));
962 // Given a TType value, find the appropriate TCompactProtocol.Types constant.
963 class function TCompactProtocolImpl.getCompactType( const ttype : TType) : Byte;
965 if ttype in VALID_TTYPES
966 then result := Byte( ttypeToCompactType[ttype])
967 else raise TProtocolExceptionInvalidData.Create('don''t know what type: '+IntToStr(Ord(ttype)));
971 //--- unit tests -------------------------------------------
974 procedure TestDoubleToInt64Bits;
976 procedure TestPair( const a : Double; const b : Int64);
978 ASSERT( TCompactProtocolImpl.DoubleToInt64Bits(a) = b);
979 ASSERT( TCompactProtocolImpl.Int64BitsToDouble(b) = a);
983 TestPair( 1.0000000000000000E+000, Int64($3FF0000000000000));
984 TestPair( 1.5000000000000000E+001, Int64($402E000000000000));
985 TestPair( 2.5500000000000000E+002, Int64($406FE00000000000));
986 TestPair( 4.2949672950000000E+009, Int64($41EFFFFFFFE00000));
987 TestPair( 3.9062500000000000E-003, Int64($3F70000000000000));
988 TestPair( 2.3283064365386963E-010, Int64($3DF0000000000000));
989 TestPair( 1.2345678901230000E-300, Int64($01AA74FE1C1E7E45));
990 TestPair( 1.2345678901234500E-150, Int64($20D02A36586DB4BB));
991 TestPair( 1.2345678901234565E+000, Int64($3FF3C0CA428C59FA));
992 TestPair( 1.2345678901234567E+000, Int64($3FF3C0CA428C59FB));
993 TestPair( 1.2345678901234569E+000, Int64($3FF3C0CA428C59FC));
994 TestPair( 1.2345678901234569E+150, Int64($5F182344CD3CDF9F));
995 TestPair( 1.2345678901234569E+300, Int64($7E3D7EE8BCBBD352));
996 TestPair( -1.7976931348623157E+308, Int64($FFEFFFFFFFFFFFFF));
997 TestPair( 1.7976931348623157E+308, Int64($7FEFFFFFFFFFFFFF));
998 TestPair( 4.9406564584124654E-324, Int64($0000000000000001));
999 TestPair( 0.0000000000000000E+000, Int64($0000000000000000));
1000 TestPair( 4.94065645841247E-324, Int64($0000000000000001));
1001 TestPair( 3.2378592100206092E-319, Int64($000000000000FFFF));
1002 TestPair( 1.3906711615669959E-309, Int64($0000FFFFFFFFFFFF));
1003 TestPair( NegInfinity, Int64($FFF0000000000000));
1004 TestPair( Infinity, Int64($7FF0000000000000));
1007 ASSERT( TCompactProtocolImpl.DoubleToInt64Bits( NaN) = Int64($FFF8000000000000));
1008 ASSERT( IsNan( TCompactProtocolImpl.Int64BitsToDouble( Int64($FFF8000000000000))));
1014 procedure TestZigZag;
1016 procedure Test32( const test : Integer);
1019 zz := TCompactProtocolImpl.intToZigZag(test);
1020 ASSERT( TCompactProtocolImpl.zigzagToInt(zz) = test, IntToStr(test));
1023 procedure Test64( const test : Int64);
1026 zz := TCompactProtocolImpl.longToZigzag(test);
1027 ASSERT( TCompactProtocolImpl.zigzagToLong(zz) = test, IntToStr(test));
1032 // protobuf testcases
1033 ASSERT( TCompactProtocolImpl.intToZigZag(0) = 0, 'pb #1 to ZigZag');
1034 ASSERT( TCompactProtocolImpl.intToZigZag(-1) = 1, 'pb #2 to ZigZag');
1035 ASSERT( TCompactProtocolImpl.intToZigZag(1) = 2, 'pb #3 to ZigZag');
1036 ASSERT( TCompactProtocolImpl.intToZigZag(-2) = 3, 'pb #4 to ZigZag');
1037 ASSERT( TCompactProtocolImpl.intToZigZag(+2147483647) = 4294967294, 'pb #5 to ZigZag');
1038 ASSERT( TCompactProtocolImpl.intToZigZag(-2147483648) = 4294967295, 'pb #6 to ZigZag');
1040 // protobuf testcases
1041 ASSERT( TCompactProtocolImpl.zigzagToInt(0) = 0, 'pb #1 from ZigZag');
1042 ASSERT( TCompactProtocolImpl.zigzagToInt(1) = -1, 'pb #2 from ZigZag');
1043 ASSERT( TCompactProtocolImpl.zigzagToInt(2) = 1, 'pb #3 from ZigZag');
1044 ASSERT( TCompactProtocolImpl.zigzagToInt(3) = -2, 'pb #4 from ZigZag');
1045 ASSERT( TCompactProtocolImpl.zigzagToInt(4294967294) = +2147483647, 'pb #5 from ZigZag');
1046 ASSERT( TCompactProtocolImpl.zigzagToInt(4294967295) = -2147483648, 'pb #6 from ZigZag');
1048 // back and forth 32
1050 for i := 0 to 30 do begin
1051 Test32( +(Integer(1) shl i));
1052 Test32( -(Integer(1) shl i));
1054 Test32( Integer($7FFFFFFF));
1055 Test32( Integer($80000000));
1057 // back and forth 64
1059 for i := 0 to 62 do begin
1060 Test64( +(Int64(1) shl i));
1061 Test64( -(Int64(1) shl i));
1063 Test64( Int64($7FFFFFFFFFFFFFFF));
1064 Test64( Int64($8000000000000000));
1070 procedure TestLongBytes;
1072 procedure Test( const test : Int64);
1075 TCompactProtocolImpl.fixedLongToBytes( test, buf);
1076 ASSERT( TCompactProtocolImpl.bytesToLong( buf) = test, IntToStr(test));
1082 for i := 0 to 62 do begin
1083 Test( +(Int64(1) shl i));
1084 Test( -(Int64(1) shl i));
1086 Test( Int64($7FFFFFFFFFFFFFFF));
1087 Test( Int64($8000000000000000));
1095 const FPU_CW_DENORMALIZED = $0002;
1099 Set8087CW( w or FPU_CW_DENORMALIZED);
1101 TestDoubleToInt64Bits;