* synchronize with trunk

git-svn-id: branches/unicodekvm@41679 -

compiler/systems/i_bsd.pas

@@ -338,7 +338,7 @@ unit i_bsd;
             system       : system_i386_OpenBSD;
             name         : 'OpenBSD for i386';
             shortname    : 'OpenBSD';
-            flags        : [tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_sections,tf_has_winlike_resources];
+            flags        : [tf_pic_default,tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_sections,tf_has_winlike_resources];
             cpu          : cpu_i386;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';

packages/pastojs/src/fppas2js.pp

@@ -792,11 +792,11 @@ const
     'rc',  // rtl.rc
     'rcCharAt',  // rtl.rcCharAt
     'rcSetCharAt',  // rtl.rcSetCharAt
-    '$assign',
-    '$clone',
-    'recNewT',
-    '$eq',
-    '$new',
+    '$assign', // pbifnRecordAssign
+    '$clone', // pbifnRecordClone
+    'recNewT', // pbifnRecordNew
+    '$eq', // pbifnRecordEqual
+    '$new', // pbifnRecordNew
     'addField',
     'addFields',
     'addMethod',
@@ -5110,7 +5110,7 @@ begin
       else if C=TPasRecordType then
         begin
         // typecast to recordtype
-        if FromResolved.BaseType=btNone then
+        if FromResolved.BaseType=btUntyped then
           // recordtype(untyped) -> ok
         else if FromResolved.BaseType=btContext then
           begin
@@ -9516,7 +9516,7 @@ var
   Param, Value: TPasExpr;
   JSBaseType: TPas2jsBaseType;
   C: TClass;
-  aName: String;
+  aName, ArgName: String;
   aClassTypeEl: TPasClassType;
   ParamTypeEl, TypeEl: TPasType;
   NeedIntfRef: Boolean;
@@ -9666,6 +9666,15 @@ begin
       aResolver.ComputeElement(Param,ParamResolved,[]);
       ParamTypeEl:=ParamResolved.LoTypeEl;
 
+      if (C=TPasRecordType) and (ParamResolved.BaseType=btUntyped)
+          and (ParamResolved.IdentEl is TPasArgument) then
+        begin
+        // RecordType(UntypedArg) -> UntypedArg
+        ArgName:=TransformArgName(TPasArgument(ParamResolved.IdentEl),AContext);
+        Result:=CreatePrimitiveDotExpr(ArgName,El);
+        exit;
+        end;
+
       Result:=ConvertExpression(Param,AContext);
 
       if C=TPasRangeType then
@@ -21594,6 +21603,9 @@ begin
 
   aResolver.ComputeElement(El,ExprResolved,ExprFlags);
 
+  if (TargetArg.ArgType=nil) and (ExprResolved.LoTypeEl is TPasRecordType) then
+    NeedVar:=false; // pass aRecord to UntypedArg -> no reference needed
+
   // consider TargetArg access
   if NeedVar then
     Result:=CreateProcCallArgRef(El,ExprResolved,TargetArg,AContext)
@@ -22077,7 +22089,7 @@ begin
         // create  SetExpr.$assign(v)
         Call:=CreateCallExpression(El);
         Call.Expr:=CreateDotNameExpr(El,SetExpr,
-                                       TJSString(GetBIName(pbifnRecordAssign)));
+                                     TJSString(GetBIName(pbifnRecordAssign)));
         Call.AddArg(RHS);
         SetExpr:=Call;
         end
@@ -22232,6 +22244,40 @@ begin
   TypeEl:=AContext.Resolver.ResolveAliasType(Arg.ArgType);
   IsRecord:=TypeEl is TPasRecordType;
 
+  if AContext.Access=caAssign then
+    begin
+    AssignContext:=AContext.AccessContext as TAssignContext;
+    if IsRecord then
+      begin
+      // aRecordArg:=right  ->  "aRecordArg.$assign(right)"
+      if AssignContext.Call<>nil then
+        RaiseNotSupported(Arg,AContext,20190105174026);
+      Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
+      exit;
+      end
+    else if (Arg.ArgType=nil)
+        and (AssignContext.RightResolved.LoTypeEl is TPasRecordType)
+        and (rrfReadable in AssignContext.RightResolved.Flags) then
+      begin
+      // UntypedArg:=aRecordVar  ->  "UntypedArg.$assign(right)"
+      // Note: records are passed directly to Untyped parameters
+      if AssignContext.Call<>nil then
+        RaiseNotSupported(Arg,AContext,20190311140048);
+      Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
+      exit;
+      end;
+    end
+  else if IsRecord and (AContext is TParamContext) then
+    begin
+    ParamContext:=TParamContext(AContext);
+    if ParamContext.ResolvedExpr.BaseType=btUntyped then
+      begin
+      // pass aRecordVar to UntypedArg -> pass aRecordVar directly, no temp ref object
+      Result:=CreatePrimitiveDotExpr(ArgName,PosEl);
+      exit;
+      end;
+    end;
+
   if (Arg.Access in [argVar,argOut]) and not IsRecord then
     begin
     // Arg is a reference object
