/pliant/util/encoding/general.pli
 
 1  module "/pliant/language/unsafe.pli" 
 2   
 3  constant optimized true 
 4   
 5  if optimized 
 6   
 7    function general_encode clear tag code -> encoded 
 8      arg Str clear ; arg Int tag ; arg (Array uInt8 256) code ; arg Str encoded 
 9      var Int reserved := 2*clear:len+4 
 10      var Address buf := memory_allocate reserved addressof:encoded 
 11      var Address dest := buf 
 12      var Address src := clear characters 
 13      var Address stop := src translate Char clear:len 
 14      while src<>stop 
 15        var Int := src map uInt8 
 16        var Int cc := code c 
 17        if cc<>0 
 18          dest map uInt8 := cc ; dest := dest translate Char 1 
 19        else 
 20          var Int required := ((cast dest Int).-.(cast buf Int))+2+((cast stop Int).-.(cast src Int)) 
 21          if required>reserved 
 22            var Int offset := (cast dest Int).-.(cast buf Int) 
 23            reserved := 2*reserved+2 
 24            buf := memory_resize buf reserved addressof:encoded 
 25            dest := buf translate Byte offset 
 26          dest map uInt8 := tag ; dest := dest translate Char 1 
 27          var Int cc := c\16 
 28          dest map uInt8 := cc+(shunt cc<10 "0":number "A":number-10) ; dest := dest translate Char 1 
 29          var Int cc := c%16 
 30          dest map uInt8 := cc+(shunt cc<10 "0":number "A":number-10) ; dest := dest translate Char 1 
 31        src := src translate Char 1 
 32        check (cast dest Int).-.(cast buf Int)<=reserved 
 33      reserved := (cast dest Int).-.(cast buf Int) 
 34      buf := memory_resize buf reserved addressof:encoded 
 35      encoded set buf reserved true 
 36   
 37  else 
 38   
 39    function general_encode clear tag code -> encoded 
 40      arg Str clear ; arg Int tag ; arg (Array uInt8 256) code ; arg Str encoded 
 41      encoded := clear 
 42      var Int i := 0 
 43      while i<encoded:len 
 44        var Int c := encoded:i:number 
 45        var Int cc := code c 
 46        if cc<>0 
 47          encoded:i := character cc 
 48          i += 1 
 49        else 
 50          encoded := (encoded 0 i)+character:tag+(right (string c "radix 16") 2 "0")+(encoded i+1 encoded:len) 
 51          i += 3 
 52   
 53   
 54  if optimized 
 55   
 56    function unhexa c -> i 
 57      arg Int i 
 58      if c>="0":number and c<="9":number 
 59        := c-"0":number 
 60      eif c>="A":number and c<="F":number 
 61        := c-("A":number-10) 
 62      eif c>="a":number and c<="f":number 
 63        := c-("a":number-10) 
 64      else 
 65        := 0 
 66   
 67    function general_decode encoded tag -> clear 
 68      arg Str encoded clear ; arg Int tag 
 69      var Address buf := memory_allocate encoded:len addressof:clear 
 70      var Address dest := buf 
 71      var Address src := encoded:characters 
 72      var Address stop := encoded:characters translate Char encoded:len 
 73      var uInt8 tag8 := tag 
 74      while true 
 75        var Address tag1 := memory_search src (max (cast stop Int).-.(cast src Int)-2 0) addressof:tag8 1 
 76        if tag1=null 
 77          tag1 := stop 
 78        var Int step := (cast tag1 Int).-.(cast src Int) 
 79        memory_copy src dest step ; dest := dest translate Byte step 
 80        if tag1=stop 
 81          clear set buf (cast dest Int).-.(cast buf Int) true 
 82          return 
 83        src := src translate Byte step 
 84        dest map uInt8 := unhexa:((src translate uInt8 1) map uInt8)*16+unhexa:((src translate uInt8 2) map uInt8) 
 85        src := src translate uInt8 3 
 86        dest := dest translate uInt8 1 
 87      var Int len := (cast dest Int).-.(cast buf Int) 
 88      buf := memory_resize buf len addressof:encoded 
 89      clear set buf len true 
 90     
 91  else 
 92   
 93    function unhexa s -> i 
 94      arg Str s ; arg Int i 
 95      i := 0 
 96      for (var Int j) 0 s:len-1 
 97        var Int c := s:j number 
 98        if c>="0":0:number and c<="9":0:number 
 99          i := i*16+(c-"0":0:number) 
 100        eif c>="A":0:number and c<="F":0:number 
 101          i := i*16+(c-"A":0:number+10) 
 102        eif c>="a":0:number and c<="f":0:number 
 103          i := i*16+(c-"a":0:number+10) 
 104        else 
 105          return undefined 
 106     
 107    function general_decode encoded tag -> clear 
 108      arg Str encoded clear ; arg Int tag 
 109      clear := encoded 
 110      var Int i := -1 
 111      while { i := ((clear i+1 clear:len) search character:tag -(i+2))+(i+1) ; i<>(-1) } and i+2<clear:len 
 112        var Int h := unhexa (clear i+1 2) 
 113        if h=defined 
 114          clear := (clear 0 i)+character:h+(clear i+3 clear:len) 
 115   
 116   
 117  function general_code keep -> code 
 118    arg Str keep ; arg (Array uInt8 256) code 
 119    for (var Int u) 0 255 
 120      code := shunt u>="a":0:number and u<="z":0:number or u>="A":0:number and u<="Z":0:number or u>="0":0:number and u<="9":0:number or (keep search character:-1)<>(-1) 0 
 121   
 122  export general_encode general_decode general_code