Mega Top 1/os2_top1.zip/os2_top1/APPS/PROG/PASCAL/SPEED2/SRC/LIB/SYSTEM.PAS

Pascal/Delphi Source File | 1994-10-11 | 130.4 KB | 5,422 lines

{$%} {Forces the compiler to accept SYSTEM as a unit}
UNIT SYSTEM;

{**************************************************************************
*                                                                         *
*                                                                         *
*                                                                         *
*         Main SYSTEM application routines and basic OS/2 APIs            *
*                                                                         *
*                                                                         *
*                                                                         *
*                                                                         *
***************************************************************************}


INTERFACE

CONST
     {Note: An ARRAY [0..x] OF CHAR is equal to a PSTRING[x] !}


     MAXINT       =32767;
     MININT       =-32768;
     MAXLONGINT   =$7FFFFFFF;
     MINLONGINT   =$80000001;
     NULLHANDLE   =0;
     NULL         =0;

TYPE
     APIRET=LONGWORD;
     PVOID=POINTER;

     SHANDLE=WORD;
     LHANDLE=LONGWORD;

TYPE
     UCHAR=BYTE;
     USHORT=WORD;
     ULONG=LONGWORD;
     UINT=WORD;
     LONG=LONGWORD;
     SHORT=INTEGER;

     PSZ=PString;

     BOOL=LONGWORD;

     QWORD=RECORD
                 ulLo:ULONG;
                 ulHi:ULONG;
           END;

     SEL=WORD;

     { Common Error definitions }
     ERRORID=ULONG;

TYPE
     HMODULE=LHANDLE;
     PID=LHANDLE;
     TID=LHANDLE;
     SGID=USHORT;

     { Common SUP types }

TYPE
     HAB=LHANDLE;

     { Common GPI/DEV types }

     HPS=LHANDLE;
     HDC=LHANDLE;
     HRGN=LHANDLE;
     HBITMAP=LHANDLE;
     HMF=LHANDLE;
     HPAL=LHANDLE;
     COLOR=LONGINT;

TYPE
     POINTL=RECORD
                  x:LONGINT;
                  y:LONGINT;
            END;

     POINTS=RECORD
                  x:INTEGER;
                  y:INTEGER;
            END;

     RECTL=RECORD
               xLeft:LONGINT;
               yBottom:LONGINT;
               xRight:LONGINT;
               yTop:LONGINT;
           END;

TYPE
      HWND=LHANDLE;
      HMQ=LHANDLE;
      WRECT=RECTL;
      WPOINT=POINTL;

     { font struct for Vio/GpiCreateLogFont }

CONST
     { size for fields in the font structures }
     FACESIZE                    =32;

TYPE
     FATTRS=RECORD
                  usRecordLength:USHORT;
                  fsSelection:USHORT;
                  lMatch:LONGINT;
                  szFacename:PSTRING[FACESIZE-1];
                  idRegistry:USHORT;
                  usCodePage:USHORT;
                  lMaxBaselineExt:LONGINT;
                  lAveCharWidth:LONG;
                  fsType:USHORT;
                  fsFontUse:USHORT;
           END;

TYPE
     PANOSE=RECORD
                  bFamilyType:BYTE;
                  bSerifStyle:BYTE;
                  bWeight:BYTE;
                  bProportion:BYTE;
                  bContrast:BYTE;
                  bStrokeVariation:BYTE;
                  bArmStyle:BYTE;
                  bLetterform:BYTE;
                  bMidline:BYTE;
                  bXHeight:BYTE;
                  fbPassedISO:BYTE;
                  fbFailedISO:BYTE;
            END;

     FONTMETRICS=RECORD
                      szFamilyname:PSTRING[FACESIZE-1];
                      szFacename:PSTRING[FACESIZE-1];
                      idRegistry:USHORT;
                      usCodePage:USHORT;
                      lEmHeight:LONG;
                      lXHeight:LONG;
                      lMaxAscender:LONG;
                      lMaxDescender:LONG;
                      lLowerCaseAscent:LONG;
                      lLowerCaseDescent:LONG;
                      lInternalLeading:LONG;
                      lExternalLeading:LONG;
                      lAveCharWidth:LONG;
                      lMaxCharInc:LONG;
                      lEmInc:LONG;
                      lMaxBaselineExt:LONG;
                      sCharSlope:SHORT;
                      sInlineDir:SHORT;
                      sCharRot:SHORT;
                      usWeightClass:USHORT;
                      usWidthClass:USHORT;
                      sXDeviceRes:SHORT;
                      sYDeviceRes:SHORT;
                      sFirstChar:SHORT;
                      sLastChar:SHORT;
                      sDefaultChar:SHORT;
                      sBreakChar:SHORT;
                      sNominalPointSize:SHORT;
                      sMinimumPointSize:SHORT;
                      sMaximumPointSize:SHORT;
                      fsType:USHORT;
                      fsDefn:USHORT;
                      fsSelection:USHORT;
                      fsCapabilities:USHORT;
                      lSubscriptXSize:LONG;
                      lSubscriptYSize:LONG;
                      lSubscriptXOffset:LONG;
                      lSubscriptYOffset:LONG;
                      lSuperscriptXSize:LONG;
                      lSuperscriptYSize:LONG;
                      lSuperscriptXOffset:LONG;
                      lSuperscriptYOffset:LONG;
                      lUnderscoreSize:LONG;
                      lUnderscorePosition:LONG;
                      lStrikeoutSize:LONG;
                      lStrikeoutPosition:LONG;
                      sKerningPairs:SHORT;
                      sFamilyClass:SHORT;
                      lMatch:LONG;
                      FamilyNameAtom:LONG;
                      FaceNameAtom:LONG;
                      _panose:PANOSE;
                 END;

TYPE
     PCHAR=^PSTRING;      {Pointer to Zero terminated string}

     PQMSG=^QMSG;
     QMSG=RECORD
              ahwnd:HWND;
              msg:LONGWORD;
              mp1:POINTER;
              mp2:POINTER;
              time:LONGWORD;
              ptl:POINTL;
              reserved:LONGWORD;
          END;

     PSWP=^SWP;
     SWP=RECORD
               fl:ULONG;
               cy:LONG;
               cx:LONG;
               y:LONG;
               x:LONG;
               hwndInsertBehind:HWND;
               ahwnd:HWND;
               ulReserved1:ULONG;
               ulReserved2:ULONG;
         END;

    PSWPBUF=^TSWPBUF;
    TSWPBUF=ARRAY[0..20] OF SWP;


    PLONGBUF=^TLONGBUF;
    TLONGBUF=ARRAY[0..65530] OF LONGWORD;

    PScreenBuf=^ScreenBuf;
    ScreenBuf=array[0..30] of string;

    _PDATETIME=^_DATETIME;
    _DATETIME=RECORD
                  hours:BYTE;
                  minutes:BYTE;
                  seconds:BYTE;
                  hundredths:BYTE;
                  day:BYTE;
                  month:BYTE;
                  year:WORD;
                  timezone:INTEGER;
                  weekday:BYTE;
             END;

VAR PMScrBuf:PScreenBuf;

CONST
     { Standard Window Messages }
     WM_NULL                  =$0000;
     WM_CREATE                =$0001;
     WM_DESTROY               =$0002;
     WM_ENABLE                =$0004;
     WM_SHOW                  =$0005;
     WM_MOVE                  =$0006;
     WM_SIZE                  =$0007;
     WM_ADJUSTWINDOWPOS       =$0008;
     WM_CALCVALIDRECTS        =$0009;
     WM_SETWINDOWPARAMS       =$000a;
     WM_QUERYWINDOWPARAMS     =$000b;
     WM_HITTEST               =$000c;
     WM_ACTIVATE              =$000d;
     WM_SETFOCUS              =$000f;
     WM_SETSELECTION          =$0010;
     WM_PPAINT                =$0011;
     WM_PSETFOCUS             =$0012;
     WM_PSYSCOLORCHANGE       =$0013;
     WM_PSIZE                 =$0014;
     WM_PACTIVATE             =$0015;
     WM_PCONTROL              =$0016;
     WM_COMMAND               =$0020;
     WM_SYSCOMMAND            =$0021;
     WM_HELP                  =$0022;
     WM_PAINT                 =$0023;
     WM_TIMER                 =$0024;
     WM_SEM1                  =$0025;
     WM_SEM2                  =$0026;
     WM_SEM3                  =$0027;
     WM_SEM4                  =$0028;
     WM_CLOSE                 =$0029;
     WM_QUIT                  =$002a;
     WM_SYSCOLORCHANGE        =$002b;
     WM_SYSVALUECHANGED       =$002d;
     WM_APPTERMINATENOTIFY    =$002e;
     WM_PRESPARAMCHANGED      =$002f;

     { Control notification messages }
     WM_CONTROL               =$0030;
     WM_VSCROLL               =$0031;
     WM_HSCROLL               =$0032;
     WM_INITMENU              =$0033;
     WM_MENUSELECT            =$0034;
     WM_MENUEND               =$0035;
     WM_DRAWITEM              =$0036;
     WM_MEASUREITEM           =$0037;
     WM_CONTROLPOINTER        =$0038;
     WM_QUERYDLGCODE          =$003a;
     WM_INITDLG               =$003b;
     WM_SUBSTITUTESTRING      =$003c;
     WM_MATCHMNEMONIC         =$003d;
     WM_SAVEAPPLICATION       =$003e;

     { Frame window related messages }

     WM_FLASHWINDOW           =$0040;
     WM_FORMATFRAME           =$0041;
     WM_UPDATEFRAME           =$0042;
     WM_FOCUSCHANGE           =$0043;

     WM_SETBORDERSIZE         =$0044;
     WM_TRACKFRAME            =$0045;
     WM_MINMAXFRAME           =$0046;
     WM_SETICON               =$0047;
     WM_QUERYICON             =$0048;
     WM_SETACCELTABLE         =$0049;
     WM_QUERYACCELTABLE       =$004a;
     WM_TRANSLATEACCEL        =$004b;
     WM_QUERYTRACKINFO        =$004c;
     WM_QUERYBORDERSIZE       =$004d;
     WM_NEXTMENU              =$004e;
     WM_ERASEBACKGROUND       =$004f;
     WM_QUERYFRAMEINFO        =$0050;
     WM_QUERYFOCUSCHAIN       =$0051;
     WM_OWNERPOSCHANGE        =$0052;
     WM_CALCFRAMERECT         =$0053;
     WM_WINDOWPOSCHANGED      =$0055;
     WM_ADJUSTFRAMEPOS        =$0056;
     WM_QUERYFRAMECTLCOUNT    =$0059;
     WM_QUERYHELPINFO         =$005B;
     WM_SETHELPINFO           =$005C;
     WM_ERROR                 =$005D;
     WM_REALIZEPALETTE        =$005E;

     { Key/Character input messages }
     WM_CHAR                  =$007a;
     WM_VIOCHAR               =$007b;

     { Mouse input messages }
     WM_MOUSEFIRST            =$0070;
     WM_MOUSELAST             =$0079;
     WM_BUTTONCLICKFIRST      =$0071;
     WM_BUTTONCLICKLAST       =$0079;
     WM_MOUSEMOVE             =$0070;
     WM_BUTTON1DOWN           =$0071;
     WM_BUTTON1UP             =$0072;
     WM_BUTTON1DBLCLK         =$0073;
     WM_BUTTON2DOWN           =$0074;
     WM_BUTTON2UP             =$0075;
     WM_BUTTON2DBLCLK         =$0076;
     WM_BUTTON3DOWN           =$0077;
     WM_BUTTON3UP             =$0078;
     WM_BUTTON3DBLCLK         =$0079;
     WM_MOUSEMAP              =$007D;
     WM_EXTMOUSEFIRST         =$0410;
     WM_EXTMOUSELAST          =$0419;
     WM_CHORD                 =$0410;
     WM_BUTTON1MOTIONSTART    =$0411;
     WM_BUTTON1MOTIONEND      =$0412;
     WM_BUTTON1CLICK          =$0413;
     WM_BUTTON2MOTIONSTART    =$0414;
     WM_BUTTON2MOTIONEND      =$0415;
     WM_BUTTON2CLICK          =$0416;
     WM_BUTTON3MOTIONSTART    =$0417;
     WM_BUTTON3MOTIONEND      =$0418;
     WM_BUTTON3CLICK          =$0419;
     WM_MOUSETRANSLATEFIRST   =$0420;
     WM_MOUSETRANSLATELAST    =$0428;
     WM_BEGINDRAG             =$0420;
     WM_ENDDRAG               =$0421;
     WM_SINGLESELECT          =$0422;
     WM_OPEN                  =$0423;
     WM_CONTEXTMENU           =$0424;
     WM_CONTEXTHELP           =$0425;
     WM_TEXTEDIT              =$0426;
     WM_BEGINSELECT           =$0427;
     WM_ENDSELECT             =$0428;
     WM_PENFIRST              =$04C0;
     WM_PENLAST               =$04FF;
     WM_MMPMFIRST             =$0500;
     WM_MMPMLAST              =$05FF;

     WM_HELPBASE              =$0F00; {Start of msgs for help manager}
     WM_HELPTOP               =$0FFF; { End of msgs for help manager }

     WM_USER                  =$1000;

VAR CheckBreak:BOOLEAN;        {Enables/Disables Ctrl-Break checks}
    ExitCode:WORD;             {The exitcode from main process}
    ErrorAddr:LONGWORD;        {32 Bit linear error adress}
    ExitProc:POINTER;          {Exit procedures chain}
    IORESULT:LONGWORD;         {In/Out result code}
    FPUResult:LONGWORD;        {FPU result code}
    SEEKMODE:LongWord;         {Mode for file seek operations}
    FILEMODE:LongWord;         {Mode for file open operations}
    HeapOrg:Pointer;           {Bottom of heap}
    HeapEnd:Pointer;           {End of heap}
    HeapPtr:Pointer;           {Actual heap position}
    HeapSize:LONGWORD;         {Size of heap}
    PMCrtWindow:LONGWORD;      {CRT Window for text output}
    PMCrtFrameHandle:LONGWORD; {Frame handle for CRT Window}
    PMCrtTitle:STRING;         {Title for CRT Window}
    DrawLocX,DrawLocY:LONGWORD;{Actual drawing position}
    Apphandle:LONGWORD;        {Main application PM anchor handle}
    AppQueueHandle:LONGWORD;   {Main application queue handle}
    AlternateExit:BOOLEAN;     {Set if PMObject is active for WM_QUIT Message}
    MaxLines:LONGWORD;         {Maximal count of crt lines}
    TextCol,TextBackCol:LONGWORD;  {Current colors for text output}
    CrtKeyCount:Byte;
    KeyBuffer:array[0..33] of char;
    CursorVisible:LONGWORD;    {indicates that cursor is visible/invisible}
    MaxDrawStarty,MaxDrawLeny:LONGWORD;
    ArgStart:POINTER; {Pointer to program arguments}
    BlockReadResult:LONGWORD;
    BlockWriteResult:LONGWORD;
    DllModule:LONGWORD;  {When the module is a DLL Init Module at main BEGIN}
    DllTerminating:LONGWORD; {When the module is a DLL Terminating flag at main BEGIN}
    DllInitTermResult:LONGWORD; {indicates success of DLL init/term}
    ModuleCount:BYTE; {If it is a DLL modules currently using this DLL}



CONST
    rad=1;
    deg=2;
    gra=3;

VAR
    IsNotRad:BOOLEAN;
    ToRad,FromRad:EXTENDED;


FUNCTION  MAXAVAIL:LongWord;
FUNCTION  MEMAVAIL:LongWord;
PROCEDURE GETMEM(var p:Pointer;size:LongWord);
PROCEDURE FREEMEM(var p:pointer;size:LongWord);
PROCEDURE NewSystemHeap;  {free the whole (!) heap and generate new heap}

PROCEDURE BYTEMOVE(var source;var dest;size:LongWord);
PROCEDURE MOVE(var source;var dest;size:LongWord);
PROCEDURE FILLCHAR(var dest;size:LongWord;value:byte);

FUNCTION POS(item:string;source:string):Byte;
FUNCTION COPY(source:string;start,ende:Byte):String;
PROCEDURE SUBSTR(VAR source:string;start,ende:Byte);
FUNCTION ToStr(l:longint):string;
FUNCTION  UPCASE(item:char):Char;
PROCEDURE Insert(Source:String;VAR s:string;Ind:Byte);
PROCEDURE Delete(Var s:string;Ind:byte;len:byte);
PROCEDURE CopyStrPChar(s:String;VAR p:PCHAR);
PROCEDURE CopyPCharStr(p:PChar;VAR s:STRING);
PROCEDURE Beep(Freq,duration:LONGWORD);

PROCEDURE Seek(var f:file;n:LongWord);
FUNCTION FilePos(var f:file):LongWord;
FUNCTION FileSize(var f:file):LongWord;
PROCEDURE Reset(var f:file;recsize:LongWord);
PROCEDURE Rewrite(var f:file;recsize:LongWord);
PROCEDURE BlockWrite(VAR f:file;var Buf;Count:LongWord);
PROCEDURE BlockRead(VAR f:file;var Buf;Count:LongWord);
PROCEDURE Rename(VAR f:file;Newname:String);
PROCEDURE CLOSE(VAR f:file);
PROCEDURE ASSIGN(VAR f:file;s:String);
FUNCTION Eof(VAR f:FILE):Boolean;
PROCEDURE Erase(name:STRING);
PROCEDURE CHDIR(path:string);
PROCEDURE GETDIR(drive:byte;var path:string);
PROCEDURE RMDIR(dir:string);
PROCEDURE MKDIR(dir:string);

PROCEDURE ClrScr;
FUNCTION KeyPressed: Boolean;
FUNCTION ReadKey: Char;
PROCEDURE CreateLogFont(_HPS:LONGWORD;VAR facename:STRING;hei,len,
                        SelAttr:LONGWORD);
PROCEDURE GOTOXY(x,y:LONGWORD);

FUNCTION  PARAMSTR(item:Byte):string;
FUNCTION  PARAMCOUNT:Byte;
PROCEDURE PutMemPtr(p:Pointer;Offset:LONGWORD;Value:BYTE);
FUNCTION GetMemPtr(p:Pointer;Offset:LONGWORD):BYTE;
PROCEDURE Halt(code:BYTE);
PROCEDURE RunError(Code:BYTE);
PROCEDURE SetTrigMode(mode:BYTE);

PROCEDURE MainDispatchLoop;

FUNCTION LongToPointer(l:LONGWORD):POINTER;
FUNCTION PointerToLong(p:POINTER):LONGWORD;

PROCEDURE Randomize;
FUNCTION  Random(value:word):word;

FUNCTION SHORT1FROMMP(p:POINTER):WORD;
FUNCTION SHORT2FROMMP(p:POINTER):WORD;
FUNCTION MPFrom2Short(s1,s2:Word):POINTER;
FUNCTION MPFromShort(s:Word):POINTER;


IMPLEMENTATION


FUNCTION SHORT1FROMMP(p:POINTER):WORD;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV AX,[EBX+4]
        RETN32 4
     END;
END;

FUNCTION SHORT2FROMMP(p:POINTER):WORD;ASM;
BEGIN

     ASM
        MOV EBX,ESP
        MOV AX,[EBX+6]
        RETN32 4
     END;
END;

FUNCTION MPFrom2Short(s1,s2:Word):POINTER;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV AX,[EBX+4]
        PUSH AX
        MOV AX,[EBX+6]
        PUSH AX
        POP EAX
        RETN32 4
     END;
END;

