Merge remote-tracking branch 'origin/main' into unicodekvm

.gitignore

@@ -27,6 +27,7 @@
 *.diff
 *.lst
 *.app
+*.ttp
 fpcmade.*
 *-stamp.*
 build-stamp.*

compiler/constexp.pas

@@ -26,9 +26,6 @@ unit constexp;
 
 interface
 
-  uses
-    sfpux80;
-
 type  Tconstexprint=record
         overflow:boolean;
         case signed:boolean of
@@ -40,8 +37,6 @@ type  Tconstexprint=record
 
       errorproc=procedure (i:longint);
 
-      TConstExprFloat = float128;
-
 {"Uses verbose" gives a dependency on cpuinfo through globals. This leads
  build trouble when compiling the directory utils, since the cpu directory
  isn't searched there. Therefore we use a procvar and make verbose install

compiler/fpcdefs.inc

@@ -276,10 +276,10 @@
   {$endif mips}
 {$endif mipsel}
 
-{$ifdef mips64}
+{$ifdef mips64eb}
   {$define mips}
   {$define mips64}
-{$endif mips64}
+{$endif mips64eb}
 
 {$ifdef mips64el}
   {$define mips}

compiler/hlcg2ll.pas

@@ -1492,10 +1492,14 @@ implementation
             LOC_CMMREGISTER:
               cg.a_loadmm_ref_cgpara(list,locsize,l.reference,cgpara,mms_movescalar);
             { Some targets pass floats in normal registers }
+            LOC_REFERENCE,
+            LOC_CREFERENCE:
+              if use_vectorfpu(size) then
+                cg.a_loadmm_ref_cgpara(list,locsize,l.reference,cgpara,mms_movescalar)
+              else
+                cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara);
             LOC_REGISTER,
             LOC_CREGISTER,
-            LOC_REFERENCE,
-            LOC_CREFERENCE,
             LOC_FPUREGISTER,
             LOC_CFPUREGISTER:
               cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara);

compiler/i386/cgcpu.pas

@@ -378,6 +378,10 @@ unit cgcpu;
             list.concat(Taicpu.Op_reg(A_POP,S_W,NR_FS));
             list.concat(Taicpu.Op_reg(A_POP,S_W,NR_GS));
             { this restores the flags }
+
+            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+              list.concat(tai_regalloc.dealloc(NR_STACK_POINTER_REG,nil));
+
             list.concat(Taicpu.Op_none(A_IRET,S_NO));
           end
         { Routines with the poclearstack flag set use only a ret }
@@ -388,6 +392,9 @@ unit cgcpu;
            { but not on win32 }
            { and not for safecall with hidden exceptions, because the result }
            { wich contains the exception is passed in EAX }
+           if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+             list.concat(tai_regalloc.dealloc(NR_STACK_POINTER_REG,nil));
+
            if ((target_info.system <> system_i386_win32) or
                (target_info.abi=abi_old_win32_gnu)) and
               not ((current_procinfo.procdef.proccalloption = pocall_safecall) and
@@ -398,16 +405,27 @@ unit cgcpu;
            else
              list.concat(Taicpu.Op_none(A_RET,S_NO));
          end
+
         { ... also routines with parasize=0 }
         else if (parasize=0) then
-         list.concat(Taicpu.Op_none(A_RET,S_NO))
+         begin
+           if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+             list.concat(tai_regalloc.dealloc(NR_STACK_POINTER_REG,nil));
+
+           list.concat(Taicpu.Op_none(A_RET,S_NO))
+         end
         else
          begin
            { parameters are limited to 65535 bytes because ret allows only imm16 }
            if (parasize>65535) then
              CGMessage(cg_e_parasize_too_big);
+
+           if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+             list.concat(tai_regalloc.dealloc(NR_STACK_POINTER_REG,nil));
+
            list.concat(Taicpu.Op_const(A_RET,S_W,parasize));
          end;
+
       end;
 
 

compiler/m68k/cgcpu.pas

@@ -930,7 +930,13 @@ unit cgcpu;
        opsize: topsize;
        needsext: boolean;
       begin
-         if needs_unaligned(ref.alignment,fromsize) then
+         needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
+         if needsext then
+           size:=fromsize
+         else
+           size:=tosize;
+
+         if needs_unaligned(ref.alignment,size) then
            begin
              //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned')));
              a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register);
@@ -940,11 +946,6 @@ unit cgcpu;
          href:=ref;
          fixref(list,href,false);
 
-         needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
-         if needsext then
-           size:=fromsize
-         else
-           size:=tosize;
          opsize:=TCGSize2OpSize[size];
          if isaddressregister(register) and not (opsize in [S_L]) then
            hreg:=getintregister(list,OS_ADDR)
@@ -1771,6 +1772,9 @@ unit cgcpu;
          srcrefp,dstrefp : treference;
          srcref,dstref : treference;
       begin
+         if (len < 1) then
+           exit;
+
          if (len = 1) or
             ((len in [2,4]) and
              not needs_unaligned(source.alignment,lentocgsize[len]) and

compiler/mips/cgcpu.pas

@@ -550,6 +550,10 @@ begin
         list.concat(taicpu.op_reg_reg_const(A_ANDI, reg2, reg1, $ff));
       OS_16:
         list.concat(taicpu.op_reg_reg_const(A_ANDI, reg2, reg1, $ffff));
+{$ifdef cpu64bitalu}
+      OS_64,
+      OS_S64,
+{$endif cpu64bitalu}
       OS_32,
       OS_S32:
         done:=false;
@@ -1237,8 +1241,12 @@ begin
   case size of
     OS_32:  asmop:=A_MULTU;
     OS_S32: asmop:=A_MULT;
+{$ifdef cpu64bitalu}
+    OS_64:  asmop:=A_DMULTU;
+    OS_S64: asmop:=A_DMULT;
+{$endif cpu64bitalu}
   else
-    InternalError(2014060802);
+    InternalError(2022020901);
   end;
   list.concat(taicpu.op_reg_reg(asmop,src1,src2));
   if (dstlo<>NR_NO) then
@@ -1607,7 +1615,7 @@ begin
         list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst));
         Inc(src.offset, 4);
         Inc(dst.offset, 4);
-	Inc(count2);
+        Inc(count2);
       end;
       len := len mod 4;
     end;
@@ -1679,7 +1687,7 @@ begin
     begin
       { unrolled loop }
       tmpreg1 := GetIntRegister(list, OS_INT);
-      i:=1;
+      i := 1;
       while i <= len do
       begin
         list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src));

compiler/mips/cpupara.pas

@@ -365,7 +365,8 @@ implementation
             while paralen>0 do
               begin
                 paraloc:=hp.paraloc[side].add_location;
-                { We can allocate at maximum 32 bits per register }
+{$ifndef cpu64bitalu}
+                { We can allocate at maximum 32 bits per register on mips32 }
                 if (paracgsize in [OS_64,OS_S64]) or
                    ((paracgsize in [OS_F32,OS_F64]) and
                      not(can_use_float)) then
@@ -374,6 +375,7 @@ implementation
                     paraloc^.def:=u32inttype;
                   end
                 else
+{$endif cpu64bitalu}
                   begin
                     paraloc^.size:=paracgsize;
                     paraloc^.def:=locdef;

compiler/ncgadd.pas

@@ -786,9 +786,11 @@ interface
               if is_boolean(left.resultdef) and
                  is_boolean(right.resultdef) then
                 second_opboolean
+{$ifndef cpu64bitalu}
               { 64bit operations }
               else if is_64bit(left.resultdef) then
                 second_op64bit
+{$endif cpu64bitalu}
               else
                 second_opordinal;
             end;

compiler/ncgvmt.pas

@@ -1234,7 +1234,7 @@ implementation
           between code fragments that use a different TOC (which has to be
           executed when that "branch" returns). So we can't use tail call
           branches to routines potentially using a different TOC there }
-        if target_info.system in systems_ppc_toc then
+        if target_info.abi in abis_ppc_toc then
           usehighlevelwrapper:=true
         else
           usehighlevelwrapper:=false;

compiler/ogwasm.pas

@@ -1025,7 +1025,10 @@ implementation
                       if not assigned(objrel.symbol) then
                         internalerror(2021092509);
                       objsec.Data.seek(objrel.DataOffset);
-                      WriteUleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).FuncIndex);
+                      if TWasmObjSymbol(objrel.symbol).FuncIndex<0 then
+                        internalerror(2022012401)
+                      else
+                        WriteUleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).FuncIndex);
                     end;
                   RELOC_MEMORY_ADDR_OR_TABLE_INDEX_SLEB:
                     begin
@@ -1064,14 +1067,20 @@ implementation
                       if not assigned(objrel.symbol) then
                         internalerror(2021092509);
                       objsec.Data.seek(objrel.DataOffset);
-                      WriteUleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).GlobalIndex);
+                      if TWasmObjSymbol(objrel.symbol).GlobalIndex<0 then
+                        internalerror(2022012402)
+                      else
+                        WriteUleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).GlobalIndex);
                     end;
                   RELOC_TAG_INDEX_LEB:
                     begin
                       if not assigned(objrel.symbol) then
                         internalerror(2021092716);
                       objsec.Data.seek(objrel.DataOffset);
-                      WriteSleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).TagIndex);
+                      if TWasmObjSymbol(objrel.symbol).TagIndex<0 then
+                        internalerror(2022012403)
+                      else
+                        WriteSleb5(objsec.Data,TWasmObjSymbol(objrel.symbol).TagIndex);
                     end;
                   else
                     internalerror(2021092510);

compiler/options.pas

@@ -4204,7 +4204,7 @@ procedure read_arguments(cmd:TCmdStr);
         def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
       {$endif mipseb}
 
-      {$ifdef mips64}
+      {$ifdef mips64eb}
         def_system_macro('CPUMIPS');
         def_system_macro('CPUMIPS64');
         def_system_macro('CPUMIPSEB64');
@@ -4216,7 +4216,7 @@ procedure read_arguments(cmd:TCmdStr);
         def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
         { See comment above for mipsel }
         def_system_macro('FPC_LOCALS_ARE_STACK_REG_RELATIVE');
-      {$endif mips64}
+      {$endif mips64eb}
 
       {$ifdef mips64el}
         def_system_macro('CPUMIPS');

compiler/pdecsub.pas

@@ -2197,7 +2197,7 @@ procedure pd_syscall(pd:tabstractprocdef);
                 system_i386_aros:
                     result:='eax';
                 system_x86_64_aros:
-                    result:='rax';
+                    result:='r12';
                 system_powerpc_morphos:
                     result:='r12';
                 else

compiler/powerpc/cgcpu.pas

@@ -911,9 +911,17 @@ const
               end;
           end;
 
-        { save the CR if necessary ( !!! never done currently ) }
-{       still need to find out where this has to be done for SystemV
-        a_reg_alloc(list,R_0);
+        { save current RTOC for restoration after calls if necessary }
+        if (pi_do_call in current_procinfo.flags) and
+           (target_info.abi in abis_ppc_toc) then
+          begin
+            reference_reset_base(href,NR_STACK_POINTER_REG,get_rtoc_offset,ctempposinvalid,target_info.stackalign,[]);
+            a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,href);
+          end;
+
+        { save the CR if/when we ever start using caller-save portions of that
+          register}
+{       a_reg_alloc(list,R_0);
         list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR);
         list.concat(taicpu.op_reg_ref(A_STW,scratch_register,
           new_reference(STACK_POINTER_REG,LA_CR)));
@@ -1306,6 +1314,14 @@ const
                 a_reg_dealloc(list,href.index);
               end;
           end;
+
+        { save current RTOC for restoration after calls if necessary }
+        if pi_do_call in current_procinfo.flags then
+          begin
+            reference_reset_base(href,NR_STACK_POINTER_REG,get_rtoc_offset,ctempposinvalid,target_info.stackalign,[]);
+            a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,href);
+          end;
+
       end;
 
     procedure tcgppc.g_return_from_proc_mac(list : TAsmList;parasize : tcgint);

compiler/powerpc64/cgcpu.pas

@@ -305,22 +305,6 @@ begin
 end;
 
 
-function get_rtoc_offset: longint;
-begin
-  result:=0;
-  case target_info.abi of
-    abi_powerpc_aix,
-    abi_powerpc_darwin:
-      result:=LA_RTOC_AIX;
-    abi_powerpc_elfv1:
-      result:=LA_RTOC_SYSV;
-    abi_powerpc_elfv2:
-      result:=LA_RTOC_ELFV2;
-    else
-      internalerror(2015021001);
-  end;
-end;
-
 { calling a procedure by address }
 
 procedure tcgppc.a_call_reg(list: TAsmList; reg: tregister);
@@ -330,40 +314,44 @@ var
 begin
   if (target_info.abi<>abi_powerpc_sysv) then
     inherited a_call_reg(list,reg)
-  else if (not (cs_opt_size in current_settings.optimizerswitches)) then begin
-    tempreg := getintregister(list, OS_INT);
-    { load actual function entry (reg contains the reference to the function descriptor)
-    into tempreg }
-    reference_reset_base(tmpref, reg, 0, ctempposinvalid, sizeof(pint), []);
-    a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
-
-    { move actual function pointer to CTR register }
-    list.concat(taicpu.op_reg(A_MTCTR, tempreg));
-
-    { load new TOC pointer from function descriptor into RTOC register }
-    reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
+  else
+    begin
+      if (not (cs_opt_size in current_settings.optimizerswitches)) then
+        begin
+          tempreg := getintregister(list, OS_INT);
+          { load actual function entry (reg contains the reference to the function descriptor)
+          into tempreg }
+          reference_reset_base(tmpref, reg, 0, ctempposinvalid, sizeof(pint), []);
+          a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg);
+
+          { move actual function pointer to CTR register }
+          list.concat(taicpu.op_reg(A_MTCTR, tempreg));
+
+          { load new TOC pointer from function descriptor into RTOC register }
+          reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
+          a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
+
+          { load new environment pointer from function descriptor into R11 register }
+          reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
+          a_reg_alloc(list, NR_R11);
+          a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11);
+          { call function }
+          list.concat(taicpu.op_none(A_BCTRL));
+          a_reg_dealloc(list, NR_R11);
+        end
+    else
+      begin
+        { call ptrgl helper routine which expects the pointer to the function descriptor
+        in R11 }
+        a_reg_alloc(list, NR_R11);
+        a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
+        a_call_name_direct(list, A_BL, '.ptrgl', false, false, false);
+        a_reg_dealloc(list, NR_R11);
+      end;
+    { we need to load the old RTOC from stackframe because we changed it}
+    reference_reset_base(tmpref, NR_STACK_POINTER_REG, get_rtoc_offset, ctempposinvalid, 8, []);
     a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
-
-    { load new environment pointer from function descriptor into R11 register }
-    reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR], ctempposinvalid, 8, []);
-    a_reg_alloc(list, NR_R11);
-    a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11);
-    { call function }
-    list.concat(taicpu.op_none(A_BCTRL));
-    a_reg_dealloc(list, NR_R11);
-  end else begin
-    { call ptrgl helper routine which expects the pointer to the function descriptor
-    in R11 }
-    a_reg_alloc(list, NR_R11);
-    a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
-    a_call_name_direct(list, A_BL, '.ptrgl', false, false, false);
-    a_reg_dealloc(list, NR_R11);
   end;
-
-  { we need to load the old RTOC from stackframe because we changed it}
-  reference_reset_base(tmpref, NR_STACK_POINTER_REG, get_rtoc_offset, ctempposinvalid, 8, []);
-  a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC);
-
   include(current_procinfo.flags, pi_do_call);
 end;
 
@@ -1270,7 +1258,8 @@ begin
   end;
 
   { save current RTOC for restoration after calls if necessary }
-  if pi_do_call in current_procinfo.flags then
+  if (pi_do_call in current_procinfo.flags) and
+     (target_info.abi in abis_ppc_toc) then
     begin
       reference_reset_base(href,NR_STACK_POINTER_REG,get_rtoc_offset,ctempposinvalid,target_info.stackalign,[]);
       a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,href);

compiler/ppcgen/cgppc.pas

@@ -89,6 +89,8 @@ unit cgppc;
         procedure a_jmp(list: TAsmList; op: tasmop;
                         c: tasmcondflag; crval: longint; l: tasmlabel);
 
+        function get_rtoc_offset: longint;
+
         function save_lr_in_prologue: boolean;
 
         function load_got_symbol(list : TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
@@ -123,7 +125,6 @@ unit cgppc;
                          C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);
     TocSecBaseName = 'toc_table';
 
-
 {$ifdef extdebug}
      function ref2string(const ref : treference) : string;
      function cgop2string(const op : TOpCg) : String;
@@ -473,9 +474,6 @@ unit cgppc;
             { no need to allocate/free R0, is already allocated by call node
               because it's a volatile register }
             reg:=NR_R0;
-            { save current TOC }
-            reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,ctempposinvalid,sizeof(pint),[]);
-            a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref);
           end;
         list.concat(taicpu.op_reg(A_MTCTR,reg));
         if target_info.system in systems_aix then
@@ -488,9 +486,6 @@ unit cgppc;
           end
         else if target_info.abi=abi_powerpc_elfv2 then
           begin
-            { save current TOC }
-            reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_ELFV2,ctempposinvalid,sizeof(pint),[]);
-            a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref);
             { functions must be called via R12 for this ABI }
             if reg<>NR_R12 then
               begin
@@ -499,17 +494,13 @@ unit cgppc;
               end;
           end;
         list.concat(taicpu.op_none(A_BCTRL));
-        if (target_info.system in systems_aix) or
-           (target_info.abi=abi_powerpc_elfv2) then
+        if target_info.abi in abis_ppc_toc then
           begin
             if (target_info.abi=abi_powerpc_elfv2) and
                (reg<>NR_R12) then
               ungetcpuregister(list,NR_R12);
             { restore our TOC }
-            if target_info.system in systems_aix then
-              toc_offset:=LA_RTOC_AIX
-            else
-              toc_offset:=LA_RTOC_ELFV2;
+            toc_offset:=get_rtoc_offset;
             reference_reset_base(tmpref,NR_STACK_POINTER_REG,toc_offset,ctempposinvalid,sizeof(pint),[]);
             a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC);
           end;
@@ -743,6 +734,23 @@ unit cgppc;
      list.concat(p)
    end;
 
+ function tcgppcgen.get_rtoc_offset: longint;
+   begin
+     case target_info.abi of
+       abi_powerpc_aix:
+         result:=LA_RTOC_AIX;
+{$ifdef powerpc64}
+       { no TOC on Linux/ppc32 }
+       abi_powerpc_elfv1:
+         result:=LA_RTOC_SYSV;
+{$endif}
+       abi_powerpc_elfv2:
+         result:=LA_RTOC_ELFV2;
+       else
+         internalerror(2015021001);
+     end;
+   end;
+
 
 
   function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;

compiler/syscinfo.pas

@@ -81,7 +81,7 @@ const
       ( system: system_powerpc_morphos; procoption: po_syscall_legacy ),
       ( system: system_arm_aros;        procoption: po_syscall_baselast ),
       ( system: system_i386_aros;       procoption: po_syscall_baselast ),
-      ( system: system_x86_64_aros;     procoption: po_syscall_baselast ));
+      ( system: system_x86_64_aros;     procoption: po_syscall_basereg ));
 
 var
   default_syscall_convention: tprocoption = po_none;

compiler/systems.pas

@@ -448,14 +448,9 @@ interface
          on the caller side rather than on the callee side }
        systems_caller_copy_addr_value_para = [system_aarch64_ios,system_aarch64_darwin,system_aarch64_linux,system_aarch64_win64,system_aarch64_freebsd];
 
-       { all PPC systems that use a TOC register to address globals }
-       { TODO: not used by Darwin, but don't know about others (JM) }
-       systems_ppc_toc = [
-         system_powerpc_linux,
-         system_powerpc64_linux,
-         system_powerpc_aix,
-         system_powerpc64_aix,
-         system_powerpc_macosclassic
+       { all PPC ABIs that use a TOC register to address globals }
+       abis_ppc_toc = [
+         {$ifdef powerpc32}abi_powerpc_sysv,{$endif}abi_powerpc_aix,abi_powerpc_elfv2
        ];
 
        { pointer checking (requires special code in FPC_CHECKPOINTER,
@@ -1204,9 +1199,9 @@ begin
   {$endif ndef default_target_set}
 {$endif xtensa}
 
-{$ifdef mips64}
+{$ifdef mips64eb}
   default_target(system_mips64_linux);
-{$endif mips64}
+{$endif mips64eb}
 
 {$ifdef mips64el}
   default_target(system_mips64el_linux);

compiler/systems/t_atari.pas

@@ -156,37 +156,37 @@ begin
    end;
   if (UseVLink) and (ataritos_exe_format = 'aoutmint') then
    begin
-	LinkRes.Add('SECTIONS {');
-	LinkRes.Add('  . = 0xe4;');
-	LinkRes.Add('  .text: {');
-	LinkRes.Add('    *(.i* i* I*)');
-	LinkRes.Add('    *(.t* t* T* .c* c* CODE*)');
-	LinkRes.Add('    *(.f* f* F*)');
-	LinkRes.Add('    _etext = .;');
-	LinkRes.Add('    __etext = .;');
-	LinkRes.Add('    . = ALIGN(4);');
-	LinkRes.Add('  }');
-	LinkRes.Add('  .data: {');
-	LinkRes.Add('    PROVIDE(_LinkerDB = . + 0x8000);');
-	LinkRes.Add('    PROVIDE(_SDA_BASE_ = . + 0x8000);');
-	LinkRes.Add('    VBCC_CONSTRUCTORS');
-	LinkRes.Add('    *(.rodata*)');
-	LinkRes.Add('    *(.d* d* D*)');
-	LinkRes.Add('    *(.sdata*)');
-	LinkRes.Add('    *(__MERGED)');
-	LinkRes.Add('    _edata = .;');
-	LinkRes.Add('    __edata = .;');
-	LinkRes.Add('    . = ALIGN(4);');
-	LinkRes.Add('  }');
-	LinkRes.Add('  .bss: {');
-	LinkRes.Add('    *(.sbss*)');
-	LinkRes.Add('    *(.scommon)');
-	LinkRes.Add('    *(.b* b* B* .u* u* U*)');
-	LinkRes.Add('    *(COMMON)');
-	LinkRes.Add('    _end = ALIGN(4);');
-	LinkRes.Add('    __end = ALIGN(4);');
-	LinkRes.Add('  }');
-	LinkRes.Add('}');;
+    LinkRes.Add('SECTIONS {');
+    LinkRes.Add('  . = 0xe4;');
+    LinkRes.Add('  .text: {');
+    LinkRes.Add('    *(.i* i* I*)');
+    LinkRes.Add('    *(.t* t* T* .c* c* CODE*)');
+    LinkRes.Add('    *(.f* f* F*)');
+    LinkRes.Add('    _etext = .;');
+    LinkRes.Add('    __etext = .;');
+    LinkRes.Add('    . = ALIGN(4);');
+    LinkRes.Add('  }');
+    LinkRes.Add('  .data: {');
+    LinkRes.Add('    PROVIDE(_LinkerDB = . + 0x8000);');
+    LinkRes.Add('    PROVIDE(_SDA_BASE_ = . + 0x8000);');
+    LinkRes.Add('    VBCC_CONSTRUCTORS');
+    LinkRes.Add('    *(.rodata*)');
+    LinkRes.Add('    *(.d* d* D*)');
+    LinkRes.Add('    *(.sdata*)');
+    LinkRes.Add('    *(__MERGED)');
+    LinkRes.Add('    _edata = .;');
+    LinkRes.Add('    __edata = .;');
+    LinkRes.Add('    . = ALIGN(4);');
+    LinkRes.Add('  }');
+    LinkRes.Add('  .bss: {');
+    LinkRes.Add('    *(.sbss*)');
+    LinkRes.Add('    *(.scommon)');
+    LinkRes.Add('    *(.b* b* B* .u* u* U*)');
+    LinkRes.Add('    *(COMMON)');
+    LinkRes.Add('    _end = ALIGN(4);');
+    LinkRes.Add('    __end = ALIGN(4);');
+    LinkRes.Add('  }');
+    LinkRes.Add('}');;
    end;
 
   LinkRes.Add('INPUT (');

compiler/systems/t_linux.pas

@@ -1316,11 +1316,11 @@ initialization
   RegisterTarget(system_mipseb_linux_info);
 {$endif MIPSEL}
 {$endif MIPS32}
-{$ifdef MIPS64}
+{$ifdef MIPS64EB}
   RegisterImport(system_mips64_linux,timportliblinux);
   RegisterExport(system_mips64_linux,texportliblinux);
   RegisterTarget(system_mips64_linux_info);
-{$endif MIPS64}
+{$endif MIPS64EB}
 {$ifdef MIPS64EL}
   RegisterImport(system_mips64el_linux,timportliblinux);
   RegisterExport(system_mips64el_linux,texportliblinux);

compiler/wasm32/nwasmutil.pas

@@ -58,6 +58,33 @@ implementation
           list.Concat(tai_import_name.create(proc.mangledname,proc.import_name^));
         end;
 
+      procedure InsertUnitInfo(list : TAsmList;cur_unit: tused_unit);
+        var
+          i: Integer;
+          def  : tdef;
+          proc : tprocdef;
+        begin
+          if (cur_unit.u.moduleflags * [mf_init,mf_finalize])<>[] then
+            begin
+              if mf_init in cur_unit.u.moduleflags then
+                list.Concat(tai_functype.create(make_mangledname('INIT$',cur_unit.u.globalsymtable,''),TWasmFuncType.Create([],[])));
+              if mf_finalize in cur_unit.u.moduleflags then
+                list.Concat(tai_functype.create(make_mangledname('FINALIZE$',cur_unit.u.globalsymtable,''),TWasmFuncType.Create([],[])));
+            end;
+          for i:=0 to cur_unit.u.deflist.Count-1 do
+            begin
+              def:=tdef(cur_unit.u.deflist[i]);
+              if assigned(def) and (tdef(def).typ = procdef) then
+                begin
+                  proc := tprocdef(def);
+                  if (po_external in proc.procoptions) and (po_has_importdll in proc.procoptions) then
+                    WriteImportDll(list,proc)
+                  else if not proc.owner.iscurrentunit or (po_external in proc.procoptions) then
+                    thlcgwasm(hlcg).g_procdef(list,proc);
+                end;
+            end;
+        end;
+
     var
       i    : integer;
       def  : tdef;
@@ -94,25 +121,13 @@ implementation
       cur_unit:=tused_unit(usedunits.First);
       while assigned(cur_unit) do
         begin
-          if (cur_unit.u.moduleflags * [mf_init,mf_finalize])<>[] then
-            begin
-              if mf_init in cur_unit.u.moduleflags then
-                list.Concat(tai_functype.create(make_mangledname('INIT$',cur_unit.u.globalsymtable,''),TWasmFuncType.Create([],[])));
-              if mf_finalize in cur_unit.u.moduleflags then
-                list.Concat(tai_functype.create(make_mangledname('FINALIZE$',cur_unit.u.globalsymtable,''),TWasmFuncType.Create([],[])));
-            end;
-          for i:=0 to cur_unit.u.deflist.Count-1 do
-            begin
-              def:=tdef(cur_unit.u.deflist[i]);
-              if assigned(def) and (tdef(def).typ = procdef) then
-                begin
-                  proc := tprocdef(def);
-                  if (po_external in proc.procoptions) and (po_has_importdll in proc.procoptions) then
-                    WriteImportDll(list,proc)
-                  else if not proc.owner.iscurrentunit or (po_external in proc.procoptions) then
-                    thlcgwasm(hlcg).g_procdef(list,proc);
-                end;
-            end;
+          InsertUnitInfo(list,cur_unit);
+          cur_unit:=tused_unit(cur_unit.Next);
+        end;
+      cur_unit:=tused_unit(current_module.used_units.First);
+      while assigned(cur_unit) do
+        begin
+          InsertUnitInfo(list,cur_unit);
           cur_unit:=tused_unit(cur_unit.Next);
         end;
     end;

compiler/x86/aasmcpu.pas

@@ -2183,15 +2183,15 @@ implementation
           begin
             if aInput.typ = top_ref then
             begin
-	      if aInput.ref^.base <> NR_NO then
-	      begin	      
-	        if (aInput.ref^.offset <> 0) and
+              if aInput.ref^.base <> NR_NO then
+              begin              
+                if (aInput.ref^.offset <> 0) and
                    ((aInput.ref^.offset mod tuplesize) = 0) and
                    (abs(aInput.ref^.offset) div tuplesize <= 127) then
                 begin
                   aInput.ref^.offset := aInput.ref^.offset div tuplesize;
                   EVEXTupleState := etsIsTuple;
-    	        end;  
+                    end;  
               end;
             end;
           end;
@@ -2905,35 +2905,35 @@ implementation
              NR_EAX,
              NR_XMM0,
              NR_YMM0,
-	     NR_ZMM0: index:=0;
+             NR_ZMM0: index:=0;
              NR_ECX,
              NR_XMM1,
              NR_YMM1,
-	     NR_ZMM1: index:=1;
+             NR_ZMM1: index:=1;
              NR_EDX,
              NR_XMM2,
              NR_YMM2,
-	     NR_ZMM2: index:=2;
+             NR_ZMM2: index:=2;
              NR_EBX,
              NR_XMM3,
              NR_YMM3,
-	     NR_ZMM3: index:=3;
+             NR_ZMM3: index:=3;
              NR_NO,
              NR_XMM4,
              NR_YMM4,
-	     NR_ZMM4: index:=4;
+             NR_ZMM4: index:=4;
              NR_EBP,
              NR_XMM5,
              NR_YMM5,
-	     NR_ZMM5: index:=5;
+             NR_ZMM5: index:=5;
              NR_ESI,
              NR_XMM6,
              NR_YMM6,
-	     NR_ZMM6: index:=6;
+             NR_ZMM6: index:=6;
              NR_EDI,
              NR_XMM7,
              NR_YMM7,
-	     NR_ZMM7: index:=7;
+             NR_ZMM7: index:=7;
            else
              exit;
            end;
@@ -3507,7 +3507,7 @@ implementation
        *                 generates no code in the assembler)
        * \331          - instruction not valid with REP prefix.  Hint for
        *                 disassembler only; for SSE instructions.
-       * \332	       - disassemble a rep (0xF3 byte) prefix as repe not rep.
+       * \332               - disassemble a rep (0xF3 byte) prefix as repe not rep.
        * \333          - 0xF3 prefix for SSE instructions
        * \334          - 0xF2 prefix for SSE instructions
        * \335          - Indicates 64-bit operand size with REX.W not necessary / 64-bit scalar vector operand size
@@ -3678,7 +3678,7 @@ implementation
 {$endif i386}
            objdata.writereloc(data,len,p,Reloctype);
 {$ifdef x86_64}
-	   { Computed offset is not yet correct for GOTPC relocation }
+           { Computed offset is not yet correct for GOTPC relocation }
            { RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX need special handling }
            if assigned(p) and (RelocType in [RELOC_GOTPCREL, RELOC_REX_GOTPCRELX, RELOC_GOTPCRELX]) and
               { These relocations seem to be used only for ELF
@@ -5538,14 +5538,14 @@ implementation
             // combination (attsuffix <> "AttSufNONE") and (MemRefSize is not in MemRefMultiples) is not supported =>> check opcode-definition in x86ins.dat
 
             if (AsmOp <> A_CVTSI2SD) and
-	       (AsmOp <> A_CVTSI2SS) then
-	    begin	    
+               (AsmOp <> A_CVTSI2SS) then
+            begin            
               inc(iCntOpcodeValError);
               Str(gas_needsuffix[AsmOp],hs1);
               Str(InsTabMemRefSizeInfoCache^[AsmOp].MemRefSize,hs2);
               Message3(asmr_e_not_supported_combination_attsuffix_memrefsize_type,
                        std_op2str[AsmOp],hs1,hs2);
-	    end;	       
+            end;               
           end;
         end;
       end;

compiler/x86/cgx86.pas

@@ -3376,6 +3376,7 @@ unit cgx86;
       begin
         regsize:=0;
         stackmisalignment:=0;
+        list.concat(tai_regalloc.alloc(NR_STACK_POINTER_REG,nil));
 {$ifdef i8086}
         { Win16 callback/exported proc prologue support.
           Since callbacks can be called from different modules, DS on entry may be
@@ -3500,7 +3501,6 @@ unit cgx86;
           begin
             { return address }
             inc(stackmisalignment,sizeof(pint));
-            list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
             if current_procinfo.framepointer=NR_STACK_POINTER_REG then
               begin
 {$ifdef i386}
@@ -3511,6 +3511,7 @@ unit cgx86;
               end
             else
               begin
+                list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
 {$ifdef i8086}
                 if ((ts_x86_far_procs_push_odd_bp in current_settings.targetswitches) or
                     ((po_exports in current_procinfo.procdef.procoptions) and

compiler/x86_64/cgcpu.pas

@@ -206,12 +206,13 @@ unit cgcpu;
           is expected to be one of those directives, and not generated here. }
         suppress_endprologue:=(pi_has_unwind_info in current_procinfo.flags);
 
+        list.concat(tai_regalloc.alloc(NR_STACK_POINTER_REG,nil));
+
         { save old framepointer }
         if not nostackframe then
           begin
             { return address }
             stackmisalignment := sizeof(pint);
-            list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
             if current_procinfo.framepointer=NR_STACK_POINTER_REG then
               begin
                 push_regs;
@@ -219,6 +220,7 @@ unit cgcpu;
               end
             else
               begin
+                list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
                 { push <frame_pointer> }
                 inc(stackmisalignment,sizeof(pint));
                 push_one_reg(NR_FRAME_POINTER_REG);
@@ -427,6 +429,9 @@ unit cgcpu;
               list.Concat(taicpu.op_none(A_VZEROUPPER));
           end;
 
+        if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+          list.concat(tai_regalloc.dealloc(NR_STACK_POINTER_REG,nil));
+
         list.concat(Taicpu.Op_none(A_RET,S_NO));
 
         if (pi_has_unwind_info in current_procinfo.flags) then

compiler/x86_64/cpupara.pas

@@ -1659,6 +1659,21 @@ unit cpupara;
           begin
             hp:=tparavarsym(paras[i]);
             paradef:=hp.vardef;
+
+            { in syscalls the libbase might be set as explicit paraloc }
+            if (vo_has_explicit_paraloc in hp.varoptions) then
+              if not (vo_is_syscall_lib in hp.varoptions) then
+                internalerror(2022010501)
+              else
+                begin
+                  paracgsize:=def_cgsize(paradef);
+                  hp.paraloc[side].def:=paradef;
+                  hp.paraloc[side].size:=paracgsize;
+                  hp.paraloc[side].intsize:=tcgsize2size[paracgsize];
+                  hp.paraloc[side].alignment:=sizeof(pint);
+                  continue;
+                end;
+
             { on win64, if a record has only one field and that field is a
               single or double, it has to be handled like a single/double }
             if use_ms_abi and

compiler/x86_64/nx64cal.pas

@@ -61,11 +61,11 @@ implementation
                 begin
                   current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('AROS SysCall')));
 
-                  cg.getcpuregister(current_asmdata.CurrAsmList,NR_RAX);
-                  get_syscall_call_ref(tmpref,NR_RAX);
+                  cg.getcpuregister(current_asmdata.CurrAsmList,NR_R12);
+                  get_syscall_call_ref(tmpref,NR_R12);
 
                   current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,tmpref));
-                  cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RAX);
+                  cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R12);
                   exit;
                 end;
               internalerror(2016120101);

packages/fcl-base/src/csvdocument.pp

@@ -56,8 +56,12 @@ type
   {$ENDIF}
 
   // Random access to CSV document. Reads entire document into memory.
+
+  { TCSVDocument }
+
   TCSVDocument = class(TCSVHandler)
   private
+    FDetectBOM: Boolean;
     FRows: TFPObjectList;
     FParser: TCSVParser;
     FBuilder: TCSVBuilder;
@@ -130,6 +134,9 @@ type
     // Remove empty cells at end of rows from entire document
     procedure RemoveTrailingEmptyCells;
 
+    // Detect bom
+    Property DetectBOM : Boolean Read FDetectBOM Write FDetectBOM;
+
     // Properties
 
     // Cell data at column ACol, row ARow.
@@ -428,6 +435,7 @@ begin
   FreeAndNil(FParser);
   FParser:=TCSVParser.Create;
   FParser.AssignCSVProperties(Self);
+  FParser.DetectBOM:=Self.DetectBOM;
   with FParser do
   begin
     SetSource(AStream);

packages/fcl-js/src/jstree.pp

@@ -1000,8 +1000,10 @@ Type
   end;
 
   { TJSExportStatement - e.g. 'export Declaration' }
-  // 'export * as NameSpaceExport from ModuleName' NameSpaceExport and ModuleName are optional
-  // 'export { ExportNames[1], ExportNames[2], ... } from ModuleName' ModuleName is optional
+  // export [default] Declaration
+  // export [default] NameSpaceExport [from ModuleName]
+  // export [default] * [from ModuleName]
+  // export { ExportNames[1], ExportNames[2], ... } [from ModuleName]
 
   TJSExportStatement = class(TJSStatement)
   Private
@@ -1014,9 +1016,9 @@ Type
     function GetNamedExports: TJSExportNameElements;
   Public
     Destructor Destroy; override;
-    Property IsDefault : Boolean Read FIsDefault Write FIsDefault;
+    Property IsDefault : Boolean Read FIsDefault Write FIsDefault; // write "default"
     Property Declaration : TJSElement Read FDeclaration Write FDeclaration;
-    Property NameSpaceExport : TJSString Read FNameSpaceExport Write FNameSpaceExport;
+    Property NameSpaceExport : TJSString Read FNameSpaceExport Write FNameSpaceExport;// can be '*'
     Property ModuleName : TJSString Read FModuleName Write FModuleName;
     Property HaveExportNames : Boolean Read GetHaveNamedExports;
     Property ExportNames : TJSExportNameElements Read GetNamedExports;

packages/fcl-js/tests/tcwriter.pp

@@ -101,6 +101,7 @@ type
     Procedure TestConstDeclarationStatement;
     Procedure TestDebuggerStatement;
     Procedure TestVarListDeclarationStatement;
+    Procedure TestConstListDeclarationStatement;
     Procedure TestVarListDeclarationStatement2Vars;
     Procedure TestVarListDeclarationStatement3Vars;
     Procedure TestReturnStatement;
@@ -1058,6 +1059,23 @@ begin
   AssertWrite('simple var','var a',S);
 end;
 
+procedure TTestStatementWriter.TestConstListDeclarationStatement;
+Var
+  S : TJSVariableStatement;
+  V : TJSVarDeclaration;
+  L : TJSVariableDeclarationList;
+
+begin
+  S:=TJSVariableStatement.Create(0,0);
+  L:=TJSVariableDeclarationList.Create(0,0);
+  V:=TJSVarDeclaration.Create(0,0);
+  S.VarType:=vtConst;
+  L.A:=V;
+  S.VarDecl:=L;
+  V.Name:='a';
+  AssertWrite('simple const','const a',S);
+end;
+
 procedure TTestStatementWriter.TestVarListDeclarationStatement2Vars;
 Var
   S : TJSVariableStatement;

packages/fcl-passrc/src/pasresolver.pp

@@ -1254,8 +1254,9 @@ type
     rrfNoImplicitCallWithoutParams, // a TPrimitiveExpr is not an implicit call
     rrfNewInstance, // constructor call (without it call constructor as normal method)
     rrfFreeInstance, // destructor call (without it call destructor as normal method)
-    rrfVMT, // use VMT for call
-    rrfConstInherited // parent is const and this child is too
+    rrfVMT, // use VMT for call (e.g. calling a virtual method)
+    rrfConstInherited, // parent is const and this child is too (e.g. field of a const record argument)
+    rrfUseFields // use record fields too, flag is used by pas2js
     );
   TResolvedReferenceFlags = set of TResolvedReferenceFlag;
 
@@ -1414,6 +1415,7 @@ type
   TPRFindGenericData = record
     Find: TPRFindData;
     TemplateCount: integer;
+    LastProc: TPasProcedure;
   end;
   PPRFindGenericData = ^TPRFindGenericData;
 
@@ -1592,6 +1594,7 @@ type
     procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
       FindProcData: Pointer; var Abort: boolean); virtual;
     function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
+    function IsProcOverload(LastProc, LastExactProc, CurProc: TPasProcedure): boolean;
     function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
       Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
   protected
@@ -1734,7 +1737,7 @@ type
       SetReferenceFlags: boolean);
     procedure ComputeArgumentExpr(const ArgResolved: TPasResolverResult;
       Access: TArgumentAccess; Expr: TPasExpr; out ExprResolved: TPasResolverResult;
-      SetReferenceFlags: boolean);
+      SetReferenceFlags: boolean); virtual;
     procedure ComputeArrayParams(Params: TParamsExpr;
       out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       StartEl: TPasElement);
@@ -2232,7 +2235,7 @@ type
     function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
     function IndexOfGenericParam(Params: TPasExprArray): integer;
     procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
-      ErrorEl: TPasElement);
+      PosEl: TPasElement);
     function CheckCallProcCompatibility(ProcType: TPasProcedureType;
       Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
     function CheckCallPropertyCompatibility(PropEl: TPasProperty;
@@ -5008,19 +5011,72 @@ procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
 var
   Data: PPRFindGenericData absolute FindFirstGenericData;
   GenericTemplateTypes: TFPList;
+  Proc, LastExactProc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
 begin
+  Proc:=nil;
   if El is TPasGenericType then
     GenericTemplateTypes:=TPasGenericType(El).GenericTemplateTypes
   else if El is TPasProcedure then
-    GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(El))
+    begin
+    Proc:=TPasProcedure(El);
+    ProcScope:=Proc.CustomData as TPasProcedureScope;
+    if ProcScope.DeclarationProc<>nil then
+      begin
+      // this proc has a forward declaration -> use that instead
+      Proc:=ProcScope.DeclarationProc;
+      El:=Proc;
+      end;
+
+    if (Data^.LastProc<>nil) then
+      begin
+      if Data^.Find.Found is TPasProcedure then
+        LastExactProc:=TPasProcedure(Data^.Find.Found)
+      else
+        LastExactProc:=nil;
+      if not IsProcOverload(Data^.LastProc,LastExactProc,Proc) then
+        begin
+        Abort:=true;
+        exit;
+        end;
+      end;
+    Data^.LastProc:=Proc;
+
+    GenericTemplateTypes:=GetProcTemplateTypes(Proc);
+    end
   else
     exit;
+
   if GenericTemplateTypes=nil then exit;
   if GenericTemplateTypes.Count<>Data^.TemplateCount then
     exit;
+
+  if Data^.Find.Found<>nil then
+    begin
+    // there was already a generic proc, but it needed params
+    if ProcNeedsParams(Proc.ProcType) then
+      begin
+      // this one needs params too
+      // -> keep the first found and continue searching
+      exit;
+      end;
+    end;
+
   Data^.Find.Found:=El;
   Data^.Find.ElScope:=ElScope;
   Data^.Find.StartScope:=StartScope;
+
+  if Proc<>nil then
+    begin
+    if (not Proc.IsOverload) and (msDelphi in ProcScope.ModeSwitches) then
+      // stop searching after this proc
+    else if ProcNeedsParams(Proc.ProcType) then
+      begin
+      // continue searching for an overload proc without params
+      exit;
+      end;
+    end;
+
   Abort:=true;
 end;
 
@@ -5068,30 +5124,6 @@ begin
       // there is already a previous proc
       PrevProc:=TPasProcedure(Data^.Found);
 
-      if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
-        begin
-        if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
-          begin
-          Abort:=true;
-          exit;
-          end;
-        end
-      else
-        begin
-        // mode objfpc
-        if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
-          // mode objfpc: procs in same context have implicit overload
-        else
-          begin
-          // mode objfpc, different context
-          if not ProcHasGroupOverload(Data^.LastProc) then
-            begin
-            Abort:=true;
-            exit;
-            end;
-          end;
-        end;
-
       if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
           and (PrevProc.Parent.ClassType=TPasClassType) then
         begin
@@ -5100,12 +5132,12 @@ begin
         exit;
         end;
 
-      // check if previous found proc is override of found proc
-      if IsProcOverride(Proc,PrevProc) then
+      if not IsProcOverload(Data^.LastProc,PrevProc,Proc) then
         begin
-        // previous found proc is override of found proc -> skip
+        Abort:=true;
         exit;
         end;
+
       end;
 
     if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
@@ -5591,6 +5623,37 @@ begin
   Result:=false;
 end;
 
+function TPasResolver.IsProcOverload(LastProc, LastExactProc,
+  CurProc: TPasProcedure): boolean;
+begin
+  if msDelphi in TPasProcedureScope(LastProc.CustomData).ModeSwitches then
+    begin
+    if (not LastProc.IsOverload) or (not CurProc.IsOverload) then
+      exit(false);
+    end
+  else
+    begin
+    // mode objfpc
+    if IsSameProcContext(LastProc.Parent,CurProc.Parent) then
+      // mode objfpc: procs in same context have implicit overload
+    else
+      begin
+      // mode objfpc, different context
+      if not ProcHasGroupOverload(LastProc) then
+        exit(false);
+      end;
+    end;
+
+  // check if previous found proc is override of found proc
+  if (LastExactProc<>nil) and IsProcOverride(CurProc,LastExactProc) then
+    begin
+    // previous found proc is override of found proc -> skip
+    exit(false);
+    end;
+
+  Result:=true;
+end;
+
 function TPasResolver.FindProcSameSignature(const ProcName: string;
   Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
   ): TPasProcedure;
@@ -9311,13 +9374,15 @@ var
   ParamAccess: TResolvedRefAccess;
   i: Integer;
   ArrParams: TPasExprArray;
+  Args: TFPList;
 begin
   ArrParams:=Params.Params;
+  Args:=ProcType.Args;
   for i:=0 to length(ArrParams)-1 do
     begin
     ParamAccess:=rraRead;
-    if i<ProcType.Args.Count then
-      case TPasArgument(ProcType.Args[i]).Access of
+    if i<Args.Count then
+      case TPasArgument(Args[i]).Access of
       argVar: ParamAccess:=rraVarParam;
       argOut: ParamAccess:=rraOutParam;
       end;
@@ -10419,7 +10484,7 @@ begin
       if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
         begin
         {$IFDEF VerbosePasResolver}
-        writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El));
+        writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El),' Args.Count=',Proc.ProcType.Args.Count);
         {$ENDIF}
         RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
           sWrongNumberOfParametersForCallTo,[Proc.Name],El);
@@ -13519,9 +13584,9 @@ begin
         if (LeftResolved.IdentEl is TPasType)
             or (not (rrfReadable in LeftResolved.Flags)) then
           begin
-          { $IFDEF VerbosePasResolver}
+          {$IFDEF VerbosePasResolver}
           writeln('TPasResolver.ComputeBinaryExprRes as-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
-          { $ENDIF}
+          {$ENDIF}
           RaiseIncompatibleTypeRes(20180204124711,nOperatorIsNotOverloadedAOpB,
             [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
           end;
@@ -21624,9 +21689,10 @@ begin
   //    ' FindData.Found=',GetObjName(FindData.Found));
   if OnlyTypeMembers then
     begin
+    // only class vars/procs allowed
+
     //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
     //    and (vmClass in TPasVariable(FindData.Found).VarModifiers));
-    // only class vars/procs allowed
     if FindData.Found.ClassType=TPasConstructor then
       // constructor: ok
     else if IsClassMethod(FindData.Found)
@@ -22905,8 +22971,10 @@ begin
     RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
       [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
 
+  if not (rrfReadable in ExprResolved.Flags) then
+    CheckUseAsType(ExprResolved.LoTypeEl,20220210140100,Expr);
+
   Flags:=[];
-  CheckUseAsType(LoType,20190123113957,Expr);
   ClassRecScope:=nil;
   ExprScope:=nil;
   if LoType.ClassType=TPasClassOfType then
@@ -28366,7 +28434,7 @@ begin
 end;
 
 procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
-  ErrorEl: TPasElement);
+  PosEl: TPasElement);
 begin
   if aType=nil then exit;
   if aType is TPasGenericType then
@@ -28374,18 +28442,18 @@ begin
     if aType.ClassType=TPasClassType then
       begin
       if TPasClassType(aType).HelperForType<>nil then
-        RaiseHelpersCannotBeUsedAsType(id,ErrorEl);
+        RaiseHelpersCannotBeUsedAsType(id,PosEl);
       end;
     if (TPasGenericType(aType).GenericTemplateTypes<>nil)
         and (TPasGenericType(aType).GenericTemplateTypes.Count>0) then
       begin
       // ref to generic type without specialization
       if not (msDelphi in CurrentParser.CurrentModeswitches)
-          and (ErrorEl.HasParent(aType)) then
+          and (PosEl.HasParent(aType)) then
         // ObjFPC allows referring to parent without type params
       else
         RaiseMsg(id,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,
-            [ErrorEl.ElementTypeName],ErrorEl);
+            [PosEl.ElementTypeName],PosEl);
       end;
     end;
 end;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -257,8 +257,9 @@ type
     function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean; overload;
     function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
-    function CanSkipGenericType(El: TPasGenericType): boolean;
-    function CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
+    function IsGenericElement(El: TPasElement): boolean; virtual;
+    function CanSkipGenericType(El: TPasGenericType): boolean; virtual;
+    function CanSkipGenericProc(DeclProc: TPasProcedure): boolean; virtual;
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
@@ -282,8 +283,10 @@ type
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
+    procedure UseExportSymbol(El: TPasExportSymbol); virtual;
     procedure UseArgument(El: TPasArgument; Access: TResolvedRefAccess); virtual;
     procedure UseResultElement(El: TPasResultElement; Access: TResolvedRefAccess); virtual;
+    procedure UseRecordFields(El: TPasExpr); virtual;
     // create hints for a unit, program or library
     procedure EmitElementHints(El: TPasElement); virtual;
     procedure EmitSectionHints(Section: TPasSection); virtual;
@@ -1030,6 +1033,19 @@ begin
     CheckImplRef;
 end;
 
+function TPasAnalyzer.IsGenericElement(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  C:=El.ClassType;
+  if C.InheritsFrom(TPasProcedure) then
+    Result:=TPasProcedure(El).NameParts<>nil
+  else if C.InheritsFrom(TPasGenericType) then
+    Result:=TPasGenericType(El).GenericTemplateTypes<>nil
+  else
+    Result:=false;
+end;
+
 function TPasAnalyzer.CanSkipGenericType(El: TPasGenericType): boolean;
 
   procedure RaiseHalfSpecialized;
@@ -1198,6 +1214,7 @@ var
   ClassEl: TPasClassType;
   ArrType: TPasArrayType;
   SpecType: TPasSpecializeType;
+  Rec: TPasRecordType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
@@ -1258,7 +1275,9 @@ begin
         Member:=TPasElement(Members[i]);
         if Member.ClassType=TPasAttributes then
           continue;
-        if IsUsed(Member) then
+        if IsGenericElement(Member) then
+          continue;
+        if IsUsed(Member) then // only used elements of a class
           UseTypeInfo(Member);
         end;
       end;
@@ -1266,16 +1285,28 @@ begin
   else if C=TPasClassOfType then
   else if C=TPasRecordType then
     begin
-    // published record: use all members
-    if CanSkipGenericType(TPasRecordType(El)) then exit;
-    Members:=TPasRecordType(El).Members;
+    // published record: use all members (except generic)
+    Rec:=TPasRecordType(El);
+    if CanSkipGenericType(Rec) then exit;
+    Members:=Rec.Members;
     for i:=0 to Members.Count-1 do
       begin
       Member:=TPasElement(Members[i]);
       if Member.ClassType=TPasAttributes then
         continue; // attributes are never used directly
-      UseSubEl(Member);
+      if IsGenericElement(Member) then
+        continue;
+      if Member.ClassType=TPasVariable then
+        // all fields, even if not used
+        UseSubEl(Member)
+      else if IsUsed(Member) then
+        // all used non fields
+        UseSubEl(Member);
       end;
+    UseSubEl(Rec.VariantEl);
+    if Rec.Variants<>nil then
+      for i:=0 to Rec.Variants.Count-1 do
+        UseSubEl(TPasVariant(Rec.Variants[i]));
     end
   else if C.InheritsFrom(TPasProcedure) then
     UseSubEl(TPasProcedure(El).ProcType)
@@ -1467,6 +1498,8 @@ begin
       end
     else if C=TPasAttributes then
       // attributes are never used directly
+    else if C=TPasExportSymbol then
+      UseExportSymbol(TPasExportSymbol(Decl))
     else
       RaiseNotSupported(20170306165213,Decl);
     end;
@@ -1757,6 +1790,8 @@ begin
           end;
         end;
       end;
+    if rrfUseFields in Ref.Flags then
+      UseRecordFields(El);
 
     if Decl is TPasUnresolvedSymbolRef then
       begin
@@ -2622,6 +2657,24 @@ begin
   UseExpr(El.Expr);
 end;
 
+procedure TPasAnalyzer.UseExportSymbol(El: TPasExportSymbol);
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  if not MarkElementAsUsed(El) then exit;
+  if El.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl<>nil then
+      UseElement(Decl,Ref.Access,false);
+    end;
+  UseExpr(El.NameExpr);
+  UseExpr(El.ExportName);
+  UseExpr(El.ExportIndex);
+end;
+
 procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
   );
 var
@@ -2690,6 +2743,56 @@ begin
   UpdateAccess(IsWrite, IsRead, Usage);
 end;
 
+procedure TPasAnalyzer.UseRecordFields(El: TPasExpr);
+
+  procedure UseRec(Rec: TPasRecordType); forward;
+
+  procedure UseVar(V: TPasVariable);
+  var
+    ResolvedEl: TPasResolverResult;
+  begin
+    UseElement(V,rraRead,false);
+
+    // check nested record
+    Resolver.ComputeElement(V.VarType,ResolvedEl,[],V);
+    if ResolvedEl.LoTypeEl is TPasRecordType then
+      UseRec(TPasRecordType(ResolvedEl.LoTypeEl));
+  end;
+
+  procedure UseRec(Rec: TPasRecordType);
+  var
+    Members: TFPList;
+    i: Integer;
+    Member: TPasElement;
+    C: TClass;
+    Variant: TPasVariant;
+  begin
+    Members:=Rec.Members;
+    for i:=0 to Members.Count-1 do
+      begin
+      Member:=TPasElement(Members[i]);
+      C:=Member.ClassType;
+      if C=TPasVariable then
+        UseVar(TPasVariable(Member));
+      end;
+    if Rec.VariantEl is TPasVariable then
+      UseVar(TPasVariable(Rec.VariantEl));
+    if Rec.Variants<>nil then
+      for i:=0 to Rec.Variants.Count-1 do
+        begin
+        Variant:=TPasVariant(Rec.Variants[i]);
+        UseRec(Variant.Members);
+        end;
+  end;
+
+var
+  ResolvedEl: TPasResolverResult;
+begin
+  Resolver.ComputeElement(El,ResolvedEl,[]);
+  if ResolvedEl.LoTypeEl is TPasRecordType then
+    UseRec(TPasRecordType(ResolvedEl.LoTypeEl));
+end;
+
 procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
 var
   C: TClass;

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -5,7 +5,8 @@ unit tcbaseparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser, TestPasUtils,
+  testregistry;
 
 const
   DefaultMainFilename = 'afile.pp';
@@ -103,296 +104,10 @@ Type
     Property MainFilename: string read FMainFilename write FMainFilename;
   end;
 
-function ExtractFileUnitName(aFilename: string): string;
-function GetPasElementDesc(El: TPasElement): string;
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-
 implementation
 
 uses typinfo;
 
-function ExtractFileUnitName(aFilename: string): string;
-var
-  p: Integer;
-begin
-  Result:=ExtractFileName(aFilename);
-  if Result='' then exit;
-  for p:=length(Result) downto 1 do
-    case Result[p] of
-    '/','\': exit;
-    '.':
-      begin
-      Delete(Result,p,length(Result));
-      exit;
-      end;
-    end;
-end;
-
-function GetPasElementDesc(El: TPasElement): string;
-begin
-  if El=nil then exit('nil');
-  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
-end;
-
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-const
-  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
-  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
-var
-  c1:char;
-  CommentLvl: Integer;
-  Src: PChar;
-begin
-  Src:=Position;
-  // read till next atom
-  while true do
-    begin
-    case Src^ of
-    #0: break;
-    #1..#32:  // spaces and special characters
-      inc(Src);
-    #$EF:
-      if (Src[1]=#$BB)
-      and (Src[2]=#$BF) then
-        begin
-        // skip UTF BOM
-        inc(Src,3);
-        end
-      else
-        break;
-    '{':    // comment start or compiler directive
-      if (Src[1]='$') and (not SkipDirectives) then
-        // compiler directive
-        break
-      else begin
-        // Pascal comment => skip
-        CommentLvl:=1;
-        while true do
-          begin
-          inc(Src);
-          case Src^ of
-          #0: break;
-          '{':
-            if NestedComments then
-              inc(CommentLvl);
-          '}':
-            begin
-            dec(CommentLvl);
-            if CommentLvl=0 then
-              begin
-              inc(Src);
-              break;
-              end;
-            end;
-          end;
-        end;
-      end;
-    '/':  // comment or real division
-      if (Src[1]='/') then
-        begin
-        // comment start -> read til line end
-        inc(Src);
-        while not (Src^ in [#0,#10,#13]) do
-          inc(Src);
-        end
-      else
-        break;
-    '(':  // comment, bracket or compiler directive
-      if (Src[1]='*') then
-        begin
-        if (Src[2]='$') and (not SkipDirectives) then
-          // compiler directive
-          break
-        else
-          begin
-          // comment start -> read til comment end
-          inc(Src,2);
-          CommentLvl:=1;
-          while true do
-            begin
-            case Src^ of
-            #0: break;
-            '(':
-              if NestedComments and (Src[1]='*') then
-                inc(CommentLvl);
-            '*':
-              if (Src[1]=')') then
-                begin
-                dec(CommentLvl);
-                if CommentLvl=0 then
-                  begin
-                  inc(Src,2);
-                  break;
-                  end;
-                inc(Position);
-                end;
-            end;
-            inc(Src);
-            end;
-        end;
-      end else
-        // round bracket open
-        break;
-    else
-      break;
-    end;
-    end;
-  // read token
-  TokenStart:=Src;
-  c1:=Src^;
-  case c1 of
-  #0:
-    ;
-  'A'..'Z','a'..'z','_':
-    begin
-    // identifier
-    inc(Src);
-    while Src^ in IdentChars do
-      inc(Src);
-    end;
-  '0'..'9': // number
-    begin
-    inc(Src);
-    // read numbers
-    while (Src^ in ['0'..'9']) do
-      inc(Src);
-    if (Src^='.') and (Src[1]<>'.') then
-      begin
-      // real type number
-      inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    if (Src^ in ['e','E']) then
-      begin
-      // read exponent
-      inc(Src);
-      if (Src^='-') then inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    end;
-  '''','#':  // string constant
-    while true do
-      case Src^ of
-      #0: break;
-      '#':
-        begin
-        inc(Src);
-        while Src^ in ['0'..'9'] do
-          inc(Src);
-        end;
-      '''':
-        begin
-        inc(Src);
-        while not (Src^ in ['''',#0]) do
-          inc(Src);
-        if Src^='''' then
-          inc(Src);
-        end;
-      else
-        break;
-      end;
-  '$':  // hex constant
-    begin
-    inc(Src);
-    while Src^ in HexNumberChars do
-      inc(Src);
-    end;
-  '&':  // octal constant or keyword as identifier (e.g. &label)
-    begin
-    inc(Src);
-    if Src^ in ['0'..'7'] then
-      while Src^ in ['0'..'7'] do
-        inc(Src)
-    else
-      while Src^ in IdentChars do
-        inc(Src);
-    end;
-  '{':  // compiler directive (it can't be a comment, because see above)
-    begin
-    CommentLvl:=1;
-    while true do
-      begin
-      inc(Src);
-      case Src^ of
-      #0: break;
-      '{':
-        if NestedComments then
-          inc(CommentLvl);
-      '}':
-        begin
-        dec(CommentLvl);
-        if CommentLvl=0 then
-          begin
-          inc(Src);
-          break;
-          end;
-        end;
-      end;
-      end;
-    end;
-  '(':  // bracket or compiler directive
-    if (Src[1]='*') then
-      begin
-      // compiler directive -> read til comment end
-      inc(Src,2);
-      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
-        inc(Src);
-      inc(Src,2);
-      end
-    else
-      // round bracket open
-      inc(Src);
-  #192..#255:
-    begin
-    // read UTF8 character
-    inc(Src);
-    if ((ord(c1) and %11100000) = %11000000) then
-      begin
-      // could be 2 byte character
-      if (ord(Src[0]) and %11000000) = %10000000 then
-        inc(Src);
-      end
-    else if ((ord(c1) and %11110000) = %11100000) then
-      begin
-      // could be 3 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000) then
-        inc(Src,2);
-      end
-    else if ((ord(c1) and %11111000) = %11110000) then
-      begin
-      // could be 4 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000)
-      and ((ord(Src[2]) and %11000000) = %10000000) then
-        inc(Src,3);
-      end;
-    end;
-  else
-    inc(Src);
-    case c1 of
-    '<': if Src^ in ['>','='] then inc(Src);
-    '.': if Src^='.' then inc(Src);
-    '@':
-      if Src^='@' then
-        begin
-        // @@ label
-        repeat
-          inc(Src);
-        until not (Src^ in IdentChars);
-        end
-    else
-      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
-        inc(Src);
-    end;
-  end;
-  Position:=Src;
-end;
-
 { TTestEngine }
 
 destructor TTestEngine.Destroy;

packages/fcl-passrc/tests/tcexprparser.pas

@@ -5,7 +5,7 @@ unit tcexprparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit,  testregistry, tcbaseparser, pastree;
+  Classes, SysUtils, fpcunit, testregistry, tcbaseparser, TestPasUtils, pastree;
 
 type
 

packages/fcl-passrc/tests/tcgenerics.pas

@@ -43,6 +43,7 @@ Type
 
     // generic method
     Procedure TestGenericMethod_Program;
+    Procedure TestGenericMethod_OverloadDelphi;
   end;
 
 implementation
@@ -384,6 +385,35 @@ begin
   ParseModule;
 end;
 
+procedure TTestGenerics.TestGenericMethod_OverloadDelphi;
+begin
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure Fly<S>; overload;',
+  '    procedure Fly<T>(val: T); overload;',
+  '  end;',
+  'procedure TObject.Fly<S>;',
+  'begin',
+  'end;',
+  'procedure TObject.Fly<T>(val: word);',
+  'begin',
+  'end;',
+  'var o : TObject;',
+  'begin',
+  '  o.Fly<word>;',
+  '  o.Fly<word>();',
+  '  o.Fly<longint>(3);',
+  '  with o do begin',
+  '    Fly<word>;',
+  '    Fly<word>();',
+  '    Fly<longint>(13);',
+  '  end;',
+  '']);
+  ParseModule;
+end;
+
 initialization
   RegisterTest(TTestGenerics);
 end.

packages/fcl-passrc/tests/tcresolver.pas

@@ -20,7 +20,7 @@ interface
 uses
   Classes, SysUtils, contnrs, strutils, fpcunit, testregistry,
   PasTree, PScanner, PParser, PasResolver, PasResolveEval,
-  tcbaseparser;
+  tcbaseparser, TestPasUtils;
 
 type
   TSrcMarkerKind = (
@@ -568,6 +568,7 @@ type
     Procedure TestClass_MethodInvalidOverload;
     Procedure TestClass_MethodOverride;
     Procedure TestClass_MethodOverride2;
+    Procedure TestClass_MethodOverrideAndOverload;
     Procedure TestClass_MethodOverrideFixCase;
     Procedure TestClass_MethodOverrideSameResultType;
     Procedure TestClass_MethodOverrideDiffResultTypeFail;
@@ -9644,6 +9645,36 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_MethodOverrideAndOverload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  public',
+  '    procedure Fly(b: boolean); virtual; abstract; overload;',
+  '    procedure Fly(c: word); virtual; abstract; overload;',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  public',
+  '    procedure Fly(b: boolean); override; overload;',
+  '    procedure Fly(c: word); override; overload;',
+  '  end;',
+  'procedure TBird.Fly(b: boolean);',
+  'begin end;',
+  'procedure TBird.Fly(c: word);',
+  'begin end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  '  b.Fly(true);',
+  '  b.Fly(1);',
+  'end.',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_MethodOverrideFixCase;
 
   procedure CheckOverrideName(aLabel: string);

packages/fcl-passrc/tests/tcstatements.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
-  tcbaseparser, testregistry;
+  tcbaseparser, TestPasUtils, testregistry;
 
 Type
   { TTestStatementParser }

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -10,7 +10,8 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, PasTree, PScanner, PasResolver, tcbaseparser,
-  testregistry, strutils, tcresolver, PasUseAnalyzer, PasResolveEval;
+  testregistry, strutils, tcresolver, PasUseAnalyzer,
+  PasResolveEval;
 
 type
 
@@ -280,7 +281,9 @@ begin
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
     begin
+    {$IFDEF VerbosePasAnalyzer}
     writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
+    {$ENDIF}
     p:=RPos('_',aMarker^.Identifier);
     if p>1 then
       begin
@@ -303,7 +306,9 @@ begin
         for i:=0 to Elements.Count-1 do
           begin
           El:=TPasElement(Elements[i]);
+          {$IFDEF VerbosePasAnalyzer}
           writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          {$ENDIF}
           case ExpectedUsed of
           uUsed,uNotUsed:
             if Analyzer.IsUsed(El) then

packages/fcl-passrc/tests/testpassrc.lpr

@@ -7,7 +7,7 @@ uses
   Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcexprparser, tcprocfunc, tcpassrcutil, tcresolver,
-  tcuseanalyzer, pasresolveeval, tcresolvegenerics, tcgenerics;
+  tcuseanalyzer, pasresolveeval, tcresolvegenerics, tcgenerics, TestPasUtils;
 
 type
 

packages/fcl-passrc/tests/testpasutils.pas

@@ -0,0 +1,299 @@
+unit TestPasUtils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, PasTree;
+
+function ExtractFileUnitName(aFilename: string): string;
+function GetPasElementDesc(El: TPasElement): string;
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+
+implementation
+
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
+
+function GetPasElementDesc(El: TPasElement): string;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
+end;
+
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  c1:char;
+  CommentLvl: Integer;
+  Src: PChar;
+begin
+  Src:=Position;
+  // read till next atom
+  while true do
+    begin
+    case Src^ of
+    #0: break;
+    #1..#32:  // spaces and special characters
+      inc(Src);
+    #$EF:
+      if (Src[1]=#$BB)
+      and (Src[2]=#$BF) then
+        begin
+        // skip UTF BOM
+        inc(Src,3);
+        end
+      else
+        break;
+    '{':    // comment start or compiler directive
+      if (Src[1]='$') and (not SkipDirectives) then
+        // compiler directive
+        break
+      else begin
+        // Pascal comment => skip
+        CommentLvl:=1;
+        while true do
+          begin
+          inc(Src);
+          case Src^ of
+          #0: break;
+          '{':
+            if NestedComments then
+              inc(CommentLvl);
+          '}':
+            begin
+            dec(CommentLvl);
+            if CommentLvl=0 then
+              begin
+              inc(Src);
+              break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    '/':  // comment or real division
+      if (Src[1]='/') then
+        begin
+        // comment start -> read til line end
+        inc(Src);
+        while not (Src^ in [#0,#10,#13]) do
+          inc(Src);
+        end
+      else
+        break;
+    '(':  // comment, bracket or compiler directive
+      if (Src[1]='*') then
+        begin
+        if (Src[2]='$') and (not SkipDirectives) then
+          // compiler directive
+          break
+        else
+          begin
+          // comment start -> read til comment end
+          inc(Src,2);
+          CommentLvl:=1;
+          while true do
+            begin
+            case Src^ of
+            #0: break;
+            '(':
+              if NestedComments and (Src[1]='*') then
+                inc(CommentLvl);
+            '*':
+              if (Src[1]=')') then
+                begin
+                dec(CommentLvl);
+                if CommentLvl=0 then
+                  begin
+                  inc(Src,2);
+                  break;
+                  end;
+                inc(Position);
+                end;
+            end;
+            inc(Src);
+            end;
+        end;
+      end else
+        // round bracket open
+        break;
+    else
+      break;
+    end;
+    end;
+  // read token
+  TokenStart:=Src;
+  c1:=Src^;
+  case c1 of
+  #0:
+    ;
+  'A'..'Z','a'..'z','_':
+    begin
+    // identifier
+    inc(Src);
+    while Src^ in IdentChars do
+      inc(Src);
+    end;
+  '0'..'9': // number
+    begin
+    inc(Src);
+    // read numbers
+    while (Src^ in ['0'..'9']) do
+      inc(Src);
+    if (Src^='.') and (Src[1]<>'.') then
+      begin
+      // real type number
+      inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    if (Src^ in ['e','E']) then
+      begin
+      // read exponent
+      inc(Src);
+      if (Src^='-') then inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    end;
+  '''','#':  // string constant
+    while true do
+      case Src^ of
+      #0: break;
+      '#':
+        begin
+        inc(Src);
+        while Src^ in ['0'..'9'] do
+          inc(Src);
+        end;
+      '''':
+        begin
+        inc(Src);
+        while not (Src^ in ['''',#0]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      else
+        break;
+      end;
+  '$':  // hex constant
+    begin
+    inc(Src);
+    while Src^ in HexNumberChars do
+      inc(Src);
+    end;
+  '&':  // octal constant or keyword as identifier (e.g. &label)
+    begin
+    inc(Src);
+    if Src^ in ['0'..'7'] then
+      while Src^ in ['0'..'7'] do
+        inc(Src)
+    else
+      while Src^ in IdentChars do
+        inc(Src);
+    end;
+  '{':  // compiler directive (it can't be a comment, because see above)
+    begin
+    CommentLvl:=1;
+    while true do
+      begin
+      inc(Src);
+      case Src^ of
+      #0: break;
+      '{':
+        if NestedComments then
+          inc(CommentLvl);
+      '}':
+        begin
+        dec(CommentLvl);
+        if CommentLvl=0 then
+          begin
+          inc(Src);
+          break;
+          end;
+        end;
+      end;
+      end;
+    end;
+  '(':  // bracket or compiler directive
+    if (Src[1]='*') then
+      begin
+      // compiler directive -> read til comment end
+      inc(Src,2);
+      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
+        inc(Src);
+      inc(Src,2);
+      end
+    else
+      // round bracket open
+      inc(Src);
+  #192..#255:
+    begin
+    // read UTF8 character
+    inc(Src);
+    if ((ord(c1) and %11100000) = %11000000) then
+      begin
+      // could be 2 byte character
+      if (ord(Src[0]) and %11000000) = %10000000 then
+        inc(Src);
+      end
+    else if ((ord(c1) and %11110000) = %11100000) then
+      begin
+      // could be 3 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000) then
+        inc(Src,2);
+      end
+    else if ((ord(c1) and %11111000) = %11110000) then
+      begin
+      // could be 4 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000)
+      and ((ord(Src[2]) and %11000000) = %10000000) then
+        inc(Src,3);
+      end;
+    end;
+  else
+    inc(Src);
+    case c1 of
+    '<': if Src^ in ['>','='] then inc(Src);
+    '.': if Src^='.' then inc(Src);
+    '@':
+      if Src^='@' then
+        begin
+        // @@ label
+        repeat
+          inc(Src);
+        until not (Src^ in IdentChars);
+        end
+    else
+      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
+        inc(Src);
+    end;
+  end;
+  Position:=Src;
+end;
+
+end.
+

packages/fcl-web/src/base/fphttpclient.pp

@@ -677,7 +677,6 @@ begin
       Aport:=443
     else
       Aport:=80;
-  G:=GetSocketHandler(UseSSL);    
   {$ifdef Unix}
   IsUnixSocketConnection := UnixSocketPath <> '';
   if IsUnixSocketConnection then

packages/fcl-web/src/base/httproute.pp

@@ -52,6 +52,7 @@ Type
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
   Public
     Destructor Destroy; override;
+    class function NormalizeRoute(AValue: String): String;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
     Function Matches(Const APattern : String; AMethod : TRouteMethod; Options : TRouteOptions) : Boolean;
     Function MatchPattern(Const Path : String; L : TStrings; Options : TRouteOptions) : Boolean;
@@ -457,9 +458,11 @@ procedure THTTPRouter.CheckDuplicate(APattern: String; AMethod: TRouteMethod;
 Var
   I,DI : Integer;
   R : THTTPRoute;
+  aPtrn : String;
 
 begin
   DI:=-1;
+  aPtrn:=THTTPRoute.NormalizeRoute(aPattern);
   Lock;
   try
     For I:=0 to FRoutes.Count-1 do
@@ -467,7 +470,7 @@ begin
       R:=FRoutes[I];
       if R.Default then
         DI:=I;
-      if R.Matches(APattern,AMethod,FRouteOptions) then
+      if R.Matches(aPtrn,AMethod,FRouteOptions) then
         Raise EHTTPRoute.CreateFmt(EDuplicateRoute,[APattern,RouteMethodToString(AMethod)]);
       end;
   finally
@@ -866,15 +869,21 @@ end;
 
 { THTTPRoute }
 
+Class Function THTTPRoute.NormalizeRoute(AValue: String) : String;
+
+begin
+  Result:=IncludeHTTPPathDelimiter(AValue);
+  if (Length(Result)>1) and (Result[1]='/') then
+    Delete(Result,1,1);
+end;
+
 procedure THTTPRoute.SetURLPattern(AValue: String);
 
 Var
   V : String;
 
 begin
-  V:=IncludeHTTPPathDelimiter(AValue);
-  if (V<>'') and (V<>'/') and (V[1]='/') then
-    Delete(V,1,1);
+  V:=NormalizeRoute(aValue);
   if FURLPattern=V then Exit;
   FURLPattern:=V;
 end;
@@ -899,7 +908,7 @@ function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod; Optio
 begin
   Result:=((Method=rmAll) or (AMethod=Method));
   if Result then
-    Result:=SameText(URLPattern,APattern) or ((URLPattern='') and (roEmptyMatchesAll in Options))
+    Result:=SameText(URLPattern,NormalizeRoute(APattern)) or ((URLPattern='') and (roEmptyMatchesAll in Options))
 end;
 
 Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings; Options: TRouteOptions) : Boolean;

packages/ide/Makefile

@@ -2957,7 +2957,7 @@ ifdef CREATESHARED
 override FPCOPT+=-Cg
 endif
 ifneq ($(filter $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
-ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel riscv64 powerpc64),)
+ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel mips64 mips64el riscv64 powerpc64),)
 override FPCOPT+=-Cg
 endif
 endif
@@ -3430,7 +3430,7 @@ ifdef NOLLVM
 FPMAKE_OPT+=--NOLLVM=1
 endif
 .NOTPARALLEL:
-PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64
+PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa wasm32 z80
 CLEAN_TARGETS=$(addsuffix _clean,$(sort $(PPC_TARGETS)))
 DISTCLEAN_TARGETS=$(addsuffix _distclean,$(sort $(PPC_TARGETS)))
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(PPC_TARGETS)))

packages/ide/Makefile.fpc

@@ -100,7 +100,7 @@ endif
 
 .NOTPARALLEL:
 
-PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64
+PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64 riscv32 riscv64 xtensa wasm32 z80
 CLEAN_TARGETS=$(addsuffix _clean,$(sort $(PPC_TARGETS)))
 DISTCLEAN_TARGETS=$(addsuffix _distclean,$(sort $(PPC_TARGETS)))
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(PPC_TARGETS)))

packages/ide/compiler/Makefile

@@ -388,6 +388,15 @@ endif
 ifeq ($(PPC_TARGET),sparc64)
 override FPCOPT+= -Fu$(COMPILERDIR)/sparcgen -Fi$(COMPILERDIR)/sparcgen
 endif
+ifeq ($(PPC_TARGET),wasm32)
+override FPCOPT+= -dNOOPT
+endif
+ifeq ($(PPC_TARGET),riscv32)
+override LOCALOPT+=-Furiscv
+endif
+ifeq ($(PPC_TARGET),riscv64)
+override LOCALOPT+=-Furiscv
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_UNITS+=compunit
 endif
@@ -3787,7 +3796,7 @@ ifdef CREATESHARED
 override FPCOPT+=-Cg
 endif
 ifneq ($(filter $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
-ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel riscv64 powerpc64),)
+ifneq ($(filter $(CPU_TARGET),x86_64 mips mipsel mips64 mips64el riscv64 powerpc64),)
 override FPCOPT+=-Cg
 endif
 endif

packages/ide/compiler/Makefile.fpc

@@ -75,6 +75,20 @@ endif
 ifeq ($(PPC_TARGET),sparc64)
 override FPCOPT+= -Fu$(COMPILERDIR)/sparcgen -Fi$(COMPILERDIR)/sparcgen
 endif
+# wasm32 specific
+ifeq ($(PPC_TARGET),wasm32)
+override FPCOPT+= -dNOOPT
+endif
+# RiscV32 specific
+ifeq ($(PPC_TARGET),riscv32)
+override LOCALOPT+=-Furiscv
+endif
+# RiscV64 specific
+ifeq ($(PPC_TARGET),riscv64)
+override LOCALOPT+=-Furiscv
+endif
+
+
 
 
 [rules]

packages/ide/fpmake.pp

@@ -248,6 +248,8 @@ begin
         P.Options.Add('-dNOCATCH');
         P.Options.Add('-dBrowserCol');
         P.Options.Add('-dGDB');
+        if CompilerTarget=wasm32 then
+          P.Options.Add('-dNOOPT');
         
         CompilerDir:=P.Directory +'../../compiler';
 
@@ -302,7 +304,7 @@ begin
         T:=P.Targets.AddProgram('fp.pas');
         if CompilerTarget<>Defaults.CPU then
           begin
-            T.SetExeName(CPUToString(CompilerTarget)+'-fp');
+            T.SetExeName(AddProgramExtension(CPUToString(CompilerTarget)+'-fp',Defaults.BuildOS));
             P.SetUnitsOutputDir(P.GetUnitsOutputDir(Defaults.BuildCPU,Defaults.BuildOS)+CPUToString(CompilerTarget));
             P.Options.Add('-dCROSSGDB');
           end;

packages/pastojs/src/fppas2js.pp

@@ -677,6 +677,7 @@ type
     pbivnMessageInt,
     pbivnMessageStr,
     pbivnLibrary, // library
+    pbivnLibraryVars, // library vars
     pbivnLocalModuleRef,
     pbivnLocalProcRef,
     pbivnLocalTypeRef,
@@ -865,6 +866,7 @@ const
     '$msgint', // pbivnMessageInt
     '$msgstr', // pbivnMessageStr
     'library', //  pbivnLibrary  pas.library
+    'vars', //  pbivnLibraryVars  vars
     '$lm', // pbivnLocalModuleRef
     '$lp', // pbivnLocalProcRef
     '$lt', // pbivnLocalTypeRef
@@ -1552,6 +1554,9 @@ type
     procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty
       ); override;
     procedure FinishExportSymbol(El: TPasExportSymbol); override;
+    procedure ComputeArgumentExpr(const ArgResolved: TPasResolverResult;
+      Access: TArgumentAccess; Expr: TPasExpr; out
+      ExprResolved: TPasResolverResult; SetReferenceFlags: boolean); override;
     procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement);
     function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual;
     function FindSystemExternalClassType(const aClassName, JSName: string;
@@ -2049,6 +2054,7 @@ type
       AContext: TConvertContext): TJSElement; virtual;
     Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
     Function CreateDotSplit(El: TPasElement; Expr: TJSElement): TJSElement; virtual;
+    Function CreateExportStatement(VarType: TJSVarType; AliasName: TJSString; InitJS: TJSElement; PosEl: TPasElement): TJSExportStatement; virtual;
     Function CreatePrecompiledJS(El: TJSElement): string; virtual;
     Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
     // JS literals
@@ -2097,6 +2103,7 @@ type
     Function CreateImplementationSection(El: TPasModule; IntfContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement; virtual;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure CreateExportsSection(El: TPasLibrary; Src: TJSSourceElements; AContext: TConvertContext); virtual;
+    Function AddRTLRun(El: TPasModule; ModuleName: string; Src: TJSSourceElements; AContext: TConvertContext): TJSCallExpression; virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     function AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext): boolean; virtual;
@@ -4912,6 +4919,7 @@ procedure TPas2JSResolver.FinishExportSymbol(El: TPasExportSymbol);
 var
   ResolvedEl: TPasResolverResult;
   DeclEl: TPasElement;
+  C: TClass;
   Proc: TPasProcedure;
   V: TPasVariable;
 begin
@@ -4932,6 +4940,7 @@ begin
       sSymbolCannotBeExportedFromALibrary,[],El);
   if DeclEl is TPasResultElement then
     DeclEl:=DeclEl.Parent.Parent;
+  C:=DeclEl.ClassType;
 
   if DeclEl.Parent=nil then
     RaiseMsg(20220206142534,nSymbolCannotBeExportedFromALibrary,
@@ -4949,14 +4958,14 @@ begin
     RaiseMsg(20211022224239,nSymbolCannotBeExportedFromALibrary,
       sSymbolCannotBeExportedFromALibrary,[],El);
 
-  if DeclEl is TPasProcedure then
+  if C.InheritsFrom(TPasProcedure) then
     begin
     Proc:=TPasProcedure(DeclEl);
     if Proc.IsExternal or Proc.IsAbstract then
       RaiseMsg(20211021225630,nSymbolCannotBeExportedFromALibrary,
         sSymbolCannotBeExportedFromALibrary,[],El);
     end
-  else if DeclEl is TPasVariable then
+  else if (C=TPasVariable) or (C=TPasConst) then
     begin
     V:=TPasVariable(DeclEl);
     if vmExternal in V.VarModifiers then
@@ -4964,8 +4973,39 @@ begin
         sSymbolCannotBeExportedFromALibrary,[],El);
     end
   else
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPas2JSResolver.FinishExportSymbol ',GetObjPath(El));
+    {$ENDIF}
     RaiseMsg(20210106223621,nSymbolCannotBeExportedFromALibrary,
       sSymbolCannotBeExportedFromALibrary,[],El);
+    end;
+end;
+
+procedure TPas2JSResolver.ComputeArgumentExpr(
+  const ArgResolved: TPasResolverResult; Access: TArgumentAccess;
+  Expr: TPasExpr; out ExprResolved: TPasResolverResult;
+  SetReferenceFlags: boolean);
+var
+  RightEl: TPasExpr;
+  Ref: TResolvedReference;
+begin
+  inherited ComputeArgumentExpr(ArgResolved, Access, Expr, ExprResolved,
+    SetReferenceFlags);
+  if SetReferenceFlags
+      and (Access in [argDefault, argConst])
+      and ((ArgResolved.BaseType=btUntyped)
+         or IsJSBaseType(ArgResolved,pbtJSValue,true{must have rrfReadable}))
+      and (ExprResolved.LoTypeEl is TPasRecordType) then
+    begin
+    // passing a record to an untyped or jsvalue parameter -> mark fields as "read" too
+    RightEl:=GetRightMostExpr(Expr);
+    if RightEl.CustomData is TResolvedReference then
+      begin
+      Ref:=TResolvedReference(RightEl.CustomData);
+      Include(Ref.Flags,rrfUseFields);
+      end;
+    end;
 end;
 
 procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList;
@@ -8207,7 +8247,10 @@ Library:
         <initialization>
         };
     });
-  export1 = pas.unit1.func1;
+  rtl.run('library');
+  var li = pas['library'];
+  export const func1 = pas.unit1.func1;
+  export const var1 = li.var1;
 
 Unit without implementation:
  rtl.module('<unitname>',
@@ -8337,7 +8380,6 @@ begin
       if Assigned(Lib.LibrarySection) then
         AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
       HasImplCode:=AddDelayedInits(Lib,Src,IntfContext);
-      CreateExportsSection(Lib,Src,IntfContext);
       CreateInitSection(Lib,Src,IntfContext);
       end
     else
@@ -8387,6 +8429,18 @@ begin
 
     if (ModScope<>nil) and (coStoreImplJS in Options) then
       StoreImplJSLocals(ModScope,IntfContext);
+
+    if El is TPasLibrary then
+      begin
+      // library: rtl.run('library');
+      Lib:=TPasLibrary(El);
+      AddRTLRun(Lib,ModuleName,OuterSrc,AContext);
+      CreateExportsSection(Lib,OuterSrc,AContext);
+      end
+    else if (El is TPasProgram) and (Globals.TargetPlatform in [PlatformNodeJS,PlatformModule]) then
+      // program: rtl.run();
+      AddRTLRun(El,'',OuterSrc,AContext);
+
     ok:=true;
   finally
     IntfContext.Free;
@@ -18029,28 +18083,58 @@ end;
 
 procedure TPasToJSConverter.CreateExportsSection(El: TPasLibrary;
   Src: TJSSourceElements; AContext: TConvertContext);
+// functions:
+//   export const func1 = pas.unit1.func1;
+// variables:
+//   export const vars = {};
+//   Object.defineProperties(vars, {
+//     Var1: {
+//       get: function(){return pas.unit1.Var1;},
+//       set: function(v){pas.unit1.Var1 = v;},
+//     }
+//   });
+
+  procedure AddPropFunction(ObjLit: TJSObjectLiteral; AliasName, Arg1: TJSString;
+    BodyJS: TJSElement; PosEl: TPasElement);
+  var
+    Lit: TJSObjectLiteralElement;
+    FuncSt: TJSFunctionDeclarationStatement;
+  begin
+    Lit:=ObjLit.Elements.AddElement;
+    Lit.Name:=AliasName;
+    FuncSt:=CreateFunctionSt(PosEl,true,false);
+    Lit.Expr:=FuncSt;
+    if Arg1<>'' then
+      FuncSt.AFunction.TypedParams.AddParam(Arg1);
+    FuncSt.AFunction.Body.A:=BodyJS;
+  end;
+
+
 var
   ExportSymbols: TFPList;
   aResolver: TPas2JSResolver;
-  ExpSt: TJSExportStatement;
+  VarsExpSt, ExpSt: TJSExportStatement;
   i: Integer;
   Symb: TPasExportSymbol;
   Ref: TResolvedReference;
   NamePath: String;
+  AliasName: TJSString;
   EvalValue: TResEvalValue;
-  ExpNameJS: TJSExportNameElement;
   Decl: TPasElement;
   ResolvedEl: TPasResolverResult;
+  Call: TJSCallExpression;
+  VarsObjLit, VarObjLit: TJSObjectLiteral;
+  Lit, SubLit: TJSObjectLiteralElement;
+  RetSt: TJSReturnStatement;
+  AssignSt: TJSSimpleAssignStatement;
 begin
   ExportSymbols:=El.LibrarySection.ExportSymbols;
   if ExportSymbols.Count=0 then exit;
   aResolver:=AContext.Resolver;
 
-  ExpSt:=TJSExportStatement(CreateElement(TJSExportStatement,El));
-  AddToSourceElements(Src,ExpSt);
+  VarsExpSt:=nil;
   for i:=0 to ExportSymbols.Count-1 do
     begin
-    ExpNameJS:=ExpSt.ExportNames.AddElement;
     Symb:=TObject(ExportSymbols[i]) as TPasExportSymbol;
 
     // name
@@ -18067,9 +18151,9 @@ begin
       Decl:=Ref.Declaration;
       end;
     NamePath:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
-    ExpNameJS.Name:=TJSString(NamePath);
 
     // alias
+    AliasName:='';
     if Symb.ExportName<>nil then
       begin
       EvalValue:=aResolver.Eval(Symb.ExportName,[refConst]);
@@ -18078,10 +18162,10 @@ begin
       case EvalValue.Kind of
       {$ifdef FPC_HAS_CPSTRING}
       revkString:
-        ExpNameJS.Alias:=TJSString(TResEvalString(EvalValue).S);
+        AliasName:=TJSString(TResEvalString(EvalValue).S);
       {$endif}
       revkUnicodeString:
-        ExpNameJS.Alias:=TResEvalUTF16(EvalValue).S;
+        AliasName:=TResEvalUTF16(EvalValue).S;
       else
         RaiseNotSupported(Symb.ExportName,AContext,20211020144404);
       end;
@@ -18091,11 +18175,78 @@ begin
       begin
       if Decl.Name='' then
         RaiseNotSupported(Symb,AContext,20211020144730);
-      ExpNameJS.Alias:=TJSString(Decl.Name);
+      AliasName:=TJSString(Decl.Name);
+      end;
+
+    if Decl.ClassType=TPasVariable then
+      begin
+      if VarsExpSt=nil then
+        begin
+        // add "export const vars = {};"
+        VarsExpSt:=CreateExportStatement(vtConst,
+                   TJSString(GetBIName(pbivnLibraryVars)),
+                   TJSObjectLiteral(CreateElement(TJSObjectLiteral,Symb)),Symb);
+        AddToSourceElements(Src,VarsExpSt);
+
+        // add "Object.defineProperties(vars, { });"
+        Call:=CreateCallExpression(Symb);
+        AddToSourceElements(Src,Call);
+        Call.Expr:=CreatePrimitiveDotExpr('Object.defineProperties',Symb);
+        Call.AddArg(CreatePrimitiveDotExpr(GetBIName(pbivnLibraryVars),Symb));
+        VarsObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Symb));
+        Call.AddArg(VarsObjLit);
+        end;
+      // add "Var1: {},"
+      Lit:=VarsObjLit.Elements.AddElement;
+      Lit.Name:=AliasName;
+      VarObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Symb));
+      Lit.Expr:=VarObjLit;
+
+      // enumerable: true
+      SubLit:=VarObjLit.Elements.AddElement;
+      SubLit.Name:='enumerable';
+      SubLit.Expr:=CreateLiteralBoolean(Symb,true);
+
+      //       get: function(){return pas.unit1.Var1;},
+      RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,Symb));
+      RetSt.Expr:=CreatePrimitiveDotExpr(NamePath,Symb);
+      AddPropFunction(VarObjLit,'get','',RetSt,Symb);
+
+      //       set: function(v){pas.unit1.Var1 = v;},
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,Symb));
+      AssignSt.LHS:=CreatePrimitiveDotExpr(NamePath,Symb);
+      AssignSt.Expr:=CreatePrimitiveDotExpr(TempRefObjSetterArgName,Symb);
+      AddPropFunction(VarObjLit,'set',TJSString(TempRefObjSetterArgName),AssignSt,Symb);
+
+      end
+    else
+      begin
+      // "export const AliasName = NamePath;"
+      ExpSt:=CreateExportStatement(vtConst,AliasName,CreatePrimitiveDotExpr(NamePath,Symb),Symb);
+      AddToSourceElements(Src,ExpSt);
       end;
     end;
 end;
 
+function TPasToJSConverter.AddRTLRun(El: TPasModule; ModuleName: string;
+  Src: TJSSourceElements; AContext: TConvertContext): TJSCallExpression;
+var
+  Call: TJSCallExpression;
+begin
+  if AContext=nil then ;
+
+  // add rtl.run('library');
+  Call:=CreateCallExpression(El);
+  AddToSourceElements(Src,Call);
+  Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),'run']);
+
+  if ModuleName<>'' then
+    // add module name parameter
+    Call.AddArg(CreateLiteralString(El,ModuleName));
+
+  Result:=Call;
+end;
+
 procedure TPasToJSConverter.AddHeaderStatement(JS: TJSElement;
   PosEl: TPasElement; aContext: TConvertContext);
 var
@@ -20038,6 +20189,23 @@ begin
   Result:=Call;
 end;
 
+function TPasToJSConverter.CreateExportStatement(VarType: TJSVarType;
+  AliasName: TJSString; InitJS: TJSElement; PosEl: TPasElement
+  ): TJSExportStatement;
+var
+  VarSt: TJSVariableStatement;
+  VarDecl: TJSVarDeclaration;
+begin
+  Result:=TJSExportStatement(CreateElement(TJSExportStatement,PosEl));
+  VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,PosEl));
+  Result.Declaration:=VarSt;
+  VarSt.VarType:=VarType;
+  VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,PosEl));
+  VarSt.VarDecl:=VarDecl;
+  VarDecl.Name:=AliasName;
+  VarDecl.Init:=InitJS;
+end;
+
 function TPasToJSConverter.CreatePrecompiledJS(El: TJSElement): string;
 var
   aWriter: TBufferWriter;

packages/pastojs/src/pas2jscompiler.pp

@@ -2805,9 +2805,6 @@ begin
     FResources.DoneUnit(aFile.isMainFile);
     EmitJavaScript(aFile,aFileWriter);
 
-    if aFile.IsMainFile and (TargetPlatform in [PlatformNodeJS,PlatformModule]) then
-      aFileWriter.WriteFile('rtl.run();'+LineEnding,aFile.UnitFilename);
-
     if isSingleFile or aFile.isMainFile then
       begin
       if aFile.IsMainFile  then

packages/pastojs/src/pas2jsfiler.pp

@@ -565,7 +565,8 @@ const
     'NewInst',
     'FreeInst',
     'VMT',
-    'ConstInh'
+    'ConstInh',
+    'UseFields'
     );
 
   PCUResolverWithExprScopeFlagNames: array[TPasWithExprScopeFlag] of string = (

packages/pastojs/tests/tcconverter.pas

@@ -394,7 +394,7 @@ begin
 
   // "var $l=1, $end=100"
   VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
-  VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.A));
+  VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.VarDecl));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
   AssertEquals('Correct name for '+LoopVar,LoopVar,VD.Name);
   AssertLiteral('Correct start value',VD.Init,1);
@@ -455,7 +455,7 @@ begin
 
   // "var $l=100, $end=1"
   VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
-  VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.A));
+  VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.VarDecl));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
   AssertEquals('Correct name for '+LoopVar,LoopVar,VD.Name);
   AssertLiteral('Correct start value',VD.Init,100);
@@ -704,7 +704,7 @@ begin
   L:=AssertListStatement('On block is always a list',I.BTrue);
   writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
   VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
-  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.VarDecl));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
   Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
   // check "b = c;"
@@ -765,7 +765,7 @@ begin
   L:=AssertListStatement('On block is always a list',I.BTrue);
   writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
   VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
-  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.VarDecl));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
   Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
   R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B));
@@ -787,7 +787,7 @@ begin
   S.Variables.Add(V);
   L:=TJSStatementList(Convert(S,TJSStatementList));
   JV:=TJSVariableStatement(AssertElement('Variable statement',TJSVariableStatement,L.A));
-  JVD:=TJSVarDeclaration(AssertElement('Variable declaration',TJSVarDeclaration,JV.A));
+  JVD:=TJSVarDeclaration(AssertElement('Variable declaration',TJSVarDeclaration,JV.VarDecl));
   AssertEquals('Correct variable name','a',JVD.Name);
 end;
 

packages/pastojs/tests/tcfiler.pas

@@ -370,7 +370,7 @@ begin
   FInitialFlags:=TPCUInitialFlags.Create;
   FAnalyzer:=TPas2JSAnalyzer.Create;
   FCheckedElements:=TPasAnalyzerKeySet.Create(@CompareCheckedElementPairs,@CompareElWithCheckedElementPair);
-  Analyzer.Resolver:=Engine;
+  Analyzer.Resolver:=ResolverEngine;
   Analyzer.Options:=Analyzer.Options+[paoImplReferences];
   Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
   Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
@@ -433,7 +433,7 @@ begin
     try
       PCUWriter.OnGetSrc:=@OnFilerGetSrc;
       PCUWriter.OnIsElementUsed:=@OnConverterIsElementUsed;
-      PCUWriter.WritePCU(Engine,Converter,InitialFlags,ms,false);
+      PCUWriter.WritePCU(ResolverEngine,Converter,InitialFlags,ms,false);
     except
       on E: Exception do
       begin
@@ -457,7 +457,7 @@ begin
       RestScanner:=TPas2jsPasScanner.Create(RestFileResolver);
       InitScanner(RestScanner);
       RestResolver:=TTestEnginePasResolver.Create;
-      RestResolver.Filename:=Engine.Filename;
+      RestResolver.Filename:=ResolverEngine.Filename;
       RestResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
       RestResolver.OnFindUnit:=@OnRestResolverFindUnit;
       RestParser:=TPasParser.Create(RestScanner,RestFileResolver,RestResolver);
@@ -493,7 +493,7 @@ begin
       end;
     end;
     // check parser+resolver+analyzer
-    CheckRestoredResolver(Engine,RestResolver,[]);
+    CheckRestoredResolver(ResolverEngine,RestResolver,[]);
 
     // convert using the precompiled procs
     RestConverter:=CreateConverter;
@@ -1059,7 +1059,7 @@ begin
     if Orig.ModeSwitches<>Rest.ModeSwitches then
       Fail(Path+'.ModeSwitches');
 
-    if Engine.ProcCanBePrecompiled(DeclProc) then
+    if ResolverEngine.ProcCanBePrecompiled(DeclProc) then
       begin
       CheckRestoredScopeRefs(Path+'.References',Orig.References,Rest.References,Flags);
       end;
@@ -2041,7 +2041,7 @@ begin
   // Body
   if Orig.Body<>nil then
     begin
-    if not Engine.ProcCanBePrecompiled(DeclProc) then
+    if not ResolverEngine.ProcCanBePrecompiled(DeclProc) then
       begin
       // generic body
       if OrigScope.ImplJS<>nil then

packages/pastojs/tests/tcgenerics.pas

@@ -27,13 +27,13 @@ type
     Procedure TestGen_ClassEmpty;
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_TList;
-    Procedure TestGen_Class_TCustomList; // ToDo: with Self do Result:=Method()
+    Procedure TestGen_Class_TCustomList;
     Procedure TestGen_ClassAncestor;
     Procedure TestGen_Class_TypeInfo;
-    Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird<T>, TBird<S,T>
+    Procedure TestGen_Class_TypeOverload;
     Procedure TestGen_Class_ClassProperty;
     Procedure TestGen_Class_ClassProc;
-    //Procedure TestGen_Record_ReferGenClass_DelphiFail; TBird<T> = class x:TBird; end;
+    Procedure TestGen_Class_ReferGenClass_DelphiFail;
     Procedure TestGen_Class_ClassConstructor;
     Procedure TestGen_Class_TypeCastSpecializesWarn;
     Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn;
@@ -77,11 +77,11 @@ type
     procedure TestGenProc_Infer_Widen;
     procedure TestGenProc_Infer_PassAsArg;
     procedure TestGenProc_AnonymousProc;
-    // ToDo: FuncName:= instead of Result:=
 
     // generic methods
     procedure TestGenMethod_ImplicitSpec_ObjFPC;
     procedure TestGenMethod_Delphi;
+    procedure TestGenMethod_Overload_Delphi;
 
     // generic array
     procedure TestGen_Array_OtherUnit;
@@ -92,6 +92,8 @@ type
     procedure TestGen_ProcType_ProcLocal;
     procedure TestGen_ProcType_Local_RTTI_Fail;
     procedure TestGen_ProcType_ParamUnitImpl;
+    // procedure TestGen_ProcType_TemplateCountOverload_ObjFPC; ObjFPC does not support that in FPC
+    procedure TestGen_ProcType_TemplateCountOverload_Delphi;
   end;
 
 implementation
@@ -574,7 +576,7 @@ begin
   'begin',
   '  Result:=PrepareAddingItem;',
   '  Result:=Self.PrepareAddingItem;',
-  //'  with Self do Result:=PrepareAddingItem;',
+  '  with Self do Result:=PrepareAddingItem;',
   'end;',
   'var l: TWordList;',
   'begin',
@@ -599,6 +601,7 @@ begin
     '    var Result = 0;',
     '    Result = this.PrepareAddingItem();',
     '    Result = this.PrepareAddingItem();',
+    '    Result = this.PrepareAddingItem();',
     '    return Result;',
     '  };',
     '}, "TList<System.Word>");',
@@ -688,8 +691,6 @@ end;
 
 procedure TTestGenerics.TestGen_Class_TypeOverload;
 begin
-  exit;// ToDo
-
   StartProgram(false);
   Add([
   '{$mode delphi}',
@@ -714,6 +715,14 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
+    'rtl.createClass(this, "TBird$G1", this.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.m = 0;',
+    '  };',
+    '}, "TBird<System.Word>");',
+    'this.b = null;',
+    'this.e = null;',
     '']),
     LinesToStr([ // $mod.$main
     '']));
@@ -820,6 +829,24 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Class_ReferGenClass_DelphiFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TPoint<T> = class',
+  '    var x: TPoint;', // alowed in objfpc, forbidden in delphi
+  '  end;',
+  'var p: specialize TPoint<word>;',
+  'begin',
+  '']);
+  SetExpectedPasResolverError('Generics without specialization cannot be used as a type for a variable',
+     nGenericsWithoutSpecializationAsType);
+  ConvertProgram;
+end;
+
 procedure TTestGenerics.TestGen_Class_ClassConstructor;
 begin
   StartProgram(false);
@@ -2501,6 +2528,59 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGenMethod_Overload_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure Run<S>; overload;',
+  '    procedure Run<T>(w: word); overload;',
+  '  end; ',
+  'procedure TObject.Run<S>;',
+  'begin',
+  'end;',
+  'procedure TObject.Run<T>(w: word);',
+  'begin',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o.Run<word>;',
+  '  o.Run<word>();',
+  '  o.Run<longint>(3);',
+  '  with o do begin',
+  '    Run<word>;',
+  '    Run<word>();',
+  '    Run<longint>(13);',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenMethod_Overload_Delphi',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Run$G1 = function () {',
+    '  };',
+    '  this.Run$1G1 = function (w) {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.o.Run$G1();',
+    '$mod.o.Run$G1();',
+    '$mod.o.Run$1G1(3);',
+    'var $with = $mod.o;',
+    '$with.Run$G1();',
+    '$with.Run$G1();',
+    '$with.Run$1G1(13);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_Array_OtherUnit;
 begin
   WithTypeInfo:=true;
@@ -2812,6 +2892,50 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ProcType_TemplateCountOverload_Delphi;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TProc<T> = procedure(a, b: T);',
+  '  TProc<S,T> = procedure(a: S; b: T);',
+  'var',
+  '  p: TProc<word>;',
+  '  q: TProc<char,boolean>;',
+  'procedure Run(x,y: word);',
+  'begin',
+  'end;',
+  'procedure Fly(x: char; y: boolean);',
+  'begin',
+  'end;',
+  'begin',
+  '  p:=Run;',
+  '  q:=Fly;',
+  'end.']);
+  ConvertProgram;
+  CheckSource('TestGen_ProcType_TemplateCountOverload_Delphi',
+    LinesToStr([ // statements
+    'this.$rtti.$ProcVar("TProc<System.Word>", {',
+    '  procsig: rtl.newTIProcSig([["a", rtl.word], ["b", rtl.word]])',
+    '});',
+    'this.p = null;',
+    'this.$rtti.$ProcVar("TProc<System.Char,System.Boolean>", {',
+    '  procsig: rtl.newTIProcSig([["a", rtl.char], ["b", rtl.boolean]])',
+    '});',
+    'this.q = null;',
+    'this.Run = function (x, y) {',
+    '};',
+    'this.Fly = function (x, y) {',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.Run;',
+    '$mod.q = $mod.Fly;',
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestGenerics]);
 end.

packages/pastojs/tests/tcoptimizations.pas

@@ -160,9 +160,9 @@ begin
   inherited SetUp;
   FWholeProgramOptimization:=false;
   FAnalyzerModule:=TPas2JSAnalyzer.Create;
-  FAnalyzerModule.Resolver:=Engine;
+  FAnalyzerModule.Resolver:=ResolverEngine;
   FAnalyzerProgram:=TPas2JSAnalyzer.Create;
-  FAnalyzerProgram.Resolver:=Engine;
+  FAnalyzerProgram.Resolver:=ResolverEngine;
 end;
 
 procedure TCustomTestOptimizations.TearDown;

packages/pastojs/tests/tcpas2jsanalyzer.pas

@@ -0,0 +1,504 @@
+unit TCPas2JSAnalyzer;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, StrUtils, TCModules, PasTree,
+  PScanner, PasResolver, PasUseAnalyzer, PasResolveEval, Pas2jsUseAnalyzer;
+
+type
+
+  { TCustomTestPas2jsAnalyzer }
+
+  TCustomTestPas2jsAnalyzer = class(TCustomTestModule)
+  private
+    FAnalyzer: TPas2JSAnalyzer;
+    FPAMessages: TFPList; // list of TPAMessage
+    FPAGoodMessages: TFPList;
+    FProcAnalyzer: TPas2JSAnalyzer;
+    function GetPAMessages(Index: integer): TPAMessage;
+    procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure ParseModule; override;
+    procedure AnalyzeModule; virtual;
+    procedure AnalyzeProgram; virtual;
+    procedure AnalyzeUnit; virtual;
+    procedure AnalyzeWholeProgram; virtual;
+    procedure CheckUsedMarkers; virtual;
+    procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
+      const MsgText: string); virtual;
+    procedure CheckUseAnalyzerUnexpectedHints; virtual;
+    procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
+    procedure CheckScopeReferences(const ScopeName: string;
+      const RefNames: array of string);
+  public
+    property Analyzer: TPas2JSAnalyzer read FAnalyzer;
+    property ProcAnalyzer: TPas2JSAnalyzer read FProcAnalyzer;
+    function PAMessageCount: integer;
+    property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
+  end;
+
+  { TTestPas2jsAnalyzer }
+
+  TTestPas2jsAnalyzer = class(TCustomTestPas2jsAnalyzer)
+  Published
+    procedure TestM_ProgramLocalVar;
+    procedure TestM_PassRecordToJSValue;
+  end;
+
+
+implementation
+
+{ TTestPas2jsAnalyzer }
+
+procedure TTestPas2jsAnalyzer.TestM_ProgramLocalVar;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#DoIt_used}DoIt;',
+  'var {#l_notused}l: longint;',
+  'begin',
+  'end;',
+  'begin',
+  '  DoIt;',
+  'end.']);
+  AnalyzeProgram;
+end;
+
+procedure TTestPas2jsAnalyzer.TestM_PassRecordToJSValue;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#trec_used}TRec = record',
+  '    {#x_used}x: word;',
+  '  end;',
+  '  {#tbig_used}TBig = record',
+  '    {#r_used}r: TRec;',
+  '  end;',
+  '  {#tnope_used}TNope = record',
+  '    {#a_notused}a: word;',
+  '    {#b_used}b: word;',
+  '  end;',
+  'procedure DoIt(v: JSValue);',
+  'begin',
+  'end;',
+  'var big: TBig;',
+  '  n: TNope;',
+  'begin',
+  '  DoIt(big);',
+  '  DoIt(n.b);',
+  'end.']);
+  AnalyzeProgram;
+end;
+
+{ TCustomTestPas2jsAnalyzer }
+
+function TCustomTestPas2jsAnalyzer.GetPAMessages(Index: integer): TPAMessage;
+begin
+  Result:=TPAMessage(FPAMessages[Index]);
+end;
+
+procedure TCustomTestPas2jsAnalyzer.OnAnalyzerMessage(Sender: TObject;
+  Msg: TPAMessage);
+begin
+  Msg.AddRef;
+  FPAMessages.Add(Msg);
+end;
+
+procedure TCustomTestPas2jsAnalyzer.SetUp;
+begin
+  inherited SetUp;
+  FPAMessages:=TFPList.Create;
+  FPAGoodMessages:=TFPList.Create;
+  FAnalyzer:=TPas2JSAnalyzer.Create;
+  FAnalyzer.Resolver:=ResolverEngine;
+  Analyzer.OnMessage:=@OnAnalyzerMessage;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.TearDown;
+var
+  i: Integer;
+begin
+  FreeAndNil(FPAGoodMessages);
+  for i:=0 to FPAMessages.Count-1 do
+    TPAMessage(FPAMessages[i]).Release;
+  FreeAndNil(FPAMessages);
+  FreeAndNil(FAnalyzer);
+  FreeAndNil(FProcAnalyzer);
+  inherited TearDown;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.ParseModule;
+begin
+  inherited ParseModule;
+  if SkipTests then exit;
+  CheckReferenceDirectives;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.AnalyzeModule;
+begin
+  Analyzer.AnalyzeModule(Module);
+  Analyzer.EmitModuleHints(Module);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.AnalyzeProgram;
+begin
+  ParseProgram;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.AnalyzeUnit;
+begin
+  ParseUnit;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.AnalyzeWholeProgram;
+begin
+  ParseProgram;
+  Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.CheckUsedMarkers;
+type
+  TUsed = (
+    uUsed,
+    uNotUsed,
+    uTypeInfo,
+    uNoTypeinfo
+    );
+var
+  aMarker: PSrcMarker;
+  p: SizeInt;
+  Postfix: String;
+  Elements: TFPList;
+  i: Integer;
+  El, FoundEl: TPasElement;
+  ExpectedUsed: TUsed;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TCustomTestPas2jsAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
+    {$ENDIF}
+    p:=RPos('_',aMarker^.Identifier);
+    if p>1 then
+      begin
+      Postfix:=copy(aMarker^.Identifier,p+1);
+
+      if Postfix='used' then
+        ExpectedUsed:=uUsed
+      else if Postfix='notused' then
+        ExpectedUsed:=uNotUsed
+      else if Postfix='typeinfo' then
+        ExpectedUsed:=uTypeInfo
+      else if Postfix='notypeinfo' then
+        ExpectedUsed:=uNoTypeInfo
+      else
+        RaiseErrorAtSrcMarker('TCustomTestPas2jsAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        FoundEl:=nil;
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          {$IFDEF VerbosePasAnalyzer}
+          writeln('TCustomTestPas2jsAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          {$ENDIF}
+          case ExpectedUsed of
+          uUsed,uNotUsed:
+            if Analyzer.IsUsed(El) then
+              begin
+              FoundEl:=El;
+              break;
+              end;
+          uTypeInfo,uNoTypeinfo:
+            if Analyzer.IsTypeInfoUsed(El) then
+              begin
+              FoundEl:=El;
+              break;
+              end;
+          end;
+          end;
+        if FoundEl<>nil then
+          case ExpectedUsed of
+          uNotUsed:
+            RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
+          uNoTypeinfo:
+            RaiseErrorAtSrcMarker('expected element to have *no* typeinfo, but it is marked',aMarker);
+          end
+        else
+          case ExpectedUsed of
+          uUsed:
+            RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
+          uTypeInfo:
+            RaiseErrorAtSrcMarker('expected element to have typeinfo, but it is not marked',aMarker);
+          end;
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
+  MsgNumber: integer; const MsgText: string);
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: string;
+begin
+  i:=PAMessageCount-1;
+  while i>=0 do
+    begin
+    Msg:=PAMessages[i];
+    if (Msg.MsgNumber=MsgNumber) then
+      begin
+      if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
+        begin
+        FPAGoodMessages.Add(Msg);
+        exit;
+        end;
+      end;
+    dec(i);
+    end;
+  // mismatch
+  writeln('TCustomTestPas2jsAnalyzer.CheckHasHint: ');
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    writeln('  ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
+    end;
+  s:='';
+  str(MsgType,s);
+  Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
+end;
+
+procedure TCustomTestPas2jsAnalyzer.CheckUseAnalyzerUnexpectedHints;
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: String;
+begin
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
+    s:='';
+    str(Msg.MsgType,s);
+    Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
+    end;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.CheckUnitUsed(const aFilename: string;
+  Used: boolean);
+var
+  aResolver: TTestEnginePasResolver;
+  PAEl: TPAElement;
+begin
+  aResolver:=FindModuleWithFilename(aFilename);
+  AssertNotNull('unit not found "'+aFilename+'"',aResolver);
+  AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
+  PAEl:=Analyzer.FindElement(aResolver.Module);
+  if PAEl<>nil then
+    begin
+    // unit is used
+    if not Used then
+      Fail('expected unit "'+aFilename+'" not used, but it is used');
+    end
+  else
+    begin
+    // unit is not used
+    if Used then
+      Fail('expected unit "'+aFilename+'" used, but it is not used');
+    end;
+end;
+
+procedure TCustomTestPas2jsAnalyzer.CheckScopeReferences(
+  const ScopeName: string; const RefNames: array of string);
+type
+  TEntry = record
+    Name: string;
+    Access: TPSRefAccess;
+  end;
+
+var
+  Entries: array of TEntry;
+
+  procedure CheckRefs(ScopeRefs: TPasScopeReferences; const Prefix: string);
+
+    procedure DumpRefsAndFail(Refs: TFPList; const Msg: string);
+    var
+      i: Integer;
+      Ref: TPasScopeReference;
+    begin
+      {$IFDEF VerbosePasAnalyzer}
+      if Refs.Count=0 then
+        writeln('DumpRefsAndFail ',Prefix,' NO REFS');
+      {$ENDIF}
+      for i:=0 to Refs.Count-1 do
+        begin
+        Ref:=TPasScopeReference(Refs[i]);
+        if Ref=nil then break;
+        {$IFDEF VerbosePasAnalyzer}
+        writeln('DumpRefsAndFail ',Prefix,' ',i,' ',GetObjName(Ref.Element),' ',Ref.Access);
+        {$ENDIF}
+        end;
+      Fail(Prefix+': '+Msg);
+    end;
+
+  var
+    Refs: TFPList;
+    j, i: Integer;
+    o: TObject;
+    Ref: TPasScopeReference;
+  begin
+    if ScopeRefs=nil then
+      Refs:=TFPList.Create
+    else
+      Refs:=ScopeRefs.GetList;
+    try
+      // check that Refs only contains TPasProcScopeReference
+      for i:=0 to Refs.Count-1 do
+        begin
+        o:=TObject(Refs[i]);
+        if not (o is TPasScopeReference) then
+          Fail(Prefix+': Refs['+IntToStr(i)+'] '+GetObjName(o));
+        end;
+      // check that all Entries are referenced
+      for i:=0 to length(Entries)-1 do
+        begin
+        j:=Refs.Count-1;
+        while (j>=0)
+            and (CompareText(Entries[i].Name,TPasScopeReference(Refs[j]).Element.Name)<>0) do
+          dec(j);
+        if j<0 then
+          DumpRefsAndFail(Refs,'Missing reference "'+Entries[i].Name+'"');
+        Ref:=TPasScopeReference(Refs[j]);
+        if (Entries[i].Access<>psraNone) and (Ref.Access<>Entries[i].Access) then
+          DumpRefsAndFail(Refs,'Wrong reference access "'+Entries[i].Name+'",'
+            +' expected '+dbgs(Entries[i].Access)+', but got '+dbgs(Ref.Access));
+        end;
+      // check that no other references are in Refs
+      for i:=0 to Refs.Count-1 do
+        begin
+        Ref:=TPasScopeReference(Refs[i]);
+        j:=length(Entries)-1;
+        while (j>=0)
+            and (CompareText(Ref.Element.Name,Entries[j].Name)<>0) do
+          dec(j);
+        if j<0 then
+          DumpRefsAndFail(Refs,'Unneeded reference "'+GetObjName(Ref.Element)+'"');
+        end;
+    finally
+      Refs.Free;
+    end;
+  end;
+
+  function FindProc(Section: TPasSection): boolean;
+  var
+    i: Integer;
+    El: TPasElement;
+    Proc: TPasProcedure;
+    Scope: TPasProcedureScope;
+  begin
+    for i:=0 to Section.Declarations.Count-1 do
+      begin
+      El:=TPasElement(Section.Declarations[i]);
+      if CompareText(El.Name,ScopeName)<>0 then continue;
+      if not (El is TPasProcedure) then
+        Fail('El is not proc '+GetObjName(El));
+      Proc:=TPasProcedure(El);
+      Scope:=Proc.CustomData as TPasProcedureScope;
+      if Scope.DeclarationProc<>nil then continue;
+
+      // check references created by AnalyzeModule
+      CheckRefs(Scope.References,'AnalyzeModule');
+
+      exit(true);
+      end;
+    Result:=false;
+  end;
+
+  procedure CheckInitialFinalization(El: TPasImplBlock);
+  var
+    Scope: TPasInitialFinalizationScope;
+  begin
+    Scope:=El.CustomData as TPasInitialFinalizationScope;
+    CheckRefs(Scope.References,'AnalyzeModule');
+  end;
+
+var
+  i: Integer;
+begin
+  Entries:=nil;
+  SetLength(Entries,High(RefNames)-low(RefNames)+1);
+  for i:=low(RefNames) to high(RefNames) do
+    begin
+    Entries[i].Name:=RefNames[i];
+    Entries[i].Access:=psraNone;
+    end;
+
+  if Module is TPasProgram then
+    begin
+    if CompareText(ScopeName,'begin')=0 then
+      begin
+      // check begin-block references created by AnalyzeModule
+      CheckInitialFinalization(Module.InitializationSection);
+      exit;
+      end
+    else if FindProc(TPasProgram(Module).ProgramSection) then
+      exit;
+    end
+  else if Module is TPasLibrary then
+    begin
+    if CompareText(ScopeName,'begin')=0 then
+      begin
+      // check begin-block references created by AnalyzeModule
+      CheckInitialFinalization(Module.InitializationSection);
+      exit;
+      end
+    else if FindProc(TPasLibrary(Module).LibrarySection) then
+      exit;
+    end
+  else if Module.ClassType=TPasModule then
+    begin
+    if CompareText(ScopeName,'initialization')=0 then
+      begin
+      // check initialization references created by AnalyzeModule
+      CheckInitialFinalization(Module.InitializationSection);
+      exit;
+      end
+    else if CompareText(ScopeName,'finalization')=0 then
+      begin
+      // check finalization references created by AnalyzeModule
+      CheckInitialFinalization(Module.FinalizationSection);
+      exit;
+      end
+    else if FindProc(Module.InterfaceSection) then
+      exit
+    else if FindProc(Module.ImplementationSection) then
+      exit;
+    end;
+  Fail('missing proc '+ScopeName);
+end;
+
+function TCustomTestPas2jsAnalyzer.PAMessageCount: integer;
+begin
+  Result:=FPAMessages.Count;
+end;
+
+Initialization
+  RegisterTests([TTestPas2jsAnalyzer]);
+end.
+

packages/pastojs/tests/tcsrcmap.pas

@@ -180,7 +180,7 @@ begin
   // collect markers in Pascal
   PasSrc:=TStringList.Create;
   try
-    PasSrc.Text:=Engine.Source;
+    PasSrc.Text:=ResolverEngine.Source;
     for i:=1 to PasSrc.Count do
       begin
       Line:=PasSrc[i-1];

packages/pastojs/tests/tcunitsearch.pas

@@ -137,6 +137,7 @@ type
   TTestCLI_UnitSearch = class(TCustomTestCLI)
   protected
     procedure CheckLinklibProgramSrc(Msg,Header: string);
+    procedure CheckFullSource(Msg, Filename, ExpectedSrc: string);
   published
     procedure TestUS_CreateRelativePath;
 
@@ -146,6 +147,7 @@ type
     procedure TestUS_Program_FU;
     procedure TestUS_Program_FU_o;
     procedure TestUS_Program_FE_o;
+    procedure TestUS_PlatformModule_Program;
 
     // include files
     procedure TestUS_IncludeSameDir;
@@ -625,6 +627,8 @@ var
   aFile: TCLIFile;
 begin
   aFile:=FindFile('test1.js');
+  if aFile=nil then
+    Fail(Msg+' file not found test1.js');
   CheckDiff(Msg,
     LinesToStr([
     #$EF#$BB#$BF+Header,
@@ -640,6 +644,17 @@ begin
     aFile.Source);
 end;
 
+procedure TTestCLI_UnitSearch.CheckFullSource(Msg, Filename, ExpectedSrc: string
+  );
+var
+  aFile: TCLIFile;
+begin
+  aFile:=FindFile(Filename);
+  if aFile=nil then
+    Fail(Msg+' file not found "'+Filename+'"');
+  CheckDiff(Msg,ExpectedSrc,aFile.Source);
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_CreateRelativePath;
 
   procedure DoTest(Filename, BaseDirectory, Expected: string;
@@ -748,6 +763,25 @@ begin
   AssertNotNull('foo.js not found',FindFile('foo.js'));
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_PlatformModule_Program;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  Compile(['-Tmodule','-va','test1.pas']);
+  CheckFullSource('TestUS_PlatformModule_Library','test1.js',
+    LinesToStr([
+    #$EF#$BB#$BF+'rtl.module("program",["system"],function () {',
+    '  "use strict";',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '  };',
+    '});',
+    'rtl.run();',
+    '']));
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_IncludeSameDir;
 begin
   AddUnit('system.pp',[''],['']);

packages/pastojs/tests/testpas2js.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="13">
+    <Units Count="15">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -101,6 +101,16 @@
         <Filename Value="tcconverter.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit12>
+      <Unit13>
+        <Filename Value="tcpas2jsanalyzer.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCPas2JSAnalyzer"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="../../fcl-passrc/tests/testpasutils.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestPasUtils"/>
+      </Unit14>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -110,7 +120,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-json/src;../../fcl-passrc/src;../../pastojs/tests"/>
+      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-json/src;../../fcl-passrc/src;../../pastojs/tests;../../fcl-passrc/tests"/>
       <UnitOutputDirectory Value="lib"/>
     </SearchPaths>
     <CodeGeneration>

packages/pastojs/tests/testpas2js.pp

@@ -22,7 +22,8 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, TCModules, TCSrcMap,
-  TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile;
+  TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile, 
+  TCPas2JSAnalyzer, TestPasUtils;
 
 type
 

packages/paszlib/examples/testgzstream.pp

@@ -0,0 +1,41 @@
+program example;
+
+uses
+  SysUtils, ZStream, Classes;
+
+procedure TestGZip;
+var
+  SS: TStringStream;
+  CS: TGZipCompressionStream;
+  FS: TFileStream;
+begin
+  SS := TStringStream.Create('hello, hello!');
+  FS := TFileStream.Create(GetTempDir+'test.gz', fmCreate);
+  CS := TGZipCompressionStream.Create(FS);
+  CS.CopyFrom(SS, 0);
+  CS.Free;
+  FS.Free;
+  SS.Free;
+end;
+
+procedure TestGUnzip;
+var
+  FS: TFileStream;
+  DS: TGZipDecompressionStream;
+  SS: TStringStream;
+begin
+  FS := TFileStream.Create(GetTempDir+'test.gz', fmOpenRead);
+  DS := TGZipDecompressionStream.Create(FS);
+  SS := TStringStream.Create('');
+  SS.CopyFrom(DS, 0);
+  DS.Free;
+  FS.Free;
+  WriteLn(SS.DataString);
+  SS.Free;
+end;
+
+begin
+  TestGZip;
+  TestGUnZip;
+end. 
+

packages/paszlib/src/zstream.pp

@@ -19,6 +19,8 @@ unit ZStream;
 
  **********************************************************************}
 
+{ GZip specs: https://datatracker.ietf.org/doc/html/rfc1952 }
+
 {$mode objfpc}
 
 {***************************************************************************}
@@ -97,6 +99,38 @@ type
           destructor destroy;override;
         end;
 
+        TGZipCompressionStream = class(TStream)
+        private
+          FLevel: TCompressionLevel;
+          FCrc32Val: Longword;
+          FUncompressedSize: Cardinal;
+          FDest: TStream;
+          FCompressionStream: TCompressionStream;
+          procedure WriteHeader;
+          procedure WriteFooter;
+        public
+          constructor Create(ADest: TStream); overload;
+          constructor Create(ALevel: TCompressionLevel; ADest: TStream); overload;
+          destructor Destroy; override;
+          function Write(const Buffer; Count: Longint): Longint; override;
+        end;
+
+        TGZipDecompressionStream = class(TStream)
+        private
+          FCrc32Val: Longword;
+          FUncompressedSize: Cardinal;
+          FSource: TStream;
+          FDecompressionStream: TDecompressionStream;
+          procedure Assert(ACond: Boolean; AMsg: string = '');
+          procedure ReadHeader;
+          procedure ReadFooter;
+        public
+          constructor Create(ASource: TStream);
+          destructor Destroy; override;
+          function Read(var Buffer; Count: Longint): Longint; override;
+          function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
+        end;
+
         Ezliberror=class(Estreamerror)
         end;
 
@@ -117,12 +151,66 @@ uses    zdeflate,zinflate;
 
 const   bufsize=16384;     {Size of the buffer used for temporarily storing
                             data from the child stream.}
+  Crc_32_Tab : Array[0..255] of LongWord = (
+    $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
+    $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
+    $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
+    $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
+    $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
+    $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
+    $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
+    $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
+    $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
+    $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
+    $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
+    $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
+    $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
+    $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
+    $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
+    $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
+    $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
+    $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
+    $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
+    $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
+    $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
+    $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
+    $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
+    $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
+    $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
+    $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
+    $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
+    $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
+    $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
+    $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
+    $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
+    $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
+  );
 
 resourcestring Sgz_open_error='Could not open gzip compressed file %s.';
                Sgz_read_only='Gzip compressed file was opened for reading.';
                Sgz_write_only='Gzip compressed file was opened for writing.';
+               Sgz_invalid_header='Invalid GZip header';
+               Sgz_invalid_algorithm='Invalid compression algorithm';
+               Sgz_invalid_crc32='Invalid crc32 checksum';
+               Sgz_invalid_output_size='Invalid output size';
                Sseek_failed='Seek in deflate compressed stream failed.';
 
+function UpdateCrc32(Crc: Longword; const Buffer; Count: Longint): Longword;
+var
+ PBuf: PByte;
+ i: Longint;
+begin
+ PBuf := @Buffer;
+
+ Result := Crc xor $FFFFFFFF;
+ for i := 1 to Count do
+ begin
+   Result := Crc_32_Tab[(Result xor PBuf^) and $ff] xor (Result shr 8);
+   Inc(PBuf);
+ end;
+ Result := Result xor $FFFFFFFF;
+end;
+
 constructor Tcustomzlibstream.create(stream:Tstream);
 
 begin
@@ -413,4 +501,175 @@ begin
   inherited destroy;
 end;
 
+{ TGZipCompressionStream }
+
+constructor TGZipCompressionStream.Create(ADest: TStream);
+begin
+  Create(clDefault, ADest);
+end;
+
+constructor TGZipCompressionStream.Create(ALevel: TCompressionLevel; ADest: TStream);
+begin
+  inherited Create;
+  FLevel := ALevel;
+  FCrc32Val := 0;
+  FUncompressedSize := 0;
+  FDest := ADest;
+  WriteHeader;
+  FCompressionStream := TCompressionStream.Create(FLevel, FDest, True);
+end;
+
+destructor TGZipCompressionStream.Destroy;
+begin
+  FCompressionStream.Flush;
+  FCompressionStream.Free;
+  WriteFooter;
+  inherited;
+end;
+
+procedure TGZipCompressionStream.WriteHeader;
+begin
+  FDest.WriteByte($1f);  // signature 1 of 2
+  FDest.WriteByte($8b);  // signature 2 of 2
+  FDest.WriteByte($08);  // deflate algorithm
+  FDest.WriteByte($00);  // no flags
+  FDest.WriteDWord($00); // modification time unknown. Source is stream, not a file
+  if FLevel = clmax then // XFL = extra flags = compression level
+    FDest.WriteByte($02)
+  else if FLevel = clfastest then
+    FDest.WriteByte($04)
+  else
+    FDest.WriteByte($00);
+  FDest.WriteByte($ff);  // OS file system unknown. Source is stream, not a file
+end;
+
+procedure TGZipCompressionStream.WriteFooter;
+var
+  i: Integer;
+begin
+  // write crc32 in 4 bytes, least significant byte first
+  for i := 1 to 4 do
+  begin
+    FDest.WriteByte(FCrc32Val and $ff);
+    FCrc32Val := FCrc32Val shr 8;
+  end;
+
+  // write uncompressed size in 4 bytes, least significant byte first
+  for i := 1 to 4 do
+  begin
+    FDest.WriteByte(FUncompressedSize and $ff);
+    FUncompressedSize := FUncompressedSize shr 8;
+  end;
+end;
+
+function TGZipCompressionStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  FCrc32Val := UpdateCrc32(FCrc32Val, Buffer, Count);
+  Inc(FUncompressedSize, Count);
+  Result := FCompressionStream.Write(Buffer, Count);
+end;
+
+{ TGZipDecompressionStream }
+
+constructor TGZipDecompressionStream.Create(ASource: TStream);
+begin
+  inherited Create;
+  FSource := ASource;
+  FCrc32Val := 0;
+  FUncompressedSize := 0;
+  ReadHeader;
+  FDecompressionStream := TDecompressionStream.Create(FSource, True);
+end;
+
+destructor TGZipDecompressionStream.Destroy;
+begin
+  FDecompressionStream.Free;
+  inherited;
+end;
+
+procedure TGZipDecompressionStream.Assert(ACond: Boolean; AMsg: string = '');
+begin
+  if not ACond then
+    raise EDecompressionError.Create(AMsg);
+end;
+
+procedure TGZipDecompressionStream.ReadHeader;
+var
+  Flags: Byte;
+  XLEN: Cardinal;
+begin
+  Assert(FSource.ReadByte = $1f, Sgz_invalid_header);
+  Assert(FSource.ReadByte = $8b, Sgz_invalid_header);
+  Assert(FSource.ReadByte = $08, Sgz_invalid_algorithm);
+  Flags := FSource.ReadByte;
+  FSource.ReadDWord; // skip modification time. Dest is stream, not a file
+  FSource.ReadByte;  // skip compression level, is not needed
+  FSource.ReadByte;  // skip OS file system. Dest is stream, not a file
+
+  if (Flags and $4) <> 0 then // FLG.FEXTRA
+  begin
+    XLEN := FSource.ReadByte + FSource.ReadByte shl 8; // least significant byte first
+    while XLEN > 0 do
+    begin
+      FSource.ReadByte;
+      Dec(XLEN);
+    end;
+  end;
+
+  if (Flags and $8) <> 0 then // FLG.FNAME
+  begin
+    repeat
+    until FSource.ReadByte = 0; // zero-terminated file name
+  end;
+
+  if (Flags and $10) <> 0 then // FLG.FCOMMENT
+  begin
+    repeat
+    until FSource.ReadByte = 0; // zero-terminated file comment
+  end;
+
+  if (Flags and $2) <> 0 then // FLG.FHCRC
+    FSource.ReadWord; // skip CRC16, check not implemented
+end;
+
+procedure TGZipDecompressionStream.ReadFooter;
+var
+  Crc32: Longword;
+  OrigSize: Longword;
+begin
+  // The TDecompressionStream reads in buffers, so the footer
+  // may already be skipped. Therefore, we need to Seek to the footer.
+  // If FSource is non-seekable, we skip checking Crc32 and OrigSize.
+  try
+    FSource.Seek(-8, soEnd);
+  except
+    Exit;  // skip Crc32 and OrigSize checking
+  end;
+
+  Crc32 := FSource.ReadByte + FSource.ReadByte shl 8 + FSource.ReadByte shl 16 + FSource.ReadByte shl 24;
+  Assert(FCrc32Val = Crc32, Sgz_invalid_crc32);
+  OrigSize := FSource.ReadByte + FSource.ReadByte shl 8 + FSource.ReadByte shl 16 + FSource.ReadByte shl 24;
+  Assert(FUncompressedSize = OrigSize, Sgz_invalid_output_size);
+end;
+
+function TGZipDecompressionStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  Result := FDecompressionStream.Read(Buffer, Count);
+  Inc(FUncompressedSize, Result);
+  FCrc32Val := UpdateCrc32(FCrc32Val, Buffer, Result);
+
+  if Result < Count then
+    ReadFooter;
+end;
+
+function TGZipDecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+begin
+  // accept Seek(0, soBeginning) if nothing read yet
+  // this is needed for the TStream.CopyFrom() method
+  if (Offset = 0) and (Origin = TSeekOrigin.soBeginning) and (FUncompressedSize = 0) then
+    Result := 0
+  else
+    Result := inherited Seek(Offset, Origin);
+end;
+
 end.

packages/rtl-extra/fpmake.pp

@@ -19,7 +19,7 @@ Const
   IPCBSDs       = [FreeBSD,NetBSD,OpenBSD,DragonFly];
 //  IPCcdeclOSes  = [Darwin,iphonesim,ios];
 
-  PrinterOSes   = [go32v2,msdos,os2,win32,win64]+unixlikes-[beos,haiku,morphos];
+  PrinterOSes   = [go32v2,msdos,os2,win32,win64,atari]+unixlikes-[beos,haiku,morphos];
   SerialOSes    = [android,linux,netbsd,openbsd,win32,win64];
   UComplexOSes  = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,wince,win32,win64,freertos,wasi]+UnixLikes+AllAmigaLikeOSes;
   MatrixOSes    = [atari,embedded,emx,gba,go32v2,msdos,nativent,nds,netware,netwlibc,os2,sinclairql,symbian,watcom,wii,win32,win64,wince,freertos,wasi]+UnixLikes+AllAmigaLikeOSes;

packages/rtl-extra/src/atari/printer.pp

@@ -0,0 +1,29 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Printer unit for BP7/PurePascal compatible RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+interface
+
+{$I printerh.inc}
+
+implementation
+
+{$I printer.inc}
+
+begin
+  (* WARNING: has to be checked; do_open('PRN') returns a valid, negative OS handle *)
+  InitPrinter ('PRN:');
+  SetPrinterExit;
+end.

packages/tosunits/fpmake.pp

@@ -34,6 +34,9 @@ begin
     T:=P.Targets.AddUnit('tos.pas');
     T:=P.Targets.AddUnit('vdi.pas');
     T:=P.Targets.AddUnit('aes.pas');
+    T:=P.Targets.AddUnit('gem.pas');
+    T:=P.Targets.AddUnit('gemcommon.pas');
+    T:=P.Targets.AddUnit('nf_ops.pas');
 
     P.ExamplePath.Add('examples');
     T:=P.Targets.AddExampleProgram('higem.pas');

packages/tosunits/src/aestypes.inc

@@ -0,0 +1,800 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 Thorsten Otto
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+  PAESContrl = ^TAESContrl;
+  TAESContrl = record
+    opcode: SmallInt;
+    case boolean of
+      true: (
+        nums: array[0..3] of SmallInt; );
+      false: (
+        num_intin: SmallInt;
+        num_intout: SmallInt;
+        num_addrin: SmallInt;
+        num_addrout: SmallInt; );
+  end;
+
+  PAESGlobal = ^TAESGlobal;
+  TAESGlobal = array[0..14] of SmallInt;
+
+  PAESIntIn = ^TAESIntIn;
+  TAESIntIn = array[0..15] of SmallInt;
+
+  PAESIntOut = ^TAESIntOut;
+  TAESIntOut = array[0..9] of SmallInt;
+
+  PAESAddrIn = ^TAESAddrIn;
+  TAESAddrIn = array[0..7] of Pointer;
+
+  PAESAddrOut = ^TAESAddrOut;
+  TAESAddrOut = array[0..1] of Pointer;
+
+type
+  PAESPB = ^TAESPB;
+  TAESPB = record
+    control: PAESContrl;
+    global: PAESGlobal;
+    intin: PAESIntIn;
+    intout: PAESIntOut;
+    addrin: PAESAddrIn;
+    addrout: PAESAddrOut;
+  end;
+
+const
+  AES_TRAP_MAGIC = $C8;
+
+{ object flags }
+const
+    NONE            = 0;
+    SELECTABLE      = 1;
+    DEFAULT         = 2;
+    F_EXIT          = 4;
+    EDITABLE        = 8;
+    RBUTTON         = 16;
+    LASTOB          = 32;
+    TOUCHEXIT       = 64;
+    HIDETREE        = 128;
+    INDIRECT        = 256;
+    FL3DMASK        = $0600;
+    FL3DNONE        = $0000;
+    FL3DIND         = $0200;
+    FL3DBAK         = $0400;
+    FL3DACT         = $0600;
+    SUBMENU         = $0800;         {* falcon aes hierarchical menus *}
+
+{ object state }
+const
+    NORMAL          = $0000;
+    SELECTED        = $0001;
+    CROSSED         = $0002;
+    CHECKED         = $0004;
+    DISABLED        = $0008;
+    OUTLINED        = $0010;
+    SHADOWED        = $0020;
+    WHITEBAK        = $0040;
+    DRAW3D          = $0080;
+
+{ AES object types }
+const
+    G_BOX           = 20;
+    G_TEXT          = 21;
+    G_BOXTEXT       = 22;
+    G_IMAGE         = 23;
+    G_USERDEF       = 24;
+    G_IBOX          = 25;
+    G_BUTTON        = 26;
+    G_BOXCHAR       = 27;
+    G_STRING        = 28;
+    G_FTEXT         = 29;
+    G_FBOXTEXT      = 30;
+    G_ICON          = 31;
+    G_TITLE         = 32;
+    G_CICON         = 33;
+    G_SWBUTTON      = 34;
+    G_POPUP         = 35;
+    G_WINTITLE      = 36;
+    G_EDIT          = 37;
+    G_SHORTCUT      = 38;
+    G_SLIST         = 39;
+    G_EXTBOX        = 40;
+    G_OBLINK        = 41;
+
+
+type
+    PTEDINFO = ^TTEDINFO;
+    TTEDINFO = record
+        te_ptext        : Pchar;
+        te_ptmplt       : Pchar;
+        te_pvalid       : Pchar;
+        te_font         : smallint;
+        te_resvd1       : smallint;
+        te_just         : smallint;
+        te_color        : smallint;
+        te_resvd2       : smallint;
+        te_thickness    : smallint;
+        te_txtlen       : smallint;
+        te_tmplen       : smallint;
+    end;
+
+    PICONBLK = ^TICONBLK;
+    TICONBLK = record
+        ib_pmask        : Pointer;
+        ib_pdata        : Pointer;
+        ib_ptext        : Pchar;
+        ib_char         : smallint;
+        ib_xchar        : smallint;
+        ib_ychar        : smallint;
+        ib_xicon        : smallint;
+        ib_yicon        : smallint;
+        ib_wicon        : smallint;
+        ib_hicon        : smallint;
+        ib_xtext        : smallint;
+        ib_ytext        : smallint;
+        ib_wtext        : smallint;
+        ib_htext        : smallint;
+    end;
+
+    PCICON = ^TCICON;
+    TCICON = record
+        num_planes      : smallint;
+        col_data        : Pointer;
+        col_mask        : Pointer;
+        sel_data        : Pointer;
+        sel_mask        : Pointer;
+        next_res        : PCICON;
+    end;
+
+    PCICONBLK = ^TCICONBLK;
+    TCICONBLK = record
+        monoblk         : TICONBLK;
+        mainlist        : PCICON;
+    end;
+
+    PBITBLK = ^TBITBLK;
+    TBITBLK = record
+        bi_pdata        : Pointer;
+        bi_wb           : smallint;
+        bi_hl           : smallint;
+        bi_x            : smallint;
+        bi_y            : smallint;
+        bi_color        : smallint;
+    end;
+
+    PUSERBLK = ^TUSERBLK;
+    TUSERBLK = record
+        ub_code         : Pointer;
+        ub_parm         : LongInt;
+    end;
+
+    POBSPEC = ^TOBSPEC;
+    TOBSPEC = record
+        case smallint of
+            0,
+            G_BOX,
+            G_IBOX,
+            G_BOXCHAR:  ( index:        LongInt     );
+            G_BOXTEXT,
+            G_TEXT,
+            G_FTEXT,
+            G_FBOXTEXT: ( ted_info:     PTEDINFO    );
+            G_IMAGE:    ( bit_blk:      PBITBLK );
+            G_USERDEF:  ( user_blk:     PUSERBLK    );
+            G_BUTTON,
+            G_STRING,
+            G_TITLE:    ( free_string:  Pchar       );
+            G_ICON:     ( icon_blk:     PICONBLK    );
+            G_CICON:    ( cicon_blk:    PCICONBLK   );
+
+            INDIRECT:   ( ob_spec:      POBSPEC );
+    end;
+
+type
+  PAESOBJECT = ^TAESOBJECT;
+  TAESOBJECT = record
+    ob_next: smallint;   {* The next object               *}
+    ob_head: smallint;   {* First child                   *}
+    ob_tail: smallint;   {* Last child                    *}
+    ob_type: word;       {* Object type                   *}
+    ob_flags: word;      {* Manipulation flags            *}
+    ob_state: word;      {* Object status                 *}
+    ob_spec: TOBSPEC;    {* More under object type        *}
+    ob_x: smallint;      {* X-coordinate of the object    *}
+    ob_y: smallint;      {* Y-coordinate of the object    *}
+    ob_width: smallint;  {* Width of the object           *}
+    ob_height: smallint; {* Height of the object          *}
+  end;
+
+    PAESTree = ^TAESTree;
+    TAESTree = Array[0..2339] of TAESOBJECT;
+
+    PPARMBLK = ^TPARMBLK;
+    TPARMBLK = record
+        pb_tree         : PAESTree;
+        pb_obj          : smallint;
+        pr_prevstate    : smallint; {* maybe bug in PP; should be pb_prevstate *}
+        pr_currstate    : smallint; {* maybe bug in PP; should be pb_currstate *}
+        pb_x            : smallint;
+        pb_y            : smallint;
+        pb_w            : smallint;
+        pb_h            : smallint;
+        pb_xc           : smallint;
+        pb_yc           : smallint;
+        pb_wc           : smallint;
+        pb_hc           : smallint;
+        pb_parm         : LongInt;
+    end;
+
+    PRSHDR = ^TRSHDR;
+    TRSHDR = record
+        rsh_vrsn:       Word;
+        rsh_object:     Word;
+        rsh_tedinfo:    Word;
+        rsh_iconblk:    Word;
+        rsh_bitblk:     Word;
+        rsh_frstr:      Word;
+        rsh_string:     Word;
+        rsh_imdata:     Word;
+        rsh_frimg:      Word;
+        rsh_trindex:    Word;
+        rsh_nobs:       Word;
+        rsh_ntree:      Word;
+        rsh_nted:       Word;
+        rsh_nib:        Word;
+        rsh_nbb:        Word;
+        rsh_nstring:    Word;
+        rsh_nimages:    Word;
+        rsh_rssize:     Word;
+    end;
+
+type
+    PEVENT = ^TEVENT;
+    TEVENT = record
+        ev_mflags:      smallint;        { input parameters }
+        ev_mbclicks:    smallint;
+        ev_bmask:       smallint;
+        ev_mbstate:     smallint;
+        ev_mm1flags:    smallint;
+        ev_mm1x:        smallint;
+        ev_mm1y:        smallint;
+        ev_mm1width:    smallint;
+        ev_mm1height:   smallint;
+        ev_mm2flags:    smallint;
+        ev_mm2x:        smallint;
+        ev_mm2y:        smallint;
+        ev_mm2width:    smallint;
+        ev_mm2height:   smallint;
+        ev_mtlocount:   smallint;
+        ev_mthicount:   smallint;
+        ev_mwich:       smallint;       { output parameters }
+        ev_mmox:        smallint;
+        ev_mmoy:        smallint;
+        ev_mmobutton:   smallint;
+        ev_mmokstate:   smallint;
+        ev_mkreturn:    smallint;
+        ev_mbreturn:    smallint;
+        ev_mmgpbuf:     ARRAY_8;
+    end;
+
+type
+  PGRECT = ^TGRECT;
+  TGRECT = record
+    case integer of 
+     0: (x: smallint;     {* X-coordinate *}
+         y: smallint;     {* Y-coordinate *}
+         w: smallint;     {* Width        *}
+         h: smallint);    {* Height       *}
+     1: (g_x: smallint;   {* X-coordinate *}
+         g_y: smallint;   {* Y-coordinate *}
+         g_w: smallint;   {* Width        *}
+         g_h: smallint);  {* Height       *}
+  end;
+
+{ kinds, as used by wind_create() }
+const
+  NAME    = $01;   { Window has a title bar. }
+  CLOSER  = $02;   { Window has a close box. }
+  FULLER  = $04;   { Window has a fuller box. }
+  MOVER   = $08;   { Window may be moved by the user. }
+  INFO    = $10;   { Window has an information line. }
+  SIZER   = $20;   { Window has a sizer box. }
+  UPARROW = $40;   { Window has an up arrow. }
+  DNARROW = $80;   { Window has a down arrow. }
+  VSLIDE  = $100;  { Window has a vertical slider. }
+  LFARROW = $200;  { Window has a left arrow. }
+  RTARROW = $400;  { Window has a right arrow. }
+  HSLIDE  = $800;  { Window has a horizontal slider. }
+  MENUBAR = $1000; { Window has a menu bar (XaAES) }
+  SMALLER = $4000; { Window has an iconifier. }
+  ICONIFIER = SMALLER;
+  BORDER  = $8000; { Window has an sizeing border }
+
+{ messages as used by evnt_mesag() }
+const
+  MN_SELECTED   = 10;
+  WM_REDRAW     = 20;
+  WM_TOPPED     = 21;
+  WM_CLOSED     = 22;
+  WM_FULLED     = 23;
+  WM_ARROWED    = 24;
+  WM_HSLID      = 25;
+  WM_VSLID      = 26;
+  WM_SIZED      = 27;
+  WM_MOVED      = 28;
+  WM_NEWTOP     = 29;
+  WM_UNTOPPED   = 30;
+  WM_ONTOP      = 31;
+  WM_OFFTOP     = 32;
+  WM_BOTTOMED   = 33;
+  WM_ICONIFY    = 34;
+  WM_UNICONIFY  = 35;
+  WM_ALLICONIFY = 36;
+  WM_TOOLBAR    = 37;
+  AC_OPEN       = 40;
+  AC_CLOSE      = 41;
+  CT_UPDATE     = 50;
+  CT_MOVE       = 51;
+  CT_NEWTOP     = 52;
+  AP_TERM       = 50;
+  AP_TFAIL      = 51;
+  AP_RESCHG     = 57;
+  SHUT_COMPLETED = 60;
+  RESCHG_COMPLETED = 61;
+  AP_DRAGDROP   = 63;
+  SH_EXIT       = 68;          {* AES 4.0 *}
+  SH_START      = 69;          {* AES 4.0 *}
+  SH_WDRAW      = 72;          {* AES 4.0 *}
+  SC_CHANGED    = 80;
+  PRN_CHANGED   = 82;          {* NVDI *}
+  FNT_CHANGED   = 83;          {* NVDI *}
+  COLORS_CHANGED = 84;         {* NVDI *}
+  THR_EXIT      = 88;          {* MagiC 4.5 *}
+  PA_EXIT       = 89;          {* MagiC 3 *}
+  CH_EXIT       = 90;
+  WM_WHEEL      = 345;         {* XaAES *}
+  WM_MOUSEWHEEL = 2352;
+  WM_SHADED     = 22360;       {* WiNX *}
+  WM_UNSHADED   = 22361;       {* WinX *}
+
+    WA_UPPAGE       = 0;
+    WA_DNPAGE       = 1;
+    WA_UPLINE       = 2;
+    WA_DNLINE       = 3;
+    WA_LFPAGE       = 4;
+    WA_RTPAGE       = 5;
+    WA_LFLINE       = 6;
+    WA_RTLINE       = 7;
+    WA_WHEEL        = 8;
+
+{* AP_DRAGDROP return codes *}
+const
+    DD_OK        = 0;
+    DD_NAK       = 1;
+    DD_EXT       = 2;
+    DD_LEN       = 3;
+    DD_TRASH     = 4;
+    DD_PRINTER   = 5;
+    DD_CLIPBOARD = 6;
+
+    DD_TIMEOUT  = 4000;     {* Timeout in ms *}
+
+    DD_NUMEXTS  = 8;        {* Number of formats *}
+    DD_EXTLEN   = 4;
+    DD_EXTSIZE  = DD_NUMEXTS * DD_EXTLEN;
+
+    DD_FNAME    = 'U:\\PIPE\\DRAGDROP.AA';
+    DD_NAMEMAX  = 128;      {* Maximum length of a format name *}
+    DD_HDRMIN   = 9;            {* Minimum length of Drag&Drop headers *}
+    DD_HDRMAX   = 8 + DD_NAMEMAX;   {* Maximum length *}
+
+{ message flags as used by evnt_multi() }
+const
+  MU_KEYBD  = $0001; { Keyboard event }
+  MU_BUTTON = $0002; { Button event   }
+  MU_M1     = $0004; { Mouse event 1  }
+  MU_M2     = $0008; { Mouse event 2  }
+  MU_MESAG  = $0010; { Messages       }
+  MU_TIMER  = $0020; { Timer events   }
+  MU_WHEEL         = $0040;      {* AES 4.09 & XaAES *}
+  MU_MX            = $0080;      {* XaAES *}
+  MU_NORM_KEYBD    = $0100;      {*   "   *}
+  MU_DYNAMIC_KEYBD = $0200;      {* keybd as a bunch of buttons, includes release of key *}
+
+{ window update flags as used by wind_update() }
+const
+  END_UPDATE = (0);  { Screen redraw is compete and the flag set by BEG_UPDATE is reset }
+  BEG_UPDATE = (1);  { Screen redraw starts, rectangle lists are frozen, flag is set to prevent any other processes updating the screen }
+  END_MCTRL  = (2);  { Application releases control of the mouse to the AES and resumes mouse click message reactions }
+  BEG_MCTRL  = (3);  { The application wants to have sole control over mouse button messages }
+  BEG_CHECK  = $100;
+
+{ window flags as used by wind_set()/wind_get() }
+const
+  WF_KIND      = (1);
+  WF_NAME      = (2);
+  WF_INFO      = (3);
+  WF_WORKXYWH  = (4);
+  WF_CURRXYWH  = (5);
+  WF_PREVXYWH  = (6);
+  WF_FULLXYWH  = (7);
+  WF_HSLIDE    = (8);
+  WF_VSLIDE    = (9);
+  WF_TOP       = (10);
+  WF_FIRSTXYWH = (11);
+  WF_NEXTXYWH  = (12);
+  WF_NEWDESK   = (14);
+  WF_HSLSIZE   = (15);
+  WF_VSLSIZE   = (16);
+  WF_SCREEN    = (17);
+  WF_COLOR     = 18;
+  WF_TATTRB    = 18;
+  WF_DCOLOR    = 19;
+  WF_SIZTOP    = 19;
+  WF_OWNER     = 20;
+  WF_BEVENT    = 24;
+  WF_BOTTOM    = 25;
+  WF_ICONIFY   = 26;
+  WF_UNICONIFY = 27;
+  WF_UNICONIFYXYWH = 28;
+  WF_TOOLBAR   = (30);
+  WF_FTOOLBAR  = 31;
+  WF_NTOOLBAR  = 32;
+  WF_MENU      = 33;
+  WF_WIDGET    = 34;
+  WF_WHEEL     = 40;
+  WF_OPTS      = 41;
+  WF_TOPMOST   = 232;             {* XaAES, MyAES *}
+  WF_WINX      = $5758;
+  WF_WINXCFG   = $5759;
+  WF_DDELAY    = $575a;
+  WF_SHADE     = $575d;
+  WF_STACK     = $575e;
+  WF_TOPALL    = $575f;
+  WF_BOTTOMALL = $5760;
+  WF_XAAES     = $5841;
+
+{ window calculation types as used by wind_calc() }
+const
+  WC_BORDER = 0;
+  WC_WORK   = 1;
+
+{ WF_DCOLOR objects }
+const
+    W_BOX           = 0;
+    W_TITLE         = 1;
+    W_CLOSER        = 2;
+    W_NAME          = 3;
+    W_FULLER        = 4;
+    W_INFO          = 5;
+    W_DATA          = 6;
+    W_WORK          = 7;
+    W_SIZER         = 8;
+    W_VBAR          = 9;
+    W_UPARROW       = 10;
+    W_DNARROW       = 11;
+    W_VSLIDE        = 12;
+    W_VELEV         = 13;
+    W_HBAR          = 14;
+    W_LFARROW       = 15;
+    W_RTARROW       = 16;
+    W_HSLIDE        = 17;
+    W_HELEV         = 18;
+    W_SMALLER       = 19;
+    W_BOTTOMER      = 20;
+    W_HIDER         = 30;
+
+{* wind_set(WF_BEVENT) *}
+    BEVENT_WORK     = $0001;          {* AES 4.0  *}
+    BEVENT_INFO     = $0002;          {* MagiC 6  *}
+
+{* wind_set(WF_OPTS) bitmask flags *}
+    WO0_WHEEL       = $0001;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO0_FULLREDRAW  = $0002;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO0_NOBLITW     = $0004;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO0_NOBLITH     = $0008;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO0_SENDREPOS   = $0010;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO1_NONE        = $0000;  {* see mt_wind_set() with #WF_OPTS mode *}
+    WO2_NONE        = $0000;  {* see mt_wind_set() with #WF_OPTS mode *}
+
+{* wind_set(WF_WHEEL) modes *}
+    WHEEL_MESAG     = 0;   {* AES will send #WM_WHEEL messages *}
+    WHEEL_ARROWED   = 1;   {* AES will send #WM_ARROWED messages *}
+    WHEEL_SLIDER    = 2;   {* AES will convert mouse wheel events to slider events *}
+
+
+{ AES standard object colors }
+const
+  WHITE    = (00);  { White          1000, 1000, 1000 }
+  BLACK    = (01);  { Black             0,    0,    0 }
+  RED      = (02);  { Red            1000,    0,    0 }
+  GREEN    = (03);  { Green             0, 1000,    0 }
+  BLUE     = (04);  { Blue              0,    0, 1000 }
+  CYAN     = (05);  { Cyan              0, 1000, 1000 }
+  YELLOW   = (06);  { Yellow         1000, 1000,    0 }
+  MAGENTA  = (07);  { Magenta        1000,    0, 1000 }
+  DWHITE   = (08);  { Light grey      752,  752,  752 }
+  DBLACK   = (09);  { Dark grey       501,  501,  501 }
+  DRED     = (10);  { Dark red        713,    0,    0 }
+  DGREEN   = (11);  { Dark green        0,  713,    0 }
+  DBLUE    = (12);  { Dark blue         0,    0,  713 }
+  DCYAN    = (13);  { Dark cyan         0,  713,  713 }
+  DYELLOW  = (14);  { Dark yellow     713,  713,    0 }
+  DMAGENTA = (15);  { Dark magenta    713,    0,  713 }
+
+{* editable text justification *}
+const
+    TE_LEFT         = 0;
+    TE_RIGHT        = 1;
+    TE_CNTR         = 2;
+    TE_JUST_MASK    = 3;
+
+{* font types *}
+const
+    GDOS_PROP        = 0; {* Speedo GDOS font *}
+    GDOS_MONO        = 1; {* Speedo GDOS font, force monospace output *}
+    GDOS_BITM        = 2; {* GDOS bit map font *}
+    IBM              = 3;
+    SMALL            = 5;
+    TE_FONT_MASK     = 7;
+
+{* editable text field definitions *}
+const
+    ED_START        = 0;
+    ED_INIT         = 1;
+    ED_CHAR         = 2;
+    ED_END          = 3;
+    ED_CRSR         = 100;            {* MAG!X *}
+    ED_DRAW         = 103;            {* MAG!X 2.00 *}
+    EDSTART         = 0;
+    EDINIT          = 1;
+    EDCHAR          = 2;
+    EDEND           = 3;
+
+{$IFNDEF IP_HOLLOW_defined}
+{* inside patterns *}
+    IP_HOLLOW       = 0;
+    IP_1PATT        = 1;
+    IP_2PATT        = 2;
+    IP_3PATT        = 3;
+    IP_4PATT        = 4;
+    IP_5PATT        = 5;
+    IP_6PATT        = 6;
+    IP_SOLID        = 7;
+{$DEFINE IP_HOLLOW_defined}
+{$ENDIF}
+
+    ROOT            = 0;
+    MAX_DEPTH       = 8;
+
+{ AES mouse cursor number }
+const
+  ARROW          = 0;       { Arrow                               }
+  TEXT_CRSR      = 1;       { Text cursor                         }
+  HOURGLASS      = 2;       { Hourglass, bee                      }
+  BUSY_BEE       = 2;       { See HOURGLASS                       }
+  BUSYBEE        = 2;       { See HOURGLASS                       }
+  POINT_HAND     = 3;       { Pointing hand                       }
+  FLAT_HAND      = 4;       { Flat hand                           }
+  THIN_CROSS     = 5;       { Thin crosshairs                     }
+  THICK_CROSS    = 6;       { Thick crosshairs                    }
+  OUTLN_CROSS    = 7;       { Outlined crosshairs                 }
+  USER_DEF       = 255;     { User-defined mouse form             }
+  M_OFF          = 256;     { Switch off mouse pointer            }
+  M_ON           = 257;     { Switch on mouse pointer             }
+  M_SAVE         = 258;     { Save current mouse form             }
+  M_LAST         = 259;     { Restore most recently saved form    }
+  M_PREVIOUS     = 259;     { See M_LAST                          }
+  M_RESTORE      = 260;     { Restore last shape                  }
+  M_FORCE        = $8000;
+  X_MRESET       = 1000;
+  X_MGET         = 1001;
+  X_MSET_SHAPE   = 1100;
+
+{ Menu definitions as used by menu_bar() }
+const
+  MENU_INQUIRE   = -1;
+  MENU_HIDE      = 0;
+  MENU_SHOW      = 1;
+
+{ Form dialog space actions, as used by form_dial() }
+const
+  FMD_START  = 0; { Reserve screen space for a dialog }
+  FMD_GROW   = 1; { Draw several expanding rectangles from the coordinates fo_dilittlx/y/w/hto fo_dibigx/y/w/h }
+  FMD_SHRINK = 2; { Draw several shrinking rectangles from fo_dibigx/y/w/h to fo_dilittlx/y/w/h }
+  FMD_FINISH = 3; { Release the reserved screen space again }
+
+{ Resource structure types as used by rsrc_gaddr()/rsrc_saddr() }
+const
+  R_TREE      = 0;  { Object tree                          }
+  R_OBJECT    = 1;  { Individual OBJECT (TAESOBJECT)       }
+  R_TEDINFO   = 2;  { TEDINFO structure                    }
+  R_ICONBLK   = 3;  { ICONBLK structure                    }
+  R_BITBLK    = 4;  { BITBLK structure                     }
+  R_STRING    = 5;  { Free string data                     }
+  R_IMAGEDATA = 6;  { Free image data                      }
+  R_OBSPEC    = 7;  { ob_spec field in OBJECT (TAESOBJECT) }
+  R_TEPTEXT   = 8;  { te_ptext in TEDINFO                  }
+  R_TEPTMPLT  = 9;  { te_ptmplt in TEDINFO                 }
+  R_TEPVALID  = 10; { te_pvalid in TEDINFO                 }
+  R_IBPMASK   = 11; { ib_pmask in ICONBLK                  }
+  R_IBPDATA   = 12; { ib_pdata in ICONBLK                  }
+  R_IBPTEXT   = 13; { ib_ptext in ICONBLK                  }
+  R_BIPDATA   = 14; { ib_pdate in BITBLK                   }
+  R_FRSTR     = 15; { ad_frstr free string                 }
+  R_FRIMG     = 16; { ad_frimg free image                  }
+
+{* keyboard states (same as in bios) *}
+    K_RSHIFT        = $0001;
+    K_LSHIFT        = $0002;
+    K_SHIFT         = $0003;
+    K_CTRL          = $0004;
+    K_ALT           = $0008;
+    K_CAPSLOCK      = $0010;
+
+{* appl_read modes *}
+    APR_NOWAIT      = -1;   {* Do not wait for message -- see mt_appl_read() *}
+
+{* appl_search modes *}
+    APP_FIRST = 0;
+    APP_NEXT  = 1;
+    APP_DESK  = 2;
+    X_APS_CHILD0    = $7100; {* Geneva *}
+    X_APS_CHILD     = $7101; {* Geneva *}
+    X_APS_CHEXIT    = -1;    {* Geneva *}
+
+{* application type (appl_search return values) *}
+    APP_SYSTEM          = $001;
+    APP_APPLICATION     = $002;
+    APP_ACCESSORY       = $004;
+    APP_SHELL           = $008;
+    APP_AESSYS          = $010;
+    APP_AESTHREAD       = $020;
+    APP_TASKINFO        = $100; {* XaAES extension for taskbar applications. *}
+    APP_HIDDEN          = $100; {* Task is disabled; XaAES only for APP_TASKINFO *}
+    APP_FOCUS           = $200; {* Active application; XaAES only for APP_TASKINFO *}
+
+{* menu_attach modes *}
+    ME_INQUIRE      = 0;
+    ME_ATTACH       = 1;
+    ME_REMOVE       = 2;
+{* menu_attach attributes *}
+    SCROLL_NO       = 0;
+    SCROLL_YES      = 1;
+
+{* menu_popup modes *}
+    SCROLL_LISTBOX      = -1;
+
+{* the objc_sysvar ob_swhich values *}
+    LK3DIND      = 1;
+    LK3DACT      = 2;
+    INDBUTCOL    = 3;
+    ACTBUTCOL    = 4;
+    BACKGRCOL    = 5;
+    AD3DVAL      = 6;
+    MX_ENABLE3D  = 10;
+    MENUCOL      = 11;
+
+    OB_GETVAR = 0;
+    OB_SETVAR = 1;
+
+{* objc_sysvar modes *}
+    SV_INQUIRE      = 0;
+    SV_SET          = 1;
+
+{* scrp_read return values *}
+    SCRAP_CSV       = $0001;
+    SCRAP_TXT       = $0002;
+    SCRAP_GEM       = $0004;
+    SCRAP_IMG       = $0008;
+    SCRAP_DCA       = $0010;
+    SCRAP_DIF       = $0020;
+    SCRAP_USR       = $8000;
+
+{* shel_write modes for parameter "isover" *}
+    SHW_IMMED        = 0;
+    SHW_CHAIN        = 1;
+    SHW_DOS          = 2;
+    SHW_PARALLEL   = 100;
+    SHW_SINGLE     = 101;
+
+{* shel_write sh_wdoex parameter flags in MSB *}
+    SHD_PSETLIM = (1 shl 8);    { MiNT memory allocation limit }
+    SHD_PRENICE = (1 shl 9);    { MiNT Prenice (priority) level }
+    SHD_DFLTDIR = (1 shl 10);   { Default directory string }
+    SHD_ENVIRON = (1 shl 11);   { Environment string }
+    SHD_UID     = (1 shl 12);   { set user id }
+    SHD_GID     = (1 shl 13);   { set group id }
+
+{* shel_write modes for parameter "doex" *}
+    SWM_LAUNCH       = 0;
+    SWM_LAUNCHNOW    = 1;
+    SWM_LAUNCHACC    = 3;
+    SWM_SHUTDOWN     = 4;
+    SWM_REZCHANGE    = 5;
+    SWM_BROADCAST    = 7;
+    SWM_ENVIRON      = 8;
+    SWM_NEWMSG       = 9;
+    SWM_AESMSG      = 10;
+    SWM_THRCREATE   = 20;
+    SWM_THREXIT     = 21;
+    SWM_THRKILL     = 22;
+
+{* shel_write, parameter wisgr *}
+    TOSAPP              = 0;
+    GEMAPP              = 1;
+
+{* command line parser (shel_write: parameter "wiscr") *}
+    CL_NORMAL       = 0;
+    CL_PARSE        = 1;
+
+{* shutdown action (shel_write: mode SWM_SHUTDOWN, parameter "wiscr") *}
+    SD_ABORT        = 0;
+    SD_PARTIAL      = 1;
+    SD_COMPLETE     = 2;
+
+{* shel_write: mode SWM_ENVIRON, parameter 'wisgr' *}
+    ENVIRON_SIZE    = 0;
+    ENVIRON_CHANGE  = 1;
+    ENVIRON_COPY    = 2;
+
+type
+    PMENU = ^TMENU;
+    TMENU = record
+        mn_tree:        PAESTree;
+        mn_menu:        smallint;
+        mn_item:        smallint;
+        mn_scroll:      smallint;
+        mn_keystate:    smallint;
+    end;
+
+    PMN_SET = ^TMN_SET;
+    TMN_SET = record
+        Display:        LongInt;
+        Drag:           LongInt;
+        Delay:          LongInt;
+        Speed:          LongInt;
+        Height:     smallint;
+    end;
+
+{* extended appl_write structure *}
+    PXAESMSG = ^TXAESMSG;
+    TXAESMSG = record
+        dst_apid: smallint;
+        unique_flg: smallint;
+        attached_mem: Pointer;
+        msgbuf: Psmallint;
+    end;
+
+{* tail for default shell *}
+    PSHELTAIL = ^TSHELTAIL;
+    TSHELTAIL = record
+        dummy: smallint;
+        magic: longint;
+        isfirst: smallint;
+        lasterr: longint;
+        wasgr: smallint;
+    end;
+
+{* shel_write alternative structure for sh_wpcmd parameter *}
+    PSHELW = ^TSHELW;
+    TSHELW = record
+        newcmd: Pchar;
+        psetlimit: longint;
+        prenice: longint;
+        defdir: pchar;
+        env: pointer;
+        case boolean of
+          false: (uid, gid: smallint;);
+          true: (flags: longint;);
+    end;
+

packages/tosunits/src/gem.pas

@@ -0,0 +1,643 @@
+{
+    Copyright (c) 2022 by Free Pascal development team
+
+    GEM interface unit for Atari TOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+    This is used for Pure-Pascal compatibility. For newly written code,
+    consider using the aes/vdi units instead.
+}
+
+{$MODE FPC}
+{$MODESWITCH OUT+}
+{$PACKRECORDS 2}
+
+unit gem;
+
+interface
+
+uses aes, vdi, gemcommon;
+
+const
+        LWhite          = DWHITE;
+        LBlack          = DBLACK;
+        LRed            = DRED;
+        LGreen          = DGREEN;
+        LBlue           = DBLUE;
+        LCyan           = DCYAN;
+        LYellow         = DYELLOW;
+        LMagenta        = DMAGENTA;
+
+const
+        BackSpace       = $0E08;
+        Tab             = $0F09;
+        S_Delete        = $537F;
+        S_Insert        = $5200;
+        Shift_Ins       = $5230;
+        Return          = $1C0D;
+        Enter           = $720D;
+        Undo            = $6100;
+        Help            = $6200;
+        Home            = $4700;
+        Cur_Up          = $4800;
+        Cur_Down        = $5000;
+        Cur_Left        = $4B00;
+        Cur_Right       = $4D00;
+        Shift_Home      = $4737;
+        Shift_CU        = $4838;
+        Shift_CD        = $5032;
+        Shift_CL        = $4B34;
+        Shift_CR        = $4D36;
+        Esc             = $011B;
+        Ctrl_A          = $1E01;
+        Ctrl_B          = $3002;
+        Ctrl_C          = $2E03;
+        Ctrl_D          = $2004;
+        Ctrl_E          = $1205;
+        Ctrl_F          = $2106;
+        Ctrl_G          = $2207;
+        Ctrl_H          = $2308;
+        Ctrl_I          = $1709;
+        Ctrl_J          = $240A;
+        Ctrl_K          = $250B;
+        Ctrl_L          = $260C;
+        Ctrl_M          = $320D;
+        Ctrl_N          = $310E;
+        Ctrl_O          = $180F;
+        Ctrl_P          = $1910;
+        Ctrl_Q          = $1011;
+        Ctrl_R          = $1312;
+        Ctrl_S          = $1F13;
+        Ctrl_T          = $1414;
+        Ctrl_U          = $1615;
+        Ctrl_V          = $2F16;
+        Ctrl_W          = $1117;
+        Ctrl_X          = $2D18;
+        Ctrl_Y          = $2C19;
+        Ctrl_Z          = $151A;
+        Ctrl_1          = $0211;
+        Ctrl_2          = $0300;
+        Ctrl_3          = $0413;
+        Ctrl_4          = $0514;
+        Ctrl_5          = $0615;
+        Ctrl_6          = $071E;
+        Ctrl_7          = $0817;
+        Ctrl_8          = $0918;
+        Ctrl_9          = $0A19;
+        Ctrl_0          = $0B10;
+        Alt_A           = $1E00;
+        Alt_B           = $3000;
+        Alt_C           = $2E00;
+        Alt_D           = $2000;
+        Alt_E           = $1200;
+        Alt_F           = $2100;
+        Alt_G           = $2200;
+        Alt_H           = $2300;
+        Alt_I           = $1700;
+        Alt_J           = $2400;
+        Alt_K           = $2500;
+        Alt_L           = $2600;
+        Alt_M           = $3200;
+        Alt_N           = $3100;
+        Alt_O           = $1800;
+        Alt_P           = $1900;
+        Alt_Q           = $1000;
+        Alt_R           = $1300;
+        Alt_S           = $1F00;
+        Alt_T           = $1400;
+        Alt_U           = $1600;
+        Alt_V           = $2F00;
+        Alt_W           = $1100;
+        Alt_X           = $2D00;
+        Alt_Y           = $2C00;
+        Alt_Z           = $1500;
+        Alt_1           = $7800;
+        Alt_2           = $7900;
+        Alt_3           = $7A00;
+        Alt_4           = $7B00;
+        Alt_5           = $7C00;
+        Alt_6           = $7D00;
+        Alt_7           = $7E00;
+        Alt_8           = $7F00;
+        Alt_9           = $8000;
+        Alt_0           = $8100;
+        F1              = $3B00;
+        F2              = $3C00;
+        F3              = $3D00;
+        F4              = $3E00;
+        F5              = $3F00;
+        F6              = $4000;
+        F7              = $4100;
+        F8              = $4200;
+        F9              = $4300;
+        F10             = $4400;
+        Shift_F1        = $5400;
+        Shift_F2        = $5500;
+        Shift_F3        = $5600;
+        Shift_F4        = $5700;
+        Shift_F5        = $5800;
+        Shift_F6        = $5900;
+        Shift_F7        = $5A00;
+        Shift_F8        = $5B00;
+        Shift_F9        = $5C00;
+        Shift_F10       = $5D00;
+
+        Ctrl_AE         = $2804;
+        Ctrl_OE         = $2714;
+        Ctrl_UE         = $1A01;
+        Alt_AE          = $285D;
+        Alt_OE          = $275B;
+        Alt_UE          = $1A40;
+        SH_Alt_AE       = $287D;
+        SH_Alt_OE       = $277B;
+        SH_Alt_UE       = $1A5C;
+
+
+
+type
+  control_ARRAY	= ARRAY[0..4] of smallint;
+  AESPBPtr = ^AESPB;
+  AESPB = record
+    control: ^control_ARRAY;
+    global: PAESGlobal;
+    intin: PAESIntIn;
+    intout: PAESIntOut;
+    addrin: PAESAddrIn;
+    addrout: PAESAddrOut;
+  end;
+    AESOBJECT = TAESOBJECT;
+    AESOBJECTPtr = ^TAESOBJECT;
+    VDIPB = TVDIPB;
+    VDIPBPtr = ^VDIPB;
+    TEDINFO = TTEDINFO;
+    TEDINFOPtr = ^TEDINFO;
+    ICONBLK = TICONBLK;
+    ICONBLKPtr = ^ICONBLK;
+    CICON = TCICON;
+    CICONPtr = ^CICON;
+    CICONBLK = TCICONBLK;
+    CICONBLKPtr = ^CICONBLK;
+    BITBLK = TBITBLK;
+    BITBLKPtr = ^BITBLK;
+    MFORM = TMFORM;
+    MFORMPtr = ^MFORM;
+    USERBLK = TUSERBLK;
+    USERBLKPtr = ^USERBLK;
+    OBSPEC = TOBSPEC;
+    OBSPECPtr = ^OBSPEC;
+    PARMBLK = TPARMBLK;
+    PARMBLKPtr = ^PARMBLK;
+    AESTree = TAESTree;
+    AESTreePtr = ^AESTree;
+    RSHDR = TRSHDR;
+    RSHDRPtr = ^RSHDR;
+    EVENT = TEVENT;
+    EVENTPtr = ^EVENT;
+    MENU = TMENU;
+    MENUPtr = ^MENU;
+    MN_SET = TMN_SET;
+    MN_SETPtr = ^MN_SET;
+    FONT_HDR = TFONT_HDR;
+    FONT_HDRPtr = ^FONT_HDR;
+    MFDB = vdi.TMFDB;
+    MFDBPtr = ^MFDB;
+
+    global_ARRAY    = TAESGlobal;
+
+    workout_ARRAY   = ARRAY[0..56] of smallint;
+    workin_ARRAY    = ARRAY[0..10] of smallint;
+    intin_ARRAY     = TVDIIntIn;
+    intout_ARRAY    = TVDIIntOut;
+    ptsin_ARRAY     = TVDIPtsIn;
+    ptsout_ARRAY    = TVDIPtsOut;
+
+(*
+ * PurePascal has all the AES parameter arrays exposed.
+ * We don't want to do that, because various arrays are
+ * implementation specific. For Compatibility we
+ * need to make the global array available however;
+ *)
+type
+        AES_block = record
+            global  : TAESGlobal;
+        end;
+
+var Gem_pb: AES_block; external name 'aes_global';
+
+(*
+ * we also need to make the parameter block available,
+ * so applications can define missing functions
+ * that are not yet implemented here.
+ *)
+
+var
+    AES_pb: AESPB; external name 'aespb';
+    VDI_pb: TVDIPB; external name 'vdipb';
+
+{*
+ * overloaded AES functions that take an AESTreePtr as parameter
+ *}
+function menu_bar(me_btree: AESTreePtr; me_bshow: smallint): smallint; overload;
+function menu_icheck(me_ctree: AESTreePtr; me_citem, me_ccheck: smallint): smallint; overload;
+function menu_ienable(me_etree: AESTreePtr; me_eitem, me_eenable: smallint): smallint; overload;
+function menu_tnormal(me_ntree: AESTreePtr; me_ntitle, me_nnormal: smallint): smallint; overload;
+function menu_text(me_ttree: AESTreePtr; me_titem: smallint; me_ttext: String): smallint; overload;
+function menu_attach(me_flag: smallint; me_tree: AESTreePtr; me_item: smallint; me_mdata: PMENU): smallint; overload;
+function menu_istart(me_flag: smallint; me_tree: AESTreePtr; me_imenu, me_item: smallint): smallint; overload;
+
+function objc_add(ob_atree: AESTreePtr;	ob_aparent, ob_achild: smallint): smallint; overload;
+function objc_delete(ob_dltree: AESTreePtr; ob_dlobject: smallint): smallint; overload;
+function objc_draw(ob_drtree: AESTreePtr;
+	ob_drstartob, ob_drdepth,
+	ob_drxclip, ob_dryclip,
+	ob_drwclip, ob_drhclip: smallint): smallint; overload;
+function objc_find(ob_ftree: AESTreePtr;
+	ob_fstartob, ob_fdepth,
+	ob_fmx, ob_fmy: smallint): smallint; overload;
+function objc_offset(ob_oftree: AESTreePtr;
+	ob_ofobject: smallint;
+	out ob_ofxoff, ob_ofyoff: smallint): smallint; overload;
+function objc_order(ob_ortree: AESTreePtr;
+	ob_orobject, ob_ornewpos: smallint): smallint; overload;
+function objc_edit(ob_edtree: AESTreePtr;
+	ob_edobject, ob_edchar: smallint;
+	var ob_edidx: smallint;
+	ob_edkind: smallint): smallint; overload;
+function objc_change(ob_ctree: AESTreePtr;
+	ob_cobject, ob_cresvd,
+	ob_xclip, ob_yclip,
+	ob_wclip, ob_hclip,
+	ob_cnewstate,
+	ob_credraw: smallint): smallint; overload;
+
+function form_do(fo_dotree: AESTreePtr;	fo_dostartob: smallint): smallint; overload;
+function form_center(fo_ctree: AESTreePtr; out fo_cx, fo_cy, fo_cw, fo_ch: smallint): smallint; overload;
+function form_keybd(fo_ktree: AESTreePtr;
+	fo_kobject, fo_kobnext, fo_kchar: smallint;
+	out fo_knxtobject, fo_knxtchar: smallint): smallint; overload;
+function form_button(fo_btree: AESTreePtr; fo_bobject, fo_bclicks: smallint;
+	out fo_bnxtobj: smallint): smallint; overload;
+
+function rsrc_obfix(re_obtree: AESTreePtr; re_oobject: smallint): smallint; overload;
+
+{*
+ * overloaded VDI functions
+ *}
+procedure v_opnwk(const WorkIn: workin_Array; out handle: smallint; out WorkOut: workout_Array); overload;
+procedure v_opnvwk(const WorkIn: workin_Array; var handle: smallint; out WorkOut: workout_Array); overload;
+procedure vq_extnd(handle, owflag: smallint; out WorkOut: workout_Array); overload;
+procedure vro_cpyfm(handle, vr_mode: smallint; const pxyarray: ARRAY_8; const psrcMFDB, pdesMFDB: TMFDB); overload;
+procedure vrt_cpyfm(handle, vr_mode: smallint; const pxyarray: ARRAY_8; const psrcMFDB, pdesMFDB: TMFDB; const color_index: ARRAY_2); overload;
+procedure vqt_extent(handle: smallint; const calcString: String; out extent: ARRAY_8); overload;
+procedure vqt_f_extent(handle: smallint; const str: String; out extent: ARRAY_8);
+
+{*
+ * Utility functions
+ *}
+procedure SetFreeString(tree: PAESTree; obj: smallint; const str: String);
+procedure GetFreeString(tree: PAESTree; obj: smallint; out str: String);
+procedure SetPtext(tree: PAESTree; obj: smallint; const str: String);
+procedure GetPtext(tree: PAESTree; obj: smallint; out str: String);
+procedure SetPtmplt(tree: PAESTree; obj: smallint; const str: String);
+procedure GetPtmplt(tree: PAESTree; obj: smallint; out str :String);
+procedure SetPvalid(tree: PAESTree; obj: smallint; const str: String);
+procedure GetPvalid(tree: PAESTree; obj: smallint; out str: String);
+procedure SetIcontext(tree: PAESTree; obj: smallint; const str: String);
+procedure GetIcontext(tree: PAESTree; obj: smallint; out str: String);
+procedure WindSetTitle(handle: smallint; const str: String; var buf: String);
+procedure WindSetInfo(handle: smallint; const str: String; var buf: String);
+procedure WindSetNewDesk(tree: PAESTree; firstObj: smallint);
+
+implementation
+
+type
+  aesstr = array[0..255] of char;
+
+
+function string_to_vdi(const src: String; dst: psmallint): smallint;
+var
+  i, len: longint;
+begin
+  len:=length(src);
+  for i:=0 to len-1 do
+    dst[i]:=byte(src[i + 1]);
+
+  string_to_vdi:=len;
+end;
+
+
+procedure v_opnwk(const WorkIn: workin_Array; out handle: smallint; out WorkOut: workout_Array);
+begin
+  vdi.v_opnwk(@workin[0], @handle, @workout[0]);
+end;
+
+
+procedure v_opnvwk(const WorkIn: workin_Array; var handle: smallint; out WorkOut: workout_Array);
+begin
+  vdi.v_opnvwk(@workin[0], @handle, @workout[0]);
+end;
+
+
+procedure vq_extnd(handle, owflag: smallint; out WorkOut: workout_Array);
+begin
+  vdi.vq_extnd(handle, owflag, @workout[0]);
+end;
+
+procedure vro_cpyfm(handle, vr_mode: smallint; const pxyarray: ARRAY_8; const psrcMFDB, pdesMFDB: TMFDB);
+begin
+  vdi.vro_cpyfm(handle, vr_mode, @pxyarray, @psrcMFDB, @pdesMFDB);
+end;
+
+procedure vrt_cpyfm(handle, vr_mode: smallint; const pxyarray: ARRAY_8; const psrcMFDB, pdesMFDB: TMFDB; const color_index: ARRAY_2);
+begin
+  vdi.vrt_cpyfm(handle, vr_mode, @pxyarray, @psrcMFDB, @pdesMFDB, @color_index);
+end;
+
+
+procedure vqt_extent(handle: smallint; const calcString: String; out extent: ARRAY_8);
+var len: smallint;
+begin
+  len:=string_to_vdi(calcstring, @vdi_pb.intin^[0]);
+  vdi_pb.control^[0]:=116;
+  vdi_pb.control^[1]:=0;
+  vdi_pb.control^[3]:=len;
+  vdi_pb.control^[5]:=0;
+  vdi_pb.control^[6]:=handle;
+
+  vdi.vdi;
+
+  extent[0]:=vdi_pb.ptsout^[0];
+  extent[1]:=vdi_pb.ptsout^[1];
+  extent[2]:=vdi_pb.ptsout^[2];
+  extent[3]:=vdi_pb.ptsout^[3];
+  extent[4]:=vdi_pb.ptsout^[4];
+  extent[5]:=vdi_pb.ptsout^[5];
+  extent[6]:=vdi_pb.ptsout^[6];
+  extent[7]:=vdi_pb.ptsout^[7];
+end;
+
+procedure vqt_f_extent(handle: smallint; const str: String;
+                       out extent: ARRAY_8);
+var len: longint;
+begin
+  len:=string_to_vdi(str, @vdi_pb.intin^[0]);
+  vdi_pb.control^[0]:=240;
+  vdi_pb.control^[1]:=0;
+  vdi_pb.control^[3]:=len;
+  vdi_pb.control^[5]:=0;
+  vdi_pb.control^[6]:=handle;
+
+  vdi.vdi;
+
+  extent[0]:=vdi_pb.ptsout^[0];
+  extent[1]:=vdi_pb.ptsout^[1];
+  extent[2]:=vdi_pb.ptsout^[2];
+  extent[3]:=vdi_pb.ptsout^[3];
+  extent[4]:=vdi_pb.ptsout^[4];
+  extent[5]:=vdi_pb.ptsout^[5];
+  extent[6]:=vdi_pb.ptsout^[6];
+  extent[7]:=vdi_pb.ptsout^[7];
+end;
+
+
+function menu_bar(me_btree: AESTreePtr; me_bshow: smallint): smallint;
+begin
+	menu_bar := aes.menu_bar(@me_btree[0], me_bshow);
+end;
+
+function menu_icheck(me_ctree: AESTreePtr; me_citem, me_ccheck: smallint): smallint;
+begin
+	menu_icheck := aes.menu_icheck(@me_ctree[0], me_citem, me_ccheck);
+end;
+
+function menu_ienable(me_etree: AESTreePtr; me_eitem, me_eenable: smallint): smallint;
+begin
+	menu_ienable := aes.menu_ienable(@me_etree[0], me_eitem, me_eenable);
+end;
+
+function menu_tnormal(me_ntree: AESTreePtr; me_ntitle, me_nnormal: smallint): smallint;
+begin
+	menu_tnormal := aes.menu_tnormal(@me_ntree[0], me_ntitle, me_nnormal);
+end;
+
+function menu_text(me_ttree: AESTreePtr; me_titem: smallint; me_ttext: String): smallint;
+var s: aesstr;
+begin
+  menu_text:=aes.menu_text(@me_ttree[0], me_titem, @s);
+end;
+
+function menu_attach(me_flag: smallint; me_tree: AESTreePtr; me_item: smallint; me_mdata: PMENU): smallint;
+begin
+  menu_attach:=aes.menu_attach(me_flag, @me_tree[0], me_item, me_mdata);
+end;
+
+function menu_istart(me_flag: smallint; me_tree: AESTreePtr; me_imenu, me_item: smallint): smallint; overload;
+begin
+  menu_istart:=aes.menu_istart(me_flag, @me_tree[0], me_item, me_item);
+end;
+
+
+function objc_add(ob_atree: AESTreePtr;	ob_aparent, ob_achild: smallint): smallint;
+begin
+  objc_add:=aes.objc_add(@ob_atree[0], ob_aparent, ob_achild);
+end;
+
+function objc_delete(ob_dltree: AESTreePtr; ob_dlobject: smallint): smallint;
+begin
+  objc_delete:=aes.objc_delete(@ob_dltree[0], ob_dlobject);
+end;
+
+function objc_draw(ob_drtree: AESTreePtr;
+	ob_drstartob, ob_drdepth,
+	ob_drxclip, ob_dryclip,
+	ob_drwclip, ob_drhclip: smallint): smallint;
+begin
+  objc_draw:=aes.objc_draw(@ob_drtree[0], ob_drstartob, ob_drdepth, ob_drxclip, ob_dryclip, ob_drwclip, ob_drhclip);
+end;
+
+function objc_find(ob_ftree: AESTreePtr;
+	ob_fstartob, ob_fdepth,
+	ob_fmx, ob_fmy: smallint): smallint;
+begin
+  objc_find:=aes.objc_find(@ob_ftree[0], ob_fstartob, ob_fdepth, ob_fmx, ob_fmy);
+end;
+
+function objc_offset(ob_oftree: AESTreePtr;
+	ob_ofobject: smallint;
+	out ob_ofxoff, ob_ofyoff: smallint): smallint;
+begin
+  objc_offset:=aes.objc_offset(@ob_oftree[0], ob_ofobject, ob_ofxoff, ob_ofyoff);
+end;
+
+function objc_order(ob_ortree: AESTreePtr;
+	ob_orobject, ob_ornewpos: smallint): smallint;
+begin
+  objc_order:=aes.objc_order(@ob_ortree[0], ob_orobject, ob_ornewpos);
+end;
+
+function objc_edit(ob_edtree: AESTreePtr;
+	ob_edobject, ob_edchar: smallint;
+	var ob_edidx: smallint;
+	ob_edkind: smallint): smallint;
+begin
+  objc_edit:=aes.objc_edit(@ob_edtree[0], ob_edobject, ob_edchar, ob_edidx, ob_edkind);
+end;
+
+function objc_change(ob_ctree: AESTreePtr;
+	ob_cobject, ob_cresvd,
+	ob_xclip, ob_yclip,
+	ob_wclip, ob_hclip,
+	ob_cnewstate,
+	ob_credraw: smallint): smallint;
+begin
+  objc_change:=aes.objc_change(@ob_ctree[0], ob_cobject, ob_cresvd, ob_xclip, ob_yclip, ob_wclip, ob_hclip, ob_cnewstate, ob_credraw);
+end;
+
+function form_do(fo_dotree: AESTreePtr;	fo_dostartob: smallint): smallint;
+begin
+  form_do:=aes.form_do(@fo_dotree[0], fo_dostartob);
+end;
+
+function form_center(fo_ctree: AESTreePtr; out fo_cx, fo_cy, fo_cw, fo_ch: smallint): smallint;
+begin
+  form_center:=aes.form_center(@fo_ctree[0], fo_cx, fo_cy, fo_cw, fo_ch);
+end;
+
+function form_keybd(fo_ktree: AESTreePtr;
+	fo_kobject, fo_kobnext, fo_kchar: smallint;
+	out fo_knxtobject, fo_knxtchar: smallint): smallint;
+begin
+  form_keybd:=aes.form_keybd(@fo_ktree[0], fo_kobject, fo_kobnext, fo_kchar, fo_knxtobject, fo_knxtchar);
+end;
+
+function form_button(fo_btree: AESTreePtr; fo_bobject, fo_bclicks: smallint;
+	out fo_bnxtobj: smallint): smallint;
+begin
+  form_button:=aes.form_button(@fo_btree[0], fo_bobject, fo_bclicks, fo_bnxtobj);
+end;
+
+function rsrc_obfix(re_obtree: AESTreePtr; re_oobject: smallint): smallint;
+begin
+  rsrc_obfix:=aes.rsrc_obfix(@re_obtree[0], re_oobject);
+end;
+
+
+procedure SetFreeString(tree: PAESTree; obj: smallint; const str: String);
+var len: SizeInt;
+    p: pchar;
+begin
+  len:=length(str);
+  p:=tree^[obj].ob_spec.free_string;
+  move(str[1], p^, len);
+  p[len]:=#0;
+end;
+
+procedure GetFreeString(tree: PAESTree; obj: smallint; out str: String);
+begin
+  str := tree^[obj].ob_spec.free_string;
+end;
+
+procedure SetPtext(tree: PAESTree; obj: smallint; const str: String);
+var len: SizeInt;
+    p: pchar;
+begin
+  len:=length(str);
+  p:=tree^[obj].ob_spec.ted_info^.te_ptext;
+  if (len >= tree^[obj].ob_spec.ted_info^.te_txtlen) then
+    len := tree^[obj].ob_spec.ted_info^.te_txtlen-1;
+  move(str[1], p^, len);
+  p[len]:=#0;
+end;
+
+procedure GetPtext(tree: PAESTree; obj: smallint; out str: String);
+begin
+  str := tree^[obj].ob_spec.ted_info^.te_ptext;
+end;
+
+procedure SetPtmplt(tree: PAESTree; obj: smallint; const str: String);
+var len: SizeInt;
+    p: pchar;
+begin
+  len:=length(str);
+  p:=tree^[obj].ob_spec.ted_info^.te_ptmplt;
+  if (len >= tree^[obj].ob_spec.ted_info^.te_tmplen) then
+    len := tree^[obj].ob_spec.ted_info^.te_tmplen-1;
+  move(str[1], p^, len);
+  p[len]:=#0;
+end;
+
+procedure GetPtmplt(tree: PAESTree; obj: smallint; out str: String);
+begin
+  str := tree^[obj].ob_spec.ted_info^.te_ptmplt;
+end;
+
+procedure SetPvalid(tree: PAESTree; obj: smallint; const str: String);
+var len: SizeInt;
+    p: pchar;
+begin
+  len:=length(str);
+  p:=tree^[obj].ob_spec.ted_info^.te_pvalid;
+  move(str[1], p^, len);
+  p[len]:=#0;
+end;
+
+procedure GetPvalid(tree: PAESTree; obj: smallint; out str: String);
+begin
+  str := tree^[obj].ob_spec.ted_info^.te_pvalid;
+end;
+
+procedure SetIcontext(tree: PAESTree; obj: smallint; const str: String);
+var len: SizeInt;
+    p: pchar;
+begin
+  len:=length(str);
+  p:=tree^[obj].ob_spec.icon_blk^.ib_ptext;
+  move(str[1], p^, len);
+  p[len]:=#0;
+end;
+
+procedure GetIcontext(tree: PAESTree; obj: smallint; out str: String);
+begin
+  str := tree^[obj].ob_spec.icon_blk^.ib_ptext;
+end;
+
+procedure WindSetTitle(handle: smallint; const str: String; var buf: String);
+var len: SizeInt;
+    pstr: Pchar;
+begin
+  pstr := @buf[0];
+  len:=length(str);
+  move(str[1], pstr^, len);
+  pstr[len]:=#0;
+  wind_set(handle, WF_NAME, Pointer(pstr));
+end;
+
+procedure WindSetInfo(handle: smallint; const str: String; var buf: String);
+var len: SizeInt;
+    pstr: Pchar;
+begin
+  pstr := @buf[0];
+  len:=length(str);
+  move(str[1], pstr^, len);
+  pstr[len]:=#0;
+  wind_set(handle, WF_INFO, Pointer(pstr));
+end;
+
+procedure WindSetNewDesk(tree: PAESTree; firstObj: smallint);
+begin
+{$PUSH}
+{$WARN 4055 OFF} { Conversion between ordinals and pointers is not portable }
+  wind_set(0, WF_NEWDESK, hi(ptruint(tree)), lo(ptruint(tree)), firstObj, 0);
+{$POP}
+end;
+
+end.

packages/tosunits/src/gemcommon.pas

@@ -0,0 +1,46 @@
+{
+    Copyright (c) 2022 by Free Pascal development team
+
+    GEM interface unit for Atari TOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+    Shared types between aes/vdi/gem.
+    Only type declarations should go here.
+}
+
+{$MODE FPC}
+{$MODESWITCH OUT+}
+{$PACKRECORDS 2}
+
+unit gemcommon;
+
+interface
+
+type
+    ARRAY_8     = ARRAY[0..7] of smallint;
+
+{ AES/VDI mouse form structure }
+type
+  PMFORM = ^TMFORM;
+  TMFORM = record
+    mf_xhot: smallint;       {* X-position hot-spot *}
+    mf_yhot: smallint;       {* Y-position hot-spot *}
+    mf_nplanes: smallint;    {* Number of planes    *}
+    mf_fg: smallint;         {* Mask colour         *}
+    mf_bg: smallint;         {* Pointer colour      *}
+    mf_mask: array[0..15] of smallint;   {* Mask form           *}
+    mf_data: array[0..15] of smallint;   {* Pointer form        *}
+  end;
+
+implementation
+
+end.

packages/tosunits/src/gemdos.pas

@@ -13,6 +13,7 @@
  **********************************************************************}
 
 {$PACKRECORDS 2}
+{$MODESWITCH OUT+}
 unit gemdos;
 
 interface

packages/tosunits/src/metados.pas

@@ -13,6 +13,7 @@
  **********************************************************************}
 
 {$PACKRECORDS 2}
+{$MODESWITCH OUT+}
 unit metados;
 
 interface
@@ -42,8 +43,8 @@ type
   end;
 
 
-procedure xbios_Metainit(var buffer: TMETAINFO); syscall 14 48;
-function xbios_Metaopen(drive: smallint; var buffer: TMETA_DRVINFO): LongInt; syscall 14 49;
+procedure xbios_Metainit(out buffer: TMETAINFO); syscall 14 48;
+function xbios_Metaopen(drive: smallint; out buffer: TMETA_DRVINFO): LongInt; syscall 14 49;
 function xbios_Metaclose(drive: smallint): LongInt; syscall 14 50;
 function xbios_Metaread(drive: smallint; buffer: Pointer; blockno: LongInt; count: smallint): LongInt; syscall 14 51;
 function xbios_Metawrite(drive: smallint; buffer: Pointer; blockno: LongInt; count: smallint): LongInt; syscall 14 52;

packages/tosunits/src/nf_ops.pas

@@ -0,0 +1,246 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 Thorsten Otto
+
+    NatFeats interface unit for Atari TOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$X+}
+{$I-}
+{$Q-}
+{$R-}
+{$S-}
+{$B-}
+
+unit NF_OPS;
+
+interface
+
+const
+    NF_ID_NAME      : pchar = 'NF_NAME';
+    NF_ID_VERSION   : pchar = 'NF_VERSION';
+    NF_ID_STDERR    : pchar = 'NF_STDERR';
+    NF_ID_SHUTDOWN  : pchar = 'NF_SHUTDOWN';
+    NF_ID_EXIT      : pchar = 'NF_EXIT';
+    NF_ID_DEBUG     : pchar = 'DEBUGPRINTF';
+    NF_ID_ETHERNET  : pchar = 'ETHERNET';
+    NF_ID_HOSTFS    : pchar = 'HOSTFS';
+    NF_ID_AUDIO     : pchar = 'AUDIO';
+    NF_ID_BOOTSTRAP : pchar = 'BOOTSTRAP';
+    NF_ID_CDROM     : pchar = 'CDROM';
+    NF_ID_CLIPBRD   : pchar = 'CLIPBRD';
+    NF_ID_JPEG      : pchar = 'JPEG';
+    NF_ID_OSMESA    : pchar = 'OSMESA';
+    NF_ID_PCI       : pchar = 'PCI';
+    NF_ID_FVDI      : pchar = 'fVDI';
+    NF_ID_USBHOST   : pchar = 'USBHOST';
+    NF_ID_XHDI      : pchar = 'XHDI';
+    NF_ID_SCSI      : pchar = 'NF_SCSIDRV';
+    NF_ID_HOSTEXEC  : pchar = 'HOSTEXEC';
+    NF_ID_CONFIG    : pchar = 'NF_CONFIG';
+
+(*
+ * return the NF id to use for feature_name,
+ *  or zero when not available.
+ *)
+function nf_get_id(feature_name: pchar): longint;
+
+(*
+ * return the version of the NatFeat implementation,
+ *  or zero when not available.
+ *)
+function nf_version: longint;
+
+(*
+ * return the name of the NatFeat implementor,
+ *  or NULL when not available.
+ *)
+procedure nf_get_name(buf: Pchar; bufsize: longint);
+
+(*
+ * return the full name of the NatFeat implementor,
+ *  or NULL when not available.
+ *)
+procedure nf_get_fullname(buf: Pchar; bufsize: longint);
+
+(*
+ * Write a string to the host's terminal.
+ * returns TRUE when available, FALSE otherwise.
+ *)
+function nf_debug(const s: string): boolean;
+
+(*
+ * Shutdown the emulator.
+ * May only be called from Supervisor.
+ *)
+function nf_shutdown(mode: integer): longint;
+
+(*
+ * Shutdown the emulator.
+ * May be called from user mode.
+ *)
+function nf_exit(exitcode: integer): longint;
+
+
+implementation
+
+uses
+    xbios;
+
+const
+    NATFEAT_ID = $7300;
+    NATFEAT_CALL = $7301;
+
+var
+    nf_available: boolean;
+    nf_inited: boolean;
+    nf_stderr: longint;
+
+type
+   Tnf_id = function(id: Pchar): longint; cdecl;
+   Tnf_call = function(id: longint): longint; cdecl; varargs;
+
+var cnf_call: Tnf_call;
+
+var ps: array[0..255] of char;
+
+const nf_id_opcodes: array[0..1] of word = (NATFEAT_ID, $4e75);
+      nf_call_opcodes: array[0..1] of word = (NATFEAT_CALL, $4e75);
+
+function nf_id(id: Pchar): longint;
+var cnf_id: Tnf_id;
+begin
+  cnf_id := Tnf_id(@nf_id_opcodes);
+  nf_id := cnf_id(id);
+end;
+
+
+const nf_version_str: array[0..11] of char = 'NF_VERSION';
+
+function nf_detect: longint; assembler; nostackframe;
+asm
+{$IFDEF CPUCFV4E}
+ (*
+  * on ColdFire, the NATFEAT_ID opcode is actually
+  * "mvs.b d0,d1".
+  * But since there is no emulator that emulates a ColdFire,
+  * this feature isn't available.
+  *)
+  moveq #0,d0
+{$ELSE}
+  pea    nf_version_str
+  moveq  #0,d0      (* assume no NatFeats available *)
+  move.l d0,-(sp)
+  lea    @nf_illegal,a1
+  move.l $0010,a0   (* illegal instruction vector *)
+  move.l a1,$0010
+  move.l sp,a1      (* save the ssp *)
+
+  nop               (* flush pipelines (for 68040+) *)
+
+  dc.w   NATFEAT_ID (* Jump to NATFEAT_ID *)
+  tst.l  d0
+  beq.s  @nf_illegal
+  moveq  #1,d0      (* NatFeats detected *)
+  move.l d0,(sp)
+
+@nf_illegal:
+  move.l a1,sp
+  move.l a0,$0010
+  nop               (* flush pipelines (for 68040+) *)
+  move.l (sp)+,d0
+  addq.l #4,sp      (* pop nf_version argument *)
+{$ENDIF}
+end;
+
+function nf_init: boolean;
+var ret: longint;
+begin
+  if not nf_inited then
+    begin
+      ret := xbios_supexec(@nf_detect);
+      nf_available := ret <> 0;
+      nf_inited := true;
+      cnf_call := Tnf_call(@nf_call_opcodes);
+    end;
+  nf_init := nf_available;
+end;
+
+
+function nf_get_id(feature_name: pchar): longint;
+begin
+  nf_get_id := 0;
+  if nf_init then
+    nf_get_id := nf_id(feature_name);
+end;
+
+function nf_version: longint;
+var id: longint;
+begin
+  nf_version := 0;
+  id := nf_get_id(NF_ID_VERSION);
+  if id <> 0 then
+    nf_version := cnf_call(id);
+end;
+
+procedure nf_get_name(buf: Pchar; bufsize: longint);
+var id: longint;
+begin
+  id := nf_get_id(NF_ID_NAME);
+  if id <> 0 then
+    cnf_call(id or 0, buf, bufsize)
+  else
+    buf^ := #0;
+end;
+
+procedure nf_get_fullname(buf: Pchar; bufsize: longint);
+var id: longint;
+begin
+  id := nf_get_id(NF_ID_NAME);
+  if id <> 0 then
+    cnf_call(id or 1, buf, bufsize)
+  else
+    buf^ := #0;
+end;
+
+function nf_debug(const s: string): boolean;
+begin
+  ps := s;
+  nf_debug := false;
+  if nf_stderr = 0 then
+    nf_stderr := nf_get_id(NF_ID_STDERR);
+  if nf_stderr <> 0 then
+    begin
+      cnf_call(nf_stderr, Addr(ps[0]));
+      nf_debug := true;
+    end;
+end;
+
+function nf_shutdown(mode: integer): longint;
+var id: longint;
+begin
+  nf_shutdown := 0;
+  id := nf_get_id(NF_ID_SHUTDOWN);
+  if id <> 0 then
+    nf_shutdown := cnf_call(id or mode);
+end;
+
+function nf_exit(exitcode: integer): longint;
+var id: longint;
+begin
+  nf_exit := 0;
+  id := nf_get_id(NF_ID_EXIT);
+  if id <> 0 then
+    nf_exit := cnf_call(id or 0, longint(exitcode));
+end;
+
+begin
+end.

packages/tosunits/src/tos.pas

@@ -18,13 +18,14 @@
 }
 
 {$MODE FPC}
+{$MODESWITCH OUT+}
 {$LONGSTRINGS OFF} { this unit always uses shortstrings }
 {$PACKRECORDS 2}
 unit tos;
 
 interface
 
-uses gemdos, xbios, bios;
+uses gemdos, xbios, bios, metados;
 
 const
     FO_READ     = 0;
@@ -85,11 +86,19 @@ type
         d_fname :           String[12];
     end;
 
+    LongIntFunc = xbios.TLongIntFunc;
+
+    METAINFO = metados.TMETAINFO;
+
+{ TOS program need this exported }
+var
+    basepage: PPD; external name '__base';
+
 (* ++++++++++++++++++++++++++++++++++++++++ *)
 (*                  BIOS                    *)
 (* ++++++++++++++++++++++++++++++++++++++++ *)
 
-procedure Getmpb(var p_mpb: TMPB); syscall 13 0;
+procedure Getmpb(out p_mpb: TMPB); syscall 13 0;
 function Bconstat(dev: smallint): smallint; syscall 13 1;
 function Bconin(dev: smallint): LongInt; syscall 13 2;
 procedure Bconout(dev, c: smallint); syscall 13 3;
@@ -145,7 +154,7 @@ function Kbdvbase: PKBDVECS; syscall 14 34;
 function Kbrate(initial, speed: smallint): smallint; syscall 14 35;
 procedure Prtblk(var defptr: TPBDEF); syscall 14 36;
 procedure vsync; syscall 14 37;
-function Supexec(codeptr: TLongIntFunc): LongInt; syscall 14 38;
+function Supexec(codeptr: LongIntFunc): LongInt; syscall 14 38;
 procedure Puntaes; syscall 14 39;
 function Floprate(drive, seekrate: smallint): smallint; syscall 14 41;
 function DMAread(sector: LongInt; count: smallint; buffer: Pointer; devno: smallint): LongInt; syscall 14 42;
@@ -168,19 +177,19 @@ function mon_type: smallint; syscall 14 89;
 procedure VsetSync(flag: smallint); syscall 14 90;
 function VgetSize(mode: smallint): LongInt; syscall 14 91;
 procedure VsetRGB(index, count: smallint; xrgbArray: Array of TRGB); syscall 14 93;
-procedure VgetRGB(index, count: smallint; var xrgbArray: Array of TRGB); syscall 14 94;
+procedure VgetRGB(index, count: smallint; out xrgbArray: Array of TRGB); syscall 14 94;
 function Validmode(mode: smallint): smallint; syscall 14 95;
 procedure Dsp_DoBlock(data_in: Pointer; size_in: LongInt; data_out: Pointer; size_out: LongInt); syscall 14 96;
 procedure Dsp_BlkHandShake(data_in: Pointer; size_in: LongInt; data_out: Pointer; size_out: LongInt); syscall 14 97;
 procedure Dsp_BlkUnpacked(data_in: Pointer; size_in: LongInt; data_out: Pointer; size_out: LongInt); syscall 14 98;
-procedure Dsp_InStream(data_in: Pointer; block_size, num_blocks: LongInt; var blocks_done: LongInt); syscall 14 99;
-procedure Dsp_OutStream(data_out: Pointer; block_size, num_blocks: LongInt; var blocks_done: LongInt); syscall 14 100;
-procedure Dsp_IOStream(data_in, data_out: Pointer; block_insize, block_outsize, num_blocks: LongInt;var blocks_done: LongInt); syscall 14 101;
+procedure Dsp_InStream(data_in: Pointer; block_size, num_blocks: LongInt; out blocks_done: LongInt); syscall 14 99;
+procedure Dsp_OutStream(data_out: Pointer; block_size, num_blocks: LongInt; out blocks_done: LongInt); syscall 14 100;
+procedure Dsp_IOStream(data_in, data_out: Pointer; block_insize, block_outsize, num_blocks: LongInt; out blocks_done: LongInt); syscall 14 101;
 procedure Dsp_RemoveInterrupts(mask: smallint); syscall 14 102;
 function Dsp_GetWordSize: smallint; syscall 14 103;
 function Dsp_Lock: smallint; syscall 14 104;
 procedure Dsp_Unlock; syscall 14 105;
-procedure Dsp_Available(var xavailable, yavailable: LongInt); syscall 14 106;
+procedure Dsp_Available(out xavailable, yavailable: LongInt); syscall 14 106;
 function Dsp_Reserve(xreserve, yreserve: LongInt): smallint; syscall 14 107;
 function Dsp_LoadProg(const filename: String; ability: smallint; buffer: Pointer): smallint;
 procedure Dsp_ExecProg(codeptr: Pointer; codesize: LongInt; ability: smallint); syscall 14 109;
@@ -220,6 +229,16 @@ function buffptr(bptr: Pointer): LongInt; syscall 14 141;
 
 procedure VsetMask(ormask, andmask: LongInt; overlay: smallint); syscall 14 150;
 
+procedure Metainit(out buffer: TMETAINFO); syscall 14 48;
+function Metaopen(drive: smallint; out buffer: TMETA_DRVINFO): LongInt; syscall 14 49;
+function Metaclose(drive: smallint): LongInt; syscall 14 50;
+function Metaread(drive: smallint; buffer: Pointer; blockno: LongInt; count: smallint): LongInt; syscall 14 51;
+function Metawrite(drive: smallint; buffer: Pointer; blockno: LongInt; count: smallint): LongInt; syscall 14 52;
+function Metaseek(drive: smallint; dummy, offset: longint): LongInt; syscall 14 53;
+function Metastatus(drive: smallint; buffer: Pointer): LongInt; syscall 14 54;
+function Metaioctl(drive: smallint; magic: LongInt; opcode: smallint; buffer: Pointer): LongInt; syscall 14 55;
+
+
 (* ++++++++++++++++++++++++++++++++++++++++ *)
 (*                  GEMDOS                  *)
 (* ++++++++++++++++++++++++++++++++++++++++ *)
@@ -261,7 +280,7 @@ function sversion: smallint; syscall 1 48;
 procedure ptermres(keepcnt: longint; returncode: smallint); syscall 1 49;
 function sconfig(mode: smallint; flags: longint): longint; syscall 1 51;
 
-function dfree(var buf: TDISKINFO; driveno: smallint): smallint; syscall 1 54;
+function dfree(out buf: TDISKINFO; driveno: smallint): smallint; syscall 1 54;
 
 function dcreate(const path: String): longint;
 function ddelete(const path: String): longint;
@@ -277,7 +296,7 @@ function fattrib(const filename: String; wflag: smallint; attrib: smallint): sma
 function mxalloc(amount: longint; mode: smallint): pointer; syscall 1 68;
 function fdup(handle: smallint): smallint; syscall 1 69;
 function fforce(stdh: smallint; nonstdh: smallint): smallint; syscall 1 70;
-function dgetpath(var path: String; driveno: smallint): smallint;
+function dgetpath(out path: String; driveno: smallint): smallint;
 function malloc(number: dword): pointer; syscall 1 72;
 function free(block: pointer): dword; syscall 1 73;
 function mfree(block: pointer): dword; syscall 1 73;
@@ -294,7 +313,7 @@ procedure fdatime(timeptr: PDOSTIME; handle: smallint; wflag: smallint); syscall
 function Flock(handle, mode: smallint; start, length: LongInt): LongInt; syscall 1 92;
 
 function Syield: smallint; syscall 1 255;
-function Fpipe(var usrh: ARRAY of smallint): smallint; syscall 1 256;
+function Fpipe(out usrh: ARRAY of smallint): smallint; syscall 1 256;
 function Ffchown(fd, uid, gid: smallint): longint; syscall 1 257;
 function Ffchmod(fd: smallint; mode: word): longint; syscall 1 258;
 function Fsync(fd: smallint): longint; syscall 1 259;
@@ -322,9 +341,9 @@ function Pusrval(arg: LongInt): LongInt; syscall 1 280;
 function Pdomain(newdom: smallint): smallint; syscall 1 281;
 procedure Psigreturn; syscall 1 282;
 function Pfork: smallint; syscall 1 283;
-function Pwait3(flag: smallint; var rusage: ARRAY of LongInt): LongInt; syscall 1 284;
-function Fselect(timeout: Word; var rfds, wfds, xfds: LongInt): smallint; syscall 1 285;
-function Prusage(var r: ARRAY of LongInt): LongInt; syscall 1 286;
+function Pwait3(flag: smallint; out rusage: ARRAY of LongInt): LongInt; syscall 1 284;
+function Fselect(timeout: Word; out rfds, wfds, xfds: LongInt): smallint; syscall 1 285;
+function Prusage(out r: ARRAY of LongInt): LongInt; syscall 1 286;
 function Psetlimit(lim: smallint; value: LongInt): LongInt; syscall 1 287;
 function Talarm(secs: LongInt): LongInt; syscall 1 288;
 procedure Pause; syscall 1 289;
@@ -335,13 +354,13 @@ function Pmsg(mode: smallint; mbox: LongInt; var msg: TMSGTYPE): LongInt; syscal
 function Fmidipipe(pid, inp, outp: smallint): LongInt; syscall 1 294;
 function Prenice(pid, delta: smallint): smallint; syscall 1 295;
 function Dopendir(const name: String; flag: smallint): LongInt;
-function Dreaddir(buflen: smallint; dir: LongInt; var buf: String): LongInt;
+function Dreaddir(buflen: smallint; dir: LongInt; out buf: String): LongInt;
 function Drewinddir(dir: LongInt): LongInt; syscall 1 298;
 function Dclosedir(dir: LongInt): LongInt; syscall 1 299;
-function Fxattr(flag: smallint; const name: String; var buf: TXATTR): LongInt;
+function Fxattr(flag: smallint; const name: String; out buf: TXATTR): LongInt;
 function Flink(const oldname: String; const newname: String): LongInt;
 function Fsymlink(const oldname: String; const newname: String): LongInt;
-function Freadlink(size: smallint; var buf: String; const name: String): LongInt;
+function Freadlink(size: smallint; out buf: String; const name: String): LongInt;
 function Dcntl(cmd: smallint; const name: String; arg: LongInt): LongInt;
 function Fchown(const name: String; uid, gid: smallint): LongInt;
 function Fchmod(const name: String; mode: smallint): LongInt;
@@ -352,12 +371,13 @@ procedure Psigpause(mask: LongInt); syscall 1 310;
 function Psigaction(sig: smallint; act, oact: PSIGACTION): LongInt; syscall 1 311;
 function Pgeteuid: smallint; syscall 1 312;
 function Pgetegid: smallint; syscall 1 313;
-function Pwaitpid(pid, flag: smallint; var rusage: ARRAY of LongInt): LongInt; syscall 1 314;
+function Pwaitpid(pid, flag: smallint; out rusage: ARRAY of LongInt): LongInt; syscall 1 314;
 function Dgetcwd(path: Pchar; drv, size: smallint): LongInt; syscall 1 315;
 procedure Salert(str: Pchar); syscall 1 316;
 function Tmalarm(time: longint): LongInt; syscall 1 317;
 { function Psigintr(vec, sig: smallint): LongInt; syscall 1 318; }
-function Suptime(var uptime: longint; var loadaverage: longint): LongInt; syscall 1 319;
+function Suptime(out uptime: longint; out loadaverage: longint): LongInt; syscall 1 319;
+
 
 (* ++++++++++++++++++++++++++++++++++++++++ *)
 (*              IMPLEMENTATION              *)
@@ -465,7 +485,7 @@ begin
   dsetpath := gemdos_dsetpath(s);
 end;
 
-function dgetpath(var path: String; driveno: smallint): smallint;
+function dgetpath(out path: String; driveno: smallint): smallint;
 var s: array[0..255] of char;
 begin
   Dgetpath := gemdos_dgetpath(s, driveno);
@@ -501,7 +521,7 @@ begin
   Dopendir := gemdos_dopendir(s, flag);
 end;
 
-function Dreaddir(buflen: smallint; dir: LongInt; var buf: String): LongInt;
+function Dreaddir(buflen: smallint; dir: LongInt; out buf: String): LongInt;
 var s: array[0..255] of char;
 begin
   Dreaddir := gemdos_dreaddir(buflen, dir, s);
@@ -509,7 +529,7 @@ begin
     buf := PChar(@s[0]);
 end;
 
-function Fxattr(flag: smallint; const name: String; var buf: TXATTR): LongInt;
+function Fxattr(flag: smallint; const name: String; out buf: TXATTR): LongInt;
 var s: array[0..255] of char;
 begin
   s := name;
@@ -534,7 +554,7 @@ begin
   fsymlink := gemdos_fsymlink(s1, s2);
 end;
 
-function Freadlink(size: smallint; var buf: String; const name: String): LongInt;
+function Freadlink(size: smallint; out buf: String; const name: String): LongInt;
 var s1: array[0..255] of char;
     s2: array[0..255] of char;
 begin

packages/tosunits/src/vdi.pas

@@ -12,168 +12,383 @@
 
  **********************************************************************}
 
+{$MODE FPC}
+{$MODESWITCH OUT+}
 {$PACKRECORDS 2}
+
 unit vdi;
 
 interface
 
-{ The API description of this file is based on the information available
-  online at: http://toshyp.atari.org }
-
-type
-  PCOLOR_RGB = ^TCOLOR_RGB;
-  TCOLOR_RGB = record
-      reserved: word;     {* Set to 0 or the index of the entry *}
-      red: word;          {* Red:   0<->65535 *}
-      green: word;        {* Green: 0<->65535 *}
-      blue: word;         {* Blue:  0<->65535 *}
-  end;
-
-{$WARNING type TCOLOR_ENTRY is incomplete}
-type
-  TCOLOR_ENTRY = record
-    case byte of
-      0: ( rgb: TCOLOR_RGB; );
-      1: ( cymk: array[0..1] of longint; ); // dummy
-  end;
-
-type
-  PCOLOR_TAB = ^TCOLOR_TAB;
-  TCOLOR_TAB = record             {* Colour table                    *}
-      magic: array[0..3] of char; {* 'ctab'                          *}
-      length: longint;
-      format: longint;            {* Format (0)                      *}
-      reserved: longint;          {* Reserved, set to 0              *}
-      map_id: longint;            {* Colour table ID                 *}
-      color_space: longint;       {* Colour space (at present only
-                                     CSPACE_RGB)                     *}
-      flags: longint;             {* VDI-internal flags, set to 0    *}
-      no_colors: longint;         {* Number of colour entries        *}
-      reserved1: longint;         {* Reserved, must be 0             *}
-      reserved2: longint;         {* Reserved, must be 0             *}
-      reserved3: longint;         {* Reserved, must be 0             *}
-      reserved4: longint;         {* Reserved, must be 0             *}
-      colors: array[0..0] of TCOLOR_ENTRY; { repeated no_colors times }
-  end;
-
-type
-  PPOINT16 = ^TPOINT16;
-  TPOINT16 = record               {* Point for 16-bit coordinates *}
-      x: smallint;
-      y: smallint;
-  end;
-
-type
-  PPOINT32 = ^TPOINT32;
-  TPOINT32 = record               {* Point for 32-bit coordinates *}
-      x: longint;
-      y: longint;
-  end;
-
-type
-  PRECT16 = ^TRECT16;
-  TRECT16 = record                {* Rectangle for 16-bit coordinates *}
-      x1: smallint;
-      y1: smallint;
-      x2: smallint;
-      y2: smallint;
-  end;
-
-type
-  PRECT32 = ^TRECT32;
-  TRECT32 = record                {* Rectangle for 32-bit coordinates *}
-      x1: longint;
-      y1: longint;
-      x2: longint;
-      y2: longint;
-  end;
-
-type
-  PMFDB = ^TMFDB;
-  TMFDB = record
-      fd_addr: pointer;          {* Pointer to the start of the
-                                    memory block, e.g. the
-                                    screen memory base address  *}
-      fd_w: smallint;            {* Width in pixels             *}
-      fd_h: smallint;            {* Height in pixels            *}
-      fd_wdwidth: smallint;      {* Width of a line in words    *}
-      fd_stand: smallint;        {* 0 = Device-specific format  *}
-                                 {* 1 = Standard format         *}
-      fd_nplanes: smallint;      {* Number of planes            *}
-      fd_r1: smallint;           {* Reserved, must be 0         *}
-      fd_r2: smallint;           {* Reserved, must be 0         *}
-      fd_r3: smallint;           {* Reserved, must be 0         *}
-  end;
-
-type
-  PVDIContrl = ^TVDIContrl;
-  TVDIContrl = array[0..11] of smallint;
-
-  PVDIPtsIn  = ^TVDIPtsIn;
-  TVDIPtsIn  = array[0..1023] of smallint;
+uses gemcommon;
 
-  PVDIPtsOut = ^TVDIPtsOut;
-  TVDIPtsOut = array[0..255] of smallint;
-
-  PVDIIntIn  = ^TVDIIntIn;
-  TVDIIntIn  = array[0..1023] of smallint;
+{ The API description of this file is based on the information available
+  online at: https://freemint.github.io/tos.hyp/en/index.html }
 
-  PVDIIntOut = ^TVDIIntOut;
-  TVDIIntOut = array[0..511] of smallint;
+{$I vditypes.inc}
 
 type
-  PVDIPB = ^TVDIPB;
-  TVDIPB = record
-      contrl: PVDIContrl;        {* Pointer to contrl array *}
-      intin: PVDIIntIn;          {* Pointer to intin array  *}
-      ptsin: PVDIPtsIn;          {* Pointer to ptsin array  *}
-      intout: PVDIIntOut;        {* Pointer to intout array *}
-      ptsout: PVDIPtsOut;        {* Pointer to ptsout array *}
-  end;
-
-const
-  VDI_TRAP_MAGIC = $73;
+   ARRAY_8 = gemcommon.ARRAY_8;
+   PMFORM = gemcommon.PMFORM;
+   TMFORM = gemcommon.TMFORM;
 
 procedure vdi;
+procedure vdi(pb: PVDIPB);
+
+function vq_gdos: smallint;
+function vq_vgdos: LongInt;
 
 procedure vdi_str_to_pchar(src: psmallint; des: pchar; len: smallint);
 function pchar_str_to_vdi(src: pchar; des: psmallint): longint;
 
 procedure v_opnwk(work_in: psmallint; handle: psmallint; work_out: psmallint);
 procedure v_clswk(handle: smallint);
+procedure v_clrwk(handle: smallint);
+procedure v_updwk(handle: smallint);
+
+procedure vq_chcells(handle: smallint; out rows, columns: smallint);
+procedure v_exit_cur(handle: smallint);
+procedure v_enter_cur(handle: smallint);
+procedure v_curup(handle: smallint);
+procedure v_curdown(handle: smallint);
+procedure v_curright(handle: smallint);
+procedure v_curleft(handle: smallint);
+procedure v_curhome(handle: smallint);
+procedure v_eeos(handle: smallint);
+procedure v_eeol(handle: smallint);
+procedure v_curaddress(handle, row, column: smallint);
+procedure v_curtext(handle: smallint; const outString: String);
+procedure v_rvon(handle: smallint);
+procedure v_rvoff(handle: smallint);
+procedure vq_curaddress(handle: smallint; out row, column: smallint);
+function vq_tabstatus(handle: smallint): smallint;
+procedure v_hardcopy(handle: smallint);
+procedure v_dspcur(handle, x, y: smallint);
+procedure v_rmcur(handle: smallint);
+procedure v_form_adv(handle: smallint);
+procedure v_output_window(handle: smallint; xyarray: ARRAY_4);
+procedure v_clear_disp_list(handle: smallint);
+procedure v_bit_image(handle: smallint; const filename: string;
+                aspect, x_scale, y_scale, h_align, v_align: smallint;
+                const xyarray: ARRAY_4);
+procedure vq_scan(handle: smallint; out g_slice, g_page, a_slice, a_page, div_fac: smallint);
+procedure v_alpha_text(handle: smallint; const outString: String);
+function v_orient(handle, orientation: smallint): smallint;
+function v_copies(handle, count: smallint): smallint;
+procedure v_tray(handle, tray: smallint);
+function v_page_size(handle, page_id: smallint): smallint;
+function vs_palette(handle, palette: smallint): smallint;
+procedure v_sound(handle, frequency, duration: smallint);
+function vs_mute(handle, action: smallint): smallint;
+procedure vt_resolution(handle, xres, yres: smallint;
+                        out xset, yset: smallint);
+procedure vt_axis(handle, xres, yres: smallint;
+                  out xset, yset: smallint);
+procedure vt_origin(handle, xorigin, yorigin: smallint);
+procedure vq_tdimensions(handle: smallint; out xdimension, ydimension: smallint);
+procedure vt_alignment(handle, dx, dy: smallint);
+procedure vsp_film(handle, index, lightness: smallint);
+function vqp_filmname(handle, index: smallint; out name: String): smallint;
+procedure vsc_expose(handle, state: smallint);
+procedure v_meta_extents(handle, min_x, min_y, max_x, max_y: smallint);
+procedure v_write_meta(handle, num_intin: smallint; a_intin: Pointer;
+                       num_ptsin: smallint;a_ptsin: Pointer);
+procedure vm_pagesize(handle, pgwidth, pgheight: smallint);
+procedure vm_coords(handle, llx, lly, urx, ury: smallint);
+function v_bez_qual(handle, prcnt: smallint; out actual: smallint): smallint;
+procedure vm_filename(handle: smallint; const filename: String);
+procedure v_offset(handle, offset: smallint);
+procedure v_fontinit(handle: smallint; var fh: TFONT_HDR);
+procedure v_escape2000(handle, times: smallint);
 
 procedure v_pline(handle: smallint; count: smallint; pxyarray: psmallint);
-
-procedure v_gtext(handle: smallint; x: smallint; y: smallint; _string: pchar);
+procedure v_pline(handle, count: smallint; const pxyarray: Array of smallint);
+procedure v_bez(handle, count: smallint; xyarr, bezarr: Pointer;
+                out extent: ARRAY_4;
+                out totpts, totmoves: smallint);
+procedure v_bez_fill(handle, count: smallint;
+                    xyarr, bezarr: Pointer;
+                    out extent: ARRAY_4;
+                    out totpts, totmoves: smallint);
+
+procedure v_pmarker(handle, count: smallint; const pxyarray: Array of smallint);
+procedure v_gtext(handle: smallint; x: smallint; y: smallint; outputstring: pchar);
+procedure v_gtext(handle, x, y: smallint; const outputstring: string);
+procedure v_fillarea(handle, count: smallint; const pxyarray: Array of smallint);
 
 procedure v_bar(handle: smallint; pxyarray: psmallint);
-procedure v_circle (handle: smallint; x: smallint; y: smallint; radius: smallint);
+procedure v_bar(handle: smallint; const pxyarray: ARRAY_4);
+procedure v_arc(handle, x, y, radius, begang, endang: smallint);
+procedure v_pieslice(handle, x, y, radius, begang, endang: smallint);
+procedure v_circle(handle: smallint; x: smallint; y: smallint; radius: smallint);
+procedure v_ellipse(handle, x, y, xradius, yradius: smallint);
+procedure v_ellarc(handle, x, y, xradius, yradius, begang, endang: smallint);
+procedure v_ellpie(handle, x, y, xradius, yradius, begang, endang: smallint);
+procedure v_rbox(handle: smallint; const xyarray: ARRAY_4);
+procedure v_rfbox(handle: smallint; const xyarray: ARRAY_4);
+procedure v_justified(handle, x, y: smallint;
+        const outputstring: string;
+        width, wordspace, charspace: smallint);
+function v_bez_on(handle: smallint): smallint;
+procedure v_bez_off(handle: smallint);
+
+procedure vst_height(handle, height: smallint; out char_width, char_height, cell_width, cell_height: smallint);
+function vst_rotation(handle, angle: smallint): smallint;
 
 procedure vs_color(handle: smallint; index: smallint; rgb_in: psmallint);
+procedure vs_color(handle, index: smallint; const rgb_in: ARRAY_3);
 
+function vsl_type(handle, style: smallint): smallint;
+function vsl_width(handle, width: smallint): smallint;
 function vsl_color(handle: smallint; color_index: smallint): smallint;
+function vsm_type(handle, symbol: smallint): smallint;
+function vsm_height(handle, height: smallint): smallint;
+function vsm_color(handle, color_index: smallint): smallint;
+function vst_font(handle, font: smallint): smallint;
+function vsf_interior(handle, style: smallint): smallint;
+function vsf_style(handle, style_index: smallint): smallint;
+function vq_color(handle, color_index, set_flag: smallint; out rgb: ARRAY_3): smallint;
+procedure vrq_locator(handle, x, y: smallint; out xout, yout, term: smallint);
+function vsm_locator(handle, x, y: smallint; out xout, yout, term: smallint): smallint;
+procedure vrq_valuator(handle, valuator_in: smallint; out valuator_out, terminator: smallint);
+procedure vsm_valuator(handle, val_in: smallint; out val_out, term, status: smallint);
+procedure vrq_choice(handle, ch_in: smallint; out ch_out: smallint);
+function vsm_choice(handle: smallint; out choice: smallint): smallint;
+procedure vrq_string(handle, max_length, echo_mode: smallint; const echo_xy: ARRAY_2; out resString: string);
+function vsm_string(handle, max_length, echo_mode: smallint; const echo_xy: ARRAY_2; out resString: string): smallint;
+
 function vst_color(handle: smallint; color_index: smallint): smallint;
 function vsf_color(handle: smallint; color_index: smallint): smallint;
 
 function vswr_mode(handle: smallint; mode: smallint): smallint;
-
-procedure v_opnvwk(work_in: psmallint; handle: psmallint; work_out: psmallint);
-procedure v_clsvwk(handle: smallint);
+function vsin_mode(handle, dev_type, mode: smallint): smallint;
+procedure vql_attributes(handle: smallint; out attrib: ARRAY_4);
+procedure vql_attributes(handle: smallint; out attrib: ARRAY_6);
+procedure vqm_attributes(handle: smallint; out attrib: ARRAY_4);
+procedure vqf_attributes(handle: smallint; out attrib: ARRAY_5);
+procedure vqt_attributes(handle: smallint; out attrib: ARRAY_10);
+procedure vst_alignment(handle, hor_in, vert_in: smallint; out hor_out, vert_out: smallint);
+
+procedure v_opnvwk(work_in: psmallint; handle: psmallint; work_out: psmallint); overload;
+procedure v_clsvwk(handle: smallint); overload;
+procedure vq_extnd(handle, owflag: smallint; WorkOut: psmallint); overload;
+procedure vq_scrninfo(handle: smallint; out WorkOut: ARRAY_273);
+procedure v_contourfill(handle, x, y, index: smallint);
+function vsf_perimeter(handle, per_vis: smallint): smallint;
 
 procedure v_get_pixel(handle: smallint; x: smallint; y: smallint;
                       pel: psmallint; index: psmallint);
+procedure v_get_pixel(handle, x, y: smallint; out pel, index: smallint);
+function vst_effects(handle, effect: smallint): smallint;
+function vst_point(handle, point: smallint; out char_width, char_height, cell_width, cell_height: smallint): smallint;
+procedure vsl_ends(handle, beg_style, end_style: smallint);
 
-procedure vro_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB);
+procedure vro_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB); overload;
+procedure vr_trnfm(handle: smallint; psrcMFDB, pdesMFDB: PMFDB);
+procedure vr_trnfm(handle: smallint; const psrcMFDB, pdesMFDB: TMFDB);
+procedure vsc_form(handle: smallint; pcur_form: PMFORM);
+procedure vsf_udpat(handle: smallint; pfill_pat: Pointer; planes: smallint);
+procedure vsl_udsty(handle, pattern: smallint);
+procedure vr_recfl(handle: smallint; const pxyarray: ARRAY_4);
+procedure vqin_mode(handle, dev_type: smallint; out input_mode: smallint);
+procedure vqt_extent(handle: smallint; calcString: pchar; extent: psmallint); overload;
+function vqt_width(handle, character: smallint; out cell_width, left_delta, right_delta: smallint): smallint;
 
-procedure vrt_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB; color_index: psmallint);
+procedure vex_timv(handle: smallint; tim_addr: Pointer; out otim_addr: Pointer; out tim_conv: smallint);
+
+function vst_load_fonts(handle, select: smallint): smallint;
+procedure vst_unload_fonts(handle, select: smallint);
+
+procedure vrt_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB; color_index: psmallint); overload;
 
 procedure v_show_c(handle: smallint; reset: smallint);
 procedure v_hide_c(handle: smallint);
+procedure vq_mouse(handle: smallint; out pstatus, x, y: smallint);
+procedure vex_butv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+procedure vex_motv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+procedure vex_curv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+procedure vex_wheelv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+procedure vq_key_s(handle: smallint; out pstatus: smallint);
 
 procedure vs_clip(handle: smallint; clip_flag: smallint; pxyarray: psmallint);
+procedure vs_clip(handle, clip_flag: smallint; const pxyarray: ARRAY_4);
+procedure vs_clip_off(handle: smallint);
+
+function vqt_name(handle, element_num: smallint; out name: String33): smallint;
+procedure vqt_fontinfo(handle: smallint;
+        out minADE, maxADE: smallint;
+        out distances: ARRAY_5;
+        out maxwidth: smallint;
+        out effects: ARRAY_3);
+
+procedure vqt_justified(handle, x, y: smallint; const outString: String;
+            length, word_space, char_space: smallint;
+            offsets: Pointer);
+
+procedure vst_width(handle, width: smallint; out char_width, char_height, cell_width, cell_height: smallint);
+procedure vqt_fontheader(handle: smallint; buffer: Pointer;
+                         out pathname: String);
+procedure vqt_trackkern(handle: smallint; out x, y: fix31);
+procedure vqt_pairkern(handle, ch1, ch2: smallint; out x, y: fix31);
+procedure vst_charmap(handle, mode: smallint);
+function vst_map_mode(handle, mode: smallint): smallint;
+procedure vst_kern(handle, tmode, pmode: smallint; out tracks, pairs: smallint);
+procedure vst_track_offset(handle: smallint; offset: fix31; pairmode: smallint; out tracks, pairs: smallint);
+procedure v_getbitmap_info(handle, ch: smallint;
+                           out advx, advy, xoff, yoff: fix31;
+                           out width, height: smallint;
+                           out bitmap: pointer);
+
+procedure v_ftext(handle, x, y: smallint; const str: String);
+procedure v_ftext_offset(handle, x, y: smallint;
+                         const outputstring: string;
+                         const offset: Array of smallint);
+procedure v_killoutline(handle: smallint; component: Pointer);
+procedure v_getoutline(handle, ch: smallint;
+                       const xyarray: Array of smallint;
+                       const bezarray: Array of ShortInt;
+                       maxverts: smallint;
+                       out numverts: smallint);
+procedure vst_scratch(handle, mode: smallint);
+procedure vst_error(handle, mode: smallint; out errorvar: smallint);
+function vst_arbpt(handle, point: smallint;
+                   out chwd, chht, cellwd, cellht: smallint): smallint;
+function vst_arbpt32(handle: smallint; point: fix31;
+                     out chwd, chht, cellwd, cellht: smallint): fix31;
+procedure vqt_advance(handle, ch: smallint; out advx, advy, remx, remy: smallint);
+procedure vqt_advance32(handle, ch: smallint; out advx, advy: fix31);
+function vq_devinfo(handle, devnum: smallint;
+                      out devexists: smallint;
+                      out filename: String;
+                      out devicename: String): smallint;
+procedure vqt_devinfo(handle, devnum: smallint;
+                      out dev_busy: smallint;
+                      out filename: String;
+                      out devicename: String);
+
+function v_savecache(handle: smallint; const filename: String): smallint;
+function v_loadcache(handle: smallint; const filename: String; mode: smallint): smallint;
+function v_flushcache(handle: smallint): smallint;
+function vst_setsize(handle, point: smallint;
+                     out chwd, chht, cellwd, cellht: smallint): smallint;
+function  vst_setsize32(handle: smallint; point: fix31;
+                        out chwd, chht, cellwd, cellht: smallint): fix31;
+function vst_skew(handle, skew: smallint): smallint;
+procedure vqt_get_table(handle: smallint; out map: Pointer);
+procedure vqt_cachesize(handle, which_cache: smallint; out size: LongInt);
+
+procedure v_set_app_buff(handle: smallint; address: Pointer; nparagraphs: smallint);
+
+
+(*
+ * NOT YET IMPLEMENTED:
+fix31_to_point(a) ((_WORD)((((a) + 32768L) >> 16)))
+point_to_fix31(a) (((fix31)(a)) << 16)
+
+v_trays
+
+v_ps_halftone
+vq_calibrate
+vq_page_name
+vq_tray_names
+vs_calibrate
+v_etext
+
+v_setrgbi
+v_xbit_image
+v_topbot
+vs_bkcolor
+v_pat_rotate
+vs_grayoverride
+
+v_opnbm
+v_clsbm
+
+v_get_driver_info
+vqt_real_extent
+
+vq_margins
+vq_driver_info
+vq_bit_image
+vs_page_info
+vs_crop
+vq_image_type
+vs_save_disp_list
+vs_load_disp_list
+
+vqt_xfntinfo
+vq_ext_devinfo
+vqt_ext_name
+vqt_name_and_id
+vst_name
+
+vqt_char_index
+
+vqt_is_char_available
+
+v_color2nearest
+v_color2value
+v_create_ctab
+v_create_itab
+v_ctab_idx2value
+v_ctab_idx2vdi
+v_ctab_vdi2idx
+v_delete_ctab
+v_delete_itab
+v_get_ctab_id
+v_get_outline
+v_open_bm
+v_resize_bm
+v_setrgb
+v_value2color
+vq_ctab
+vq_ctab_entry
+vq_ctab_id
+vq_dflt_ctab
+vq_hilite_color
+vq_margins
+vq_max_color
+vq_min_color
+vq_prn_scaling
+vq_px_format
+vq_weight_color
+vqf_bg_color
+vqf_fg_color
+vql_bg_color
+vql_fg_color
+vqm_bg_color
+vqm_fg_color
+vqr_bg_color
+vqr_fg_color
+vqt_bg_color
+vqt_fg_color
+vr_transfer_bits
+vs_ctab
+vs_ctab_entry
+vs_dflt_ctab
+vs_document_info
+vs_hilite_color
+vs_max_color
+vs_min_color
+vs_weight_color
+vsf_bg_color
+vsf_fg_color
+vsl_bg_color
+vsl_fg_color
+vsm_bg_color
+vsm_fg_color
+vsr_bg_color
+vsr_fg_color
+vst_bg_color
+vst_fg_color
+*)
+
 
 implementation
 
+const
+  VDI_TRAP_MAGIC = $73;
+
 var
   _contrl: TVDIContrl;
   _intin: TVDIIntIn;
@@ -183,19 +398,69 @@ var
 
 const
   pblock: TVDIPB = (
-    contrl: @_contrl;
+    control: @_contrl;
     intin: @_intin;
     ptsin: @_ptsin;
     intout: @_intout;
     ptsout: @_ptsout;
-  );
+  ); public name 'vdipb';
+
+function string_to_vdi(const src: String; dst: psmallint): smallint;
+var
+  i, len: longint;
+begin
+  len:=length(src);
+  for i:=0 to len-1 do
+    dst[i]:=byte(src[i + 1]);
+
+  string_to_vdi:=len;
+end;
+
+procedure vdi_to_string(src: psmallint; out dst: String; len: longint);
+var
+  i: longint;
+begin
+  for i:=0 to len-1 do
+    dst[i + 1]:=chr(src[i]);
+  setlength(dst, len);
+end;
 
-procedure vdi; assembler;
+procedure vdi; assembler; nostackframe;
 asm
+  pea.l       (a2)
   lea.l pblock, a0
   move.l a0, d1
   move.w #VDI_TRAP_MAGIC, d0
   trap #2
+  movea.l     (a7)+,a2
+end;
+
+procedure vdi(pb: PVDIPB); assembler; nostackframe;
+asm
+  pea.l       (a2)
+  move.l pb,a0
+  move.l a0,d1
+  move.w #VDI_TRAP_MAGIC,d0
+  trap #2
+  movea.l     (a7)+,a2
+end;
+
+function vq_gdos: smallint; assembler; nostackframe;
+asm
+  pea.l       (a2)
+  moveq.l     #-2,d0
+  trap        #2
+  addq.w      #2,d0
+  ext.l       d0
+  movea.l     (a7)+,a2
+end;
+
+function vq_vgdos: LongInt; assembler; assembler; nostackframe;
+asm
+  pea.l       (a2)
+  moveq.l     #-2,d0
+  trap        #2
+  movea.l     (a7)+,a2
 end;
 
 procedure vdi_str_to_pchar(src: psmallint; des: pchar; len: smallint);
@@ -216,7 +481,7 @@ var
 begin
   len:=0;
   repeat
-    des[len]:=ord(src[len]);
+    des[len]:=byte(src[len]);
     inc(len);
   until (src[len-1] = #0);
 
@@ -224,22 +489,26 @@ begin
 end;
 
 procedure v_opnwk(work_in: psmallint; handle: psmallint; work_out: psmallint);
+var pb: TVDIPB;
 begin
+  pb.control := @_contrl;
   // _intin[0..15] = work_in[0..15];
-  move(work_in^,_intin,16*sizeof(smallint));
+  pb.intin := PVDIIntIn(work_in);
+  pb.ptsin := @_ptsin;
+  // work_out[0..44] = intout[0..44];
+  pb.intout := PVDIIntOut(work_out);
+  // work_out[45..56] = ptsout[0..11];
+  pb.ptsout := PVDIPtsOut(@work_out[45]);
 
   _contrl[0]:=1;
   _contrl[1]:=0;
   _contrl[3]:=16;
+  _contrl[5]:=0;
   _contrl[6]:=0;
 
-  vdi;
+  vdi(@pb);
 
   handle^:=_contrl[6];
-  // work_out[0..44] = intout[0..44];
-  // work_out[45..56] = ptsout[0..11];
-  move(_intout,work_out[0],45*sizeof(smallint));
-  move(_ptsout,work_out[45],12*sizeof(smallint));
 end;
 
 procedure v_clswk(handle: smallint);
@@ -247,70 +516,74 @@ begin
   _contrl[0]:=2;
   _contrl[1]:=0;
   _contrl[3]:=0;
+  _contrl[5]:=0;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_pline(handle: smallint; count: smallint; pxyarray: psmallint);
+procedure v_clrwk(handle: smallint);
 begin
-  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
-  move(pxyarray^,_ptsin,count*2*sizeof(smallint));
-
-  _contrl[0]:=6;
-  _contrl[1]:=count;
+  _contrl[0]:=3;
+  _contrl[1]:=0;
   _contrl[3]:=0;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_gtext(handle: smallint; x: smallint; y: smallint; _string: pchar);
-var
-  i: smallint;
+procedure v_updwk(handle: smallint);
 begin
-  _ptsin[0]:=x;
-  _ptsin[1]:=y;
+  _contrl[0]:=4;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
 
-  i:=0;
-  repeat
-    _intin[i]:=byte(_string[i]);
-    inc(i);
-  until (_string[i-1] = #0);
-  dec(i);
+  vdi;
+end;
 
-  _contrl[0]:=8;
-  _contrl[1]:=1;
-  _contrl[3]:=-i;
+
+procedure vq_chcells(handle: smallint; out rows, columns: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=1;
   _contrl[6]:=handle;
 
   vdi;
+
+  rows:=_intout[0];
+  columns:=_intout[1];
 end;
 
-procedure v_bar(handle: smallint; pxyarray: psmallint);
+procedure v_exit_cur(handle: smallint);
 begin
-  // _ptsin[0..3] = pxyarray[0..3];
-  move(pxyarray^,_ptsin,4*sizeof(smallint));
-  _contrl[0]:=11;
-  _contrl[1]:=2;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
   _contrl[3]:=0;
-  _contrl[5]:=1;
+  _contrl[5]:=2;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_circle (handle: smallint; x: smallint; y: smallint; radius: smallint);
+procedure v_enter_cur(handle: smallint);
 begin
-  _ptsin[0]:=x;
-  _ptsin[1]:=y;
-  _ptsin[2]:=0;
-  _ptsin[3]:=0;
-  _ptsin[4]:=radius;
-  _ptsin[5]:=0;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=3;
+  _contrl[6]:=handle;
 
-  _contrl[0]:=11;
-  _contrl[1]:=3;
+  vdi;
+end;
+
+procedure v_curup(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
   _contrl[3]:=0;
   _contrl[5]:=4;
   _contrl[6]:=handle;
@@ -318,192 +591,2721 @@ begin
   vdi;
 end;
 
-procedure vs_color(handle: smallint; index: smallint; rgb_in: psmallint);
+procedure v_curdown(handle: smallint);
 begin
-  _intin[0]:=index;
-  _intin[1]:=rgb_in[0];
-  _intin[2]:=rgb_in[1];
-  _intin[3]:=rgb_in[2];
-
-  _contrl[0]:=14;
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=4;
+  _contrl[3]:=0;
+  _contrl[5]:=5;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-function vsl_color(handle: smallint; color_index: smallint): smallint;
+procedure v_curright(handle: smallint);
 begin
-  _intin[0]:=color_index;
-
-  _contrl[0]:=17;
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=6;
   _contrl[6]:=handle;
 
   vdi;
+end;
 
-  vsl_color:=_intout[0];
+procedure v_curleft(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=7;
+  _contrl[6]:=handle;
+
+  vdi;
 end;
 
-function vst_color(handle: smallint; color_index: smallint): smallint;
+procedure v_curhome(handle: smallint);
 begin
-  _intin[0]:=color_index;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=8;
+  _contrl[6]:=handle;
 
-  _contrl[0]:=22;
+  vdi;
+end;
+
+procedure v_eeos(handle: smallint);
+begin
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=9;
   _contrl[6]:=handle;
 
   vdi;
+end;
 
-  vst_color:=_intout[0];
+procedure v_eeol(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=10;
+  _contrl[6]:=handle;
+
+  vdi;
 end;
 
-function vsf_color(handle: smallint; color_index: smallint): smallint;
+procedure v_curaddress(handle, row, column: smallint);
 begin
-  _intin[0]:=color_index;
+  _intin[0]:=row;
+  _intin[1]:=column;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=11;
+  _contrl[6]:=handle;
 
-  _contrl[0]:=25;
+  vdi;
+end;
+
+procedure v_curtext(handle: smallint; const outString: String);
+var len: longint;
+begin
+  len:=string_to_vdi(outString, @_intin[0]);
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=1;
+  _contrl[3]:=len;
+  _contrl[5]:=12;
   _contrl[6]:=handle;
 
   vdi;
+end;
 
-  vsf_color:=_intout[0];
+procedure v_rvon(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=13;
+  _contrl[6]:=handle;
+
+  vdi;
 end;
 
-function vswr_mode(handle: smallint; mode: smallint): smallint;
+procedure v_rvoff(handle: smallint);
 begin
-  _intin[0]:=mode;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=14;
+  _contrl[6]:=handle;
 
-  _contrl[0]:=32;
+  vdi;
+end;
+
+procedure vq_curaddress(handle: smallint; out row, column: smallint);
+begin
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=15;
   _contrl[6]:=handle;
 
   vdi;
 
-  vswr_mode:=_intout[0];
+  row:=_intout[0];
+  column:=_intout[1];
 end;
 
-procedure v_opnvwk(work_in: psmallint; handle: psmallint; work_out: psmallint);
+function vq_tabstatus(handle: smallint): smallint;
 begin
-  // _intin[0..10] = work_in[0..10];
-  move(work_in^,_intin,11*sizeof(smallint));
-
-  _contrl[0]:=100;
+  _contrl[0]:=5;
   _contrl[1]:=0;
-  _contrl[3]:=11;
-  _contrl[6]:=handle^;
+  _contrl[3]:=0;
+  _contrl[5]:=16;
+  _contrl[6]:=handle;
 
   vdi;
 
-  handle^:=_contrl[6];
-  // work_out[0..44] = intout[0..44];
-  // work_out[45..56] = ptsout[0..11];
-  move(_intout,work_out[0],45*sizeof(smallint));
-  move(_ptsout,work_out[45],12*sizeof(smallint));
+  vq_tabstatus:=_intout[0];
 end;
 
-procedure v_clsvwk(handle: smallint);
+procedure v_hardcopy(handle: smallint);
 begin
-  _contrl[0]:=101;
+  _contrl[0]:=5;
   _contrl[1]:=0;
   _contrl[3]:=0;
+  _contrl[5]:=17;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_get_pixel(handle: smallint; x: smallint; y: smallint;
-                      pel: psmallint; index: psmallint);
+procedure v_dspcur(handle, x, y: smallint);
 begin
-  _ptsin[0]:=x;
   _ptsin[0]:=x;
   _ptsin[1]:=y;
-  _contrl[0]:=105;
+  _contrl[0]:=5;
   _contrl[1]:=1;
   _contrl[3]:=0;
+  _contrl[5]:=18;
   _contrl[6]:=handle;
 
   vdi;
-
-  pel^:=_intout[0];
-  index^:=_intout[1];
 end;
 
-procedure vro_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB);
+procedure v_rmcur(handle: smallint);
 begin
-  _intin[0]:=vr_mode;
-  // ptsin[0..7] = pxyarray[0..7];
-  move(pxyarray[0],_ptsin[0],8*sizeof(smallint));
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=19;
+  _contrl[6]:=handle;
 
-  PPointer(@_contrl[7])^:=psrcMFDB;
-  PPointer(@_contrl[9])^:=pdesMFDB;
+  vdi;
+end;
 
-  _contrl[0]:=109;
-  _contrl[1]:=4;
-  _contrl[3]:=1;
+procedure v_form_adv(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=20;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure vrt_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB; color_index: psmallint);
+procedure v_output_window(handle: smallint; xyarray: ARRAY_4);
 begin
-  _intin[0]:=vr_mode;
-  _intin[1]:=color_index[0];
-  _intin[2]:=color_index[1];
-  // ptsin[0..7] = pxyarray[0..7];
-  move(pxyarray[0],_ptsin[0],8*sizeof(smallint));
+  _ptsin[0]:=xyarray[0];
+  _ptsin[1]:=xyarray[1];
+  _ptsin[2]:=xyarray[2];
+  _ptsin[3]:=xyarray[3];
+  _contrl[0]:=5;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=21;
+  _contrl[6]:=handle;
 
-  PPointer(@_contrl[7])^:=psrcMFDB;
-  PPointer(@_contrl[9])^:=pdesMFDB;
+  vdi;
+end;
 
-  _contrl[0]:=121;
-  _contrl[1]:=4;
-  _contrl[3]:=3;
+procedure v_clear_disp_list(handle: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=22;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_show_c(handle: smallint; reset: smallint);
+procedure v_bit_image(handle: smallint; const filename: string;
+                aspect, x_scale, y_scale, h_align, v_align: smallint;
+                const xyarray: ARRAY_4);
+var len: longint;
 begin
-  _intin[0]:=reset;
-
-  _contrl[0]:=122;
-  _contrl[1]:=0;
-  _contrl[3]:=1;
+  _ptsin[0]:=xyarray[0];
+  _ptsin[1]:=xyarray[1];
+  _ptsin[2]:=xyarray[2];
+  _ptsin[3]:=xyarray[3];
+  _intin[0]:=aspect;
+  _intin[1]:=x_scale;
+  _intin[2]:=y_scale;
+  _intin[3]:=h_align;
+  _intin[4]:=v_align;
+  len:=string_to_vdi(filename, @_intin[5]);
+  _contrl[0]:=5;
+  _contrl[1]:=2;
+  _contrl[3]:=len+5;
+  _contrl[5]:=23;
   _contrl[6]:=handle;
 
   vdi;
 end;
 
-procedure v_hide_c(handle: smallint);
+procedure vq_scan(handle: smallint; out g_slice, g_page, a_slice, a_page, div_fac: smallint);
 begin
-  _contrl[0]:=123;
+  _contrl[0]:=5;
   _contrl[1]:=0;
   _contrl[3]:=0;
+  _contrl[5]:=24;
   _contrl[6]:=handle;
 
   vdi;
+
+  g_slice:=_intout[0];
+  g_page:=_intout[1];
+  a_slice:=_intout[2];
+  a_page:=_intout[3];
+  div_fac:=_intout[4];
 end;
 
-procedure vs_clip(handle: smallint; clip_flag: smallint; pxyarray: psmallint);
+procedure v_alpha_text(handle: smallint; const outString: String);
+var len: longint;
 begin
-  _intin[0]:=clip_flag;
-  _ptsin[0]:=pxyarray[0];
-  _ptsin[1]:=pxyarray[1];
-  _ptsin[2]:=pxyarray[2];
-  _ptsin[3]:=pxyarray[3];
+  len:=string_to_vdi(outString, @_intin[0]);
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=len;
+  _contrl[5]:=25;
+  _contrl[6]:=handle;
 
-  _contrl[0]:=129;
-  _contrl[1]:=2;
+  vdi;
+end;
+
+function v_orient(handle, orientation: smallint): smallint;
+begin
+  _intin[0]:=orientation;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=27;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_orient:=_intout[0];
+end;
+
+function v_copies(handle, count: smallint): smallint;
+begin
+  _intin[0]:=count;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=28;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_copies:=_intout[0];
+end;
+
+procedure v_tray(handle, tray: smallint);
+begin
+  _intin[0]:=tray;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=29;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function v_page_size(handle, page_id: smallint): smallint;
+begin
+  _intin[0]:=page_id;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=37;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_page_size:=_intout[0];
+end;
+
+function vs_palette(handle, palette: smallint): smallint;
+begin
+  _intin[0]:=palette;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=60;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vs_palette:=_intout[0];
+end;
+
+procedure v_sound(handle, frequency, duration: smallint);
+begin
+  _intin[0]:=frequency;
+  _intin[1]:=duration;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=61;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vs_mute(handle, action: smallint): smallint;
+begin
+  _intin[0]:=action;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=62;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vt_resolution(handle, xres, yres: smallint;
+                        out xset, yset: smallint);
+begin
+  _intin[0]:=xres;
+  _intin[1]:=yres;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=81;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  xset:=_intout[0];
+  yset:=_intout[1];
+end;
+
+procedure vt_axis(handle, xres, yres: smallint;
+                  out xset, yset: smallint);
+begin
+  _intin[0]:=xres;
+  _intin[1]:=yres;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=82;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  xset:=_intout[0];
+  yset:=_intout[1];
+end;
+
+procedure vt_origin(handle, xorigin, yorigin: smallint);
+begin
+  _intin[0]:=xorigin;
+  _intin[1]:=yorigin;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=83;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vq_tdimensions(handle: smallint; out xdimension, ydimension: smallint);
+begin
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=84;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  xdimension:=_intout[0];
+  ydimension:=_intout[1];
+end;
+
+procedure vt_alignment(handle, dx, dy: smallint);
+begin
+  _intin[0]:=dx;
+  _intin[1]:=dy;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=85;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vsp_film(handle, index, lightness: smallint);
+begin
+  _intin[0]:=index;
+  _intin[1]:=lightness;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=91;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vqp_filmname(handle, index: smallint; out name: String): smallint;
+begin
+  _intin[0]:=index;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=92;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vdi_to_string(@_intout[0], name, _contrl[4]);
+  vqp_filmname:=_contrl[4];
+end;
+
+procedure vsc_expose(handle, state: smallint);
+begin
+  _intin[0]:=state;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=93;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_meta_extents(handle, min_x, min_y, max_x, max_y: smallint);
+begin
+  _ptsin[0]:=min_x;
+  _ptsin[1]:=min_y;
+  _ptsin[2]:=max_x;
+  _ptsin[3]:=max_y;
+  _contrl[0]:=5;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=98;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_write_meta(handle, num_intin: smallint; a_intin: Pointer;
+                       num_ptsin: smallint;a_ptsin: Pointer);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := PVDIIntIn(a_intin);
+  pb.ptsin := PVDIPtsIn(a_ptsin);
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+  _contrl[0]:=5;
+  _contrl[1]:=num_ptsin;
+  _contrl[3]:=num_intin;
+  _contrl[5]:=99;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure vm_pagesize(handle, pgwidth, pgheight: smallint);
+begin
+  _intin[0]:=0;
+  _intin[1]:=pgwidth;
+  _intin[2]:=pgheight;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=3;
+  _contrl[5]:=99;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vm_coords(handle, llx, lly, urx, ury: smallint);
+begin
+  _intin[0]:=1;
+  _intin[1]:=llx;
+  _intin[2]:=lly;
+  _intin[3]:=urx;
+  _intin[4]:=ury;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=5;
+  _contrl[5]:=99;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function v_bez_qual(handle, prcnt: smallint; out actual: smallint): smallint;
+begin
+  _intin[0]:=32;
+  _intin[1]:=1;
+  _intin[2]:=prcnt;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=3;
+  _contrl[5]:=99;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  actual:=_intout[0];
+  v_bez_qual:=_intout[0];
+end;
+
+procedure vm_filename(handle: smallint; const filename: String);
+var len: longint;
+begin
+  len:=string_to_vdi(filename, @_intin[0]);
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=len;
+  _contrl[5]:=100;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_offset(handle, offset: smallint);
+begin
+  _intin[0]:=offset;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=101;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_fontinit(handle: smallint; var fh: TFONT_HDR);
+begin
+  PPointer(@_intin[0])^:=@fh;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=102;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_escape2000(handle, times: smallint);
+begin
+  _intin[0]:=times;
+  _contrl[0]:=5;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=2000;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+
+procedure v_pline(handle: smallint; count: smallint; pxyarray: psmallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := PVDIPtsIn(pxyarray);
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=6;
+  _contrl[1]:=count;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure v_pline(handle, count: smallint; const pxyarray: Array of smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := @pxyarray;
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=6;
+  _contrl[1]:=count;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure v_bez(handle, count: smallint; xyarr, bezarr: Pointer;
+                out extent: ARRAY_4;
+                out totpts, totmoves: smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := PVDIIntIn(bezarr);
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := PVDIPtsIn(xyarr);
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=6;
+  _contrl[1]:=count;
+  _contrl[3]:=(count + 1) shr 1;
+  _contrl[5]:=13;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+
+  totpts:=_intout[0];
+  totmoves:=_intout[1];
+  extent[0]:=_ptsout[0];
+  extent[1]:=_ptsout[1];
+  extent[2]:=_ptsout[2];
+  extent[3]:=_ptsout[3];
+end;
+
+procedure v_pmarker(handle, count: smallint; const pxyarray: Array of smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := @pxyarray;
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=7;
+  _contrl[1]:=count;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure v_gtext(handle: smallint; x: smallint; y: smallint; outputstring: pchar);
+var len: smallint;
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+
+  len:=pchar_str_to_vdi(outputstring, @_intin[0]);
+
+  _contrl[0]:=8;
+  _contrl[1]:=1;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_gtext(handle, x, y: smallint; const outputstring: string);
+var len: smallint;
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+
+  len:=string_to_vdi(outputstring, @_intin[0]);
+
+  _contrl[0]:=8;
+  _contrl[1]:=1;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_fillarea(handle, count: smallint; const pxyarray: Array of smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := @pxyarray;
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=9;
+  _contrl[1]:=count;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure v_bez_fill(handle, count: smallint;
+                    xyarr, bezarr: Pointer;
+                    out extent: ARRAY_4;
+                    out totpts, totmoves: smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := PVDIIntIn(bezarr);
+  // _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  pb.ptsin := PVDIPtsIn(xyarr);
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+
+  _contrl[0]:=9;
+  _contrl[1]:=count;
+  _contrl[3]:=(count + 1) shr 1;
+  _contrl[5]:=13;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+
+  totpts:=_intout[0];
+  totmoves:=_intout[1];
+  extent[0]:=_ptsout[0];
+  extent[1]:=_ptsout[1];
+  extent[2]:=_ptsout[2];
+  extent[3]:=_ptsout[3];
+end;
+
+procedure v_bar(handle: smallint; pxyarray: psmallint);
+begin
+  // _ptsin[0..3] = pxyarray[0..3];
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=1;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_bar(handle: smallint; const pxyarray: ARRAY_4);
+begin
+  // _ptsin[0..3] = pxyarray[0..3];
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=1;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_arc(handle, x, y, radius, begang, endang: smallint);
+begin
+  _intin[0]:=begang;
+  _intin[1]:=endang;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=0;
+  _ptsin[3]:=0;
+  _ptsin[4]:=0;
+  _ptsin[5]:=0;
+  _ptsin[6]:=radius;
+  _ptsin[7]:=0;
+  _contrl[0]:=11;
+  _contrl[1]:=4;
+  _contrl[3]:=2;
+  _contrl[5]:=2;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_pieslice(handle, x, y, radius, begang, endang: smallint);
+begin
+  _intin[0]:=begang;
+  _intin[1]:=endang;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=0;
+  _ptsin[3]:=0;
+  _ptsin[4]:=0;
+  _ptsin[5]:=0;
+  _ptsin[6]:=radius;
+  _ptsin[7]:=0;
+  _contrl[0]:=11;
+  _contrl[1]:=4;
+  _contrl[3]:=2;
+  _contrl[5]:=3;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+
+procedure v_circle (handle: smallint; x: smallint; y: smallint; radius: smallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=0;
+  _ptsin[3]:=0;
+  _ptsin[4]:=radius;
+  _ptsin[5]:=0;
+
+  _contrl[0]:=11;
+  _contrl[1]:=3;
+  _contrl[3]:=0;
+  _contrl[5]:=4;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_ellipse(handle, x, y, xradius, yradius: smallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=xradius;
+  _ptsin[3]:=yradius;
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=5;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_ellarc(handle, x, y, xradius, yradius, begang, endang: smallint);
+begin
+  _intin[0]:=begang;
+  _intin[1]:=endang;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=xradius;
+  _ptsin[3]:=yradius;
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=2;
+  _contrl[5]:=6;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_ellpie(handle, x, y, xradius, yradius, begang, endang: smallint);
+begin
+  _intin[0]:=begang;
+  _intin[1]:=endang;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=xradius;
+  _ptsin[3]:=yradius;
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=2;
+  _contrl[5]:=7;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_rbox(handle: smallint; const xyarray: ARRAY_4);
+begin
+  _ptsin[0]:=xyarray[0];
+  _ptsin[1]:=xyarray[1];
+  _ptsin[2]:=xyarray[2];
+  _ptsin[3]:=xyarray[3];
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=8;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_rfbox(handle: smallint; const xyarray: ARRAY_4);
+begin
+  _ptsin[0]:=xyarray[0];
+  _ptsin[1]:=xyarray[1];
+  _ptsin[2]:=xyarray[2];
+  _ptsin[3]:=xyarray[3];
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=9;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_justified(handle, x, y: smallint;
+        const outputstring: string;
+        width, wordspace, charspace: smallint);
+var len: smallint;
+begin
+  {* TODO: handle char_space $8000/$8001 (returns interspace information) *}
+  _intin[0]:=wordspace;
+  _intin[1]:=charspace;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=width;
+  _ptsin[3]:=0;
+
+  len:=string_to_vdi(outputstring, @_intin[2]);
+
+  _contrl[0]:=11;
+  _contrl[1]:=2;
+  _contrl[3]:=len+2;
+  _contrl[4]:=0;
+  _contrl[5]:=11;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function v_bez_on(handle: smallint): smallint;
+begin
+  _contrl[0]:=11;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=13;
+  _contrl[6]:=handle;
+  _intout[0]:=0;
+
+  vdi;
+
+  v_bez_on:=_intout[0];
+end;
+
+procedure v_bez_off(handle: smallint);
+begin
+  _contrl[0]:=11;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=13;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vst_height(handle, height: smallint; out char_width, char_height, cell_width, cell_height: smallint);
+begin
+  _ptsin[0]:=0;
+  _ptsin[1]:=height;
+
+  _contrl[0]:=12;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  char_width:=_ptsout[0];
+  char_height:=_ptsout[1];
+  cell_width:=_ptsout[2];
+  cell_height:=_ptsout[3];
+end;
+
+function vst_rotation(handle, angle: smallint): smallint;
+begin
+  _intin[0]:=angle;
+
+  _contrl[0]:=13;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_rotation:=_intout[0];
+end;
+
+procedure vs_color(handle: smallint; index: smallint; rgb_in: psmallint);
+begin
+  _intin[0]:=index;
+  _intin[1]:=rgb_in[0];
+  _intin[2]:=rgb_in[1];
+  _intin[3]:=rgb_in[2];
+
+  _contrl[0]:=14;
+  _contrl[1]:=0;
+  _contrl[3]:=4;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vs_color(handle, index: smallint; const rgb_in: ARRAY_3);
+begin
+  _intin[0]:=index;
+  _intin[1]:=rgb_in[0];
+  _intin[2]:=rgb_in[1];
+  _intin[3]:=rgb_in[2];
+
+  _contrl[0]:=14;
+  _contrl[1]:=0;
+  _contrl[3]:=4;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vsl_type(handle, style: smallint): smallint;
+begin
+  _intin[0]:=style;
+
+  _contrl[0]:=15;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsl_type:=_intout[0];
+end;
+
+function vsl_width(handle, width: smallint): smallint;
+begin
+  _ptsin[0]:=width;
+  _ptsin[1]:=0;
+
+  _contrl[0]:=16;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsl_width:=_ptsout[0];
+end;
+
+function vsl_color(handle: smallint; color_index: smallint): smallint;
+begin
+  _intin[0]:=color_index;
+
+  _contrl[0]:=17;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsl_color:=_intout[0];
+end;
+
+function vsm_type(handle, symbol: smallint): smallint;
+begin
+  _intin[0]:=symbol;
+
+  _contrl[0]:=18;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsm_type:=_intout[0];
+end;
+
+function vsm_height(handle, height: smallint): smallint;
+begin
+  _ptsin[0]:=0;
+  _ptsin[1]:=height;
+
+  _contrl[0]:=19;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsm_height:=_ptsout[1];
+end;
+
+function vsm_color(handle, color_index: smallint): smallint;
+begin
+  _intin[0]:=color_index;
+
+  _contrl[0]:=20;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsm_color:=_intout[0];
+end;
+
+function vst_font(handle, font: smallint): smallint;
+begin
+  _intin[0]:=font;
+
+  _contrl[0]:=21;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_font:=_intout[0];
+end;
+
+function vst_color(handle: smallint; color_index: smallint): smallint;
+begin
+  _intin[0]:=color_index;
+
+  _contrl[0]:=22;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_color:=_intout[0];
+end;
+
+function vsf_interior(handle, style: smallint): smallint;
+begin
+  _intin[0]:=style;
+
+  _contrl[0]:=23;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsf_interior:=_intout[0];
+end;
+
+function vsf_style(handle, style_index: smallint): smallint;
+begin
+  _intin[0]:=style_index;
+
+  _contrl[0]:=24;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsf_style:=_intout[0];
+end;
+
+function vsf_color(handle: smallint; color_index: smallint): smallint;
+begin
+  _intin[0]:=color_index;
+
+  _contrl[0]:=25;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsf_color:=_intout[0];
+end;
+
+function vq_color(handle, color_index, set_flag: smallint; out rgb: ARRAY_3): smallint;
+begin
+  _intin[0]:=color_index;
+  _intin[1]:=set_flag;
+
+  _contrl[0]:=26;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  rgb[0]:=_intout[1];
+  rgb[1]:=_intout[2];
+  rgb[2]:=_intout[3];
+  vq_color:=_intout[0];
+end;
+
+procedure vrq_locator(handle, x, y: smallint; out xout, yout, term: smallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+
+  _contrl[0]:=28;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  xout:=_ptsout[0];
+  yout:=_ptsout[1];
+  term:=_intout[0];
+end;
+
+function vsm_locator(handle, x, y: smallint; out xout, yout, term: smallint): smallint;
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+
+  _contrl[0]:=28;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  xout:=_ptsout[0];
+  yout:=_ptsout[1];
+  term:=_intout[0];
+
+  vsm_locator:=(_contrl[4] shl 1) or (_contrl[2]);
+end;
+
+procedure vrq_valuator(handle, valuator_in: smallint; out valuator_out, terminator: smallint);
+begin
+  _intin[0]:=valuator_in;
+
+  _contrl[0]:=29;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  valuator_out:=_intout[0];
+  terminator:=_intout[1];
+end;
+
+procedure vsm_valuator(handle, val_in: smallint; out val_out, term, status: smallint);
+begin
+  _intin[0]:=val_in;
+
+  _contrl[0]:=29;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  val_out:=_intout[0];
+  term:=_intout[1];
+  status:=_contrl[4];
+end;
+
+procedure vrq_choice(handle, ch_in: smallint; out ch_out: smallint);
+begin
+  _intin[0]:=ch_in;
+
+  _contrl[0]:=30;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  ch_out:=_intout[0];
+end;
+
+function vsm_choice(handle: smallint; out choice: smallint): smallint;
+begin
+  _intin[0]:=choice;
+
+  _contrl[0]:=30;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  choice:=_intout[0];
+  vsm_choice:=_contrl[4];
+end;
+
+procedure vrq_string(handle, max_length, echo_mode: smallint; const echo_xy: ARRAY_2; out resString: string);
+begin
+  _intin[0]:=max_length;
+  _intin[1]:=echo_mode;
+  _ptsin[0]:=echo_xy[0];
+  _ptsin[1]:=echo_xy[1];
+
+  _contrl[0]:=31;
+  _contrl[1]:=1;
+  _contrl[3]:=2;
+  _contrl[4]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vdi_to_string(@_intout, resString, _contrl[4]);
+end;
+
+function vsm_string(handle, max_length, echo_mode: smallint; const echo_xy: ARRAY_2; out resString: string): smallint;
+begin
+  _intin[0]:=max_length;
+  _intin[1]:=echo_mode;
+  _ptsin[0]:=echo_xy[0];
+  _ptsin[1]:=echo_xy[1];
+
+  _contrl[0]:=31;
+  _contrl[1]:=1;
+  _contrl[3]:=2;
+  _contrl[4]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vdi_to_string(@_intout, resString, _contrl[4]);
+  vsm_string:=_contrl[4];
+end;
+
+function vswr_mode(handle: smallint; mode: smallint): smallint;
+begin
+  _intin[0]:=mode;
+
+  _contrl[0]:=32;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vswr_mode:=_intout[0];
+end;
+
+function vsin_mode(handle, dev_type, mode: smallint): smallint;
+begin
+  _intin[0]:=mode;
+  _intin[1]:=dev_type;
+
+  _contrl[0]:=33;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsin_mode:=_intout[0];
+end;
+
+procedure vql_attributes(handle: smallint; out attrib: ARRAY_4);
+begin
+  _contrl[0]:=35;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  attrib[0]:=_intout[0];
+  attrib[1]:=_intout[1];
+  attrib[2]:=_intout[2];
+  attrib[3]:=_ptsout[0];
+end;
+
+procedure vql_attributes(handle: smallint; out attrib: ARRAY_6);
+begin
+  _contrl[0]:=35;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  attrib[0]:=_intout[0];
+  attrib[1]:=_intout[1];
+  attrib[2]:=_intout[2];
+  attrib[3]:=_ptsout[0];
+  {* TOS/EmuTOS do not return the line end styles in intout[3/4] *}
+  if (_contrl[4] >= 5) then
+    begin
+      attrib[4]:=_intout[3];
+      attrib[5]:=_intout[4];
+    end else begin
+      attrib[4]:=0;
+      attrib[5]:=0;
+    end;
+end;
+
+procedure vqm_attributes(handle: smallint; out attrib: ARRAY_4);
+begin
+  _contrl[0]:=36;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  attrib[0]:=_intout[0];
+  attrib[1]:=_intout[1];
+  attrib[2]:=_intout[2];
+  attrib[3]:=_ptsout[0];
+end;
+
+procedure vqf_attributes(handle: smallint; out attrib: ARRAY_5);
+begin
+  _contrl[0]:=37;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  attrib[0]:=_intout[0];
+  attrib[1]:=_intout[1];
+  attrib[2]:=_intout[2];
+  attrib[3]:=_intout[3];
+  attrib[4]:=_intout[4];
+end;
+
+procedure vqt_attributes(handle: smallint; out attrib: ARRAY_10);
+begin
+  _contrl[0]:=38;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  attrib[0]:=_intout[0];
+  attrib[1]:=_intout[1];
+  attrib[2]:=_intout[2];
+  attrib[3]:=_intout[3];
+  attrib[4]:=_intout[4];
+  attrib[5]:=_intout[5];
+  attrib[6]:=_ptsout[0];
+  attrib[7]:=_ptsout[1];
+  attrib[8]:=_ptsout[2];
+  attrib[9]:=_ptsout[3];
+end;
+
+procedure vst_alignment(handle, hor_in, vert_in: smallint; out hor_out, vert_out: smallint);
+begin
+  _intin[0]:=hor_in;
+  _intin[1]:=vert_in;
+
+  _contrl[0]:=39;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  hor_out:=_intout[0];
+  vert_out:=_intout[1];
+end;
+
+procedure v_opnvwk(work_in: psmallint; handle: psmallint; work_out: psmallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  // _intin[0..10] = work_in[0..10];
+  pb.intin := PVDIIntIn(work_in);
+  pb.ptsin := @_ptsin;
+  // work_out[0..44] = intout[0..44];
+  pb.intout := PVDIIntOut(work_out);
+  // work_out[45..56] = ptsout[0..11];
+  pb.ptsout := PVDIPtsOut(@work_out[45]);
+
+  _contrl[0]:=100;
+  _contrl[1]:=0;
+  _contrl[3]:=11;
+  _contrl[5]:=0;
+  _contrl[6]:=handle^;
+
+  vdi(@pb);
+
+  handle^:=_contrl[6];
+end;
+
+procedure v_clsvwk(handle: smallint);
+begin
+  _contrl[0]:=101;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vq_extnd(handle, owflag: smallint; WorkOut: psmallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  pb.ptsin := @_ptsin;
+  // work_out[0..44] = intout[0..44];
+  pb.intout := PVDIIntOut(workout);
+  // work_out[45..56] = ptsout[0..11];
+  pb.ptsout := PVDIPtsOut(@workout[45]);
+
+  _intin[0]:=owflag;
+
+  _contrl[0]:=102;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+
+procedure vq_scrninfo(handle: smallint; out WorkOut: ARRAY_273);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  pb.ptsin := @_ptsin;
+  pb.intout := @workout;
+  pb.ptsout := @_ptsout;
+
+  _intin[0]:=2;
+
+  _contrl[0]:=102;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=1;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure v_contourfill(handle, x, y, index: smallint);
+begin
+  _intin[0]:=index;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _contrl[0]:=103;
+  _contrl[1]:=1;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vsf_perimeter(handle, per_vis: smallint): smallint;
+begin
+  _intin[0]:=per_vis;
+  _contrl[0]:=104;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vsf_perimeter:=_intout[0];
+end;
+
+procedure v_get_pixel(handle: smallint; x: smallint; y: smallint;
+                      pel: psmallint; index: psmallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _contrl[0]:=105;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  pel^:=_intout[0];
+  index^:=_intout[1];
+end;
+
+procedure v_get_pixel(handle, x, y: smallint; out pel, index: smallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _contrl[0]:=105;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  pel:=_intout[0];
+  index:=_intout[1];
+end;
+
+function vst_effects(handle, effect: smallint): smallint;
+begin
+  _intin[0]:=effect;
+  _contrl[0]:=106;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_effects:=_intout[0];
+end;
+
+function vst_point(handle, point: smallint; out char_width, char_height, cell_width, cell_height: smallint): smallint;
+begin
+  _intin[0]:=point;
+  _contrl[0]:=107;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  char_width:=_ptsout[0];
+  char_height:=_ptsout[1];
+  cell_width:=_ptsout[2];
+  cell_height:=_ptsout[3];
+end;
+
+procedure vsl_ends(handle, beg_style, end_style: smallint);
+begin
+  _intin[0]:=beg_style;
+  _intin[1]:=end_style;
+  _contrl[0]:=108;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vro_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB);
+begin
+  _intin[0]:=vr_mode;
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+  _ptsin[4]:=pxyarray[4];
+  _ptsin[5]:=pxyarray[5];
+  _ptsin[6]:=pxyarray[6];
+  _ptsin[7]:=pxyarray[7];
+
+  PPointer(@_contrl[7])^:=psrcMFDB;
+  PPointer(@_contrl[9])^:=pdesMFDB;
+
+  _contrl[0]:=109;
+  _contrl[1]:=4;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vr_trnfm(handle: smallint; psrcMFDB, pdesMFDB: PMFDB);
+begin
+  PPointer(@_contrl[7])^:=psrcMFDB;
+  PPointer(@_contrl[9])^:=pdesMFDB;
+
+  _contrl[0]:=110;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vr_trnfm(handle: smallint; const psrcMFDB, pdesMFDB: TMFDB);
+begin
+  PPointer(@_contrl[7])^:=@psrcMFDB;
+  PPointer(@_contrl[9])^:=@pdesMFDB;
+
+  _contrl[0]:=110;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vsc_form(handle: smallint; pcur_form: PMFORM);
+var pb: TVDIPB;
+begin
+  {* TODO: NVDI also returns current form in intout *}
+  pb.control := @_contrl;
+  pb.intin := PVDIIntIn(pcur_form);
+  pb.ptsin := @_ptsin;
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+  _contrl[0]:=111;
+  _contrl[1]:=0;
+  _contrl[3]:=37;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure vsf_udpat(handle: smallint; pfill_pat: Pointer; planes: smallint);
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := PVDIIntIn(pfill_pat);
+  pb.ptsin := @_ptsin;
+  pb.intout := @_intout;
+  pb.ptsout := @_ptsout;
+  _contrl[0]:=112;
+  _contrl[1]:=0;
+  _contrl[3]:=planes*16;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure vsl_udsty(handle, pattern: smallint);
+begin
+  _intin[0]:=pattern;
+  _contrl[0]:=113;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vr_recfl(handle: smallint; const pxyarray: ARRAY_4);
+begin
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+  _contrl[0]:=114;
+  _contrl[1]:=2;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vqin_mode(handle, dev_type: smallint; out input_mode: smallint);
+begin
+  _intin[0]:=dev_type;
+  _contrl[0]:=115;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  input_mode:=_intout[0];
+end;
+
+procedure vqt_extent(handle: smallint; calcString: pchar; extent: psmallint);
+var len: smallint;
+begin
+  len:=pchar_str_to_vdi(calcstring, @_intin[0]);
+  _contrl[0]:=116;
+  _contrl[1]:=0;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  extent[0]:=_ptsout[0];
+  extent[1]:=_ptsout[1];
+  extent[2]:=_ptsout[2];
+  extent[3]:=_ptsout[3];
+  extent[4]:=_ptsout[4];
+  extent[5]:=_ptsout[5];
+  extent[6]:=_ptsout[6];
+  extent[7]:=_ptsout[7];
+end;
+
+function vqt_width(handle, character: smallint; out cell_width, left_delta, right_delta: smallint): smallint;
+begin
+  _intin[0]:=character;
+  _contrl[0]:=117;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  cell_width:=_ptsout[0];
+  left_delta:=_ptsout[2];
+  right_delta:=_ptsout[4];
+  vqt_width:=_intout[0];
+end;
+
+procedure vex_timv(handle: smallint; tim_addr: Pointer; out otim_addr: Pointer; out tim_conv: smallint);
+begin
+  _contrl[0]:=118;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+  PPointer(@_contrl[7])^:=tim_addr;
+
+  vdi;
+
+  otim_addr:=PPointer(@_contrl[9])^;
+  tim_conv:=_intout[0];
+end;
+
+function vst_load_fonts(handle, select: smallint): smallint;
+begin
+  _intin[0]:=select;
+
+  _contrl[0]:=119;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_load_fonts:=_intout[0];
+end;
+
+procedure vst_unload_fonts(handle, select: smallint);
+begin
+  _intin[0]:=select;
+
+  _contrl[0]:=120;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vrt_cpyfm(handle: smallint; vr_mode: smallint; pxyarray: psmallint; psrcMFDB: PMFDB; pdesMFDB: PMFDB; color_index: psmallint);
+begin
+  _intin[0]:=vr_mode;
+  _intin[1]:=color_index[0];
+  _intin[2]:=color_index[1];
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+  _ptsin[4]:=pxyarray[4];
+  _ptsin[5]:=pxyarray[5];
+  _ptsin[6]:=pxyarray[6];
+  _ptsin[7]:=pxyarray[7];
+
+  PPointer(@_contrl[7])^:=psrcMFDB;
+  PPointer(@_contrl[9])^:=pdesMFDB;
+
+  _contrl[0]:=121;
+  _contrl[1]:=4;
+  _contrl[3]:=3;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_show_c(handle: smallint; reset: smallint);
+begin
+  _intin[0]:=reset;
+
+  _contrl[0]:=122;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_hide_c(handle: smallint);
+begin
+  _contrl[0]:=123;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vq_mouse(handle: smallint; out pstatus, x, y: smallint);
+begin
+  _contrl[0]:=124;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  pstatus:=_intout[0];
+  x:=_ptsout[0];
+  y:=_ptsout[1];
+end;
+
+procedure vex_butv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+begin
+  _contrl[0]:=125;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+  PPointer(@_contrl[7])^:=pusrcode;
+
+  vdi;
+
+  psavcode:=PPointer(@_contrl[9])^;
+end;
+
+procedure vex_motv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+begin
+  _contrl[0]:=126;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+  PPointer(@_contrl[7])^:=pusrcode;
+
+  vdi;
+
+  psavcode:=PPointer(@_contrl[9])^;
+end;
+
+procedure vex_curv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+begin
+  _contrl[0]:=127;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+  PPointer(@_contrl[7])^:=pusrcode;
+
+  vdi;
+
+  psavcode:=PPointer(@_contrl[9])^;
+end;
+
+procedure vq_key_s(handle: smallint; out pstatus: smallint);
+begin
+  _contrl[0]:=128;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  pstatus:=_intout[0];
+end;
+
+procedure vs_clip(handle: smallint; clip_flag: smallint; pxyarray: psmallint);
+begin
+  _intin[0]:=clip_flag;
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+
+  _contrl[0]:=129;
+  _contrl[1]:=2;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vs_clip(handle, clip_flag: smallint; const pxyarray: ARRAY_4);
+begin
+  _intin[0]:=clip_flag;
+  _ptsin[0]:=pxyarray[0];
+  _ptsin[1]:=pxyarray[1];
+  _ptsin[2]:=pxyarray[2];
+  _ptsin[3]:=pxyarray[3];
+
+  _contrl[0]:=129;
+  _contrl[1]:=2;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vs_clip_off(handle: smallint);
+begin
+  _intin[0]:=0;
+  _ptsin[0]:=0;
+  _ptsin[1]:=0;
+  _ptsin[2]:=0;
+  _ptsin[3]:=0;
+
+  _contrl[0]:=129;
+  _contrl[1]:=2;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vqt_name(handle, element_num: smallint; out name: String33): smallint;
+begin
+  _intin[0]:=element_num;
+
+  _contrl[0]:=130;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vdi_to_string(@_intout[1], name, _contrl[4] - 1);
+
+  vqt_name:=_intout[0];
+end;
+
+procedure vqt_fontinfo(handle: smallint;
+        out minADE, maxADE: smallint;
+        out distances: ARRAY_5;
+        out maxwidth: smallint;
+        out effects: ARRAY_3);
+begin
+  _contrl[0]:=131;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  minADE:=_intout[0];
+  maxADE:=_intout[1];
+  maxwidth:=_ptsout[0];
+  distances[0]:=_ptsout[1];
+  distances[1]:=_ptsout[3];
+  distances[2]:=_ptsout[5];
+  distances[3]:=_ptsout[7];
+  distances[4]:=_ptsout[9];
+  effects[0]:=_ptsout[2];
+  effects[1]:=_ptsout[4];
+  effects[2]:=_ptsout[6];
+end;
+
+procedure vqt_justified(handle, x, y: smallint; const outString: String;
+            length, word_space, char_space: smallint;
+            offsets: Pointer);
+var len: smallint;
+var pb: TVDIPB;
+begin
+  pb.control := @_contrl;
+  pb.intin := @_intin;
+  pb.ptsin := @_ptsin;
+  pb.intout := @_intout;
+  pb.ptsout := PVDIPtsOut(offsets);
+  _intin[0]:=word_space;
+  _intin[1]:=char_space;
+  len:=string_to_vdi(outstring, @_intin[2]);
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _ptsin[2]:=length;
+  _ptsin[3]:=0;
+  _contrl[0]:=132;
+  _contrl[1]:=2;
+  _contrl[3]:=len+2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi(@pb);
+end;
+
+procedure vex_wheelv(handle: smallint; pusrcode: Pointer; out psavcode: Pointer);
+begin
+  _contrl[0]:=134;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+  PPointer(@_contrl[7])^:=pusrcode;
+
+  vdi;
+
+  psavcode:=PPointer(@_contrl[9])^;
+end;
+
+
+procedure vst_width(handle, width: smallint; out char_width, char_height, cell_width, cell_height: smallint);
+begin
+  _intin[0]:=width;
+  _contrl[0]:=231;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  char_width:=_intout[0];
+  char_height:=_intout[1];
+  cell_width:=_intout[2];
+  cell_height:=_intout[3];
+end;
+
+procedure vqt_fontheader(handle: smallint; buffer: Pointer;
+                         out pathname: String);
+begin
+  Ppointer(@_intin[0])^:=buffer;
+  _contrl[0]:=232;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vdi_to_string(@_intout[0], pathname, _contrl[4]);
+end;
+
+procedure vqt_trackkern(handle: smallint; out x, y: fix31);
+begin
+  _contrl[0]:=234;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  x:=PLongint(@_intout[0])^;
+  y:=PLongint(@_intout[2])^;
+end;
+
+procedure vqt_pairkern(handle, ch1, ch2: smallint; out x, y: fix31);
+begin
+  _intin[0]:=ch1;
+  _intin[2]:=ch2;
+  _contrl[0]:=235;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  x:=PLongint(@_intout[0])^;
+  y:=PLongint(@_intout[2])^;
+end;
+
+
+procedure vst_charmap(handle, mode: smallint);
+begin
+  _intin[0]:=mode;
+  _contrl[0]:=236;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vst_map_mode(handle, mode: smallint): smallint;
+begin
+  _intin[0]:=mode;
+  _intin[1]:=1;
+  _contrl[0]:=236;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  vst_map_mode:=_intout[0];
+end;
+
+procedure vst_kern(handle, tmode, pmode: smallint; out tracks, pairs: smallint);
+begin
+  _intin[0]:=tmode;
+  _intin[1]:=pmode;
+  _contrl[0]:=237;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  tracks:=_intout[0];
+  pairs:=_intout[0];
+end;
+
+procedure vst_track_offset(handle: smallint; offset: fix31; pairmode: smallint; out tracks, pairs: smallint);
+begin
+  _intin[0]:=255;
+  _intin[1]:=pairmode;
+  PLongint(@_intin[2])^:=offset;
+  _contrl[0]:=237;
+  _contrl[1]:=0;
+  _contrl[3]:=4;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  tracks:=_intout[0];
+  pairs:=_intout[0];
+end;
+
+procedure v_getbitmap_info(handle, ch: smallint;
+                           out advx, advy, xoff, yoff: fix31;
+                           out width, height: smallint;
+                           out bitmap: pointer);
+begin
+  _intin[0]:=ch;
+  _contrl[0]:=239;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  width:=_intout[0];
+  height:=_intout[1];
+  advx:=PLongint(@_intout[2])^;
+  advy:=PLongint(@_intout[4])^;
+  xoff:=PLongint(@_intout[6])^;
+  yoff:=PLongint(@_intout[8])^;
+  if (bitmap <> nil) then
+    bitmap:=PPointer(@_intout[10])^;
+end;
+
+
+procedure v_ftext(handle, x, y: smallint; const str: String);
+var len: longint;
+begin
+  len:=string_to_vdi(str, @_intin[0]);
+  _ptsin[0]:=x;
+  _ptsin[0]:=y;
+  _contrl[0]:=241;
+  _contrl[1]:=1;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_ftext_offset(handle, x, y: smallint;
+                         const outputstring: string;
+                         const offset: Array of smallint);
+var i, len: longint;
+    src, dst: psmallint;
+begin
+  len:=string_to_vdi(outputstring, @_intin[0]);
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  src:=offset;
+  dst:=@_ptsin[2];
+  for i:=0 to len-1 do
+    begin
+      dst^:=src^;
+      inc(dst);
+      inc(src);
+      dst^:=src^;
+      inc(dst);
+      inc(src);
+    end;
+  _contrl[0]:=241;
+  _contrl[1]:=len+1;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_killoutline(handle: smallint; component: Pointer);
+begin
+  PPointer(@_intin[0])^:=component;
+  _contrl[0]:=242;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_getoutline(handle, ch: smallint;
+                       const xyarray: Array of smallint;
+                       const bezarray: Array of ShortInt;
+                       maxverts: smallint;
+                       out numverts: smallint);
+begin
+  _intin[0]:=ch;
+  _intin[1]:=maxverts;
+  PPointer(@_intin[2])^:=@xyarray;
+  PPointer(@_intin[4])^:=@bezarray;
+  _contrl[0]:=243;
+  _contrl[1]:=0;
+  _contrl[3]:=6;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  numverts:=_intout[0];
+end;
+
+procedure vst_scratch(handle, mode: smallint);
+begin
+  _intin[0]:=mode;
+  _contrl[0]:=244;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure vst_error(handle, mode: smallint; out errorvar: smallint);
+begin
+  _intin[0]:=mode;
+  PPointer(@_intin[1])^:=@errorvar;
+  _contrl[0]:=245;
+  _contrl[1]:=0;
+  _contrl[3]:=3;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+function vst_arbpt(handle, point: smallint;
+                   out chwd, chht, cellwd, cellht: smallint): smallint;
+begin
+  _intin[0]:=point;
+  _contrl[0]:=246;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  chwd:=_ptsout[0];
+  chht:=_ptsout[1];
+  cellwd:=_ptsout[2];
+  cellht:=_ptsout[3];
+
+  vst_arbpt:=_intout[0];
+end;
+
+function vst_arbpt32(handle: smallint; point: fix31;
+                     out chwd, chht, cellwd, cellht: smallint): fix31;
+begin
+  PLongint(@_intin[0])^:=point;
+  _contrl[0]:=246;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  chwd:=_ptsout[0];
+  chht:=_ptsout[1];
+  cellwd:=_ptsout[2];
+  cellht:=_ptsout[3];
+
+  vst_arbpt32:=PLongint(@_intout[0])^;
+end;
+
+procedure vqt_advance(handle, ch: smallint; out advx, advy, remx, remy: smallint);
+begin
+  _intin[0]:=ch;
+  _contrl[0]:=247;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  advx:=_ptsout[0];
+  advy:=_ptsout[1];
+  remx:=_ptsout[2];
+  remy:=_ptsout[3];
+end;
+
+procedure vqt_advance32(handle, ch: smallint; out advx, advy: fix31);
+begin
+  _intin[0]:=ch;
+  _contrl[0]:=247;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  advx:=PLongint(@_ptsout[4])^;
+  advy:=PLongint(@_ptsout[6])^;
+end;
+
+function vq_devinfo(handle, devnum: smallint;
+                      out devexists: smallint;
+                      out filename: String;
+                      out devicename: String): smallint;
+var i, len: smallint;
+    ch: char;
+begin
+  _intin[0]:=devnum;
+  _contrl[0]:=248;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+  if (_contrl[4] = 0) or (_intout[4] = 0) then
+    begin
+      devexists:= 0;
+      filename := '';
+      devicename := '';
+      vq_devinfo:=0;
+    end
+  else
+    begin
+      (* here, the driver exists *)
+      devexists:=1;
+      (* set the filename. The value in vdi_intout may be "DRIVER.SYS"
+       * or "DRIVER   SYS". vdi_intout is not a nul-terminated string.
+       * In both cases, this binding returns a valid filename: "DRIVER.SYS"
+       * with a null-character to ended the string.
+       *)
+      len := 0;
+      for i:=0 to _contrl[4]-1 do
+        begin
+          ch := chr(_intout[i]);
+          inc(len);
+          filename[len]:=ch;
+          if (ch = ' ') and (chr(_intout[i+1]) <> ' ') then
+            begin
+              inc(len);
+              filename[len]:='.';
+            end
+          else
+            begin
+              inc(len);
+              filename[len]:=ch;
+            end
+        end;
+      setlength(filename, len);
+
+      (* device name in ptsout is a C-String, (a nul-terminated string with 8bits per characters)
+       * each short value (vdi_ptsout[x]) contains 2 characters.
+       * When ptsout contains a device name, NVDI/SpeedoGDOS seems to always write the value "13"
+       * in vdi_control[1] (hey! this should be a read only value from the VDI point of view!!!),
+       * and SpeedoGDOS 5 may set vdi_control[2] == 1 (intead of the size of vdi_ptsout, including
+       * the device_name). It's seems that this value "13" (written in vdi_control[1]) has missed
+       * its target (vdi_control[2]). So, here is a workaround:
+       *)
+       if (_contrl[2] = 1) and (_contrl[1] > 0) then
+         len := _contrl[1] * 2
+       else
+         len := (_contrl[2] - 1) * 2;
+       setlength(devicename, len);
+       move(_ptsout[1], devicename[1], len);
+       vq_devinfo:=_intout[0];;
+    end;
+
+end;
+
+procedure vqt_devinfo(handle, devnum: smallint;
+                      out dev_busy: smallint;
+                      out filename: String;
+                      out devicename: String);
+var dummy: smallint;
+begin
+  dev_busy:=vq_devinfo(handle, devnum, dummy, filename, devicename);
+end;
+
+function v_savecache(handle: smallint; const filename: String): smallint;
+var len: longint;
+begin
+  len:=string_to_vdi(filename, @_intin[0]);
+  _contrl[0]:=249;
+  _contrl[1]:=0;
+  _contrl[3]:=len;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_savecache:=_intout[0];
+end;
+
+function v_loadcache(handle: smallint; const filename: String; mode: smallint): smallint;
+var len: longint;
+begin
+  len:=string_to_vdi(filename, @_intin[1]);
+  _intin[0]:=mode;
+  _contrl[0]:=250;
+  _contrl[1]:=0;
+  _contrl[3]:=len+1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_loadcache:=_intout[0];
+end;
+
+function v_flushcache(handle: smallint): smallint;
+begin
+  _contrl[0]:=251;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  v_flushcache:=_intout[0];
+end;
+
+function vst_setsize(handle, point: smallint;
+                     out chwd, chht, cellwd, cellht: smallint): smallint;
+begin
+  _intin[0]:=point;
+  _contrl[0]:=252;
+  _contrl[1]:=0;
+  _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  chwd:=_ptsout[0];
+  chht:=_ptsout[1];
+  cellwd:=_ptsout[2];
+  cellht:=_ptsout[3];
+  vst_setsize:=_intout[0];
+end;
+
+function  vst_setsize32(handle: smallint; point: fix31;
+                        out chwd, chht, cellwd, cellht: smallint): fix31;
+begin
+  PLongint(@_intin[0])^:=point;
+  _contrl[0]:=252;
+  _contrl[1]:=0;
+  _contrl[3]:=2;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  chwd:=_ptsout[0];
+  chht:=_ptsout[1];
+  cellwd:=_ptsout[2];
+  cellht:=_ptsout[3];
+  vst_setsize32:=PLongint(@_intout[0])^;
+end;
+
+function vst_skew(handle, skew: smallint): smallint;
+begin
+  _intin[0]:=skew;
+  _contrl[0]:=253;
+  _contrl[1]:=0;
   _contrl[3]:=1;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+  vst_skew:=_intout[0];
+end;
+
+procedure vqt_get_table(handle: smallint; out map: Pointer);
+begin
+  _contrl[0]:=254;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  map:=PPointer(@_intout[0])^;
+end;
+
+procedure vqt_cachesize(handle, which_cache: smallint; out size: LongInt);
+begin
+  _intin[0]:=which_cache;
+  _contrl[0]:=255;
+  _contrl[1]:=0;
+  _contrl[3]:=0;
+  _contrl[5]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  size:=PLongint(@_intout[0])^;
+end;
+
+
+procedure v_set_app_buff(handle: smallint; address: Pointer; nparagraphs: smallint);
+begin
+  PPointer(@_intin[0])^:=address;
+  _intin[2]:=nparagraphs;
+  _contrl[0]:=-1;
+  _contrl[1]:=0;
+  _contrl[3]:=3;
+  _contrl[5]:=6;
   _contrl[6]:=handle;
 
   vdi;

packages/tosunits/src/vditypes.inc

@@ -0,0 +1,338 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 Thorsten Otto
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{* return values for vq_vgdos() inquiry *}
+const
+    GDOS_NONE       = -2;           (* no GDOS installed           *)
+    GDOS_FSM        = $5F46534D;    (* '_FSM' - FSMGDOS installed  *)
+    GDOS_FNT        = $5F464E54;    (* '_FNT' - FONTGDOS installed *)
+    GDOS_ATARI      = $0007E88A;    (* GDOS 1.1 von Atari Corp.    *)
+    GDOS_AMC        = $0007E864;    (* AMCGDos von Arnd Beissner   *)
+    GDOS_AMCLIGHT   = $0007E8BA;    (* GEMINI-Spezial-GDos von Arnd Beissner *)
+    GDOS_NVDI       = $00000000;    (* NVDI von Bela GmbH *)
+    GDOS_TTF        = $3e5d0957;    (* TTF-GDOS *)
+
+const
+{* vst_alignment modes *}
+    TA_LEFT         = 0;
+    TA_CENTER       = 1;
+    TA_RIGHT        = 2;
+    TA_BASELINE     = 0;
+    TA_HALF         = 1;
+    TA_ASCENT       = 2;
+    TA_BOTTOM       = 3;
+    TA_DESCENT      = 4;
+    TA_TOP          = 5;
+
+{* gsx modes *}
+    MD_REPLACE      = 1;
+    MD_TRANS        = 2;
+    MD_XOR          = 3;
+    MD_ERASE        = 4;
+
+{$IFNDEF IP_HOLLOW_defined}
+{* patterns (also in AES) *}
+    IP_HOLLOW       = 0;
+    IP_1PATT        = 1;
+    IP_2PATT        = 2;
+    IP_3PATT        = 3;
+    IP_4PATT        = 4;
+    IP_5PATT        = 5;
+    IP_6PATT        = 6;
+    IP_SOLID        = 7;
+{$DEFINE IP_HOLLOW_defined}
+{$ENDIF}
+
+{* gsx styles *}
+    FIS_HOLLOW      = 0;
+    FIS_SOLID       = 1;
+    FIS_PATTERN     = 2;
+    FIS_HATCH       = 3;
+    FIS_USER        = 4;
+
+{* polymarker types *}
+    MT_DOT          = 1;
+    MT_PLUS         = 2;
+    MT_ASTERISK     = 3;
+    MT_SQUARE       = 4;
+    MT_DCROSS       = 5;
+    MT_DIAMOND      = 6;
+
+{* linetypes *}
+    LT_SOLID        = 1;
+    LT_LONGDASH     = 2;
+    LT_DOTTED       = 3;
+    LT_DASHDOT      = 4;
+    LT_DASHED       = 5;
+    LT_DASHDOTDOT   = 6;
+    LT_USERDEF      = 7;
+
+{* line ends *}
+    LE_SQUARED      = 0;
+    LE_ARROWED      = 1;
+    LE_ROUNDED      = 2;
+
+{* text effects *}
+    TF_NORMAL       = 0;
+    TF_THICKENED    = 1;
+    TF_LIGHTENED    = 2;
+    TF_SLANTED      = 4;
+    TF_UNDERLINED   = 8;
+    TF_OUTLINED     = 16;
+    TF_SHADOWED     = 32;
+
+{* bit blt rules *}
+    ALL_WHITE       = 0;
+    S_AND_D         = 1;
+    S_AND_NOTD      = 2;
+    S_ONLY          = 3;
+    NOTS_AND_D      = 4;
+    D_ONLY          = 5;
+    S_XOR_D         = 6;
+    S_OR_D          = 7;
+    NOT_SORD        = 8;
+    NOT_SXORD       = 9;
+    D_INVERT        = 10;
+    S_OR_NOTD       = 11;
+    NOT_D           = 12;
+    NOTS_OR_D       = 13;
+    NOT_SANDD       = 14;
+    ALL_BLACK       = 15;
+
+{* input mode *}
+    MODE_REQUEST    = 1;
+    MODE_SAMPLE     = 2;
+
+{* vqin_mode & vsin_mode modes *}
+    DEV_LOCATOR     = 1;
+    DEV_VALUATOR    = 2;
+    DEV_CHOICE      = 3;
+    DEV_STRING      = 4;
+
+{* v_bez modes *}
+    BEZ_BEZIER      = $01;
+    BEZ_POLYLINE    = $00;
+    BEZ_NODRAW      = $02;
+
+{* v_bit_image modes *}
+    IMAGE_LEFT      = 0;
+    IMAGE_CENTER    = 1;
+    IMAGE_RIGHT     = 2;
+    IMAGE_TOP       = 0;
+    IMAGE_BOTTOM    = 2;
+
+{* vq_color modes *}
+    COLOR_REQUESTED     = 0;
+    COLOR_ACTUAL        = 1;
+
+{* vst_charmap modes *}
+    MAP_BITSTREAM   = 0;
+    MAP_ATARI       = 1;
+    MAP_UNICODE     = 2; {* for vst_map_mode, NVDI 4 *}
+
+{* vst_kern tmodes *}
+    TRACK_NONE      = 0;
+    TRACK_NORMAL    = 1;
+    TRACK_TIGHT     = 2;
+    TRACK_VERYTIGHT = 3;
+
+{* vst_kern pmodes *}
+    PAIR_OFF        = 0;
+    PAIR_ON         = 1;
+
+{* vst_scratch modes *}
+    SCRATCH_BOTH        = 0;
+    SCRATCH_BITMAP      = 1;
+    SCRATCH_NONE        = 2;
+
+{* definitions for vs_mute *}
+    MUTE_RETURN     = -1;
+    MUTE_ENABLE      = 0;
+    MUTE_DISABLE     = 1;
+
+{* definitions for v_orient *}
+    OR_PORTRAIT      = 0;
+    OR_LANDSCAPE     = 1;
+
+{* definitions for v_tray *}
+    TRAY_MANUAL     = -1;
+    TRAY_DEFAULT     = 0;
+    TRAY_FIRSTOPT    = 1;
+
+{* definitions for v_xbit_image *}
+    XBIT_FRACT       = 0;
+    XBIT_INTEGER     = 1;
+
+    XBIT_LEFT        = 0;
+    XBIT_CENTER      = 1;
+    XBIT_RIGHT       = 2;
+
+    XBIT_TOP         = 0;
+    XBIT_MIDDLE      = 1;
+    XBIT_BOTTOM      = 2;
+
+
+type
+  PCOLOR_RGB = ^TCOLOR_RGB;
+  TCOLOR_RGB = record
+      reserved: word;     {* Set to 0 or the index of the entry *}
+      red: word;          {* Red:   0<->65535 *}
+      green: word;        {* Green: 0<->65535 *}
+      blue: word;         {* Blue:  0<->65535 *}
+  end;
+
+{$WARNING type TCOLOR_ENTRY is incomplete}
+type
+  TCOLOR_ENTRY = record
+    case byte of
+      0: ( rgb: TCOLOR_RGB; );
+      1: ( cymk: array[0..1] of longint; ); // dummy
+  end;
+
+type
+  PCOLOR_TAB = ^TCOLOR_TAB;
+  TCOLOR_TAB = record             {* Colour table                    *}
+      magic: array[0..3] of char; {* 'ctab'                          *}
+      length: longint;
+      format: longint;            {* Format (0)                      *}
+      reserved: longint;          {* Reserved, set to 0              *}
+      map_id: longint;            {* Colour table ID                 *}
+      color_space: longint;       {* Colour space (at present only
+                                     CSPACE_RGB)                     *}
+      flags: longint;             {* VDI-internal flags, set to 0    *}
+      no_colors: longint;         {* Number of colour entries        *}
+      reserved1: longint;         {* Reserved, must be 0             *}
+      reserved2: longint;         {* Reserved, must be 0             *}
+      reserved3: longint;         {* Reserved, must be 0             *}
+      reserved4: longint;         {* Reserved, must be 0             *}
+      colors: array[0..0] of TCOLOR_ENTRY; { repeated no_colors times }
+  end;
+
+type
+  PPOINT16 = ^TPOINT16;
+  TPOINT16 = record               {* Point for 16-bit coordinates *}
+      x: smallint;
+      y: smallint;
+  end;
+
+type
+  PPOINT32 = ^TPOINT32;
+  TPOINT32 = record               {* Point for 32-bit coordinates *}
+      x: longint;
+      y: longint;
+  end;
+
+type
+  PRECT16 = ^TRECT16;
+  TRECT16 = record                {* Rectangle for 16-bit coordinates *}
+      x1: smallint;
+      y1: smallint;
+      x2: smallint;
+      y2: smallint;
+  end;
+
+type
+  PRECT32 = ^TRECT32;
+  TRECT32 = record                {* Rectangle for 32-bit coordinates *}
+      x1: longint;
+      y1: longint;
+      x2: longint;
+      y2: longint;
+  end;
+
+type
+  PMFDB = ^TMFDB;
+  TMFDB = record
+      fd_addr: pointer;          {* Pointer to the start of the
+                                    memory block, e.g. the
+                                    screen memory base address  *}
+      fd_w: smallint;            {* Width in pixels             *}
+      fd_h: smallint;            {* Height in pixels            *}
+      fd_wdwidth: smallint;      {* Width of a line in words    *}
+      fd_stand: smallint;        {* 0 = Device-specific format  *}
+                                 {* 1 = Standard format         *}
+      fd_nplanes: smallint;      {* Number of planes            *}
+      fd_r1: smallint;           {* Reserved, must be 0         *}
+      fd_r2: smallint;           {* Reserved, must be 0         *}
+      fd_r3: smallint;           {* Reserved, must be 0         *}
+  end;
+
+type
+    String33    = String[33];
+    String80    = String[80];
+    String125   = String[125];
+
+type
+  PVDIContrl = ^TVDIContrl;
+  TVDIContrl = ARRAY[0..11] of smallint;
+
+  PVDIPtsIn  = ^TVDIPtsIn;
+  TVDIPtsIn  = array[0..1023] of smallint;
+
+  PVDIPtsOut = ^TVDIPtsOut;
+  TVDIPtsOut = array[0..255] of smallint;
+
+  PVDIIntIn  = ^TVDIIntIn;
+  TVDIIntIn  = array[0..1023] of smallint;
+
+  PVDIIntOut = ^TVDIIntOut;
+  TVDIIntOut = array[0..511] of smallint;
+
+type
+  PVDIPB = ^TVDIPB;
+  TVDIPB = record
+      control: PVDIContrl;       {* Pointer to contrl array *}
+      intin: PVDIIntIn;          {* Pointer to intin array  *}
+      ptsin: PVDIPtsIn;          {* Pointer to ptsin array  *}
+      intout: PVDIIntOut;        {* Pointer to intout array *}
+      ptsout: PVDIPtsOut;        {* Pointer to ptsout array *}
+  end;
+
+    PFONT_HDR = ^TFONT_HDR;
+    TFONT_HDR = record
+        font_id         : smallint;
+        point           : smallint;
+        name            : Array[0..31] of Char;
+        first_ade       : Word;
+        last_ade        : Word;
+        top             : Word;
+        ascent          : Word;
+        half            : Word;
+        descent         : Word;
+        bottom          : Word;
+        max_char_width  : Word;
+        max_cell_width  : Word;
+        left_offset     : Word;
+        right_offset    : Word;
+        thicken         : Word;
+        ul_size         : Word;
+        lighten         : Word;
+        skew            : Word;
+        flags           : Word;
+        hor_table       : Pointer;
+        off_table       : Pointer;
+        dat_table       : Pointer;
+        form_width      : Word;
+        form_height     : Word;
+        next_font       : PFONT_HDR;
+    end;
+
+type
+    fix31 = LongInt;
+    ARRAY_2     = ARRAY[0..1] of smallint;
+    ARRAY_3     = ARRAY[0..2] of smallint;
+    ARRAY_4     = ARRAY[0..3] of smallint;
+    ARRAY_5     = ARRAY[0..4] of smallint;
+    ARRAY_6     = ARRAY[0..5] of smallint;
+    ARRAY_10    = ARRAY[0..9] of smallint;
+    ARRAY_273   = ARRAY[0..272] of smallint;

rtl/aarch64/aarch64.inc

@@ -221,7 +221,7 @@ function declocked(var l : longint) : boolean;assembler;nostackframe;
   {$else CPUAARCH64_HAS_LSE}
   .LDecLockedLoop:
     ldxr   w1,[x0]
-    sub    w1,w1,#1
+    subs   w1,w1,#1
     stxr   w2,w1,[x0]
     cbnz   w2,.LDecLockedLoop
     cset   w0, eq
@@ -293,7 +293,7 @@ function InterLockedDecrement (var Target: longint) : longint; assembler; nostac
   {$else CPUAARCH64_HAS_LSE}
   .LInterDecLockedLoop:
     ldxr   w1,[x0]
-    sub    w1,w1,#1
+    subs   w1,w1,#1
     stxr   w2,w1,[x0]
     cbnz   w2,.LInterDecLockedLoop
     mov    w0,w1

rtl/atari/dos.pp

@@ -41,6 +41,9 @@ implementation
 
 {$i gemdos.inc}
 
+var
+  basepage: PPD; external name '__base';
+
 procedure Error2DosError(errno: longint);
 begin
   case errno of
@@ -382,18 +385,62 @@ begin
 end;
 
 function EnvCount: Longint;
+var
+  hp : pchar;
 begin
   EnvCount:=0;
+  hp:=basepage^.p_env;
+  If (Hp<>Nil) then
+    while hp^<>#0 do
+      begin
+      Inc(EnvCount);
+      hp:=hp+strlen(hp)+1;
+      end;
 end;
 
 function EnvStr(Index: LongInt): String;
+var
+  hp : pchar;
 begin
   EnvStr:='';
+  hp:=basepage^.p_env;
+  If (Hp<>Nil) then
+    begin
+      while (hp^<>#0) and (Index>1) do
+        begin
+          Dec(Index);
+          hp:=hp+strlen(hp)+1;
+        end;
+    If (hp^<>#0) then
+      begin
+        EnvStr:=hp;
+      end;
+    end;
 end;
 
 function GetEnv(envvar : String): String;
+  var
+    hp : pchar;
+    i : longint;
+    upperenv, str : RawByteString;
 begin
-  GetEnv:='';
+   GetEnv:='';
+   hp:=basepage^.p_env;
+   if (hp=nil) then
+      exit;
+   upperenv:=upcase(envvar);
+   while hp^<>#0 do
+     begin
+        str:=hp;
+        i:=pos('=',str);
+        if upcase(copy(str,1,i-1))=upperenv then
+          begin
+             GetEnv:=copy(str,i+1,length(str)-i);
+             break;
+          end;
+        { next string entry}
+        hp:=hp+strlen(hp)+1;
+     end;
 end;
 
 

rtl/atari/gemdos.inc

@@ -19,12 +19,14 @@
 
 const
     E_OK        = 0;       // OK. No error has arisen
+    ESPIPE      = -6;      // Illegal seek
     EINVFN      = -32;     // Unknown function number
     EFILNF      = -33;     // File not found
     EPTHNF      = -34;     // Directory (folder) not found
     ENHNDL      = -35;     // No more handles available
     EACCDN      = -36;     // Access denied
     EIHNDL      = -37;     // Invalid file handle
+    EPERM       = -38;     // Permission denied
     ENSMEM      = -39;     // Insufficient memory
     EIMBA       = -40;     // Invalid memory block address
     EDRIVE      = -46;     // Invalid drive specification

rtl/atari/si_prc.pp

@@ -33,9 +33,22 @@ procedure PascalMain; external name 'PASCALMAIN';
 
 { this function must be the first in this unit which contains code }
 {$OPTIMIZATION OFF}
-procedure _FPC_proc_start(pd: PPD); cdecl; public name '_start';
+procedure _FPC_proc_start; cdecl; public name '_start';
+var pd: PPD;
 begin
-  procdesc:=pd;
+  asm
+    move.l a0,d0
+    beq @Lapp
+    moveq #0,d1
+    bra @Lacc
+    @Lapp:
+    move.l 8(a6),a0
+    moveq #1,d1
+    @Lacc:
+    move.b d1,AppFlag
+    move.l a0,procdesc
+  end;
+  pd:=procdesc;
   tpasize:=align(sizeof(pd^) + pd^.p_tlen + pd^.p_dlen + pd^.p_blen + stklen, sizeof(pointer));
 
   if gemdos_mshrink(0, pd, tpasize) < 0 then

rtl/atari/sysfile.inc

@@ -245,10 +245,10 @@ end;
 
 
 function do_isdevice(handle: thandle): boolean;
+var pos, newpos: longint;
 begin
-  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
-     (handle=StdErrorHandle) then
-    do_isdevice:=True
-  else
-    do_isdevice:=False;
+  pos := gemdos_fseek(0, handle, SEEK_FROM_CURRENT);
+  newpos := gemdos_fseek(1, handle, SEEK_FROM_START);
+  gemdos_fseek(pos, handle, SEEK_FROM_START);
+  do_isdevice := (newpos=0) or (pos=ESPIPE);
 end;

rtl/atari/sysos.inc

@@ -25,16 +25,16 @@ begin
   else
     begin
       case errno of
-        -32 : InOutRes:=1;
-        -33 : InOutRes:=2;
-        -34 : InOutRes:=3;
-        -35 : InOutRes:=4;
-        -36 : InOutRes:=5;
-        -37 : InOutRes:=8;
-        -39 : InOutRes:=8;
-        -40 : InOutRes:=9;
-        -46 : InOutRes:=15;
-        -67..-64 : InOutRes:=153;
+        EINVFN : InOutRes:=1;
+        EFILNF : InOutRes:=2;
+        EPTHNF : InOutRes:=3;
+        ENHNDL : InOutRes:=4;
+        EACCDN : InOutRes:=5;
+        EIHNDL : InOutRes:=6;
+        ENSMEM,EGSBF : InOutRes:=8;
+        EIMBA : InOutRes:=9;
+        EDRIVE : InOutRes:=15;
+        EPLFMT,EINTRN,ERANGE : InOutRes:=153;
         -15 : InOutRes:=151;
         -13 : InOutRes:=150;
       else

rtl/atari/system.pp

@@ -63,6 +63,7 @@ var
     argc: LongInt;
     argv: PPChar;
     envp: PPChar;
+    AppFlag: Boolean;			{ Application or Accessory				}
 
 
     {$if defined(FPUSOFT)}
@@ -144,14 +145,51 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
+Procedure ConsoleRead(var t:TextRec);
+var
+  dosResult: longint;
+Begin
+  dosResult:=gemdos_fread(t.Handle,t.BufSize,t.Bufptr);
+  t.BufPos:=0;
+  { Reading from console on TOS does not include the terminating CR/LF }
+  if (dosResult >= 0) then
+    begin
+      t.BufEnd := dosResult;
+      if (dosResult>=1) and (t.Bufptr^[dosResult-1] = #10) then
+        begin end
+      else
+      if (t.BufEnd < t.BufSize) then
+        begin
+          t.BufPtr^[t.BufEnd] := #13;
+          inc(t.BufEnd);
+        end;
+      if (t.BufEnd < t.BufSize) then
+        begin
+          t.BufPtr^[t.BufEnd] := #10;
+          inc(t.BufEnd);
+        end;
+    end
+  else
+    Error2InOutRes(dosResult);
+End;
+
+procedure myOpenStdIO(var f:text;mode:longint;hdl:thandle);
+begin
+  OpenStdIO(f, mode, hdl);
+  if (InOutRes=0) and (Mode=fmInput) and Do_Isdevice(hdl) then
+  begin
+    TextRec(f).InOutFunc:=@ConsoleRead;
+  end;
+end;
+
 procedure SysInitStdIO;
 begin
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+  myOpenStdIO(Input,fmInput,StdInputHandle);
+  myOpenStdIO(Output,fmOutput,StdOutputHandle);
+  myOpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 {$ifndef FPC_STDOUT_TRUE_ALIAS}
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  myOpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  myOpenStdIO(StdErr,fmOutput,StdErrorHandle);
 {$endif FPC_STDOUT_TRUE_ALIAS}
 end;
 

rtl/i386/cpu.pp

@@ -253,6 +253,8 @@ unit cpu;
                     movl $0,%ecx
                     cpuid
                     movl %ebx,_ebx
+                    movl %ecx,_ecx
+                    movl %edx,_edx
                     popl %ebx
                   end;
                   _AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);

rtl/inc/system.inc

@@ -266,15 +266,31 @@ function do_isdevice(handle:thandle):boolean;forward;
   { there is no mipsel.inc, we use mips.inc instead }
   {$i mips.inc}  { Case dependent, don't change }
   {$define SYSPROCDEFINED}
-{$else not cpumipsel}
-{$ifdef cpumips}
+{$endif cpumipsel}
+
+{$ifdef cpumipseb}
   {$ifdef SYSPROCDEFINED}
     {$Error Can't determine processor type !}
   {$endif}
   {$i mips.inc}  { Case dependent, don't change }
   {$define SYSPROCDEFINED}
-{$endif cpumips}
-{$endif not cpumipsel}
+{$endif cpumipseb}
+
+{$ifdef cpumips64el}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i mips64el.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpumips64el}
+
+{$ifdef cpumips64eb}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i mips64.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpumips64eb}
 
 {$ifdef cpuaarch64}
   {$ifdef SYSPROCDEFINED}

rtl/linux/linuxvcs.pp

@@ -109,6 +109,7 @@ begin
     fields[fieldct] := 0;
     for i := high(statln) downto low(statln) do
       begin
+{$push}{$R-} {$Q-}
         case statln[i] of
           '-': magnitude := -1;
           '0'..'9': begin
@@ -116,6 +117,7 @@ begin
                                + (magnitude * (ord(statln[i]) - ord('0')));
             magnitude := magnitude * 10;
           end;
+{$pop}
           ' ': begin
             magnitude := 1;
             fieldct := fieldct + 1;

rtl/linux/mips64/sighndh.inc

@@ -0,0 +1,96 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    TSigContext
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+const
+  __SUNOS_MAXWIN = 31;
+
+type
+  twbuf = record
+    locals : array[0..7] of longint;
+    ins    : array[0..7] of longint;
+  end;
+
+(* MIPS OABI32 structure 
+struct sigcontext {
+  unsigned int sc_regmask;
+  unsigned int sc_status;
+  unsigned long long sc_pc;
+  unsigned long long sc_regs[32];
+  unsigned long long sc_fpregs[32];
+  unsigned int sc_ownedfp;
+  unsigned int sc_fpc_csr;
+  unsigned int sc_fpc_eir;
+  unsigned int sc_used_math;
+  unsigned int sc_dsp;
+  unsigned long long sc_mdhi;
+  unsigned long long sc_mdlo;
+  unsigned long sc_hi1;
+  unsigned long sc_lo1;
+  unsigned long sc_hi2;
+  unsigned long sc_lo2;
+  unsigned long sc_hi3;
+  unsigned long sc_lo3;
+};
+typedef struct ucontext
+  {
+    unsigned long int uc_flags;
+    struct ucontext *uc_link;
+    stack_t uc_stack;
+    mcontext_t uc_mcontext;
+    __sigset_t uc_sigmask;
+  } ucontext_t;
+
+ *)
+  FPReg = record
+   case byte of
+    0 : (fp_dreg : double;);
+    1 : (fp_reg : single;
+         fp_pad : cint; );
+  end;
+
+  PSigContext = ^TSigContext;
+  TSigContext = record
+    sigc_regmask,                   
+    sigc_status: cuint; 
+    sigc_pc : culonglong;    
+    sigc_regs : array[0..31] of culonglong;
+    sigc_fpregs : array[0..31] of fpreg; 
+    sigc_fpc_csr, sigc_fpc_eir : cuint;
+    sigc_used_math : cuint;
+    sigc_dsp : cuint;
+    sigc_mdhi, sigc_mdlo : culonglong;
+    sigc_hi1,sigc_lo1,
+    sigc_hi2,sigc_lo2,
+    sigc_hi3,sigc_lo3 : culong;
+  end;
+
+  TStack = record
+    ss_sp : pointer;
+    ss_size : size_t;
+    ss_flags : cint;
+  end;
+
+  PUContext = ^TUContext;
+  TUContext = record
+    uc_flags : culong;
+    uc_link : PUContext;
+    uc_stack : TStack;
+    uc_mcontext : TSigContext;
+    uc_sigmask : TSigSet;
+  end;
+

rtl/linux/mips64/stat.inc

@@ -0,0 +1,49 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 1999-2003 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+  Stat = Record
+    st_dev     : culong;
+    st_pad0    : array[0..2] of culong;
+    st_ino     : culonglong;
+    st_mode    : mode_t;
+    st_nlink   : nlink_t;
+    st_uid     : uid_t;
+    st_gid     : gid_t;
+    st_rdev    : culong;
+    st_pad1    : array[0..2] of culong;
+    st_size    : clonglong;
+{$ifdef __USE_MISC}
+    st_atim: timespec;
+    st_mtim: timespec;
+    st_ctim: timespec;
+{$else not __USE_MISC}
+    st_atime: time_t;
+    st_atime_nsec: cint;
+
+    st_mtime: time_t;
+    st_mtime_nsec: cint;
+
+    st_ctime: time_t;
+    st_ctime_nsec: cint;
+{$endif not __USE_MISC}
+    st_blksize : blksize_t;
+    __pad4     : cuint;
+{$ifndef __USE_FILE_OFFSET64}
+    st_blocks  : blkcnt_t;
+{$else __USE_FILE_OFFSET64}
+    st_blocks  : blkcnt64_t;
+{$endif __USE_FILE_OFFSET64}
+    st_pad5: array[0..13] of cint;
+  end;

rtl/linux/mips64/syscall.inc

@@ -0,0 +1,200 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2009 by Michael Van Canneyt and David Zhang
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+  {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{$define FPC_SYSTEM_HAS_FPFORK}
+{
+  behaviour of result of fork on sparc/linux is different than on other
+  linux flavours
+}
+function Fpfork : pid_t;  [public, alias : 'FPC_SYSC_FORK'];assembler;
+asm
+  li  $2,4002
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+{*****************************************************************************
+                     --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  move  $a1,$a2
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  move  $a1,$a2
+  move  $a2,$a3
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  move  $a1,$a2
+  move  $a2,$a3
+  lw    $a3,param4
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  move  $a1,$a2
+  move  $a2,$a3
+  lw	$a3,param4
+  lw    $t0,param5
+  sw    $t0,16($sp)
+
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+asm
+  move  $v0,$a0
+  move  $a0,$a1
+  move  $a1,$a2
+  move  $a2,$a3
+  lw	$a3,param4
+  lw    $t0,param5
+  sw    $t0,16($sp)
+  lw    $t0,param6
+  sw    $t0,20($sp)
+  syscall
+  nop
+  beq $7,$0,.LDone
+  nop
+  move  $a0,$2
+  jal   SetErrno
+  nop
+  li    $2,-1
+.LDone:
+end;

rtl/linux/mips64/syscallh.inc

@@ -0,0 +1,43 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for mips *nix.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+    MA 02110-1301, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+  TSysResult = longint; // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult;  external name 'FPC_SYSCALL6';
+

rtl/linux/mips64/sysnr.inc

@@ -0,0 +1,503 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003-2004 by Florian Klaempfl and David Zhang
+
+    Syscall nrs for mips-linux O32
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+  __nr_Linux                            =  4000;
+  syscall_nr_exit                       =  __nr_linux +  1;
+  syscall_nr_fork                       =  __nr_linux +  2;
+  syscall_nr_read                       =  __nr_linux +  3;
+  syscall_nr_write                      =  __nr_linux +  4;
+  syscall_nr_open                       =  __nr_linux +  5;
+  syscall_nr_close                      =  __nr_linux +  6;
+  syscall_nr_waitpid                    =  __nr_linux +  7;
+  syscall_nr_creat                      =  __nr_linux +  8;
+  syscall_nr_link                       =  __nr_linux +  9;
+  syscall_nr_unlink                     =  __nr_linux + 10;
+  syscall_nr_execve                     =  __nr_linux + 11;
+  syscall_nr_chdir                      =  __nr_linux + 12;
+  syscall_nr_time                       =  __nr_linux + 13;
+  syscall_nr_mknod                      =  __nr_linux + 14;
+  syscall_nr_chmod                      =  __nr_linux + 15;
+  syscall_nr_lchown                     =  __nr_linux + 16;
+  syscall_nr_break                      =  __nr_linux + 17;
+
+  syscall_nr_unused18                   = __nr_Linux +  18;
+
+  syscall_nr_lseek                      =  __nr_linux + 19;
+  syscall_nr_getpid                     =  __nr_linux + 20;
+  syscall_nr_mount                      =  __nr_linux + 21;
+  syscall_nr_umount                     =  __nr_linux + 22;
+  syscall_nr_setuid                     =  __nr_linux + 23;
+  syscall_nr_getuid                     =  __nr_linux + 24;
+  syscall_nr_stime                      =  __nr_linux + 25;
+  syscall_nr_ptrace                     =  __nr_linux + 26;
+  syscall_nr_alarm                      =  __nr_linux + 27;
+
+  syscall_nr_unused28                   = __nr_Linux +  28;
+
+  syscall_nr_pause                      =  __nr_linux + 29;
+  syscall_nr_utime                      =  __nr_linux + 30;
+  syscall_nr_stty                       =  __nr_linux + 31;
+  syscall_nr_gtty                       =  __nr_linux + 32;
+  syscall_nr_access                     =  __nr_linux + 33;
+  syscall_nr_nice                       =  __nr_linux + 34;
+  syscall_nr_ftime                      =  __nr_linux + 35;
+  syscall_nr_sync                       =  __nr_linux + 36;
+  syscall_nr_kill                       =  __nr_linux + 37;
+  syscall_nr_rename                     =  __nr_linux + 38;
+  syscall_nr_mkdir                      =  __nr_linux + 39;
+  syscall_nr_rmdir                      =  __nr_linux + 40;
+  syscall_nr_dup                        =  __nr_linux + 41;
+  syscall_nr_pipe                       =  __nr_linux + 42;
+  syscall_nr_times                      =  __nr_linux + 43;
+  syscall_nr_prof                       =  __nr_linux + 44;
+  syscall_nr_brk                        =  __nr_linux + 45;
+  syscall_nr_setgid                     =  __nr_linux + 46;
+  syscall_nr_getgid                     =  __nr_linux + 47;
+  syscall_nr_signal                     =  __nr_linux + 48;
+  syscall_nr_geteuid                    =  __nr_linux + 49;
+  syscall_nr_getegid                    =  __nr_linux + 50;
+  syscall_nr_acct                       =  __nr_linux + 51;
+  syscall_nr_umount2                    =  __nr_linux + 52;
+  syscall_nr_lock                       =  __nr_linux + 53;
+  syscall_nr_ioctl                      =  __nr_linux + 54;
+  syscall_nr_fcntl                      =  __nr_linux + 55;
+  syscall_nr_mpx                        =  __nr_linux + 56;
+  syscall_nr_setpgid                    =  __nr_linux + 57;
+  syscall_nr_ulimit                     =  __nr_linux + 58;
+
+  syscall_nr_unused59                   = __nr_Linux +  59;
+
+  syscall_nr_umask                      =  __nr_linux + 60;
+  syscall_nr_chroot                     =  __nr_linux + 61;
+  syscall_nr_ustat                      =  __nr_linux + 62;
+  syscall_nr_dup2                       =  __nr_linux + 63;
+  syscall_nr_getppid                    =  __nr_linux + 64;
+  syscall_nr_getpgrp                    =  __nr_linux + 65;
+  syscall_nr_setsid                     =  __nr_linux + 66;
+  syscall_nr_sigaction                  =  __nr_linux + 67;
+  syscall_nr_sgetmask                   =  __nr_linux + 68;
+  syscall_nr_ssetmask                   =  __nr_linux + 69;
+  syscall_nr_setreuid                   =  __nr_linux + 70;
+  syscall_nr_setregid                   =  __nr_linux + 71;
+  syscall_nr_sigsuspend                 =  __nr_linux + 72;
+  syscall_nr_sigpending                 =  __nr_linux + 73;
+  syscall_nr_sethostname                =  __nr_linux + 74;
+  syscall_nr_setrlimit                  =  __nr_linux + 75;
+  syscall_nr_getrlimit                  =  __nr_linux + 76;
+  syscall_nr_getrusage                  =  __nr_linux + 77;
+  syscall_nr_gettimeofday               =  __nr_linux + 78;
+  syscall_nr_settimeofday               =  __nr_linux + 79;
+  syscall_nr_getgroups                  =  __nr_linux + 80;
+  syscall_nr_setgroups                  =  __nr_linux + 81;
+
+//  syscall_nr_select                     =  __nr_linux + 82;
+  syscall_nr_reserved82                 =  __nr_Linux +  82;
+
+  syscall_nr_symlink                    =  __nr_linux + 83;
+
+  syscall_nr_unused84                   = __nr_Linux +  84;
+
+  syscall_nr_readlink                   =  __nr_linux + 85;
+  syscall_nr_uselib                     =  __nr_linux + 86;
+  syscall_nr_swapon                     =  __nr_linux + 87;
+  syscall_nr_reboot                     =  __nr_linux + 88;
+  syscall_nr_readdir                    =  __nr_linux + 89;
+  syscall_nr_mmap                       =  __nr_linux + 90;
+  syscall_nr_munmap                     =  __nr_linux + 91;
+  syscall_nr_truncate                   =  __nr_linux + 92;
+  syscall_nr_ftruncate                  =  __nr_linux + 93;
+  syscall_nr_fchmod                     =  __nr_linux + 94;
+  syscall_nr_fchown                     =  __nr_linux + 95;
+  syscall_nr_getpriority                =  __nr_linux + 96;
+  syscall_nr_setpriority                =  __nr_linux + 97;
+  syscall_nr_profil                     =  __nr_linux + 98;
+  syscall_nr_statfs                     =  __nr_linux + 99;
+  syscall_nr_fstatfs                    = __nr_linux + 100;
+  syscall_nr_ioperm                     = __nr_linux + 101;
+  syscall_nr_socketcall                 = __nr_linux + 102;
+  syscall_nr_syslog                     = __nr_linux + 103;
+  syscall_nr_setitimer                  = __nr_linux + 104;
+  syscall_nr_getitimer                  = __nr_linux + 105;
+  syscall_nr_stat                       = __nr_linux + 106;
+  syscall_nr_lstat                      = __nr_linux + 107;
+  syscall_nr_fstat                      = __nr_linux + 108;
+
+  syscall_nr_unused109                   = __nr_Linux +  109;
+
+
+  syscall_nr_iopl                       = __nr_Linux + 110;
+
+  syscall_nr_vhangup                    = __nr_linux + 111;
+  syscall_nr_idle                       = __nr_linux + 112;
+//  syscall_nr_syscall                    = __nr_linux + 113;
+  syscall_nr_vm86                       = __nr_Linux + 113;
+
+  syscall_nr_wait4                      = __nr_linux + 114;
+  syscall_nr_swapoff                    = __nr_linux + 115;
+  syscall_nr_sysinfo                    = __nr_linux + 116;
+  syscall_nr_ipc                        = __nr_linux + 117;
+  syscall_nr_fsync                      = __nr_linux + 118;
+  syscall_nr_sigreturn                  = __nr_linux + 119;
+  syscall_nr_clone                      = __nr_linux + 120;
+  syscall_nr_setdomainname              = __nr_linux + 121;
+  syscall_nr_uname                      = __nr_linux + 122;
+  syscall_nr_modify_ldt                 = __nr_linux + 123;
+  syscall_nr_adjtimex                   = __nr_linux + 124;
+  syscall_nr_mprotect                   = __nr_linux + 125;
+  syscall_nr_sigprocmask                = __nr_linux + 126;
+  syscall_nr_create_module              = __nr_linux + 127;
+  syscall_nr_init_module                = __nr_linux + 128;
+  syscall_nr_delete_module              = __nr_linux + 129;
+  syscall_nr_get_kernel_syms            = __nr_linux + 130;
+  syscall_nr_quotactl                   = __nr_linux + 131;
+  syscall_nr_getpgid                    = __nr_linux + 132;
+  syscall_nr_fchdir                     = __nr_linux + 133;
+  syscall_nr_bdflush                    = __nr_linux + 134;
+  syscall_nr_sysfs                      = __nr_linux + 135;
+  syscall_nr_personality                = __nr_linux + 136;
+  syscall_nr_afs_syscall                = __nr_linux + 137;
+
+  syscall_nr_setfsuid                   = __nr_linux + 138;
+  syscall_nr_setfsgid                   = __nr_linux + 139;
+  syscall_nr__llseek                    = __nr_linux + 140;
+  syscall_nr_getdents                   = __nr_linux + 141;
+  syscall_nr__newselect                 = __nr_linux + 142;
+  syscall_nr_flock                      = __nr_linux + 143;
+  syscall_nr_msync                      = __nr_linux + 144;
+  syscall_nr_readv                      = __nr_linux + 145;
+  syscall_nr_writev                     = __nr_linux + 146;
+
+
+  syscall_nr_cacheflush                 =  __nr_Linux + 147;
+  syscall_nr_cachectl                   =  __nr_Linux + 148;
+
+
+  syscall_nr_sysmips                    = __nr_Linux + 149;
+
+  syscall_nr_unused150                  = __nr_Linux +  150;
+
+  syscall_nr_getsid                     = __nr_linux +  151; // 147;
+  syscall_nr_fdatasync                  = __nr_linux +  152; // 148;
+  syscall_nr__sysctl                    = __nr_linux +  153; // 149;
+
+  syscall_nr_mlock                      = __nr_linux +  154; // 150;
+
+  syscall_nr_munlock                    = __nr_linux + 155;
+  syscall_nr_mlockall                   = __nr_linux + 156;
+  syscall_nr_munlockall                 = __nr_linux + 157;
+
+  syscall_nr_sched_setparam             = __nr_linux + 158;
+  syscall_nr_sched_getparam             = __nr_linux + 159;
+
+  syscall_nr_sched_setscheduler         = __nr_linux + 160;
+  syscall_nr_sched_getscheduler         = __nr_linux + 161;
+  syscall_nr_sched_yield                = __nr_linux + 162;
+
+
+  syscall_nr_sched_get_priority_max     = __nr_linux + 163;
+  syscall_nr_sched_get_priority_min     = __nr_linux + 164;
+  syscall_nr_sched_rr_get_interval      = __nr_linux + 165;
+
+  syscall_nr_nanosleep                  = __nr_linux + 166; // 162;
+  syscall_nr_mremap                     = __nr_linux + 167;
+
+  syscall_nr_accept      =   __nr_Linux + 168;
+  syscall_nr_bind        =   __nr_Linux + 169;
+  syscall_nr_connect     =   __nr_Linux + 170;
+  syscall_nr_getpeername =   __nr_Linux + 171;
+  syscall_nr_getsockname =   __nr_Linux + 172;
+  syscall_nr_getsockopt  =   __nr_Linux + 173;
+  syscall_nr_listen      =   __nr_Linux + 174;
+  syscall_nr_recv        =   __nr_Linux + 175;
+  syscall_nr_recvfrom    =   __nr_Linux + 176;
+  syscall_nr_recvmsg     =   __nr_Linux + 177;
+  syscall_nr_send        =   __nr_Linux + 178;
+  syscall_nr_sendmsg     =   __nr_Linux + 179;
+  syscall_nr_sendto      =   __nr_Linux + 180;
+  syscall_nr_setsockopt  =   __nr_Linux + 181;
+  syscall_nr_shutdown    =   __nr_Linux + 182;
+  syscall_nr_socket      =   __nr_Linux + 183;
+  syscall_nr_socketpair  =   __nr_Linux + 184;
+
+  syscall_nr_setresuid                  = __nr_linux + 185;
+  syscall_nr_getresuid                  = __nr_linux + 186;
+//  syscall_nr_vm86                       = __nr_linux + 166;
+  syscall_nr_query_module               = __nr_linux + 187;
+  syscall_nr_poll                       = __nr_linux + 188;
+  syscall_nr_nfsservctl                 = __nr_linux + 189;
+  syscall_nr_setresgid                  = __nr_linux + 190;
+  syscall_nr_getresgid                  = __nr_linux + 191;
+  syscall_nr_prctl                      = __nr_linux + 192; // 172;
+  syscall_nr_rt_sigreturn               = __nr_linux + 193;
+  syscall_nr_rt_sigaction               = __nr_linux + 194;
+  syscall_nr_rt_sigprocmask             = __nr_linux + 195;
+  syscall_nr_rt_sigpending              = __nr_linux + 196;
+  syscall_nr_rt_sigtimedwait            = __nr_linux + 197;
+  syscall_nr_rt_sigqueueinfo            = __nr_linux + 198;
+  syscall_nr_rt_sigsuspend              = __nr_linux + 199;
+
+  syscall_nr_pread64                      = __nr_linux + 200;
+  syscall_nr_pwrite64                     = __nr_linux + 201;
+
+  syscall_nr_chown                      = __nr_linux + 202; // 182;
+  syscall_nr_getcwd                     = __nr_linux + 203; // 183;
+  syscall_nr_capget                     = __nr_linux + 204; // 184;
+  syscall_nr_capset                     = __nr_linux + 205; // 185;
+  syscall_nr_sigaltstack                = __nr_linux + 206; // 186;
+  syscall_nr_sendfile                   = __nr_linux + 207; // 187;
+
+
+//  syscall_nr_vfork                      = __nr_linux + 190;
+//  syscall_nr_ugetrlimit                 = __nr_linux + 191;
+
+// the following are new syscall, ......
+  syscall_nr_getpmsg     = __nr_Linux + 208;
+  syscall_nr_putpmsg     = __nr_Linux + 209;
+
+  syscall_nr_mmap2                      = __nr_linux + 210; // 192;
+  syscall_nr_truncate64                 = __nr_linux + 211; // 193;
+  syscall_nr_ftruncate64                = __nr_linux + 212; // 194;
+  syscall_nr_stat64                     = __nr_linux + 213; // 195;
+  syscall_nr_lstat64                    = __nr_linux + 214; // 196;
+  syscall_nr_fstat64                    = __nr_linux + 215; // 197;
+
+{
+  syscall_nr_lchown32                   = __nr_linux + 198;
+  syscall_nr_getuid32                   = __nr_linux + 199;
+  syscall_nr_getgid32                   = __nr_linux + 200;
+  syscall_nr_geteuid32                  = __nr_linux + 201;
+  syscall_nr_getegid32                  = __nr_linux + 202;
+  syscall_nr_setreuid32                 = __nr_linux + 203;
+  syscall_nr_setregid32                 = __nr_linux + 204;
+  syscall_nr_getgroups32                = __nr_linux + 205;
+  syscall_nr_setgroups32                = __nr_linux + 206;
+  syscall_nr_fchown32                   = __nr_linux + 207;
+  syscall_nr_setresuid32                = __nr_linux + 208;
+  syscall_nr_getresuid32                = __nr_linux + 209;
+  syscall_nr_setresgid32                = __nr_linux + 210;
+  syscall_nr_getresgid32                = __nr_linux + 211;
+  syscall_nr_chown32                    = __nr_linux + 212;
+  syscall_nr_setuid32                   = __nr_linux + 213;
+  syscall_nr_setgid32                   = __nr_linux + 214;
+  syscall_nr_setfsuid32                 = __nr_linux + 215;
+  syscall_nr_setfsgid32                 = __nr_linux + 216;
+ }
+
+  syscall_nr_pivot_root                 = __nr_linux + 216; // 218;
+  syscall_nr_mincore                    = __nr_linux + 217; // 219;
+  syscall_nr_madvise                    = __nr_linux + 218; // 220;
+  syscall_nr_getdents64                 = __nr_linux + 219; // 217;
+  syscall_nr_fcntl64                    = __nr_linux + 220; // 221;
+//  syscall_nr_security                   = __nr_linux + 223;
+
+// syscall_nr_reserved221    (__nr_Linux + 221)
+
+  syscall_nr_gettid                     = __nr_linux + 222; // 224;
+  syscall_nr_readahead                  = __nr_linux + 223; // 225;
+  syscall_nr_setxattr                   = __nr_linux + 224; // 226;
+  syscall_nr_lsetxattr                  = __nr_linux + 225; // 227;
+  syscall_nr_fsetxattr                  = __nr_linux + 226; // 228;
+  syscall_nr_getxattr                   = __nr_linux + 227; // 229;
+  syscall_nr_lgetxattr                  = __nr_linux + 228; // 230;
+  syscall_nr_fgetxattr                  = __nr_linux + 229; // 231;
+  syscall_nr_listxattr                  = __nr_linux + 230; // 232;
+  syscall_nr_llistxattr                 = __nr_linux + 231; // 233;
+  syscall_nr_flistxattr                 = __nr_linux + 232; // 234;
+  syscall_nr_removexattr                = __nr_linux + 233; // 235;
+  syscall_nr_lremovexattr               = __nr_linux + 234; // 236;
+  syscall_nr_fremovexattr               = __nr_linux + 235; // 237;
+  syscall_nr_tkill                      = __nr_linux + 236; // 238;
+  syscall_nr_sendfile64                 = __nr_linux + 237; // 239;
+  syscall_nr_futex                      = __nr_linux + 238; // 240;
+  syscall_nr_sched_setaffinity          = __nr_linux + 239; // 241;
+  syscall_nr_sched_getaffinity          = __nr_linux + 240; // 242;
+  syscall_nr_io_setup                   = __nr_linux + 241; // 243;
+  syscall_nr_io_destroy                 = __nr_linux + 242; // 244;
+  syscall_nr_io_getevents               = __nr_linux + 243; // 245;
+  syscall_nr_io_submit                  = __nr_linux + 244; // 246;
+  syscall_nr_io_cancel                  = __nr_linux + 245; // 247;
+  syscall_nr_exit_group                 = __nr_linux + 246; // 248;
+  syscall_nr_lookup_dcookie             = __nr_linux + 247; // 249;
+  syscall_nr_epoll_create               = __nr_linux + 248; // 250;
+  syscall_nr_epoll_ctl                  = __nr_linux + 249; // 251;
+  syscall_nr_epoll_wait                 = __nr_linux + 250; // 252;
+  syscall_nr_remap_file_pages           = __nr_linux + 251; // 253;
+
+  syscall_nr_set_tid_address  = __nr_Linux + 252;
+  syscall_nr_restart_syscall  = __nr_Linux + 253;
+  syscall_nr_fadvise64        = __nr_Linux + 254;
+  syscall_nr_statfs64         = __nr_Linux + 255;
+  syscall_nr_fstatfs64        = __nr_Linux + 256;
+  syscall_nr_timer_create     = __nr_Linux + 257;
+  syscall_nr_timer_settime    = __nr_Linux + 258;
+  syscall_nr_timer_gettime    = __nr_Linux + 259;
+  syscall_nr_timer_getoverrun = __nr_Linux + 260;
+  syscall_nr_timer_delete     = __nr_Linux + 261;
+  syscall_nr_clock_settime    = __nr_Linux + 262;
+  syscall_nr_clock_gettime    = __nr_Linux + 263;
+  syscall_nr_clock_getres     = __nr_Linux + 264;
+  syscall_nr_clock_nanosleep  = __nr_Linux + 265;
+  syscall_nr_tgkill           = __nr_Linux + 266;
+  syscall_nr_utimes           = __nr_Linux + 267;
+  syscall_nr_mbind            = __nr_Linux + 268;
+  syscall_nr_get_mempolicy    = __nr_Linux + 269;
+  syscall_nr_set_mempolicy    = __nr_Linux + 270;
+  syscall_nr_mq_open          = __nr_Linux + 271;
+  syscall_nr_mq_unlink        = __nr_Linux + 272;
+  syscall_nr_mq_timedsend     = __nr_Linux + 273;
+  syscall_nr_mq_timedreceive  = __nr_Linux + 274;
+  syscall_nr_mq_notify        = __nr_Linux + 275;
+  syscall_nr_mq_getsetattr    = __nr_Linux + 276;
+  syscall_nr_vserver          = __nr_Linux + 277;
+  syscall_nr_waitid           = __nr_Linux + 278;
+//  /* syscall_nr_sys_setaltroot    (__nr_Linux + 279) */
+  syscall_nr_add_key          = __nr_Linux + 280;
+  syscall_nr_request_key      = __nr_Linux + 281;
+  syscall_nr_keyctl           = __nr_Linux + 282;
+  syscall_nr_set_thread_area  = __nr_Linux + 283;
+  syscall_nr_inotify_init     = __nr_Linux + 284;
+  syscall_nr_inotify_add_watch =    (__nr_Linux + 285);
+  syscall_nr_inotify_rm_watch = __nr_Linux + 286;
+  syscall_nr_migrate_pages    = __nr_Linux + 287;
+  syscall_nr_openat           = __nr_Linux + 288;
+  syscall_nr_mkdirat          = __nr_Linux + 289;
+  syscall_nr_mknodat          = __nr_Linux + 290;
+  syscall_nr_fchownat         = __nr_Linux + 291;
+  syscall_nr_futimesat        = __nr_Linux + 292;
+  syscall_nr_fstatat          = __nr_Linux + 293;
+  syscall_nr_unlinkat         = __nr_Linux + 294;
+  syscall_nr_renameat         = __nr_Linux + 295;
+  syscall_nr_linkat           = __nr_Linux + 296;
+  syscall_nr_symlinkat        = __nr_Linux + 297;
+  syscall_nr_readlinkat       = __nr_Linux + 298;
+  syscall_nr_fchmodat         = __nr_Linux + 299;
+  syscall_nr_faccessat        = __nr_Linux + 300;
+  syscall_nr_pselect6         = __nr_Linux + 301;
+  syscall_nr_ppoll            = __nr_Linux + 302;
+  syscall_nr_unshare          = __nr_Linux + 303;
+  syscall_nr_splice           = __nr_Linux + 304;
+  syscall_nr_sync_file_range  = __nr_Linux + 305;
+  syscall_nr_tee              = __nr_Linux + 306;
+  syscall_nr_vmsplice         = __nr_Linux + 307;
+  syscall_nr_move_pages       = __nr_Linux + 308;
+  syscall_nr_set_robust_list              = __nr_Linux + 309;
+  syscall_nr_get_robust_list              = __nr_Linux + 310;
+  syscall_nr_kexec_load                   = __nr_Linux + 311;
+  syscall_nr_getcpu                       = __nr_Linux + 312;
+  syscall_nr_epoll_pwait                  = __nr_Linux + 313;
+  syscall_nr_ioprio_set                   = __nr_Linux + 314;
+  syscall_nr_ioprio_get                   = __nr_Linux + 315;
+  syscall_nr_utimensat                    = __nr_Linux + 316;
+  syscall_nr_signalfd                     = __nr_Linux + 317;
+  syscall_nr_timerfd                      = __nr_Linux + 318;
+  syscall_nr_eventfd                      = __nr_Linux + 319;
+  syscall_nr_fallocate                    = __nr_Linux + 320;
+  syscall_nr_timerfd_create               = __nr_Linux + 321;
+  syscall_nr_timerfd_gettime              = __nr_Linux + 322;
+  syscall_nr_timerfd_settime              = __nr_Linux + 323;
+  syscall_nr_signalfd4                    = __nr_Linux + 324;
+  syscall_nr_eventfd2                     = __nr_Linux + 325;
+  syscall_nr_epoll_create1                = __nr_Linux + 326;
+  syscall_nr_dup3                         = __nr_Linux + 327;
+  syscall_nr_pipe2                        = __nr_Linux + 328;
+  syscall_nr_inotify_init1                = __nr_Linux + 329;
+  syscall_nr_preadv                       = __nr_Linux + 330;
+  syscall_nr_pwritev                      = __nr_Linux + 331;
+  syscall_nr_rt_tgsigqueueinfo            = __nr_Linux + 332;
+  syscall_nr_perf_event_open              = __nr_Linux + 333;
+  syscall_nr_accept4                      = __nr_Linux + 334;
+  syscall_nr_recvmmsg                     = __nr_Linux + 335;
+  syscall_nr_fanotify_init                = __nr_Linux + 336;
+  syscall_nr_fanotify_mark                = __nr_Linux + 337;
+  syscall_nr_prlimit64                    = __nr_Linux + 338;
+  syscall_nr_name_to_handle_at            = __nr_Linux + 339;
+  syscall_nr_open_by_handle_at            = __nr_Linux + 340;
+  syscall_nr_clock_adjtime                = __nr_Linux + 341;
+  syscall_nr_syncfs                       = __nr_Linux + 342;
+  syscall_nr_sendmmsg                     = __nr_Linux + 343;
+  syscall_nr_setns                        = __nr_Linux + 344;
+  syscall_nr_process_vm_readv             = __nr_Linux + 345;
+  syscall_nr_process_vm_writev            = __nr_Linux + 346;
+  syscall_nr_kcmp                         = __nr_Linux + 347;
+  syscall_nr_finit_module                 = __nr_Linux + 348;
+  syscall_nr_sched_setattr                = __nr_Linux + 349;
+  syscall_nr_sched_getattr                = __nr_Linux + 350;
+  syscall_nr_renameat2                    = __nr_Linux + 351;
+  syscall_nr_seccomp                      = __nr_Linux + 352;
+  syscall_nr_getrandom                    = __nr_Linux + 353;
+  syscall_nr_memfd_create                 = __nr_Linux + 354;
+  syscall_nr_bpf                          = __nr_Linux + 355;
+  syscall_nr_execveat                     = __nr_Linux + 356;
+  syscall_nr_userfaultfd                  = __nr_Linux + 357;
+  syscall_nr_membarrier                   = __nr_Linux + 358;
+  syscall_nr_mlock2                       = __nr_Linux + 359;
+  syscall_nr_copy_file_range              = __nr_Linux + 360;
+  syscall_nr_preadv2                      = __nr_Linux + 361;
+  syscall_nr_pwritev2                     = __nr_Linux + 362;
+  syscall_nr_pkey_mprotect                = __nr_Linux + 363;
+  syscall_nr_pkey_alloc                   = __nr_Linux + 364;
+  syscall_nr_pkey_free                    = __nr_Linux + 365;
+  syscall_nr_statx                        = __nr_Linux + 366;
+  syscall_nr_rseq                         = __nr_Linux + 367;
+  syscall_nr_io_pgetevents                = __nr_Linux + 368;
+  syscall_nr_semget                       = __nr_Linux + 393;
+  syscall_nr_semctl                       = __nr_Linux + 394;
+  syscall_nr_shmget                       = __nr_Linux + 395;
+  syscall_nr_shmctl                       = __nr_Linux + 396;
+  syscall_nr_shmat                        = __nr_Linux + 397;
+  syscall_nr_shmdt                        = __nr_Linux + 398;
+  syscall_nr_msgget                       = __nr_Linux + 399;
+  syscall_nr_msgsnd                       = __nr_Linux + 400;
+  syscall_nr_msgrcv                       = __nr_Linux + 401;
+  syscall_nr_msgctl                       = __nr_Linux + 402;
+  syscall_nr_clock_gettime64              = __nr_Linux + 403;
+  syscall_nr_clock_settime64              = __nr_Linux + 404;
+  syscall_nr_clock_adjtime64              = __nr_Linux + 405;
+  syscall_nr_clock_getres_time64          = __nr_Linux + 406;
+  syscall_nr_clock_nanosleep_time64       = __nr_Linux + 407;
+  syscall_nr_timer_gettime64              = __nr_Linux + 408;
+  syscall_nr_timer_settime64              = __nr_Linux + 409;
+  syscall_nr_timerfd_gettime64            = __nr_Linux + 410;
+  syscall_nr_timerfd_settime64            = __nr_Linux + 411;
+  syscall_nr_utimensat_time64             = __nr_Linux + 412;
+  syscall_nr_pselect6_time64              = __nr_Linux + 413;
+  syscall_nr_ppoll_time64                 = __nr_Linux + 414;
+  syscall_nr_io_pgetevents_time64         = __nr_Linux + 416;
+  syscall_nr_recvmmsg_time64              = __nr_Linux + 417;
+  syscall_nr_mq_timedsend_time64          = __nr_Linux + 418;
+  syscall_nr_mq_timedreceive_time64       = __nr_Linux + 419;
+  syscall_nr_semtimedop_time64            = __nr_Linux + 420;
+  syscall_nr_rt_sigtimedwait_time64       = __nr_Linux + 421;
+  syscall_nr_futex_time64                 = __nr_Linux + 422;
+  syscall_nr_sched_rr_get_interval_time64 = __nr_Linux + 423;
+  syscall_nr_pidfd_send_signal            = __nr_Linux + 424;
+  syscall_nr_io_uring_setup               = __nr_Linux + 425;
+  syscall_nr_io_uring_enter               = __nr_Linux + 426;
+  syscall_nr_io_uring_register            = __nr_Linux + 427;
+  syscall_nr_open_tree                    = __nr_Linux + 428;
+  syscall_nr_move_mount                   = __nr_Linux + 429;
+  syscall_nr_fsopen                       = __nr_Linux + 430;
+  syscall_nr_fsconfig                     = __nr_Linux + 431;
+  syscall_nr_fsmount                      = __nr_Linux + 432;
+  syscall_nr_fspick                       = __nr_Linux + 433;
+  syscall_nr_pidfd_open                   = __nr_Linux + 434;
+  syscall_nr_clone3                       = __nr_Linux + 435;
+

rtl/linux/mips64el/sighndh.inc

@@ -0,0 +1 @@
+{$i ../mips/sighndh.inc}

rtl/linux/mips64el/stat.inc

@@ -0,0 +1 @@
+{$i ../mips64/stat.inc}

rtl/linux/mips64el/syscall.inc

@@ -0,0 +1 @@
+{$i ../mips64/syscall.inc}

rtl/linux/mips64el/syscallh.inc

@@ -0,0 +1 @@
+{$i ../mips64/syscallh.inc}

rtl/linux/mips64el/sysnr.inc

@@ -0,0 +1 @@
+{$i ../mips64/sysnr.inc}

rtl/m68k/m68k.inc

@@ -467,6 +467,26 @@ end;
 {$endif}
 
 {$IFNDEF FPC_SYSTEM_HAS_INTERLOCKEDFUNCS}
+{$IFNDEF CPUM68K_HAS_CAS}
+var
+  spinLock: byte;
+
+procedure getSpinLock; assembler; nostackframe;
+asm
+{$IFDEF CPUM68K_HAS_TAS}
+  lea.l spinlock,a0
+@loop:
+  tas (a0)
+  bne @loop
+{$ENDIF}
+end;
+
+procedure releaseSpinLock; assembler; nostackframe;
+asm
+  move.b #0,spinlock
+end;
+{$ENDIF}
+
 function InterLockedDecrement (var Target: longint) : longint;
 {$IFDEF CPUM68K_HAS_CAS}
   register; assembler;
@@ -481,13 +501,13 @@ function InterLockedDecrement (var Target: longint) : longint;
   end;
 {$ELSE}
   begin
-  {$warning FIX ME}
+    getSpinLock;
     Dec(Target);
     Result := Target;
+    releaseSpinLock;
   end;
 {$ENDIF}
 
-
 function InterLockedIncrement (var Target: longint) : longint;
 {$IFDEF CPUM68K_HAS_CAS}
   register; assembler;
@@ -502,9 +522,10 @@ function InterLockedIncrement (var Target: longint) : longint;
   end;
 {$ELSE}
   begin
-  {$warning FIX ME}
+    getSpinLock;
     Inc(Target);
     Result := Target;
+    releaseSpinLock;
   end;
 {$ENDIF}
 
@@ -520,13 +541,13 @@ function InterLockedExchange (var Target: longint;Source : longint) : longint;
   end;
 {$ELSE}
   begin
-  {$warning FIX ME}
+    getSpinLock;
     Result := Target;
     Target := Source;
+    releaseSpinLock;
   end;
 {$ENDIF}
 
-
 function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
 {$IFDEF CPUM68K_HAS_CAS}
   register; assembler;
@@ -541,9 +562,10 @@ function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint
   end;
 {$ELSE}
   begin
-  {$warning FIX ME}
+    getSpinLock;
     Result := Target;
     Target := Target + Source;
+    releaseSpinLock;
   end;
 {$ENDIF}
 
@@ -558,10 +580,11 @@ function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comp
   end;
 {$ELSE}
   begin
-  {$warning FIX ME}
+    getSpinLock;
     Result := Target;
     if Target = Comperand then
       Target := NewValue;
+    releaseSpinLock;
   end;
 {$ENDIF}
 {$ENDIF FPC_SYSTEM_HAS_INTERLOCKEDFUNCS}

rtl/mips64/cpuh.inc

@@ -0,0 +1,15 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2016 by the Free Pascal development team.
+
+    CPU specific system unit header file
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}

rtl/mips64/math.inc

@@ -0,0 +1,13 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2022 by Florian Klaempfl
+   members of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}

rtl/mips64/mips64.inc

@@ -0,0 +1,13 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2022 by Florian Klaempfl
+   members of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}

rtl/mips64/setjumph.inc

@@ -0,0 +1,26 @@
+{******************************************************************************
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000-2002 by Jonas Maebe and David Zhang
+
+    SetJmp/Longjmp declarations MIPS64
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+******************************************************************************}
+
+type
+  jmp_buf=packed record
+    ra,sp,s0,s1,s2,s3,s4,s5,s6,s7,fp,gp: longint;
+{$if defined(FPUMIPS2) or defined(FPUMIPS3)}
+    _fcsr,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30,f31: longint;
+{$endif FPUMIPS2 or FPUMIPS3}
+  end;
+  Pjmp_buf=^jmp_buf;
+
+function setjmp(var S:jmp_buf):longint;[external name 'FPC_SETJMP'];
+procedure longjmp(var S:jmp_buf;value:longint);[external name 'FPC_LONGJMP'];

rtl/mips64el/cpuh.inc

@@ -0,0 +1,15 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2022 by Florian Klaempfl
+   members of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$I ../mips64/math.inc}