@@ -22266,18 +22312,6 @@ begin
       else
         RaiseNotSupported(Arg,AContext,20170214120739);
     end;
-    end
-  else if AContext.Access=caAssign then
-    begin
-    AssignContext:=AContext.AccessContext as TAssignContext;
-    if AssignContext.LeftResolved.LoTypeEl is TPasRecordType then
-      begin
-      // aRecordArg:=right  ->  "aRecordArg.$assign(right)"
-      if AssignContext.Call<>nil then
-        RaiseNotSupported(Arg,AContext,20190105174026);
-      Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
-      exit;
-      end;
     end;
   Result:=CreatePrimitiveDotExpr(ArgName,PosEl);
 end;

packages/pastojs/tests/tcmodules.pas

@@ -10078,15 +10078,19 @@ begin
   '  U:=vd;',
   '  U:=vc;',
   '  U:=vv;',
+  '  vl:=TRecord(U);',
+  '  vd:=TRecord(U);',
+  '  vv:=TRecord(U);',
   '  doit(vd,vd,vd,vd);',
   '  doit(vc,vc,vl,vl);',
   '  doit(vv,vv,vv,vv);',
   '  doit(vl,vl,vl,vl);',
-  //'  TRecord(U).i:=3;',
+  '  TRecord(U).i:=3;',
   'end;',
   'var i: TRecord;',
   'begin',
-  '  doit(i,i,i,i);']);
+  '  doit(i,i,i,i);',
+  '']);
   ConvertProgram;
   CheckSource('TestRecord_AsParams',
     LinesToStr([ // statements
@@ -10107,55 +10111,23 @@ begin
     '  vL.$assign(vC);',
     '  vV.$assign(vV);',
     '  vV.i = vV.i;',
-    '  U.set(vL);',
-    '  U.set(vD);',
-    '  U.set(vC);',
-    '  U.set(vV);',
-    '  $mod.DoIt($mod.TRecord.$clone(vD), vD, vD, {',
-    '    get: function () {',
-    '        return vD;',
-    '      },',
-    '    set: function (v) {',
-    '        vD.$assign(v);',
-    '      }',
-    '  });',
-    '  $mod.DoIt($mod.TRecord.$clone(vC), vC, vL, {',
-    '    get: function () {',
-    '        return vL;',
-    '      },',
-    '    set: function (v) {',
-    '        vL.$assign(v);',
-    '      }',
-    '  });',
-    '  $mod.DoIt($mod.TRecord.$clone(vV), vV, vV, {',
-    '    get: function () {',
-    '        return vV;',
-    '      },',
-    '    set: function (v) {',
-    '        vV.$assign(v);',
-    '      }',
-    '  });',
-    '  $mod.DoIt($mod.TRecord.$clone(vL), vL, vL, {',
-    '    get: function () {',
-    '        return vL;',
-    '      },',
-    '    set: function (v) {',
-    '        vL.$assign(v);',
-    '      }',
-    '  });',
+    '  U.$assign(vL);',
+    '  U.$assign(vD);',
+    '  U.$assign(vC);',
+    '  U.$assign(vV);',
+    '  vL.$assign(U);',
+    '  vD.$assign(U);',
+    '  vV.$assign(U);',
+    '  $mod.DoIt($mod.TRecord.$clone(vD), vD, vD, vD);',
+    '  $mod.DoIt($mod.TRecord.$clone(vC), vC, vL, vL);',
+    '  $mod.DoIt($mod.TRecord.$clone(vV), vV, vV, vV);',
+    '  $mod.DoIt($mod.TRecord.$clone(vL), vL, vL, vL);',
+    '  U.i = 3;',
     '};',
     'this.i = $mod.TRecord.$new();'
     ]),
     LinesToStr([
-    '$mod.DoIt($mod.TRecord.$clone($mod.i), $mod.i, $mod.i, {',
-    '  p: $mod,',
-    '  get: function () {',
-    '      return this.p.i;',
-    '    },',
-    '  set: function (v) {',
-    '      this.p.i.$assign(v);',
-    '    }',
-    '});',
+    '$mod.DoIt($mod.TRecord.$clone($mod.i), $mod.i, $mod.i, $mod.i);',
     '']));
 end;
 