FUNCTION MPFromShort(s:Word):POINTER;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV AX,[EBX+4]
        MOVZX EAX,AX
        RETN32 2
     END;
END;


{**************************************************************************
*                                                                         *
*  Set support routines                                                   *
*                                                                         *
***************************************************************************}

ASSEMBLER

!SetAssign PROC NEAR32
          PUSH EBP
          MOV EBP,ESP

          MOV EDI,[EBP+8]   ;Ziel
          MOV ECX,8
          MOV EAX,0
          CLD
          REP
          STOSW

          MOV EDI,[EBP+8]   ;Ziel
          MOV CX,[EBP+12]   ;Parameter count
          CMP CX,0
          JE !NSAs          ;only clear set
          MOVZX ECX,CX
          LEA ESI,[EBP+14]  ;Points to first parameter
!plo:
          MOV AL,[ESI+0]    ;Get value of parameter
          XOR AH,AH
          MOV BX,16
          XOR EDX,EDX
          DIV BX            ;Calculate Word position
          SHL AX,1
          MOVZX EAX,AX
          ADD EDI,EAX
          MOV AX,DX         ;Bit Position [0..15]
          SHL AX,1
          MOVZX EAX,AX
          MOV EBX,OFFSET(@SetTab)
          ADD EBX,EAX
          MOV AX,[EBX+0]
          MOVZX EAX,AX
          MOV BX,[EDI+0]    ;Old Value
          OR AX,BX
          MOV [EDI+0],AX    ;Store new value

          INC ESI
          INC ESI
          MOV EDI,[EBP+8]   ;Ziel
          LOOP !plo         ;until all parameters processed
!NSAs:
          LEAVE
          RETN32 6          ;Return to caller
@SetTab dw 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768
!SetAssign ENDP

!SetAnd PROC NEAR32
          PUSH EBP
          MOV EBP,ESP
          MOV EDI,[EBP+8]   ;Ziel
          MOV ESI,[EBP+12]
          MOV ECX,8
!SAndl:
          MOV EAX,[ESI+0]
          AND EAX,[EDI+0]
          MOV [EDI+0],EAX
          ADD ESI,4
          ADD EDI,4
          LOOP !SAndl

          LEAVE
          RETN32 8
!SetAnd ENDP

!NegateSet PROC NEAR32
          PUSH EBP
          MOV EBP,ESP

          MOV EDI,[EBP+8]
          MOV ECX,8
!NS_l:
          MOV EAX,[EDI+0]
          NOT EAX
          MOV [EDI+0],EAX
          ADD EDI,4
          LOOP !NS_l

          LEAVE
          RETN32 4
!NegateSet ENDP

!TempSetAnd PROC NEAR32
           PUSH EBP
           MOV EBP,ESP
           SUB ESP,32

           MOV EDI,[EBP+8]   ;Ziel
           MOV CL,[EBP+12]   ;Count
           MOVZX ECX,CL
           LEA ESI,[EBP+14]  ;First Parameter
!TSAl:
           MOV AX,[ESI+0]
           PUSH AX
           INC ESI
           INC ESI
           LOOP !TSAl
           MOV CL,[EBP+12]   ;Count
           XOR CH,CH
           PUSH CX
           LEA EAX,[EBP-32]
           PUSH EAX
           CALLN32 !SetAssign
           MOV AL,[EBP+12]   ;Count
           MOVZX EAX,AL
           SHL EAX,1
           ADD ESP,EAX

           LEA EAX,[EBP-32]
           PUSH EAX
           MOV EAX,[EBP+8]   ;Ziel
           PUSH EAX
           CALLN32 !SetAnd

           LEAVE
           RETN32 6
!TempSetAnd ENDP

!SetOr PROC NEAR32
          PUSH EBP
          MOV EBP,ESP
          MOV EDI,[EBP+8]   ;Ziel
          MOV ESI,[EBP+12]
          MOV ECX,8
!SAndl_1:
          MOV EAX,[ESI+0]
          OR EAX,[EDI+0]
          MOV [EDI+0],EAX
          ADD ESI,4
          ADD EDI,4
          LOOP !SAndl_1

          LEAVE
          RETN32 8
!SetOr ENDP

!TempSetOr PROC NEAR32
           PUSH EBP
           MOV EBP,ESP
           SUB ESP,32

           MOV EDI,[EBP+8]   ;Ziel
           MOV CL,[EBP+12]   ;Count
           MOVZX ECX,CL
           LEA ESI,[EBP+14]  ;First Parameter
!TSAl_1:
           MOV AX,[ESI+0]
           PUSH AX
           INC ESI
           INC ESI
           LOOP !TSAl_1
           MOV CL,[EBP+12]   ;Count
           XOR CH,CH
           PUSH CX
           LEA EAX,[EBP-32]
           PUSH EAX
           CALLN32 !SetAssign
           MOV AL,[EBP+12]   ;Count
           MOVZX EAX,AL
           SHL EAX,1
           ADD ESP,EAX

           LEA EAX,[EBP-32]
           PUSH EAX
           MOV EAX,[EBP+8]   ;Ziel
           PUSH EAX
           CALLN32 !SetOr

           LEAVE
           RETN32 6
!TempSetOr ENDP

!SetAndNot PROC NEAR32
          PUSH EBP
          MOV EBP,ESP
          MOV EDI,[EBP+8]   ;Ziel
          MOV ESI,[EBP+12]
          MOV ECX,8
!SAndl_2:
          MOV EAX,[ESI+0]
          NOT EAX
          AND EAX,[EDI+0]
          MOV [EDI+0],EAX
          ADD ESI,4
          ADD EDI,4
          LOOP !SAndl_2

          LEAVE
          RETN32 8
!SetAndNot ENDP

!TempSetAndNot PROC NEAR32
           PUSH EBP
           MOV EBP,ESP
           SUB ESP,32

           MOV EDI,[EBP+8]   ;Ziel
           MOV CL,[EBP+12]   ;Count
           MOVZX ECX,CL
           LEA ESI,[EBP+14]  ;First Parameter
!TSAl_2:
           MOV AX,[ESI+0]
           PUSH AX
           INC ESI
           INC ESI
           LOOP !TSAl_2
           MOV CL,[EBP+12]   ;Count
           XOR CH,CH
           PUSH CX
           LEA EAX,[EBP-32]
           PUSH EAX
           CALLN32 !SetAssign
           MOV AL,[EBP+12]   ;Count
           MOVZX EAX,AL
           SHL EAX,1
           ADD ESP,EAX

           LEA EAX,[EBP-32]
           PUSH EAX
           MOV EAX,[EBP+8]   ;Ziel
           PUSH EAX
           CALLN32 !SetAndNot

           LEAVE
           RETN32 6
!TempSetAndNot ENDP

!SetCompare PROC NEAR32
          PUSH EBP
          MOV EBP,ESP
          MOV EDI,[EBP+8]   ;Ziel
          MOV ESI,[EBP+12]
          MOV ECX,8
!SCAndl_2:
          MOV EAX,[ESI+0]
          CMP EAX,[EDI+0]
          JNE !SCNot
          ADD ESI,4
          ADD EDI,4
          LOOP !SCAndl_2
          MOV AX,0          ;Sets are equal
          LEAVE
          RETN32 8
!SCNot:
          MOV AX,1          ;not equal
          LEAVE
          RETN32 8
!SetCompare ENDP

!TempSetCompare PROC NEAR32
           PUSH EBP
           MOV EBP,ESP
           SUB ESP,32

           MOV EDI,[EBP+8]   ;Ziel
           MOV CL,[EBP+12]   ;Count
           MOVZX ECX,CL
           LEA ESI,[EBP+14]  ;First Parameter
!TCSAl_2:
           MOV AX,[ESI+0]
           PUSH AX
           INC ESI
           INC ESI
           LOOP !TCSAl_2
           MOV CL,[EBP+12]   ;Count
           XOR CH,CH
           PUSH CX
           LEA EAX,[EBP-32]
           PUSH EAX
           CALLN32 !SetAssign
           MOV AL,[EBP+12]   ;Count
           MOVZX EAX,AL
           SHL EAX,1
           ADD ESP,EAX

           LEA EAX,[EBP-32]
           PUSH EAX
           MOV EAX,[EBP+8]   ;Ziel
           PUSH EAX
           CALLN32 !SetCompare

           LEAVE
           RETN32 6
!TempSetCompare ENDP

END;





{***************************************************************************
*                                                                          *
*     Random numbers support                                               *
*                                                                          *
****************************************************************************}


PROCEDURE Randomize;
VAR d:_DateTime;
    Hour,Minute,Second,Sec100:BYTE;
BEGIN
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,230  ;DosGetDateTime
        ADD ESP,4
     END;
     Hour:=d.hours;
     Minute:=d.minutes;
     Second:=d.Seconds;
     Sec100:=d.Hundredths;
     ASM
        MOV CL,$Minute
        MOV CH,$Hour
        MOV DH,$Second
        MOV DL,$Sec100
        MOV !RandSeed,CX
        MOV !RandSeed+2,DX
     END;
END;

ASSEMBLER

!NextRandom PROC NEAR32
            MOV AX,!RandSeed
            MOV BX,!RandSeed+2
            MOV CX,AX
            MULW !Factor
            SHL CX,3
            ADD CH,CL
            ADD DX,CX
            ADD DX,BX
            SHL BX,2
            ADD DX,BX
            ADD DH,BL
            MOV CL,5
            SHL BX,CL
            ADD DH,BL
            ADD AX,1
            ADC DX,0
            MOV !RandSeed,AX
            MOV !RandSeed+2,DX
            RETN32
!NextRandom ENDP

END;

FUNCTION  RANDOM(value:word):word;ASM;
BEGIN
     ASM
           PUSH EBP
           MOV EBP,ESP
           CALLN32 !NextRandom
           MOV CX,DX
           MOV BX,[EBP+8]
           MUL BX
           MOV AX,CX
           MOV CX,DX
           MUL BX
           ADD AX,CX
           ADC DX,0
           MOV AX,DX
           LEAVE
           RETN32 2
     END;
END;


{***************************************************************************
*                                                                          *
*   Memory management                                                      *
*                                                                          *
****************************************************************************}


PROCEDURE NewSystemHeap;  {delete old system heap and create new one}
BEGIN
    {Free old system heap and generate new}
    ASM
       ;Free old system heap
       PUSHL _HeapOrg
       MOV AL,1
       CALLDLL DosCalls,347   ;DosSubUnsetMem
       ADD ESP,4
       PUSHL _HeapOrg
       MOV AL,1
       CALLDLL DosCalls,304   ;DosFreeMem
       ADD ESP,4

       ;generate new system heap
       MOV EAX,_HeapSize    ;Allocate private memory
       PUSHL 3         ;Flags PAG_READ|PAG_WRITE
       PUSH EAX        ;Length of memory
       PUSHL OFFSET(_Heaporg)
       MOV AL,3             ;3 Parameters
       CALLDLL DosCalls,299 ;DosAllocMem
       ADD ESP,12            ;Clear Stack

       ;Prepare the memory block for suballocation
       PUSHL _HeapSize      ;Size of Heap
       PUSHL 5              ;Flags DOSSUB_INIT|DOSSUB_SPARSE_OBJ
       PUSHL _Heaporg
       MOV AL,3
       CALLDLL DosCalls,344 ;DosSubSetMem
       ADD ESP,12            ;Clear Stack

       ;Set the system pointers
       MOV EAX,_HeapOrg
       MOV _HeapPtr,EAX
       ADD EAX,_HeapSize
       MOV _HeapEnd,EAX
    END;
END;

FUNCTION LongToPointer(l:LONGWORD):POINTER;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV EAX,[EBX+4]
        RETN32 4
     END;
END;

FUNCTION PointerToLong(p:POINTER):LONGWORD;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV EAX,[EBX+4]
        RETN32 4
     END;
END;


PROCEDURE PutMemPtr(p:Pointer;Offset:LONGWORD;Value:BYTE);
BEGIN
     ASM
        MOV EDI,$p
        ADD EDI,$Offset
        MOV AL,$Value
        MOV [EDI+0],AL
     END;
END;

FUNCTION GetMemPtr(p:Pointer;Offset:LONGWORD):BYTE;ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        MOV EDI,$p
        ADD EDI,$Offset
        MOV AL,[EDI+0]
        LEAVE
        RETN32 8
     END;
END;




ASSEMBLER

