]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
1 | (* |
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 | |
9 | * | |
10 | * http://www.apache.org/licenses/LICENSE-2.0 | |
11 | * | |
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 | |
17 | * under the License. | |
18 | *) | |
19 | ||
20 | {$SCOPEDENUMS ON} | |
21 | ||
22 | unit Thrift.Protocol.Compact; | |
23 | ||
24 | interface | |
25 | ||
26 | uses | |
27 | Classes, | |
28 | SysUtils, | |
29 | Math, | |
30 | Generics.Collections, | |
31 | Thrift.Transport, | |
32 | Thrift.Protocol, | |
33 | Thrift.Utils; | |
34 | ||
35 | type | |
36 | ICompactProtocol = interface( IProtocol) | |
37 | ['{C01927EC-021A-45F7-93B1-23D6A5420EDD}'] | |
38 | end; | |
39 | ||
40 | // Compact protocol implementation for thrift. | |
41 | // Adapted from the C# version. | |
42 | TCompactProtocolImpl = class( TProtocolImpl, ICompactProtocol) | |
43 | public | |
44 | type | |
45 | TFactory = class( TInterfacedObject, IProtocolFactory) | |
46 | public | |
47 | function GetProtocol( const trans: ITransport): IProtocol; | |
48 | end; | |
49 | ||
50 | private const | |
51 | ||
52 | { TODO | |
53 | static TStruct ANONYMOUS_STRUCT = new TStruct(""); | |
54 | static TField TSTOP = new TField("", TType.Stop, (short)0); | |
55 | } | |
56 | ||
57 | PROTOCOL_ID = Byte( $82); | |
58 | VERSION = Byte( 1); | |
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); | |
63 | ||
64 | private type | |
65 | // All of the on-wire type codes. | |
66 | Types = ( | |
67 | STOP = $00, | |
68 | BOOLEAN_TRUE = $01, | |
69 | BOOLEAN_FALSE = $02, | |
70 | BYTE_ = $03, | |
71 | I16 = $04, | |
72 | I32 = $05, | |
73 | I64 = $06, | |
74 | DOUBLE_ = $07, | |
75 | BINARY = $08, | |
76 | LIST = $09, | |
77 | SET_ = $0A, | |
78 | MAP = $0B, | |
79 | STRUCT = $0C | |
80 | ); | |
81 | ||
82 | private const | |
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, | |
89 | Types(-5), // unused | |
90 | Types.I16, // I16 = 6, | |
91 | Types(-7), // unused | |
92 | Types.I32, // I32 = 8, | |
93 | Types(-9), // unused | |
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, | |
100 | ); | |
101 | ||
102 | tcompactTypeToType : array[Types] of TType = ( | |
103 | TType.Stop, // STOP | |
104 | TType.Bool_, // BOOLEAN_TRUE | |
105 | TType.Bool_, // BOOLEAN_FALSE | |
106 | TType.Byte_, // BYTE_ | |
107 | TType.I16, // I16 | |
108 | TType.I32, // I32 | |
109 | TType.I64, // I64 | |
110 | TType.Double_, // DOUBLE_ | |
111 | TType.String_, // BINARY | |
112 | TType.List, // LIST | |
113 | TType.Set_, // SET_ | |
114 | TType.Map, // MAP | |
115 | TType.Struct // STRUCT | |
116 | ); | |
117 | ||
118 | private | |
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; | |
123 | ||
124 | // If we encounter a boolean field begin, save the TField here so it can | |
125 | // have the value incorporated. | |
126 | private booleanField_ : TThriftField; | |
127 | ||
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); | |
131 | ||
132 | public | |
133 | constructor Create(const trans : ITransport); | |
134 | destructor Destroy; override; | |
135 | ||
136 | procedure Reset; | |
137 | ||
138 | private | |
139 | procedure WriteByteDirect( const b : Byte); overload; | |
140 | ||
141 | // Writes a byte without any possibility of all that field header nonsense. | |
142 | procedure WriteByteDirect( const n : Integer); overload; | |
143 | ||
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); | |
147 | ||
148 | private | |
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); | |
152 | ||
153 | public | |
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; | |
174 | ||
175 | private | |
176 | class function DoubleToInt64Bits( const db : Double) : Int64; | |
177 | class function Int64BitsToDouble( const i64 : Int64) : Double; | |
178 | ||
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); | |
182 | ||
183 | procedure WriteVarint64( n : UInt64); | |
184 | ||
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; | |
188 | ||
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; | |
192 | ||
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); | |
195 | ||
196 | public | |
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; | |
216 | ||
217 | private | |
218 | // Internal Reading methods | |
219 | ||
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; | |
223 | ||
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; | |
227 | ||
228 | ||
229 | // encoding helpers | |
230 | ||
231 | // Convert from zigzag Integer to Integer. | |
232 | class function zigzagToInt( const n : Cardinal ) : Integer; | |
233 | ||
234 | // Convert from zigzag Int64 to Int64. | |
235 | class function zigzagToLong( const n : UInt64) : Int64; | |
236 | ||
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; | |
241 | ||
242 | // type testing and converting | |
243 | class function isBoolType( const b : byte) : Boolean; | |
244 | ||
245 | // Given a TCompactProtocol.Types constant, convert it to its corresponding TType value. | |
246 | class function getTType( const type_ : byte) : TType; | |
247 | ||
248 | // Given a TType value, find the appropriate TCompactProtocol.Types constant. | |
249 | class function getCompactType( const ttype : TType) : Byte; | |
250 | end; | |
251 | ||
252 | ||
253 | implementation | |
254 | ||
255 | ||
256 | ||
257 | //--- TCompactProtocolImpl.TFactory ---------------------------------------- | |
258 | ||
259 | ||
260 | function TCompactProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol; | |
261 | begin | |
262 | result := TCompactProtocolImpl.Create( trans); | |
263 | end; | |
264 | ||
265 | ||
266 | //--- TCompactProtocolImpl ------------------------------------------------- | |
267 | ||
268 | ||
269 | constructor TCompactProtocolImpl.Create(const trans: ITransport); | |
270 | begin | |
271 | inherited Create( trans); | |
272 | ||
273 | lastFieldId_ := 0; | |
274 | lastField_ := TStack<Integer>.Create; | |
275 | ||
276 | Init( booleanField_, '', TType.Stop, 0); | |
277 | boolValue_ := unused; | |
278 | end; | |
279 | ||
280 | ||
281 | destructor TCompactProtocolImpl.Destroy; | |
282 | begin | |
283 | try | |
284 | FreeAndNil( lastField_); | |
285 | finally | |
286 | inherited Destroy; | |
287 | end; | |
288 | end; | |
289 | ||
290 | ||
291 | ||
292 | procedure TCompactProtocolImpl.Reset; | |
293 | begin | |
294 | lastField_.Clear(); | |
295 | lastFieldId_ := 0; | |
296 | Init( booleanField_, '', TType.Stop, 0); | |
297 | boolValue_ := unused; | |
298 | end; | |
299 | ||
300 | ||
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); | |
304 | begin | |
305 | Transport.Write( @b, SizeOf(b)); | |
306 | end; | |
307 | ||
308 | ||
309 | // Writes a byte without any possibility of all that field header nonsense. | |
310 | procedure TCompactProtocolImpl.WriteByteDirect( const n : Integer); | |
311 | begin | |
312 | WriteByteDirect( Byte(n)); | |
313 | end; | |
314 | ||
315 | ||
316 | // Write an i32 as a varint. Results in 1-5 bytes on the wire. | |
317 | procedure TCompactProtocolImpl.WriteVarint32( n : Cardinal); | |
318 | var i32buf : TBytes; | |
319 | idx : Integer; | |
320 | begin | |
321 | SetLength( i32buf, 5); | |
322 | idx := 0; | |
323 | while TRUE do begin | |
324 | ASSERT( idx < Length(i32buf)); | |
325 | ||
326 | // last part? | |
327 | if ((n and not $7F) = 0) then begin | |
328 | i32buf[idx] := Byte(n); | |
329 | Inc(idx); | |
330 | Break; | |
331 | end; | |
332 | ||
333 | i32buf[idx] := Byte((n and $7F) or $80); | |
334 | Inc(idx); | |
335 | n := n shr 7; | |
336 | end; | |
337 | ||
338 | Transport.Write( i32buf, 0, idx); | |
339 | end; | |
340 | ||
341 | ||
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; | |
346 | begin | |
347 | Reset; | |
348 | ||
349 | versionAndType := Byte( VERSION and VERSION_MASK) | |
350 | or Byte( (Cardinal(msg.Type_) shl TYPE_SHIFT_AMOUNT) and TYPE_MASK); | |
351 | ||
352 | WriteByteDirect( PROTOCOL_ID); | |
353 | WriteByteDirect( versionAndType); | |
354 | WriteVarint32( Cardinal(msg.SeqID)); | |
355 | WriteString( msg.Name); | |
356 | end; | |
357 | ||
358 | ||
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); | |
363 | begin | |
364 | lastField_.Push(lastFieldId_); | |
365 | lastFieldId_ := 0; | |
366 | end; | |
367 | ||
368 | ||
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; | |
372 | begin | |
373 | lastFieldId_ := lastField_.Pop(); | |
374 | end; | |
375 | ||
376 | ||
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); | |
381 | begin | |
382 | case field.Type_ of | |
383 | TType.Bool_ : booleanField_ := field; // we want to possibly include the value, so we'll wait. | |
384 | else | |
385 | WriteFieldBeginInternal(field, $FF); | |
386 | end; | |
387 | end; | |
388 | ||
389 | ||
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; | |
394 | begin | |
395 | // if there's a type override, use that. | |
396 | if typeOverride = $FF | |
397 | then typeToWrite := getCompactType( field.Type_) | |
398 | else typeToWrite := typeOverride; | |
399 | ||
400 | // check if we can use delta encoding for the field id | |
401 | if (field.ID > lastFieldId_) and ((field.ID - lastFieldId_) <= 15) | |
402 | then begin | |
403 | // Write them together | |
404 | WriteByteDirect( ((field.ID - lastFieldId_) shl 4) or typeToWrite); | |
405 | end | |
406 | else begin | |
407 | // Write them separate | |
408 | WriteByteDirect( typeToWrite); | |
409 | WriteI16( field.ID); | |
410 | end; | |
411 | ||
412 | lastFieldId_ := field.ID; | |
413 | end; | |
414 | ||
415 | ||
416 | // Write the STOP symbol so we know there are no more fields in this struct. | |
417 | procedure TCompactProtocolImpl.WriteFieldStop; | |
418 | begin | |
419 | WriteByteDirect( Byte( Types.STOP)); | |
420 | end; | |
421 | ||
422 | ||
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); | |
426 | var key, val : Byte; | |
427 | begin | |
428 | if (map.Count = 0) | |
429 | then WriteByteDirect( 0) | |
430 | else begin | |
431 | WriteVarint32( Cardinal( map.Count)); | |
432 | key := getCompactType(map.KeyType); | |
433 | val := getCompactType(map.ValueType); | |
434 | WriteByteDirect( (key shl 4) or val); | |
435 | end; | |
436 | end; | |
437 | ||
438 | ||
439 | // Write a list header. | |
440 | procedure TCompactProtocolImpl.WriteListBegin( const list: TThriftList); | |
441 | begin | |
442 | WriteCollectionBegin( list.ElementType, list.Count); | |
443 | end; | |
444 | ||
445 | ||
446 | // Write a set header. | |
447 | procedure TCompactProtocolImpl.WriteSetBegin( const set_: TThriftSet ); | |
448 | begin | |
449 | WriteCollectionBegin( set_.ElementType, set_.Count); | |
450 | end; | |
451 | ||
452 | ||
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); | |
458 | var bt : Types; | |
459 | begin | |
460 | if b | |
461 | then bt := Types.BOOLEAN_TRUE | |
462 | else bt := Types.BOOLEAN_FALSE; | |
463 | ||
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; | |
468 | end | |
469 | else begin | |
470 | // we're not part of a field, so just Write the value. | |
471 | WriteByteDirect( Byte(bt)); | |
472 | end; | |
473 | end; | |
474 | ||
475 | ||
476 | // Write a byte. Nothing to see here! | |
477 | procedure TCompactProtocolImpl.WriteByte( b: ShortInt); | |
478 | begin | |
479 | WriteByteDirect( Byte(b)); | |
480 | end; | |
481 | ||
482 | ||
483 | // Write an I16 as a zigzag varint. | |
484 | procedure TCompactProtocolImpl.WriteI16( i16: SmallInt); | |
485 | begin | |
486 | WriteVarint32( intToZigZag( i16)); | |
487 | end; | |
488 | ||
489 | ||
490 | // Write an i32 as a zigzag varint. | |
491 | procedure TCompactProtocolImpl.WriteI32( i32: Integer); | |
492 | begin | |
493 | WriteVarint32( intToZigZag( i32)); | |
494 | end; | |
495 | ||
496 | ||
497 | // Write an i64 as a zigzag varint. | |
498 | procedure TCompactProtocolImpl.WriteI64( const i64: Int64); | |
499 | begin | |
500 | WriteVarint64( longToZigzag( i64)); | |
501 | end; | |
502 | ||
503 | ||
504 | class function TCompactProtocolImpl.DoubleToInt64Bits( const db : Double) : Int64; | |
505 | begin | |
506 | ASSERT( SizeOf(db) = SizeOf(result)); | |
507 | Move( db, result, SizeOf(result)); | |
508 | end; | |
509 | ||
510 | ||
511 | class function TCompactProtocolImpl.Int64BitsToDouble( const i64 : Int64) : Double; | |
512 | begin | |
513 | ASSERT( SizeOf(i64) = SizeOf(result)); | |
514 | Move( i64, result, SizeOf(result)); | |
515 | end; | |
516 | ||
517 | ||
518 | // Write a double to the wire as 8 bytes. | |
519 | procedure TCompactProtocolImpl.WriteDouble( const dub: Double); | |
520 | var data : TBytes; | |
521 | begin | |
522 | fixedLongToBytes( DoubleToInt64Bits(dub), data); | |
523 | Transport.Write( data); | |
524 | end; | |
525 | ||
526 | ||
527 | // Write a byte array, using a varint for the size. | |
528 | procedure TCompactProtocolImpl.WriteBinary( const b: TBytes); | |
529 | begin | |
530 | WriteVarint32( Cardinal(Length(b))); | |
531 | Transport.Write( b); | |
532 | end; | |
533 | ||
534 | procedure TCompactProtocolImpl.WriteMessageEnd; | |
535 | begin | |
536 | // nothing to do | |
537 | end; | |
538 | ||
539 | ||
540 | procedure TCompactProtocolImpl.WriteMapEnd; | |
541 | begin | |
542 | // nothing to do | |
543 | end; | |
544 | ||
545 | ||
546 | procedure TCompactProtocolImpl.WriteListEnd; | |
547 | begin | |
548 | // nothing to do | |
549 | end; | |
550 | ||
551 | ||
552 | procedure TCompactProtocolImpl.WriteSetEnd; | |
553 | begin | |
554 | // nothing to do | |
555 | end; | |
556 | ||
557 | ||
558 | procedure TCompactProtocolImpl.WriteFieldEnd; | |
559 | begin | |
560 | // nothing to do | |
561 | end; | |
562 | ||
563 | ||
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); | |
567 | begin | |
568 | if size <= 14 | |
569 | then WriteByteDirect( (size shl 4) or getCompactType(elemType)) | |
570 | else begin | |
571 | WriteByteDirect( $F0 or getCompactType(elemType)); | |
572 | WriteVarint32( Cardinal(size)); | |
573 | end; | |
574 | end; | |
575 | ||
576 | ||
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; | |
580 | idx : Integer; | |
581 | begin | |
582 | SetLength( varint64out, 10); | |
583 | idx := 0; | |
584 | while TRUE do begin | |
585 | ASSERT( idx < Length(varint64out)); | |
586 | ||
587 | // last one? | |
588 | if (n and not UInt64($7F)) = 0 then begin | |
589 | varint64out[idx] := Byte(n); | |
590 | Inc(idx); | |
591 | Break; | |
592 | end; | |
593 | ||
594 | varint64out[idx] := Byte((n and $7F) or $80); | |
595 | Inc(idx); | |
596 | n := n shr 7; | |
597 | end; | |
598 | ||
599 | Transport.Write( varint64out, 0, idx); | |
600 | end; | |
601 | ||
602 | ||
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; | |
606 | begin | |
607 | // there is no arithmetic right shift in Delphi | |
608 | if n >= 0 | |
609 | then result := UInt64(n shl 1) | |
610 | else result := UInt64(n shl 1) xor $FFFFFFFFFFFFFFFF; | |
611 | end; | |
612 | ||
613 | ||
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; | |
617 | begin | |
618 | // there is no arithmetic right shift in Delphi | |
619 | if n >= 0 | |
620 | then result := Cardinal(n shl 1) | |
621 | else result := Cardinal(n shl 1) xor $FFFFFFFF; | |
622 | end; | |
623 | ||
624 | ||
625 | // Convert a Int64 into 8 little-endian bytes in buf | |
626 | class procedure TCompactProtocolImpl.fixedLongToBytes( const n : Int64; var buf : TBytes); | |
627 | begin | |
628 | SetLength( buf, 8); | |
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); | |
637 | end; | |
638 | ||
639 | ||
640 | ||
641 | // Read a message header. | |
642 | function TCompactProtocolImpl.ReadMessageBegin : TThriftMessage; | |
643 | var protocolId, versionAndType, version, type_ : Byte; | |
644 | seqid : Integer; | |
645 | msgNm : String; | |
646 | begin | |
647 | Reset; | |
648 | ||
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)); | |
653 | ||
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)); | |
659 | ||
660 | type_ := Byte( (versionAndType shr TYPE_SHIFT_AMOUNT) and TYPE_BITS); | |
661 | seqid := Integer( ReadVarint32); | |
662 | msgNm := ReadString; | |
663 | Init( result, msgNm, TMessageType(type_), seqid); | |
664 | end; | |
665 | ||
666 | ||
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; | |
670 | begin | |
671 | lastField_.Push( lastFieldId_); | |
672 | lastFieldId_ := 0; | |
673 | Init( result); | |
674 | end; | |
675 | ||
676 | ||
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; | |
680 | begin | |
681 | // consume the last field we Read off the wire. | |
682 | lastFieldId_ := lastField_.Pop(); | |
683 | end; | |
684 | ||
685 | ||
686 | // Read a field header off the wire. | |
687 | function TCompactProtocolImpl.ReadFieldBegin: TThriftField; | |
688 | var type_ : Byte; | |
689 | modifier : ShortInt; | |
690 | fieldId : SmallInt; | |
691 | begin | |
692 | type_ := Byte( ReadByte); | |
693 | ||
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); | |
697 | Exit; | |
698 | end; | |
699 | ||
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); | |
702 | if (modifier = 0) | |
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. | |
705 | ||
706 | Init( result, '', getTType(Byte(type_ and $0F)), fieldId); | |
707 | ||
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; | |
714 | end; | |
715 | ||
716 | // push the new field onto the field stack so we can keep the deltas going. | |
717 | lastFieldId_ := result.ID; | |
718 | end; | |
719 | ||
720 | ||
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 | |
723 | // "correct" types. | |
724 | function TCompactProtocolImpl.ReadMapBegin: TThriftMap; | |
725 | var size : Integer; | |
726 | keyAndValueType : Byte; | |
727 | key, val : TType; | |
728 | begin | |
729 | size := Integer( ReadVarint32); | |
730 | if size = 0 | |
731 | then keyAndValueType := 0 | |
732 | else keyAndValueType := Byte( ReadByte); | |
733 | ||
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)); | |
738 | end; | |
739 | ||
740 | ||
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 | |
744 | // true size. | |
745 | function TCompactProtocolImpl.ReadListBegin: TThriftList; | |
746 | var size_and_type : Byte; | |
747 | size : Integer; | |
748 | type_ : TType; | |
749 | begin | |
750 | size_and_type := Byte( ReadByte); | |
751 | ||
752 | size := (size_and_type shr 4) and $0F; | |
753 | if (size = 15) | |
754 | then size := Integer( ReadVarint32); | |
755 | ||
756 | type_ := getTType( size_and_type); | |
757 | Init( result, type_, size); | |
758 | end; | |
759 | ||
760 | ||
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 | |
764 | // true size. | |
765 | function TCompactProtocolImpl.ReadSetBegin: TThriftSet; | |
766 | var size_and_type : Byte; | |
767 | size : Integer; | |
768 | type_ : TType; | |
769 | begin | |
770 | size_and_type := Byte( ReadByte); | |
771 | ||
772 | size := (size_and_type shr 4) and $0F; | |
773 | if (size = 15) | |
774 | then size := Integer( ReadVarint32); | |
775 | ||
776 | type_ := getTType( size_and_type); | |
777 | Init( result, type_, size); | |
778 | end; | |
779 | ||
780 | ||
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; | |
785 | begin | |
786 | if boolValue_ <> unused then begin | |
787 | result := (boolValue_ = bool_true); | |
788 | boolValue_ := unused; | |
789 | Exit; | |
790 | end; | |
791 | ||
792 | result := (Byte(ReadByte) = Byte(Types.BOOLEAN_TRUE)); | |
793 | end; | |
794 | ||
795 | ||
796 | // Read a single byte off the wire. Nothing interesting here. | |
797 | function TCompactProtocolImpl.ReadByte: ShortInt; | |
798 | begin | |
799 | Transport.ReadAll( @result, SizeOf(result), 0, 1); | |
800 | end; | |
801 | ||
802 | ||
803 | // Read an i16 from the wire as a zigzag varint. | |
804 | function TCompactProtocolImpl.ReadI16: SmallInt; | |
805 | begin | |
806 | result := SmallInt( zigzagToInt( ReadVarint32)); | |
807 | end; | |
808 | ||
809 | ||
810 | // Read an i32 from the wire as a zigzag varint. | |
811 | function TCompactProtocolImpl.ReadI32: Integer; | |
812 | begin | |
813 | result := zigzagToInt( ReadVarint32); | |
814 | end; | |
815 | ||
816 | ||
817 | // Read an i64 from the wire as a zigzag varint. | |
818 | function TCompactProtocolImpl.ReadI64: Int64; | |
819 | begin | |
820 | result := zigzagToLong( ReadVarint64); | |
821 | end; | |
822 | ||
823 | ||
824 | // No magic here - just Read a double off the wire. | |
825 | function TCompactProtocolImpl.ReadDouble:Double; | |
826 | var longBits : TBytes; | |
827 | begin | |
828 | SetLength( longBits, 8); | |
829 | Transport.ReadAll( longBits, 0, 8); | |
830 | result := Int64BitsToDouble( bytesToLong( longBits)); | |
831 | end; | |
832 | ||
833 | ||
834 | // Read a byte[] from the wire. | |
835 | function TCompactProtocolImpl.ReadBinary: TBytes; | |
836 | var length : Integer; | |
837 | begin | |
838 | length := Integer( ReadVarint32); | |
839 | SetLength( result, length); | |
840 | if (length > 0) | |
841 | then Transport.ReadAll( result, 0, length); | |
842 | end; | |
843 | ||
844 | ||
845 | procedure TCompactProtocolImpl.ReadMessageEnd; | |
846 | begin | |
847 | // nothing to do | |
848 | end; | |
849 | ||
850 | ||
851 | procedure TCompactProtocolImpl.ReadFieldEnd; | |
852 | begin | |
853 | // nothing to do | |
854 | end; | |
855 | ||
856 | ||
857 | procedure TCompactProtocolImpl.ReadMapEnd; | |
858 | begin | |
859 | // nothing to do | |
860 | end; | |
861 | ||
862 | ||
863 | procedure TCompactProtocolImpl.ReadListEnd; | |
864 | begin | |
865 | // nothing to do | |
866 | end; | |
867 | ||
868 | ||
869 | procedure TCompactProtocolImpl.ReadSetEnd; | |
870 | begin | |
871 | // nothing to do | |
872 | end; | |
873 | ||
874 | ||
875 | ||
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; | |
879 | var shift : Integer; | |
880 | b : Byte; | |
881 | begin | |
882 | result := 0; | |
883 | shift := 0; | |
884 | while TRUE do begin | |
885 | b := Byte( ReadByte); | |
886 | result := result or (Cardinal(b and $7F) shl shift); | |
887 | if ((b and $80) <> $80) | |
888 | then Break; | |
889 | Inc( shift, 7); | |
890 | end; | |
891 | end; | |
892 | ||
893 | ||
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; | |
897 | var shift : Integer; | |
898 | b : Byte; | |
899 | begin | |
900 | result := 0; | |
901 | shift := 0; | |
902 | while TRUE do begin | |
903 | b := Byte( ReadByte); | |
904 | result := result or (UInt64(b and $7F) shl shift); | |
905 | if ((b and $80) <> $80) | |
906 | then Break; | |
907 | Inc( shift, 7); | |
908 | end; | |
909 | end; | |
910 | ||
911 | ||
912 | // Convert from zigzag Integer to Integer. | |
913 | class function TCompactProtocolImpl.zigzagToInt( const n : Cardinal ) : Integer; | |
914 | begin | |
915 | result := Integer(n shr 1) xor (-Integer(n and 1)); | |
916 | end; | |
917 | ||
918 | ||
919 | // Convert from zigzag Int64 to Int64. | |
920 | class function TCompactProtocolImpl.zigzagToLong( const n : UInt64) : Int64; | |
921 | begin | |
922 | result := Int64(n shr 1) xor (-Int64(n and 1)); | |
923 | end; | |
924 | ||
925 | ||
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; | |
930 | begin | |
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)); | |
940 | end; | |
941 | ||
942 | ||
943 | class function TCompactProtocolImpl.isBoolType( const b : byte) : Boolean; | |
944 | var lowerNibble : Byte; | |
945 | begin | |
946 | lowerNibble := b and $0f; | |
947 | result := (Types(lowerNibble) in [Types.BOOLEAN_TRUE, Types.BOOLEAN_FALSE]); | |
948 | end; | |
949 | ||
950 | ||
951 | // Given a TCompactProtocol.Types constant, convert it to its corresponding TType value. | |
952 | class function TCompactProtocolImpl.getTType( const type_ : byte) : TType; | |
953 | var tct : Types; | |
954 | begin | |
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))); | |
959 | end; | |
960 | ||
961 | ||
962 | // Given a TType value, find the appropriate TCompactProtocol.Types constant. | |
963 | class function TCompactProtocolImpl.getCompactType( const ttype : TType) : Byte; | |
964 | begin | |
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))); | |
968 | end; | |
969 | ||
970 | ||
971 | //--- unit tests ------------------------------------------- | |
972 | ||
973 | {$IFDEF Debug} | |
974 | procedure TestDoubleToInt64Bits; | |
975 | ||
976 | procedure TestPair( const a : Double; const b : Int64); | |
977 | begin | |
978 | ASSERT( TCompactProtocolImpl.DoubleToInt64Bits(a) = b); | |
979 | ASSERT( TCompactProtocolImpl.Int64BitsToDouble(b) = a); | |
980 | end; | |
981 | ||
982 | begin | |
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)); | |
1005 | ||
1006 | // NaN is special | |
1007 | ASSERT( TCompactProtocolImpl.DoubleToInt64Bits( NaN) = Int64($FFF8000000000000)); | |
1008 | ASSERT( IsNan( TCompactProtocolImpl.Int64BitsToDouble( Int64($FFF8000000000000)))); | |
1009 | end; | |
1010 | {$ENDIF} | |
1011 | ||
1012 | ||
1013 | {$IFDEF Debug} | |
1014 | procedure TestZigZag; | |
1015 | ||
1016 | procedure Test32( const test : Integer); | |
1017 | var zz : Cardinal; | |
1018 | begin | |
1019 | zz := TCompactProtocolImpl.intToZigZag(test); | |
1020 | ASSERT( TCompactProtocolImpl.zigzagToInt(zz) = test, IntToStr(test)); | |
1021 | end; | |
1022 | ||
1023 | procedure Test64( const test : Int64); | |
1024 | var zz : UInt64; | |
1025 | begin | |
1026 | zz := TCompactProtocolImpl.longToZigzag(test); | |
1027 | ASSERT( TCompactProtocolImpl.zigzagToLong(zz) = test, IntToStr(test)); | |
1028 | end; | |
1029 | ||
1030 | var i : Integer; | |
1031 | begin | |
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'); | |
1039 | ||
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'); | |
1047 | ||
1048 | // back and forth 32 | |
1049 | Test32( 0); | |
1050 | for i := 0 to 30 do begin | |
1051 | Test32( +(Integer(1) shl i)); | |
1052 | Test32( -(Integer(1) shl i)); | |
1053 | end; | |
1054 | Test32( Integer($7FFFFFFF)); | |
1055 | Test32( Integer($80000000)); | |
1056 | ||
1057 | // back and forth 64 | |
1058 | Test64( 0); | |
1059 | for i := 0 to 62 do begin | |
1060 | Test64( +(Int64(1) shl i)); | |
1061 | Test64( -(Int64(1) shl i)); | |
1062 | end; | |
1063 | Test64( Int64($7FFFFFFFFFFFFFFF)); | |
1064 | Test64( Int64($8000000000000000)); | |
1065 | end; | |
1066 | {$ENDIF} | |
1067 | ||
1068 | ||
1069 | {$IFDEF Debug} | |
1070 | procedure TestLongBytes; | |
1071 | ||
1072 | procedure Test( const test : Int64); | |
1073 | var buf : TBytes; | |
1074 | begin | |
1075 | TCompactProtocolImpl.fixedLongToBytes( test, buf); | |
1076 | ASSERT( TCompactProtocolImpl.bytesToLong( buf) = test, IntToStr(test)); | |
1077 | end; | |
1078 | ||
1079 | var i : Integer; | |
1080 | begin | |
1081 | Test( 0); | |
1082 | for i := 0 to 62 do begin | |
1083 | Test( +(Int64(1) shl i)); | |
1084 | Test( -(Int64(1) shl i)); | |
1085 | end; | |
1086 | Test( Int64($7FFFFFFFFFFFFFFF)); | |
1087 | Test( Int64($8000000000000000)); | |
1088 | end; | |
1089 | {$ENDIF} | |
1090 | ||
1091 | ||
1092 | {$IFDEF Debug} | |
1093 | procedure UnitTest; | |
1094 | var w : WORD; | |
1095 | const FPU_CW_DENORMALIZED = $0002; | |
1096 | begin | |
1097 | w := Get8087CW; | |
1098 | try | |
1099 | Set8087CW( w or FPU_CW_DENORMALIZED); | |
1100 | ||
1101 | TestDoubleToInt64Bits; | |
1102 | TestZigZag; | |
1103 | TestLongBytes; | |
1104 | ||
1105 | finally | |
1106 | Set8087CW( w); | |
1107 | end; | |
1108 | end; | |
1109 | {$ENDIF} | |
1110 | ||
1111 | ||
1112 | initialization | |
1113 | {$IFDEF Debug} | |
1114 | UnitTest; | |
1115 | {$ENDIF} | |
1116 | ||
1117 | end. | |
1118 |