Freepascal

Freepascal oder FPC ist ein freier Pascal-Compiler. Die passende IDE Lazarus gibt es für alle gängigen Plattformen.

aktuelle Änderungen

• Es gibt Bemühungen zu Delphi(tm) kompatibel zu werden
• FreePascal ist aber zunehmend innovativer in Sprachumfang und bei den Zielsystemen
• FreePascal erstellt ausführbaren Code der etwas langsamer ist als der hochoptimierende Delphi-Windows-Compiler

• Compiler: https://gitlab.com/freepascal.org/fpc/source/-/commits/main
• IDE: https://gitlab.com/freepascal.org/lazarus/lazarus/-/commits/main
• Wiki: https://wiki.freepascal.org/Special:RecentChanges?hidebots=1&limit=50&days=7&enhanced=1&urlversion=2

OrgaMon-Projekte

keepcon, bakexternal, domadd, lOrgaMon, Polyzalos, HTTP2

Installation

• Für OpenSuse sollten ausschliesslich für diese Plattform compilierte Pakete verwendet werden. Das Standard 64-Bit Paket von Sourceforge wird nicht laufen!

#
# Option 1: aus "Factory"
#
zypper ar --refresh http://download.opensuse.org/repositories/devel:/languages:/pascal/openSUSE_Factory/devel:languages:pascal.repo

#
# Option 2: aus "42.1"
#
zypper ar --refresh http://download.opensuse.org/repositories/devel:languages:pascal/openSUSE_Leap_42.1/devel:languages:pascal.repo

#
# ein erstmaliger Download des Repository-Index, dem "Key" kann man mit 
# Taste <A> dauerhaft vertrauen
#
zypper refresh

#
# die eigentliche Installation
#
zypper install lazarus

Unterschiede

FileAge(FileName: UnicodeString; out LastWrite: TDateTime): boolean

• Delphi liefert einen abgeschnittenen ms Wert, also :19 s
• Freepascal liefert einen gerundeten s Wert, also :20 s

AnsiUpperCase

• die Funktionen AnsiUpperCase und AnsiLowerCase arbeiten in Freepascal nicht mit ü und unzähligen anderen "special chars", diese Zeichen bleiben einfach unberührt
• Workaround 1 (wird nicht mehr verwendet):

function AnsiUpperCase(const S: string): string;
begin
 if length(s)>0 then
   begin
     result:=s;
     UniqueString(result);
     CharUpperBuffA(pchar(result),length(result));
   end
 else
   result:=;
end;

• Workaround 2 (aktiv als ANSI_Upper(), ANSI_Lower())
• Ich habe ein Programm geschrieben, das aus den "offiziellen" Charset- Beschreibungen 2 Look-Up-Tabellen zur Umkodierung erstellt (eine für LowerCase, eine für UpperCase)
  • Source-Code: https://github.com/Andreas-Filsinger/OrgaMon/blob/main/Lazarus/ANSI_UpperLower/ansi8859txt.pas
  • Quelle: https://en.wikipedia.org/wiki/ISO/IEC_8859
  • Quelle: https://unicode.org/Public/MAPPINGS/ISO8859/
• Ich habe auf AVX, SIMD, SSE oder andere Dinge gehofft die mit Look-Up-Tabellen helfen, kam in der Recherche aber nicht weiter
  • SSE oder AVX verwenden? Also wir haben eine 8-Bit Look up table LUT[0..255]