!ParaInfo PROC NEAR32  ;(AL=Function - 1 count of parameters to CL
                       ;               2 Pointer to parameter CL to ESI
                       ;Input:argument start in ESI
         MOV BX,0      ;we start with parameter 0
         CMP AL,2      ;get parameter name ?
         JNE !no_name
         PUSH ESI
         CMP CL,0      ;parameter 0 required ?
         JE !no_args   ;Thats cool (or it sucks)
         POP ESI
!no_name:
         ;Overread the EXE file name
         CLD
         PUSH AX
!rrloop:
         LODSB
         CMP AL,0
         JNE !rrloop
         POP AX

         CMP AL,2   ;get parameter name ?
         JE !get_argname
         MOV CL,255 ;impossible parameter
!get_argname:
         XOR CH,CH
         MOV BX,1      ;now finally we start with parameter 1

         LODSB
         ;check whether the first character is a separator
         CMP AL,' '
         JE !aagain
         CMP AL,0   ;is this already the end -->Urrgh !
         JNE !al2
         PUSHL 0    ;The (nonexistent) parameters -->Throw it away guy !
         MOV BL,0   ;No parameters
         JMP !no_args
!al2:
         DEC ESI    ;restore old position
!aagain:
         PUSH ESI   ;save last adress
         CMP CL,BL  ;is the parameter reached ??
         JE !no_args
!readloop:
         LODSB
         CMP AL,0
         JE !no_args1  ;No more arguments detected
         ;check all separators possible
         CMP AL,' '
         JE !separator
         ;No separator --> normal character
         JMP !readloop
!separator:
         ;Check whether more separators follow
         LODSB
         CMP AL,' '
         JE !one_more
         CMP AL,0      ;A zero parameter is stupid
         JNE !no_more
         POP EAX       ;Clear stack
         PUSHL 0       ;The (nonexistent) parameter -->Throw it away guy !
         JMP !no_args
!one_more:
         JMP !separator
!no_more:
         DEC ESI
         INC BX        ;Increment parameter count
         POP EAX       ;clear stack
         JMP !aagain
!no_args1:
         ;Argument index was invalid
         POP ESI   ;Clear Stack
         PUSHL 0   ;Pointer to parameter is NIL
!no_args:
         MOV CL,BL     ;Parameter count
         POP ESI       ;Adress of last parameter
         RETN32
!ParaInfo ENDP

END;

FUNCTION  PARAMSTR(item:Byte):string;ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         MOV CL,[EBP+12]             ;index to CL
         MOV AL,2                    ;Get Parameter name
         MOV ESI,_ArgStart
         CALLN32 !ParaInfo
         MOV EDI,[EBP+8]             ;Result string
         MOVB [EDI+0],0              ;Result string is empty
         CMP ESI,0                   ;Parameter invalid ?
         JE _Lpe                     ;--> It sucks !

         MOV EDI,[EBP+8]             ;result string
         XOR AL,AL    ;Stringlen to 0
         STOSB
         MOV CL,0     ;Len is 0
         CLD
__lp1:
         LODSB
         ;Check all separators
         CMP AL,' '
         JE __Lps
         CMP AL,0    ;Last parameter
         JE __Lps
         INC CL
         ;No separator --> save
         STOSB
         JMP __lp1
__Lps:
         MOV AL,0              ;terminate string with zero
         STOSB
         MOV EDI,[EBP+8]       ;Result string
         MOV [EDI+0],CL        ;set Stringlen
_lpe:
         LEAVE
         RETN32 6
    END;
END;



FUNCTION  PARAMCOUNT:Byte;ASM;
BEGIN
     ASM
           MOV AL,1  ;get parametercount
           MOV ESI,_ArgStart
           CALLN32 !ParaInfo
           MOV AL,CL
           XOR AH,AH
           RETN32
     END;
END;



PROCEDURE Beep(Freq,duration:LONGWORD);
BEGIN
     ASM
         PUSHL $duration
         PUSHL $freq
         MOV AL,2
         CALLDLL DOSCALLS,286  ;DosBeep
         ADD ESP,8
     END;
END;



PROCEDURE MainDispatchLoop;
VAR _qmsg:QMSG;
BEGIN
     ASM
!ndis:
        PUSHL 0
        PUSHL 0
        PUSHL 0
        LEA EAX,$_qmsg
        PUSH EAX
        PUSHL _AppHandle
        MOV AL,5
        CALLDLL PMWIN,915  ;WinGetMsg
        ADD ESP,20
        CMP EAX,0
        JE !exdis

        LEA EAX,$_qmsg
        PUSH EAX
        PUSHL _AppHandle
        MOV AL,2
        CALLDLL PMWIN,912  ;WinDispatchMsg
        ADD ESP,8
        JMP !ndis
!exdis:
     END;
END;

PROCEDURE CopyStrPChar(s:String;VAR p:PCHAR);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV ESI,[EBX+8]  ;Source
        MOV EDI,[EBX+4] ;Dest
        MOV CL,[ESI+0]
        INC ESI
        MOVZX ECX,CL
        CMP CX,0
        JE !scpc
        CLD
        REP
        MOVSB
!scpc:
        MOVB [EDI+0],0

        RETN32 8
     END;
END;

PROCEDURE CopyPCharStr(p:PChar;VAR s:String);ASM;
BEGIN
     ASM
        MOV EBX,ESP

        MOV ESI,[EBX+8]  ;Source
        MOV EDI,[EBX+4] ;Dest
        PUSH EDI
        INC EDI
        MOV CL,0
        CLD
!aclo:
        LODSB
        CMP AL,0
        JE !scpc_1
        STOSB
        INC CL
        JMP !aclo
!scpc_1:
        POP EDI
        MOV [EDI+0],CL

        RETN32 8
     END;
END;

ASSEMBLER

!Concat PROC NEAR32
        MOV EBX,ESP
        MOV EDI,[EBX+8]    ;s
        MOV ESI,[EBX+4]    ;s1
        MOVZXB ECX,[EDI+0] ;length of s
        CLD
        LODSB
        ADD [EDI+0],AL
        JNC !!ll1
        MOVB [EDI+0],255
        MOV AL,CL
        NOT AL
!!ll1:
        ADD EDI,ECX
        INC EDI
        MOV CL,AL
        REP
        MOVSB
        MOV AL,0      ;Abschluß PChar
        STOSB
        RETN32 4
!Concat ENDP

END; {Assembler}

PROCEDURE Halt(code:BYTE);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV AL,[EBX+4]
        XOR AH,AH
        MOV _ExitCode,AX
        CMPD _PMCrtWindow,0   ;is a CrtWindow created ?
        JE !qt                ;No !
        CALLN32 _MainDispatchLoop ;Wait until CRT terminates
!qt:
        MOV AX,_ExitCode  ;ExitCode holen
        XOR AH,AH
        CMP AL,0   ;Fehler aufgetreten ?
        JE noexerr

        PUSH AX      ;Save Return code

        MOV EDI,OFFSET(!ErrorMsg)
        ADD EDI,24   ;Focus after error
        XOR AH,AH
        MOV BX,10
        XOR ECX,ECX
Lw46_111:
        XOR EDX,EDX
        DIV BX
        PUSH DX
        INC CX
        OR AX,AX
        JNE Lw46_111
Lw47_111:
        POP AX
        ADD AL,'0'
        MOV [EDI+0],AL
        INC EDI
        LOOP Lw47_111

        ;Insert the error Adress
        MOVB [EDI+0],32
        MOVB [EDI+1],'a'
        MOVB [EDI+2],'t'
        MOVB [EDI+3],32
        ADD EDI,4

        MOV EAX,_ErrorAddr
        SUB EAX,4
        MOV EBX,16
        XOR ECX,ECX
Lw46_112:
        XOR EDX,EDX
        DIV EBX
        PUSH DX
        INC CX
        OR EAX,EAX
        JNE Lw46_112
Lw47_112:
        POP AX
        ADD AL,'0'
        CMP AL,57
        JNA !g57
        ADD AL,7
!g57:
        MOV [EDI+0],AL
        INC EDI
        LOOP Lw47_112
        MOVB [EDI+0],0

        PUSHL 1200
        PUSHL 200
        CALLN32 _Beep

        PUSHL 4010h                  ;MB_OK|MB_MOVEABLE|MB_QUERY
        PUSHL 0
        PUSHL OFFSET(@Err)
        PUSHL OFFSET(!ErrorMsg)
        PUSHL 1
        PUSHL 1
        MOV AL,6
        CALLDLL PMWin,789        ;WinMessageBox
        ADD ESP,24


        POP AX     ;Get Return Code
noexerr:
        PUSH AX

        MOV EAX,_PMCrtWindow
        CMP EAX,0
        JE !nodel

        PUSHL _PMCrtWindow
        MOV AL,1
        CALLDLL PMWIN,728   ;WinDestroyWindow
        ADD ESP,4
!nodel:
        ;Free system heap
        PUSHL _HeapOrg
        MOV AL,1
        CALLDLL DosCalls,347   ;DosSubUnsetMem
        ADD ESP,4
        PUSHL _HeapOrg
        MOV AL,1
        CALLDLL DosCalls,304   ;DosFreeMem
        ADD ESP,4

        PUSHL _AppQueueHandle
        MOV AL,1
        CALLDLL PMWIN,726   ;WinDestroyMsgQueue
        ADD ESP,4
        PUSHL _AppHandle
        MOV AL,1
        CALLDLL PMWIN,888   ;WinTerminate
        ADD ESP,4

        POP AX
        MOVZX EAX,AX
        PUSHL 1               ;Exit the whole process
        PUSH EAX              ;Return Code
        MOV AL,2
        CALLDLL DosCalls,234  ;DosExit
        ADD ESP,8
        RETN32
@Err db 'Runtime error - Program terminated',0
    END; {asm}
END;

PROCEDURE RunError(Code:BYTE);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        POP EAX            ;Adress from call
        MOV _ErrorAddr,EAX
        MOV AL,[EBX+4]
        XOR AH,AH
        MOV _ExitCode,AX
exloop:
        PUSHL OFFSET(@raddr) ;Return adress for ExitProc
        PUSHL _ExitProc    ;ExitProc on Stack
        RETN32             ;jump into ExitProc
@raddr
        JMP exloop  ;until termination
     END; {asm}
END;

PROCEDURE RunErrorIntern(Code:BYTE);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV AL,[EBX+4]
        XOR AH,AH
        MOV _ExitCode,AX
exloop:
        PUSHL OFFSET(@raddr) ;Return adress for ExitProc
        PUSHL _ExitProc    ;ExitProc on Stack
        RETN32             ;jump into ExitProc
@raddr
        JMP exloop  ;until termination
     END; {asm}
END;

ASSEMBLER

!PCharCopy PROC NEAR32
         MOV EBX,ESP
         MOV ESI,[EBX+8]
         MOV EDI,[EBX+4]
         CLD
!re:
         LODSB
         STOSB
         CMP AL,0
         JNE !re
         CLD
         RETN32 8
!PCharCopy ENDP

END;

PROCEDURE GetAPIMem(VAR p:POINTER;size:LONGWORD);
BEGIN
     ASM
        PUSHL 19        ;Flags PAG_READ|PAG_WRITE|PAG_COMMIT
        PUSHL $size     ;Length of memory
        PUSHL $p
        MOV AL,3             ;3 Parameters
        CALLDLL DosCalls,299 ;DosAllocMem
        ADD ESP,12            ;Clear Stack
        CMP EAX,0
        JE !eok
        LEAVE
        POP EAX              ;Adress from which the error came
        MOV _ErrorAddr,EAX
        PUSH 214             ;Illegal pointer operation
        CALLN32 _RunErrorIntern
!eok:
     END;
END;

PROCEDURE FreeAPIMem(VAR p:POINTER;size:LONGWORD);
BEGIN
     ASM
        MOV ESI,$p
        PUSHL [ESI+0]
        MOV AL,1
        CALLDLL DosCalls,304   ;DosFreeMem
        ADD ESP,4
        CMP EAX,0
        JE !eok_1

        LEAVE
        POP EAX                ;Adress from which the error came
        MOV _ErrorAddr,EAX
        PUSH 204               ;Illegal pointer operation
        CALLN32 _RunErrorIntern
!eok_1:
        MOV ESI,$p
        MOVD [ESI+0],0
     END;
END;


PROCEDURE GETMEM(var p:Pointer;size:LongWord);
BEGIN
     ASM
        MOV EAX,[EBP+8]       ;Size
        ADD EAX,7
        AND AL,F8h            ;Align on 8 byte boundary
        PUSH EAX
        PUSHL [EBP+12]
        PUSHL _HeapOrg
        MOV AL,3
        CALLDLL DosCalls,345   ;DosSubAllocMem
        ADD ESP,12             ;Clear Stack
        CMP EAX,0
        JE !wg
        LEAVE
        POP EAX                ;Adress from which the error came
        MOV _ErrorAddr,EAX
        PUSH 204               ;Illegal pointer operation
        CALLN32 _RunErrorIntern
!wg:
        MOV ESI,[EBP+12]
        MOV EAX,[ESI+0]        ;Adresse
        ADD EAX,[EBP+8]
        CMP EAX,_HeapPtr
        JB !eg
        MOV _HeapPtr,EAX
!eg:
     END;
END;

PROCEDURE FREEMEM(var p:pointer;size:LongWord);
BEGIN
     ASM
         MOV ESI,[EBP+12]      ;Addr
         MOV ESI,[ESI+0]

         MOV EAX,[EBP+8]       ;Size
         ADD EAX,7
         AND AL,F8h            ;Align on 8 byte boundary
         PUSH EAX
         MOV ESI,[EBP+12]
         MOV EAX,[ESI+0]
         MOVD [ESI+0],0       ;Invalidate pointer
         MOV EBX,EAX
         ADD EBX,[EBP+8]
         CMP EBX,_HeapPtr
         JB !nf
         MOV _HeapPtr,EAX
!nf:
         PUSH EAX              ;Adress of block
         PUSHL _HeapOrg
         MOV AL,3
         CALLDLL DosCalls,346  ;DosSubFreeMem
         ADD ESP,12
         CMP EAX,0
         JE !ef
         LEAVE
         POP EAX               ;Adress from which the error came
         MOV _ErrorAddr,EAX
         PUSH 204              ;Illegal pointer operation
         CALLN32 _RunErrorIntern
!ef:
     END;
END;

FUNCTION  MAXAVAIL:LongWord;ASM;
BEGIN
     ASM
        MOV EAX,_HeapEnd
        SUB EAX,_HeapPtr
        RETN32
     END;
END;


FUNCTION  MEMAVAIL:LongWord;ASM;
BEGIN
     ASM
        MOV EAX,_HeapEnd
        SUB EAX,_HeapPtr
        RETN32
     END;
END;

PROCEDURE BYTEMOVE(var source;var dest;size:LongWord);ASM;
BEGIN
     ASM
         MOV EBX,ESP
         MOV ESI,[EBX+12]
         MOV EDI,[EBX+8]
         MOV ECX,[EBX+4]
         CLD
         CMP ESI,EDI
         JAE !Mo1
         ADD ESI,ECX
         ADD EDI,ECX
         DEC ESI
         DEC EDI
         STD
!Mo1:
         REP
         MOVSB
         CLD
         RETN32 12
    END;
END;


PROCEDURE MOVE(var source;var dest;size:LongWord);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV ESI,[EBX+12]
        MOV EDI,[EBX+8]
        MOV ECX,[EBX+4]
        CLD
        CMP ESI,EDI
        JB !Mo2
        CMP ECX,0
        JE __L12_1
        TEST ECX,1
        JE __L11_1         ;schon gerade Anzahl
        MOVSB
        JMP !Mo2_1
!Mo2:
        ADD ESI,ECX
        ADD EDI,ECX
        DEC ESI
        DEC EDI
        STD
        CMP ECX,0
        JE __L12_1
        TEST ECX,1
        JNE __L__11_1         ;schon gerade Anzahl ??
        DEC EDI               ;ja !!
        DEC ESI
        JMP __L11_1
__L__11_1:
        MOVSB
        DEC ESI
        DEC EDI
!Mo2_1:
        DEC ECX            ;count auf gerade Anzahl
        CMP ECX,0
        JE __L12_1
__L11_1:
        SHR ECX,1         ;da wortweises Übertragen
        REP
        db 66h            ;no double word
        MOVSW
__L12_1:
        CLD
        RETN32 12
     END;
END;


PROCEDURE FILLCHAR(var dest;size:LongWord;value:byte);ASM;
BEGIN
    ASM
        CLD
        MOV EBX,ESP
        MOV EDI,[EBX+10]   ;Destination pointer
        MOV ECX,[EBX+6]    ;count
        CMP ECX,0          ;count=0 ??
        JE __L12
        MOV AL,[EBX+4]     ;value
        MOV AH,AL

        CMP ECX,0
        JE __L12
        TEST ECX,1
        JE __L11           ;schon gerade Anzahl
        STOSB
        DEC ECX            ;count auf gerade Anzahl
        CMP ECX,0
        JE __L12
__L11:
        SHR ECX,1         ;da wortweises Übertragen
        REP
        db 66h            ;no double word
        STOSW
__L12:
        RETN32 10
     END;
END;



ASSEMBLER

;***************************************************
;String Support routines
;***************************************************

!StrCopy PROC NEAR32
                CLD
                MOV EBX,ESP
                MOV ESI,[EBX+10]     ;Source String
                MOV EDI,[EBX+6]     ;Destination String
                MOV CL,[EBX+4]       ;Maximum length
                MOVZX ECX,CL
                LODSB
                CMP AL,CL
                JBE _L1
                MOV AL,CL
_L1:
                STOSB
                MOV CL,AL
                MOVZX ECX,CL
                CMP ECX,0
                JE _eee1

                TEST ECX,1
                JE __L11_2         ;schon gerade Anzahl
                MOVSB
                DEC ECX            ;count auf gerade Anzahl
                CMP ECX,0
                JE _eee1
__L11_2:
                SHR ECX,1         ;da wortweises Übertragen
                REP
                db 66h            ;no double word
                MOVSW
_eee1:
                MOV AL,0          ;Abschluß PChar
                STOSB
                RETN32 10
!StrCopy ENDP


!StrCopyTemp PROC NEAR32
                CLD
                MOV EBX,ESP
                PUSHA
                MOV ESI,[EBX+4]          ;Source String
                MOV EDI,OFFSET(!TempString) ;Destination String
                LODSB                       ;Length of source string
                STOSB                       ;save
                MOV CL,AL                   ;set counter
                MOVZX ECX,CL

                CMP ECX,0
                JE __L12_3
                TEST ECX,1
                JE __L11_3         ;schon gerade Anzahl
                MOVSB
                DEC ECX            ;count auf gerade Anzahl
                CMP ECX,0
                JE __L12_3
__L11_3:
                SHR ECX,1         ;da wortweises Übertragen
                REP
                db 66h            ;no double word
                MOVSW
__L12_3:
                MOV EDI,OFFSET(!TempString)
                MOV AL,[EDI+0]
                XOR AH,AH
                MOVZX EAX,AX
                ADD EDI,EAX
                MOVB [EDI+1],0  ;Abschluß PChar
                POPA
                RETN32 4
!StrCopyTemp ENDP

!AddString PROC NEAR32
        MOV EBX,ESP
        MOV EDI,[EBX+8]    ;s2
        MOV ESI,[EBX+4]    ;s1
        MOVZXB ECX,[EDI+0] ;length of s
        CLD
        LODSB
        ADD [EDI+0],AL
        JNC !!lll1
        MOVB [EDI+0],255
        MOV AL,CL
        NOT AL
!!lll1:
        ADD EDI,ECX
        INC EDI
        MOV CL,AL
        REP
        MOVSB
        MOV AL,0      ;Abschluß PChar
        STOSB
        RETN32 8
!AddString ENDP

!CopyString PROC NEAR32
        CLD
    SUB    EDX,EBX
    CMP    EAX,EBX
    JB    LA1
        MOV    EAX,EBX
LA1:
        STOSB
    MOV    ECX,EAX
    ADD    EBX,ESI
        CMP     ECX,0
        JE __L12_4

        TEST ECX,1
        JE __L11_4         ;schon gerade Anzahl
        MOVSB
        DEC ECX            ;count auf gerade Anzahl
        CMP ECX,0
        JE __L12_4
__L11_4:
        SHR ECX,1         ;da wortweises Übertragen
        REP
        db 66h            ;no double word
        MOVSW
__L12_4:
    MOV    ESI,EBX
    RETN32
!CopyString ENDP

END;

FUNCTION  UPCASE(item:char):Char;ASM;
BEGIN
     ASM
         MOV EBX,ESP
         MOV AL,[EBX+4]
         CMP AL,61h
         JB L32
         CMP AL,7ah
         JA L32
         SUB AL,20h
L32:
         RETN32 2
      END;
END;

FUNCTION COPY(source:string;start,ende:Byte):String;ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP

        MOV ESI,[EBP+16]             ;Source string
        MOV EDI,[EBP+8]              ;Destination string

        MOVZXB AX,[ESI+0]            ;Length of source
        MOVZXB ECX,$Start            ;Index
        OR ECX,ECX
        JG !_Lab1
        MOV ECX,1
!_Lab1:
        ADD ESI,ECX
        SUB AX,CX
        JB !_Lab3
        INC AX
        MOVZXB CX,$Ende             ;Count
        OR CX,CX
        JGE !_Lab2
        XOR CX,CX
!_Lab2:
        CMP AX,CX
        JBE !_Lab4
        MOV AX,CX
        JMP !_Lab4
!_Lab3:
        XOR AX,AX
!_Lab4:
        STOSB
        MOVZX ECX,AX
        CMP ECX,0
        JE !_Lab5
        REP
        MOVSB
!_Lab5:
        MOV EDI,[EBP+16]             ;Source string
        MOVZXB EAX,[EDI+0]
        ADD EDI,EAX
        MOVB [EDI+1],0               ;Abschluß PChar

        LEAVE
        RETN32 12
     END;
END;

PROCEDURE SUBSTR(VAR source:string;start,ende:Byte);ASM;
BEGIN
      ASM
        PUSH EBP
        MOV EBP,ESP

        MOV ESI,[EBP+12]             ;Source string
        MOV EDI,ESI                  ;Destination string

        MOVZXB AX,[ESI+0]            ;Length of source
        MOVZXB ECX,$Start            ;Index
        OR ECX,ECX
        JG !_Lab1_1
        MOV ECX,1
!_Lab1_1:
        ADD ESI,ECX
        SUB AX,CX
        JB !_Lab3_1
        INC AX
        MOVZXB CX,$Ende             ;Count
        OR CX,CX
        JGE !_Lab2_1
        XOR CX,CX
!_Lab2_1:
        CMP AX,CX
        JBE !_Lab4_1
        MOV AX,CX
        JMP !_Lab4_1
!_Lab3_1:
        XOR AX,AX
!_Lab4_1:
        STOSB
        MOVZX ECX,AX
        CMP ECX,0
        JE !_Lab5_1
        REP
        MOVSB
!_Lab5_1:
        MOV EDI,[EBP+12]
        MOVZXB EAX,[EDI+0]
        ADD EDI,EAX
        MOVB [EDI+1],0  ;Abschluß PChar
        LEAVE
        RETN32 8
     END;
END;

ASSEMBLER

!Long2Str PROC NEAR32
        MOV EBX,ESP
        MOV EAX,[EBX+8]
        MOV EDI,[EBX+4]
        PUSH EDI
        POP ESI
        MOVB [EDI+0],0
        MOV EBX,10
        XOR ECX,ECX
        CMP EAX,0
        JNL Lw46_1
        NEG EAX
        MOVB [EDI+0],1
        INC EDI
        MOVB [EDI+0],'-'
Lw46_1:
        XOR EDX,EDX
        DIV EBX
        PUSH DX
        INC CX
        OR EAX,EAX
        JNE Lw46_1
Lw47:
        POP AX
        ADD AL,'0'
        INCB [ESI+0]
        INC EDI
        MOV [EDI+0],AL
        LOOP Lw47

        MOV EBX,ESP
        MOV EDI,[EBX+4]
        MOV AL,[EDI+0]
        MOVZX EAX,AL
        ADD EDI,EAX
        MOVB [EDI+1],0  ;Abschluß PChar
        RETN32 8
!Long2Str ENDP


!Str2Long PROC NEAR32
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,10
        MOV EDI,[EBP+16]   ;s
        MOV CL,[EDI+0]     ;Länge
        MOVZX ECX,CL
        MOVB [EBP-6],0

        MOVD [EBP-10],10   ;Base
        MOV AL,[EDI+1]
        ADD EDI,ECX
        CMP AL,'$'         ;Hexadecimal ??
        JNE !nohex
        MOVD [EBP-10],16   ;Base
        DEC ECX
!nohex:
        CMP AL,'-'
        JNE !q2
        DEC ECX
        MOVB [EBP-6],1
!q2:
        MOV EBX,1
        MOVW EAX,0
        MOV [EBP-4],EAX
!q1:
        MOV AL,[EDI+0]
        DEC EDI
        CMP AL,48
        JB !qerr
        CMP AL,57
        JNA !noqerr

        CMP AL,102
        JA !qerr
        CMP AL,65
        JB !qerr
        CMP AL,70
        JBE !hexnum
        CMP AL,97
        JB !qerr
        SUB AL,32    ;To upper
!hexnum:
        CMPD [EBP-10],16
        JNE !qerr
        SUB AL,7
!noqerr:
        SUB AL,48
        MOVZX EAX,AL
        MUL EBX
        MOV EDX,[EBP-4]
        ADD EDX,EAX
        MOV [EBP-4],EDX
        MOV EAX,EBX
        MOV EBX,[EBP-10]  ;Base
        MUL EBX
        MOV EBX,EAX
        LOOP !q1
!qerr:
        MOV EDI,[EBP+8]     ;result
        XOR CH,CH
        MOV [EDI+0],CX
        MOV EAX,[EBP-4]
        CMPB [EBP-6],1
        JNE !q3
        NEG EAX
!q3:
        MOV EDI,[EBP+12]    ;l
        MOV [EDI+0],EAX
        LEAVE
        RETN32 12
!Str2Long ENDP

!Str2Word PROC NEAR32
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,10
        MOV EDI,[EBP+16]   ;s
        MOV CL,[EDI+0]     ;Länge
        MOVZX ECX,CL
        MOVB [EBP-6],0

        MOVD [EBP-10],10   ;Base
        MOV AL,[EDI+1]
        ADD EDI,ECX
        CMP AL,'$'         ;Hexadecimal ??
        JNE !__nohex
        MOVD [EBP-10],16   ;Base
        DEC ECX
!__nohex:
        CMP AL,'-'
        JNE !__q2
        DEC ECX
        MOVB [EBP-6],1
!__q2:
        MOV EBX,1
        MOVW EAX,0
        MOV [EBP-4],EAX
!__q1:
        MOV AL,[EDI+0]
        DEC EDI
        CMP AL,48
        JB !__qerr
        CMP AL,57
        JNA !__noqerr

        CMP AL,102
        JA !__qerr
        CMP AL,65
        JB !__qerr
        CMP AL,70
        JBE !__hexnum
        CMP AL,97
        JB !__qerr
        SUB AL,32    ;To upper
!__hexnum:
        CMPD [EBP-10],16
        JNE !__qerr
        SUB AL,7
!__noqerr:
        SUB AL,48
        MOVZX EAX,AL
        MUL EBX
        MOV EDX,[EBP-4]
        ADD EDX,EAX
        MOV [EBP-4],EDX
        MOV EAX,EBX
        MOV EBX,[EBP-10]  ;Base
        MUL EBX
        MOV EBX,EAX
        LOOP !__q1
!__qerr:
        MOV EDI,[EBP+8]     ;result
        XOR CH,CH
        MOV [EDI+0],CX
        MOV EAX,[EBP-4]
        CMPB [EBP-6],1
        JNE !__q3
        NEG EAX
!__q3:
        MOV EDI,[EBP+12]    ;l
        MOV [EDI+0],AX
        LEAVE
        RETN32 12
!Str2Word ENDP

!Str2Byte PROC NEAR32
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,10
        MOV EDI,[EBP+16]   ;s
        MOV CL,[EDI+0]     ;Länge
        MOVZX ECX,CL
        MOVB [EBP-6],0

        MOVD [EBP-10],10   ;Base
        MOV AL,[EDI+1]
        ADD EDI,ECX
        CMP AL,'$'         ;Hexadecimal ??
        JNE !___nohex
        MOVD [EBP-10],16   ;Base
        DEC ECX
!___nohex:
        CMP AL,'-'
        JNE !___q2
        DEC ECX
        MOVB [EBP-6],1
!___q2:
        MOV EBX,1
        MOVW EAX,0
        MOV [EBP-4],EAX
!___q1:
        MOV AL,[EDI+0]
        DEC EDI
        CMP AL,48
        JB !___qerr
        CMP AL,57
        JNA !___noqerr

        CMP AL,102
        JA !___qerr
        CMP AL,65
        JB !___qerr
        CMP AL,70
        JBE !___hexnum
        CMP AL,97
        JB !___qerr
        SUB AL,32    ;To upper
!___hexnum:
        CMPD [EBP-10],16
        JNE !___qerr
        SUB AL,7
!___noqerr:
        SUB AL,48
        MOVZX EAX,AL
        MUL EBX
        MOV EDX,[EBP-4]
        ADD EDX,EAX
        MOV [EBP-4],EDX
        MOV EAX,EBX
        MOV EBX,[EBP-10]  ;Base
        MUL EBX
        MOV EBX,EAX
        LOOP !___q1
!___qerr:
        MOV EDI,[EBP+8]     ;result
        XOR CH,CH
        MOV [EDI+0],CX
        MOV EAX,[EBP-4]
        CMPB [EBP-6],1
        JNE !___q3
        NEG EAX
!___q3:
        MOV EDI,[EBP+12]    ;l
        MOV [EDI+0],AL
        LEAVE
        RETN32 12
!Str2Byte ENDP

END;

FUNCTION ToStr(l:longint):string;ASM;
BEGIN
     ASM
        MOV EBX,ESP
        PUSHL [EBX+8]
        PUSHL [EBX+4]      ;Destination string
        CALLN32 !Long2Str
        RETN32 8
     END;
END;

ASSEMBLER

!StringCmp PROC NEAR32
              MOV EBX,ESP
              CLD
              MOV ESI,[EBX+8]
              MOV EDI,[EBX+4]
              LODSB
              MOV AH,[EDI+0]
              INC EDI
              MOV CL,AL
              CMP CL,AH
              JBE _nl1
              MOV CL,AH
_nl1:
              OR CL,CL
              JE _nl2
              MOVZX ECX,CL
              CLD
              REP
              CMPSB
              JNE _nl3
_nl2:
              CMP AL,AH
_nl3:
              RETN32 8
!StringCmp ENDP

!PStringCmp PROC NEAR32
              MOV EBX,ESP
              CLD
              MOV ESI,[EBX+8]  ;2.String
              MOV EDI,[EBX+4]
              PUSH EDI
              PUSH ESI
              MOV AL,0
!syy:
              CMPB [ESI+0],0
              JE !sxx
              INC AL
              INC ESI
              JMP !syy
!sxx:
              MOV AH,0
!syy1:
              CMPB [EDI+0],0
              JE !sxx1
              INC AH
              INC EDI
              JMP !syy1
!sxx1:
              POP ESI
              POP EDI
              MOV CL,AL
              CMP CL,AH
              JBE _nl1_1
              MOV CL,AH
_nl1_1:
              OR CL,CL
              JE _nl2_1
              MOVZX ECX,CL
              CLD
              REP
              CMPSB
              JNE _nl3_1
_nl2_1:
              CMP AL,AH
_nl3_1:
              RETN32 8
!PStringCmp ENDP

END;

FUNCTION POS(item:string;source:string):Byte;ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         MOV ESI,[EBP+12]   ;item
         CLD
         LODSB
         OR AL,AL
         JE !lab2
         MOVZXB EAX,AL
         MOV EDX,EAX
         MOV EDI,[EBP+8]    ;source
         MOVZXB ECX,[EDI+0]
         SUB ECX,EDX
         JB !lab2
         INC ECX
         INC EDI
!lab1:
         LODSB
         REPNE
         SCASB
         JNE !lab2
         MOV EAX,EDI
         MOV EBX,ECX
         MOV ECX,EDX
         DEC ECX
         REPE
         CMPSB
         JE !lab3
         MOV EDI,EAX
         MOV ECX,EBX
         MOV ESI,[EBP+12]   ;item
         INC ESI
         JMP !lab1
!Lab2:
         XOR EAX,EAX
         JMP !Lab4
!lab3:
         DEC EAX
         SUB EAX,[EBP+8]    ;source
!Lab4:
         LEAVE
         RETN32 8
     END;
END;

PROCEDURE Insert(Source:String;VAR s:string;Ind:Byte);
var OldLen:Byte;
    SourceLen:Byte;
    TStr:STRING;
Begin
     asm
        CMPB [EBP+8],0
        JE !exx2
        LEA EDI,$TStr
        MOV ESI,[EBP+10]
        INC EDI
        MOV CL,[ESI+0]
        XOR CH,CH
        MOV [EBP-2],CL   ;OldLen
        MOV CL,[EBP+8]   ;ab dieser Position
        CMP CL,[EBP-2]
        JNA !no
        MOV CL,[EBP-2]
        MOV [EBP+8],CL
        INC CL
!no:
        INC ESI
        CMP CL,0
        JE !nc1
        DEC CL
        MOVZX ECX,CL
        CLD
        REP
        MOVSB             ;var s in TempString kopieren
!nc1:
        PUSH ESI          ;alte Position merken
        MOV ESI,[EBP+14]  ;Source
        MOV CL,[Esi+0]
        XOR CH,CH
        MOV [EBP-4],CL    ;SourceLen
        iNC ESI
        CMP CL,0
        JE !nc2
        MOVZX ECX,CL
        CLD
        REP
        MOVSB
!nc2:
        POP ESI         ;alte Position holen
        MOV CL,[EBP-2]  ;Oldlen
        MOV AL,[EBP+8]  ;Index
        DEC AL
        SUB CL,AL
        CMP CL,0
        JE !nc3
        MOVZX ECX,CL
        REP
        MOVSB
!nc3:
        MOV AL,[EBP-2]  ;Oldlen
        ADD AL,[EBP-4]

        MOV $TStr,AL  ;Länge setzen
        MOV EDI,[EBP+10]
        LEA ESI,$TStr
        MOV CL,AL
        INC CL
        MOVZX ECX,CL
        CLD
        REP
        MOVSB
        MOV EDI,[EBP+10]
        XOR CH,CH
        MOV CL,AL
        MOVZX ECX,CL
        ADD EDI,ECX
        MOVB [EDI+1],0  ;Abschluß PChar
!exx2:
    end;
End;

PROCEDURE Delete(Var s:string;Ind:byte;len:byte);
var newlen:Byte;
BEGIN
     ASM
        MOV EDI,$s        ;var s
        MOV AL,[EDI+0]    ;Length of the string
        MOV CL,$Ind       ;Index in the string
        CMP CL,AL
        JA !exx3
        CMP CL,0
        JE !exx1

        MOVZX ECX,CL      ;Index in the string
        ADD EDI,ECX       ;add the index
        MOV ESI,$s        ;var s
        ADD ESI,ECX       ;add the index
        MOV CL,$len       ;len
        ADD CL,$ind       ;index
        CMP CL,AL         ;greater than maximal length ??
        JNA !cp
        ;len=maximal length-Index
        MOV CL,$Len       ;len
        MOV BL,AL         ;maximal length to bl
        SUB BL,CL
        MOV $Len,CL       ;set len anew
!cp:
        MOV CL,$Len       ;len
        MOVZX ECX,CL
        ADD ESI,ECX       ;add len
        ADD CL,$Ind       ;Index
        DEC CL
        SUB AL,CL
        MOV CL,AL         ;to transmit
        CMP CL,0
        JE !exx1          ;zero bytes

        MOVZX ECX,CL
        CLD
        REP
        MOVSB
!exx1:
        MOV EDI,$s        ;var s
        MOV AL,[EDI+0]    ;current len
        SUB AL,$Len       ;len
        MOV [EDI+0],AL    ;Länge neu setzen
        MOVZX EAX,AL
        ADD EDI,EAX
        MOVB [EDI+1],0 ;PChar Abschluß
!exx3:
     end;
END;

{*************************************************************************
*                                                                        *
*                                                                        *
*             Procedures and functions for file handling                 *
*                                                                        *
*                                                                        *
**************************************************************************}

PROCEDURE CHDIR(path:string);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV EAX,[EBX+4]
        INC EAX
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,255  ;DosSetCurrentDir
        ADD ESP,4
        MOV _IoResult,EAX
        RETN32
     END;
END;

PROCEDURE GETDIR(drive:byte;var path:string);ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        MOVD _IoResult,0
        SUB ESP,8

        MOV AL,$drive
        CMP AL,0      ;actual drive required ??
        JA !nad

        LEA EAX,[EBP-4]    ;DriveMap
        PUSH EAX
        LEA EAX,[EBP-8]    ;Current drive
        PUSH EAX
        MOV AL,2
        CALLDLL DosCalls,275 ;DosQueryCurrentDisk
        ADD ESP,8

        MOV _IoResult,EAX
        CMPD _IoResult,0
        JNE !egd
        MOV AL,[EBP-8]
!nad:
        MOV EDI,[EBP+8]    ;Path
        INC EDI
        CLD
        ADD AL,64
        STOSB
        MOV AL,':'
        STOSB
        MOV AL,'\'
        STOSB

        MOVD [EBP-4],250   ;max length of dir
        LEA EAX,[EBP-4]
        PUSH EAX
        MOV EAX,[EBP+8]    ;Path
        ADD EAX,4          ;dispatch drive letter and :\
        PUSH EAX
        MOV AL,[EBP+12]    ;Drive number
        MOVZX EAX,AL
        PUSH EAX
        MOV AL,3
        CALLDLL DosCalls,274     ;DosQueryCurrentDir
        ADD ESP,12
        MOV _IoResult,EAX

        CMPD _IoResult,0
        JNE !egd

        MOV CL,255
        MOV ESI,[EBP+8]
        INC ESI
        CLD
!lgd:
        INC CL
        LODSB
        CMP AL,0
        JNE !lgd

        MOV ESI,[EBP+8]
        MOV [ESI+0],CL   ;set string length
!egd:
        LEAVE
        RETN32 6
     END;
END;

PROCEDURE RMDIR(dir:string);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        MOV EAX,[EBX+4]
        INC EAX
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,226    ;DosDeleteDir
        ADD ESP,4
        MOV _IoResult,EAX
        RETN32 4
     END;
END;

PROCEDURE MKDIR(dir:string);ASM;
BEGIN
     ASM
        MOV EBX,ESP
        PUSHL 0         ;No extended attributes
        MOV EAX,[EBX+4]
        INC EAX
        PUSH EAX
        MOV AL,2
        CALLDLL DosCalls,270  ;DosCreateDir
        ADD ESP,8
        MOV _IoResult,EAX
        RETN32 4
     END;
END;

PROCEDURE Erase(name:STRING);ASM;
BEGIN
     ASM
         MOV EBX,ESP
         MOV EAX,[EBX+4]
         INC EAX
         PUSH EAX
         MOV AL,1
         CALLDLL DosCalls,259   ;DosDelete
         ADD ESP,4
         MOV _IoResult,EAX
         RETN32
     END;
END;

PROCEDURE Seek(var f:file;n:LongWord);ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,4
         LEA EAX,[EBP-4]
         PUSH EAX
         PUSHL _SeekMode   ;from where to Seek
         PUSHL [EBP+8]     ;Bytes to move
         MOV EDI,[EBP+12]  ;var f
         PUSHL [EDI+0]     ;Handle
         MOV AL,4
         CALLDLL DosCalls,256 ;DosSetFilePtr
         ADD ESP,16
         MOV _IoResult,EAX
         LEAVE
         RETN32 8
      END;
END;

FUNCTION FilePos(var f:file):LongWord;ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,4
         LEA EAX,[EBP-4]
         PUSH EAX
         PUSHL 1                ;from current position
         PUSHL 0
         MOV EDI,[EBP+8]        ;var f
         PUSHL [EDI+0]     ;Handle
         MOV AL,4
         CALLDLL DosCalls,256 ;DosSetFilePtr
         ADD ESP,16
         MOV _IoResult,EAX
         MOV EAX,[EBP-4]   ;result
         LEAVE
         RETN32 4
      END;
END;


FUNCTION FileSize(var f:file):LongWord;ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,8
         MOV EDI,[EBP+8]  ;Var f
         PUSH EDI
         CALLN32 _FilePos
         PUSH EAX
         CMPD,_ioresult,0
         JNE L_19_1   ;Error occured

         LEA EAX,[EBP-8]
         PUSH EAX
         PUSHL 2                ;_End of file
         PUSHL 0
         MOV EDI,[EBP+8]        ;var f
         PUSHL [EDI+0]          ;Handle
         MOV AL,4
         CALLDLL DosCalls,256   ;DosSetFilePtr
         ADD ESP,16
         CMPD _IoResult,0
         JNE L_19_1   ;Error occured

         POP EBX   ;alte Fileposition
         LEA EAX,[EBP-4]
         PUSH EAX
         PUSHL 0                ;Start of file
         PUSH EBX
         MOV EDI,[EBP+8]        ;var f
         PUSHL [EDI+0]     ;Handle
         MOV AL,4
         CALLDLL DosCalls,256 ;DosSetFilePtr
         ADD ESP,16
         MOV _IoResult,EAX
L_19_1:
         MOV EAX,[EBP-8]
         LEAVE
         RETN32 4
      END;
END;



PROCEDURE Reset(var f:file;recsize:LongWord);ASM;
BEGIN
      ASM
         PUSH EBP
         MOV EBP,ESP
         MOVD _Ioresult,0
         SUB ESP,4         ;Action Taken
         MOV EDI,[EBP+12]  ;Var f
         MOV EAX,[EBP+8]   ;Recsize
         MOV [EDI+4],EAX
         MOVD [EDI+88],0   ;No extended attributes required
         PUSHL 0           ;no extended Attributes
         PUSHL _FileMode
         PUSHL 1           ;Open If file exists
         PUSHL 0           ;No attributes required
         PUSHL 0
         LEA EAX,[EBP-4]
         PUSH EAX
         LEA EAX,[EDI+0]   ;Handle
         PUSH EAX
         LEA EAX,[EDI+8]   ;Filename
         PUSH EAX
         MOV AL,8
         CALLDLL DosCalls,273  ;DosOpen
         ADD ESP,32
         MOV _IoResult,EAX
         CMPD _IoResult,0
         JNE !ers
         MOV ESI,[EBP+12]
         MOV EAX,_FileMode
         MOV [EDI+92],EAX  ;Patch file mode
!ers:
         LEAVE
         RETN32 8
      END;
END;

PROCEDURE Rewrite(var f:file;recsize:Longword);ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         MOVD _IoResult,0
         SUB ESP,4         ;Action Taken
         MOV EDI,[EBP+12]  ;Var f
         MOV EAX,[EBP+8]   ;Recsize
         MOV [EDI+4],EAX
         MOVD [EDI+88],0   ;no extended Attributes required
         PUSHL 0           ;no extended Attributes required
         PUSHL _FileMode
         PUSHL  18         ;Create if not exist,replace if exist
         PUSHL 20h         ;ARCHIVE
         PUSHL 0
         LEA EAX,[EBP-4]
         PUSH EAX
         LEA EAX,[EDI+0]   ;Handle
         PUSH EAX
         LEA EAX,[EDI+8]   ;Filename
         PUSH EAX
         MOV AL,8
         CALLDLL DosCalls,273  ;DosOpen
         ADD ESP,32
         MOV _IoResult,EAX
         CMPD _IoResult,0
         JNE !ers_1
         MOV ESI,[EBP+12]
         MOV EAX,_FileMode
         MOV [EDI+92],EAX  ;Patch file mode
!ers_1:
         LEAVE
         RETN32 8
      END;
END;

PROCEDURE BlockWrite(VAR f:file;var Buf;Count:LongWord);ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         MOVD _IoResult,0
         CMPD [EBP+8],0  ;Bufferlen
         JE !ebw
         MOV EDI,[EBP+16]  ;VAR f
         PUSHL OFFSET(_BlockWriteResult)    ;result
         MOV EAX,[EBP+8]  ;BufferLen
         MOV EBX,[EDI+4]   ;RecSize
         MUL EBX
         PUSH EAX
         PUSHL [EBP+12]    ;Buffer
         PUSHL [EDI+0]     ;Handle
         MOV AL,4
         CALLDLL DosCalls,282 ;DosWrite
         ADD ESP,16
         MOV _IoResult,EAX
!ebw:
         LEAVE
         RETN32 12
     END;
END;

PROCEDURE BlockRead(VAR f:file;var Buf;Count:LongWord);ASM;
BEGIN
     ASM
         PUSH EBP
         MOV EBP,ESP
         MOVD _IoResult,0
         CMPD [EBP+8],0  ;Bufferlen
         JE !ebr
         MOV EDI,[EBP+16]  ;VAR f
         PUSHL OFFSET(_BlockreadResult)  ;result
         MOV EAX,[EBP+8]  ;BufferLen
         MOV EBX,[EDI+4]   ;RecSize
         MUL EBX
         PUSH EAX
         PUSHL [EBP+12] ;Buffer
         PUSHL [EDI+0]  ;Handle
         MOV AL,4
         CALLDLL DosCalls,281 ;DosRead
         ADD ESP,16
         MOV _IoResult,EAX
!ebr:
         LEAVE
         RETN32 12
     END;
END;

PROCEDURE Rename(VAR f:file;NewName:String);
BEGIN
     ASM
        LEA EAX,$NewName
        INC EAX
        PUSH EAX
        MOV ESI,$f
        LEA EAX,[ESI+8]   ;old filename
        PUSH EAX
        MOV AL,2
        CALLDLL DosCalls,271  ;DosMove
        ADD ESP,8
        MOV _Ioresult,EAX
     END;
END;

PROCEDURE CLOSE(VAR f:file);ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        MOV EDI,[EBP+8]
        MOVD _Ioresult,0
        CMPD [EDI+0],0  ;Get file Handle
        JNE !nce
        MOVD _IoResult,6 ;Invalid Handle
        JMP !edc
!nce:
        PUSHL [EDI+0]  ;Handle
        MOV AL,1
        CALLDLL DosCalls,257  ;DosClose
        ADD ESP,4
        MOV _IoResult,EAX
        CMPD _IoResult,0
        JNE !edc
        MOV EDI,[EBP+8]
        MOVD [EDI+92],0  ;Mark file as closed
!edc:
        LEAVE
        RETN32 4
      END;
END;


PROCEDURE ASSIGN(VAR f:file;s:String);ASM;
BEGIN
     ASM
       PUSH EBP
       MOV EBP,ESP
       MOV EDI,[EBP+12]  ;File variable
       MOV AL,0
       MOV ECX,100       ;Length of file structure
       REP
       STOSB
       MOV EDI,[EBP+12]  ;File variable

       MOV ESI,[EBP+8]   ;String
       MOV CL,[ESI+0]    ;Length
       INC ESI
       CMP CL,79
       JBE L_1
L_2:
       MOV CL,79
       JMP L_3
L_1:
       CMP CL,0
       JE L_2__1    ;Skip empty file name
L_3:
       MOVZX ECX,CL
       ADD EDI,8    ;Set on filename
       CLD
       REP
       MOVSB
L_2__1:
       LEAVE
       RETN32 8
   END;
END;

ASSEMBLER

!BlockWriteFile PROC NEAR32
         PUSH EBP
         MOV EBP,ESP
         MOVD _IoResult,0
         CMPD [EBP+8],0  ;Bufferlen
         JE !ebw1
         MOV EDI,[EBP+16]  ;VAR f
         PUSHL OFFSET(_BlockWriteResult)    ;result
         MOV EAX,[EBP+8]  ;BufferLen
         MOV EBX,[EDI+4]   ;RecSize
         MUL EBX
         PUSH EAX
         PUSHL [EBP+12]    ;Buffer
         PUSHL [EDI+0]     ;Handle
         MOV AL,4
         CALLDLL DosCalls,282 ;DosWrite
         ADD ESP,16
         MOV _IoResult,EAX
!ebw1:
         LEAVE
         RETN32 8   ;Leave f on stack
!BlockWriteFile ENDP

!BlockReadFile PROC NEAR32
         PUSH EBP
         MOV EBP,ESP
         MOVD _IoResult,0
         CMPD [EBP+8],0  ;Bufferlen
         JE !ebr1
         MOV EDI,[EBP+16]  ;VAR f
         PUSHL OFFSET(_BlockreadResult)  ;result
         MOV EAX,[EBP+8]  ;BufferLen
         MOV EBX,[EDI+4]   ;RecSize
         MUL EBX
         PUSH EAX
         PUSHL [EBP+12] ;Buffer
         PUSHL [EDI+0]  ;Handle
         MOV AL,4
         CALLDLL DosCalls,281 ;DosRead
         ADD ESP,16
         MOV _IoResult,EAX
!ebr1:
         LEAVE
         RETN32 8  ;Leave f on stack
!BlockReadFile ENDP


!TextRead PROC NEAR32  ;[EBP+12]-->FileVar  Result to !TempString
                       ;[EBP+8]-->BufferString
          PUSH EBP
          MOV EBP,ESP
          SUB ESP,4    ;for old file position
          PUSHA        ;PUSHAD

          PUSHL [EBP+12]    ;FileVar
          CALLN32 _Filepos
          MOV EBX,_IoResult
          CMP EBX,0
          JNE !end_read

          MOV [EBP-4],EAX   ;Save file position

          MOV EDI,[EBP+12]  ;Filevar
          MOVD [EDI+4],1    ;RecSize
          PUSH EDI
          MOV EDX,[EBP+8]   ;Buffer
          INC EDX
          PUSH EDX
          PUSHL 255         ;Length
          CALLN32 _BlockRead
          CMPD _IoResult,0
          JNE L_14x

          MOV EAX,_BlockReadresult    ;Result
          MOV ESI,[EBP+8]
          MOV [ESI+0],AL   ;Bytes read
          JMP L_16x
L_14x:
L_12x:
          MOV ESI,[EBP+8]
          MOVB [ESI+0],0   ;No records transmitted
L_16x:
          MOV EAX,_IoResult
          CMPW EAX,0
          JNE !end_read
          XOR CX,CX
          MOV ESI,[EBP+8]
          CLD
          LODSB
          CMP AL,0
          JE !end_read
          XOR AH,AH
          MOV DX,AX     ;old len
!lox1:
          LODSB
          INC CX
          CMP AL,13
          JE !end_lox
          CMP AL,10
          JE !end_lox
          CMP CX,DX       ;greater then bytes read ?
          JAE !end_read
          CMP CX,255
          JB !lox1
          JMP !end_read   ;NO CR found
!end_lox:
          MOV AX,CX
          DEC AX
          PUSH EDI
          MOV EDI,[EBP+8]
          MOV [EDI+0],AL  ;Set new length
          CMPB [EDI+1],13
          jne !ner
          MOVB [EDI+0],0
!ner:
          POP EDI
          LODSB
          CMP AL,10
          JNE !no_i
          INC CX
!no_i:
          MOV AX,CX
          MOVZX EAX,AL
          MOV EBX,[EBP-4]       ;old file-position
          ADD EBX,EAX
          MOV EAX,[EBP+12]       ;FileVar
          PUSH EAX
          PUSH EBX
          CALLN32 _Seek
!end_read:
          POPA                  ;POPAD
          LEAVE
          RETN32 4               ;Do not remove parameters !!!
!TextRead ENDP

!TextWrite PROC NEAR32  ;[EBP+12]-->FileVar [EBP+8] String to write
          PUSH EBP
          MOV EBP,ESP

          MOV EDI,[EBP+12]  ;Filevar
          MOVD [EDI+4],1    ;RecSize
          PUSH EDI
          MOV EDI,[EBP+8]   ;String
          MOV CL,[EDI+0]
          MOVZX ECX,CL
          INC EDI
          PUSH EDI
          PUSH ECX          ;Length
          CALLN32 _BlockWrite
          CMPD _IoResult,0
          JNE !no_1

          MOV EDI,[EBP+12]   ;Filevar
          PUSH EDI
          MOV EDX,OFFSET(@creoln)
          PUSH EDX
          PUSHL 2            ;length
          CALLN32 _BlockWrite
!no_1:
          LEAVE
          RETN32 4    ;Do not remove FileVar parameter !!!
@creoln db 13,10
!TextWrite ENDP

END;

FUNCTION Eof(var f:file):Boolean;ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP

        MOV EDI,[EBP+8] ;var f
        CMPD [EDI+0],0  ;FileHandle
        JE L_21

        PUSHL [EBP+8]  ;var f
        CALLN32 _Filepos
        PUSH EAX       ;Save current position

        PUSHL [EBP+8]  ;var f
        CALLN32 _FileSize

        POP EBX        ;Get current position
        CMP EBX,EAX
        JB L_22
        MOV AL,1       ;its EOF
        LEAVE
        RETN32 4
L_22:
        XOR AL,AL      ;its not EOF
        LEAVE
        RETN32 4
L_21:
        MOVD _IoResult,6  ;Invalid handle
        XOR EAX,EAX
        JMP L_22
      END;
END;




{*************************************************************************
*                                                                        *
*                                                                        *
*          Procedures and functions for outputting text in a PM Screen   *
*                                                                        *
**************************************************************************}

PROCEDURE CreateLogFont(_HPS:LONGWORD;VAR facename:STRING;hei,len,
                        SelAttr:LONGWORD);
VAR fa:FATTRS;
BEGIN
     move(facename[1],fa.szFaceName,length(facename)+1);
     fa.usRecordLength:=sizeof(FATTRS);
     fa.fsSelection:=SelAttr;
     fa.lMatch:=1;
     fa.idRegistry:=0;
     fa.usCodePage:=0; {default}
     fa.lMaxbaseLineExt:=hei;
     fa.lAveCharWidth:=len;
     fa.fsType:=0;
     fa.fsFontUse:=0;
     ASM
        LEA EAX,$fa
        PUSH EAX
        PUSHL 1   ;Font ID
        PUSHL 0
        PUSHL $_hps
        MOV AL,4
        CALLDLL PMGPI,368    ;GpiCreateLogFont
        ADD ESP,16

        PUSHL 1   ;Font ID
        PUSHL $_hps
        MOV AL,2
        CALLDLL PMGPI,513   ;GpiSetCharSet
        ADD ESP,8
     END;
END;

PROCEDURE InvalidatePMCrtWindow;
VAR rc:RECTL;
BEGIN
     ASM
        LEA EAX,$rc
        PUSH EAX
        PUSHL _PMCrtWindow
        MOV AL,2
        CALLDLL PMWIN,840  ;WinQueryWindowRect
        ADD ESP,8

        PUSHL 0
        LEA EAX,$rc
        PUSH EAX
        PUSHL _PMCrtWindow
        MOV AL,3
        CALLDLL PMWIN,765   ;WinInvalidateRect
        ADD ESP,12
     END;
END;


PROCEDURE PMCrtScrollDown;
BEGIN
     ASM
        MOV EDI,_PMScrBuf
        MOV ESI,EDI
        ADD ESI,256
        MOV ECX,1920   ;30 Lines a 256 chars=7680 (DIV 4 --> MOVSD)
        CLD
        REP
        MOVSW          ;MOVSD
     END;
     Dec(DrawLocY);
     PmScrBuf^[DrawLocY]:='';
     {prepare whole window for repaint}
     MaxDrawStarty:=0;
     MaxDrawLeny:=MaxLines;
END;

PROCEDURE PMCrtRedraw(_hps:HPS);
VAR pt:pointl;
    rec:RECTL;
    Adresse:LONGWORD;
    t:Word;
    Metrics:FontMetrics;
    YAddFont:LONGWORD;
    Size:LONGWORD;
    cusizex,cusizey,cux,cuy:LONGWORD;
    facename:string;
BEGIN
     Size:=sizeof(FontMetrics);
     facename:='System VIO';
     CreateLogFont(_hps,facename,16,8,0);
     ASM
        LEA EAX,$Metrics
        PUSH EAX
        PUSHL $Size
        PUSHL $_hps
        MOV AL,3
        CALLDLL PMGPI,453  ;QueryFontMetrics
        ADD ESP,12

        LEA EAX,$rec
        PUSH EAX
        PUSHL _PMCrtWindow
        MOV AL,2
        CALLDLL PMWIN,840  ;WinQueryWindowRect
        ADD ESP,8
     END;
     YAddFont:=Metrics.lMaxAscender+Metrics.lMaxDescender;
     cusizex:=Metrics.lAveCharWidth;
     cusizey:=2;
     cux:=2+DrawLocx*cusizex;
     cuy:=rec.yTop-(DrawLocy+1)*YAddFont;
     ASM
        ;Set window cursor
        PUSHL 0      ;whole window
        PUSHL 8004h  ;CURSOR_SETPOS
        PUSHL $cusizey
        PUSHL $cusizex
        PUSHL $cuy
        PUSHL $cux
        PUSHL _PMCrtWindow
        MOV AL,7
        CALLDLL PMWIN,715  ;WinCreateCursor
        ADD ESP,28

        PUSHL _CursorVisible
        PUSHL _PMCrtWindow
        MOV AL,2
        CALLDLL PMWIN,880     ;WinShowCursor
        ADD ESP,8

        PUSHL _TextCol        ;TextColor
        PUSHL $_hps
        MOV AL,2
        CALLDLL PMGPI,517    ;GpiSetColor
        ADD ESP,8

        PUSHL _TextBackCol   ;Text BackGround
        PUSHL $_hps
        MOV AL,2
        CALLDLL PMGPI,504    ;GpiSetBackColor
        ADD ESP,8

        PUSHL 2      ;BM_OVERPAINT
        PUSHL $_hps
        MOV AL,2
        CALLDLL PMGPI,505    ;GpiSetBackMix
        ADD ESP,8

        MOV EAX,_MaxDrawStarty
        MOV EBX,256
        MUL EBX
        MOV EBX,_PmScrBuf
        ADD EAX,EBX
        MOV $Adresse,EAX
    END;

    pt.x:=2;
    pt.y:=rec.yTop-(MaxDrawStarty+1)*yAddFont;
    t:=0;
    IF MaxDrawLeny<>MaxLines THEN
    BEGIN
         rec.yTop:=pt.y;
         rec.yBottom:=rec.yTop-(MaxDrawLeny+1)*yAddFont;
         IF MaxDrawLeny=0 THEN rec.xleft:=rec.xleft+DrawLocX*cusizex; {1 Zeile}
    END;
    ASM
       PUSHL _TextBackCol
       LEA EAX,$rec
       PUSH EAX
       PUSHL $_hps
       MOV AL,3
       CALLDLL PMWIN,743  ;WinFillRect
       ADD ESP,12
    END;
    WHILE pt.y>=rec.yBottom DO
    BEGIN
         ASM
            MOV ESI,$Adresse
            MOV AL,[ESI+0]
            CMP AL,0
            JE !no_draw
            INC ESI
            PUSH ESI
            MOVZX EAX,AL
            PUSH EAX

            LEA EAX,$pt
            PUSH EAX
            PUSHL $_hps
            MOV AL,4
            CALLDLL PMGPI,359   ;GpiCharStringAt
            ADD ESP,16
!no_draw:
         END;
         Inc(Adresse,256);
         dec(pt.y,yAddFont);
         inc(t);
         IF t>MaxDrawLeny THEN exit;
    END;
END;

FUNCTION PMCrtHandleEvent(Win:LONGWORD;Msg:LONGWORD;para1,para2:POINTER;
                          VAR Handled:BOOLEAN):LONGWORD;
VAR
    H:Boolean;
    _hps:LONGWORD;
    r:LONGWORD;
    command:WORD;
    rc:RECTL;
BEGIN
      r:=0;
      H:=TRUE;
      CASE Msg OF
          WM_QUIT:
          BEGIN
               IF PMCrtWindow<>0 THEN
               BEGIN {Destroy Crt Window}
                    ASM
                       PUSHL 5 ;QW_PARENT
                       PUSHL $Win
                       MOV AL,2
                       CALLDLL PMWIN,834  ;WinQueryWindow
                       ADD ESP,8
                       PUSH EAX
                       MOV AL,1
                       CALLDLL PMWIN,728  ;WinDestroyWindow
                       ADD ESP,4
                    END;
                    PMCrtWindow:=0;
                    FreeApiMem(PMScrBuf,sizeof(ScreenBuf));
               END;
               IF not Handled THEN H:=FALSE;
          END;
          WM_SETFOCUS:  {EingabeFocus neu setzen}
          BEGIN
               ASM
                  MOV EAX,[EBP+12]  ;para2
                  CMP EAX,0
                  JE !dc      ;Window is loosing focus

                  ;Window becomes focus --> Create the cursor
                  PUSHL 0  ;whole window
                  PUSHL 4  ;CURSOR_SOLID | CURSOR_FLASH
                  PUSHL 2
                  PUSHL 8
                  PUSHL 40
                  PUSHL 40
                  PUSHL _PMCrtWindow
                  MOV AL,7
                  CALLDLL PMWIN,715  ;WinCreateCursor
                  ADD ESP,28

                  PUSHL 1            ;Show the cursor
                  PUSHL _PMCrtWindow
                  MOV AL,2
                  CALLDLL PMWIN,880  ;WinShowCursor
                  ADD ESP,4

                  CALLN32 _InvalidatePMCrtWindow

                  JMP !ccde
!dc:
                  ;Window is loosing focus --> Destroy the cursor
                  PUSHL _PMCrtWindow
                  MOV AL,1
                  CALLDLL PMWIN,725  ;WinDestroyCursor
                  ADD ESP,4
!ccde:
               END;
          END;
          WM_CHAR:
          BEGIN
              if CrtKeyCount < 33 then
              begin
                   ASM
                      MOV AX,[EBP+16]    ;para1
                      AND AX,41h         ;KC_Char valid and KC_KEYUP
                      CMP AX,1
                      JNE !no_char
                      MOV AX,[EBP+12] ;para2
                      LEA EDI,_KeyBuffer
                      MOV BL,_CrtKeyCount
                      MOVZX EBX,BL
                      ADD EDI,EBX
                      INCB _CrtKeyCount
                      MOV [EDI+0],AL
!no_char:
                   END;
              end;
          END;
          WM_CLOSE:
          BEGIN
               PmCrtWindow:=0;
               IF not AlternateExit THEN {send WM_QUIT}
               BEGIN
                    ASM
                       PUSHL 0
                       PUSHL 0
                       PUSHL 2ah  ;WM_QUIT
                       PUSHL $win
                       MOV AL,4
                       CALLDLL PMWIN,919  ;WinPostMsg
                       ADD ESP,16
                    END;
               END
               ELSE {only destroy window}
               BEGIN
                    ASM
                       PUSHL 5 ;QW_PARENT
                       PUSHL $Win
                       MOV AL,2
                       CALLDLL PMWIN,834  ;WinQueryWindow
                       ADD ESP,8
                       PUSH EAX
                       MOV AL,1
                       CALLDLL PMWIN,728  ;WinDestroyWindow
                       ADD ESP,4
                    END;
               END;
          END;
          WM_PAINT:
          BEGIN
               MaxDrawStarty:=0;
               MaxDrawLeny:=MaxLines;
               ASM
                  LEA EAX,$rc
                  PUSH EAX
                  PUSHL 0
                  PUSHL $Win
                  MOV AL,3
                  CALLDLL PMWIN,703  ;WinbeginPaint
                  ADD ESP,12
                  MOV $_hps,EAX
               END;
               PMCrtRedraw(_hps);
               ASM
                  PUSHL $_hps
                  MOV AL,1
                  CALLDLL PMWIN,738  ;WinendPaint
                  ADD ESP,4
               END;
          END;
          WM_ERASEBACKGROUND:r:=1;
          ELSE IF not Handled THEN H:=FALSE;
      END;
      Handled:=H;
      PMCrtHandleEvent:=r;
END;

FUNCTION PMCrtHandler(para2,para1:POINTER;Msg,Win:LONGWORD):LONGWORD;ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,2
        ;Save parameters as it is SYSTEM Calling Convention
        PUSH EDI
        PUSH ESI
        PUSH EBX

        MOVW [EBP-2],0   ;Not Handled
        PUSHL $Win
        PUSHL $Msg
        PUSHL $para1
        PUSHL $para2
        LEA EAX,[EBP-2]
        PUSH EAX
        CALLN32 _PMCrtHandleEvent
        MOV BL,[EBP-2]
        CMP BL,0
        JNE !hh
        ;not handled
        ;Default Window handler
        PUSHL $para2
        PUSHL $para1
        PUSHL $msg
        PUSHL $win
        MOV AL,4
        CALLDLL PMWin,911   ;WinDefWindowProc
        ADD ESP,16
!hh:
        ;Get registers as it is SYSTEM calling convention
        POP EBX
        POP ESI
        POP EDI
        LEAVE
        RETN32
    END;
END;

PROCEDURE DrawPMCrtWindow;
BEGIN
     ASM
         PUSHL _PMCrtWindow
         MOV AL,1
         CALLDLL PMWIN,757   ;WinGetPS
         ADD ESP,4

         PUSH EAX            ;For WinReleasePS

         PUSH EAX
         CALLN32 _PMCrtRedraw

         MOV AL,1
         CALLDLL PMWIN,848   ;WinReleasePS
         ADD ESP,4
     END;
END;


PROCEDURE CreatePMCrtWindow; {Generate a window}
VAR fr:LONGWORD;
    t:Byte;
BEGIN
     IF PMCrtWindow=0 THEN
     BEGIN
         MaxLines:=29;
         TextCol:=7;     {CLR_NEUTRAL}
         TextBackCol:=0; {CLR_BACKGROUND}
         GetAPIMem(PMScrBuf,sizeof(ScreenBuf));
         {prepare whole window for repaint}
         MaxDrawStarty:=0;
         MaxDrawLeny:=MaxLines;
         ASM
            MOV ECX,_MaxLines
            MOV AL,0
!cloop:
            MOV EDI,_PMScrBuf
            MOV [EDI+0],AL
            ADD EDI,256
            LOOP !cloop
         END;
         DrawLocX:=0;
         DrawLocY:=0;
         ASM
            PUSHL 0
            PUSHL 4  ;CS_SizeRedraw
            MOV EAX,*_PMCrtHandler
            PUSH EAX
            PUSHL OFFSET(@CrtWinName)
            PUSHL _AppHandle
            MOV AL,5
            CALLDLL PMWIN,926  ;WinregisterClass
            ADD ESP,20

            PUSHL OFFSET(_PmCrtWindow)
            PUSHL 0
            PUSHL 0
            PUSHL 0
            MOV EAX,OFFSET(_PMCrtTitle)
            INC EAX
            PUSH EAX
            PUSHL OFFSET(@CrtWinName)
            MOVD $fr,0c3bh
            LEA EAX,$fr
            PUSH EAX
            PUSHL 0
            PUSHL 1  ;HWND_DESKTOP
            MOV AL,9
            CALLDLL PMWIN,908   ;WinCreateStdWindow
            ADD ESP,36
            MOV _PMCrtFrameHandle,EAX

            PUSHL 8fh
            PUSHL 350
            PUSHL 500
            PUSHL 100
            PUSHL 50
            PUSHL 3   ;HWND_TOP
            PUSHL _PMCrtFrameHandle
            MOV AL,7
            CALLDLL PMWIN,875   ;WinsetWindowPos
            ADD ESP,28
            LEAVE
            RETN32
@CrtWinName db 'PMCRTWIN',0
       END;
     END;
END;



PROCEDURE GOTOXY(x,y:LONGWORD);
BEGIN
     CreatePMCrtWindow;
     IF x>0 THEN dec(x);
     IF y>0 THEN dec(y);
     IF x>250 THEN x:=250;
     IF y>MaxLines-1 THEN y:=MaxLines-1;
     DrawLocX:=x;
     DrawLocY:=y;
     MaxDrawStarty:=DrawLocy;
     MaxDrawLeny:=0;
     DrawPMCrtWindow;
END;

PROCEDURE HideCursor;
BEGIN
     CreatePMCrtWindow;
     Cursorvisible:=0;
     MaxDrawStarty:=DrawLocy;
     MaxDrawLeny:=0;
     DrawPMCrtWindow;
END;

PROCEDURE ShowCursor;
BEGIN
     CreatePMCrtWindow;
     Cursorvisible:=1;
     MaxDrawStarty:=DrawLocy;
     MaxDrawLeny:=0;
     DrawPMCrtWindow;
END;

PROCEDURE ClrScr;
BEGIN
     CreatePMCrtWindow;
     DrawLocx:=0;
     DrawLocY:=0;
     ASM
        MOV ECX,_MaxLines
        MOV AL,0
!cloop_1:
        MOV EDI,_PMScrBuf
        MOV [EDI+0],AL
        ADD EDI,256
        LOOP !cloop_1
     END;
     {prepare whole window for repaint}
     MaxDrawStarty:=0;
     MaxDrawLeny:=MaxLines;
     DrawPMCrtWindow;
END;

ASSEMBLER

!CharOut PROC NEAR32  ;Char in AL  ;Format in AH
             PUSH AX  ;Save char
             CALLN32 _CreatePMCrtWindow
             MOV EDI,_PMScrBuf
             MOV EAX,_DrawLocY
             SHL EAX,8  ;*256
             ADD EDI,EAX

             MOV EBX,_DrawLocX
             CMP EBX,255
             JAE !exco    ;Skip
!next_c:
             MOV AL,[EDI+0]
             MOVZX EAX,AL
             CMP EAX,75
             JAE !exco    ;Skip
             CMP EAX,EBX        ;until positions ok
             JA !go
             MOV ESI,EDI
             ADD ESI,EAX
             INC ESI
             MOVB [ESI+0],32    ;Fill with space
             INCB [EDI+0]
             JMP !next_c
!go:
             CMP EAX,EBX
             JA !ninc
             INCB [EDI+0]
!ninc:
             POP AX             ;Get char
             INC EBX
             CMP AH,1           ;Format ???
             JBE !nform2
             MOVZX ECX,AH
             DEC ECX
!lolo:
             INCB [EDI+0]
             MOV ESI,EDI
             ADD ESI,EBX
             MOVB [ESI+0],32
             INC EBX
             INCD _DrawLocX
             LOOP !lolo
!nform2:
             ADD EDI,EBX
             MOV [EDI+0],AL
             INCD _DrawLocX
!exco:
             RETN32
!CharOut ENDP

!WriteEnd PROC NEAR32
                  MOV EAX,_DrawLocY
                  MOV _MaxDrawStarty,EAX
                  MOVD _MaxDrawLeny,0  ;draw 1 line
                  MOV EAX,_DrawLocX
                  CMP EAX,74
                  JB !wncr
                  INCD _DrawLocY
                  MOV EAX,_DrawLocY
                  CMP EAX,_MaxLines
                  JB !ns22
                  ;Scroll the current window
                  CALLN32 _PMCrtScrollDown
!ns22:
                  MOVD _DrawLocX,0
!wncr:
                  CALLN32 _DrawPMCrtWindow
                  RETN32
!WriteEnd ENDP



!WritelnEnd PROC NEAR32
                  CALLN32 _CreatePMCrtWindow;
                  MOV EAX,_DrawLocY
                  MOV _MaxDrawStarty,EAX
                  MOVD _MaxDrawLeny,0  ;draw 1 line
                  INC EAX
                  MOV _DrawLocY,EAX
                  CMP EAX,_MaxLines
                  JB !ns
                  ;Scroll the current window
                  CALLN32 _PMCrtScrollDown
!ns:
                  MOVD _DrawLocX,0
                  CALLN32 _DrawPMCrtWindow
                  RETN32
!WritelnEnd ENDP


!Writeln PROC NEAR32
            CALLN32 !WritelnEnd
            RETN32
!Writeln ENDP


!WriteStr PROC NEAR32        ;put out string
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,255
         PUSHL [EBP+10]
         LEA EAX,[EBP-255]
         PUSH EAX
         PUSH 255
         CALLN32 !STRCOPY
$S EQU [EBP-255]

         CALLN32 _CreatePMCrtWindow

         MOV AL,[EBP+8]      ;Format value
         LEA ESI,$S
         MOV BL,[ESI+0]      ;Actual len
         CMP BL,AL
         JAE !nform

         ;String must be extended
         SUB AL,BL           ;Char to extend
         MOVZX EAX,AL        ;Number of spaces to be inserted
         MOV CL,[ESI+0]      ;Length of string
         MOVZX ECX,CL
         ADD [ESI+0],AL      ;Increment length
         ADD ESI,ECX         ;Last char
         MOV EDI,ESI
         ADD EDI,EAX
         STD
         REP
         MOVSB
         CLD
         LEA EDI,$S
         INC EDI
         MOV ECX,EAX
         MOV AL,32
         REP
         STOSB
!nform:
         MOV EDI,_PMScrBuf
         MOV EAX,_DrawLocY
         SHL EAX,8  ;*256
         ADD EDI,EAX

         MOV EBX,_DrawLocX  ;is this the start of a line ?
         CMP EBX,0
         JNE !move          ;No --> special action required

         LEA ESI,$S         ;TextString
         MOV AL,[ESI+0]
         MOVZX EAX,AL
         ADD _DrawLocX,EAX
         PUSH ESI
         PUSH EDI
         PUSH 255
         CALLN32 !StrCopy
         LEAVE
         RETN32 6
!move:
!next_c_1:
         MOV AL,[EDI+0] ;Actual len of the line
         MOVZX EAX,AL
         CMP EAX,75
         JAE !exco_1    ;Skip

         CMP EAX,EBX    ;until positions ok (pos=DrawLocX)
         JA !go_1
         MOV ESI,EDI
         ADD ESI,EAX
         INC ESI
         MOVB [ESI+0],32  ;Fill with space
         INCB [EDI+0]
         JMP !next_c_1
!go_1:
         LEA ESI,$S         ;TextString
         MOV AL,[ESI+0]     ;Length of the string
         INC ESI
         MOVZX EAX,AL       ;Bytes to copy
         MOV BL,[EDI+0]     ;Current length of the line
         MOVZX EBX,BL

         MOV ECX,EAX
         ADD ECX,EBX
         CMP ECX,75
         JB !aok            ;This fits into this line
         ;Limit exceeeded --> Cut String and NewLine
         MOV EAX,75
         SUB EAX,EBX     ;Calculate positions that are free
!aok:
         CMP EAX,0       ;Current bytes to tranmit
         JE !exco_1      ;No bytes to transmit

         MOV ECX,_DrawLocX
         ADD ECX,EAX      ;Add Bytes to Transmit
         MOV [EDI+0],CL   ;increment textlen

         MOV EBX,_DrawLocX
         ADD _DrawLocX,EAX

         ADD EDI,EBX        ;set to location
         INC EDI

         MOV ECX,EAX        ;Bytes to copy
         CLD
         REP
         MOVSB
!exco_1:
         LEAVE
         RETN32 6
!WriteStr ENDP

!WriteWord PROC NEAR32       ;(AX:word)           gibt 16 bit Zahl in AX aus
          PUSH EBP
          MOV EBP,ESP
          SUB ESP,255
$!TempStr EQU [EBP-255]
          MOV BL,[EBP+8]     ;Format
          PUSH BX

          MOVZX EAX,AX
          PUSH EAX
          LEA EAX,$!TempStr
          PUSH EAX
          CALLN32 _ToStr

          POP BX
          LEA EAX,$!TempStr
          PUSH EAX
          PUSH BX          ;Format
          CALLN32 !WriteStr
          LEAVE
          RETN32 2    ;keine Parameter
!WriteWord ENDP

!WriteInt PROC NEAR32       ;(AX:word) gibt 16 bit Zahl in AX aus mit Vorzeichen
          PUSH EBP
          MOV EBP,ESP
          SUB ESP,255
$!TempStr EQU [EBP-255]
          MOV BL,[EBP+8]     ;Format
          PUSH BX
          MOV CX,0
          CMP AX,0
          JNS !novorz
          MOV CX,1           ;'-' requested
          NEG AX
!novorz:
          PUSH CX            ;Format
          MOVZX EAX,AX
          PUSH EAX
          LEA EAX,$!TempStr
          PUSH EAX
          CALLN32 _ToStr
          POP CX             ;Format
          CMP CX,0
          JE !n_min

          LEA ESI,$!TempStr
          MOV CL,[ESI+0]
          INCB [ESI+0]
          MOVZX ECX,CL
          ADD ESI,ECX
          MOV EDI,ESI
          INC EDI
          STD
          REP
          MOVSB
          CLD
          LEA ESI,$!TempStr
          MOVB [ESI+1],'-'
!n_min:
          POP BX
          LEA EAX,$!TempStr
          PUSH EAX
          PUSH BX          ;Format
          CALLN32 !WriteStr
          LEAVE
          RETN32 2    ;keine Parameter
!WriteInt ENDP


!WriteLongWord PROC NEAR32       ;(EAX:word)    gibt 32 bit Zahl in EAX aus
             PUSH EBP
             MOV EBP,ESP
             SUB ESP,255
$!TempStr EQU [EBP-255]
             MOV BL,[EBP+8]     ;Format
             PUSH BX

             PUSH EAX
             LEA EAX,$!TempStr
             PUSH EAX
             CALLN32 _ToStr

             POP BX
             LEA EAX,$!TempStr
             PUSH EAX
             PUSH BX          ;Format
             CALLN32 !WriteStr
             LEAVE
             RETN32 2  ;keine Parameter
!WriteLongWord ENDP

!WriteLongInt PROC NEAR32       ;(EAX:word)    gibt 32 bit Zahl in EAX aus
             PUSH EBP
             MOV EBP,ESP
             SUB ESP,255
$!TempStr EQU [EBP-255]
             MOV BL,[EBP+8]     ;Format
             PUSH BX
             MOV CX,0
             CMP EAX,0
             JNS !novorz1
             MOV CX,1
             NEG EAX
!novorz1:
             PUSH CX            ;Format
             PUSH EAX
             LEA EAX,$!TempStr
             PUSH EAX
             CALLN32 _ToStr
             POP CX             ;Format
             CMP CX,0
             JE !n_min1

             LEA ESI,$!TempStr
             MOV CL,[ESI+0]
             INCB [ESI+0]
             MOVZX ECX,CL
             ADD ESI,ECX
             MOV EDI,ESI
             INC EDI
             STD
             REP
             MOVSB
             CLD
             LEA ESI,$!TempStr
             MOVB [ESI+1],'-'
!n_min1:
             POP BX
             LEA EAX,$!TempStr
             PUSH EAX
             PUSH BX          ;Format
             CALLN32 !WriteStr
             LEAVE
             RETN32 2    ;keine Parameter
!WriteLongInt ENDP


END;



{*************************************************************************
*                                                                        *
*                                                                        *
*           SYSTEM initialization procedures                             *
*                                                                        *
*                                                                        *
**************************************************************************}


ASSEMBLER

!SystemEnd PROC NEAR32
           XOR AH,AH
           MOV _ExitCode,AX
exloop1:
           PUSHL OFFSET(@raddr1)  ;Returnadress for ExitProc
           PUSHL _ExitProc    ;ExitProc on Stack
           RETN32             ;jump into ExitProc
@raddr1
           JMP exloop1        ;until termination
!SystemEnd ENDP

!Halt1 PROC NEAR32
      MOV AX,_ExitCode
      PUSH AX
      CALLN32 _Halt
!Halt1 ENDP

!SystemInit PROC NEAR32  ;SystemHeapSize in EAX
           ;Initialize FPU
           db 0dbh,0e3h              ;FINIT Init FPU
           db 0dbh,0e2h              ;FCLEX Clear Exceptions
           FLDCW !FPUControl         ;Load Control word
           FWAIT
           ;allocate main memory (uncommitted) for suballocation
           ;via Getmem and Freemem
           MOV EBX,1024
           MUL EBX
           MOV _HeapSize,EAX
           PUSHL 3         ;Flags PAG_READ|PAG_WRITE
           PUSH EAX        ;Length of memory
           PUSHL OFFSET(_Heaporg)
           MOV AL,3             ;3 Parameters
           CALLDLL DosCalls,299 ;DosAllocMem
           ADD ESP,12            ;Clear Stack
           CMP EAX,0
           JNE !ei

           ;Prepare the memory block for suballocation
           PUSHL _HeapSize      ;Size of Heap
           PUSHL 5              ;Flags DOSSUB_INIT|DOSSUB_SPARSE_OBJ
           PUSHL _Heaporg
           MOV AL,3
           CALLDLL DosCalls,344 ;DosSubSetMem
           ADD ESP,12            ;Clear Stack
           CMP EAX,0
           JNE !ei

           MOV EAX,_HeapOrg
           MOV _HeapPtr,EAX
           ADD EAX,_HeapSize
           MOV _HeapEnd,EAX
           MOV EAX,*!Halt1       ;Standard exit procedure
           MOV _ExitProc,EAX
           ;Create Application anchor handle
           PUSHL 0
           MOV AL,1
           CALLDLL PMWIN,763   ;WinInitialize
           ADD ESP,4
           MOV _AppHandle,EAX
           ;Create Application Message queue
           PUSHL 0
           PUSHL _AppHandle
           MOV AL,2
           CALLDLL PMWIN,716   ;WinCreateMsgQueue
           ADD ESP,8
           MOV _AppQueueHandle,EAX

           PUSH 0
           PUSHL OFFSET(!TempString)
           CALLN32 _ParamStr   ;Get name of program

           PUSHL OFFSET(!TempString)
           PUSHL OFFSET(_PMCRTTITLE)
           PUSH 255
           CALLN32 !StrCopy
           MOVD _TextBackCol,-2
           MOVD _SeekMode,0   ;FILE_BEGIN
           MOVD _FileMode,42h ;fmInOut
           MOVB _CrtKeyCount,0
           MOVD _CursorVisible,1  ;Cursor is visible
           RETN32
!ei:
           ;Error during initialization
           POP EAX                ;Address from which the error came
           MOV _ErrorAddr,EAX
           PUSH 216               ;Access violation
           CALLN32 _RunErrorIntern
!SystemInit ENDP

!VmtCall PROC NEAR32  ;(object:Pointer;) numProc in AX
        PUSH EBP
        MOV EBP,ESP
        MOV EDI,[EBP+8]
        CMP EDI,0
        JNE !obj_init
!obj_error:
        ;Object not initialized or VMT damaged
        PUSH 210               ;Object not initialized
        CALLN32 _RunErrorIntern
!obj_init
        MOV EBX [EDI+0]
        CMP EBX,0
        JE !obj_error
        MOV EDI,[EDI+0]  ;get VMT pointer
        DEC AX
        SHL AX,2         ;VmtNummer*2
        MOVZX EAX,AX
        ADD EDI,EAX      ;add NumProc
        LEAVE
        db ffh,27h       ;JMP NEAR32 [EDI+0] --> in Methode springen
        RETN32
!VmtCall ENDP

END;


{*************************************************************************
*                                                                        *
*                                                                        *
*             KeyBoard Procedures and functions                          *
*                                                                        *
*                                                                        *
**************************************************************************}

FUNCTION KeyPressed: Boolean;
VAR _qmsg:QMSG;
    MsgIdent:LONGWORD;
begin
  CreatePMCrtWindow;
  ASM
!next_mess:
      CMPB _CrtKeyCount,0
      JA !exm

      PUSHL 0
      PUSHL 0
      PUSHL 0
      LEA EAX,$_qmsg
      PUSH EAX
      PUSHL _AppHandle
      MOV AL,5
      CALLDLL PMWIN,915  ;WinGetMsg
      ADD ESP,20
      CMP EAX,0
      JNE !exm_1
      MOVD _PMCrtWindow,0
      MOV AX,0
      CALLN32 !SystemEnd  ;WM_QUIT message detected
!exm_1:
      LEA EAX,$_qmsg
      PUSH EAX
      PUSHL _AppHandle
      MOV AL,2
      CALLDLL PMWIN,912  ;WinDispatchMsg
      ADD ESP,8
!exm:
  END;
  IF CrtKeyCount>0 THEN KeyPressed:=TRUE
  ELSE KeyPressed:=FALSE;
END;

FUNCTION ReadKey:Char;
var t:byte;
begin
    CreatePMCrtWindow;
    REPEAT UNTIL KeyPressed;
    ReadKey:=KeyBuffer[0];
    Dec(CrtKeyCount);
    FOR t:=0 to CrtKeyCount do KeyBuffer[t]:=Keybuffer[t+1];
    ASM
       ;Function result
       MOV AL,[EBP-2]
    END;
end;

ASSEMBLER

!ReadStr PROC NEAR32  ;read string from comsole [EBP+8] is output
                   PUSH EBP
                   MOV EBP,ESP
                   SUB ESP,2
                   CALLN32 _CreatePMCrtWindow
                   PUSHA         ;PUSHAD
                   MOV EDI,[EBP+8]
                   INC EDI       ;on first character
                   MOV ECX,0     ;Length is currently zero
_nez:
                   PUSHA
                   CALLN32 _ReadKey   ;read a character
                   CMP AL,0dh          ;is it a CR
                   JE !zcr             ;yes !
                   MOV [EBP-2],AL      ;save
                   CMP AL,8            ;is it a BS
                   JNE __!nbs

                   POPA
                   MOV EAX,[EBP+8]
                   CMP ECX,0
                   JE _nez             ;Backspace cannot be first char
                   DEC EDI
                   PUSHA
                   DECD _DrawLocX
                   MOV AL,32
                   MOV AH,0
                   CALLN32 !CharOut
                   DECD _DrawLocX
                   CALLN32 !WriteEnd
                   POPA
                   DEC ECX
                   JMP _nez
__!nbs:
                   MOV AH,0
                   CALLN32 !CharOut    ;and put out
                   CALLN32 !WriteEnd
_nv10:
                   POPA
                   MOV AL,[EBP-2]      ;get char
                   MOV [EDI+0],AL      ;and save
                   INC EDI
                   INC ECX             ;save length
                   CMP ECX,254         ;already 255 chars ?
                   JB _nez             ;no-->next char
                   PUSHA

!zcr:
                   POPA
                   MOV ESI,[EBP+8]
                   MOV [ESI+0],CL      ;save length
                   CALLN32 !WriteEnd
                   POPA
                   LEAVE
                   RETN32
!ReadStr ENDP

!ReadLongWord PROC NEAR32   ;(var value:word)   read word from console
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,259
$!TempStr EQU [EBP-259]
         CALLN32 _CreatePMCrtWindow
         LEA EAX,$!TempStr
         PUSH EAX
         CALLN32 !ReadStr   ;to !TempString
         LEA ESI,$!TempStr
         MOVD [EBP-4],0     ;Word to 0
         MOV EBX,1           ;value to multiply
         MOV CL,[ESI+0]     ;get length
         MOVZX ECX,CL
         CMP CL,0           ;no input ??
         JE l4
         ADD ESI,ECX        ;onto first char
L3:
         MOV AL,[ESI+0]     ;get char
         DEC ESI
         SUB AL,48
         MOVZX EAX,AL
         MUL EBX
         ADD [EBP-4],EAX
         MOV EAX,EBX
         MOV EBX,10
         MUL EBX
         MOV EBX,EAX          ;Multiplikator
         LOOP L3
L4:
         MOV EAX,[EBP-4]
         LEAVE
         RETN32             ;no parameters
!ReadLongWord ENDP

END; {ASSEMBLER}

{*************************************************************************
*                                                                        *
*                                                                        *
*             Floating point support                                     *
*                                                                        *
*                                                                        *
**************************************************************************}

PROCEDURE SetTrigMode(mode:BYTE);
BEGIN
     CASE Mode OF
        Rad:IsNotRad:=FALSE;
        Deg:
        BEGIN
             ToRad:=0.01745329262;
             FromRad:=57.29577951;
             IsNotRad:=TRUE;
        END;
        Gra:
        BEGIN
             ToRad:=0.01570796327;
             FromRad:=63.66197724;
             IsNotRad:=TRUE;
        END;
     END; {case}
END;

ASSEMBLER

!RadArc PROC NEAR32  ;Converts ST(0) to Rad
       CMPB _IsNotRad,1
       JNE !!!_l80
       FLDT _ToRad
       DB deh,c9h  ;FMULP ST(1),ST
!!!_l80:
       RETN32
!RadArc ENDP

!NormRad PROC NEAR32  ;Converts ST(0) to actual TrigMode
       CMPB _IsNotRad,1
       JNE !!!_l81
       FLDT _FromRad
       DB deh,c9h  ;FMULP ST(1),ST
!!!_l81:
       RETN32
!NormRad ENDP


!Calculate PROC NEAR32
;Input EDI String
;CX Count
;Output Value in ST(0)
         PUSH EBP
         MOV EBP,ESP
         SUB ESP,2
!!!weiter1:
         MOV AL,[EDI+0]
         SUB AL,3ah
         ADD AL,0ah
         JNB !!!ex
         XOR AH,AH
         MOV [EBP-2],AX
         FILDD !C10
         db 0deh,0c9h           ;FMULP ST(1),ST
         FILDW [EBP-2]
         db 0deh,0c1h           ;FADDP ST(1),ST
         INC EDI
         DEC CX
         CMP CX,0
         JE !!!ex
         JMP !!!weiter1
!!!ex:
         LEAVE
         RETN32
!Calculate ENDP

!DivMul10 PROC NEAR32
;Input: BX Count of divides/mult by 10
;       AL 0-mult 1-divide
        MOV CX,BX
        AND CX,7                ;only values 0..7
        MOV ESI,OFFSET(!DivTab)
        MOVZX ECX,CX
        SHL ECX,1
        SHL ECX,1
        ADD ESI,ECX
        FILDD [ESI+0]   ;10..10000000 laden
        SHR BX,1
        SHR BX,1
        SHR BX,1                ;divide numbers by 8
        MOV ESI,OFFSET(!Power10Tab)
        CMP BX,0
        JE !!!process
!!!Power10:
        SHR BX,1
        JNB !!!mm            ;until a bit is set
        FLDT [ESI+0]
        db 0deh,0c9h              ;FMULP ST(1),ST
!!!mm:
        ADD ESI,10
        CMP BX,0
        JNE !!!Power10
!!!process:
        CMP AL,1
        JNE !!!_mul
        db 0deh,0f9h             ;FDIVP ST(1),ST
        RETN32
!!!_mul:
        db 0deh,0c9h             ;FMULP ST(1),ST
        RETN32
!DivMul10 ENDP

!Str2Float PROC NEAR32
;Input EDI  String to convert
;      CX     Length of this string
;Output Floating point value in ST(0)
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,6     ;for Control word and sign

        FSTCW [EBP-2] ;Store control word
        FWAIT
        db 0dbh,0e2h                 ;FCLEX Clear exceptions
        FLDCW !FPUControl  ;Load control word
        FWAIT
        db 0d9h,0eeh               ;FLDZ Load +0.0
        MOVB [EBP-4],0         ;sign is positive
        MOVW [EBP-6],0         ;count of numbers after point
!!!again:
        CMP CX,0              ;String has zero length ?
        JE !!!Error

        MOV AL,[EDI+0]        ;load character
        CMP AL,43  ;'+'
        JNE !!!not_plus
        ;Sign '+' was detected
        INC EDI
        DEC CX
        CMP CX,0
        JE !!!Error
        JMP !!!weiter
!!!not_plus:
        CMP AL,45   ;'-'
        JNE !!!not_minus
        ;Sign '-' was detected
        MOVB [EBP-4],1 ;Sign is negative
        INC EDI
        DEC CX
        CMP CX,0
        JE !!!Error
        JMP !!!weiter
!!!not_minus:
        CMP AL,32
        JNE !!!weiter
        INC EDI
        DEC CX
        JMP !!!again
!!!weiter:
        CALLN32 !Calculate                ;Calculate numbers before point
        CMP CX,0
        JE !!!no_exp

        ;Look for .
        MOV AL,[EDI+0]
        CMP AL,'.'
        JNE !!!Change
        DEC CX
        INC EDI
        PUSH CX
        CALLN32 !Calculate              ;Calculate numbers after point
        POP BX
        SUB BX,CX
        MOV [EBP-6],BX               ;Count of numbers after point
!!!Change:
        ;in ST(0) is now an integer value
        ;[EBP-6] contains the current numbers after the point
        CMPB [EBP-4],1
        JNE !!!not_neg
        db 0d9h,0e0h,9bh             ;FCHS+FWAIT change sign
!!!not_neg:
        ;Check for exponent
        CMP CX,0
        JE !!!no_exp
        MOV AL,[EDI+0]
        CMP AL,'e'
        JE !!!exp
        CMP AL,'E'
        JNE !!!no_exp
!!!exp:
        ;an exponent was detected
        INC EDI
        DEC CX
        CMP CX,0
        JE !!!Error
        db 0d9h,0eeh             ;FLDZ Load +0.0
        MOVB [EBP-4],0    ;sign is positive
        MOV AL,[EDI+0]
        CMP AL,'-'
        JNE !!!no_minus
        MOVB [EBP-4],1   ;sign is negative
        INC EDI
        DEC CX
        CMP CX,0
        JE !!!Error
        JMP !!!Calc
!!!no_minus:
        CMP AL,43   ;'+'
        JNE !!!calc
        INC EDI
        DEC CX
        CMP CX,0
        JE !!!Error
!!!calc:
        CALLN32 !Calculate
        FISTPW !Exponent   ;Store integer value and pop
        MOV BX,!Exponent
        MOV AL,0                 ;Mult
        CMPB [EBP-4],1
        JNE !!!make
        MOV AL,1                 ;Divide if Exponent negative
!!!make:
        PUSH CX
        CALLN32 !DivMul10
        POP CX
!!!no_exp:
        CMP CX,0
        JNE !!!Error     ;invalid chars
        MOV BX,[EBP-6]
        MOV AL,1      ;Divide
        CALLN32 !DivMul10
        JMP !!!ok
!!!Error:
        MOVW _IoResult,1      ;FPU error
!!!ok:
        LEAVE
        RETN32
!Str2Float ENDP

!Str2Real PROC NEAR32
       PUSH EBP
       MOV EBP,ESP

       MOV EDI,[EBP+16]
       MOV CL,[EDI+0]
       INC EDI
       XOR CH,CH
       CALLN32 !Str2Float
       MOV EDI,[EBP+12]
       FSTPD [EDI+0]

       MOV EDI,[EBP+8]      ;Result
       MOVW [EDI+0],0
       CMPW _FPUResult,0
       JE !!__fex1
       MOVW [EDI+0],1
!!__fex1:
       LEAVE
       RETN32 12
!Str2Real ENDP

!Str2Double PROC NEAR32
       PUSH EBP
       MOV EBP,ESP

       MOV EDI,[EBP+16]
       MOV CL,[EDI+0]
       INC EDI
       XOR CH,CH
       CALLN32 !Str2Float
       MOV EDI,[EBP+12]
       FSTPQ [EDI+0]

       MOV EDI,[EBP+8]     ;Result
       MOVW [EDI+0],0
       CMPW _FPUResult,0
       JE !!__fex11
       MOVW [EDI+0],1
!!__fex11:
       LEAVE
       RETN32 12
!Str2Double ENDP

!Str2Extended PROC NEAR32
       PUSH EBP
       MOV EBP,ESP

       MOV EDI,[EBP+16]
       MOV CL,[EDI+0]
       INC EDI
       XOR CH,CH
       CALLN32 !Str2FLoat
       MOV EDI,[EBP+12]
       FSTPT [EDI+0]

       MOV EDI,[EBP+8]   ;Result
       MOVW [EDI+0],0
       CMPW _FPUResult,0
       JE !!__fex111
       MOVW [EDI+0],1
!!__fex111:
       LEAVE
       RETN32 12
!Str2Extended ENDP


!ValReal PROC NEAR32
;Input EDI Destination string
;      ST(0) Float value
;      AX Nachkommastellen 0..9  (FFFF=alle bis zu einer 0)
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,48

       PUSH EDI
       INC EDI

       FSTPT [EBP-10]    ;Store original value

       FLDT [EBP-10]    ;original value
       FLDCW !FPURound  ;Load control word
       FWAIT
       db 0d9h,0fch             ;FRNDINT
       FLDCW !FPUControl ;Load control word
       FWAIT
       FSTPT [EBP-20]    ;Store Ganzzahl

       FLDT [EBP-10]    ;original value
       FLDT [EBP-20]    ;Ganzzahl
       db 0deh,0e9h             ;FSUBP ST(1),ST

       ;gebrochener Anteil nun in ST(0)
       db 0d9h,0e8h     ;FLD1
       db 0d8h,0d9h             ;FCOMP ST(1)
       FWAIT
       FSTSW [EBP-48]
       MOV AX,[EBP-48]
       SAHF
       JNE !!!ne_1              ;Nachkommastellen<1.0
       ;Kommastellen wurden aufgerundet --> korrigieren
       db 0ddh,0c0h            ;FFREE ST
       FLDT [EBP-20]           ;Ganzzahl
       db 0d9h,0e8h     ;FLD1
       db 0deh,0c1h            ;FADDP ST(1),ST  1 addieren
       FSTPT [EBP-20]          ;Store Ganzzahl
       db 0d9h,0eeh            ;FLDZ Nachkommastellen sind 0
!!!ne_1:
       MOV ESI,OFFSET(!DivTab)
       CMP AX,0FFFFh
       JNE !!!no_std
       ;alle Stellen bis zu einer 0
       ADD ESI,36
       JMP !!!pp
!!!no_std:
       CMP AX,9
       JBE !!!pp1
       MOV AX,9
!!!pp1:
       MOV BX,AX
       SHL BX,1
       SHL BX,1
       MOVZX EBX,BX
       ADD ESI,EBX
!!!pp:
       MOV [EBP-32],AX  ;Nachkommastellen
       FILDD [ESI+0]
       db 0deh,0c9h             ;FMULP ST(1),ST Kommastellen erweitern
       db 0d9h,0e1h    ;FABS
       FSTPT [EBP-30]   ;Kommastellen

       FLDT [EBP-10]    ;original value
       db 0d9h,0e4h             ;FTST
       FWAIT
       FSTSW [EBP-48]
       MOV AX,[EBP-48]
       SAHF
       JAE !!!_eq
       MOV AL,'-'
       CLD
       STOSB
!!!_eq:
       db 0ddh,0c0h            ;FFREE ST
       MOV ESI,OFFSET(!DivTab)
       ADD ESI,4
       FLDT [EBP-20]    ;Ganzzahl
       db 0d9h,0e1h    ;FABS
       MOV CX,0
!!!_Rep:
       FILDD [ESI+0]
       db 0deh,0f9h             ;FDIVP ST(1),ST Divide by 10
       FSTPT [EBP-42]

       FLDT [EBP-42]
       FLDT [EBP-42]
       FLDCW !FPURound  ;Load control word
       FWAIT
       db 0d9h,0fch             ;FRNDINT
       FLDCW !FPUControl ;Load control word
       FWAIT
       db 0deh,0e9h             ;FSUBP ST(1),ST Kommastellen
       FILDD [ESI+0]
       db 0deh,0c9h             ;FMULP ST(1),ST Multiply with 10
       FISTPD [EBP-46]
       MOV AX,[EBP-46]          ;Zahl
       ADD AX,48
       PUSH AX
       INC CX

       FLDT [EBP-42]
       FLDCW !FPURound  ;Load control word
       FWAIT
       db 0d9h,0fch             ;FRNDINT
       FLDCW !FPUControl ;Load control word
       FWAIT
       db 0d9h,0e4h             ;FTST
       FWAIT
       FSTSW [EBP-48]
       MOV AX,[EBP-48]
       SAHF
       JNE !!!_Rep                ;Until Zero

       CMP CX,0
       JE !!!_nk

       db 0ddh,0c0h            ;FFREE ST
       MOVZX ECX,CX
       CLD
!!!llo:
       POP AX
       STOSB
       LOOP !!!llo

       MOV AL,'.'
       STOSB
!!!_nk:
       FLDT [EBP-30]    ;Kommastellen
       MOV ECX,0
       db 0d9h,0e4h             ;FTST   -- Kommastellen 0 ???
       FWAIT
       FSTSW [EBP-48]
       MOV AX,[EBP-48]
       SAHF
       JNE !!!_Rep1             ;Not Zero
       MOV ECX,9                ;Fill it up with 9 zeros
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       PUSH 48  ;'0'
       JMP !!!zzz
!!!_Rep1:
       FILDD [ESI+0]
       db 0deh,0f9h             ;FDIVP ST(1),ST Divide by 10
       FSTPT [EBP-42]

       FLDT [EBP-42]
       FLDT [EBP-42]
       FLDCW !FPURound  ;Load control word
       FWAIT
       db 0d9h,0fch                ;FRNDINT
       FLDCW !FPUControl ;Load control word
       FWAIT
       db 0deh,0e9h             ;FSUBP ST(1),ST Kommastellen
       FILDD [ESI+0]
       db 0deh,0c9h             ;FMULP ST(1),ST  Multiply with 10
       FISTPD [EBP-46]
       MOV AX,[EBP-46]          ;Zahl
       ADD AX,48
       PUSH AX
       INC CX

       FLDT [EBP-42]
       FLDCW !FPURound  ;Load control word
       FWAIT
       db 0d9h,0fch             ;FRNDINT
       FLDCW !FPUControl ;Load control word
       FWAIT
       db 0d9h,0e4h             ;FTST
       FWAIT
       FSTSW [EBP-48]
       MOV AX,[EBP-48]
       SAHF
       JNE !!!_Rep1                ;Until Zero
!!!zzz:
       db 0ddh,0c0h             ;FFREE ST
       CMP CX,0
       JE !!!_nk1
       MOVZX ECX,CX

       CMP CX,9
       JAE !!!llo1
       ;there must be inserted zeros after the point
       PUSH ECX
       MOV EBX,9
       SUB EBX,ECX
       MOV ECX,EBX
       CLD
!!!llo1_1:
       MOV AX,48   ;'0'
       STOSB
       LOOP !!!llo1_1
       POP ECX
!!!llo1:
       POP AX
       STOSB
       LOOP !!!llo1
!!!_nk1:
       POP EDX                  ;original EDI
       MOV EBX,EDI
       DEC EBX
       SUB EBX,EDX
       MOV AL,0
       STOSB                   ;Abschluß PChar
       MOV EDI,EDX
       MOV AL,BL
       STOSB

       LEAVE
       RETN32
!ValReal ENDP

!Real2Str PROC NEAR32
        PUSH EBP
        MOV EBP,ESP

        MOV EDI,[EBP+12]
        FLDD [EDI+0]   ;Load real value
        MOV EDI,[EBP+8]
        MOV AX,0ffffh                ;alle Nachkommastellen
        CALLN32 !ValReal

        LEAVE
        RETN32 8
!Real2Str ENDP

!Double2Str PROC NEAR32
        PUSH EBP
        MOV EBP,ESP

        MOV EDI,[EBP+12]
        FLDQ [EDI+0]   ;Load double value
        MOV EDI,[EBP+8]
        MOV AX,0ffffh                ;alle Nachkommastellen
        CALLN32 !ValReal

        LEAVE
        RETN32 8
!Double2Str ENDP

!Extended2Str PROC NEAR32
        PUSH EBP
        MOV EBP,ESP

        MOV EDI,[EBP+12]
        FLDT [EDI+0]    ;Load extended value
        MOV EDI,[EBP+8]
        MOV AX,0ffffh                ;alle Nachkommastellen
        CALLN32 !ValReal

        LEAVE
        RETN32 8
!Extended2Str ENDP

!WriteExtended PROC NEAR32   ;Writes extended in ST
          PUSH EBP
          MOV EBP,ESP
          SUB ESP,260
          FSTPT [EBP-260]

          LEA EAX,[EBP-260]
          PUSH EAX
          LEA EAX,[EBP-250]
          PUSH EAX
          CALLN32 !Extended2Str

          LEA EAX,[EBP-250]
          PUSH EAX
          PUSH [EBP+8]       ;Format value
          CALLN32 !WriteStr

          LEAVE
          RETN32 2
!WriteExtended ENDP

!FPULoadLong PROC NEAR32
            PUSH EBP
            MOV EBP,ESP
            FILDD [EBP+8]
            LEAVE
            RETN32 4
!FPULoadLong ENDP


!Sin PROC NEAR32   ;calculate SIN in ST(0)
    CALLN32 !RadArc
    db d9h,feh  ;FSIN
    RETN32
!Sin ENDP

!Cos PROC NEAR32   ;calculate COS in ST(0)
    CALLN32 !RadArc
    db d9h,ffh  ;FCOS
    RETN32
!Cos ENDP

!Tan PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,12
       MOVW _FPUResult,0
       FSTPT [EBP-10]
       FLDT [EBP-10]
       CALLN32 !Sin
       FLDT [EBP-10]
       CALLN32 !Cos
       DB d9h,e4h    ;FTST
       FSTSW [EBP-12]
       FWAIT
       MOV AH,[EBP-11]
       SAHF
       JNE !!!_l50
       db 0ddh,0d8h          ;FSTP ST(0)
       db 0ddh,0d8h          ;FSTP ST(0)
       DB d9h,eeh            ;FLDZ
       MOVW _FPUResult,2
       JMP !!!_l51
!!!_l50:
       DB deh,f9h   ;FDIVP ST(1),ST
!!!_l51:
       LEAVE
       RETN32
!Tan ENDP

!Cot PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,12
       MOVW _FPUResult,0
       FSTPT [EBP-10]
       FLDT [EBP-10]
       CALLN32 !Cos
       FLDT [EBP-10]
       CALLN32 !Sin
       DB d9h,e4h    ;FTST
       FSTSW [EBP-12]
       FWAIT
       MOV AH,[EBP-11]
       SAHF
       JNE !!!_l53
       db 0ddh,0d8h          ;FSTP ST(0)
       db 0ddh,0d8h          ;FSTP ST(0)
       DB d9h,eeh            ;FLDZ
       MOVW _FPUResult,2
       JMP !!!_l54
!!!_l53:
       DB deh,f9h   ;FDIVP ST(1),ST
!!!_l54:
       LEAVE
       RETN32
!Cot ENDP

!ArcTan PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,2
       MOVW _FPUResult,0
       DB d9h,e5h  ;FXAM     ;Type of ST(0)
       FWAIT
       FSTSW [EBP-2]
       MOV AH,[EBP-1]
       SAHF
       XCHG CX,AX
       JB !!!_l30
       JNE !!!_l31
       JMP !!!_l32
!!!_l30:
       JE !!!_l32
       JNP !!!_l32
       db 0ddh,0d8h          ;FSTP ST(0)
       FLDT !fl3
       JMP !!!_l33
!!!_l31:
       DB d9h,e1h   ;FABS
       DB d9h,e8h   ;FLD1
       DB d8h,d1h   ;FCOM ST(1)
       FWAIT
       FSTSW [EBP-2]
       MOV AH,[EBP-1]
       SAHF
       JNE !!!_l34
       DB deh,d9h   ;FCOMPP ST(1)
       FLDT !fl2
       JMP !!!_l33
!!!_l34:
       JNB !!!_l35
       DB d9h,c9h   ;FXCH ST(1)
!!!_l35:
       DB d9h,f3h   ;FPATAN
       JNB !!!_l33
       FLDT !fl3
       DB deh,e9h   ;FSUBP ST(1),ST
       XOR CH,2
!!!_l33:
       TEST CH,2
       JE !!!_l32
       DB d9h,e0h   ;FCHS
       FWAIT
!!!_l32:
       CALLN32 !NormRad
       LEAVE
       RETN32
!ArcTan ENDP

!Sqrt PROC NEAR32
       DB d9h,fah   ;FSQRT
       RETN32
!Sqrt ENDP

!ln PROC NEAR32
      PUSH EBP
      MOV EBP,ESP
      SUB ESP,10
      MOVW _FPUResult,0
      DB d9h,edh   ;FLDLN2
      DB d9h,c9h   ;FXCH ST(1)
      DB d9h,e5h   ;FXAM
      FWAIT
      FSTSW [EBP-10]
      MOV AH,[EBP-9]
      SAHF
      JB !!!_l20
      JE !!!_l21
      TEST AH,2
      JE !!!_l22
!!!_l21:
      db 0ddh,0d8h          ;FSTP ST(0)
      JMP !!!_l23
!!!_l20:
      db 0ddh,0d8h          ;FSTP ST(0)
      JE !!!_l24
      JNP !!!_l24
!!!_l23:
      db 0ddh,0d8h          ;FSTP ST(0)
      FLDD !fl1
!!!_l24:
      DB d9h,e4h   ;FTST
      JMP !!!_l29
!!!_l22:
      DB d9h,c0h   ;FLD ST(0)
      FSTPT [EBP-10]
      CMPW [EBP-2],3fffh
      JNE !!!_l25
      CMPW [EBP-4],8000h
      JNE !!!_l25
      DB d9h,e8h    ;FLD1
      DB deh,e9h    ;FSUBP ST(1),ST
      DB d9h,f9h    ;FYL2XP1
      JMP !!!_l29
!!!_l25:
      DB d9h,f1h    ;FYL2X
!!!_l29:
      LEAVE
      RETN32
!ln ENDP

!Exp PROC NEAR32
      PUSH EBP
      MOV EBP,ESP
      SUB ESP,16
      MOVW _FPUResult,0
      DB d9h,eah   ;FLD2E
      DB d9h,c9h   ;FXCH ST(1)
      DB d9h,e5h   ;FXAM
      FWAIT
      FSTSW [EBP-6]
      DB d9h,c9h   ;FXCH ST(1)
      MOV AH,[EBP-5]
      SAHF
      XCHG BX,AX
      JB !!!_l40
      JNE !!!_l41
      db 0ddh,0d8h          ;FSTP ST(0)
      db 0ddh,0d8h          ;FSTP ST(0)
      DB d9h,e8h     ;FLD1
      JMP !!!_l43
!!!_l40:
      db 0ddh,0d8h          ;FSTP ST(0)
      JE !!!_l44
      JNP !!!_l44
!!!_l48:
      db 0ddh,0d8h          ;FSTP ST(0)
      FLDD !fl4
!!!_l44:
      DB d9h,e4h    ;FTST
      JMP !!!_l43
!!!_l41:
      DB deh,c9h    ;FMULP ST(1),ST
      DB d9h,e1h    ;FABS
      FLDD !fl5
      DB d9h,c9h   ;FXCH ST(1)
      FSTPT [EBP-16]
      FLDT [EBP-16]
      DB deh,d9h    ;FCOMPP ST(1)
      FWAIT
      FSTSW [EBP-6]
      FLDT [EBP-16]
      TESTB [EBP-5],41h
      JE !!!_l46
      DB d9h,f0h    ;F2XM1
      DB d9h,e8h    ;FLD1
      DB deh,c1h    ;FADDP ST(1),ST
      JMP !!!_l47
!!!_l46:
      DB d9h,e8h    ;FLD1
      DB d9h,c1h    ;FLD ST(1)
      FWAIT
      FSTCW [EBP-6]
      DB d9h,fdh    ;FSCALE
      ORB [EBP-5],0fh
      FLDCW [EBP-6]
      FWAIT
      DB d9h,fch    ;FRNDINT
      ANDB [EBP-5],f3h
      FLDCW [EBP-6]
      FWAIT
      FISTD [EBP-4]
      DB d9h,c9h    ;FXCH ST(1)
      DB d9h,e0h    ;FCHS
      DB d9h,c9h    ;FXCH ST(1)
      DB d9h,fdh    ;FSCALE
      DB ddh,d9h    ;FSTP ST(1)
      DB deh,e9h    ;FSUBP ST(1),ST
      CMPW [EBP-2],0
      JG !!!_l48
      DB d9h,f0h    ;F2XM1
      DB d9h,e8h    ;FLD1
      DB deh,c1h    ;FADDP ST(1),ST
      MOV CX,[EBP-4]
      SHR CX,1
      MOV [EBP-4],CX
      JNB !!!_l49
      FLDT !fl6
      DB deh,c9h    ;FMULP ST(1),ST
!!!_l49:
      FILDW [EBP-4]
      DB d9h,c9h    ;FXCH ST(1)
      DB d9h,fdh    ;FSCALE
      DB ddh,d9h    ;FSTP ST(1)
!!!_l47:
      TEST BH,2
      JE !!!_l43
      DB d9h,e8h    ;FLD1
      DB deh,f1h    ;FDIVRP ST(1),ST
!!!_l43:
      LEAVE
      RETN32
!Exp ENDP

!Frac PROC NEAR32
      PUSH EBP
      MOV EBP,ESP
      SUB ESP,12
      FSTPT [EBP-10]
      FLDT [EBP-10]
      FLDCW !FPURound  ;Load control word
      FWAIT
      db 0d9h,0fch             ;FRNDINT
      FLDCW !FPUControl ;Load control word
      FWAIT
      FLDT [EBP-10]
      DB d9h,c9h    ;FXCH ST(1)
      DB deh,e9h    ;FSUBP ST(1),ST
      LEAVE
      RETN32
!Frac ENDP

!Int PROC NEAR32
      FLDCW !FPURound  ;Load control word
      FWAIT
      db 0d9h,0fch             ;FRNDINT
      FLDCW !FPUControl ;Load control word
      FWAIT
      RETN32
!Int ENDP

!Round PROC NEAR32
      PUSH EBP
      MOV EBP,ESP
      SUB ESP,10
      db 0d9h,0fch             ;FRNDINT
      FISTPD [EBP-10]
      MOV EAX,[EBP-10]
      LEAVE
      RETN32
!Round ENDP

!Trunc PROC NEAR32
      PUSH EBP
      MOV EBP,ESP
      SUB ESP,10
      FLDCW !FPURound  ;Load control word
      FWAIT
      db 0d9h,0fch             ;FRNDINT
      FLDCW !FPUControl ;Load control word
      FWAIT
      FISTPD [EBP-10]
      MOV EAX,[EBP-10]
      LEAVE
      RETN32
!Trunc ENDP

!Sqr PROC NEAR32
      DB d9h,c0h   ;FLD St(0)
      Db deh,c9h   ;FMULP ST(1),ST
      RETN32
!Sqr ENDP

!ArcSin PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,12
       MOVW _FPUResult,0

       DB d9h,c0h   ;FLD St(0)
       DB d9h,e1h   ;FABS
       DB d9h,e8h   ;FLD1
       DB deh,d9h   ;FCOMPP ST(1)
       FWAIT
       FSTSW [EBP-12]
       MOV AH,[EBP-11]
       SAHF
       JB !!!_l60
       JNE !!!_l62
       ;ArcSin(1.0)=w*pi/2
       FLDT !fl7    ;1.5707...
       DB deh,c9h   ;FMULP ST(1),ST
       JMP !!!_l61
!!!_l62:
       DB d9h,c0h   ;FLD St(0)
       FSTPT [EBP-10]
       DB d9h,c0h   ;FLD St(0)
       Db deh,c9h   ;FMULP ST(1),ST
       DB d9h,e8h   ;FLD1
       DB deh,e1h   ;FSUBP ST(1),ST
       DB d9h,fah   ;FSQRT
       FLDT [EBP-10]
       DB d9h,c9h    ;FXCH ST(1)
       DB deh,f9h   ;FDIVP ST(1),ST
       CALLN32 !ArcTan
       JMP !!!_l61
!!!_l60:
       MOVW _FPUResult,3
!!!_l61:
       CALLN32 !NormRad
       LEAVE
       RETN32
!ArcSin ENDP

!ArcCos PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !ArcSin
       FLDT !fl7   ;PI/2
       DB d9h,c9h    ;FXCH ST(1)
       DB deh,e9h  ;FSUBP ST(1),ST
       CALLN32 !NormRad
       RETN32
!ArcCos ENDP

!ArcCot PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !ArcTan
       FLDT !fl7   ;PI/2
       DB d9h,c9h    ;FXCH ST(1)
       DB deh,e9h  ;FSUBP ST(1),ST
       CALLN32 !NormRad
       RETN32
!ArcCot ENDP

!Sinh PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !Exp
       DB d9h,c0h   ;FLD St(0)
       DB d9h,e8h   ;FLD1
       DB d9h,c9h   ;FXCH ST(1)
       DB deh,f9h   ;FDIVP ST(1),ST
       DB d9h,c9h   ;FXCH ST(1)
       DB deh,e1h   ;FSUBP ST(1),ST
       FLDT !fl8
       DB deh,c9h   ;FMULP ST(1),ST
       RETN32
!Sinh ENDP

!Cosh PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !Exp
       DB d9h,c0h   ;FLD St(0)
       DB d9h,e8h   ;FLD1
       DB d9h,c9h   ;FXCH ST(1)
       DB deh,f9h   ;FDIVP ST(1),ST
       DB deh,c1h   ;FADDP ST(1),ST
       FLDT !fl8
       DB deh,c9h   ;FMULP ST(1),ST
       RETN32
!Cosh ENDP

!Tanh PROC NEAR32
       MOVW _FPUResult,0
       FLDT !fl9   ;2.0
       DB deh,c9h  ;FMULP ST(1),ST
       CALLN32 !Exp
       DB d9h,e8h  ;FLD1
       DB deh,c1h  ;FADDP ST(1),ST
       FLDT !fl9   ;2.0
       DB d9h,c9h   ;FXCH ST(1)
       DB deh,f9h   ;FDIVP ST(1),ST
       DB d9h,e8h  ;FLD1
       DB deh,e1h   ;FSUBP ST(1),ST
       RETN32
!Tanh ENDP

!Coth PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,12
       MOVW _FPUResult,0
       DB d9h,c0h   ;FLD St(0)
       FSTPT [EBP-10]
       CALLN32 !Sinh
       DB d9h,e4h   ;FTST
       FWAIT
       FSTSW [EBP-12]
       MOV AH,[EBP-11]
       SAHF
       JE !!!_l70
       FLDT [EBP-10]
       CALLN32 !Cosh
       DB d9h,c9h   ;FXCH ST(1)
       DB deh,f9h   ;FDIVP ST(1),ST
       JMP !!!_l71
!!!_l70:
       MOVW _FPUResult,4
!!!_l71:
       LEAVE
       RETN32
!Coth ENDP

!lg PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !ln
       FLDT !fl10
       DB deh,f9h   ;FDIVP ST(1),ST
       RETN32
!lg ENDP

!lb PROC NEAR32
       MOVW _FPUResult,0
       CALLN32 !ln
       FLDT !fl11
       DB deh,f9h   ;FDIVP ST(1),ST
       RETN32
!lb ENDP

!ReadReal PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,262
       LEA EAX,[EBP-260]
       PUSH EAX
       CALLN32 !ReadStr
       LEA EAX,[EBP-260]
       PUSH EAX
       PUSHL [EBP+8]
       LEA EAX,[EBP-262]
       PUSH EAX
       CALLN32 !Str2Real
       LEAVE
       RETN32 4
!ReadReal ENDP

!ReadDouble PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,262
       LEA EAX,[EBP-260]
       PUSH EAX
       CALLN32 !ReadStr
       LEA EAX,[EBP-260]
       PUSH EAX
       PUSHL [EBP+8]
       LEA EAX,[EBP-262]
       PUSH EAX
       CALLN32 !Str2Double
       LEAVE
       RETN32 4
!ReadDouble ENDP

!ReadExtended PROC NEAR32
       PUSH EBP
       MOV EBP,ESP
       SUB ESP,262
       LEA EAX,[EBP-260]
       PUSH EAX
       CALLN32 !ReadStr
       LEA EAX,[EBP-260]
       PUSH EAX
       PUSHL [EBP+8]
       LEA EAX,[EBP-262]
       PUSH EAX
       CALLN32 !Str2Extended
       LEAVE
       RETN32 4
!ReadExtended ENDP

END;



BEGIN
END.

ASSEMBLER
!TempChar db 0     ;Uses for !CharOut
!TempWord dw 0,0   ;Used temporary
!TempRet  dw 0,0   ;Used for Output via DosWrite as return value
!TempCR   db 13,10 ;Used by !WritelnEnd
!ErrorMsg db 'Speed-386 Runtime error     at:XXXXXXXXXXXXX',0 ;Error Message
!TempString   db 0,ds 255,0   ; for temporary string operations
!TempString1  db 0,ds 255,0   ; for temporary string operations
!TempString2  db 0,ds 255,0   ;  ''   ''            ''
!TempString3  db 0,ds 255,0   ;  ''   ''            ''
!RandSeed dw 0,0              ;Temp for Random
!Factor dw 8405h              ; konstanter Faktor for Random

!FPUControl DW 133fh
!FPURound DW 1f3fh
!C10 db 10,0,0,0
!DivTab db 1,0,0,0
       db 10,0,0,0
       db 100,0,0,0
       db 0e8h,3,0,0
       db 10h,27h,0,0
       db 0a0h,86h,1,0
       db 40h,42h,0fh,0
       db 80h,96h,98h,0
       db 0,0e1h,0f5h,5
       db 0,0cah,9ah,3bh  ;1E+9
!Power10Tab db 0,0,0,0,0,20h,0bch,0beh,19h,40h                ;1.0E+8
           db 0,0,0,4,0bfh,0c9h,1bh,8eh,34h,40h              ;1.0E+16
           db 9eh,0b5h,70h,2bh,0a8h,0adh,0c5h,9dh,69h,40h    ;1.0E+32
           db 0d5h,0a6h,0cfh,0ffh,49h,1fh,78h,0c2h,0d3h,40h  ;1.0E+64
           db 0e0h,8ch,0e9h,80h,0c9h,47h,0bah,93h,0a8h,41h   ;1.0E+128
           db 8eh,0deh,0f9h,9dh,0fbh,0ebh,7eh,0aah,51h,43h   ;1.0E+256
           db 0c7h,91h,0eh,0a6h,0aeh,0a0h,19h,0e3h,0a3h,46h  ;1.0E+512
           db 17h,0ch,75h,81h,86h,75h,76h,0c9h,48h,4dh       ;1.0E+1024
           db 0e5h,5dh,3dh,0c5h,5dh,3bh,8bh,9eh,92h,5ah      ;1.0E+2048
           db 9bh,97h,20h,8ah,2,52h,60h,0c4h,25h,75h         ;1.0E+4096
!Exponent dw 0
!FCompp dw 0  ;Flags nach FCompp
!fl1 db 0,42h,c0h,ffh
!fl2 db 35h,c2h,68h,21h,a2h,dah,0fh,c9h,feh,3fh  ;0.7853...
!fl3 db 35h,c2h,68h,21h,a2h,dah,0fh,c9h,ffh,3fh
!fl4 db 0,4ah,c0h,ffh
!fl5 db 0,0,0,3fh
!fl6 db 85h,64h,deh,f9h,33h,f3h,4,b5h,ffh,3fh
!fl7 db 48h,7eh,2ah,92h,a2h,dah,0fh,c9h,ffh,3fh  ;PI/2
!fl8 db 0,0,0,0,0,0,0,80h,feh,3fh                ;0.5
!fl9 db 0,0,0,0,0,0,0,80h,0,40h                  ;2.0
!fl10 db 83h,abh,4bh,ach,ddh,8dh,5dh,93h,0,40h   ;ln(10)
!fl11 db 7eh,c0h,68h,77h,0dh,18h,72h,b1h,feh,3fh ;ln(2)

END; {ASSEMBLER}