update
git-svn-id: svn://kolibrios.org@7693 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
parent
885116b9fb
commit
c4dee82cbc
Binary file not shown.
@ -17,6 +17,7 @@ UTF-8
|
||||
"kos" - KolibriOS
|
||||
"obj" - KolibriOS DLL
|
||||
"elfexe" - Linux ELF-EXEC
|
||||
"elfso" - Linux ELF-SO
|
||||
4) необязательные параметры-ключи
|
||||
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб)
|
||||
-base <address> адрес загрузки исполняемого файла в килобайтах
|
||||
@ -144,10 +145,10 @@ UTF-8
|
||||
до 32 бит, для записи байтов использовать SYSTEM.PUT8,
|
||||
для WCHAR -- SYSTEM.PUT16
|
||||
|
||||
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
|
||||
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
|
||||
Память[a] := младшие 8 бит (x)
|
||||
|
||||
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
|
||||
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
|
||||
Память[a] := младшие 16 бит (x)
|
||||
|
||||
PROCEDURE MOVE(Source, Dest, n: INTEGER)
|
||||
@ -358,8 +359,8 @@ Oberon-
|
||||
Все программы неявно используют модуль RTL. Компилятор транслирует
|
||||
некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
|
||||
ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
|
||||
следует явно вызывать эти процедуры, за исключением процедуры SetDll,
|
||||
если приложение компилируется как Windows DLL:
|
||||
следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini
|
||||
если приложение компилируется как Windows DLL или Linux SO, соответственно:
|
||||
|
||||
PROCEDURE SetDll
|
||||
(process_detach, thread_detach, thread_attach: DLL_ENTRY);
|
||||
@ -372,8 +373,15 @@ SetDll
|
||||
- создании нового потока (thread_attach)
|
||||
- уничтожении потока (thread_detach)
|
||||
|
||||
Для прочих типов приложений, вызов процедуры SetDll не влияет на
|
||||
|
||||
PROCEDURE SetFini (ProcFini: PROC);
|
||||
где TYPE PROC = PROCEDURE (* без параметров *)
|
||||
|
||||
SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки.
|
||||
|
||||
Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на
|
||||
поведение программы.
|
||||
|
||||
Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
|
||||
(Windows), в терминал (Linux), на доску отладки (KolibriOS).
|
||||
|
||||
@ -395,6 +403,4 @@ SetDll
|
||||
PROCEDURE [stdcall] lib_init (): INTEGER
|
||||
|
||||
Эта процедура должна быть вызвана перед использованием DLL.
|
||||
Процедура всегда возвращает 1.
|
||||
|
||||
Для Linux, генерация динамических библиотек не реализована.
|
||||
Процедура всегда возвращает 1.
|
@ -17,6 +17,7 @@ UTF-8
|
||||
"kos" - KolibriOS
|
||||
"obj" - KolibriOS DLL
|
||||
"elfexe" - Linux ELF-EXEC
|
||||
"elfso" - Linux ELF-SO
|
||||
4) ¥®¡ï§ ⥫ìë¥ ¯ à ¬¥âàë-ª«îç¨
|
||||
-stk <size> à §¬¥à áâíª ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ¨î 2 Œ¡)
|
||||
-base <address> ¤à¥á § £à㧪¨ ¨á¯®«ï¥¬®£® ä ©« ¢ ª¨«®¡ ©â å
|
||||
@ -144,10 +145,10 @@ UTF-8
|
||||
¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8,
|
||||
¤«ï WCHAR -- SYSTEM.PUT16
|
||||
|
||||
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
|
||||
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
|
||||
<20> ¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x)
|
||||
|
||||
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
|
||||
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
|
||||
<20> ¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x)
|
||||
|
||||
PROCEDURE MOVE(Source, Dest, n: INTEGER)
|
||||
@ -358,8 +359,8 @@ Oberon-ॠ
|
||||
‚ᥠ¯à®£à ¬¬ë ¥ï¢® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à âà ᫨àã¥â
|
||||
¥ª®â®àë¥ ®¯¥à 樨 (¯à®¢¥àª ¨ ®åà ⨯ , áà ¢¥¨¥ áâப, á®®¡é¥¨ï ®¡
|
||||
®è¨¡ª å ¢à¥¬¥¨ ¢ë¯®«¥¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. <20>¥
|
||||
á«¥¤ã¥â  ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, § ¨áª«î票¥¬ ¯à®æ¥¤ãàë SetDll,
|
||||
¥á«¨ ¯à¨«®¦¥¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL:
|
||||
á«¥¤ã¥â  ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, § ¨áª«î票¥¬ ¯à®æ¥¤ãà SetDll ¨ SetFini
|
||||
¥á«¨ ¯à¨«®¦¥¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL ¨«¨ Linux SO, ᮮ⢥âá⢥®:
|
||||
|
||||
PROCEDURE SetDll
|
||||
(process_detach, thread_detach, thread_attach: DLL_ENTRY);
|
||||
@ -372,8 +373,15 @@ SetDll
|
||||
- ᮧ¤ ¨¨ ®¢®£® ¯®â®ª (thread_attach)
|
||||
- ã¨ç⮦¥¨¨ ¯®â®ª (thread_detach)
|
||||
|
||||
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥¨©, ¢ë§®¢ ¯à®æ¥¤ãàë SetDll ¥ ¢«¨ï¥â
|
||||
|
||||
PROCEDURE SetFini (ProcFini: PROC);
|
||||
£¤¥ TYPE PROC = PROCEDURE (* ¡¥§ ¯ à ¬¥â஢ *)
|
||||
|
||||
SetFini § ç ¥â ¯à®æ¥¤ãàã ProcFini ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ so-¡¨¡«¨®â¥ª¨.
|
||||
|
||||
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥¨©, ¢ë§®¢ ¯à®æ¥¤ãà SetDll ¨ SetFini ¥ ¢«¨ï¥â
|
||||
¯®¢¥¤¥¨¥ ¯à®£à ¬¬ë.
|
||||
|
||||
‘®®¡é¥¨ï ®¡ ®è¨¡ª å ¢à¥¬¥¨ ¢ë¯®«¥¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª å
|
||||
(Windows), ¢ â¥à¬¨ « (Linux), ¤®áªã ®â« ¤ª¨ (KolibriOS).
|
||||
|
||||
@ -395,6 +403,4 @@ SetDll
|
||||
PROCEDURE [stdcall] lib_init (): INTEGER
|
||||
|
||||
<EFBFBD>â ¯à®æ¥¤ãà ¤®«¦ ¡ëâì ¢ë§¢ ¯¥à¥¤ ¨á¯®«ì§®¢ ¨¥¬ DLL.
|
||||
<EFBFBD>à®æ¥¤ãà ¢á¥£¤ ¢®§¢à é ¥â 1.
|
||||
|
||||
„«ï Linux, £¥¥à æ¨ï ¤¨ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª ¥ ॠ«¨§®¢ .
|
||||
<EFBFBD>à®æ¥¤ãà ¢á¥£¤ ¢®§¢à é ¥â 1.
|
@ -98,8 +98,8 @@ MODULE Math -
|
||||
|
||||
CONST
|
||||
|
||||
pi = 3.141592653589793D+00
|
||||
e = 2.718281828459045D+00
|
||||
pi = 3.141592653589793E+00
|
||||
e = 2.718281828459045E+00
|
||||
|
||||
|
||||
PROCEDURE IsNan(x: REAL): BOOLEAN
|
||||
@ -153,13 +153,13 @@ MODULE Math -
|
||||
PROCEDURE tanh(x: REAL): REAL
|
||||
ãèïåðáîëè÷åñêèé òàíãåíñ x
|
||||
|
||||
PROCEDURE arcsinh(x: REAL): REAL
|
||||
PROCEDURE arsinh(x: REAL): REAL
|
||||
îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x
|
||||
|
||||
PROCEDURE arccosh(x: REAL): REAL
|
||||
PROCEDURE arcosh(x: REAL): REAL
|
||||
îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x
|
||||
|
||||
PROCEDURE arctanh(x: REAL): REAL
|
||||
PROCEDURE artanh(x: REAL): REAL
|
||||
îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x
|
||||
|
||||
PROCEDURE round(x: REAL): REAL
|
||||
@ -181,6 +181,9 @@ MODULE Math -
|
||||
åñëè x < 0 âîçâðàùàåò -1
|
||||
åñëè x = 0 âîçâðàùàåò 0
|
||||
|
||||
PROCEDURE fact(n: INTEGER): REAL
|
||||
ôàêòîðèàë n
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Debug - âûâîä íà äîñêó îòëàäêè
|
||||
Èíòåðôåéñ êàê ìîäóëü Out
|
||||
@ -337,7 +340,7 @@ MODULE DateTime -
|
||||
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
|
||||
âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ
|
||||
Year, Month, Day, Hour, Min, Sec;
|
||||
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5
|
||||
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5
|
||||
|
||||
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
|
||||
Hour, Min, Sec: INTEGER): BOOLEAN
|
||||
|
@ -1,94 +1,94 @@
|
||||
==============================================================================
|
||||
|
||||
<EFBFBD>¨¡«¨®â¥ª (KolibriOS)
|
||||
<EFBFBD>¨¡«¨®â¥ª (KolibriOS)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Out - ª®á®«ìë© ¢ë¢®¤
|
||||
|
||||
PROCEDURE Open
|
||||
ä®à¬ «ì® ®âªàë¢ ¥â ª®á®«ìë© ¢ë¢®¤
|
||||
PROCEDURE Open
|
||||
ä®à¬ «ì® ®âªàë¢ ¥â ª®á®«ìë© ¢ë¢®¤
|
||||
|
||||
PROCEDURE Int(x, width: INTEGER)
|
||||
¢ë¢®¤ 楫®£® ç¨á« x;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤
|
||||
PROCEDURE Int(x, width: INTEGER)
|
||||
¢ë¢®¤ 楫®£® ç¨á« x;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤
|
||||
|
||||
PROCEDURE Real(x: REAL; width: INTEGER)
|
||||
¢ë¢®¤ ¢¥é¥á⢥®£® ç¨á« x ¢ ¯« ¢ î饬 ä®à¬ â¥;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤
|
||||
PROCEDURE Real(x: REAL; width: INTEGER)
|
||||
¢ë¢®¤ ¢¥é¥á⢥®£® ç¨á« x ¢ ¯« ¢ î饬 ä®à¬ â¥;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤
|
||||
|
||||
PROCEDURE Char(x: CHAR)
|
||||
¢ë¢®¤ ᨬ¢®« x
|
||||
PROCEDURE Char(x: CHAR)
|
||||
¢ë¢®¤ ᨬ¢®« x
|
||||
|
||||
PROCEDURE FixReal(x: REAL; width, p: INTEGER)
|
||||
¢ë¢®¤ ¢¥é¥á⢥®£® ç¨á« x ¢ 䨪á¨à®¢ ®¬ ä®à¬ â¥;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ ;
|
||||
p - ª®«¨ç¥á⢮ § ª®¢ ¯®á«¥ ¤¥áïâ¨ç®© â®çª¨
|
||||
PROCEDURE FixReal(x: REAL; width, p: INTEGER)
|
||||
¢ë¢®¤ ¢¥é¥á⢥®£® ç¨á« x ¢ 䨪á¨à®¢ ®¬ ä®à¬ â¥;
|
||||
width - ª®«¨ç¥á⢮ § ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ ;
|
||||
p - ª®«¨ç¥á⢮ § ª®¢ ¯®á«¥ ¤¥áïâ¨ç®© â®çª¨
|
||||
|
||||
PROCEDURE Ln
|
||||
¯¥à¥å®¤ á«¥¤ãîéãî áâபã
|
||||
PROCEDURE Ln
|
||||
¯¥à¥å®¤ á«¥¤ãîéãî áâபã
|
||||
|
||||
PROCEDURE String(s: ARRAY OF CHAR)
|
||||
¢ë¢®¤ áâப¨ s
|
||||
PROCEDURE String(s: ARRAY OF CHAR)
|
||||
¢ë¢®¤ áâப¨ s
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE In - ª®á®«ìë© ¢¢®¤
|
||||
|
||||
VAR Done: BOOLEAN
|
||||
¯à¨¨¬ ¥â § 票¥ TRUE ¢ á«ãç ¥ ãᯥ讣® ¢ë¯®«¥¨ï
|
||||
®¯¥à 樨 ¢¢®¤ , ¨ ç¥ FALSE
|
||||
VAR Done: BOOLEAN
|
||||
¯à¨¨¬ ¥â § 票¥ TRUE ¢ á«ãç ¥ ãᯥ讣® ¢ë¯®«¥¨ï
|
||||
®¯¥à 樨 ¢¢®¤ , ¨ ç¥ FALSE
|
||||
|
||||
PROCEDURE Open
|
||||
ä®à¬ «ì® ®âªàë¢ ¥â ª®á®«ìë© ¢¢®¤,
|
||||
â ª¦¥ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥®© Done § 票¥ TRUE
|
||||
PROCEDURE Open
|
||||
ä®à¬ «ì® ®âªàë¢ ¥â ª®á®«ìë© ¢¢®¤,
|
||||
â ª¦¥ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥®© Done § 票¥ TRUE
|
||||
|
||||
PROCEDURE Int(VAR x: INTEGER)
|
||||
¢¢®¤ ç¨á« ⨯ INTEGER
|
||||
PROCEDURE Int(VAR x: INTEGER)
|
||||
¢¢®¤ ç¨á« ⨯ INTEGER
|
||||
|
||||
PROCEDURE Char(VAR x: CHAR)
|
||||
¢¢®¤ ᨬ¢®«
|
||||
PROCEDURE Char(VAR x: CHAR)
|
||||
¢¢®¤ ᨬ¢®«
|
||||
|
||||
PROCEDURE Real(VAR x: REAL)
|
||||
¢¢®¤ ç¨á« ⨯ REAL
|
||||
PROCEDURE Real(VAR x: REAL)
|
||||
¢¢®¤ ç¨á« ⨯ REAL
|
||||
|
||||
PROCEDURE String(VAR s: ARRAY OF CHAR)
|
||||
¢¢®¤ áâப¨
|
||||
PROCEDURE String(VAR s: ARRAY OF CHAR)
|
||||
¢¢®¤ áâப¨
|
||||
|
||||
PROCEDURE Ln
|
||||
®¦¨¤ ¨¥ ¦ â¨ï ENTER
|
||||
PROCEDURE Ln
|
||||
®¦¨¤ ¨¥ ¦ â¨ï ENTER
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Console - ¤®¯®«¨â¥«ìë¥ ¯à®æ¥¤ãàë ª®á®«ì®£® ¢ë¢®¤
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
‘«¥¤ãî騥 ª®áâ âë ®¯à¥¤¥«ïîâ 梥⠪®á®«ì®£® ¢ë¢®¤
|
||||
‘«¥¤ãî騥 ª®áâ âë ®¯à¥¤¥«ïîâ 梥⠪®á®«ì®£® ¢ë¢®¤
|
||||
|
||||
Black = 0 Blue = 1 Green = 2
|
||||
Cyan = 3 Red = 4 Magenta = 5
|
||||
Brown = 6 LightGray = 7 DarkGray = 8
|
||||
LightBlue = 9 LightGreen = 10 LightCyan = 11
|
||||
LightRed = 12 LightMagenta = 13 Yellow = 14
|
||||
White = 15
|
||||
Black = 0 Blue = 1 Green = 2
|
||||
Cyan = 3 Red = 4 Magenta = 5
|
||||
Brown = 6 LightGray = 7 DarkGray = 8
|
||||
LightBlue = 9 LightGreen = 10 LightCyan = 11
|
||||
LightRed = 12 LightMagenta = 13 Yellow = 14
|
||||
White = 15
|
||||
|
||||
PROCEDURE Cls
|
||||
®ç¨á⪠®ª ª®á®«¨
|
||||
PROCEDURE Cls
|
||||
®ç¨á⪠®ª ª®á®«¨
|
||||
|
||||
PROCEDURE SetColor(FColor, BColor: INTEGER)
|
||||
ãáâ ®¢ª 梥⠪®á®«ì®£® ¢ë¢®¤ : FColor - 梥â ⥪áâ ,
|
||||
BColor - 梥â ä® , ¢®§¬®¦ë¥ § 票ï - ¢ë襯¥à¥ç¨á«¥ë¥
|
||||
ª®áâ âë
|
||||
PROCEDURE SetColor(FColor, BColor: INTEGER)
|
||||
ãáâ ®¢ª 梥⠪®á®«ì®£® ¢ë¢®¤ : FColor - 梥â ⥪áâ ,
|
||||
BColor - 梥â ä® , ¢®§¬®¦ë¥ § 票ï - ¢ë襯¥à¥ç¨á«¥ë¥
|
||||
ª®áâ âë
|
||||
|
||||
PROCEDURE SetCursor(x, y: INTEGER)
|
||||
ãáâ ®¢ª ªãàá®à ª®á®«¨ ¢ ¯®§¨æ¨î (x, y)
|
||||
PROCEDURE SetCursor(x, y: INTEGER)
|
||||
ãáâ ®¢ª ªãàá®à ª®á®«¨ ¢ ¯®§¨æ¨î (x, y)
|
||||
|
||||
PROCEDURE GetCursor(VAR x, y: INTEGER)
|
||||
§ ¯¨áë¢ ¥â ¢ ¯ à ¬¥âàë ⥪ã騥 ª®®à¤¨ âë ªãàá®à ª®á®«¨
|
||||
PROCEDURE GetCursor(VAR x, y: INTEGER)
|
||||
§ ¯¨áë¢ ¥â ¢ ¯ à ¬¥âàë ⥪ã騥 ª®®à¤¨ âë ªãàá®à ª®á®«¨
|
||||
|
||||
PROCEDURE GetCursorX(): INTEGER
|
||||
¢®§¢à é ¥â ⥪ãéãî x-ª®®à¤¨ âã ªãàá®à ª®á®«¨
|
||||
PROCEDURE GetCursorX(): INTEGER
|
||||
¢®§¢à é ¥â ⥪ãéãî x-ª®®à¤¨ âã ªãàá®à ª®á®«¨
|
||||
|
||||
PROCEDURE GetCursorY(): INTEGER
|
||||
¢®§¢à é ¥â ⥪ãéãî y-ª®®à¤¨ âã ªãàá®à ª®á®«¨
|
||||
PROCEDURE GetCursorY(): INTEGER
|
||||
¢®§¢à é ¥â ⥪ãéãî y-ª®®à¤¨ âã ªãàá®à ª®á®«¨
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE ConsoleLib - ®¡¥à⪠¡¨¡«¨®â¥ª¨ console.obj
|
||||
@ -96,466 +96,469 @@ MODULE ConsoleLib -
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Math - ¬ ⥬ â¨ç¥áª¨¥ äãªæ¨¨
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
pi = 3.141592653589793D+00
|
||||
e = 2.718281828459045D+00
|
||||
pi = 3.141592653589793E+00
|
||||
e = 2.718281828459045E+00
|
||||
|
||||
|
||||
PROCEDURE IsNan(x: REAL): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ x - ¥ ç¨á«®
|
||||
PROCEDURE IsNan(x: REAL): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ x - ¥ ç¨á«®
|
||||
|
||||
PROCEDURE IsInf(x: REAL): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ x - ¡¥áª®¥ç®áâì
|
||||
PROCEDURE IsInf(x: REAL): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ x - ¡¥áª®¥ç®áâì
|
||||
|
||||
PROCEDURE sqrt(x: REAL): REAL
|
||||
ª¢ ¤à âë© ª®à¥ì x
|
||||
PROCEDURE sqrt(x: REAL): REAL
|
||||
ª¢ ¤à âë© ª®à¥ì x
|
||||
|
||||
PROCEDURE exp(x: REAL): REAL
|
||||
íªá¯®¥â x
|
||||
PROCEDURE exp(x: REAL): REAL
|
||||
íªá¯®¥â x
|
||||
|
||||
PROCEDURE ln(x: REAL): REAL
|
||||
âãà «ìë© «®£ à¨ä¬ x
|
||||
PROCEDURE ln(x: REAL): REAL
|
||||
âãà «ìë© «®£ à¨ä¬ x
|
||||
|
||||
PROCEDURE sin(x: REAL): REAL
|
||||
á¨ãá x
|
||||
PROCEDURE sin(x: REAL): REAL
|
||||
á¨ãá x
|
||||
|
||||
PROCEDURE cos(x: REAL): REAL
|
||||
ª®á¨ãá x
|
||||
PROCEDURE cos(x: REAL): REAL
|
||||
ª®á¨ãá x
|
||||
|
||||
PROCEDURE tan(x: REAL): REAL
|
||||
â £¥á x
|
||||
PROCEDURE tan(x: REAL): REAL
|
||||
â £¥á x
|
||||
|
||||
PROCEDURE arcsin(x: REAL): REAL
|
||||
àªá¨ãá x
|
||||
PROCEDURE arcsin(x: REAL): REAL
|
||||
àªá¨ãá x
|
||||
|
||||
PROCEDURE arccos(x: REAL): REAL
|
||||
પ®á¨ãá x
|
||||
PROCEDURE arccos(x: REAL): REAL
|
||||
પ®á¨ãá x
|
||||
|
||||
PROCEDURE arctan(x: REAL): REAL
|
||||
àªâ £¥á x
|
||||
PROCEDURE arctan(x: REAL): REAL
|
||||
àªâ £¥á x
|
||||
|
||||
PROCEDURE arctan2(y, x: REAL): REAL
|
||||
àªâ £¥á y/x
|
||||
PROCEDURE arctan2(y, x: REAL): REAL
|
||||
àªâ £¥á y/x
|
||||
|
||||
PROCEDURE power(base, exponent: REAL): REAL
|
||||
¢®§¢¥¤¥¨¥ ç¨á« base ¢ á⥯¥ì exponent
|
||||
PROCEDURE power(base, exponent: REAL): REAL
|
||||
¢®§¢¥¤¥¨¥ ç¨á« base ¢ á⥯¥ì exponent
|
||||
|
||||
PROCEDURE log(base, x: REAL): REAL
|
||||
«®£ à¨ä¬ x ¯® ®á®¢ ¨î base
|
||||
PROCEDURE log(base, x: REAL): REAL
|
||||
«®£ à¨ä¬ x ¯® ®á®¢ ¨î base
|
||||
|
||||
PROCEDURE sinh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© á¨ãá x
|
||||
PROCEDURE sinh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© á¨ãá x
|
||||
|
||||
PROCEDURE cosh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© ª®á¨ãá x
|
||||
PROCEDURE cosh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© ª®á¨ãá x
|
||||
|
||||
PROCEDURE tanh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© â £¥á x
|
||||
PROCEDURE tanh(x: REAL): REAL
|
||||
£¨¯¥à¡®«¨ç¥áª¨© â £¥á x
|
||||
|
||||
PROCEDURE arcsinh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© á¨ãá x
|
||||
PROCEDURE arsinh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© á¨ãá x
|
||||
|
||||
PROCEDURE arccosh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨ãá x
|
||||
PROCEDURE arcosh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨ãá x
|
||||
|
||||
PROCEDURE arctanh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© â £¥á x
|
||||
PROCEDURE artanh(x: REAL): REAL
|
||||
®¡à âë© £¨¯¥à¡®«¨ç¥áª¨© â £¥á x
|
||||
|
||||
PROCEDURE round(x: REAL): REAL
|
||||
®ªà㣫¥¨¥ x ¤® ¡«¨¦ ©è¥£® 楫®£®
|
||||
PROCEDURE round(x: REAL): REAL
|
||||
®ªà㣫¥¨¥ x ¤® ¡«¨¦ ©è¥£® 楫®£®
|
||||
|
||||
PROCEDURE frac(x: REAL): REAL;
|
||||
¤à®¡ ï ç áâì ç¨á« x
|
||||
PROCEDURE frac(x: REAL): REAL;
|
||||
¤à®¡ ï ç áâì ç¨á« x
|
||||
|
||||
PROCEDURE floor(x: REAL): REAL
|
||||
¨¡®«ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥¨¥ ª ª REAL),
|
||||
¥ ¡®«ìè¥ x: floor(1.2) = 1.0
|
||||
PROCEDURE floor(x: REAL): REAL
|
||||
¨¡®«ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥¨¥ ª ª REAL),
|
||||
¥ ¡®«ìè¥ x: floor(1.2) = 1.0
|
||||
|
||||
PROCEDURE ceil(x: REAL): REAL
|
||||
¨¬¥ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥¨¥ ª ª REAL),
|
||||
¥ ¬¥ìè¥ x: ceil(1.2) = 2.0
|
||||
PROCEDURE ceil(x: REAL): REAL
|
||||
¨¬¥ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥¨¥ ª ª REAL),
|
||||
¥ ¬¥ìè¥ x: ceil(1.2) = 2.0
|
||||
|
||||
PROCEDURE sgn(x: REAL): INTEGER
|
||||
¥á«¨ x > 0 ¢®§¢à é ¥â 1
|
||||
¥á«¨ x < 0 ¢®§¢à é ¥â -1
|
||||
¥á«¨ x = 0 ¢®§¢à é ¥â 0
|
||||
PROCEDURE sgn(x: REAL): INTEGER
|
||||
¥á«¨ x > 0 ¢®§¢à é ¥â 1
|
||||
¥á«¨ x < 0 ¢®§¢à é ¥â -1
|
||||
¥á«¨ x = 0 ¢®§¢à é ¥â 0
|
||||
|
||||
PROCEDURE fact(n: INTEGER): REAL
|
||||
ä ªâ®à¨ « n
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Debug - ¢ë¢®¤ ¤®áªã ®â« ¤ª¨
|
||||
ˆâ¥àä¥©á ª ª ¬®¤ã«ì Out
|
||||
ˆâ¥àä¥©á ª ª ¬®¤ã«ì Out
|
||||
|
||||
PROCEDURE Open
|
||||
®âªàë¢ ¥â ¤®áªã ®â« ¤ª¨
|
||||
PROCEDURE Open
|
||||
®âªàë¢ ¥â ¤®áªã ®â« ¤ª¨
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE File - à ¡®â á ä ©«®¢®© á¨á⥬®©
|
||||
|
||||
TYPE
|
||||
TYPE
|
||||
|
||||
FNAME = ARRAY 520 OF CHAR
|
||||
FNAME = ARRAY 520 OF CHAR
|
||||
|
||||
FS = POINTER TO rFS
|
||||
FS = POINTER TO rFS
|
||||
|
||||
rFS = RECORD (* ¨ä®à¬ 樮 ï áâàãªâãà ä ©« *)
|
||||
subfunc, pos, hpos, bytes, buffer: INTEGER;
|
||||
name: FNAME
|
||||
END
|
||||
rFS = RECORD (* ¨ä®à¬ 樮 ï áâàãªâãà ä ©« *)
|
||||
subfunc, pos, hpos, bytes, buffer: INTEGER;
|
||||
name: FNAME
|
||||
END
|
||||
|
||||
FD = POINTER TO rFD
|
||||
FD = POINTER TO rFD
|
||||
|
||||
rFD = RECORD (* áâàãªâãà ¡«®ª ¤ ëå ¢å®¤ ª â «®£ *)
|
||||
attr: INTEGER;
|
||||
ntyp: CHAR;
|
||||
reserved: ARRAY 3 OF CHAR;
|
||||
time_create, date_create,
|
||||
time_access, date_access,
|
||||
time_modif, date_modif,
|
||||
size, hsize: INTEGER;
|
||||
name: FNAME
|
||||
END
|
||||
rFD = RECORD (* áâàãªâãà ¡«®ª ¤ ëå ¢å®¤ ª â «®£ *)
|
||||
attr: INTEGER;
|
||||
ntyp: CHAR;
|
||||
reserved: ARRAY 3 OF CHAR;
|
||||
time_create, date_create,
|
||||
time_access, date_access,
|
||||
time_modif, date_modif,
|
||||
size, hsize: INTEGER;
|
||||
name: FNAME
|
||||
END
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
SEEK_BEG = 0
|
||||
SEEK_CUR = 1
|
||||
SEEK_END = 2
|
||||
SEEK_BEG = 0
|
||||
SEEK_CUR = 1
|
||||
SEEK_END = 2
|
||||
|
||||
PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
|
||||
‡ £à㦠¥â ¢ ¯ ¬ïâì ä ©« á ¨¬¥¥¬ FName, § ¯¨áë¢ ¥â ¢ ¯ à ¬¥âà
|
||||
size à §¬¥à ä ©« , ¢®§¢à é ¥â ¤à¥á § £à㦥®£® ä ©«
|
||||
¨«¨ 0 (®è¨¡ª ). <20>ਠ¥®¡å®¤¨¬®áâ¨, à ᯠª®¢ë¢ ¥â
|
||||
ä ©« (kunpack).
|
||||
PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
|
||||
‡ £à㦠¥â ¢ ¯ ¬ïâì ä ©« á ¨¬¥¥¬ FName, § ¯¨áë¢ ¥â ¢ ¯ à ¬¥âà
|
||||
size à §¬¥à ä ©« , ¢®§¢à é ¥â ¤à¥á § £à㦥®£® ä ©«
|
||||
¨«¨ 0 (®è¨¡ª ). <20>ਠ¥®¡å®¤¨¬®áâ¨, à ᯠª®¢ë¢ ¥â
|
||||
ä ©« (kunpack).
|
||||
|
||||
PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
|
||||
‡ ¯¨áë¢ ¥â áâàãªâãàã ¡«®ª ¤ ëå ¢å®¤ ª â «®£ ¤«ï ä ©«
|
||||
¨«¨ ¯ ¯ª¨ á ¨¬¥¥¬ FName ¢ ¯ à ¬¥âà Info.
|
||||
<EFBFBD>ਠ®è¨¡ª¥ ¢®§¢à é ¥â FALSE.
|
||||
PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
|
||||
‡ ¯¨áë¢ ¥â áâàãªâãàã ¡«®ª ¤ ëå ¢å®¤ ª â «®£ ¤«ï ä ©«
|
||||
¨«¨ ¯ ¯ª¨ á ¨¬¥¥¬ FName ¢ ¯ à ¬¥âà Info.
|
||||
<EFBFBD>ਠ®è¨¡ª¥ ¢®§¢à é ¥â FALSE.
|
||||
|
||||
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ ä ©« á ¨¬¥¥¬ FName áãé¥áâ¢ã¥â
|
||||
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ ä ©« á ¨¬¥¥¬ FName áãé¥áâ¢ã¥â
|
||||
|
||||
PROCEDURE Close(VAR F: FS)
|
||||
®á¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥ãî ¤«ï ¨ä®à¬ 樮®© áâàãªâãàë
|
||||
ä ©« F ¨ ¯à¨á¢ ¨¢ ¥â F § 票¥ NIL
|
||||
PROCEDURE Close(VAR F: FS)
|
||||
®á¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥ãî ¤«ï ¨ä®à¬ 樮®© áâàãªâãàë
|
||||
ä ©« F ¨ ¯à¨á¢ ¨¢ ¥â F § 票¥ NIL
|
||||
|
||||
PROCEDURE Open(FName: ARRAY OF CHAR): FS
|
||||
¢®§¢à é ¥â 㪠§ â¥«ì ¨ä®à¬ 樮ãî áâàãªâãàã ä ©« á
|
||||
¨¬¥¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
|
||||
PROCEDURE Open(FName: ARRAY OF CHAR): FS
|
||||
¢®§¢à é ¥â 㪠§ â¥«ì ¨ä®à¬ 樮ãî áâàãªâãàã ä ©« á
|
||||
¨¬¥¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
|
||||
|
||||
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
|
||||
㤠«ï¥â ä ©« á ¨¬¥¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
|
||||
㤠«ï¥â ä ©« á ¨¬¥¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
|
||||
PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER
|
||||
ãáâ ¢«¨¢ ¥â ¯®§¨æ¨î ç⥨ï-§ ¯¨á¨ ä ©« F Offset,
|
||||
®â®á¨â¥«ì® Origin = (SEEK_BEG - ç «® ä ©« ,
|
||||
SEEK_CUR - ⥪ãé ï ¯®§¨æ¨ï, SEEK_END - ª®¥æ ä ©« ),
|
||||
¢®§¢à é ¥â ¯®§¨æ¨î ®â®á¨â¥«ì® ç « ä ©« , ¯à¨¬¥à:
|
||||
Seek(F, 0, SEEK_END)
|
||||
ãáâ ¢«¨¢ ¥â ¯®§¨æ¨î ª®¥æ ä ©« ¨ ¢®§¢à é ¥â ¤«¨ã
|
||||
ä ©« ; ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â -1
|
||||
PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER
|
||||
ãáâ ¢«¨¢ ¥â ¯®§¨æ¨î ç⥨ï-§ ¯¨á¨ ä ©« F Offset,
|
||||
®â®á¨â¥«ì® Origin = (SEEK_BEG - ç «® ä ©« ,
|
||||
SEEK_CUR - ⥪ãé ï ¯®§¨æ¨ï, SEEK_END - ª®¥æ ä ©« ),
|
||||
¢®§¢à é ¥â ¯®§¨æ¨î ®â®á¨â¥«ì® ç « ä ©« , ¯à¨¬¥à:
|
||||
Seek(F, 0, SEEK_END)
|
||||
ãáâ ¢«¨¢ ¥â ¯®§¨æ¨î ª®¥æ ä ©« ¨ ¢®§¢à é ¥â ¤«¨ã
|
||||
ä ©« ; ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â -1
|
||||
|
||||
PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER
|
||||
—¨â ¥â ¤ ë¥ ¨§ ä ©« ¢ ¯ ¬ïâì. F - 㪠§ ⥫ì
|
||||
¨ä®à¬ 樮ãî áâàãªâãàã ä ©« , Buffer - ¤à¥á ®¡« áâ¨
|
||||
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï ¯à®ç¨â âì
|
||||
¨§ ä ©« ; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® ¯à®ç¨â ®
|
||||
¨ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ï¥â ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF.
|
||||
PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER
|
||||
—¨â ¥â ¤ ë¥ ¨§ ä ©« ¢ ¯ ¬ïâì. F - 㪠§ ⥫ì
|
||||
¨ä®à¬ 樮ãî áâàãªâãàã ä ©« , Buffer - ¤à¥á ®¡« áâ¨
|
||||
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï ¯à®ç¨â âì
|
||||
¨§ ä ©« ; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® ¯à®ç¨â ®
|
||||
¨ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ï¥â ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF.
|
||||
|
||||
PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER
|
||||
‡ ¯¨áë¢ ¥â ¤ ë¥ ¨§ ¯ ¬ï⨠¢ ä ©«. F - 㪠§ ⥫ì
|
||||
¨ä®à¬ 樮ãî áâàãªâãàã ä ©« , Buffer - ¤à¥á ®¡« áâ¨
|
||||
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï § ¯¨á âì
|
||||
¢ ä ©«; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® § ¯¨á ® ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ï¥â ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF.
|
||||
PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER
|
||||
‡ ¯¨áë¢ ¥â ¤ ë¥ ¨§ ¯ ¬ï⨠¢ ä ©«. F - 㪠§ ⥫ì
|
||||
¨ä®à¬ 樮ãî áâàãªâãàã ä ©« , Buffer - ¤à¥á ®¡« áâ¨
|
||||
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï § ¯¨á âì
|
||||
¢ ä ©«; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® § ¯¨á ® ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ï¥â ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF.
|
||||
|
||||
PROCEDURE Create(FName: ARRAY OF CHAR): FS
|
||||
ᮧ¤ ¥â ®¢ë© ä ©« á ¨¬¥¥¬ FName (¯®«®¥ ¨¬ï), ¢®§¢à é ¥â
|
||||
㪠§ â¥«ì ¨ä®à¬ 樮ãî áâàãªâãàã ä ©« ,
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
|
||||
PROCEDURE Create(FName: ARRAY OF CHAR): FS
|
||||
ᮧ¤ ¥â ®¢ë© ä ©« á ¨¬¥¥¬ FName (¯®«®¥ ¨¬ï), ¢®§¢à é ¥â
|
||||
㪠§ â¥«ì ¨ä®à¬ 樮ãî áâàãªâãàã ä ©« ,
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
|
||||
|
||||
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
ᮧ¤ ¥â ¯ ¯ªã á ¨¬¥¥¬ DirName, ¢á¥ ¯à®¬¥¦ãâ®çë¥ ¯ ¯ª¨
|
||||
¤®«¦ë áãé¥á⢮¢ âì, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
ᮧ¤ ¥â ¯ ¯ªã á ¨¬¥¥¬ DirName, ¢á¥ ¯à®¬¥¦ãâ®çë¥ ¯ ¯ª¨
|
||||
¤®«¦ë áãé¥á⢮¢ âì, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
|
||||
PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
㤠«ï¥â ¯ãáâãî ¯ ¯ªã á ¨¬¥¥¬ DirName,
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
㤠«ï¥â ¯ãáâãî ¯ ¯ªã á ¨¬¥¥¬ DirName,
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
|
||||
PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ ¯ ¯ª á ¨¬¥¥¬ DirName áãé¥áâ¢ã¥â
|
||||
PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN
|
||||
¢®§¢à é ¥â TRUE, ¥á«¨ ¯ ¯ª á ¨¬¥¥¬ DirName áãé¥áâ¢ã¥â
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Read - ç⥨¥ ®á®¢ëå ⨯®¢ ¤ ëå ¨§ ä ©« F
|
||||
|
||||
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ让 ®¯¥à 樨 çâ¥¨ï ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ïîâ ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF
|
||||
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ让 ®¯¥à 樨 çâ¥¨ï ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ïîâ ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF
|
||||
|
||||
PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
|
||||
PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
|
||||
|
||||
PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
|
||||
PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
|
||||
|
||||
PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
|
||||
PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
|
||||
|
||||
PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
|
||||
PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
|
||||
|
||||
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
|
||||
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
|
||||
|
||||
PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN
|
||||
PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Write - § ¯¨áì ®á®¢ëå ⨯®¢ ¤ ëå ¢ ä ©« F
|
||||
|
||||
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ让 ®¯¥à 樨 § ¯¨á¨ ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ïîâ ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF
|
||||
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ让 ®¯¥à 樨 § ¯¨á¨ ¨
|
||||
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥ïîâ ¯®§¨æ¨î ç⥨ï/§ ¯¨á¨ ¢
|
||||
¨ä®à¬ 樮®© áâàãªâãॠF
|
||||
|
||||
PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
|
||||
PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
|
||||
|
||||
PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
|
||||
PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
|
||||
|
||||
PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
|
||||
PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
|
||||
|
||||
PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
|
||||
PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
|
||||
|
||||
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
|
||||
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
|
||||
|
||||
PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN
|
||||
PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE DateTime - ¤ â , ¢à¥¬ï
|
||||
|
||||
CONST ERR = -7.0E5
|
||||
CONST ERR = -7.0E5
|
||||
|
||||
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
|
||||
§ ¯¨áë¢ ¥â ¢ ¯ à ¬¥âàë ª®¬¯®¥âë ⥪ã饩 á¨á⥬®© ¤ âë ¨
|
||||
¢à¥¬¥¨
|
||||
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
|
||||
§ ¯¨áë¢ ¥â ¢ ¯ à ¬¥âàë ª®¬¯®¥âë ⥪ã饩 á¨á⥬®© ¤ âë ¨
|
||||
¢à¥¬¥¨
|
||||
|
||||
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
|
||||
¢®§¢à é ¥â ¤ âã, ¯®«ãç¥ãî ¨§ ª®¬¯®¥â®¢
|
||||
Year, Month, Day, Hour, Min, Sec;
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®áâ âã ERR = -7.0D5
|
||||
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
|
||||
¢®§¢à é ¥â ¤ âã, ¯®«ãç¥ãî ¨§ ª®¬¯®¥â®¢
|
||||
Year, Month, Day, Hour, Min, Sec;
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®áâ âã ERR = -7.0E5
|
||||
|
||||
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
|
||||
Hour, Min, Sec: INTEGER): BOOLEAN
|
||||
¨§¢«¥ª ¥â ª®¬¯®¥âë
|
||||
Year, Month, Day, Hour, Min, Sec ¨§ ¤ âë Date;
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
|
||||
Hour, Min, Sec: INTEGER): BOOLEAN
|
||||
¨§¢«¥ª ¥â ª®¬¯®¥âë
|
||||
Year, Month, Day, Hour, Min, Sec ¨§ ¤ âë Date;
|
||||
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE Args - ¯ à ¬¥âàë ¯à®£à ¬¬ë
|
||||
|
||||
VAR argc: INTEGER
|
||||
ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ¯à®£à ¬¬ë, ¢ª«îç ï ¨¬ï
|
||||
¨á¯®«ï¥¬®£® ä ©«
|
||||
VAR argc: INTEGER
|
||||
ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ¯à®£à ¬¬ë, ¢ª«îç ï ¨¬ï
|
||||
¨á¯®«ï¥¬®£® ä ©«
|
||||
|
||||
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
|
||||
§ ¯¨áë¢ ¥â ¢ áâபã s n-© ¯ à ¬¥âà ¯à®£à ¬¬ë,
|
||||
㬥à æ¨ï ¯ à ¬¥â஢ ®â 0 ¤® argc - 1,
|
||||
ã«¥¢®© ¯ à ¬¥âà -- ¨¬ï ¨á¯®«ï¥¬®£® ä ©«
|
||||
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
|
||||
§ ¯¨áë¢ ¥â ¢ áâபã s n-© ¯ à ¬¥âà ¯à®£à ¬¬ë,
|
||||
㬥à æ¨ï ¯ à ¬¥â஢ ®â 0 ¤® argc - 1,
|
||||
ã«¥¢®© ¯ à ¬¥âà -- ¨¬ï ¨á¯®«ï¥¬®£® ä ©«
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE KOSAPI
|
||||
|
||||
PROCEDURE sysfunc1(arg1: INTEGER): INTEGER
|
||||
PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER
|
||||
...
|
||||
PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER
|
||||
Ž¡¥à⪨ ¤«ï äãªæ¨© API ï¤à KolibriOS.
|
||||
arg1 .. arg7 ᮮ⢥âáâ¢ãîâ ॣ¨áâà ¬
|
||||
eax, ebx, ecx, edx, esi, edi, ebp;
|
||||
¢®§¢à é îâ § 票¥ ॣ¨áâà eax ¯®á«¥ á¨á⥬®£® ¢ë§®¢ .
|
||||
PROCEDURE sysfunc1(arg1: INTEGER): INTEGER
|
||||
PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER
|
||||
...
|
||||
PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER
|
||||
Ž¡¥à⪨ ¤«ï äãªæ¨© API ï¤à KolibriOS.
|
||||
arg1 .. arg7 ᮮ⢥âáâ¢ãîâ ॣ¨áâà ¬
|
||||
eax, ebx, ecx, edx, esi, edi, ebp;
|
||||
¢®§¢à é îâ § 票¥ ॣ¨áâà eax ¯®á«¥ á¨á⥬®£® ¢ë§®¢ .
|
||||
|
||||
PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
|
||||
Ž¡¥à⪠¤«ï äãªæ¨© API ï¤à KolibriOS.
|
||||
arg1 - ॣ¨áâà eax, arg2 - ॣ¨áâà ebx,
|
||||
res2 - § 票¥ ॣ¨áâà ebx ¯®á«¥ á¨á⥬®£® ¢ë§®¢ ;
|
||||
¢®§¢à é ¥â § 票¥ ॣ¨áâà eax ¯®á«¥ á¨á⥬®£® ¢ë§®¢ .
|
||||
PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
|
||||
Ž¡¥à⪠¤«ï äãªæ¨© API ï¤à KolibriOS.
|
||||
arg1 - ॣ¨áâà eax, arg2 - ॣ¨áâà ebx,
|
||||
res2 - § 票¥ ॣ¨áâà ebx ¯®á«¥ á¨á⥬®£® ¢ë§®¢ ;
|
||||
¢®§¢à é ¥â § 票¥ ॣ¨áâà eax ¯®á«¥ á¨á⥬®£® ¢ë§®¢ .
|
||||
|
||||
PROCEDURE malloc(size: INTEGER): INTEGER
|
||||
‚뤥«ï¥â ¡«®ª ¯ ¬ïâ¨.
|
||||
size - à §¬¥à ¡«®ª ¢ ¡ ©â å,
|
||||
¢®§¢à é ¥â ¤à¥á ¢ë¤¥«¥®£® ¡«®ª
|
||||
PROCEDURE malloc(size: INTEGER): INTEGER
|
||||
‚뤥«ï¥â ¡«®ª ¯ ¬ïâ¨.
|
||||
size - à §¬¥à ¡«®ª ¢ ¡ ©â å,
|
||||
¢®§¢à é ¥â ¤à¥á ¢ë¤¥«¥®£® ¡«®ª
|
||||
|
||||
PROCEDURE free(ptr: INTEGER): INTEGER
|
||||
Žá¢®¡®¦¤ ¥â à ¥¥ ¢ë¤¥«¥ë© ¡«®ª ¯ ¬ïâ¨ á ¤à¥á®¬ ptr,
|
||||
¢®§¢à é ¥â 0
|
||||
PROCEDURE free(ptr: INTEGER): INTEGER
|
||||
Žá¢®¡®¦¤ ¥â à ¥¥ ¢ë¤¥«¥ë© ¡«®ª ¯ ¬ïâ¨ á ¤à¥á®¬ ptr,
|
||||
¢®§¢à é ¥â 0
|
||||
|
||||
PROCEDURE realloc(ptr, size: INTEGER): INTEGER
|
||||
<EFBFBD>¥à¥à á¯à¥¤¥«ï¥â ¡«®ª ¯ ¬ïâ¨,
|
||||
ptr - ¤à¥á à ¥¥ ¢ë¤¥«¥®£® ¡«®ª ,
|
||||
size - ®¢ë© à §¬¥à,
|
||||
¢®§¢à é ¥â 㪠§ â¥«ì ¯¥à¥à á¯à¥¤¥«¥ë© ¡«®ª,
|
||||
0 ¯à¨ ®è¨¡ª¥
|
||||
PROCEDURE realloc(ptr, size: INTEGER): INTEGER
|
||||
<EFBFBD>¥à¥à á¯à¥¤¥«ï¥â ¡«®ª ¯ ¬ïâ¨,
|
||||
ptr - ¤à¥á à ¥¥ ¢ë¤¥«¥®£® ¡«®ª ,
|
||||
size - ®¢ë© à §¬¥à,
|
||||
¢®§¢à é ¥â 㪠§ â¥«ì ¯¥à¥à á¯à¥¤¥«¥ë© ¡«®ª,
|
||||
0 ¯à¨ ®è¨¡ª¥
|
||||
|
||||
PROCEDURE GetCommandLine(): INTEGER
|
||||
‚®§¢à é ¥â ¤à¥á áâப¨ ¯ à ¬¥â஢
|
||||
PROCEDURE GetCommandLine(): INTEGER
|
||||
‚®§¢à é ¥â ¤à¥á áâப¨ ¯ à ¬¥â஢
|
||||
|
||||
PROCEDURE GetName(): INTEGER
|
||||
‚®§¢à é ¥â ¤à¥á áâப¨ á ¨¬¥¥¬ ¯à®£à ¬¬ë
|
||||
PROCEDURE GetName(): INTEGER
|
||||
‚®§¢à é ¥â ¤à¥á áâப¨ á ¨¬¥¥¬ ¯à®£à ¬¬ë
|
||||
|
||||
PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
|
||||
‡ £à㦠¥â DLL á ¯®«ë¬ ¨¬¥¥¬ name. ‚®§¢à é ¥â ¤à¥á â ¡«¨æë
|
||||
íªá¯®àâ . <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
|
||||
PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
|
||||
‡ £à㦠¥â DLL á ¯®«ë¬ ¨¬¥¥¬ name. ‚®§¢à é ¥â ¤à¥á â ¡«¨æë
|
||||
íªá¯®àâ . <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
|
||||
|
||||
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
|
||||
name - ¨¬ï ¯à®æ¥¤ãàë
|
||||
lib - ¤à¥á â ¡«¨æë íªá¯®àâ DLL
|
||||
‚®§¢à é ¥â ¤à¥á ¯à®æ¥¤ãàë. <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
|
||||
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
|
||||
name - ¨¬ï ¯à®æ¥¤ãàë
|
||||
lib - ¤à¥á â ¡«¨æë íªá¯®àâ DLL
|
||||
‚®§¢à é ¥â ¤à¥á ¯à®æ¥¤ãàë. <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE ColorDlg - à ¡®â á ¤¨ «®£®¬ "Color Dialog"
|
||||
|
||||
TYPE
|
||||
TYPE
|
||||
|
||||
Dialog = POINTER TO RECORD (* áâàãªâãà ¤¨ «®£ *)
|
||||
status: INTEGER (* á®áâ®ï¨¥ ¤¨ «®£ :
|
||||
0 - ¯®«ì§®¢ â¥«ì ¦ « Cancel
|
||||
1 - ¯®«ì§®¢ â¥«ì ¦ « OK
|
||||
2 - ¤¨ «®£ ®âªàëâ *)
|
||||
Dialog = POINTER TO RECORD (* áâàãªâãà ¤¨ «®£ *)
|
||||
status: INTEGER (* á®áâ®ï¨¥ ¤¨ «®£ :
|
||||
0 - ¯®«ì§®¢ â¥«ì ¦ « Cancel
|
||||
1 - ¯®«ì§®¢ â¥«ì ¦ « OK
|
||||
2 - ¤¨ «®£ ®âªàëâ *)
|
||||
|
||||
color: INTEGER (* ¢ë¡à ë© æ¢¥â *)
|
||||
END
|
||||
color: INTEGER (* ¢ë¡à ë© æ¢¥â *)
|
||||
END
|
||||
|
||||
PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
|
||||
ᮧ¤ âì ¤¨ «®£
|
||||
draw_window - ¯à®æ¥¤ãà ¯¥à¥à¨á®¢ª¨ ®á®¢®£® ®ª
|
||||
(TYPE DRAW_WINDOW = PROCEDURE);
|
||||
¯à®æ¥¤ãà ¢®§¢à é ¥â 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
|
||||
ᮧ¤ âì ¤¨ «®£
|
||||
draw_window - ¯à®æ¥¤ãà ¯¥à¥à¨á®¢ª¨ ®á®¢®£® ®ª
|
||||
(TYPE DRAW_WINDOW = PROCEDURE);
|
||||
¯à®æ¥¤ãà ¢®§¢à é ¥â 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
|
||||
PROCEDURE Show(cd: Dialog)
|
||||
¯®ª § âì ¤¨ «®£
|
||||
cd - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ à ¥¥
|
||||
¯à®æ¥¤ãன Create
|
||||
PROCEDURE Show(cd: Dialog)
|
||||
¯®ª § âì ¤¨ «®£
|
||||
cd - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ à ¥¥
|
||||
¯à®æ¥¤ãன Create
|
||||
|
||||
PROCEDURE Destroy(VAR cd: Dialog)
|
||||
ã¨ç⮦¨âì ¤¨ «®£
|
||||
cd - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
PROCEDURE Destroy(VAR cd: Dialog)
|
||||
ã¨ç⮦¨âì ¤¨ «®£
|
||||
cd - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE OpenDlg - à ¡®â á ¤¨ «®£®¬ "Open Dialog"
|
||||
|
||||
TYPE
|
||||
TYPE
|
||||
|
||||
Dialog = POINTER TO RECORD (* áâàãªâãà ¤¨ «®£ *)
|
||||
status: INTEGER (* á®áâ®ï¨¥ ¤¨ «®£ :
|
||||
0 - ¯®«ì§®¢ â¥«ì ¦ « Cancel
|
||||
1 - ¯®«ì§®¢ â¥«ì ¦ « OK
|
||||
2 - ¤¨ «®£ ®âªàëâ *)
|
||||
Dialog = POINTER TO RECORD (* áâàãªâãà ¤¨ «®£ *)
|
||||
status: INTEGER (* á®áâ®ï¨¥ ¤¨ «®£ :
|
||||
0 - ¯®«ì§®¢ â¥«ì ¦ « Cancel
|
||||
1 - ¯®«ì§®¢ â¥«ì ¦ « OK
|
||||
2 - ¤¨ «®£ ®âªàëâ *)
|
||||
|
||||
FileName: ARRAY 4096 OF CHAR (* ¨¬ï ¢ë¡à ®£® ä ©« *)
|
||||
FilePath: ARRAY 4096 OF CHAR (* ¯®«®¥ ¨¬ï ¢ë¡à ®£®
|
||||
ä ©« *)
|
||||
END
|
||||
FileName: ARRAY 4096 OF CHAR (* ¨¬ï ¢ë¡à ®£® ä ©« *)
|
||||
FilePath: ARRAY 4096 OF CHAR (* ¯®«®¥ ¨¬ï ¢ë¡à ®£®
|
||||
ä ©« *)
|
||||
END
|
||||
|
||||
PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path,
|
||||
filter: ARRAY OF CHAR): Dialog
|
||||
ᮧ¤ âì ¤¨ «®£
|
||||
draw_window - ¯à®æ¥¤ãà ¯¥à¥à¨á®¢ª¨ ®á®¢®£® ®ª
|
||||
(TYPE DRAW_WINDOW = PROCEDURE)
|
||||
type - ⨯ ¤¨ «®£
|
||||
0 - ®âªàëâì
|
||||
1 - á®åà ¨âì
|
||||
2 - ¢ë¡à âì ¯ ¯ªã
|
||||
def_path - ¯ãâì ¯® 㬮«ç ¨î, ¯ ¯ª def_path ¡ã¤¥â ®âªàëâ
|
||||
¯à¨ ¯¥à¢®¬ § ¯ã᪥ ¤¨ «®£
|
||||
filter - ¢ áâப¥ § ¯¨á ® ¯¥à¥ç¨á«¥¨¥ à áè¨à¥¨© ä ©«®¢,
|
||||
ª®â®àë¥ ¡ã¤ãâ ¯®ª § ë ¢ ¤¨ «®£®¢®¬ ®ª¥, à áè¨à¥¨ï
|
||||
à §¤¥«ïîâáï ᨬ¢®«®¬ "|", ¯à¨¬¥à: "ASM|TXT|INI"
|
||||
¯à®æ¥¤ãà ¢®§¢à é ¥â 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path,
|
||||
filter: ARRAY OF CHAR): Dialog
|
||||
ᮧ¤ âì ¤¨ «®£
|
||||
draw_window - ¯à®æ¥¤ãà ¯¥à¥à¨á®¢ª¨ ®á®¢®£® ®ª
|
||||
(TYPE DRAW_WINDOW = PROCEDURE)
|
||||
type - ⨯ ¤¨ «®£
|
||||
0 - ®âªàëâì
|
||||
1 - á®åà ¨âì
|
||||
2 - ¢ë¡à âì ¯ ¯ªã
|
||||
def_path - ¯ãâì ¯® 㬮«ç ¨î, ¯ ¯ª def_path ¡ã¤¥â ®âªàëâ
|
||||
¯à¨ ¯¥à¢®¬ § ¯ã᪥ ¤¨ «®£
|
||||
filter - ¢ áâப¥ § ¯¨á ® ¯¥à¥ç¨á«¥¨¥ à áè¨à¥¨© ä ©«®¢,
|
||||
ª®â®àë¥ ¡ã¤ãâ ¯®ª § ë ¢ ¤¨ «®£®¢®¬ ®ª¥, à áè¨à¥¨ï
|
||||
à §¤¥«ïîâáï ᨬ¢®«®¬ "|", ¯à¨¬¥à: "ASM|TXT|INI"
|
||||
¯à®æ¥¤ãà ¢®§¢à é ¥â 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
|
||||
PROCEDURE Show(od: Dialog; Width, Height: INTEGER)
|
||||
¯®ª § âì ¤¨ «®£
|
||||
od - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ à ¥¥
|
||||
¯à®æ¥¤ãன Create
|
||||
Width ¨ Height - è¨à¨ ¨ ¢ëá®â ¤¨ «®£®¢®£® ®ª
|
||||
PROCEDURE Show(od: Dialog; Width, Height: INTEGER)
|
||||
¯®ª § âì ¤¨ «®£
|
||||
od - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ à ¥¥
|
||||
¯à®æ¥¤ãன Create
|
||||
Width ¨ Height - è¨à¨ ¨ ¢ëá®â ¤¨ «®£®¢®£® ®ª
|
||||
|
||||
PROCEDURE Destroy(VAR od: Dialog)
|
||||
ã¨ç⮦¨âì ¤¨ «®£
|
||||
od - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
PROCEDURE Destroy(VAR od: Dialog)
|
||||
ã¨ç⮦¨âì ¤¨ «®£
|
||||
od - 㪠§ ⥫ì áâàãªâãàã ¤¨ «®£
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
MODULE kfonts - à ¡®â á kf-èà¨äâ ¬¨
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
bold = 1
|
||||
italic = 2
|
||||
underline = 4
|
||||
strike_through = 8
|
||||
smoothing = 16
|
||||
bpp32 = 32
|
||||
bold = 1
|
||||
italic = 2
|
||||
underline = 4
|
||||
strike_through = 8
|
||||
smoothing = 16
|
||||
bpp32 = 32
|
||||
|
||||
TYPE
|
||||
TYPE
|
||||
|
||||
TFont = POINTER TO TFont_desc (* 㪠§ ⥫ì èà¨äâ *)
|
||||
TFont = POINTER TO TFont_desc (* 㪠§ ⥫ì èà¨äâ *)
|
||||
|
||||
PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont
|
||||
§ £à㧨âì èà¨äâ ¨§ ä ©«
|
||||
file_name ¨¬ï kf-ä ©«
|
||||
१-â: 㪠§ ⥫ì èà¨äâ/NIL (®è¨¡ª )
|
||||
PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont
|
||||
§ £à㧨âì èà¨äâ ¨§ ä ©«
|
||||
file_name ¨¬ï kf-ä ©«
|
||||
१-â: 㪠§ ⥫ì èà¨äâ/NIL (®è¨¡ª )
|
||||
|
||||
PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN
|
||||
ãáâ ®¢¨âì à §¬¥à èà¨äâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
font_size à §¬¥à èà¨äâ
|
||||
१-â: TRUE/FALSE (®è¨¡ª )
|
||||
PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN
|
||||
ãáâ ®¢¨âì à §¬¥à èà¨äâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
font_size à §¬¥à èà¨äâ
|
||||
१-â: TRUE/FALSE (®è¨¡ª )
|
||||
|
||||
PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
|
||||
¯à®¢¥à¨âì, ¥áâì «¨ èà¨äâ, § ¤ ®£® à §¬¥à
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
font_size à §¬¥à èà¨äâ
|
||||
१-â: TRUE/FALSE (èà¨äâ ¥â)
|
||||
PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
|
||||
¯à®¢¥à¨âì, ¥áâì «¨ èà¨äâ, § ¤ ®£® à §¬¥à
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
font_size à §¬¥à èà¨äâ
|
||||
१-â: TRUE/FALSE (èà¨äâ ¥â)
|
||||
|
||||
PROCEDURE Destroy(VAR Font: TFont)
|
||||
¢ë£à㧨âì èà¨äâ, ®á¢®¡®¤¨âì ¤¨ ¬¨ç¥áªãî ¯ ¬ïâì
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
<EFBFBD>à¨á¢ ¨¢ ¥â ¯¥à¥¬¥®© Font § 票¥ NIL
|
||||
PROCEDURE Destroy(VAR Font: TFont)
|
||||
¢ë£à㧨âì èà¨äâ, ®á¢®¡®¤¨âì ¤¨ ¬¨ç¥áªãî ¯ ¬ïâì
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
<EFBFBD>à¨á¢ ¨¢ ¥â ¯¥à¥¬¥®© Font § 票¥ NIL
|
||||
|
||||
PROCEDURE TextHeight(Font: TFont): INTEGER
|
||||
¯®«ãç¨âì ¢ëá®âã áâப¨ ⥪áâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
१-â: ¢ëá®â áâப¨ ⥪áâ ¢ ¯¨ªá¥«ïå
|
||||
PROCEDURE TextHeight(Font: TFont): INTEGER
|
||||
¯®«ãç¨âì ¢ëá®âã áâப¨ ⥪áâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
१-â: ¢ëá®â áâப¨ ⥪áâ ¢ ¯¨ªá¥«ïå
|
||||
|
||||
PROCEDURE TextWidth(Font: TFont;
|
||||
str, length, params: INTEGER): INTEGER
|
||||
¯®«ãç¨âì è¨à¨ã áâப¨ ⥪áâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
str ¤à¥á áâப¨ ⥪áâ ¢ ª®¤¨à®¢ª¥ Win-1251
|
||||
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப
|
||||
§ ¢¥àè ¥âáï ã«¥¬
|
||||
params ¯ à ¬¥âàë-ä« £¨ á¬. ¨¦¥
|
||||
१-â: è¨à¨ áâப¨ ⥪áâ ¢ ¯¨ªá¥«ïå
|
||||
PROCEDURE TextWidth(Font: TFont;
|
||||
str, length, params: INTEGER): INTEGER
|
||||
¯®«ãç¨âì è¨à¨ã áâப¨ ⥪áâ
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
str ¤à¥á áâப¨ ⥪áâ ¢ ª®¤¨à®¢ª¥ Win-1251
|
||||
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப
|
||||
§ ¢¥àè ¥âáï ã«¥¬
|
||||
params ¯ à ¬¥âàë-ä« £¨ á¬. ¨¦¥
|
||||
१-â: è¨à¨ áâப¨ ⥪áâ ¢ ¯¨ªá¥«ïå
|
||||
|
||||
PROCEDURE TextOut(Font: TFont;
|
||||
canvas, x, y, str, length, color, params: INTEGER)
|
||||
¢ë¢¥á⨠⥪áâ ¢ ¡ãä¥à
|
||||
¤«ï ¢ë¢®¤ ¡ãä¥à ¢ ®ª®, ¨á¯®«ì§®¢ âì ä.65 ¨«¨
|
||||
ä.7 (¥á«¨ ¡ãä¥à 24-¡¨âë©)
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
canvas ¤à¥á £à ä¨ç¥áª®£® ¡ãä¥à
|
||||
áâàãªâãà ¡ãä¥à :
|
||||
Xsize dd
|
||||
Ysize dd
|
||||
picture rb Xsize * Ysize * 4 (32 ¡¨â )
|
||||
¨«¨ Xsize * Ysize * 3 (24 ¡¨â )
|
||||
x, y ª®®à¤¨ âë ⥪áâ ®â®á¨â¥«ì® «¥¢®£® ¢¥à奣®
|
||||
㣫 ¡ãä¥à
|
||||
str ¤à¥á áâப¨ ⥪áâ ¢ ª®¤¨à®¢ª¥ Win-1251
|
||||
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப
|
||||
§ ¢¥àè ¥âáï ã«¥¬
|
||||
color 梥â ⥪áâ 0x00RRGGBB
|
||||
params ¯ à ¬¥âàë-ä« £¨:
|
||||
1 ¦¨àë©
|
||||
2 ªãàᨢ
|
||||
4 ¯®¤ç¥àªãâë©
|
||||
8 ¯¥à¥ç¥àªãâë©
|
||||
16 ¯à¨¬¥¨âì ᣫ ¦¨¢ ¨¥
|
||||
32 ¢ë¢®¤ ¢ 32-¡¨âë© ¡ãä¥à
|
||||
¢®§¬®¦® ¨á¯®«ì§®¢ ¨¥ ä« £®¢ ¢ «î¡ëå á®ç¥â ¨ïå
|
||||
PROCEDURE TextOut(Font: TFont;
|
||||
canvas, x, y, str, length, color, params: INTEGER)
|
||||
¢ë¢¥á⨠⥪áâ ¢ ¡ãä¥à
|
||||
¤«ï ¢ë¢®¤ ¡ãä¥à ¢ ®ª®, ¨á¯®«ì§®¢ âì ä.65 ¨«¨
|
||||
ä.7 (¥á«¨ ¡ãä¥à 24-¡¨âë©)
|
||||
Font 㪠§ ⥫ì èà¨äâ
|
||||
canvas ¤à¥á £à ä¨ç¥áª®£® ¡ãä¥à
|
||||
áâàãªâãà ¡ãä¥à :
|
||||
Xsize dd
|
||||
Ysize dd
|
||||
picture rb Xsize * Ysize * 4 (32 ¡¨â )
|
||||
¨«¨ Xsize * Ysize * 3 (24 ¡¨â )
|
||||
x, y ª®®à¤¨ âë ⥪áâ ®â®á¨â¥«ì® «¥¢®£® ¢¥à奣®
|
||||
㣫 ¡ãä¥à
|
||||
str ¤à¥á áâப¨ ⥪áâ ¢ ª®¤¨à®¢ª¥ Win-1251
|
||||
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப
|
||||
§ ¢¥àè ¥âáï ã«¥¬
|
||||
color 梥â ⥪áâ 0x00RRGGBB
|
||||
params ¯ à ¬¥âàë-ä« £¨:
|
||||
1 ¦¨àë©
|
||||
2 ªãàᨢ
|
||||
4 ¯®¤ç¥àªãâë©
|
||||
8 ¯¥à¥ç¥àªãâë©
|
||||
16 ¯à¨¬¥¨âì ᣫ ¦¨¢ ¨¥
|
||||
32 ¢ë¢®¤ ¢ 32-¡¨âë© ¡ãä¥à
|
||||
¢®§¬®¦® ¨á¯®«ì§®¢ ¨¥ ä« £®¢ ¢ «î¡ëå á®ç¥â ¨ïå
|
||||
------------------------------------------------------------------------------
|
||||
MODULE RasterWorks - ®¡¥à⪠¡¨¡«¨®â¥ª¨ Rasterworks.obj
|
||||
------------------------------------------------------------------------------
|
||||
|
@ -17,7 +17,7 @@
|
||||
|
||||
MODULE File;
|
||||
|
||||
IMPORT sys := SYSTEM, KOSAPI;
|
||||
IMPORT sys := SYSTEM, KOSAPI;
|
||||
|
||||
|
||||
CONST
|
||||
@ -47,7 +47,7 @@ TYPE
|
||||
time_modif*, date_modif*,
|
||||
size*, hsize*: INTEGER;
|
||||
name*: FNAME
|
||||
END;
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
|
||||
@ -67,7 +67,7 @@ BEGIN
|
||||
0C2H, 008H, 000H (* ret 8 *)
|
||||
)
|
||||
RETURN 0
|
||||
END f_68_27;
|
||||
END f_68_27;
|
||||
|
||||
|
||||
PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
|
||||
@ -77,7 +77,7 @@ END Load;
|
||||
|
||||
PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
|
||||
VAR
|
||||
res2: INTEGER; fs: rFS;
|
||||
res2: INTEGER; fs: rFS;
|
||||
|
||||
BEGIN
|
||||
fs.subfunc := 5;
|
||||
@ -88,7 +88,7 @@ BEGIN
|
||||
COPY(FName, fs.name)
|
||||
|
||||
RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
|
||||
END GetFileInfo;
|
||||
END GetFileInfo;
|
||||
|
||||
|
||||
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
|
||||
@ -97,7 +97,7 @@ VAR
|
||||
BEGIN
|
||||
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
|
||||
END Exists;
|
||||
|
||||
|
||||
|
||||
PROCEDURE Close* (VAR F: FS);
|
||||
BEGIN
|
||||
@ -109,9 +109,9 @@ END Close;
|
||||
|
||||
PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
|
||||
VAR
|
||||
F: FS;
|
||||
F: FS;
|
||||
|
||||
BEGIN
|
||||
BEGIN
|
||||
|
||||
IF Exists(FName) THEN
|
||||
NEW(F);
|
||||
@ -128,7 +128,7 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN F
|
||||
END Open;
|
||||
END Open;
|
||||
|
||||
|
||||
PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
|
||||
@ -158,7 +158,7 @@ BEGIN
|
||||
|
||||
RETURN res = 0
|
||||
END Delete;
|
||||
|
||||
|
||||
|
||||
PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
|
||||
VAR
|
||||
@ -202,7 +202,7 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN res2
|
||||
END Read;
|
||||
END Read;
|
||||
|
||||
|
||||
PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
|
||||
@ -225,7 +225,7 @@ BEGIN
|
||||
|
||||
RETURN res2
|
||||
END Write;
|
||||
|
||||
|
||||
|
||||
PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
|
||||
VAR
|
||||
@ -249,14 +249,14 @@ BEGIN
|
||||
|
||||
RETURN F
|
||||
END Create;
|
||||
|
||||
|
||||
|
||||
PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
fd: rFD;
|
||||
BEGIN
|
||||
RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
|
||||
END DirExists;
|
||||
END DirExists;
|
||||
|
||||
|
||||
PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
|
||||
@ -282,7 +282,7 @@ BEGIN
|
||||
|
||||
RETURN res = 0
|
||||
END CreateDir;
|
||||
|
||||
|
||||
|
||||
PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
|
@ -1,5 +1,5 @@
|
||||
(*
|
||||
Copyright 2013, 2014, 2018 Anton Krotov
|
||||
Copyright 2013, 2014, 2018, 2019 Anton Krotov
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Lesser General Public License as published by
|
||||
@ -167,10 +167,10 @@ END ln;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] log* (base, x: REAL): REAL;
|
||||
BEGIN
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
0D9H, 0E8H, (* fld1 *)
|
||||
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
|
||||
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
|
||||
0D9H, 0F1H, (* fyl2x *)
|
||||
0D9H, 0E8H, (* fld1 *)
|
||||
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
|
||||
@ -251,58 +251,45 @@ END arctan;
|
||||
|
||||
|
||||
PROCEDURE sinh* (x: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF IsZero(x) THEN
|
||||
res := 0.0
|
||||
ELSE
|
||||
res := (exp(x) - exp(-x)) / 2.0
|
||||
END
|
||||
RETURN res
|
||||
x := exp(x)
|
||||
RETURN (x - 1.0 / x) * 0.5
|
||||
END sinh;
|
||||
|
||||
|
||||
PROCEDURE cosh* (x: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF IsZero(x) THEN
|
||||
res := 1.0
|
||||
ELSE
|
||||
res := (exp(x) + exp(-x)) / 2.0
|
||||
END
|
||||
RETURN res
|
||||
x := exp(x)
|
||||
RETURN (x + 1.0 / x) * 0.5
|
||||
END cosh;
|
||||
|
||||
|
||||
PROCEDURE tanh* (x: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
IF IsZero(x) THEN
|
||||
res := 0.0
|
||||
IF x > 15.0 THEN
|
||||
x := 1.0
|
||||
ELSIF x < -15.0 THEN
|
||||
x := -1.0
|
||||
ELSE
|
||||
res := sinh(x) / cosh(x)
|
||||
x := exp(2.0 * x);
|
||||
x := (x - 1.0) / (x + 1.0)
|
||||
END
|
||||
RETURN res
|
||||
|
||||
RETURN x
|
||||
END tanh;
|
||||
|
||||
|
||||
PROCEDURE arcsinh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt((x * x) + 1.0))
|
||||
END arcsinh;
|
||||
PROCEDURE arsinh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt(x * x + 1.0))
|
||||
END arsinh;
|
||||
|
||||
|
||||
PROCEDURE arccosh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
|
||||
END arccosh;
|
||||
PROCEDURE arcosh* (x: REAL): REAL;
|
||||
RETURN ln(x + sqrt(x * x - 1.0))
|
||||
END arcosh;
|
||||
|
||||
|
||||
PROCEDURE arctanh* (x: REAL): REAL;
|
||||
PROCEDURE artanh* (x: REAL): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
@ -315,7 +302,7 @@ BEGIN
|
||||
res := 0.5 * ln((1.0 + x) / (1.0 - x))
|
||||
END
|
||||
RETURN res
|
||||
END arctanh;
|
||||
END artanh;
|
||||
|
||||
|
||||
PROCEDURE floor* (x: REAL): REAL;
|
||||
@ -374,8 +361,24 @@ BEGIN
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END sgn;
|
||||
|
||||
|
||||
|
||||
PROCEDURE fact* (n: INTEGER): REAL;
|
||||
VAR
|
||||
res: REAL;
|
||||
|
||||
BEGIN
|
||||
res := 1.0;
|
||||
WHILE n > 1 DO
|
||||
res := res * FLT(n);
|
||||
DEC(n)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END fact;
|
||||
|
||||
|
||||
END Math.
|
@ -1,4 +1,4 @@
|
||||
(*
|
||||
(*
|
||||
Copyright 2017 Anton Krotov
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@ -24,18 +24,18 @@ CONST
|
||||
|
||||
//net devices types
|
||||
|
||||
LOOPBACK* = 0;
|
||||
ETH* = 1;
|
||||
SLIP* = 2;
|
||||
LOOPBACK* = 0;
|
||||
ETH* = 1;
|
||||
SLIP* = 2;
|
||||
|
||||
//Link status
|
||||
|
||||
LINK_DOWN* = 0;
|
||||
LINK_DOWN* = 0;
|
||||
LINK_UNKNOWN* = 1;
|
||||
LINK_FD* = 2; //full duplex flag
|
||||
LINK_10M* = 4;
|
||||
LINK_100M* = 8;
|
||||
LINK_1G* = 12;
|
||||
LINK_FD* = 2; //full duplex flag
|
||||
LINK_10M* = 4;
|
||||
LINK_100M* = 8;
|
||||
LINK_1G* = 12;
|
||||
|
||||
|
||||
TYPE
|
||||
|
@ -10,7 +10,7 @@ MODULE RTL;
|
||||
IMPORT SYSTEM, API;
|
||||
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
bit_depth* = 32;
|
||||
maxint* = 7FFFFFFFH;
|
||||
@ -22,11 +22,13 @@ CONST
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
MAX_SET = 31;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
|
||||
PROC = PROCEDURE;
|
||||
|
||||
|
||||
VAR
|
||||
@ -40,6 +42,8 @@ VAR
|
||||
thread_attach: DLL_ENTRY
|
||||
END;
|
||||
|
||||
fini: PROC;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
|
||||
BEGIN
|
||||
@ -107,18 +111,12 @@ BEGIN
|
||||
END _arrcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
|
||||
VAR
|
||||
i, n, k: INTEGER;
|
||||
@ -137,32 +135,29 @@ BEGIN
|
||||
END _rot;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF (a <= b) & (a <= 31) & (b >= 0) THEN
|
||||
IF b > 31 THEN
|
||||
b := 31
|
||||
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
|
||||
IF b > MAX_SET THEN
|
||||
b := MAX_SET
|
||||
END;
|
||||
IF a < 0 THEN
|
||||
a := 0
|
||||
END;
|
||||
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
|
||||
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
|
||||
ELSE
|
||||
res := 0
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
RETURN _set2(a, b)
|
||||
RETURN a
|
||||
END _set;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
RETURN _set(b, a)
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -185,7 +180,7 @@ BEGIN
|
||||
END divmod;
|
||||
|
||||
|
||||
PROCEDURE div_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -196,10 +191,10 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN div
|
||||
END div_;
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -210,29 +205,19 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN mod
|
||||
END mod_;
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
RETURN _div2(a, b)
|
||||
END _div;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
RETURN _mod2(a, b)
|
||||
END _mod;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
||||
BEGIN
|
||||
ptr := API._NEW(size);
|
||||
@ -251,50 +236,6 @@ BEGIN
|
||||
END _dispose;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -345,16 +286,71 @@ BEGIN
|
||||
END _lengthw;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmp(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _length(len1, str1) - _length(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -370,21 +366,25 @@ BEGIN
|
||||
END _strcmp;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmp(op, len2, str2, len1, str1)
|
||||
END _strcmp2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: WCHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmpw(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _lengthw(len1, str1) - _lengthw(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2 * 2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1 * 2, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -400,11 +400,6 @@ BEGIN
|
||||
END _strcmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmpw(op, len2, str2, len1, str1)
|
||||
END _strcmpw2;
|
||||
|
||||
|
||||
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
c: CHAR;
|
||||
@ -470,14 +465,14 @@ BEGIN
|
||||
END append;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _error* (module, err: INTEGER);
|
||||
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
|
||||
VAR
|
||||
s, temp: ARRAY 1024 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
s := "";
|
||||
CASE err MOD 16 OF
|
||||
CASE err OF
|
||||
| 1: append(s, "assertion failure")
|
||||
| 2: append(s, "NIL dereference")
|
||||
| 3: append(s, "division by zero")
|
||||
@ -493,8 +488,8 @@ BEGIN
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
@ -502,69 +497,42 @@ BEGIN
|
||||
END _error;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _isrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
ELSE
|
||||
t1 := -1
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _is;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r:t1 IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _guardrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
SYSTEM.GET(p, p);
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # t0) & (t1 # 0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
ELSE
|
||||
t1 := t0
|
||||
p := 1
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _guard;
|
||||
|
||||
|
||||
@ -613,18 +581,50 @@ BEGIN
|
||||
END _exit;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
||||
VAR
|
||||
t0, t1, i, j: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
|
||||
API.init(param, code);
|
||||
|
||||
types := _types;
|
||||
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
||||
ASSERT(types # 0);
|
||||
FOR i := 0 TO tcount - 1 DO
|
||||
FOR j := 0 TO tcount - 1 DO
|
||||
t0 := i; t1 := j;
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
|
||||
END;
|
||||
|
||||
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
||||
END
|
||||
END;
|
||||
|
||||
name := modname;
|
||||
|
||||
dll.process_detach := NIL;
|
||||
dll.thread_detach := NIL;
|
||||
dll.thread_attach := NIL;
|
||||
|
||||
fini := NIL
|
||||
END _init;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _sofinit*;
|
||||
BEGIN
|
||||
IF fini # NIL THEN
|
||||
fini
|
||||
END
|
||||
END _sofinit;
|
||||
|
||||
|
||||
PROCEDURE SetFini* (ProcFini: PROC);
|
||||
BEGIN
|
||||
fini := ProcFini
|
||||
END SetFini;
|
||||
|
||||
|
||||
END RTL.
|
@ -1,4 +1,4 @@
|
||||
(*
|
||||
(*
|
||||
Copyright 2016 Anton Krotov
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
@ -38,16 +38,6 @@ VAR
|
||||
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
|
||||
END dlopen;
|
||||
|
||||
|
||||
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
|
||||
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
|
||||
END dlsym;
|
||||
|
||||
|
||||
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, len, ptr: INTEGER;
|
||||
|
@ -10,7 +10,7 @@ MODULE RTL;
|
||||
IMPORT SYSTEM, API;
|
||||
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
bit_depth* = 32;
|
||||
maxint* = 7FFFFFFFH;
|
||||
@ -22,11 +22,13 @@ CONST
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
MAX_SET = 31;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
|
||||
PROC = PROCEDURE;
|
||||
|
||||
|
||||
VAR
|
||||
@ -40,6 +42,8 @@ VAR
|
||||
thread_attach: DLL_ENTRY
|
||||
END;
|
||||
|
||||
fini: PROC;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
|
||||
BEGIN
|
||||
@ -107,18 +111,12 @@ BEGIN
|
||||
END _arrcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
|
||||
VAR
|
||||
i, n, k: INTEGER;
|
||||
@ -137,32 +135,29 @@ BEGIN
|
||||
END _rot;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF (a <= b) & (a <= 31) & (b >= 0) THEN
|
||||
IF b > 31 THEN
|
||||
b := 31
|
||||
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
|
||||
IF b > MAX_SET THEN
|
||||
b := MAX_SET
|
||||
END;
|
||||
IF a < 0 THEN
|
||||
a := 0
|
||||
END;
|
||||
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
|
||||
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
|
||||
ELSE
|
||||
res := 0
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
RETURN _set2(a, b)
|
||||
RETURN a
|
||||
END _set;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
RETURN _set(b, a)
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -185,7 +180,7 @@ BEGIN
|
||||
END divmod;
|
||||
|
||||
|
||||
PROCEDURE div_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -196,10 +191,10 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN div
|
||||
END div_;
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -210,29 +205,19 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN mod
|
||||
END mod_;
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
RETURN _div2(a, b)
|
||||
END _div;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
RETURN _mod2(a, b)
|
||||
END _mod;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
||||
BEGIN
|
||||
ptr := API._NEW(size);
|
||||
@ -251,50 +236,6 @@ BEGIN
|
||||
END _dispose;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -345,16 +286,71 @@ BEGIN
|
||||
END _lengthw;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmp(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _length(len1, str1) - _length(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -370,21 +366,25 @@ BEGIN
|
||||
END _strcmp;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmp(op, len2, str2, len1, str1)
|
||||
END _strcmp2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: WCHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmpw(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _lengthw(len1, str1) - _lengthw(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2 * 2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1 * 2, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -400,11 +400,6 @@ BEGIN
|
||||
END _strcmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmpw(op, len2, str2, len1, str1)
|
||||
END _strcmpw2;
|
||||
|
||||
|
||||
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
c: CHAR;
|
||||
@ -470,14 +465,14 @@ BEGIN
|
||||
END append;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _error* (module, err: INTEGER);
|
||||
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
|
||||
VAR
|
||||
s, temp: ARRAY 1024 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
s := "";
|
||||
CASE err MOD 16 OF
|
||||
CASE err OF
|
||||
| 1: append(s, "assertion failure")
|
||||
| 2: append(s, "NIL dereference")
|
||||
| 3: append(s, "division by zero")
|
||||
@ -493,8 +488,8 @@ BEGIN
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
@ -502,69 +497,42 @@ BEGIN
|
||||
END _error;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _isrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
ELSE
|
||||
t1 := -1
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _is;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r:t1 IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _guardrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
SYSTEM.GET(p, p);
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # t0) & (t1 # 0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
ELSE
|
||||
t1 := t0
|
||||
p := 1
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _guard;
|
||||
|
||||
|
||||
@ -613,18 +581,50 @@ BEGIN
|
||||
END _exit;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
||||
VAR
|
||||
t0, t1, i, j: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
|
||||
API.init(param, code);
|
||||
|
||||
types := _types;
|
||||
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
||||
ASSERT(types # 0);
|
||||
FOR i := 0 TO tcount - 1 DO
|
||||
FOR j := 0 TO tcount - 1 DO
|
||||
t0 := i; t1 := j;
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
|
||||
END;
|
||||
|
||||
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
||||
END
|
||||
END;
|
||||
|
||||
name := modname;
|
||||
|
||||
dll.process_detach := NIL;
|
||||
dll.thread_detach := NIL;
|
||||
dll.thread_attach := NIL;
|
||||
|
||||
fini := NIL
|
||||
END _init;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _sofinit*;
|
||||
BEGIN
|
||||
IF fini # NIL THEN
|
||||
fini
|
||||
END
|
||||
END _sofinit;
|
||||
|
||||
|
||||
PROCEDURE SetFini* (ProcFini: PROC);
|
||||
BEGIN
|
||||
fini := ProcFini
|
||||
END SetFini;
|
||||
|
||||
|
||||
END RTL.
|
@ -13,14 +13,16 @@ VAR
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
base*: INTEGER;
|
||||
heap: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
|
||||
|
||||
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
|
||||
@ -30,19 +32,22 @@ END DebugMsg;
|
||||
|
||||
|
||||
PROCEDURE _NEW* (size: INTEGER): INTEGER;
|
||||
RETURN Alloc(64, size)
|
||||
RETURN HeapAlloc(heap, 8, size)
|
||||
END _NEW;
|
||||
|
||||
|
||||
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
|
||||
RETURN Free(p)
|
||||
BEGIN
|
||||
HeapFree(heap, 0, p)
|
||||
RETURN 0
|
||||
END _DISPOSE;
|
||||
|
||||
|
||||
PROCEDURE init* (reserved, code: INTEGER);
|
||||
BEGIN
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
base := code - 4096
|
||||
base := code - 4096;
|
||||
heap := GetProcessHeap()
|
||||
END init;
|
||||
|
||||
|
||||
|
@ -10,7 +10,7 @@ MODULE RTL;
|
||||
IMPORT SYSTEM, API;
|
||||
|
||||
|
||||
CONST
|
||||
CONST
|
||||
|
||||
bit_depth* = 32;
|
||||
maxint* = 7FFFFFFFH;
|
||||
@ -22,11 +22,13 @@ CONST
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
MAX_SET = 31;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
|
||||
PROC = PROCEDURE;
|
||||
|
||||
|
||||
VAR
|
||||
@ -40,6 +42,8 @@ VAR
|
||||
thread_attach: DLL_ENTRY
|
||||
END;
|
||||
|
||||
fini: PROC;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
|
||||
BEGIN
|
||||
@ -107,18 +111,12 @@ BEGIN
|
||||
END _arrcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
|
||||
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
||||
END _strcpy2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
|
||||
VAR
|
||||
i, n, k: INTEGER;
|
||||
@ -137,32 +135,29 @@ BEGIN
|
||||
END _rot;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF (a <= b) & (a <= 31) & (b >= 0) THEN
|
||||
IF b > 31 THEN
|
||||
b := 31
|
||||
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
|
||||
IF b > MAX_SET THEN
|
||||
b := MAX_SET
|
||||
END;
|
||||
IF a < 0 THEN
|
||||
a := 0
|
||||
END;
|
||||
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
|
||||
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
|
||||
ELSE
|
||||
res := 0
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
|
||||
RETURN _set2(a, b)
|
||||
RETURN a
|
||||
END _set;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
||||
RETURN _set(b, a)
|
||||
END _set2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -185,7 +180,7 @@ BEGIN
|
||||
END divmod;
|
||||
|
||||
|
||||
PROCEDURE div_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -196,10 +191,10 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN div
|
||||
END div_;
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
|
||||
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
|
||||
VAR
|
||||
div, mod: INTEGER;
|
||||
|
||||
@ -210,29 +205,19 @@ BEGIN
|
||||
END
|
||||
|
||||
RETURN mod
|
||||
END mod_;
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
RETURN _div2(a, b)
|
||||
END _div;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
|
||||
RETURN div_(a, b)
|
||||
END _div2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
RETURN _mod2(a, b)
|
||||
END _mod;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
|
||||
RETURN mod_(a, b)
|
||||
END _mod2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
||||
BEGIN
|
||||
ptr := API._NEW(size);
|
||||
@ -251,50 +236,6 @@ BEGIN
|
||||
END _dispose;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.CODE(
|
||||
@ -345,16 +286,71 @@ BEGIN
|
||||
END _lengthw;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := minint;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
res := 0;
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmp(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _length(len1, str1) - _length(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -370,21 +366,25 @@ BEGIN
|
||||
END _strcmp;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmp(op, len2, str2, len1, str1)
|
||||
END _strcmp2;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
c: WCHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
res := strncmpw(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _lengthw(len1, str1) - _lengthw(len2, str2)
|
||||
IF res = minint THEN
|
||||
IF len1 > len2 THEN
|
||||
SYSTEM.GET(str1 + len2 * 2, c);
|
||||
res := ORD(c)
|
||||
ELSIF len1 < len2 THEN
|
||||
SYSTEM.GET(str2 + len1 * 2, c);
|
||||
res := -ORD(c)
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
@ -400,11 +400,6 @@ BEGIN
|
||||
END _strcmpw;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
|
||||
RETURN _strcmpw(op, len2, str2, len1, str1)
|
||||
END _strcmpw2;
|
||||
|
||||
|
||||
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
c: CHAR;
|
||||
@ -470,14 +465,14 @@ BEGIN
|
||||
END append;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _error* (module, err: INTEGER);
|
||||
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
|
||||
VAR
|
||||
s, temp: ARRAY 1024 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
|
||||
s := "";
|
||||
CASE err MOD 16 OF
|
||||
CASE err OF
|
||||
| 1: append(s, "assertion failure")
|
||||
| 2: append(s, "NIL dereference")
|
||||
| 3: append(s, "division by zero")
|
||||
@ -493,8 +488,8 @@ BEGIN
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
@ -502,69 +497,42 @@ BEGIN
|
||||
END _error;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _isrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
ELSE
|
||||
t1 := -1
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _is;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
|
||||
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* r:t1 IS t0 *)
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
SYSTEM.GET(t0 + t1 + types, t0)
|
||||
RETURN t0 MOD 2
|
||||
END _guardrec;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
t1: INTEGER;
|
||||
|
||||
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
(* p IS t0 *)
|
||||
SYSTEM.GET(p, p);
|
||||
IF p # 0 THEN
|
||||
DEC(p, SIZE_OF_DWORD);
|
||||
SYSTEM.GET(p, t1);
|
||||
WHILE (t1 # t0) & (t1 # 0) DO
|
||||
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
|
||||
END
|
||||
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
||||
SYSTEM.GET(t0 + p + types, p)
|
||||
ELSE
|
||||
t1 := t0
|
||||
p := 1
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
RETURN p MOD 2
|
||||
END _guard;
|
||||
|
||||
|
||||
@ -613,18 +581,50 @@ BEGIN
|
||||
END _exit;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
|
||||
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
||||
VAR
|
||||
t0, t1, i, j: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
|
||||
API.init(param, code);
|
||||
|
||||
types := _types;
|
||||
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
||||
ASSERT(types # 0);
|
||||
FOR i := 0 TO tcount - 1 DO
|
||||
FOR j := 0 TO tcount - 1 DO
|
||||
t0 := i; t1 := j;
|
||||
|
||||
WHILE (t1 # 0) & (t1 # t0) DO
|
||||
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
|
||||
END;
|
||||
|
||||
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
||||
END
|
||||
END;
|
||||
|
||||
name := modname;
|
||||
|
||||
dll.process_detach := NIL;
|
||||
dll.thread_detach := NIL;
|
||||
dll.thread_attach := NIL;
|
||||
|
||||
fini := NIL
|
||||
END _init;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] _sofinit*;
|
||||
BEGIN
|
||||
IF fini # NIL THEN
|
||||
fini
|
||||
END
|
||||
END _sofinit;
|
||||
|
||||
|
||||
PROCEDURE SetFini* (ProcFini: PROC);
|
||||
BEGIN
|
||||
fini := ProcFini
|
||||
END SetFini;
|
||||
|
||||
|
||||
END RTL.
|
File diff suppressed because it is too large
Load Diff
@ -7,7 +7,7 @@
|
||||
|
||||
MODULE ARITH;
|
||||
|
||||
IMPORT AVLTREES, STRINGS, MACHINE, UTILS;
|
||||
IMPORT AVLTREES, STRINGS, UTILS;
|
||||
|
||||
|
||||
CONST
|
||||
@ -53,10 +53,7 @@ BEGIN
|
||||
ELSIF v.typ = tWCHAR THEN
|
||||
res := v.int
|
||||
ELSIF v.typ = tSET THEN
|
||||
res := ORD(v.set);
|
||||
IF MACHINE._64to32 THEN
|
||||
res := MACHINE.Int32To64(res)
|
||||
END
|
||||
res := UTILS.Long(ORD(v.set))
|
||||
ELSIF v.typ = tBOOLEAN THEN
|
||||
res := ORD(v.bool)
|
||||
END
|
||||
@ -88,13 +85,13 @@ VAR
|
||||
BEGIN
|
||||
error := FALSE;
|
||||
|
||||
IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN
|
||||
IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN
|
||||
error := TRUE
|
||||
ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN
|
||||
error := TRUE
|
||||
ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN
|
||||
error := TRUE
|
||||
ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN
|
||||
ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN
|
||||
error := TRUE
|
||||
END
|
||||
|
||||
@ -172,7 +169,7 @@ BEGIN
|
||||
n := i
|
||||
END;
|
||||
|
||||
IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN
|
||||
IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
|
||||
error := 2
|
||||
ELSE
|
||||
value := value * 16 + d;
|
||||
@ -181,9 +178,7 @@ BEGIN
|
||||
|
||||
END;
|
||||
|
||||
IF MACHINE._64to32 THEN
|
||||
value := MACHINE.Int32To64(value);
|
||||
END;
|
||||
value := UTILS.Long(value);
|
||||
|
||||
IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
|
||||
error := 3
|
||||
@ -471,58 +466,53 @@ END mulInt;
|
||||
|
||||
|
||||
PROCEDURE _ASR (x, n: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF MACHINE._64to32 THEN
|
||||
x := MACHINE.Int32To64(x)
|
||||
END
|
||||
|
||||
RETURN ASR(x, n)
|
||||
RETURN ASR(UTILS.Long(x), n)
|
||||
END _ASR;
|
||||
|
||||
|
||||
PROCEDURE _LSR (x, n: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF MACHINE._64to32 THEN
|
||||
x := MACHINE.Int64To32(x);
|
||||
x := LSR(x, n);
|
||||
x := MACHINE.Int32To64(x)
|
||||
ELSE
|
||||
x := LSR(x, n)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
RETURN UTILS.Long(LSR(UTILS.Short(x), n))
|
||||
END _LSR;
|
||||
|
||||
|
||||
PROCEDURE _LSL (x, n: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
x := LSL(x, n);
|
||||
IF MACHINE._64to32 THEN
|
||||
x := MACHINE.Int32To64(x)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
RETURN UTILS.Long(LSL(x, n))
|
||||
END _LSL;
|
||||
|
||||
|
||||
PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
x := MACHINE.Int64To32(x);
|
||||
x := UTILS.Short(x);
|
||||
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
|
||||
RETURN MACHINE.Int32To64(x)
|
||||
RETURN UTILS.Long(x)
|
||||
END _ROR1_32;
|
||||
|
||||
|
||||
PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
x := x MOD 65536;
|
||||
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
|
||||
RETURN UTILS.Long(x)
|
||||
END _ROR1_16;
|
||||
|
||||
|
||||
PROCEDURE _ROR (x, n: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF MACHINE._64to32 THEN
|
||||
|
||||
CASE UTILS.bit_diff OF
|
||||
|0: x := ROR(x, n)
|
||||
|16, 48:
|
||||
n := n MOD 16;
|
||||
WHILE n > 0 DO
|
||||
x := _ROR1_16(x);
|
||||
DEC(n)
|
||||
END
|
||||
|32:
|
||||
n := n MOD 32;
|
||||
WHILE n > 0 DO
|
||||
x := _ROR1_32(x);
|
||||
DEC(n)
|
||||
END
|
||||
ELSE
|
||||
x := ROR(x, n)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
@ -587,11 +577,7 @@ BEGIN
|
||||
CASE v.typ OF
|
||||
|tCHAR, tWCHAR:
|
||||
|tBOOLEAN: v.int := ORD(v.bool)
|
||||
|tSET:
|
||||
v.int := ORD(v.set);
|
||||
IF MACHINE._64to32 THEN
|
||||
v.int := MACHINE.Int32To64(v.int)
|
||||
END
|
||||
|tSET: v.int := UTILS.Long(ORD(v.set))
|
||||
END;
|
||||
v.typ := tINTEGER
|
||||
END ord;
|
||||
@ -616,7 +602,7 @@ VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
res := FALSE;
|
||||
|
||||
CASE v.typ OF
|
||||
|tREAL:
|
||||
@ -627,8 +613,8 @@ BEGIN
|
||||
v.int := ABS(v.int);
|
||||
res := TRUE
|
||||
END
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END abs;
|
||||
|
||||
@ -787,7 +773,7 @@ BEGIN
|
||||
|
||||
|"I":
|
||||
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
|
||||
IF range(v, 0, MACHINE.target.maxSet) THEN
|
||||
IF range(v, 0, UTILS.target.maxSet) THEN
|
||||
res := v.int IN v2.set
|
||||
ELSE
|
||||
error := 2
|
||||
|
@ -1,11 +1,11 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE AVLTREES;
|
||||
MODULE AVLTREES;
|
||||
|
||||
IMPORT C := COLLECTIONS;
|
||||
|
||||
@ -39,7 +39,7 @@ VAR
|
||||
node: NODE;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
BEGIN
|
||||
citem := C.pop(nodes);
|
||||
IF citem = NIL THEN
|
||||
NEW(node)
|
||||
@ -181,8 +181,8 @@ BEGIN
|
||||
|
||||
IF destructor # NIL THEN
|
||||
destructor(node.data)
|
||||
END;
|
||||
|
||||
END;
|
||||
|
||||
C.push(nodes, node);
|
||||
node := NIL;
|
||||
|
||||
|
@ -7,7 +7,7 @@
|
||||
|
||||
MODULE BIN;
|
||||
|
||||
IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS;
|
||||
IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
|
||||
|
||||
|
||||
CONST
|
||||
@ -138,7 +138,10 @@ BEGIN
|
||||
END;
|
||||
|
||||
IF UTILS.bit_depth = 64 THEN
|
||||
x := MACHINE.Int32To64(x)
|
||||
x := LSL(x, 16);
|
||||
x := LSL(x, 16);
|
||||
x := ASR(x, 16);
|
||||
x := ASR(x, 16)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
@ -151,7 +154,7 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.SetByte(array, idx + i, MACHINE.Byte(x, i))
|
||||
CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
|
||||
END
|
||||
END put32le;
|
||||
|
||||
@ -162,7 +165,7 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.PushByte(program.data, MACHINE.Byte(x, i))
|
||||
CHL.PushByte(program.data, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutData32LE;
|
||||
|
||||
@ -173,7 +176,7 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 7 DO
|
||||
CHL.PushByte(program.data, MACHINE.Byte(x, i))
|
||||
CHL.PushByte(program.data, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutData64LE;
|
||||
|
||||
@ -203,7 +206,7 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.PushByte(program.code, MACHINE.Byte(x, i))
|
||||
CHL.PushByte(program.code, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutCode32LE;
|
||||
|
||||
@ -217,7 +220,6 @@ END SetLabel;
|
||||
PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
|
||||
VAR
|
||||
imp: IMPRT;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
CHL.PushByte(program.import, 0);
|
||||
@ -228,16 +230,9 @@ BEGIN
|
||||
END;
|
||||
|
||||
NEW(imp);
|
||||
imp.nameoffs := CHL.Length(program.import);
|
||||
imp.nameoffs := CHL.PushStr(program.import, name);
|
||||
imp.label := label;
|
||||
LISTS.push(program.imp_list, imp);
|
||||
|
||||
i := 0;
|
||||
WHILE name[i] # 0X DO
|
||||
CHL.PushByte(program.import, ORD(name[i]));
|
||||
INC(i)
|
||||
END;
|
||||
CHL.PushByte(program.import, 0)
|
||||
LISTS.push(program.imp_list, imp)
|
||||
END Import;
|
||||
|
||||
|
||||
@ -262,19 +257,11 @@ END less;
|
||||
PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
|
||||
VAR
|
||||
exp, cur: EXPRT;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
NEW(exp);
|
||||
exp.nameoffs := CHL.Length(program.export);
|
||||
exp.label := CHL.GetInt(program.labels, label);
|
||||
|
||||
i := 0;
|
||||
WHILE name[i] # 0X DO
|
||||
CHL.PushByte(program.export, ORD(name[i]));
|
||||
INC(i)
|
||||
END;
|
||||
CHL.PushByte(program.export, 0);
|
||||
exp.nameoffs := CHL.PushStr(program.export, name);
|
||||
|
||||
cur := program.exp_list.first(EXPRT);
|
||||
WHILE (cur # NIL) & less(program.export, cur, exp) DO
|
||||
@ -389,7 +376,7 @@ BEGIN
|
||||
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
|
||||
END;
|
||||
|
||||
idx := idx + k
|
||||
INC(idx, k)
|
||||
END InitArray;
|
||||
|
||||
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -118,11 +118,46 @@ BEGIN
|
||||
END PushByte;
|
||||
|
||||
|
||||
PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
|
||||
VAR
|
||||
i, res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := list.length;
|
||||
i := 0;
|
||||
REPEAT
|
||||
PushByte(list, ORD(str[i]));
|
||||
INC(i)
|
||||
UNTIL str[i - 1] = 0X
|
||||
|
||||
RETURN res
|
||||
END PushStr;
|
||||
|
||||
|
||||
PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
i := 0;
|
||||
WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
|
||||
str[i] := CHR(GetByte(list, pos));
|
||||
res := str[i] = 0X;
|
||||
INC(pos);
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END GetStr;
|
||||
|
||||
|
||||
PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST);
|
||||
VAR
|
||||
chunk: BYTECHUNK;
|
||||
|
||||
BEGIN
|
||||
BEGIN
|
||||
chunk := list.first(BYTECHUNK);
|
||||
WHILE chunk # NIL DO
|
||||
WR.Write(file, chunk.data, chunk.count);
|
||||
|
@ -1,12 +1,12 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE COLLECTIONS;
|
||||
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -23,29 +23,39 @@ BEGIN
|
||||
END String;
|
||||
|
||||
|
||||
PROCEDURE Int* (n: INTEGER);
|
||||
PROCEDURE Int* (x: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 32 OF CHAR;
|
||||
s: ARRAY 24 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
STRINGS.IntToStr(n, s);
|
||||
STRINGS.IntToStr(x, s);
|
||||
String(s)
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE Int2* (n: INTEGER);
|
||||
PROCEDURE Hex* (x, n: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 24 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
IF n < 10 THEN
|
||||
STRINGS.IntToHex(x, s, n);
|
||||
String(s)
|
||||
END Hex;
|
||||
|
||||
|
||||
PROCEDURE Int2* (x: INTEGER);
|
||||
BEGIN
|
||||
IF x < 10 THEN
|
||||
String("0")
|
||||
END;
|
||||
Int(n)
|
||||
Int(x)
|
||||
END Int2;
|
||||
|
||||
|
||||
PROCEDURE Ln*;
|
||||
BEGIN
|
||||
String(UTILS.eol)
|
||||
END Ln;
|
||||
END Ln;
|
||||
|
||||
|
||||
PROCEDURE StringLn* (s: ARRAY OF CHAR);
|
||||
@ -55,16 +65,16 @@ BEGIN
|
||||
END StringLn;
|
||||
|
||||
|
||||
PROCEDURE IntLn* (n: INTEGER);
|
||||
BEGIN
|
||||
Int(n);
|
||||
PROCEDURE IntLn* (x: INTEGER);
|
||||
BEGIN
|
||||
Int(x);
|
||||
Ln
|
||||
END IntLn;
|
||||
|
||||
|
||||
PROCEDURE Int2Ln* (n: INTEGER);
|
||||
BEGIN
|
||||
Int2(n);
|
||||
PROCEDURE Int2Ln* (x: INTEGER);
|
||||
BEGIN
|
||||
Int2(x);
|
||||
Ln
|
||||
END Int2Ln;
|
||||
|
||||
|
@ -9,8 +9,8 @@ MODULE CONSTANTS;
|
||||
|
||||
CONST
|
||||
|
||||
vMajor* = 0;
|
||||
vMinor* = 98;
|
||||
vMajor* = 1;
|
||||
vMinor* = 0;
|
||||
|
||||
FILE_EXT* = ".ob07";
|
||||
RTL_NAME* = "RTL";
|
||||
@ -26,7 +26,10 @@ CONST
|
||||
Target_iGUI64* = 7;
|
||||
Target_iDLL64* = 8;
|
||||
Target_iELF32* = 9;
|
||||
Target_iELF64* = 10;
|
||||
Target_iELFSO32* = 10;
|
||||
Target_iELF64* = 11;
|
||||
Target_iELFSO64* = 12;
|
||||
Target_iMSP430* = 13;
|
||||
|
||||
Target_sConsole* = "console";
|
||||
Target_sGUI* = "gui";
|
||||
@ -37,7 +40,10 @@ CONST
|
||||
Target_sGUI64* = "gui64";
|
||||
Target_sDLL64* = "dll64";
|
||||
Target_sELF32* = "elfexe";
|
||||
Target_sELFSO32* = "elfso";
|
||||
Target_sELF64* = "elfexe64";
|
||||
Target_sELFSO64* = "elfso64";
|
||||
Target_sMSP430* = "msp430";
|
||||
|
||||
|
||||
END CONSTANTS.
|
@ -7,7 +7,7 @@
|
||||
|
||||
MODULE Compiler;
|
||||
|
||||
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER;
|
||||
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430;
|
||||
|
||||
|
||||
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER;
|
||||
@ -33,8 +33,14 @@ BEGIN
|
||||
res := mConst.Target_iDLL64
|
||||
ELSIF s = mConst.Target_sELF32 THEN
|
||||
res := mConst.Target_iELF32
|
||||
ELSIF s = mConst.Target_sELFSO32 THEN
|
||||
res := mConst.Target_iELFSO32
|
||||
ELSIF s = mConst.Target_sELF64 THEN
|
||||
res := mConst.Target_iELF64
|
||||
ELSIF s = mConst.Target_sELFSO64 THEN
|
||||
res := mConst.Target_iELFSO64
|
||||
ELSIF s = mConst.Target_sMSP430 THEN
|
||||
res := mConst.Target_iMSP430
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
@ -43,7 +49,7 @@ BEGIN
|
||||
END Target;
|
||||
|
||||
|
||||
PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET);
|
||||
PROCEDURE keys (VAR options: PROG.OPTIONS);
|
||||
VAR
|
||||
param: PARS.PATH;
|
||||
i, j: INTEGER;
|
||||
@ -51,8 +57,10 @@ VAR
|
||||
value: INTEGER;
|
||||
minor,
|
||||
major: INTEGER;
|
||||
checking: SET;
|
||||
|
||||
BEGIN
|
||||
checking := options.checking;
|
||||
end := FALSE;
|
||||
i := 4;
|
||||
REPEAT
|
||||
@ -62,7 +70,7 @@ BEGIN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
|
||||
StackSize := value
|
||||
options.stack := value
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
@ -72,7 +80,27 @@ BEGIN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, value) THEN
|
||||
BaseAddress := ((value DIV 64) * 64) * 1024
|
||||
options.base := ((value DIV 64) * 64) * 1024
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
ELSIF param = "-ram" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, value) THEN
|
||||
options.ram := value
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
ELSIF param = "-rom" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, value) THEN
|
||||
options.rom := value
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
@ -109,32 +137,34 @@ BEGIN
|
||||
END;
|
||||
|
||||
INC(j)
|
||||
END
|
||||
END;
|
||||
|
||||
END
|
||||
|
||||
ELSIF param = "-ver" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToVer(param, major, minor) THEN
|
||||
Version := major * 65536 + minor
|
||||
options.version := major * 65536 + minor
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
ELSIF param = "-pic" THEN
|
||||
pic := TRUE
|
||||
options.pic := TRUE
|
||||
|
||||
ELSIF param = "" THEN
|
||||
end := TRUE
|
||||
|
||||
ELSE
|
||||
ERRORS.error3("bad parameter: ", param, "")
|
||||
ERRORS.BadParam(param)
|
||||
END;
|
||||
|
||||
INC(i)
|
||||
UNTIL end
|
||||
UNTIL end;
|
||||
|
||||
options.checking := checking
|
||||
END keys;
|
||||
|
||||
|
||||
@ -149,38 +179,34 @@ VAR
|
||||
outname: PARS.PATH;
|
||||
param: PARS.PATH;
|
||||
temp: PARS.PATH;
|
||||
|
||||
target: INTEGER;
|
||||
|
||||
bit_depth: INTEGER;
|
||||
time: INTEGER;
|
||||
|
||||
StackSize,
|
||||
Version,
|
||||
BaseAdr: INTEGER;
|
||||
pic: BOOLEAN;
|
||||
checking: SET;
|
||||
|
||||
bits64: BOOLEAN;
|
||||
options: PROG.OPTIONS;
|
||||
|
||||
BEGIN
|
||||
StackSize := 2;
|
||||
Version := 65536;
|
||||
pic := FALSE;
|
||||
checking := ST.chkALL;
|
||||
options.stack := 2;
|
||||
options.version := 65536;
|
||||
options.pic := FALSE;
|
||||
options.checking := ST.chkALL;
|
||||
|
||||
PATHS.GetCurrentDirectory(app_path);
|
||||
lib_path := app_path;
|
||||
|
||||
UTILS.GetArg(1, inname);
|
||||
|
||||
C.Ln;
|
||||
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
|
||||
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
|
||||
C.StringLn("Copyright (c) 2018-2019, Anton Krotov");
|
||||
|
||||
IF inname = "" THEN
|
||||
C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
|
||||
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln;
|
||||
C.Ln;
|
||||
C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln;
|
||||
IF UTILS.bit_depth = 64 THEN
|
||||
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln;
|
||||
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
|
||||
ELSIF UTILS.bit_depth = 32 THEN
|
||||
C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln;
|
||||
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
|
||||
END;
|
||||
C.StringLn("optional settings:"); C.Ln;
|
||||
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln;
|
||||
@ -188,14 +214,17 @@ BEGIN
|
||||
C.StringLn(' -ver <major.minor> set version of program'); C.Ln;
|
||||
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
|
||||
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln;
|
||||
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430)"); C.Ln;
|
||||
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430)"); C.Ln;
|
||||
UTILS.Exit(0)
|
||||
END;
|
||||
|
||||
PATHS.split(inname, path, modname, ext);
|
||||
|
||||
IF ext # mConst.FILE_EXT THEN
|
||||
ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
|
||||
ERRORS.Error(207)
|
||||
END;
|
||||
|
||||
IF PATHS.isRelative(path) THEN
|
||||
PATHS.RelPath(app_path, path, temp);
|
||||
path := temp
|
||||
@ -203,7 +232,7 @@ BEGIN
|
||||
|
||||
UTILS.GetArg(2, outname);
|
||||
IF outname = "" THEN
|
||||
ERRORS.error1("not enough parameters")
|
||||
ERRORS.Error(205)
|
||||
END;
|
||||
IF PATHS.isRelative(outname) THEN
|
||||
PATHS.RelPath(app_path, outname, temp);
|
||||
@ -212,59 +241,70 @@ BEGIN
|
||||
|
||||
UTILS.GetArg(3, param);
|
||||
IF param = "" THEN
|
||||
ERRORS.error1("not enough parameters")
|
||||
ERRORS.Error(205)
|
||||
END;
|
||||
|
||||
target := Target(param);
|
||||
|
||||
IF target = 0 THEN
|
||||
ERRORS.error1("bad parameter <target>")
|
||||
ERRORS.Error(206)
|
||||
END;
|
||||
|
||||
bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
|
||||
|
||||
IF bits64 THEN
|
||||
IF UTILS.bit_depth = 32 THEN
|
||||
ERRORS.error1("bad parameter <target>")
|
||||
END;
|
||||
PARS.init(64, target)
|
||||
ELSE
|
||||
PARS.init(32, target)
|
||||
CASE target OF
|
||||
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
|
||||
bit_depth := 64
|
||||
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
|
||||
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32:
|
||||
bit_depth := 32
|
||||
|mConst.Target_iMSP430:
|
||||
bit_depth := 16;
|
||||
options.ram := MSP430.minRAM;
|
||||
options.rom := MSP430.minROM
|
||||
END;
|
||||
|
||||
PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64};
|
||||
PARS.program.obj := target = mConst.Target_iObject;
|
||||
IF UTILS.bit_depth < bit_depth THEN
|
||||
ERRORS.Error(206)
|
||||
END;
|
||||
|
||||
STRINGS.append(lib_path, "lib");
|
||||
STRINGS.append(lib_path, UTILS.slash);
|
||||
|
||||
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
|
||||
CASE target OF
|
||||
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
|
||||
IF target = mConst.Target_iDLL THEN
|
||||
BaseAdr := 10000000H
|
||||
options.base := 10000000H
|
||||
ELSE
|
||||
BaseAdr := 400000H
|
||||
options.base := 400000H
|
||||
END;
|
||||
STRINGS.append(lib_path, "Windows32")
|
||||
|
||||
ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN
|
||||
|mConst.Target_iKolibri, mConst.Target_iObject:
|
||||
STRINGS.append(lib_path, "KolibriOS")
|
||||
|
||||
ELSIF target = mConst.Target_iELF32 THEN
|
||||
|mConst.Target_iELF32, mConst.Target_iELFSO32:
|
||||
STRINGS.append(lib_path, "Linux32")
|
||||
|
||||
ELSIF target = mConst.Target_iELF64 THEN
|
||||
|mConst.Target_iELF64, mConst.Target_iELFSO64:
|
||||
STRINGS.append(lib_path, "Linux64")
|
||||
|
||||
ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
|
||||
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64:
|
||||
STRINGS.append(lib_path, "Windows64")
|
||||
|
||||
|mConst.Target_iMSP430:
|
||||
STRINGS.append(lib_path, "MSP430")
|
||||
|
||||
END;
|
||||
|
||||
STRINGS.append(lib_path, UTILS.slash);
|
||||
|
||||
keys(StackSize, BaseAdr, Version, pic, checking);
|
||||
keys(options);
|
||||
|
||||
ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking);
|
||||
PARS.init(bit_depth, target, options);
|
||||
|
||||
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
|
||||
PARS.program.obj := target = mConst.Target_iObject;
|
||||
|
||||
ST.compile(path, lib_path, modname, outname, target, options);
|
||||
|
||||
time := UTILS.GetTickCount() - UTILS.time;
|
||||
|
||||
|
@ -7,7 +7,7 @@
|
||||
|
||||
MODULE ELF;
|
||||
|
||||
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS;
|
||||
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
|
||||
|
||||
|
||||
CONST
|
||||
@ -68,9 +68,35 @@ TYPE
|
||||
|
||||
END;
|
||||
|
||||
|
||||
Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
d_tag, d_val: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
name, value, size: INTEGER;
|
||||
info, other: CHAR;
|
||||
shndx: WCHAR
|
||||
|
||||
END;
|
||||
|
||||
|
||||
FILE = WR.FILE;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
dynamic: LISTS.LIST;
|
||||
strtab: CHL.BYTELIST;
|
||||
symtab: LISTS.LIST;
|
||||
|
||||
hashtab, bucket, chain: CHL.INTLIST;
|
||||
|
||||
|
||||
PROCEDURE align (n, _align: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF n MOD _align # 0 THEN
|
||||
@ -136,7 +162,75 @@ BEGIN
|
||||
END fixup;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN);
|
||||
PROCEDURE NewDyn (tag, val: INTEGER);
|
||||
VAR
|
||||
dyn: Elf32_Dyn;
|
||||
|
||||
BEGIN
|
||||
NEW(dyn);
|
||||
dyn.d_tag := tag;
|
||||
dyn.d_val := val;
|
||||
LISTS.push(dynamic, dyn)
|
||||
END NewDyn;
|
||||
|
||||
|
||||
PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
|
||||
VAR
|
||||
sym: Elf32_Sym;
|
||||
|
||||
BEGIN
|
||||
NEW(sym);
|
||||
sym.name := name;
|
||||
sym.value := value;
|
||||
sym.size := size;
|
||||
sym.info := info;
|
||||
sym.other := other;
|
||||
sym.shndx := shndx;
|
||||
|
||||
LISTS.push(symtab, sym)
|
||||
END NewSym;
|
||||
|
||||
|
||||
PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
|
||||
VAR
|
||||
i, h: INTEGER;
|
||||
g: SET;
|
||||
|
||||
BEGIN
|
||||
h := 0;
|
||||
i := 0;
|
||||
WHILE name[i] # 0X DO
|
||||
h := h * 16 + ORD(name[i]);
|
||||
g := BITS(h) * {28..31};
|
||||
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN h
|
||||
END HashStr;
|
||||
|
||||
|
||||
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
|
||||
VAR
|
||||
symi, hi, k: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR symi := 0 TO symCount - 1 DO
|
||||
CHL.SetInt(chain, symi, 0);
|
||||
hi := CHL.GetInt(hashtab, symi) MOD symCount;
|
||||
IF CHL.GetInt(bucket, hi) # 0 THEN
|
||||
k := symi;
|
||||
WHILE CHL.GetInt(chain, k) # 0 DO
|
||||
k := CHL.GetInt(chain, k)
|
||||
END;
|
||||
CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
|
||||
END;
|
||||
CHL.SetInt(bucket, hi, symi)
|
||||
END
|
||||
END MakeHash;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
|
||||
CONST
|
||||
interp = 0;
|
||||
dyn = 1;
|
||||
@ -145,33 +239,67 @@ CONST
|
||||
data = 4;
|
||||
bss = 5;
|
||||
|
||||
linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
|
||||
linuxInterpreter32 = "/lib/ld-linux.so.2";
|
||||
|
||||
exeBaseAddress32 = 8048000H;
|
||||
exeBaseAddress64 = 400000H;
|
||||
dllBaseAddress = 0;
|
||||
|
||||
DT_NULL = 0;
|
||||
DT_NEEDED = 1;
|
||||
DT_HASH = 4;
|
||||
DT_STRTAB = 5;
|
||||
DT_SYMTAB = 6;
|
||||
DT_RELA = 7;
|
||||
DT_RELASZ = 8;
|
||||
DT_RELAENT = 9;
|
||||
DT_STRSZ = 10;
|
||||
DT_SYMENT = 11;
|
||||
DT_INIT = 12;
|
||||
DT_FINI = 13;
|
||||
DT_SONAME = 14;
|
||||
DT_REL = 17;
|
||||
DT_RELSZ = 18;
|
||||
DT_RELENT = 19;
|
||||
|
||||
VAR
|
||||
ehdr: Elf32_Ehdr;
|
||||
phdr: ARRAY 16 OF Elf32_Phdr;
|
||||
|
||||
i, LoadAdr, offset, pad, VA: INTEGER;
|
||||
i, BaseAdr, offset, pad, VA, symCount: INTEGER;
|
||||
|
||||
SizeOf: RECORD header, code, data, bss: INTEGER END;
|
||||
|
||||
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
|
||||
|
||||
File: FILE;
|
||||
|
||||
str: ARRAY 40 OF CHAR; lstr: INTEGER;
|
||||
Dyn: ARRAY 350 OF BYTE;
|
||||
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
|
||||
|
||||
item: LISTS.ITEM;
|
||||
|
||||
Name: ARRAY 2048 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
IF amd64 THEN
|
||||
str := "/lib64/ld-linux-x86-64.so.2"
|
||||
ELSE
|
||||
str := "/lib/ld-linux.so.2"
|
||||
END;
|
||||
lstr := LENGTH(str);
|
||||
dynamic := LISTS.create(NIL);
|
||||
symtab := LISTS.create(NIL);
|
||||
strtab := CHL.CreateByteList();
|
||||
|
||||
IF amd64 THEN
|
||||
LoadAdr := 400000H
|
||||
BaseAdr := exeBaseAddress64;
|
||||
Interpreter := linuxInterpreter64
|
||||
ELSE
|
||||
LoadAdr := 08048000H
|
||||
BaseAdr := exeBaseAddress32;
|
||||
Interpreter := linuxInterpreter32
|
||||
END;
|
||||
|
||||
IF so THEN
|
||||
BaseAdr := dllBaseAddress
|
||||
END;
|
||||
|
||||
lenInterpreter := LENGTH(Interpreter) + 1;
|
||||
|
||||
SizeOf.code := CHL.Length(program.code);
|
||||
SizeOf.data := CHL.Length(program.data);
|
||||
SizeOf.bss := program.bss;
|
||||
@ -192,7 +320,12 @@ BEGIN
|
||||
ehdr.e_ident[i] := 0
|
||||
END;
|
||||
|
||||
ehdr.e_type := WCHR(ET_EXEC);
|
||||
IF so THEN
|
||||
ehdr.e_type := WCHR(ET_DYN)
|
||||
ELSE
|
||||
ehdr.e_type := WCHR(ET_EXEC)
|
||||
END;
|
||||
|
||||
ehdr.e_version := 1;
|
||||
ehdr.e_shoff := 0;
|
||||
ehdr.e_flags := 0;
|
||||
@ -218,24 +351,92 @@ BEGIN
|
||||
|
||||
phdr[interp].p_type := 3;
|
||||
phdr[interp].p_offset := SizeOf.header;
|
||||
phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset;
|
||||
phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset;
|
||||
phdr[interp].p_filesz := lstr + 1;
|
||||
phdr[interp].p_memsz := lstr + 1;
|
||||
phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
|
||||
phdr[interp].p_paddr := phdr[interp].p_vaddr;
|
||||
phdr[interp].p_filesz := lenInterpreter;
|
||||
phdr[interp].p_memsz := lenInterpreter;
|
||||
phdr[interp].p_flags := PF_R;
|
||||
phdr[interp].p_align := 1;
|
||||
|
||||
phdr[dyn].p_type := 2;
|
||||
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
|
||||
phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset;
|
||||
phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset;
|
||||
IF amd64 THEN
|
||||
phdr[dyn].p_filesz := 0A0H;
|
||||
phdr[dyn].p_memsz := 0A0H
|
||||
ELSE
|
||||
phdr[dyn].p_filesz := 50H;
|
||||
phdr[dyn].p_memsz := 50H
|
||||
phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
|
||||
phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
|
||||
|
||||
hashtab := CHL.CreateIntList();
|
||||
|
||||
CHL.PushInt(hashtab, HashStr(""));
|
||||
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
|
||||
CHL.PushInt(hashtab, HashStr("dlopen"));
|
||||
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
|
||||
CHL.PushInt(hashtab, HashStr("dlsym"));
|
||||
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
|
||||
|
||||
IF so THEN
|
||||
item := program.exp_list.first;
|
||||
WHILE item # NIL DO
|
||||
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
|
||||
CHL.PushInt(hashtab, HashStr(Name));
|
||||
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
|
||||
item := item.next
|
||||
END;
|
||||
ASSERT(CHL.GetStr(program.data, program.modname, Name))
|
||||
END;
|
||||
|
||||
symCount := LISTS.count(symtab);
|
||||
|
||||
bucket := CHL.CreateIntList();
|
||||
chain := CHL.CreateIntList();
|
||||
|
||||
FOR i := 1 TO symCount DO
|
||||
CHL.PushInt(bucket, 0);
|
||||
CHL.PushInt(chain, 0)
|
||||
END;
|
||||
|
||||
MakeHash(bucket, chain, symCount);
|
||||
|
||||
NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
|
||||
NewDyn(DT_STRTAB, 0);
|
||||
NewDyn(DT_STRSZ, CHL.Length(strtab));
|
||||
NewDyn(DT_SYMTAB, 0);
|
||||
|
||||
IF amd64 THEN
|
||||
NewDyn(DT_SYMENT, 24);
|
||||
NewDyn(DT_RELA, 0);
|
||||
NewDyn(DT_RELASZ, 48);
|
||||
NewDyn(DT_RELAENT, 24)
|
||||
ELSE
|
||||
NewDyn(DT_SYMENT, 16);
|
||||
NewDyn(DT_REL, 0);
|
||||
NewDyn(DT_RELSZ, 16);
|
||||
NewDyn(DT_RELENT, 8)
|
||||
END;
|
||||
|
||||
NewDyn(DT_HASH, 0);
|
||||
|
||||
IF so THEN
|
||||
NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
|
||||
NewDyn(DT_INIT, 0);
|
||||
NewDyn(DT_FINI, 0)
|
||||
END;
|
||||
|
||||
NewDyn(DT_NULL, 0);
|
||||
|
||||
Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
|
||||
Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
|
||||
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
|
||||
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
|
||||
|
||||
Offset.dyn := phdr[dyn].p_offset;
|
||||
|
||||
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr;
|
||||
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr;
|
||||
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr;
|
||||
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr;
|
||||
|
||||
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
|
||||
phdr[dyn].p_memsz := phdr[dyn].p_filesz;
|
||||
|
||||
phdr[dyn].p_flags := PF_R;
|
||||
phdr[dyn].p_align := 1;
|
||||
|
||||
@ -243,20 +444,15 @@ BEGIN
|
||||
|
||||
phdr[header].p_type := 1;
|
||||
phdr[header].p_offset := offset;
|
||||
phdr[header].p_vaddr := LoadAdr;
|
||||
phdr[header].p_paddr := LoadAdr;
|
||||
IF amd64 THEN
|
||||
phdr[header].p_filesz := 305H;
|
||||
phdr[header].p_memsz := 305H
|
||||
ELSE
|
||||
phdr[header].p_filesz := 1D0H;
|
||||
phdr[header].p_memsz := 1D0H
|
||||
END;
|
||||
phdr[header].p_vaddr := BaseAdr;
|
||||
phdr[header].p_paddr := BaseAdr;
|
||||
phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
|
||||
phdr[header].p_memsz := phdr[header].p_filesz;
|
||||
phdr[header].p_flags := PF_R + PF_W;
|
||||
phdr[header].p_align := 1000H;
|
||||
|
||||
|
||||
offset := offset + phdr[header].p_filesz;
|
||||
VA := LoadAdr + offset + 1000H;
|
||||
VA := BaseAdr + offset + 1000H;
|
||||
|
||||
phdr[text].p_type := 1;
|
||||
phdr[text].p_offset := offset;
|
||||
@ -268,9 +464,9 @@ BEGIN
|
||||
phdr[text].p_align := 1000H;
|
||||
|
||||
ehdr.e_entry := phdr[text].p_vaddr;
|
||||
|
||||
|
||||
offset := offset + phdr[text].p_filesz;
|
||||
VA := LoadAdr + offset + 2000H;
|
||||
VA := BaseAdr + offset + 2000H;
|
||||
pad := (16 - VA MOD 16) MOD 16;
|
||||
|
||||
phdr[data].p_type := 1;
|
||||
@ -281,9 +477,9 @@ BEGIN
|
||||
phdr[data].p_memsz := SizeOf.data + pad;
|
||||
phdr[data].p_flags := PF_R + PF_W;
|
||||
phdr[data].p_align := 1000H;
|
||||
|
||||
|
||||
offset := offset + phdr[data].p_filesz;
|
||||
VA := LoadAdr + offset + 3000H;
|
||||
VA := BaseAdr + offset + 3000H;
|
||||
|
||||
phdr[bss].p_type := 1;
|
||||
phdr[bss].p_offset := offset;
|
||||
@ -294,7 +490,20 @@ BEGIN
|
||||
phdr[bss].p_flags := PF_R + PF_W;
|
||||
phdr[bss].p_align := 1000H;
|
||||
|
||||
fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
|
||||
fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
|
||||
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
IF item(Elf32_Sym).value # 0 THEN
|
||||
INC(item(Elf32_Sym).value, ehdr.e_entry)
|
||||
END;
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
IF so THEN
|
||||
item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
|
||||
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
|
||||
END;
|
||||
|
||||
File := WR.Create(FileName);
|
||||
|
||||
@ -340,34 +549,94 @@ BEGIN
|
||||
WritePH(File, phdr[bss])
|
||||
END;
|
||||
|
||||
FOR i := 0 TO lstr DO
|
||||
WR.WriteByte(File, ORD(str[i]))
|
||||
FOR i := 0 TO lenInterpreter - 1 DO
|
||||
WR.WriteByte(File, ORD(Interpreter[i]))
|
||||
END;
|
||||
|
||||
i := 0;
|
||||
IF amd64 THEN
|
||||
BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000");
|
||||
BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000");
|
||||
BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000");
|
||||
BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000");
|
||||
BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000");
|
||||
BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000");
|
||||
BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000");
|
||||
BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000");
|
||||
BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000");
|
||||
BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69");
|
||||
BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000")
|
||||
ELSE
|
||||
BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408");
|
||||
BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000");
|
||||
BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000");
|
||||
BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000");
|
||||
BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000");
|
||||
BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32");
|
||||
BIN.InitArray(Dyn, i, "000000000000000000")
|
||||
END;
|
||||
item := dynamic.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write64LE(File, item(Elf32_Dyn).d_tag);
|
||||
WR.Write64LE(File, item(Elf32_Dyn).d_val);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
WR.Write(File, Dyn, i);
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(File, item(Elf32_Sym).name);
|
||||
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
|
||||
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
|
||||
Write16(File, item(Elf32_Sym).shndx);
|
||||
WR.Write64LE(File, item(Elf32_Sym).value);
|
||||
WR.Write64LE(File, item(Elf32_Sym).size);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16);
|
||||
WR.Write32LE(File, 1);
|
||||
WR.Write32LE(File, 1);
|
||||
WR.Write64LE(File, 0);
|
||||
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
|
||||
WR.Write32LE(File, 1);
|
||||
WR.Write32LE(File, 2);
|
||||
WR.Write64LE(File, 0);
|
||||
|
||||
WR.Write32LE(File, symCount);
|
||||
WR.Write32LE(File, symCount);
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(File, CHL.GetInt(bucket, i))
|
||||
END;
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(File, CHL.GetInt(chain, i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(File, strtab);
|
||||
WR.Write64LE(File, 0);
|
||||
WR.Write64LE(File, 0)
|
||||
|
||||
ELSE
|
||||
item := dynamic.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(File, item(Elf32_Dyn).d_tag);
|
||||
WR.Write32LE(File, item(Elf32_Dyn).d_val);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(File, item(Elf32_Sym).name);
|
||||
WR.Write32LE(File, item(Elf32_Sym).value);
|
||||
WR.Write32LE(File, item(Elf32_Sym).size);
|
||||
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
|
||||
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
|
||||
Write16(File, item(Elf32_Sym).shndx);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
|
||||
WR.Write32LE(File, 00000101H);
|
||||
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4);
|
||||
WR.Write32LE(File, 00000201H);
|
||||
|
||||
WR.Write32LE(File, symCount);
|
||||
WR.Write32LE(File, symCount);
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(File, CHL.GetInt(bucket, i))
|
||||
END;
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(File, CHL.GetInt(chain, i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(File, strtab);
|
||||
WR.Write32LE(File, 0);
|
||||
WR.Write32LE(File, 0)
|
||||
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(File, program.code);
|
||||
WHILE pad > 0 DO
|
||||
|
@ -7,25 +7,35 @@
|
||||
|
||||
MODULE ERRORS;
|
||||
|
||||
IMPORT C := CONSOLE, UTILS;
|
||||
IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS;
|
||||
|
||||
|
||||
PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
|
||||
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
|
||||
BEGIN
|
||||
IF hint = 0 THEN
|
||||
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")");
|
||||
C.String(" variable '"); C.String(name); C.StringLn("' never used")
|
||||
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
C.String("variable '"); C.String(name); C.StringLn("' never used")
|
||||
END
|
||||
END hintmsg;
|
||||
END HintMsg;
|
||||
|
||||
|
||||
PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
|
||||
PROCEDURE WarningMsg* (line, col, warning: INTEGER);
|
||||
BEGIN
|
||||
C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
CASE warning OF
|
||||
|0: C.StringLn("passing a string value as a fixed array")
|
||||
|1: C.StringLn("endless FOR loop")
|
||||
END
|
||||
END WarningMsg;
|
||||
|
||||
|
||||
PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
|
||||
VAR
|
||||
str: ARRAY 80 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
|
||||
CASE errno OF
|
||||
| 1: str := "missing 'H' or 'X'"
|
||||
@ -36,6 +46,7 @@ BEGIN
|
||||
| 6: str := "identifier too long"
|
||||
| 7: str := "number too long"
|
||||
| 8..12: str := "number too large"
|
||||
| 13: str := "real numbers not supported"
|
||||
|
||||
| 21: str := "'MODULE' expected"
|
||||
| 22: str := "identifier expected"
|
||||
@ -79,7 +90,7 @@ BEGIN
|
||||
| 60: str := "identifier does not match procedure name"
|
||||
| 61: str := "illegally marked identifier"
|
||||
| 62: str := "expression should be constant"
|
||||
| 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected"
|
||||
| 63: str := "not enough RAM"
|
||||
| 64: str := "'(' expected"
|
||||
| 65: str := "',' expected"
|
||||
| 66: str := "incompatible parameter"
|
||||
@ -126,46 +137,81 @@ BEGIN
|
||||
|107: str := "too large parameter of CHR"
|
||||
|108: str := "a variable or a procedure expected"
|
||||
|109: str := "expression should be constant"
|
||||
|110: str := "'noalign' expected"
|
||||
|
||||
|111: str := "record [noalign] cannot have a base type"
|
||||
|112: str := "record [noalign] cannot be a base type"
|
||||
|113: str := "result type of procedure should not be REAL"
|
||||
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|
||||
|115: str := "recursive constant definition"
|
||||
|116: str := "procedure too deep nested"
|
||||
|117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected"
|
||||
|118: str := "this flag for Windows only"
|
||||
|119: str := "this flag for Linux only"
|
||||
|
||||
|120: str := "too many formal parameters"
|
||||
|
||||
|122: str := "negative divisor"
|
||||
|123: str := "illegal flag"
|
||||
|124: str := "unknown flag"
|
||||
|125: str := "flag not supported"
|
||||
END;
|
||||
C.StringLn(str);
|
||||
C.String(" file: "); C.StringLn(fname);
|
||||
UTILS.Exit(1)
|
||||
END errormsg;
|
||||
END ErrorMsg;
|
||||
|
||||
|
||||
PROCEDURE error1* (s1: ARRAY OF CHAR);
|
||||
PROCEDURE Error1 (s1: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.StringLn(s1);
|
||||
UTILS.Exit(1)
|
||||
END error1;
|
||||
END Error1;
|
||||
|
||||
|
||||
PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR);
|
||||
PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(s1); C.String(s2); C.StringLn(s3);
|
||||
UTILS.Exit(1)
|
||||
END error3;
|
||||
END Error3;
|
||||
|
||||
|
||||
PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR);
|
||||
PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
|
||||
UTILS.Exit(1)
|
||||
END error5;
|
||||
END Error5;
|
||||
|
||||
|
||||
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found")
|
||||
END WrongRTL;
|
||||
|
||||
|
||||
PROCEDURE BadParam* (param: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error3("bad parameter: ", param, "")
|
||||
END BadParam;
|
||||
|
||||
|
||||
PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error5("file ", Path, Name, Ext, " not found")
|
||||
END FileNotFound;
|
||||
|
||||
|
||||
PROCEDURE Error* (n: INTEGER);
|
||||
BEGIN
|
||||
CASE n OF
|
||||
|201: Error1("writing file error")
|
||||
|202: Error1("too many relocations")
|
||||
|203: Error1("size of program is too large")
|
||||
|204: Error1("size of global variables is too large")
|
||||
|205: Error1("not enough parameters")
|
||||
|206: Error1("bad parameter <target>")
|
||||
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
|
||||
END
|
||||
END Error;
|
||||
|
||||
|
||||
END ERRORS.
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
|
1182
programs/develop/oberon07/Source/IL.ob07
Normal file
1182
programs/develop/oberon07/Source/IL.ob07
Normal file
File diff suppressed because it is too large
Load Diff
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -197,7 +197,7 @@ BEGIN
|
||||
WR.Write32LE(File, header.sp);
|
||||
WR.Write32LE(File, header.param);
|
||||
WR.Write32LE(File, header.path);
|
||||
|
||||
|
||||
CHL.WriteToFile(File, program.code);
|
||||
WR.Padding(File, FileAlignment);
|
||||
|
||||
@ -206,8 +206,8 @@ BEGIN
|
||||
|
||||
FOR i := 0 TO ILen - 1 DO
|
||||
WR.Write32LE(File, CHL.GetInt(ImportTable, i))
|
||||
END;
|
||||
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(File, program.import);
|
||||
|
||||
WR.Close(File)
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -168,14 +168,32 @@ BEGIN
|
||||
END count;
|
||||
|
||||
|
||||
PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
|
||||
VAR
|
||||
item: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(idx >= 0);
|
||||
|
||||
item := list.first;
|
||||
WHILE (item # NIL) & (idx > 0) DO
|
||||
item := item.next;
|
||||
DEC(idx)
|
||||
END
|
||||
|
||||
RETURN item
|
||||
END getidx;
|
||||
|
||||
|
||||
PROCEDURE create* (list: LIST): LIST;
|
||||
BEGIN
|
||||
IF list = NIL THEN
|
||||
NEW(list)
|
||||
END;
|
||||
|
||||
list.first := NIL;
|
||||
list.last := NIL
|
||||
list.first := NIL;
|
||||
list.last := NIL
|
||||
|
||||
RETURN list
|
||||
END create;
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -136,7 +136,7 @@ VAR
|
||||
PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
|
||||
BEGIN
|
||||
IF NumberOfRelocations >= 65536 THEN
|
||||
ERRORS.error1("too many relocations")
|
||||
ERRORS.Error(202)
|
||||
END;
|
||||
section.NumberOfRelocations := WCHR(NumberOfRelocations)
|
||||
END SetNumberOfRelocations;
|
||||
|
1793
programs/develop/oberon07/Source/MSP430.ob07
Normal file
1793
programs/develop/oberon07/Source/MSP430.ob07
Normal file
File diff suppressed because it is too large
Load Diff
677
programs/develop/oberon07/Source/MSP430RTL.ob07
Normal file
677
programs/develop/oberon07/Source/MSP430RTL.ob07
Normal file
@ -0,0 +1,677 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE MSP430RTL;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
_mul* = 0;
|
||||
_divmod* = 1;
|
||||
_lsl* = 2;
|
||||
_asr* = 3;
|
||||
_ror* = 4;
|
||||
_lsr* = 5;
|
||||
_in* = 6;
|
||||
_in2* = 7;
|
||||
_set1* = 8;
|
||||
_incl* = 9;
|
||||
_excl* = 10;
|
||||
_move* = 11;
|
||||
_set* = 12;
|
||||
_arrcpy* = 13;
|
||||
_rot* = 14;
|
||||
_strcmp* = 15;
|
||||
_error* = 16;
|
||||
_is* = 17;
|
||||
_guard* = 18;
|
||||
_guardrec* = 19;
|
||||
_length* = 20;
|
||||
_new* = 21;
|
||||
|
||||
|
||||
HP = 14;
|
||||
|
||||
LenIV* = 32;
|
||||
|
||||
iv = 10000H - LenIV * 2;
|
||||
sp = iv - 2;
|
||||
empty_proc* = sp - 2;
|
||||
free_size = empty_proc - 2;
|
||||
free_adr = free_size - 2;
|
||||
bits = free_adr - 272;
|
||||
bits_offs = bits - 32;
|
||||
DataSize* = iv - bits_offs;
|
||||
types = bits_offs - 2;
|
||||
|
||||
IntVectorSize* = LenIV * 2 + DataSize;
|
||||
|
||||
VarSize* = 4;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
EMITPROC = PROCEDURE (n: INTEGER);
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
ram*, trap*, int*: INTEGER;
|
||||
|
||||
rtl*: ARRAY 22 OF
|
||||
RECORD
|
||||
label*: INTEGER;
|
||||
used: BOOLEAN
|
||||
END;
|
||||
|
||||
Label, Word, Call: EMITPROC;
|
||||
|
||||
|
||||
PROCEDURE Gen*;
|
||||
|
||||
|
||||
PROCEDURE Word1 (word: INTEGER);
|
||||
BEGIN
|
||||
Word(word)
|
||||
END Word1;
|
||||
|
||||
|
||||
PROCEDURE Word2 (word1, word2: INTEGER);
|
||||
BEGIN
|
||||
Word1(word1);
|
||||
Word1(word2)
|
||||
END Word2;
|
||||
|
||||
|
||||
PROCEDURE Word3 (word1, word2, word3: INTEGER);
|
||||
BEGIN
|
||||
Word1(word1);
|
||||
Word1(word2);
|
||||
Word1(word3)
|
||||
END Word3;
|
||||
|
||||
|
||||
BEGIN
|
||||
(* _lsl (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_lsl].used THEN
|
||||
Label(rtl[_lsl].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 3); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _asr (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_asr].used THEN
|
||||
Label(rtl[_asr].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(1104H); (* RRA R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 3); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _ror (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_ror].used THEN
|
||||
Label(rtl[_ror].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 5); (* JZ L1 *)
|
||||
Word1(4406H); (* MOV R4, R6 *)
|
||||
(* L2: *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(1004H); (* RRC R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 4); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _lsr (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_lsr].used THEN
|
||||
Label(rtl[_lsr].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 4); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1004H); (* RRC R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 4); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _set (b, a: INTEGER): SET *)
|
||||
IF rtl[_set].used THEN
|
||||
Label(rtl[_set].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
|
||||
Word1(9504H); (* CMP R5, R4 *)
|
||||
Word1(3800H + 24); (* JL L1 *)
|
||||
Word2(9035H, 16); (* CMP #16, R5 *)
|
||||
Word1(3400H + 21); (* JGE L1 *)
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(3800H + 19); (* JL L1 *)
|
||||
Word2(9034H, 16); (* CMP #16, R4 *)
|
||||
Word1(3800H + 2); (* JL L2 *)
|
||||
Word2(4034H, 15); (* MOV #15, R4 *)
|
||||
(* L2: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(3400H + 1); (* JGE L3 *)
|
||||
Word1(4305H); (* MOV #0, R5 *)
|
||||
(* L3: *)
|
||||
Word1(8504H); (* SUB R5, R4 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits_offs); (* ADD bits_offs, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(5405H); (* ADD R4, R5 *)
|
||||
Word2(5035H, bits); (* ADD bits, R5 *)
|
||||
Word1(4524H); (* MOV @R5, R4 *)
|
||||
Word1(4130H); (* MOV @SP+, PC *)
|
||||
(* L1: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _set1 (a: INTEGER): SET *)
|
||||
IF rtl[_set1].used THEN
|
||||
Label(rtl[_set1].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 5); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word1(4130H); (* MOV @SP+, PC *)
|
||||
(* L1: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _in2 (i, s: INTEGER): BOOLEAN *)
|
||||
IF rtl[_in2].used THEN
|
||||
Label(rtl[_in2].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(0F114H, 4); (* AND 4(SP), R4 *)
|
||||
Word1(2400H + 1); (* JZ L1 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _in (s, i: INTEGER): BOOLEAN *)
|
||||
IF rtl[_in].used THEN
|
||||
Label(rtl[_in].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 9); (* JNZ L2 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(0F114H, 2); (* AND 2(SP), R4 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H); (* MOV @SP+, PC *)
|
||||
(* L2: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _incl (VAR s: SET; i: INTEGER) *)
|
||||
IF rtl[_incl].used THEN
|
||||
Label(rtl[_incl].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 8); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
|
||||
Word2(0D485H, 0); (* BIS R4, 0(R5) *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _excl (VAR s: SET; i: INTEGER) *)
|
||||
IF rtl[_excl].used THEN
|
||||
Label(rtl[_excl].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 8); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
|
||||
Word2(0C485H, 0); (* BIC R4, 0(R5) *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _rot (len, adr: INTEGER) *)
|
||||
IF rtl[_rot].used THEN
|
||||
Label(rtl[_rot].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *)
|
||||
Word1(8314H); (* SUB #1, R4 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word1(1225H); (* PUSH @R5 *)
|
||||
Word1(4406H); (* MOV R4, R6 *)
|
||||
(* L1: *)
|
||||
Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *)
|
||||
Word1(5325H); (* ADD #2, R5 *)
|
||||
Word1(8326H); (* SUB #2, R6 *)
|
||||
Word1(2000H + 400H - 6); (* JNZ L1 *)
|
||||
Word2(41B5H, 0); (* MOV @SP+, 0(R5) *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *)
|
||||
IF rtl[_divmod].used THEN
|
||||
Label(rtl[_divmod].label);
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L1: *)
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 17); (* JL L3 *)
|
||||
Word1(4327H); (* MOV #2, R7 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
(* L4: *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 6); (* JZ L2 *)
|
||||
Word1(3800H + 5); (* JL L2 *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 3); (* JL L2 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(5707H); (* ADD R7, R7 *)
|
||||
Word1(3C00H + 400H - 8); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1007H); (* RRC R7 *)
|
||||
Word1(8605H); (* SUB R6, R5 *)
|
||||
Word1(5704H); (* ADD R7, R4 *)
|
||||
Word1(3C00H + 400H - 21); (* JMP L1 *)
|
||||
(* L3: *)
|
||||
(*----------- (a < 0) --------------*)
|
||||
(* L1: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(3400H + 23); (* JGE L3 *)
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
|
||||
Word1(4327H); (* MOV #2, R7 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
(* L4: *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 6); (* JZ L2 *)
|
||||
Word1(3800H + 5); (* JL L2 *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 3); (* JL L2 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(5707H); (* ADD R7, R7 *)
|
||||
Word1(3C00H + 400H - 8); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1007H); (* RRC R7 *)
|
||||
Word1(5605H); (* ADD R6, R5 *)
|
||||
Word1(8704H); (* SUB R7, R4 *)
|
||||
Word1(3C00H + 400H - 25); (* JMP L1 *)
|
||||
(* L3: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _mul (a, b: INTEGER): INTEGER *)
|
||||
IF rtl[_mul].used THEN
|
||||
Label(rtl[_mul].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *)
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *)
|
||||
Word1(4304H); (* MOV #0, R4; res := 0 *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 7); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(0B316H); (* BIT #1, R6 *)
|
||||
Word1(2400H + 1); (* JZ L3 *)
|
||||
Word1(5504H); (* ADD R5, R4 *)
|
||||
(* L3: *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(2000H + 400H - 7); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _error (module, err, line: INTEGER) *)
|
||||
IF rtl[_error].used THEN
|
||||
Label(rtl[_error].label);
|
||||
Word1(0C232H); (* BIC #8, SR; DINT *)
|
||||
Word1(4303H); (* MOV R3, R3; NOP *)
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *)
|
||||
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *)
|
||||
Word2(4211H, sp); (* MOV sp(SR), SP *)
|
||||
Word1(1206H); (* PUSH R6 *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Word2(4214H, trap); (* MOV trap(SR), R4 *)
|
||||
Word1(9304H); (* TST R4 *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(1284H); (* CALL R4 *)
|
||||
(* L: *)
|
||||
Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
|
||||
END;
|
||||
|
||||
(* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
|
||||
IF rtl[_new].used THEN
|
||||
Label(rtl[_new].label);
|
||||
Word1(1202H); (* PUSH SR *)
|
||||
Word1(4302H); (* MOV #0, SR *)
|
||||
Word1(4303H); (* NOP *)
|
||||
Word1(4104H); (* MOV SP, R4 *)
|
||||
Word2(8034H, 16); (* SUB #16, R4 *)
|
||||
Word1(4005H + 100H * HP); (* MOV HP, R5 *)
|
||||
Word2(5115H, 6); (* ADD 6(SP), R5 *)
|
||||
Word1(9504H); (* CMP R5, R4 *)
|
||||
Word2(4114H, 8); (* MOV 8(SP), R4 *)
|
||||
Word1(3800H + 12); (* JL L1 *)
|
||||
Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *)
|
||||
Word1(5320H + HP); (* ADD #2, HP *)
|
||||
Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *)
|
||||
(* L3 *)
|
||||
Word2(4380H + HP, 0); (* MOV #0, 0(HP) *)
|
||||
Word1(5320H + HP); (* ADD #2, HP *)
|
||||
Word1(9500H + HP); (* CMP R5, HP *)
|
||||
Word1(3800H + 400H - 5); (* JL L3 *)
|
||||
Word1(3C00H + 2); (* JMP L2 *)
|
||||
(* L1 *)
|
||||
Word2(4384H, 0); (* MOV #0, 0(R4) *)
|
||||
(* L2 *)
|
||||
Word1(1300H) (* RETI *)
|
||||
END;
|
||||
|
||||
(* _guardrec (t0, t1: INTEGER): INTEGER *)
|
||||
IF rtl[_guardrec].used THEN
|
||||
Label(rtl[_guardrec].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *)
|
||||
Word2(4036H, types); (* MOV #types, R6 *)
|
||||
(* L3: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(2400H + 8); (* JZ L1 *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 10); (* JZ L2 *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
Word1(5605H); (* ADD R6, R5 *)
|
||||
Word1(4525H); (* MOV @R5, R5 *)
|
||||
Word1(3C00H + 400H - 10); (* JMP L3 *)
|
||||
(* L1: *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 2); (* JZ L2 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H); (* MOV @SP+, PC *)
|
||||
(* L2: *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _is (t, p: INTEGER): INTEGER *)
|
||||
IF rtl[_is].used THEN
|
||||
Label(rtl[_is].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *)
|
||||
Word1(9304H); (* TST R4 *)
|
||||
Word1(2400H + 2); (* JZ L *)
|
||||
Word2(4414H, -2); (* MOV -2(R4), R4 *)
|
||||
(* L: *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Call(rtl[_guardrec].label); (* CALL _guardrec *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _guard (t, p: INTEGER): INTEGER *)
|
||||
IF rtl[_guard].used THEN
|
||||
Label(rtl[_guard].label);
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4525H); (* MOV @R5, R5 *)
|
||||
Word1(9305H); (* TST R5 *)
|
||||
Word1(2400H + 9); (* JZ L *)
|
||||
Word2(4515H, -2); (* MOV -2(R5), R5 *)
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Call(rtl[_guardrec].label); (* CALL _guardrec *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
(* L: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _move (bytes, dest, source: INTEGER) *)
|
||||
IF rtl[_move].used THEN
|
||||
Label(rtl[_move].label);
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *)
|
||||
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *)
|
||||
Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(3800H + 6); (* JL L1 *)
|
||||
Word1(2400H + 5); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *)
|
||||
Word1(5317H); (* ADD #1, R7 *)
|
||||
Word1(8316H); (* SUB #1, R6 *)
|
||||
Word1(2000H + 400H - 5); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *)
|
||||
IF rtl[_arrcpy].used THEN
|
||||
Label(rtl[_arrcpy].label);
|
||||
Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *)
|
||||
Word1(3800H + 18); (* JL L1 *)
|
||||
Word2(1211H, 12); (* PUSH 12(SP) *)
|
||||
Word2(1211H, 10); (* PUSH 10(SP) *)
|
||||
Word2(1211H, 14); (* PUSH 14(SP) *)
|
||||
Word2(1211H, 10); (* PUSH 10(SP) *)
|
||||
Call(rtl[_mul].label); (* CALL _mul *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Call(rtl[_move].label); (* CALL _move *)
|
||||
Word2(5031H, 6); (* ADD #6, SP *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L1 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _length (len, str: INTEGER): INTEGER *)
|
||||
IF rtl[_length].used THEN
|
||||
Label(rtl[_length].label);
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *)
|
||||
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *)
|
||||
Word1(4304H); (* MOV #0, R4; res := 0 *)
|
||||
(* L2: *)
|
||||
Word1(4775H); (* MOV.B @R7+, R5 *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
Word1(5314H); (* ADD #1, R4 *)
|
||||
Word1(8316H); (* SUB #1, R6 *)
|
||||
Word1(2000H + 400H - 6); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *)
|
||||
IF rtl[_strcmp].used THEN
|
||||
Label(rtl[_strcmp].label);
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
|
||||
Word1(9607H); (* CMP R6, R7 *)
|
||||
Word1(3400H + 1); (* JGE L5 *)
|
||||
Word1(4706H); (* MOV R7, R6 *)
|
||||
(* L5: *)
|
||||
Word1(1206H); (* PUSH R6 *)
|
||||
Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *)
|
||||
(* L3: *)
|
||||
Word2(9381H, 0); (* CMP #0, 0(SP) *)
|
||||
Word1(2400H + 11); (* JZ L1 *)
|
||||
Word1(4674H); (* MOV.B @R6+, R4 *)
|
||||
Word1(4775H); (* MOV.B @R7+, R5 *)
|
||||
Word2(8391H, 0); (* SUB #1, 0(SP) *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 2); (* JZ L2 *)
|
||||
Word1(8504H); (* SUB R5, R4 *)
|
||||
Word1(3C00H + 5); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(2000H + 400H - 13); (* JNZ L3 *)
|
||||
Word1(3C00H + 2); (* JMP L4 *)
|
||||
(* L1: *)
|
||||
Word2(4034H, 8000H); (* MOV #8000H, R4 *)
|
||||
(* L4: *)
|
||||
Word1(5321H); (* ADD #2, SP *)
|
||||
|
||||
Word2(9034H, 8000H); (* CMP #8000H, R4 *)
|
||||
Word1(2000H + 18); (* JNZ L6 *)
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
|
||||
Word1(9607H); (* CMP R6, R7 *)
|
||||
Word1(2400H + 11); (* JZ L7 *)
|
||||
Word1(3800H + 4); (* JL L8 *)
|
||||
Word2(5116H, 10); (* ADD 10(SP), R6 *)
|
||||
Word1(4664H); (* MOV.B @R6, R4 *)
|
||||
Word1(3C00H + 7); (* JMP L6 *)
|
||||
(* L8: *)
|
||||
Word2(5117H, 6); (* ADD 6(SP), R7 *)
|
||||
Word1(4764H); (* MOV.B @R7, R4 *)
|
||||
Word1(0E334H); (* XOR #-1, R4 *)
|
||||
Word1(5314H); (* ADD #1, R4 *)
|
||||
Word1(3C00H + 1); (* JMP L6 *)
|
||||
(* L7: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L6: *)
|
||||
|
||||
Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(2000H + 1); (* JNZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3800H + 1); (* JL L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3800H + 2); (* JL L *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(3800H + 2); (* JL L *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3400H + 1); (* JGE L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H) (* RET *)
|
||||
END
|
||||
|
||||
END Gen;
|
||||
|
||||
|
||||
PROCEDURE Set* (idx, label: INTEGER);
|
||||
BEGIN
|
||||
rtl[idx].label := label;
|
||||
rtl[idx].used := FALSE
|
||||
END Set;
|
||||
|
||||
|
||||
PROCEDURE Used* (idx: INTEGER);
|
||||
BEGIN
|
||||
rtl[idx].used := TRUE;
|
||||
IF (idx = _guard) OR (idx = _is) THEN
|
||||
rtl[_guardrec].used := TRUE
|
||||
ELSIF idx = _arrcpy THEN
|
||||
rtl[_move].used := TRUE;
|
||||
rtl[_mul].used := TRUE
|
||||
END
|
||||
END Used;
|
||||
|
||||
|
||||
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER);
|
||||
BEGIN
|
||||
Label := pLabel;
|
||||
Word := pWord;
|
||||
Call := pCall;
|
||||
|
||||
IF ramSize > 2048 THEN
|
||||
ram := 1100H
|
||||
ELSE
|
||||
ram := 200H
|
||||
END;
|
||||
trap := ram;
|
||||
int := trap + 2
|
||||
END Init;
|
||||
|
||||
|
||||
END MSP430RTL.
|
@ -7,7 +7,7 @@
|
||||
|
||||
MODULE PARS;
|
||||
|
||||
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS;
|
||||
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
|
||||
|
||||
|
||||
CONST
|
||||
@ -24,6 +24,12 @@ TYPE
|
||||
|
||||
PARSER* = POINTER TO rPARSER;
|
||||
|
||||
POSITION* = RECORD (SCAN.POSITION)
|
||||
|
||||
parser*: PARSER
|
||||
|
||||
END;
|
||||
|
||||
EXPR* = RECORD
|
||||
|
||||
obj*: INTEGER;
|
||||
@ -37,7 +43,7 @@ TYPE
|
||||
|
||||
STATPROC = PROCEDURE (parser: PARSER);
|
||||
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
|
||||
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
|
||||
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
|
||||
|
||||
rPARSER = RECORD (C.ITEM)
|
||||
|
||||
@ -67,7 +73,7 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
program*: PROG.PROGRAM;
|
||||
program*: PROG.PROGRAM;
|
||||
|
||||
parsers: C.COLLECTION;
|
||||
|
||||
@ -83,34 +89,40 @@ BEGIN
|
||||
END destroy;
|
||||
|
||||
|
||||
PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
|
||||
PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
|
||||
BEGIN
|
||||
ERRORS.errormsg(parser.fname, pos.line, pos.col, errno)
|
||||
pos.line := parser.lex.pos.line;
|
||||
pos.col := parser.lex.pos.col;
|
||||
pos.parser := parser
|
||||
END getpos;
|
||||
|
||||
|
||||
PROCEDURE error* (pos: POSITION; errno: INTEGER);
|
||||
BEGIN
|
||||
ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
|
||||
END error;
|
||||
|
||||
|
||||
PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
|
||||
PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
|
||||
BEGIN
|
||||
IF ~condition THEN
|
||||
error(parser, pos, errno)
|
||||
error(pos, errno)
|
||||
END
|
||||
END check;
|
||||
|
||||
|
||||
PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
|
||||
VAR
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
IF ~condition THEN
|
||||
error(parser, parser.lex.pos, errno)
|
||||
getpos(parser, pos);
|
||||
error(pos, errno)
|
||||
END
|
||||
END check1;
|
||||
|
||||
|
||||
PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
|
||||
BEGIN
|
||||
pos := parser.lex.pos
|
||||
END getpos;
|
||||
|
||||
|
||||
PROCEDURE Next* (parser: PARSER);
|
||||
VAR
|
||||
errno: INTEGER;
|
||||
@ -118,6 +130,14 @@ VAR
|
||||
BEGIN
|
||||
SCAN.Next(parser.scanner, parser.lex);
|
||||
errno := parser.lex.error;
|
||||
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
|
||||
IF parser.lex.sym = SCAN.lxFLOAT THEN
|
||||
errno := -SCAN.lxERROR13
|
||||
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
|
||||
errno := -SCAN.lxERROR10
|
||||
END
|
||||
END;
|
||||
|
||||
IF errno # 0 THEN
|
||||
check1(FALSE, parser, errno)
|
||||
END;
|
||||
@ -125,10 +145,10 @@ BEGIN
|
||||
END Next;
|
||||
|
||||
|
||||
PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION);
|
||||
PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
|
||||
BEGIN
|
||||
Next(parser);
|
||||
pos := parser.lex.pos
|
||||
getpos(parser, pos)
|
||||
END NextPos;
|
||||
|
||||
|
||||
@ -178,17 +198,14 @@ END ExpectSym;
|
||||
|
||||
PROCEDURE ImportList (parser: PARSER);
|
||||
VAR
|
||||
name: SCAN.IDENT;
|
||||
parser2: PARSER;
|
||||
pos: SCAN.POSITION;
|
||||
alias: BOOLEAN;
|
||||
unit: PROG.UNIT;
|
||||
ident: PROG.IDENT;
|
||||
units: PROG.UNITS;
|
||||
name: SCAN.IDENT;
|
||||
parser2: PARSER;
|
||||
pos: POSITION;
|
||||
alias: BOOLEAN;
|
||||
unit: PROG.UNIT;
|
||||
ident: PROG.IDENT;
|
||||
|
||||
BEGIN
|
||||
units := program.units;
|
||||
|
||||
alias := FALSE;
|
||||
|
||||
REPEAT
|
||||
@ -199,18 +216,18 @@ BEGIN
|
||||
getpos(parser, pos);
|
||||
|
||||
IF ~alias THEN
|
||||
ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE);
|
||||
check(ident # NIL, parser, pos, 30)
|
||||
ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
|
||||
check(ident # NIL, pos, 30)
|
||||
END;
|
||||
|
||||
Next(parser);
|
||||
|
||||
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
|
||||
alias := FALSE;
|
||||
unit := units.get(units, name);
|
||||
unit := PROG.getUnit(program, name);
|
||||
|
||||
IF unit # NIL THEN
|
||||
check(unit.closed, parser, pos, 31)
|
||||
check(unit.closed, pos, 31)
|
||||
ELSE
|
||||
parser2 := parser.create(parser.path, parser.lib_path,
|
||||
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
|
||||
@ -220,9 +237,9 @@ BEGIN
|
||||
destroy(parser2);
|
||||
parser2 := parser.create(parser.lib_path, parser.lib_path,
|
||||
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
|
||||
check(parser2.open(parser2, name.s), parser, pos, 29)
|
||||
check(parser2.open(parser2, name.s), pos, 29)
|
||||
ELSE
|
||||
check(FALSE, parser, pos, 29)
|
||||
error(pos, 29)
|
||||
END
|
||||
END;
|
||||
|
||||
@ -257,7 +274,7 @@ VAR
|
||||
BEGIN
|
||||
ASSERT(parser.sym = SCAN.lxIDENT);
|
||||
|
||||
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
|
||||
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
|
||||
|
||||
IF ~forward THEN
|
||||
check1(ident # NIL, parser, 48)
|
||||
@ -267,7 +284,7 @@ BEGIN
|
||||
unit := ident.unit;
|
||||
ExpectSym(parser, SCAN.lxPOINT);
|
||||
ExpectSym(parser, SCAN.lxIDENT);
|
||||
ident := unit.idents.get(unit, parser.lex.ident, FALSE);
|
||||
ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
|
||||
check1((ident # NIL) & ident.export, parser, 48)
|
||||
END
|
||||
|
||||
@ -312,30 +329,29 @@ BEGIN
|
||||
END;
|
||||
|
||||
ARITH.setbool(v, bool)
|
||||
|
||||
END strcmp;
|
||||
|
||||
|
||||
PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
|
||||
VAR
|
||||
e: EXPR;
|
||||
pos: SCAN.POSITION;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
getpos(parser, pos);
|
||||
parser.constexp := TRUE;
|
||||
parser.expression(parser, e);
|
||||
parser.constexp := FALSE;
|
||||
check(e.obj = eCONST, parser, pos, 62);
|
||||
check(e.obj = eCONST, pos, 62);
|
||||
v := e.value
|
||||
END ConstExpression;
|
||||
|
||||
|
||||
PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
|
||||
VAR
|
||||
name: SCAN.IDENT;
|
||||
export: BOOLEAN;
|
||||
pos: SCAN.POSITION;
|
||||
name: SCAN.IDENT;
|
||||
export: BOOLEAN;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
ASSERT(parser.sym = SCAN.lxIDENT);
|
||||
@ -355,7 +371,7 @@ BEGIN
|
||||
Next(parser)
|
||||
END;
|
||||
|
||||
check(rec.fields.add(rec, name, export), parser, pos, 30);
|
||||
check(PROG.addField(rec, name, export), pos, 30);
|
||||
|
||||
IF parser.sym = SCAN.lxCOMMA THEN
|
||||
ExpectSym(parser, SCAN.lxIDENT)
|
||||
@ -391,7 +407,7 @@ VAR
|
||||
exit := FALSE;
|
||||
|
||||
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
|
||||
check1(type.params.add(type, parser.lex.ident, vPar), parser, 30);
|
||||
check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
|
||||
Next(parser);
|
||||
IF parser.sym = SCAN.lxCOMMA THEN
|
||||
ExpectSym(parser, SCAN.lxIDENT)
|
||||
@ -412,13 +428,13 @@ VAR
|
||||
t1 := t0;
|
||||
|
||||
WHILE dim > 0 DO
|
||||
t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
|
||||
t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
|
||||
t1.base := t0;
|
||||
t0 := t1;
|
||||
DEC(dim)
|
||||
END;
|
||||
|
||||
type.params.set(type, t1);
|
||||
PROG.setParams(type, t1);
|
||||
Next(parser);
|
||||
exit := TRUE
|
||||
ELSE
|
||||
@ -449,7 +465,7 @@ BEGIN
|
||||
ExpectSym(parser, SCAN.lxIDENT);
|
||||
ident := QIdent(parser, FALSE);
|
||||
check1(ident.typ = PROG.idTYPE, parser, 68);
|
||||
check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69);
|
||||
check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
|
||||
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
|
||||
type.base := ident.type;
|
||||
Next(parser)
|
||||
@ -461,54 +477,83 @@ BEGIN
|
||||
END FormalParameters;
|
||||
|
||||
|
||||
PROCEDURE sysflag (parser: PARSER): INTEGER;
|
||||
PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
res, sf: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF parser.lex.s = "stdcall" THEN
|
||||
res := PROG.stdcall
|
||||
sf := PROG.sf_stdcall
|
||||
ELSIF parser.lex.s = "stdcall64" THEN
|
||||
res := PROG.stdcall64
|
||||
sf := PROG.sf_stdcall64
|
||||
ELSIF parser.lex.s = "ccall" THEN
|
||||
res := PROG.ccall
|
||||
sf := PROG.sf_ccall
|
||||
ELSIF parser.lex.s = "ccall16" THEN
|
||||
res := PROG.ccall16
|
||||
sf := PROG.sf_ccall16
|
||||
ELSIF parser.lex.s = "win64" THEN
|
||||
res := PROG.win64
|
||||
sf := PROG.sf_win64
|
||||
ELSIF parser.lex.s = "systemv" THEN
|
||||
res := PROG.systemv
|
||||
sf := PROG.sf_systemv
|
||||
ELSIF parser.lex.s = "windows" THEN
|
||||
sf := PROG.sf_windows
|
||||
ELSIF parser.lex.s = "linux" THEN
|
||||
sf := PROG.sf_linux
|
||||
ELSIF parser.lex.s = "code" THEN
|
||||
sf := PROG.sf_code
|
||||
ELSIF parser.lex.s = "noalign" THEN
|
||||
sf := PROG.sf_noalign
|
||||
ELSE
|
||||
check1(FALSE, parser, 124)
|
||||
END;
|
||||
|
||||
check1(sf IN program.target.sysflags, parser, 125);
|
||||
|
||||
IF proc THEN
|
||||
check1(sf IN PROG.proc_flags, parser, 123)
|
||||
ELSE
|
||||
check1(sf IN PROG.rec_flags, parser, 123)
|
||||
END;
|
||||
|
||||
CASE sf OF
|
||||
|PROG.sf_stdcall:
|
||||
res := PROG.stdcall
|
||||
|PROG.sf_stdcall64:
|
||||
res := PROG.stdcall64
|
||||
|PROG.sf_ccall:
|
||||
res := PROG.ccall
|
||||
|PROG.sf_ccall16:
|
||||
res := PROG.ccall16
|
||||
|PROG.sf_win64:
|
||||
res := PROG.win64
|
||||
|PROG.sf_systemv:
|
||||
res := PROG.systemv
|
||||
|PROG.sf_code:
|
||||
res := PROG.code
|
||||
|PROG.sf_windows:
|
||||
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
|
||||
res := PROG.stdcall
|
||||
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
|
||||
res := PROG.win64
|
||||
ELSE
|
||||
check1(FALSE, parser, 118)
|
||||
END
|
||||
ELSIF parser.lex.s = "linux" THEN
|
||||
IF program.target.sys = mConst.Target_iELF32 THEN
|
||||
|PROG.sf_linux:
|
||||
IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
|
||||
res := PROG.ccall16
|
||||
ELSIF program.target.sys = mConst.Target_iELF64 THEN
|
||||
ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
|
||||
res := PROG.systemv
|
||||
ELSE
|
||||
check1(FALSE, parser, 119)
|
||||
END
|
||||
ELSIF parser.lex.s = "noalign" THEN
|
||||
|PROG.sf_noalign:
|
||||
res := PROG.noalign
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END sysflag;
|
||||
|
||||
|
||||
PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
|
||||
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
|
||||
VAR
|
||||
call: INTEGER;
|
||||
dll, proc: SCAN.LEXSTR;
|
||||
pos: SCAN.POSITION;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
|
||||
@ -518,12 +563,7 @@ BEGIN
|
||||
getpos(parser, pos);
|
||||
check1(parser.unit.sysimport, parser, 54);
|
||||
Next(parser);
|
||||
call := sysflag(parser);
|
||||
IF program.target.bit_depth = 64 THEN
|
||||
check1(call IN PROG.callconv64, parser, 117)
|
||||
ELSIF program.target.bit_depth = 32 THEN
|
||||
check1(call IN PROG.callconv32, parser, 63)
|
||||
END;
|
||||
call := sysflag(parser, TRUE);
|
||||
Next(parser);
|
||||
IF parser.sym = SCAN.lxMINUS THEN
|
||||
Next(parser);
|
||||
@ -539,20 +579,21 @@ BEGIN
|
||||
ExpectSym(parser, SCAN.lxSTRING);
|
||||
proc := parser.lex.s;
|
||||
Next(parser);
|
||||
import := CODE.AddImp(dll, proc)
|
||||
import := IL.AddImp(dll, proc)
|
||||
END;
|
||||
checklex(parser, SCAN.lxRSQUARE);
|
||||
Next(parser)
|
||||
ELSE
|
||||
IF program.target.bit_depth = 32 THEN
|
||||
call := PROG.default
|
||||
ELSIF program.target.bit_depth = 64 THEN
|
||||
call := PROG.default64
|
||||
CASE program.target.bit_depth OF
|
||||
|16: call := PROG.default16
|
||||
|32: call := PROG.default32
|
||||
|64: call := PROG.default64
|
||||
END
|
||||
END;
|
||||
|
||||
IF import # NIL THEN
|
||||
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70)
|
||||
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
|
||||
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
|
||||
END
|
||||
|
||||
RETURN call
|
||||
@ -570,12 +611,12 @@ VAR
|
||||
typeSize: ARITH.VALUE;
|
||||
ident: PROG.IDENT;
|
||||
unit: PROG.UNIT;
|
||||
pos, pos2: SCAN.POSITION;
|
||||
pos, pos2: POSITION;
|
||||
fieldType: PROG.TYPE_;
|
||||
baseIdent: SCAN.IDENT;
|
||||
a, b: INTEGER;
|
||||
RecFlag: INTEGER;
|
||||
import: CODE.IMPORT_PROC;
|
||||
import: IL.IMPORT_PROC;
|
||||
|
||||
BEGIN
|
||||
unit := parser.unit;
|
||||
@ -604,11 +645,11 @@ BEGIN
|
||||
|
||||
ConstExpression(parser, arrLen);
|
||||
|
||||
check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43);
|
||||
check(ARITH.check(arrLen), parser, pos, 39);
|
||||
check(ARITH.getInt(arrLen) > 0, parser, pos, 51);
|
||||
check(arrLen.typ = ARITH.tINTEGER, pos, 43);
|
||||
check(ARITH.check(arrLen), pos, 39);
|
||||
check(ARITH.getInt(arrLen) > 0, pos, 51);
|
||||
|
||||
t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
|
||||
t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
|
||||
|
||||
IF parser.sym = SCAN.lxCOMMA THEN
|
||||
type(parser, t.base, {comma, closed})
|
||||
@ -623,8 +664,8 @@ BEGIN
|
||||
|
||||
a := t.length;
|
||||
b := t.base.size;
|
||||
check(ARITH.mulInt(a, b), parser, pos2, 104);
|
||||
check(ARITH.setInt(typeSize, a), parser, pos2, 104);
|
||||
check(ARITH.mulInt(a, b), pos2, 104);
|
||||
check(ARITH.setInt(typeSize, a), pos2, 104);
|
||||
t.size := a;
|
||||
|
||||
t.closed := TRUE
|
||||
@ -633,19 +674,14 @@ BEGIN
|
||||
getpos(parser, pos2);
|
||||
Next(parser);
|
||||
|
||||
t := program.enterType(program, PROG.tRECORD, 0, 0, unit);
|
||||
t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
|
||||
t.align := 1;
|
||||
|
||||
IF parser.sym = SCAN.lxLSQUARE THEN
|
||||
check1(parser.unit.sysimport, parser, 54);
|
||||
Next(parser);
|
||||
RecFlag := sysflag(parser);
|
||||
IF RecFlag = PROG.noalign THEN
|
||||
t.noalign := TRUE
|
||||
ELSE
|
||||
check1(FALSE, parser, 110)
|
||||
END;
|
||||
|
||||
RecFlag := sysflag(parser, FALSE);
|
||||
t.noalign := RecFlag = PROG.noalign;
|
||||
ExpectSym(parser, SCAN.lxRSQUARE);
|
||||
Next(parser)
|
||||
END;
|
||||
@ -657,14 +693,14 @@ BEGIN
|
||||
|
||||
type(parser, t.base, {closed});
|
||||
|
||||
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52);
|
||||
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
|
||||
|
||||
IF t.base.typ = PROG.tPOINTER THEN
|
||||
t.base := t.base.base;
|
||||
check(t.base # NIL, parser, pos, 55)
|
||||
check(t.base # NIL, pos, 55)
|
||||
END;
|
||||
|
||||
check(~t.base.noalign, parser, pos, 112);
|
||||
check(~t.base.noalign, pos, 112);
|
||||
|
||||
checklex(parser, SCAN.lxRROUND);
|
||||
Next(parser);
|
||||
@ -684,7 +720,7 @@ BEGIN
|
||||
Next(parser);
|
||||
|
||||
type(parser, fieldType, {closed});
|
||||
check(t.fields.set(t, fieldType), parser, pos2, 104);
|
||||
check(PROG.setFields(t, fieldType), pos2, 104);
|
||||
|
||||
IF (fieldType.align > t.align) & ~t.noalign THEN
|
||||
t.align := fieldType.align
|
||||
@ -699,21 +735,21 @@ BEGIN
|
||||
|
||||
t.closed := TRUE;
|
||||
|
||||
CODE.AddRec(t.base.num);
|
||||
IL.AddRec(t.base.num);
|
||||
|
||||
IF ~t.noalign THEN
|
||||
check(MACHINE.Align(t.size, t.align), parser, pos2, 104);
|
||||
check(ARITH.setInt(typeSize, t.size), parser, pos2, 104)
|
||||
check(UTILS.Align(t.size, t.align), pos2, 104);
|
||||
check(ARITH.setInt(typeSize, t.size), pos2, 104)
|
||||
END;
|
||||
|
||||
checklex(parser, SCAN.lxEND);
|
||||
Next(parser)
|
||||
|
||||
ELSIF parser.sym = SCAN.lxPOINTER THEN
|
||||
ELSIF parser.sym = SCAN.lxPOINTER THEN
|
||||
ExpectSym(parser, SCAN.lxTO);
|
||||
Next(parser);
|
||||
|
||||
t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
|
||||
t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
|
||||
t.align := program.target.adr;
|
||||
|
||||
getpos(parser, pos);
|
||||
@ -725,14 +761,14 @@ BEGIN
|
||||
type(parser, t.base, {forward});
|
||||
|
||||
IF t.base # NIL THEN
|
||||
check(t.base.typ = PROG.tRECORD, parser, pos, 58)
|
||||
check(t.base.typ = PROG.tRECORD, pos, 58)
|
||||
ELSE
|
||||
unit.pointers.add(unit, t, baseIdent, pos)
|
||||
PROG.frwPtr(unit, t, baseIdent, pos)
|
||||
END
|
||||
|
||||
ELSIF parser.sym = SCAN.lxPROCEDURE THEN
|
||||
NextPos(parser, pos);
|
||||
t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
|
||||
t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
|
||||
t.align := program.target.adr;
|
||||
t.call := procflag(parser, import, FALSE);
|
||||
FormalParameters(parser, t)
|
||||
@ -746,15 +782,15 @@ END type;
|
||||
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
|
||||
VAR
|
||||
ident: PROG.IDENT;
|
||||
pos: SCAN.POSITION;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
ASSERT(parser.sym = SCAN.lxIDENT);
|
||||
|
||||
name := parser.lex.ident;
|
||||
getpos(parser, pos);
|
||||
ident := parser.unit.idents.add(parser.unit, name, typ);
|
||||
check(ident # NIL, parser, pos, 30);
|
||||
ident := PROG.addIdent(parser.unit, name, typ);
|
||||
check(ident # NIL, pos, 30);
|
||||
ident.pos := pos;
|
||||
Next(parser);
|
||||
|
||||
@ -770,9 +806,9 @@ END IdentDef;
|
||||
|
||||
PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
|
||||
VAR
|
||||
ident: PROG.IDENT;
|
||||
name: SCAN.IDENT;
|
||||
pos: SCAN.POSITION;
|
||||
ident: PROG.IDENT;
|
||||
name: SCAN.IDENT;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
IF const THEN
|
||||
@ -787,12 +823,12 @@ BEGIN
|
||||
IF const THEN
|
||||
ConstExpression(parser, ident.value);
|
||||
IF ident.value.typ = ARITH.tINTEGER THEN
|
||||
check(ARITH.check(ident.value), parser, pos, 39)
|
||||
check(ARITH.check(ident.value), pos, 39)
|
||||
ELSIF ident.value.typ = ARITH.tREAL THEN
|
||||
check(ARITH.check(ident.value), parser, pos, 40)
|
||||
check(ARITH.check(ident.value), pos, 40)
|
||||
END;
|
||||
ident.typ := PROG.idCONST;
|
||||
ident.type := program.getType(program, ident.value.typ)
|
||||
ident.type := PROG.getType(program, ident.value.typ)
|
||||
ELSE
|
||||
type(parser, ident.type, {})
|
||||
END;
|
||||
@ -805,9 +841,9 @@ END ConstTypeDeclaration;
|
||||
|
||||
PROCEDURE VarDeclaration (parser: PARSER);
|
||||
VAR
|
||||
ident: PROG.IDENT;
|
||||
name: SCAN.IDENT;
|
||||
t: PROG.TYPE_;
|
||||
ident: PROG.IDENT;
|
||||
name: SCAN.IDENT;
|
||||
t: PROG.TYPE_;
|
||||
|
||||
BEGIN
|
||||
|
||||
@ -819,7 +855,7 @@ BEGIN
|
||||
ELSIF parser.sym = SCAN.lxCOLON THEN
|
||||
Next(parser);
|
||||
type(parser, t, {});
|
||||
parser.unit.setvars(parser.unit, t);
|
||||
PROG.setVarsType(parser.unit, t);
|
||||
checklex(parser, SCAN.lxSEMI);
|
||||
Next(parser)
|
||||
ELSE
|
||||
@ -835,6 +871,7 @@ PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
|
||||
VAR
|
||||
ptr: PROG.FRWPTR;
|
||||
endmod: BOOLEAN;
|
||||
pos: POSITION;
|
||||
|
||||
|
||||
PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
|
||||
@ -842,20 +879,24 @@ VAR
|
||||
proc: PROG.IDENT;
|
||||
endname,
|
||||
name: SCAN.IDENT;
|
||||
param: LISTS.ITEM;
|
||||
param: PROG.PARAM;
|
||||
unit: PROG.UNIT;
|
||||
ident: PROG.IDENT;
|
||||
e: EXPR;
|
||||
pos: SCAN.POSITION;
|
||||
pos, pos1,
|
||||
pos2: POSITION;
|
||||
label: INTEGER;
|
||||
enter: CODE.COMMAND;
|
||||
enter: IL.COMMAND;
|
||||
call: INTEGER;
|
||||
t: PROG.TYPE_;
|
||||
import: CODE.IMPORT_PROC;
|
||||
import: IL.IMPORT_PROC;
|
||||
endmod, b: BOOLEAN;
|
||||
fparams: SET;
|
||||
variables: LISTS.LIST;
|
||||
int, flt: INTEGER;
|
||||
comma: BOOLEAN;
|
||||
code: ARITH.VALUE;
|
||||
codeProc: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
endmod := FALSE;
|
||||
@ -865,6 +906,7 @@ VAR
|
||||
call := procflag(parser, import, TRUE);
|
||||
|
||||
getpos(parser, pos);
|
||||
pos1 := pos;
|
||||
checklex(parser, SCAN.lxIDENT);
|
||||
|
||||
IF import # NIL THEN
|
||||
@ -875,29 +917,56 @@ VAR
|
||||
proc := IdentDef(parser, PROG.idPROC, name)
|
||||
END;
|
||||
|
||||
check(unit.scope.open(unit, proc.proc), parser, pos, 116);
|
||||
check(PROG.openScope(unit, proc.proc), pos, 116);
|
||||
|
||||
proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
|
||||
proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
|
||||
t := proc.type;
|
||||
t.align := program.target.adr;
|
||||
t.call := call;
|
||||
t.align := program.target.adr;
|
||||
t.call := call;
|
||||
|
||||
FormalParameters(parser, t);
|
||||
|
||||
|
||||
codeProc := call IN {PROG.code, PROG._code};
|
||||
|
||||
IF call IN {PROG.systemv, PROG._systemv} THEN
|
||||
check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120)
|
||||
check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
|
||||
END;
|
||||
|
||||
param := t.params.first;
|
||||
param := t.params.first(PROG.PARAM);
|
||||
WHILE param # NIL DO
|
||||
ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM);
|
||||
ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
|
||||
ASSERT(ident # NIL);
|
||||
ident.type := param(PROG.PARAM).type;
|
||||
ident.offset := param(PROG.PARAM).offset;
|
||||
IF param(PROG.PARAM).vPar THEN
|
||||
ident.type := param.type;
|
||||
ident.offset := param.offset;
|
||||
IF param.vPar THEN
|
||||
ident.typ := PROG.idVPAR
|
||||
END;
|
||||
param := param.next
|
||||
param := param.next(PROG.PARAM)
|
||||
END;
|
||||
|
||||
IF import = NIL THEN
|
||||
label := IL.NewLabel();
|
||||
proc.proc.label := label
|
||||
END;
|
||||
|
||||
IF codeProc THEN
|
||||
enter := IL.EnterC(label);
|
||||
comma := FALSE;
|
||||
WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
|
||||
getpos(parser, pos2);
|
||||
ConstExpression(parser, code);
|
||||
check(code.typ = ARITH.tINTEGER, pos2, 43);
|
||||
IF program.target.sys # mConst.Target_iMSP430 THEN
|
||||
check(ARITH.range(code, 0, 255), pos2, 42)
|
||||
END;
|
||||
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
|
||||
comma := parser.sym = SCAN.lxCOMMA;
|
||||
IF comma THEN
|
||||
Next(parser)
|
||||
ELSE
|
||||
checklex(parser, SCAN.lxSEMI)
|
||||
END
|
||||
END
|
||||
END;
|
||||
|
||||
checklex(parser, SCAN.lxSEMI);
|
||||
@ -905,55 +974,64 @@ VAR
|
||||
|
||||
IF import = NIL THEN
|
||||
|
||||
label := CODE.NewLabel();
|
||||
proc.proc.label := label;
|
||||
|
||||
IF parser.main & proc.export & program.dll THEN
|
||||
IF program.obj THEN
|
||||
check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114)
|
||||
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
|
||||
END;
|
||||
CODE.AddExp(label, proc.name.s);
|
||||
IL.AddExp(label, proc.name.s);
|
||||
proc.proc.used := TRUE
|
||||
END;
|
||||
|
||||
b := DeclarationSequence(parser);
|
||||
IF ~codeProc THEN
|
||||
b := DeclarationSequence(parser)
|
||||
END;
|
||||
|
||||
program.locsize := 0;
|
||||
IF call IN {PROG._win64, PROG.win64} THEN
|
||||
fparams := proc.type.params.getfparams(proc.type, 3, int, flt);
|
||||
enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4))
|
||||
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
|
||||
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
|
||||
ELSIF call IN {PROG._systemv, PROG.systemv} THEN
|
||||
fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
|
||||
enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size))
|
||||
fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
|
||||
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
|
||||
ELSIF codeProc THEN
|
||||
|
||||
ELSE
|
||||
enter := CODE.Enter(label, 0)
|
||||
enter := IL.Enter(label, 0)
|
||||
END;
|
||||
proc.proc.enter := enter;
|
||||
|
||||
IF parser.sym = SCAN.lxBEGIN THEN
|
||||
IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
|
||||
Next(parser);
|
||||
parser.StatSeq(parser)
|
||||
END;
|
||||
|
||||
IF t.base # NIL THEN
|
||||
IF ~codeProc & (t.base # NIL) THEN
|
||||
checklex(parser, SCAN.lxRETURN);
|
||||
NextPos(parser, pos);
|
||||
parser.expression(parser, e);
|
||||
check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87)
|
||||
check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
|
||||
END;
|
||||
|
||||
proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL),
|
||||
t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
|
||||
enter.param2 := program.locsize;
|
||||
checklex(parser, SCAN.lxEND)
|
||||
IF ~codeProc THEN
|
||||
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
|
||||
t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
|
||||
enter.param2 := program.locsize;
|
||||
checklex(parser, SCAN.lxEND)
|
||||
ELSE
|
||||
proc.proc.leave := IL.LeaveC()
|
||||
END;
|
||||
|
||||
IF program.target.sys = mConst.Target_iMSP430 THEN
|
||||
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
|
||||
END
|
||||
END;
|
||||
|
||||
IF parser.sym = SCAN.lxEND THEN
|
||||
ExpectSym(parser, SCAN.lxIDENT);
|
||||
getpos(parser, pos);
|
||||
endname := parser.lex.ident;
|
||||
IF import = NIL THEN
|
||||
check(endname = name, parser, pos, 60);
|
||||
IF ~codeProc & (import = NIL) THEN
|
||||
check(endname = name, pos, 60);
|
||||
ExpectSym(parser, SCAN.lxSEMI);
|
||||
Next(parser)
|
||||
ELSE
|
||||
@ -965,20 +1043,20 @@ VAR
|
||||
ExpectSym(parser, SCAN.lxSEMI);
|
||||
Next(parser)
|
||||
ELSE
|
||||
check(FALSE, parser, pos, 60)
|
||||
error(pos, 60)
|
||||
END
|
||||
END
|
||||
END;
|
||||
|
||||
IF import = NIL THEN
|
||||
IF ~codeProc & (import = NIL) THEN
|
||||
variables := LISTS.create(NIL);
|
||||
ELSE
|
||||
variables := NIL
|
||||
END;
|
||||
|
||||
unit.scope.close(unit, variables);
|
||||
PROG.closeScope(unit, variables);
|
||||
|
||||
IF import = NIL THEN
|
||||
IF ~codeProc & (import = NIL) THEN
|
||||
enter.variables := variables
|
||||
END
|
||||
|
||||
@ -1001,12 +1079,15 @@ BEGIN
|
||||
END
|
||||
END;
|
||||
|
||||
ptr := parser.unit.pointers.link(parser.unit);
|
||||
ptr := PROG.linkPtr(parser.unit);
|
||||
IF ptr # NIL THEN
|
||||
pos.line := ptr.pos.line;
|
||||
pos.col := ptr.pos.col;
|
||||
pos.parser := parser;
|
||||
IF ptr.notRecord THEN
|
||||
error(parser, ptr.pos, 58)
|
||||
error(pos, 58)
|
||||
ELSE
|
||||
error(parser, ptr.pos, 48)
|
||||
error(pos, 48)
|
||||
END
|
||||
END;
|
||||
|
||||
@ -1029,10 +1110,12 @@ END DeclarationSequence;
|
||||
|
||||
PROCEDURE parse (parser: PARSER);
|
||||
VAR
|
||||
unit: PROG.UNIT;
|
||||
label: INTEGER;
|
||||
name: INTEGER;
|
||||
endmod: BOOLEAN;
|
||||
unit: PROG.UNIT;
|
||||
label: INTEGER;
|
||||
name: INTEGER;
|
||||
endmod: BOOLEAN;
|
||||
errlabel: INTEGER;
|
||||
errno: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ASSERT(parser # NIL);
|
||||
@ -1045,7 +1128,7 @@ BEGIN
|
||||
check1(parser.lex.s = parser.modname, parser, 23)
|
||||
END;
|
||||
|
||||
unit := program.units.create(program.units, parser.lex.ident);
|
||||
unit := PROG.newUnit(program, parser.lex.ident);
|
||||
|
||||
parser.unit := unit;
|
||||
|
||||
@ -1062,19 +1145,26 @@ BEGIN
|
||||
END;
|
||||
CONSOLE.Ln;
|
||||
|
||||
label := CODE.NewLabel();
|
||||
CODE.AddJmpCmd(CODE.opJMP, label);
|
||||
label := IL.NewLabel();
|
||||
IL.AddJmpCmd(IL.opJMP, label);
|
||||
|
||||
name := CODE.putstr(unit.name.s);
|
||||
name := IL.putstr(unit.name.s);
|
||||
|
||||
CODE.SetErrLabel;
|
||||
CODE.AddCmd(CODE.opSADR, name);
|
||||
CODE.AddCmd(CODE.opPARAM, 1);
|
||||
CODE.AddCmd0(CODE.opERR);
|
||||
errlabel := IL.NewLabel();
|
||||
IL.SetLabel(errlabel);
|
||||
IL.StrAdr(name);
|
||||
IL.Param1;
|
||||
IL.AddCmd0(IL.opERR);
|
||||
|
||||
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
|
||||
IL.SetErrLabel(errno);
|
||||
IL.AddCmd(IL.opPUSHC, errno);
|
||||
IL.AddJmpCmd(IL.opJMP, errlabel)
|
||||
END;
|
||||
|
||||
endmod := DeclarationSequence(parser);
|
||||
|
||||
CODE.SetLabel(label);
|
||||
IL.SetLabel(label);
|
||||
|
||||
IF ~endmod THEN
|
||||
|
||||
@ -1091,8 +1181,7 @@ BEGIN
|
||||
|
||||
END;
|
||||
|
||||
unit.close(unit)
|
||||
|
||||
PROG.closeUnit(unit)
|
||||
END parse;
|
||||
|
||||
|
||||
@ -1156,9 +1245,9 @@ BEGIN
|
||||
END create;
|
||||
|
||||
|
||||
PROCEDURE init* (bit_depth, sys: INTEGER);
|
||||
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
|
||||
BEGIN
|
||||
program := PROG.create(bit_depth, sys);
|
||||
program := PROG.create(bit_depth, target, options);
|
||||
parsers := C.create()
|
||||
END init;
|
||||
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -12,11 +12,11 @@ IMPORT STRINGS, UTILS;
|
||||
|
||||
CONST
|
||||
|
||||
slash = UTILS.slash;
|
||||
|
||||
slash = UTILS.slash;
|
||||
|
||||
PATHLEN = 2048;
|
||||
|
||||
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
PATH* = ARRAY PATHLEN OF CHAR;
|
||||
@ -92,12 +92,12 @@ BEGIN
|
||||
res[i] := 0X
|
||||
END
|
||||
|
||||
END RelPath;
|
||||
END RelPath;
|
||||
|
||||
|
||||
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
|
||||
RETURN UTILS.isRelative(path)
|
||||
END isRelative;
|
||||
END isRelative;
|
||||
|
||||
|
||||
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -12,8 +12,10 @@ CONST
|
||||
|
||||
N = 16;
|
||||
|
||||
R0* = 0; R1* = 1; R2* = 2;
|
||||
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
|
||||
R0* = 0; R1* = 1; R2* = 2; R3* = 3;
|
||||
R4* = 4; R5* = 5; R6* = 6; R7* = 7;
|
||||
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
|
||||
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
|
||||
|
||||
NVR = 32;
|
||||
|
||||
@ -24,7 +26,7 @@ TYPE
|
||||
OP2 = PROCEDURE (arg1, arg2: INTEGER);
|
||||
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
|
||||
|
||||
REGS* = POINTER TO RECORD
|
||||
REGS* = RECORD
|
||||
|
||||
regs*: SET;
|
||||
stk*: ARRAY N OF INTEGER;
|
||||
@ -42,7 +44,7 @@ TYPE
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE push (R: REGS);
|
||||
PROCEDURE push (VAR R: REGS);
|
||||
VAR
|
||||
i, reg: INTEGER;
|
||||
|
||||
@ -58,7 +60,7 @@ BEGIN
|
||||
END push;
|
||||
|
||||
|
||||
PROCEDURE pop (R: REGS; reg: INTEGER);
|
||||
PROCEDURE pop (VAR R: REGS; reg: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
@ -111,7 +113,7 @@ BEGIN
|
||||
END GetFreeReg;
|
||||
|
||||
|
||||
PROCEDURE Put (R: REGS; reg: INTEGER);
|
||||
PROCEDURE Put (VAR R: REGS; reg: INTEGER);
|
||||
BEGIN
|
||||
EXCL(R.regs, reg);
|
||||
INC(R.top);
|
||||
@ -119,7 +121,7 @@ BEGIN
|
||||
END Put;
|
||||
|
||||
|
||||
PROCEDURE PopAnyReg (R: REGS): INTEGER;
|
||||
PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
|
||||
VAR
|
||||
reg: INTEGER;
|
||||
|
||||
@ -134,7 +136,7 @@ BEGIN
|
||||
END PopAnyReg;
|
||||
|
||||
|
||||
PROCEDURE GetAnyReg* (R: REGS): INTEGER;
|
||||
PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
|
||||
VAR
|
||||
reg: INTEGER;
|
||||
|
||||
@ -152,13 +154,13 @@ BEGIN
|
||||
END GetAnyReg;
|
||||
|
||||
|
||||
PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN;
|
||||
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
free, n: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
|
||||
PROCEDURE exch (R: REGS; reg1, reg2: INTEGER);
|
||||
PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
|
||||
VAR
|
||||
n1, n2: INTEGER;
|
||||
|
||||
@ -201,7 +203,7 @@ BEGIN
|
||||
END GetReg;
|
||||
|
||||
|
||||
PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN;
|
||||
PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
n1, n2: INTEGER;
|
||||
res: BOOLEAN;
|
||||
@ -239,14 +241,14 @@ BEGIN
|
||||
END Exchange;
|
||||
|
||||
|
||||
PROCEDURE Drop* (R: REGS);
|
||||
PROCEDURE Drop* (VAR R: REGS);
|
||||
BEGIN
|
||||
INCL(R.regs, R.stk[R.top]);
|
||||
DEC(R.top)
|
||||
END Drop;
|
||||
|
||||
|
||||
PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER);
|
||||
PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
|
||||
BEGIN
|
||||
IF R.top > 0 THEN
|
||||
reg1 := R.stk[R.top - 1];
|
||||
@ -261,7 +263,7 @@ BEGIN
|
||||
END BinOp;
|
||||
|
||||
|
||||
PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER);
|
||||
PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
|
||||
BEGIN
|
||||
IF R.top >= 0 THEN
|
||||
reg := R.stk[R.top]
|
||||
@ -271,7 +273,7 @@ BEGIN
|
||||
END UnOp;
|
||||
|
||||
|
||||
PROCEDURE PushAll* (R: REGS);
|
||||
PROCEDURE PushAll* (VAR R: REGS);
|
||||
BEGIN
|
||||
WHILE R.top >= 0 DO
|
||||
push(R)
|
||||
@ -279,7 +281,15 @@ BEGIN
|
||||
END PushAll;
|
||||
|
||||
|
||||
PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER);
|
||||
PROCEDURE PushAll_1* (VAR R: REGS);
|
||||
BEGIN
|
||||
WHILE R.top >= 1 DO
|
||||
push(R)
|
||||
END
|
||||
END PushAll_1;
|
||||
|
||||
|
||||
PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
|
||||
BEGIN
|
||||
ASSERT(reg IN R.vregs);
|
||||
ASSERT(offs # 0);
|
||||
@ -291,7 +301,7 @@ BEGIN
|
||||
END Lock;
|
||||
|
||||
|
||||
PROCEDURE Release* (R: REGS; reg: INTEGER);
|
||||
PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
|
||||
BEGIN
|
||||
ASSERT(reg IN R.vregs);
|
||||
R.offs[reg] := 0
|
||||
@ -350,7 +360,7 @@ BEGIN
|
||||
END Restore;
|
||||
|
||||
|
||||
PROCEDURE Reset* (R: REGS);
|
||||
PROCEDURE Reset* (VAR R: REGS);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
@ -401,14 +411,11 @@ BEGIN
|
||||
END GetAnyVarReg;
|
||||
|
||||
|
||||
PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS;
|
||||
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
|
||||
VAR
|
||||
R: REGS;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
NEW(R);
|
||||
|
||||
R.regs := regs;
|
||||
R.pushed := 0;
|
||||
R.top := -1;
|
||||
@ -427,8 +434,7 @@ BEGIN
|
||||
R.size[i] := 0
|
||||
END
|
||||
|
||||
RETURN R
|
||||
END Create;
|
||||
END Init;
|
||||
|
||||
|
||||
END REG.
|
@ -1,46 +1,47 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE SCAN;
|
||||
|
||||
IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS;
|
||||
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
LEXLEN = 1024;
|
||||
|
||||
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
|
||||
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
|
||||
lxEOF* = 8;
|
||||
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
|
||||
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
|
||||
lxEOF* = 8;
|
||||
|
||||
lxKW = 101;
|
||||
lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;
|
||||
lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;
|
||||
lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;
|
||||
lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;
|
||||
lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;
|
||||
lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;
|
||||
lxASSIGN* = 45; lxRANGE* = 46;
|
||||
|
||||
lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104;
|
||||
lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108;
|
||||
lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112;
|
||||
lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116;
|
||||
lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120;
|
||||
lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124;
|
||||
lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128;
|
||||
lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132;
|
||||
lxWHILE* = 133;
|
||||
lxKW = 51;
|
||||
|
||||
lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204;
|
||||
lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208;
|
||||
lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212;
|
||||
lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216;
|
||||
lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220;
|
||||
lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224;
|
||||
lxASSIGN* = 225; lxRANGE* = 226;
|
||||
lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;
|
||||
lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;
|
||||
lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;
|
||||
lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;
|
||||
lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;
|
||||
lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;
|
||||
lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;
|
||||
lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;
|
||||
lxWHILE* = 83;
|
||||
|
||||
lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4;
|
||||
lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8;
|
||||
lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12;
|
||||
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
|
||||
lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
|
||||
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
|
||||
lxERROR13* = -13;
|
||||
|
||||
|
||||
TYPE
|
||||
@ -62,25 +63,20 @@ TYPE
|
||||
|
||||
LEX* = RECORD
|
||||
|
||||
s*: LEXSTR;
|
||||
length*: INTEGER;
|
||||
sym*: INTEGER;
|
||||
pos*: POSITION;
|
||||
ident*: IDENT;
|
||||
string*: IDENT;
|
||||
value*: ARITH.VALUE;
|
||||
error*: INTEGER;
|
||||
s*: LEXSTR;
|
||||
length*: INTEGER;
|
||||
sym*: INTEGER;
|
||||
pos*: POSITION;
|
||||
ident*: IDENT;
|
||||
string*: IDENT;
|
||||
value*: ARITH.VALUE;
|
||||
error*: INTEGER;
|
||||
|
||||
over: BOOLEAN
|
||||
over: BOOLEAN
|
||||
|
||||
END;
|
||||
|
||||
SCANNER* = POINTER TO RECORD (C.ITEM)
|
||||
|
||||
text: TEXTDRV.TEXT;
|
||||
range: BOOLEAN
|
||||
|
||||
END;
|
||||
SCANNER* = TXT.TEXT;
|
||||
|
||||
KEYWORD = ARRAY 10 OF CHAR;
|
||||
|
||||
@ -89,16 +85,14 @@ VAR
|
||||
|
||||
vocabulary: RECORD
|
||||
|
||||
KW: ARRAY 33 OF KEYWORD;
|
||||
|
||||
delimiters: ARRAY 256 OF BOOLEAN;
|
||||
|
||||
idents: AVL.NODE;
|
||||
ident: IDENT
|
||||
KW: ARRAY 33 OF KEYWORD;
|
||||
delimiters: ARRAY 256 OF BOOLEAN;
|
||||
idents: AVL.NODE;
|
||||
ident: IDENT
|
||||
|
||||
END;
|
||||
|
||||
scanners: C.COLLECTION;
|
||||
upto: BOOLEAN;
|
||||
|
||||
|
||||
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
|
||||
@ -109,36 +103,27 @@ END nodecmp;
|
||||
PROCEDURE key (VAR lex: LEX);
|
||||
VAR
|
||||
L, R, M: INTEGER;
|
||||
found: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
L := 0;
|
||||
R := LEN(vocabulary.KW) - 1;
|
||||
M := (L + R) DIV 2;
|
||||
found := FALSE;
|
||||
|
||||
WHILE L # M DO
|
||||
IF lex.s > vocabulary.KW[M] THEN
|
||||
L := M;
|
||||
M := (L + R) DIV 2
|
||||
ELSIF lex.s < vocabulary.KW[M] THEN
|
||||
R := M;
|
||||
M := (L + R) DIV 2
|
||||
REPEAT
|
||||
M := (L + R) DIV 2;
|
||||
|
||||
IF lex.s # vocabulary.KW[M] THEN
|
||||
IF lex.s > vocabulary.KW[M] THEN
|
||||
L := M + 1
|
||||
ELSE
|
||||
R := M - 1
|
||||
END
|
||||
ELSE
|
||||
lex.sym := lxKW + M;
|
||||
L := M;
|
||||
R := M
|
||||
found := TRUE;
|
||||
lex.sym := lxKW + M
|
||||
END
|
||||
END;
|
||||
|
||||
IF L # R THEN
|
||||
IF lex.s = vocabulary.KW[L] THEN
|
||||
lex.sym := lxKW + L
|
||||
END;
|
||||
|
||||
IF lex.s = vocabulary.KW[R] THEN
|
||||
lex.sym := lxKW + R
|
||||
END
|
||||
END
|
||||
|
||||
UNTIL found OR (L > R)
|
||||
END key;
|
||||
|
||||
|
||||
@ -173,18 +158,24 @@ BEGIN
|
||||
END putchar;
|
||||
|
||||
|
||||
PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX);
|
||||
PROCEDURE nextc (text: TXT.TEXT): CHAR;
|
||||
BEGIN
|
||||
TXT.next(text)
|
||||
RETURN text.peak
|
||||
END nextc;
|
||||
|
||||
|
||||
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
c := text.peak(text);
|
||||
c := text.peak;
|
||||
ASSERT(S.letter(c));
|
||||
|
||||
WHILE S.letter(c) OR S.digit(c) DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
IF lex.over THEN
|
||||
@ -201,44 +192,40 @@ BEGIN
|
||||
END ident;
|
||||
|
||||
|
||||
PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
|
||||
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
|
||||
VAR
|
||||
c: CHAR;
|
||||
hex: BOOLEAN;
|
||||
error: INTEGER;
|
||||
|
||||
BEGIN
|
||||
c := text.peak(text);
|
||||
c := text.peak;
|
||||
ASSERT(S.digit(c));
|
||||
|
||||
error := 0;
|
||||
|
||||
range := FALSE;
|
||||
|
||||
lex.sym := lxINTEGER;
|
||||
hex := FALSE;
|
||||
|
||||
WHILE S.digit(c) DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
WHILE S.hexdigit(c) DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text);
|
||||
c := nextc(text);
|
||||
hex := TRUE
|
||||
END;
|
||||
|
||||
IF c = "H" THEN
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
TXT.next(text);
|
||||
lex.sym := lxHEX
|
||||
|
||||
ELSIF c = "X" THEN
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
TXT.next(text);
|
||||
lex.sym := lxCHAR
|
||||
|
||||
ELSIF c = "." THEN
|
||||
@ -247,39 +234,35 @@ BEGIN
|
||||
lex.sym := lxERROR01
|
||||
ELSE
|
||||
|
||||
text.nextc(text);
|
||||
c := text.peak(text);
|
||||
c := nextc(text);
|
||||
|
||||
IF c # "." THEN
|
||||
putchar(lex, ".");
|
||||
lex.sym := lxFLOAT
|
||||
ELSE
|
||||
lex.sym := lxINTEGER;
|
||||
range := TRUE
|
||||
text.peak := 7FX;
|
||||
upto := TRUE
|
||||
END;
|
||||
|
||||
WHILE S.digit(c) DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
IF c = "E" THEN
|
||||
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text);
|
||||
c := nextc(text);
|
||||
IF (c = "+") OR (c = "-") THEN
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
IF S.digit(c) THEN
|
||||
WHILE S.digit(c) DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END
|
||||
ELSE
|
||||
lex.sym := lxERROR02
|
||||
@ -289,11 +272,8 @@ BEGIN
|
||||
|
||||
END
|
||||
|
||||
ELSE
|
||||
|
||||
IF hex THEN
|
||||
lex.sym := lxERROR01
|
||||
END
|
||||
ELSIF hex THEN
|
||||
lex.sym := lxERROR01
|
||||
|
||||
END;
|
||||
|
||||
@ -321,31 +301,23 @@ BEGIN
|
||||
END number;
|
||||
|
||||
|
||||
PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX);
|
||||
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
|
||||
VAR
|
||||
c, c1: CHAR;
|
||||
n: INTEGER;
|
||||
quot: CHAR;
|
||||
c: CHAR;
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
quot := text.peak(text);
|
||||
|
||||
ASSERT((quot = '"') OR (quot = "'"));
|
||||
|
||||
text.nextc(text);
|
||||
c := text.peak(text);
|
||||
c1 := c;
|
||||
n := 0;
|
||||
c := nextc(text);
|
||||
n := 0;
|
||||
|
||||
WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := text.peak(text);
|
||||
c := nextc(text);
|
||||
INC(n)
|
||||
END;
|
||||
|
||||
IF c = quot THEN
|
||||
text.nextc(text);
|
||||
TXT.next(text);
|
||||
IF lex.over THEN
|
||||
lex.sym := lxERROR05
|
||||
ELSE
|
||||
@ -353,7 +325,7 @@ BEGIN
|
||||
lex.sym := lxSTRING
|
||||
ELSE
|
||||
lex.sym := lxCHAR;
|
||||
ARITH.setChar(lex.value, ORD(c1))
|
||||
ARITH.setChar(lex.value, ORD(lex.s[0]))
|
||||
END
|
||||
END
|
||||
ELSE
|
||||
@ -369,19 +341,19 @@ BEGIN
|
||||
END string;
|
||||
|
||||
|
||||
PROCEDURE comment (text: TEXTDRV.TEXT);
|
||||
PROCEDURE comment (text: TXT.TEXT);
|
||||
VAR
|
||||
c: CHAR;
|
||||
cond, depth: INTEGER;
|
||||
|
||||
BEGIN
|
||||
cond := 0;
|
||||
cond := 0;
|
||||
depth := 1;
|
||||
|
||||
REPEAT
|
||||
|
||||
c := text.peak(text);
|
||||
text.nextc(text);
|
||||
c := text.peak;
|
||||
TXT.next(text);
|
||||
|
||||
IF c = "*" THEN
|
||||
IF cond = 1 THEN
|
||||
@ -406,21 +378,12 @@ BEGIN
|
||||
END comment;
|
||||
|
||||
|
||||
PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
|
||||
BEGIN
|
||||
c := text.peak(text);
|
||||
|
||||
IF range THEN
|
||||
ASSERT(c = ".")
|
||||
END;
|
||||
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
c := nextc(text);
|
||||
|
||||
CASE c OF
|
||||
CASE lex.s[0] OF
|
||||
|"+":
|
||||
lex.sym := lxPLUS
|
||||
|
||||
@ -433,10 +396,10 @@ BEGIN
|
||||
|"/":
|
||||
lex.sym := lxSLASH;
|
||||
|
||||
IF text.peak(text) = "/" THEN
|
||||
IF c = "/" THEN
|
||||
lex.sym := lxCOMMENT;
|
||||
REPEAT
|
||||
text.nextc(text)
|
||||
TXT.next(text)
|
||||
UNTIL text.eol OR text.eof
|
||||
END
|
||||
|
||||
@ -447,24 +410,12 @@ BEGIN
|
||||
lex.sym := lxAND
|
||||
|
||||
|".":
|
||||
IF range THEN
|
||||
lex.sym := lxPOINT;
|
||||
|
||||
putchar(lex, ".");
|
||||
IF c = "." THEN
|
||||
lex.sym := lxRANGE;
|
||||
range := FALSE;
|
||||
DEC(lex.pos.col)
|
||||
|
||||
ELSE
|
||||
|
||||
lex.sym := lxPOINT;
|
||||
c := text.peak(text);
|
||||
|
||||
IF c = "." THEN
|
||||
lex.sym := lxRANGE;
|
||||
putchar(lex, c);
|
||||
text.nextc(text)
|
||||
END
|
||||
|
||||
putchar(lex, c);
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|",":
|
||||
@ -478,12 +429,10 @@ BEGIN
|
||||
|
||||
|"(":
|
||||
lex.sym := lxLROUND;
|
||||
c := text.peak(text);
|
||||
|
||||
IF c = "*" THEN
|
||||
lex.sym := lxCOMMENT;
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
TXT.next(text);
|
||||
comment(text)
|
||||
END
|
||||
|
||||
@ -504,32 +453,29 @@ BEGIN
|
||||
|
||||
|"<":
|
||||
lex.sym := lxLT;
|
||||
c := text.peak(text);
|
||||
|
||||
IF c = "=" THEN
|
||||
lex.sym := lxLE;
|
||||
putchar(lex, c);
|
||||
text.nextc(text)
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|">":
|
||||
lex.sym := lxGT;
|
||||
c := text.peak(text);
|
||||
|
||||
IF c = "=" THEN
|
||||
lex.sym := lxGE;
|
||||
putchar(lex, c);
|
||||
text.nextc(text)
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|":":
|
||||
lex.sym := lxCOLON;
|
||||
c := text.peak(text);
|
||||
|
||||
IF c = "=" THEN
|
||||
lex.sym := lxASSIGN;
|
||||
putchar(lex, c);
|
||||
text.nextc(text)
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|")":
|
||||
@ -546,26 +492,21 @@ BEGIN
|
||||
END delimiter;
|
||||
|
||||
|
||||
PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX);
|
||||
PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
|
||||
VAR
|
||||
c: CHAR;
|
||||
text: TEXTDRV.TEXT;
|
||||
|
||||
BEGIN
|
||||
text := scanner.text;
|
||||
|
||||
REPEAT
|
||||
|
||||
c := text.peak(text);
|
||||
c := text.peak;
|
||||
|
||||
WHILE S.space(c) DO
|
||||
text.nextc(text);
|
||||
c := text.peak(text)
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
lex.s[0] := 0X;
|
||||
lex.length := 0;
|
||||
lex.sym := lxUNDEF;
|
||||
lex.pos.line := text.line;
|
||||
lex.pos.col := text.col;
|
||||
lex.ident := NIL;
|
||||
@ -574,19 +515,26 @@ BEGIN
|
||||
IF S.letter(c) THEN
|
||||
ident(text, lex)
|
||||
ELSIF S.digit(c) THEN
|
||||
number(text, lex, scanner.range)
|
||||
number(text, lex)
|
||||
ELSIF (c = '"') OR (c = "'") THEN
|
||||
string(text, lex)
|
||||
string(text, lex, c)
|
||||
ELSIF vocabulary.delimiters[ORD(c)] THEN
|
||||
delimiter(text, lex, scanner.range)
|
||||
delimiter(text, lex, c)
|
||||
ELSIF c = 0X THEN
|
||||
lex.sym := lxEOF;
|
||||
IF text.eof THEN
|
||||
INC(lex.pos.col)
|
||||
END
|
||||
ELSIF (c = 7FX) & upto THEN
|
||||
upto := FALSE;
|
||||
lex.sym := lxRANGE;
|
||||
putchar(lex, ".");
|
||||
putchar(lex, ".");
|
||||
DEC(lex.pos.col);
|
||||
TXT.next(text)
|
||||
ELSE
|
||||
putchar(lex, c);
|
||||
text.nextc(text);
|
||||
TXT.next(text);
|
||||
lex.sym := lxERROR04
|
||||
END;
|
||||
|
||||
@ -601,53 +549,14 @@ BEGIN
|
||||
END Next;
|
||||
|
||||
|
||||
PROCEDURE NewScanner (): SCANNER;
|
||||
VAR
|
||||
scan: SCANNER;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(scanners);
|
||||
IF citem = NIL THEN
|
||||
NEW(scan)
|
||||
ELSE
|
||||
scan := citem(SCANNER)
|
||||
END
|
||||
|
||||
RETURN scan
|
||||
END NewScanner;
|
||||
|
||||
|
||||
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
|
||||
VAR
|
||||
scanner: SCANNER;
|
||||
text: TEXTDRV.TEXT;
|
||||
|
||||
BEGIN
|
||||
text := TEXTDRV.create();
|
||||
IF text.open(text, name) THEN
|
||||
scanner := NewScanner();
|
||||
scanner.text := text;
|
||||
scanner.range := FALSE
|
||||
ELSE
|
||||
scanner := NIL;
|
||||
TEXTDRV.destroy(text)
|
||||
END
|
||||
|
||||
RETURN scanner
|
||||
RETURN TXT.open(name)
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE close* (VAR scanner: SCANNER);
|
||||
BEGIN
|
||||
IF scanner # NIL THEN
|
||||
IF scanner.text # NIL THEN
|
||||
TEXTDRV.destroy(scanner.text)
|
||||
END;
|
||||
|
||||
C.push(scanners, scanner);
|
||||
scanner := NIL
|
||||
END
|
||||
TXT.close(scanner)
|
||||
END close;
|
||||
|
||||
|
||||
@ -656,14 +565,16 @@ VAR
|
||||
i: INTEGER;
|
||||
delim: ARRAY 23 OF CHAR;
|
||||
|
||||
|
||||
PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
|
||||
BEGIN
|
||||
vocabulary.KW[i] := kw;
|
||||
INC(i)
|
||||
END enterkw;
|
||||
|
||||
|
||||
BEGIN
|
||||
scanners := C.create();
|
||||
upto := FALSE;
|
||||
|
||||
FOR i := 0 TO 255 DO
|
||||
vocabulary.delimiters[i] := FALSE
|
||||
@ -714,7 +625,7 @@ BEGIN
|
||||
vocabulary.ident.s := "";
|
||||
vocabulary.ident.offset := -1;
|
||||
vocabulary.ident.offsetW := -1;
|
||||
vocabulary.idents := NIL
|
||||
vocabulary.idents := NIL
|
||||
END init;
|
||||
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -92,6 +92,29 @@ BEGIN
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE hexdgt (n: BYTE): BYTE;
|
||||
BEGIN
|
||||
IF n < 10 THEN
|
||||
n := n + ORD("0")
|
||||
ELSE
|
||||
n := n - 10 + ORD("A")
|
||||
END
|
||||
|
||||
RETURN n
|
||||
END hexdgt;
|
||||
|
||||
|
||||
PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
|
||||
BEGIN
|
||||
str[n] := 0X;
|
||||
WHILE n > 0 DO
|
||||
str[n - 1] := CHR(hexdgt(x MOD 16));
|
||||
x := x DIV 16;
|
||||
DEC(n)
|
||||
END
|
||||
END IntToHex;
|
||||
|
||||
|
||||
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
|
||||
BEGIN
|
||||
WHILE count > 0 DO
|
||||
@ -261,12 +284,12 @@ BEGIN
|
||||
|
||||
|0E1X..0EFX:
|
||||
u := LSL(ORD(c) - 0E0H, 12);
|
||||
IF i + 1 < srclen THEN
|
||||
IF i + 1 < srclen THEN
|
||||
INC(i);
|
||||
INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64)
|
||||
END;
|
||||
IF i + 1 < srclen THEN
|
||||
INC(i);
|
||||
INC(i);
|
||||
INC(u, ORD(BITS(ORD(src[i])) * {0..5}))
|
||||
END
|
||||
(*
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -30,10 +30,7 @@ TYPE
|
||||
line*, col*: INTEGER;
|
||||
eof*: BOOLEAN;
|
||||
eol*: BOOLEAN;
|
||||
|
||||
open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
|
||||
peak*: PROCEDURE (text: TEXT): CHAR;
|
||||
nextc*: PROCEDURE (text: TEXT)
|
||||
peak*: CHAR
|
||||
|
||||
END;
|
||||
|
||||
@ -43,26 +40,6 @@ VAR
|
||||
texts: C.COLLECTION;
|
||||
|
||||
|
||||
PROCEDURE reset (text: TEXT);
|
||||
BEGIN
|
||||
text.chunk[0] := 0;
|
||||
text.pos := 0;
|
||||
text.size := 0;
|
||||
text.file := NIL;
|
||||
text.utf8 := FALSE;
|
||||
text.CR := FALSE;
|
||||
text.line := 1;
|
||||
text.col := 1;
|
||||
text.eof := FALSE;
|
||||
text.eol := FALSE
|
||||
END reset;
|
||||
|
||||
|
||||
PROCEDURE peak (text: TEXT): CHAR;
|
||||
RETURN CHR(text.chunk[text.pos])
|
||||
END peak;
|
||||
|
||||
|
||||
PROCEDURE load (text: TEXT);
|
||||
BEGIN
|
||||
IF ~text.eof THEN
|
||||
@ -71,37 +48,40 @@ BEGIN
|
||||
IF text.size = 0 THEN
|
||||
text.eof := TRUE;
|
||||
text.chunk[0] := 0
|
||||
END
|
||||
END;
|
||||
text.peak := CHR(text.chunk[0])
|
||||
END
|
||||
END load;
|
||||
|
||||
|
||||
PROCEDURE next (text: TEXT);
|
||||
PROCEDURE next* (text: TEXT);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
IF text.pos < text.size - 1 THEN
|
||||
INC(text.pos)
|
||||
INC(text.pos);
|
||||
text.peak := CHR(text.chunk[text.pos])
|
||||
ELSE
|
||||
load(text)
|
||||
END;
|
||||
|
||||
IF ~text.eof THEN
|
||||
|
||||
c := peak(text);
|
||||
c := text.peak;
|
||||
|
||||
IF c = CR THEN
|
||||
INC(text.line);
|
||||
text.col := 0;
|
||||
text.eol := TRUE;
|
||||
text.CR := TRUE
|
||||
text.col := 0;
|
||||
text.eol := TRUE;
|
||||
text.CR := TRUE
|
||||
ELSIF c = LF THEN
|
||||
IF ~text.CR THEN
|
||||
INC(text.line);
|
||||
text.col := 0;
|
||||
text.eol := TRUE
|
||||
text.col := 0;
|
||||
text.eol := TRUE
|
||||
ELSE
|
||||
text.eol := FALSE
|
||||
text.eol := FALSE
|
||||
END;
|
||||
text.CR := FALSE
|
||||
ELSE
|
||||
@ -123,7 +103,6 @@ END next;
|
||||
|
||||
PROCEDURE init (text: TEXT);
|
||||
BEGIN
|
||||
|
||||
IF (text.pos = 0) & (text.size >= 3) THEN
|
||||
IF (text.chunk[0] = 0EFH) &
|
||||
(text.chunk[1] = 0BBH) &
|
||||
@ -140,58 +119,13 @@ BEGIN
|
||||
END;
|
||||
|
||||
text.line := 1;
|
||||
text.col := 1
|
||||
text.col := 1;
|
||||
|
||||
text.peak := CHR(text.chunk[text.pos])
|
||||
END init;
|
||||
|
||||
|
||||
PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
ASSERT(text # NIL);
|
||||
|
||||
reset(text);
|
||||
text.file := FILES.open(name);
|
||||
IF text.file # NIL THEN
|
||||
load(text);
|
||||
init(text)
|
||||
END
|
||||
|
||||
RETURN text.file # NIL
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE NewText (): TEXT;
|
||||
VAR
|
||||
text: TEXT;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(texts);
|
||||
IF citem = NIL THEN
|
||||
NEW(text)
|
||||
ELSE
|
||||
text := citem(TEXT)
|
||||
END
|
||||
|
||||
RETURN text
|
||||
END NewText;
|
||||
|
||||
|
||||
PROCEDURE create* (): TEXT;
|
||||
VAR
|
||||
text: TEXT;
|
||||
BEGIN
|
||||
text := NewText();
|
||||
reset(text);
|
||||
text.open := open;
|
||||
text.peak := peak;
|
||||
text.nextc := next
|
||||
|
||||
RETURN text
|
||||
END create;
|
||||
|
||||
|
||||
PROCEDURE destroy* (VAR text: TEXT);
|
||||
PROCEDURE close* (VAR text: TEXT);
|
||||
BEGIN
|
||||
IF text # NIL THEN
|
||||
IF text.file # NIL THEN
|
||||
@ -201,7 +135,44 @@ BEGIN
|
||||
C.push(texts, text);
|
||||
text := NIL
|
||||
END
|
||||
END destroy;
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
|
||||
VAR
|
||||
text: TEXT;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(texts);
|
||||
IF citem = NIL THEN
|
||||
NEW(text)
|
||||
ELSE
|
||||
text := citem(TEXT)
|
||||
END;
|
||||
|
||||
IF text # NIL THEN
|
||||
text.chunk[0] := 0;
|
||||
text.pos := 0;
|
||||
text.size := 0;
|
||||
text.utf8 := FALSE;
|
||||
text.CR := FALSE;
|
||||
text.line := 1;
|
||||
text.col := 1;
|
||||
text.eof := FALSE;
|
||||
text.eol := FALSE;
|
||||
text.peak := 0X;
|
||||
text.file := FILES.open(name);
|
||||
IF text.file # NIL THEN
|
||||
load(text);
|
||||
init(text)
|
||||
ELSE
|
||||
close(text)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN text
|
||||
END open;
|
||||
|
||||
|
||||
BEGIN
|
||||
|
@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@ -55,12 +55,7 @@ END init;
|
||||
|
||||
|
||||
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
|
||||
VAR
|
||||
d, s: INTEGER;
|
||||
BEGIN
|
||||
d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4;
|
||||
s := d * 86400 + hour * 3600 + min * 60 + sec
|
||||
RETURN s
|
||||
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
|
||||
END time;
|
||||
|
||||
|
||||
|
@ -17,9 +17,12 @@ CONST
|
||||
bit_depth* = HOST.bit_depth;
|
||||
maxint* = HOST.maxint;
|
||||
minint* = HOST.minint;
|
||||
|
||||
|
||||
OS = HOST.OS;
|
||||
|
||||
min32* = -2147483647-1;
|
||||
max32* = 2147483647;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
@ -29,6 +32,22 @@ VAR
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
target*:
|
||||
|
||||
RECORD
|
||||
|
||||
bit_depth*,
|
||||
maxInt*,
|
||||
minInt*,
|
||||
maxSet*,
|
||||
maxHex*: INTEGER;
|
||||
|
||||
maxReal*: REAL
|
||||
|
||||
END;
|
||||
|
||||
bit_diff*: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
|
||||
RETURN HOST.FileRead(F, Buffer, bytes)
|
||||
@ -112,6 +131,76 @@ BEGIN
|
||||
END UnixTime;
|
||||
|
||||
|
||||
PROCEDURE SetBitDepth* (BitDepth: INTEGER);
|
||||
BEGIN
|
||||
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
|
||||
bit_diff := bit_depth - BitDepth;
|
||||
ASSERT(bit_diff >= 0);
|
||||
|
||||
target.bit_depth := BitDepth;
|
||||
target.maxSet := BitDepth - 1;
|
||||
target.maxHex := BitDepth DIV 4;
|
||||
target.minInt := ASR(minint, bit_diff);
|
||||
target.maxInt := ASR(maxint, bit_diff);
|
||||
target.maxReal := 1.9;
|
||||
PACK(target.maxReal, 1023);
|
||||
END SetBitDepth;
|
||||
|
||||
|
||||
PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
|
||||
RETURN ASR(n, 8 * idx) MOD 256
|
||||
END Byte;
|
||||
|
||||
|
||||
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
IF bytes MOD align # 0 THEN
|
||||
res := maxint - bytes >= align - (bytes MOD align);
|
||||
IF res THEN
|
||||
bytes := bytes + align - (bytes MOD align)
|
||||
END
|
||||
ELSE
|
||||
res := TRUE
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END Align;
|
||||
|
||||
|
||||
PROCEDURE Long* (value: INTEGER): INTEGER;
|
||||
RETURN ASR(LSL(value, bit_diff), bit_diff)
|
||||
END Long;
|
||||
|
||||
|
||||
PROCEDURE Short* (value: INTEGER): INTEGER;
|
||||
RETURN LSR(LSL(value, bit_diff), bit_diff)
|
||||
END Short;
|
||||
|
||||
|
||||
PROCEDURE Log2* (x: INTEGER): INTEGER;
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ASSERT(x > 0);
|
||||
|
||||
n := 0;
|
||||
WHILE ~ODD(x) DO
|
||||
x := x DIV 2;
|
||||
INC(n)
|
||||
END;
|
||||
|
||||
IF x # 1 THEN
|
||||
n := -1
|
||||
END
|
||||
|
||||
RETURN n
|
||||
END Log2;
|
||||
|
||||
|
||||
BEGIN
|
||||
time := GetTickCount();
|
||||
COPY(HOST.eol, eol);
|
||||
|
@ -1,13 +1,13 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018, Anton Krotov
|
||||
Copyright (c) 2018, 2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE WRITER;
|
||||
|
||||
IMPORT FILES, ERRORS, MACHINE;
|
||||
IMPORT FILES, ERRORS, UTILS;
|
||||
|
||||
|
||||
TYPE
|
||||
@ -35,7 +35,7 @@ BEGIN
|
||||
IF FILES.WriteByte(file, n) THEN
|
||||
INC(counter)
|
||||
ELSE
|
||||
ERRORS.error1("writing file error")
|
||||
ERRORS.Error(201)
|
||||
END
|
||||
END WriteByte;
|
||||
|
||||
@ -47,7 +47,7 @@ VAR
|
||||
BEGIN
|
||||
n := FILES.write(file, chunk, bytes);
|
||||
IF n # bytes THEN
|
||||
ERRORS.error1("writing file error")
|
||||
ERRORS.Error(201)
|
||||
END;
|
||||
INC(counter, n)
|
||||
END Write;
|
||||
@ -59,7 +59,7 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 7 DO
|
||||
WriteByte(file, MACHINE.Byte(n, i))
|
||||
WriteByte(file, UTILS.Byte(n, i))
|
||||
END
|
||||
END Write64LE;
|
||||
|
||||
@ -70,15 +70,15 @@ VAR
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
WriteByte(file, MACHINE.Byte(n, i))
|
||||
WriteByte(file, UTILS.Byte(n, i))
|
||||
END
|
||||
END Write32LE;
|
||||
|
||||
|
||||
PROCEDURE Write16LE* (file: FILE; n: INTEGER);
|
||||
BEGIN
|
||||
WriteByte(file, MACHINE.Byte(n, 0));
|
||||
WriteByte(file, MACHINE.Byte(n, 1))
|
||||
WriteByte(file, UTILS.Byte(n, 0));
|
||||
WriteByte(file, UTILS.Byte(n, 1))
|
||||
END Write16LE;
|
||||
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user