# Lookup Table, LUT = 256 Bytes (2048 Bit)
# src, der Ausgangsstrin liefert mit jedem Char den Index (8 Bit Index) für die Look-Up-Tabelle. Mit diesem Index wird LUT ausgelesen, das ist das neue Zeichen. In vielen Fällen
# gibt es keine Änderung, z.B. "A" bleibt "A". Aus Performanche-Gründen interessieren diese Details aber nicht

 const
  LUT  
  {ANSI_8859_15_Upper} : array[0..255] of char = (#$00, #$01,
  #$02, #$03, #$04, #$05, #$06, #$07, #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F, #$10, #$11,
  #$12, #$13, #$14, #$15, #$16, #$17, #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F, #$20, #$21,
  #$22, #$23, #$24, #$25, #$26, #$27, #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F, #$30, #$31,
  #$32, #$33, #$34, #$35, #$36, #$37, #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F, #$40, #$41,
  #$42, #$43, #$44, #$45, #$46, #$47, #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F, #$50, #$51,
  #$52, #$53, #$54, #$55, #$56, #$57, #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F, #$60, {#$61->}#$41,
  {#$62->}#$42, {#$63->}#$43, {#$64->}#$44, {#$65->}#$45, {#$66->}#$46, {#$67->}#$47, {#$68->}#$48, {#$69->}#$49, {#$6A->}#$4A, {#$6B->}#$4B, {#$6C->}#$4C, {#$6D->}#$4D, {#$6E->}#$4E, {#$6F->}#$4F, {#$70->}#$50, {#$71->}#$51,
  {#$72->}#$52, {#$73->}#$53, {#$74->}#$54, {#$75->}#$55, {#$76->}#$56, {#$77->}#$57, {#$78->}#$58, {#$79->}#$59, {#$7A->}#$5A, #$7B, #$7C, #$7D, #$7E, #$7F, #$80, #$81,
  #$82, #$83, #$84, #$85, #$86, #$87, #$88, #$89, #$8A, #$8B, #$8C, #$8D, #$8E, #$8F, #$90, #$91,
  #$92, #$93, #$94, #$95, #$96, #$97, #$98, #$99, #$9A, #$9B, #$9C, #$9D, #$9E, #$9F, #$A0, #$A1,
  #$A2, #$A3, #$A4, #$A5, #$A6, #$A7, {#$A8->}#$A6, #$A9, #$AA, #$AB, #$AC, #$AD, #$AE, #$AF, #$B0, #$B1,
  #$B2, #$B3, #$B4, #$B5, #$B6, #$B7, {#$B8->}#$B4, #$B9, #$BA, #$BB, #$BC, {#$BD->}#$BC, #$BE, #$BF, #$C0, #$C1,
  #$C2, #$C3, #$C4, #$C5, #$C6, #$C7, #$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF, #$D0, #$D1,
  #$D2, #$D3, #$D4, #$D5, #$D6, #$D7, #$D8, #$D9, #$DA, #$DB, #$DC, #$DD, #$DE, #$DF, {#$E0->}#$C0, {#$E1->}#$C1,
  {#$E2->}#$C2, {#$E3->}#$C3, {#$E4->}#$C4, {#$E5->}#$C5, {#$E6->}#$C6, {#$E7->}#$C7, {#$E8->}#$C8, {#$E9->}#$C9, {#$EA->}#$CA, {#$EB->}#$CB, {#$EC->}#$CC, {#$ED->}#$CD, {#$EE->}#$CE, {#$EF->}#$CF, {#$F0->}#$D0, {#$F1->}#$D1,
  {#$F2->}#$D2, {#$F3->}#$D3, {#$F4->}#$D4, {#$F5->}#$D5, {#$F6->}#$D6, #$F7, {#$F8->}#$D8, {#$F9->}#$D9, {#$FA->}#$DA, {#$FB->}#$DB, {#$FC->}#$DC, {#$FD->}#$DD, {#$FE->}#$DE, {#$FF->}#$BE);
 
 l := length(src);
 SetLength(result,l);
 for n := 1 to l do
  result[n] := LUT[ord(src[n])]

Beispiel

program circularreference;

procedure Marco(n: Integer); forward;

procedure Polo(n: Integer);
begin
  write('Polo');
  if (n>0) then
   Marco(n-1);
end;

procedure Marco(n: Integer);
begin
  write('Macro');
  if (n>0) then
   Polo(n-1);
end;

begin
  Marco(10);
  writeln;
  Polo(10);
  writeln;

  readln;
end.

Spracherweiterungen

• hier fasse ich einige Spracherweiterungen auf, die mir so einfallen
• Intel Parallel Building Blocks (PBB)
• OpenMP
• Ev. kommt mir hier das kommende LLVM Target von FreePascal zugute

"param" anstelle von "var"

 var
  MomentTimeout : ANFiXDate; Parameter;
  c,i,r : integer; Parameter;
  
 begin
    // all zu alte Einträge löschen
    MomentTimeout := DatePlus(DateGet, -10);
    i := 0;
    c := colOf('MOMENT');
    for r := RowCount downto 1 do
      if (StrToIntDef(readCell(r, c), 0) < MomentTimeout) then
      begin
        del(r);
        inc(i);
      end;
    if (i > 0) then
      Log('INFO: ' + 'gebe ' + inttostr(i) +
        ' Dateieinträge frei, da sie älter als 10 Tage sind');
 end;

"param" Variable sind wie "var" Variable, die aber erst gesetzt werden, wenn ein (erster) lesender Zugriff erfolgt. Das "Setzen" des VAriablen-Wertes erfolgt gar nicht, an dieser Stelle wird kein Code ausgeführt, erst beim ersten Vergleich wird "MomentTimeout" gesetzt. Danach wird MomentTimeout wie eine normale Variable verwendet. Dadurch lässt sich der Code übersichtlicher gestalten. Man kann die "gathering" Phase schön beisammenhalten - auch wenn die die Kosten hoch sind. Es wird jedoch keine Zeit verbraten, und eine Menge komplexe if-Bedingungen gespart.

nebenläufige Zuweisung

var
 a,b : integer; Concurrent;

begin
 a := sql('count SOULS from EARTH');
 b := sql('count STARS from UNIVERSE');
 if (a>=b) then
   beep;
end;

Die Zuweisung nach a erfolgt in einem eigenen Thread. DIe Codeausführung wird sofort mit der nächsten Zeile fortgesetzt. Auch für die Zuweisung zu b wird ein Thread gestartet. Erst bei einem lesenden Zugriff auf a oder b wird auf das Ergebnis (= Beendigung des Threads) gewartet, ein erneuter schreibender ZUgriff auf a oder b würde den Thread ohne Warten auf das Ergebnis abbrechen.

prism statement

Ich denke über eine Optimierung nach, einen Sonderfall des "case" Statements nach. Der Compiler könnte es automatisch machen oder er durch "prism" gezwungen.

prism c 
 0..3:
 4..9:
 10:
 13:
else
end;

• dies würde vom Compiler nicht mit einer "if" Kette entschieden, sondern mit einer Jumptable mit 14 Einträgen. c wird als Offset interprätiert um die Jumptable zu adressieren. 11 und 12 springen in den "else" Zweig, <0 oder >13 auch. Die "Entscheidung"

• fpc\compiler\x86_64\nx64set.pas Line 63 ff
• Optimierung nur bei -Os, (=size), ich halte aber auch "speed" für ein Argument

• die Optimierung für bei einer Hohen Granularität sind keiner erhöhten Code Grösse
  • Beispiel, ein Range verschlechtert die Granularität 99..110 würde 12 JMP Table Einträge erzeugen!
• bei wesentlichen Lücken im case Statement würden viele "NOP"-Einträge entstehen
  • case n of 0: 20: else end; es würden für 1..19 "Lücken" entstehen, die alle nach "else" springen
• Linear-Verschiebung, Normalisierung: case n -2: -1: 0: 1: 2: end; muss normalisiert werden auf 0: .. 4: ohne "n" zu ändern

• case statement ohne "ranges", also KEIN 0..18
• case statement ohne nennenswerte Lücken

JMP [Table+AX*8]

.GLOBAL calculate
calculate:
   pushl %ebp
   movl %esp,%ebp
   movl 12(%ebp),%eax
   movl 8(%ebp),%ecx
   cmpl $2,%ecx
   ja done
   jmp *operations(,%ecx,4)
operation1:
   imull %eax,%eax
   jmp done
operation2:
   negl %eax
   jmp done
operation3:
   addl $0x80,%eax
done:
   leave
   ret
operations:
   .long operation1, operation2, operation3

• http://www.mindfruit.co.uk/2012/01/switch-blocks-jump-tables.html

my way would be (assumed 64-bit mode yet):
;entry in rax and all entries contain a valid address
;a limit check here may not hurt much.

 jmp [table+rax*8]            ;if in the data-seg or
 jmp cs:[table+rax*8]         ;if the table is part of the code section
;also possible if your compiler is able to:
 jmp [rip+table_offset+rax*8] ;RIP access uses CS by default

__
wolfgang

The code I posted here first was a test-case-stand-alone example that
I constructed so I could learn how to write jump tables. In the end
though I am looking to include an assembly function into a library
which is built in a static and a dynamic version using libtool and
autoconf/automake. As I mentioned on linux-assembly, the linker was
complaining about my jump table telling me that it can't relocate some
symbols. I used a C program with a large switch statement and gcc with
-fPIC to see how to deal with PIC and am using the version below now.
Just as gcc does, I placed the jump table in .section .rodata, but I
am not sure if that's equivalent to placing it in the .data section or
not.

 .text
 .global jump_table
 .type jump_table, @function

jump_table:
 # Push stack pointer so we can make room for local storage.
 push %rax

 mov $0x02, %rax # Move index into rax; 2 is supposed to end up at
label_02.

 lea 0(,%rax, 4), %rdx
 lea table(%rip), %rax
 mov (%rdx, %rax), %edx
 movslq %edx, %rdx
 lea table(%rip), %rax
 lea (%rdx, %rax), %rax
 jmp *%rax

 .section .rodata
 .align 4
table:
 .long label_00-table
 .long label_01-table
 .long label_02-table
 .long label_03-table

 .text
label_00:
 jmp done

label_01:
 jmp done

label_02:
 jmp done

label_03:
 jmp done

done:
 pop %rax
 ret

 .size jump_table, .-jump_table

• fpc\tests\webtbs\tw10641.pp (Jumptable)
• fpc\tests\webtbs\tw3577.pp (Jumptable)
• fpc\tests\webtbs\tw11638.pp (Code-Länge des JMP)

Umsetzungsprobleme

• ich habe keine Möglichkeit im Assembler mir zu wünschen dass immer ein far-Jump mit 5 Bytes erstellt wird, es wird optimiert und zwar ensteht bein kurzen Jumps ein 2 Byte grosser Befehl
• will ich den Befehl selbst codieren, dann ensteht 2 neue Probleme:
  • DB $e9,$72,$00,$00,$00 also ich bekomme das $7 nicht hin (dieses Bit ist vorgegeben)
  • DB $e9
  • DB $70|(@there-@here) // 1. Problem: binäres oder? 2.Problem: Minus Operation

#$66#$66#$0F#$1F#$84#$00#$00#$00#$00#$00 -> data16 nop WORD PTR [rax+rax*1+0x0]
#$66#$2e#$0f#$1f#$84#$00#$00#$00#$00#$00 -> nop WORD PTR cs:[rax+rax*1+0x0]

Die "long" NOPs :

• https://stackoverflow.com/questions/12559475/what-does-nopl-do-in-x86-system
• http://www.felixcloutier.com/x86/NOP.html
• https://github.com/redox-os/binutils-gdb/blob/master/bfd/cpu-i386.c
• gas:
  • https://github.com/bminor/binutils-gdb/blob/master/gas/config/tc-i386.c
  • https://github.com/bminor/binutils-gdb/commit/80b8656cbaaf09b685c2f3c9dd96f61274ed7fb7#diff-c3c1bdcf15ebcd70b899275b3486272b

Beispiel

; Example 3.12. switch with relative pointers, 64 bit, YASM syntax
SECTION .data
jumptable: dd case1-jumptable, case2-jumptable, case3-jumptable
SECTION .text
default rel ; use relative addresses
funcb: ; This function implements a switch statement
mov eax, [rsp+8] ; function parameter
cmp eax, 3
jnb case_default ; index out of range
lea rdx, [jumptable] ; address of table
movsxd rax, dword [rdx+rax*4] ; read table entry
; The jump addresses are relative to jumptable, get absolute address:
add rax, rdx
jmp rax ; jump to desired case
case1: ...
ret
case2: ...
ret
case3: ...
ret
case_default:
...
ret

relevante Projekte

• https://github.com/mikerabat/mrmath
• https://de.wikipedia.org/wiki/Netwide_Assembler