packages/rtl-console/src/unix/keyboard.pp

@@ -128,7 +128,7 @@ procedure SetRawMode(b:boolean);
 var Tio:Termios;
 
 begin
-  TCGetAttr(1,Tio);
+  TCGetAttr(0,Tio);
   if b then
    begin
      {Standard output now needs #13#10.}
@@ -142,7 +142,7 @@ begin
       {Standard output normally needs just a linefeed.}
       settextlineending(output,#10);
     end;
-  TCsetattr(1,TCSANOW,Tio);
+  TCsetattr(0,TCSANOW,Tio);
 end;
 
 {$ifdef linux}

rtl/openbsd/termios.inc

@@ -55,17 +55,16 @@ Type
 
 
 type
-  Termios = packed record
+  tcflag_t = cuint;
+  cc_t = cuchar;
+  Termios = record
     c_iflag,
     c_oflag,
     c_cflag,
-    c_lflag  : longint;
-//    c_line   : char;
-    c_cc     : array[0..NCCS-1] of byte;
-   {$IFDEF BSD}
+    c_lflag  : tcflag_t;
+    c_cc     : array[0..NCCS-1] of cc_t;
     c_ispeed,
-    c_ospeed : longint;
-   {$endif}
+    c_ospeed : cint;
   end;
   TTermios=Termios;
 
@@ -92,6 +91,7 @@ CONST
         IXON            =     $200;     { enable output flow control }
         IXOFF           =     $400;     { enable input flow control }
         IXANY           =     $800;     { any char will restart after stop }
+        IUCLC           =    $1000;     { translate upper to lower case }
         IMAXBEL         =    $2000;     { ring bell on input queue full }
 
 {
@@ -101,6 +101,10 @@ CONST
         ONLCR           =       $2;     { map NL to CR-NL (ala CRMOD) }
         OXTABS          =       $4;     { expand tabs to spaces }
         ONOEOT          =       $8;     { discard EOT's (^D) on output) }
+        OCRNL           =      $10;     { map CR to NL }
+        OLCUC           =      $20;     { translate lower case to upper case }
+        ONOCR           =      $40;     { No CR output at column 0 }
+        ONLRET          =      $80;     { NL performs the CR function }
 
 {
  * Control flags - hardware control of terminal
@@ -117,13 +121,11 @@ CONST
         PARODD          =    $2000;     { odd parity, else even }
         HUPCL           =    $4000;     { hang up on last close }
         CLOCAL          =    $8000;     { ignore modem status lines }
-        CCTS_OFLOW      =   $10000;     { CTS flow control of output }
-        CRTS_IFLOW      =   $20000;     { RTS flow control of input }
-        CRTSCTS         =   (CCTS_OFLOW or CRTS_IFLOW);
-        CDTR_IFLOW      =   $40000;     { DTR flow control of input }
-        CDSR_OFLOW      =   $80000;     { DSR flow control of output }
-        CCAR_OFLOW      =  $100000;     { DCD flow control of output }
-        MDMBUF          =  $100000;     { old name for CCAR_OFLOW }
+        CRTSCTS         =   $10000;     { RTS/CTS full-duplex flow control }
+        CRTS_IFLOW      =  CRTSCTS;     { XXX compat }
+        CCTS_OFLOW      =  CRTSCTS;     { XXX compat }
+        MDMBUF          =  $100000;     { DTR/DCD hardware flow control }
+        CHWFLOW    = MDMBUF or CRTSCTS; { all types of hw flow control }
 
 {
  * "Local" flags - dumping ground for other state
@@ -144,9 +146,10 @@ CONST
         ICANON          =     $100;     { canonicalize input lines }
         ALTWERASE       =     $200;     { use alternate WERASE algorithm }
         IEXTEN          =     $400;     { enable DISCARD and LNEXT }
-        EXTPROC         =     $800;      { external processing }
+        EXTPROC         =     $800;     { external processing }
         TOSTOP          =  $400000;     { stop background jobs from output }
         FLUSHO          =  $800000;     { output being flushed (state) }
+        XCASE           = $1000000;     { canonical upper/lower case }
         NOKERNINFO      = $2000000;     { no kernel output from VSTATUS }
         PENDIN          =$20000000;     { XXX retype pending input (state) }
         NOFLSH          =$80000000;     { don't flush after interrupt }

utils/pas2js/docs/translation.html

@@ -65,6 +65,7 @@
     <a href="#functiontype">Translating function types</a><br>
     <a href="#absolute">Translating var modifier absolute</a><br>
     <a href="#assert">Translating assert()</a><br>
+    <a href="#dispatch">TObject.Dispatch</a><br>
     <a href="#calljavascript">Calling JavaScript from Pascal</a><br>
     <a href="#asm">The asm block</a><br>
     <a href="#assembler">The procedure modifier assembler</a><br>
@@ -630,8 +631,8 @@ End.
       <tbody>
         <tr>
           <th>Pascal</th>
-          <th>JS Pas2js 1.2</th>
           <th>JS Pas2js 1.3</th>
+          <th>JS Pas2js 1.2</th>
         </tr>
         <tr>
           <td>
@@ -658,26 +659,26 @@ End.
 ["System"],
 function(){
   var $mod = this;
-  this.TMyRecord = function(s) {
-    if (s){
+  rtl.recNewT($mod, "TMyRecord", function() {
+    this.i = 0;
+    this.s = "";
+    this.d = 0.0;
+    this.$eq = function (b) {
+      return (this.i == b.i) &&
+         (this.s == b.i) && (this.d == b.d);
+    };
+    this.$assign = function (s) {
       this.i = s.i;
       this.s = s.s;
       this.d = s.d;
-    } else {
-      this.i = 0;
-      this.s = "";
-      this.d = 0.0;
-    };
-    this.$equal = function (b) {
-      return (this.i == b.i) &&
-        (this.s == b.i) && (this.d == b.d);
+      return this;
     };
   };
-  this.r = new this.TMyRecord();
+  this.r = this.TMyRecord.$new();
   $mod.$init = function() {
     $mod.r.i=123;
-    $mod.r = new $mod.TMyRecord($mod.s);
-    if ($mod.r.$equal($mod.s)) ;
+    $mod.r.$assign($mod.s);
+    if ($mod.r.$eq($mod.s)) ;
   },
 },
 []);
@@ -688,26 +689,26 @@ function(){
 ["System"],
 function(){
   var $mod = this;
-  rtl.recNewT($mod, "TMyRecord", function() {
-    this.i = 0;
-    this.s = "";
-    this.d = 0.0;
-    this.$eq = function (b) {
-      return (this.i == b.i) &&
-         (this.s == b.i) && (this.d == b.d);
-    };
-    this.$assign = function (s) {
+  this.TMyRecord = function(s) {
+    if (s){
       this.i = s.i;
       this.s = s.s;
       this.d = s.d;
-      return this;
+    } else {
+      this.i = 0;
+      this.s = "";
+      this.d = 0.0;
+    };
+    this.$equal = function (b) {
+      return (this.i == b.i) &&
+        (this.s == b.i) && (this.d == b.d);
     };
   };
-  this.r = this.TMyRecord.$new();
+  this.r = new this.TMyRecord();
   $mod.$init = function() {
     $mod.r.i=123;
-    $mod.r.$assign($mod.s);
-    if ($mod.r.$eq($mod.s)) ;
+    $mod.r = new $mod.TMyRecord($mod.s);
+    if ($mod.r.$equal($mod.s)) ;
   },
 },
 []);
@@ -756,6 +757,9 @@ function(){
           <li><i>Dispose(PointerOfRecord)</i> Sets the variable to null if possible.</li>
         </ul>
       </li>
+      <li>Passing a record to an untyped arguments (e.g. ''TObject.Dispatch(var Msg)'')
+        passes the record JS object directly, not creating a temporary reference object.</li>
+      <li>Typecasting RecordType(UntypedArgument) returns the argument, i.e. no conversion.</li>
     </ul>
     </div>
 
@@ -2266,6 +2270,21 @@ End.
     </ul>
     </div>
 
+    <div class="section">
+    <h2 id="dispatch">TObject.Dispatch</h2>
+    The procedure modifier '''message''' and the ''TObject.Dispatch'' works
+    similar to FPC/Delphi, as it expects a record of a specific format and
+    ''Dispatch'' calls the method with that message number or string.<br>
+    The procedure modifier '''message &lt;integer&gt;''' adds an entry to the
+    ''$msgint'' object, and modifier '''message &lt;string&gt;''' adds an entry
+    to the ''$msgstr'' object.<br>
+    The '''TObject.Dispatch''' expects as argument a record with an integer
+    field ''Msg'' (case sensitive).<br>
+    The '''TObject.DispatchStr''' expects as argument a record with a string
+    field ''MsgStr'' (case sensitive).<br>
+    </div>
+
+
     <div class="section">
     <h2 id="calljavascript">Calling JavaScript from Pascal</h2>
     Pas2js allows to write low level functions and/or access a JavaScript library