| /programs/develop/oberon07/Compiler.kex |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| /programs/develop/oberon07/Docs/About1251.txt |
|---|
| 30,7 → 30,6 |
| ïåðåäàåòñÿ. Ñîîáùåíèÿ êîìïèëÿòîðà âûâîäÿòñÿ íà êîíñîëü (Windows, |
| KolibriOS), â òåðìèíàë (Linux). |
| 2. Ïàïêà Lib - áèáëèîòåêà ìîäóëåé |
| 3. Ïàïêà Source - èñõîäíûé êîä êîìïèëÿòîðà |
| ------------------------------------------------------------------------------ |
| Îòëè÷èÿ îò îðèãèíàëà |
| 45,6 → 44,8 |
| 7. Ñåìàíòèêà DIV è MOD óòî÷íåíà äëÿ îòðèöàòåëüíûõ ÷èñåë |
| 8. Äîáàâëåíû îäíîñòðî÷íûå êîììåíòàðèè (íà÷èíàþòñÿ ñ ïàðû ñèìâîëîâ "//") |
| 9. Ðàçðåøåí ýêñïîðò ïåðåìåííûõ òèïîâ ARRAY è RECORD (òîëüêî äëÿ ÷òåíèÿ) |
| 10. Ðàçðåøåíî íàñëåäîâàíèå îò òèïà-óêàçàòåëÿ |
| 11. Äîáàâëåíû ïñåâäîíèìû òèïîâ (TYPE A = B) |
| ------------------------------------------------------------------------------ |
| Îñîáåííîñòè ðåàëèçàöèè |
| 93,7 → 94,7 |
| âîçâðàùàåò ñïåöèàëüíîå âåùåñòâåííîå çíà÷åíèå "áåñêîíå÷íîñòü" |
| PROCEDURE GET(a: INTEGER; |
| VAR v: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) |
| VAR v: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) |
| v := Ïàìÿòü[a] |
| PROCEDURE PUT(a: INTEGER; x: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) |
| 103,6 → 104,11 |
| Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest, |
| îáëàñòè Source è Dest íå äîëæíû ïåðåêðûâàòüñÿ |
| PROCEDURE COPY(VAR Source: ëþáîé òèï; VAR Dest: ëþáîé òèï; n: INTEGER) |
| Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest. |
| Ýêâèâàëåíòíî |
| SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) |
| PROCEDURE CODE(s: ARRAY OF CHAR) |
| Âñòàâêà ìàøèííîãî êîäà |
| s - ñòðîêîâàÿ êîíñòàíòà øåñòíàäöàòèðè÷íûõ öèôð |
| 198,6 → 204,12 |
| LSR(x, n: INTEGER): INTEGER |
| Ëîãè÷åñêèé ñäâèã x íà n áèò âïðàâî. |
| MIN(a, b: INTEGER): INTEGER |
| Ìèíèìóì èç äâóõ çíà÷åíèé. |
| MAX(a, b: INTEGER): INTEGER |
| Ìàêñèìóì èç äâóõ çíà÷åíèé. |
| BITS(x: INTEGER): SET |
| Èíòåðïðåòèðóåò x êàê çíà÷åíèå òèïà SET. |
| Âûïîëíÿåòñÿ íà ýòàïå êîìïèëÿöèè. |
| 853,4 → 865,6 |
| MODULE RasterWorks - îáåðòêà áèáëèîòåêè Rasterworks.obj |
| ------------------------------------------------------------------------------ |
| MODULE libimg - îáåðòêà áèáëèîòåêè libimg.obj |
| ------------------------------------------------------------------------------ |
| MODULE NetDevices - îáåðòêà äëÿ ô.74 (ðàáîòà ñ ñåòåâûìè óñòðîéñòâàìè) |
| ------------------------------------------------------------------------------ |
| /programs/develop/oberon07/Docs/About866.txt |
|---|
| 30,7 → 30,6 |
| ¯¥à¥¤ ¥âáï. ®®¡é¥¨ï ª®¬¯¨«ïâ®à ¢ë¢®¤ïâáï ª®á®«ì (Windows, |
| KolibriOS), ¢ â¥à¬¨ « (Linux). |
| 2. ¯ª Lib - ¡¨¡«¨®â¥ª ¬®¤ã«¥© |
| 3. ¯ª Source - ¨áå®¤ë© ª®¤ ª®¬¯¨«ïâ®à |
| ------------------------------------------------------------------------------ |
| ⫨ç¨ï ®â ®à¨£¨ « |
| 45,6 → 44,8 |
| 7. ¥¬ ⨪ DIV ¨ MOD ãâ®ç¥ ¤«ï ®âà¨æ ⥫ìëå ç¨á¥« |
| 8. ®¡ ¢«¥ë ®¤®áâà®çë¥ ª®¬¬¥â ਨ ( ç¨ îâáï á ¯ àë ᨬ¢®«®¢ "//") |
| 9. §à¥è¥ íªá¯®àâ ¯¥à¥¬¥ëå ⨯®¢ ARRAY ¨ RECORD (⮫쪮 ¤«ï ç⥨ï) |
| 10. §à¥è¥® á«¥¤®¢ ¨¥ ®â ⨯ -㪠§ ⥫ï |
| 11. ®¡ ¢«¥ë ¯á¥¢¤®¨¬ë ⨯®¢ (TYPE A = B) |
| ------------------------------------------------------------------------------ |
| ᮡ¥®á⨠ॠ«¨§ 樨 |
| 93,7 → 94,7 |
| ¢®§¢à é ¥â á¯¥æ¨ «ì®¥ ¢¥é¥á⢥®¥ § 票¥ "¡¥áª®¥ç®áâì" |
| PROCEDURE GET(a: INTEGER; |
| VAR v: «î¡®© ®á®¢®© ⨯, PROCEDURE, POINTER) |
| VAR v: «î¡®© ®á®¢®© ⨯, PROCEDURE, POINTER) |
| v := ¬ïâì[a] |
| PROCEDURE PUT(a: INTEGER; x: «î¡®© ®á®¢®© ⨯, PROCEDURE, POINTER) |
| 103,6 → 104,11 |
| ®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest, |
| ®¡« á⨠Source ¨ Dest ¥ ¤®«¦ë ¯¥à¥ªàë¢ âìáï |
| PROCEDURE COPY(VAR Source: «î¡®© ⨯; VAR Dest: «î¡®© ⨯; n: INTEGER) |
| ®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest. |
| ª¢¨¢ «¥â® |
| SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) |
| PROCEDURE CODE(s: ARRAY OF CHAR) |
| áâ ¢ª ¬ 訮£® ª®¤ |
| s - áâப®¢ ï ª®áâ â è¥áâ ¤æ â¨à¨çëå æ¨äà |
| 198,6 → 204,12 |
| LSR(x, n: INTEGER): INTEGER |
| ®£¨ç¥áª¨© ᤢ¨£ x n ¡¨â ¢¯à ¢®. |
| MIN(a, b: INTEGER): INTEGER |
| ¨¨¬ã¬ ¨§ ¤¢ãå § 票©. |
| MAX(a, b: INTEGER): INTEGER |
| ªá¨¬ã¬ ¨§ ¤¢ãå § 票©. |
| BITS(x: INTEGER): SET |
| â¥à¯à¥â¨àã¥â x ª ª § 票¥ ⨯ SET. |
| 믮«ï¥âáï íâ ¯¥ ª®¬¯¨«ï樨. |
| 853,4 → 865,6 |
| MODULE RasterWorks - ®¡¥à⪠¡¨¡«¨®â¥ª¨ Rasterworks.obj |
| ------------------------------------------------------------------------------ |
| MODULE libimg - ®¡¥à⪠¡¨¡«¨®â¥ª¨ libimg.obj |
| ------------------------------------------------------------------------------ |
| MODULE NetDevices - ®¡¥à⪠¤«ï ä.74 (à ¡®â á á¥â¥¢ë¬¨ ãáâனá⢠¬¨) |
| ------------------------------------------------------------------------------ |
| /programs/develop/oberon07/Lib/KolibriOS/API.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 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 |
| 107,25 → 107,25 |
| ELSE |
| temp := 0; |
| IF heap + size >= endheap THEN |
| IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN |
| temp := sysfunc3(68, 12, HEAP_SIZE) |
| ELSE |
| temp := 0 |
| END; |
| IF temp # 0 THEN |
| mem_commit(temp, HEAP_SIZE); |
| heap := temp; |
| endheap := heap + HEAP_SIZE |
| ELSE |
| temp := -1 |
| END |
| IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN |
| temp := sysfunc3(68, 12, HEAP_SIZE) |
| ELSE |
| temp := 0 |
| END; |
| IF temp # 0 THEN |
| mem_commit(temp, HEAP_SIZE); |
| heap := temp; |
| endheap := heap + HEAP_SIZE |
| ELSE |
| temp := -1 |
| END |
| END; |
| IF (heap # 0) & (temp # -1) THEN |
| sys.PUT(heap, size); |
| res := heap + 4; |
| heap := heap + size |
| sys.PUT(heap, size); |
| res := heap + 4; |
| heap := heap + size |
| ELSE |
| res := 0 |
| res := 0 |
| END |
| END |
| ELSE |
| 132,9 → 132,9 |
| IF sysfunc2(18, 16) > ASR(size, 10) THEN |
| res := sysfunc3(68, 12, size); |
| IF res # 0 THEN |
| mem_commit(res, size); |
| sys.PUT(res, size); |
| INC(res, 4) |
| mem_commit(res, size); |
| sys.PUT(res, size); |
| INC(res, 4) |
| END |
| ELSE |
| res := 0 |
| 166,6 → 166,11 |
| p1 := sysfunc1(-1) |
| END ExitProcess; |
| PROCEDURE ExitThread*(p1: INTEGER); |
| BEGIN |
| p1 := sysfunc1(-1) |
| END ExitThread; |
| PROCEDURE OutChar(c: CHAR); |
| VAR res: INTEGER; |
| BEGIN |
| 181,7 → 186,7 |
| REPEAT |
| sys.GET(lpCaption, c); |
| IF c # 0X THEN |
| OutChar(c) |
| OutChar(c) |
| END; |
| INC(lpCaption) |
| UNTIL c = 0X; |
| /programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 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 |
| 35,46 → 35,12 |
| VAR |
| con_init : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); |
| con_exit : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); |
| con_write_asciiz : PROCEDURE [stdcall] (string: INTEGER); |
| con_init : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); |
| con_exit : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); |
| con_write_asciiz : PROCEDURE [stdcall] (string: INTEGER); |
| fsize, sec*, dsec*: INTEGER; |
| PROCEDURE [stdcall] sysfunc1(arg1: INTEGER): INTEGER; |
| BEGIN |
| sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) |
| sys.CODE("CD40"); (* int 40h *) |
| sys.CODE("C9"); (* leave *) |
| sys.CODE("C20400"); (* ret 04h *) |
| RETURN 0 |
| END sysfunc1; |
| PROCEDURE [stdcall] sysfunc2(arg1, arg2: INTEGER): INTEGER; |
| BEGIN |
| sys.CODE("53"); (* push ebx *) |
| sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) |
| sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) |
| sys.CODE("CD40"); (* int 40h *) |
| sys.CODE("5B"); (* pop ebx *) |
| sys.CODE("C9"); (* leave *) |
| sys.CODE("C20800"); (* ret 08h *) |
| RETURN 0 |
| END sysfunc2; |
| PROCEDURE [stdcall] sysfunc3(arg1, arg2, arg3: INTEGER): INTEGER; |
| BEGIN |
| sys.CODE("53"); (* push ebx *) |
| sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) |
| sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) |
| sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) |
| sys.CODE("CD40"); (* int 40h *) |
| sys.CODE("5B"); (* pop ebx *) |
| sys.CODE("C9"); (* leave *) |
| sys.CODE("C20C00"); (* ret 0Ch *) |
| RETURN 0 |
| END sysfunc3; |
| PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER; |
| BEGIN |
| sys.CODE("53"); (* push ebx *) |
| 122,7 → 88,7 |
| PROCEDURE Time*(VAR sec, dsec: INTEGER); |
| VAR t: INTEGER; |
| BEGIN |
| t := sysfunc2(26, 9); |
| t := API.sysfunc2(26, 9); |
| sec := t DIV 100; |
| dsec := t MOD 100 |
| END Time; |
| 139,10 → 105,10 |
| BEGIN |
| Time(sec, dsec); |
| Lib := sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj")); |
| Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj")); |
| IF Lib # 0 THEN |
| GetProc(sys.ADR(con_init), "con_init"); |
| GetProc(sys.ADR(con_exit), "con_exit"); |
| GetProc(sys.ADR(con_init), "con_init"); |
| GetProc(sys.ADR(con_exit), "con_exit"); |
| GetProc(sys.ADR(con_write_asciiz), "con_write_asciiz"); |
| IF con_init # NIL THEN |
| con_init(-1, -1, -1, -1, sys.ADR("Oberon-07/11 for KolibriOS")) |
| 155,7 → 121,7 |
| IF con_exit # NIL THEN |
| con_exit(FALSE) |
| END; |
| n := sysfunc1(-1) |
| API.ExitProcess(0) |
| END ExitProcess; |
| PROCEDURE GetCommandLine*(): INTEGER; |
| 173,7 → 139,7 |
| END GetName; |
| PROCEDURE malloc*(size: INTEGER): INTEGER; |
| RETURN sysfunc3(68, 12, size) |
| RETURN API.sysfunc3(68, 12, size) |
| END malloc; |
| PROCEDURE CloseFile*(hObject: INTEGER); |
| /programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 |
|---|
| 0,0 → 1,107 |
| (* |
| Copyright 2017 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 |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE NetDevices; |
| IMPORT sys := SYSTEM, K := KOSAPI; |
| CONST |
| //net devices types |
| LOOPBACK* = 0; |
| ETH* = 1; |
| SLIP* = 2; |
| //Link status |
| LINK_DOWN* = 0; |
| LINK_UNKNOWN* = 1; |
| LINK_FD* = 2; //full duplex flag |
| LINK_10M* = 4; |
| LINK_100M* = 8; |
| LINK_1G* = 12; |
| TYPE |
| DEVICENAME* = ARRAY 64 OF CHAR; |
| PROCEDURE Number* (): INTEGER; |
| RETURN K.sysfunc2(74, -1) |
| END Number; |
| PROCEDURE Type* (num: INTEGER): INTEGER; |
| RETURN K.sysfunc2(74, num * 256) |
| END Type; |
| PROCEDURE Name* (num: INTEGER; VAR name: DEVICENAME): BOOLEAN; |
| VAR err: BOOLEAN; |
| BEGIN |
| err := K.sysfunc3(74, num * 256 + 1, sys.ADR(name[0])) = -1; |
| IF err THEN |
| name := "" |
| END |
| RETURN ~err |
| END Name; |
| PROCEDURE Reset* (num: INTEGER): BOOLEAN; |
| RETURN K.sysfunc2(74, num * 256 + 2) # -1 |
| END Reset; |
| PROCEDURE Stop* (num: INTEGER): BOOLEAN; |
| RETURN K.sysfunc2(74, num * 256 + 3) # -1 |
| END Stop; |
| PROCEDURE Pointer* (num: INTEGER): INTEGER; |
| RETURN K.sysfunc2(74, num * 256 + 4) |
| END Pointer; |
| PROCEDURE SentPackets* (num: INTEGER): INTEGER; |
| RETURN K.sysfunc2(74, num * 256 + 6) |
| END SentPackets; |
| PROCEDURE ReceivedPackets* (num: INTEGER): INTEGER; |
| RETURN K.sysfunc2(74, num * 256 + 7) |
| END ReceivedPackets; |
| PROCEDURE SentBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER; |
| RETURN K.sysfunc22(74, num * 256 + 8, hValue) |
| END SentBytes; |
| PROCEDURE ReceivedBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER; |
| RETURN K.sysfunc22(74, num * 256 + 9, hValue) |
| END ReceivedBytes; |
| PROCEDURE LinkStatus* (num: INTEGER): INTEGER; |
| RETURN K.sysfunc2(74, num * 256 + 10) |
| END LinkStatus; |
| END NetDevices. |
| /programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 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 |
| 28,6 → 28,7 |
| VAR |
| SelfName, rtab: INTEGER; CloseProc: PROC; |
| init: BOOLEAN; |
| PROCEDURE [stdcall] _halt*(n: INTEGER); |
| BEGIN |
| 116,26 → 117,18 |
| END |
| END _arrayrot; |
| PROCEDURE Min(a, b: INTEGER): INTEGER; |
| BEGIN |
| IF a > b THEN |
| a := b |
| END |
| RETURN a |
| END Min; |
| PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; |
| BEGIN |
| sys.CODE("8B4508"); // mov eax, [ebp + 08h] |
| sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] |
| sys.CODE("48"); // dec eax |
| // L1: |
| // L1: |
| sys.CODE("40"); // inc eax |
| sys.CODE("803800"); // cmp byte ptr [eax], 0 |
| sys.CODE("7403"); // jz L2 |
| sys.CODE("E2F8"); // loop L1 |
| sys.CODE("40"); // inc eax |
| // L2: |
| // L2: |
| sys.CODE("2B4508"); // sub eax, [ebp + 08h] |
| sys.CODE("C9"); // leave |
| sys.CODE("C20800"); // ret 08h |
| 144,7 → 137,7 |
| PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); |
| BEGIN |
| _savearr(Min(alen, blen), a, b); |
| _savearr(MIN(alen, blen), a, b); |
| IF blen > alen THEN |
| sys.PUT(b + alen, 0X) |
| END |
| 153,7 → 146,7 |
| PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b))); |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); |
| IF i = 0 THEN |
| i := _length(a) - _length(b) |
| END; |
| 252,7 → 245,8 |
| Int(code, int); |
| StrAppend(int) |
| END; |
| API.DebugMsg(sys.ADR(msg), SelfName) |
| API.DebugMsg(sys.ADR(msg), SelfName); |
| API.ExitThread(0) |
| END _assrt; |
| PROCEDURE [stdcall] _close*; |
| 264,11 → 258,14 |
| PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); |
| BEGIN |
| API.zeromem(gsize, gadr); |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL |
| IF ~init THEN |
| API.zeromem(gsize, gadr); |
| init := TRUE; |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL |
| END |
| END _init; |
| PROCEDURE SetClose*(proc: PROC); |
| /programs/develop/oberon07/Lib/Linux32/API.ob07 |
|---|
| 1,4 → 1,4 |
| (* |
| (* |
| Copyright 2016 Anton Krotov |
| This program is free software: you can redistribute it and/or modify |
| 27,22 → 27,22 |
| Param*: INTEGER; |
| sec* : INTEGER; |
| dsec* : INTEGER; |
| stdin* : INTEGER; |
| stdout* : INTEGER; |
| stderr* : INTEGER; |
| dlopen* : PROCEDURE [cdecl] (filename, flag: INTEGER): INTEGER; |
| dlsym* : PROCEDURE [cdecl] (handle, symbol: INTEGER): INTEGER; |
| _malloc* : PROCEDURE [cdecl] (size: INTEGER): INTEGER; |
| free* : PROCEDURE [cdecl] (ptr: INTEGER); |
| fopen* : PROCEDURE [cdecl] (fname, fmode: INTEGER): INTEGER; |
| sec* : INTEGER; |
| dsec* : INTEGER; |
| stdin* : INTEGER; |
| stdout* : INTEGER; |
| stderr* : INTEGER; |
| dlopen* : PROCEDURE [cdecl] (filename, flag: INTEGER): INTEGER; |
| dlsym* : PROCEDURE [cdecl] (handle, symbol: INTEGER): INTEGER; |
| _malloc* : PROCEDURE [cdecl] (size: INTEGER): INTEGER; |
| free* : PROCEDURE [cdecl] (ptr: INTEGER); |
| fopen* : PROCEDURE [cdecl] (fname, fmode: INTEGER): INTEGER; |
| fclose*, ftell* : PROCEDURE [cdecl] (file: INTEGER): INTEGER; |
| fwrite*, fread* : PROCEDURE [cdecl] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fseek* : PROCEDURE [cdecl] (file, offset, origin: INTEGER): INTEGER; |
| exit* : PROCEDURE [cdecl] (code: INTEGER); |
| strncmp* : PROCEDURE [cdecl] (str1, str2, n: INTEGER): INTEGER; |
| strlen* : PROCEDURE [cdecl] (str: INTEGER): INTEGER; |
| fseek* : PROCEDURE [cdecl] (file, offset, origin: INTEGER): INTEGER; |
| exit* : PROCEDURE [cdecl] (code: INTEGER); |
| strncmp* : PROCEDURE [cdecl] (str1, str2, n: INTEGER): INTEGER; |
| strlen* : PROCEDURE [cdecl] (str: INTEGER): INTEGER; |
| clock_gettime* : PROCEDURE [cdecl] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| PROCEDURE [stdcall] zeromem* (size, adr: INTEGER); |
| 103,6 → 103,11 |
| exit(code) |
| END ExitProcess; |
| PROCEDURE ExitThread* (code: INTEGER); |
| BEGIN |
| exit(code) |
| END ExitThread; |
| PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); |
| VAR H: INTEGER; |
| BEGIN |
| 116,19 → 121,19 |
| BEGIN |
| Param := esp; |
| sys.MOVE(Param + 12, sys.ADR(dlopen), 4); |
| sys.MOVE(Param + 16, sys.ADR(dlsym), 4); |
| sys.MOVE(Param + 20, sys.ADR(exit), 4); |
| sys.MOVE(Param + 24, sys.ADR(stdin), 4); |
| sys.MOVE(Param + 16, sys.ADR(dlsym), 4); |
| sys.MOVE(Param + 20, sys.ADR(exit), 4); |
| sys.MOVE(Param + 24, sys.ADR(stdin), 4); |
| sys.MOVE(Param + 28, sys.ADR(stdout), 4); |
| sys.MOVE(Param + 32, sys.ADR(stderr), 4); |
| sys.MOVE(Param + 36, sys.ADR(_malloc), 4); |
| sys.MOVE(Param + 40, sys.ADR(free), 4); |
| sys.MOVE(Param + 44, sys.ADR(fopen), 4); |
| sys.MOVE(Param + 40, sys.ADR(free), 4); |
| sys.MOVE(Param + 44, sys.ADR(fopen), 4); |
| sys.MOVE(Param + 48, sys.ADR(fclose), 4); |
| sys.MOVE(Param + 52, sys.ADR(fwrite), 4); |
| sys.MOVE(Param + 56, sys.ADR(fread), 4); |
| sys.MOVE(Param + 60, sys.ADR(fseek), 4); |
| sys.MOVE(Param + 64, sys.ADR(ftell), 4); |
| sys.MOVE(Param + 56, sys.ADR(fread), 4); |
| sys.MOVE(Param + 60, sys.ADR(fseek), 4); |
| sys.MOVE(Param + 64, sys.ADR(ftell), 4); |
| lib := dlopen(sys.ADR("libc.so.6"), 1); |
| ASSERT(lib # 0); |
| /programs/develop/oberon07/Lib/Linux32/RTL.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| (* |
| Copyright 2016, 2017 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 |
| 28,6 → 28,7 |
| VAR |
| SelfName, rtab: INTEGER; CloseProc: PROC; |
| init: BOOLEAN; |
| PROCEDURE [stdcall] _halt*(n: INTEGER); |
| BEGIN |
| 116,26 → 117,18 |
| END |
| END _arrayrot; |
| PROCEDURE Min(a, b: INTEGER): INTEGER; |
| BEGIN |
| IF a > b THEN |
| a := b |
| END |
| RETURN a |
| END Min; |
| PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; |
| BEGIN |
| sys.CODE("8B4508"); // mov eax, [ebp + 08h] |
| sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] |
| sys.CODE("48"); // dec eax |
| // L1: |
| // L1: |
| sys.CODE("40"); // inc eax |
| sys.CODE("803800"); // cmp byte ptr [eax], 0 |
| sys.CODE("7403"); // jz L2 |
| sys.CODE("E2F8"); // loop L1 |
| sys.CODE("40"); // inc eax |
| // L2: |
| // L2: |
| sys.CODE("2B4508"); // sub eax, [ebp + 08h] |
| sys.CODE("C9"); // leave |
| sys.CODE("C20800"); // ret 08h |
| 144,7 → 137,7 |
| PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); |
| BEGIN |
| _savearr(Min(alen, blen), a, b); |
| _savearr(MIN(alen, blen), a, b); |
| IF blen > alen THEN |
| sys.PUT(b + alen, 0X) |
| END |
| 153,7 → 146,7 |
| PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b))); |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); |
| IF i = 0 THEN |
| i := _length(a) - _length(b) |
| END; |
| 252,7 → 245,8 |
| Int(code, int); |
| StrAppend(int) |
| END; |
| API.DebugMsg(sys.ADR(msg), SelfName) |
| API.DebugMsg(sys.ADR(msg), SelfName); |
| API.ExitThread(0) |
| END _assrt; |
| PROCEDURE [stdcall] _close*; |
| 264,11 → 258,14 |
| PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); |
| BEGIN |
| API.zeromem(gsize, gadr); |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL; |
| IF ~init THEN |
| API.zeromem(gsize, gadr); |
| init := TRUE; |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL |
| END |
| END _init; |
| PROCEDURE SetClose*(proc: PROC); |
| /programs/develop/oberon07/Lib/Windows32/API.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| (* |
| Copyright 2016, 2017 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 |
| 25,6 → 25,8 |
| Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER; |
| MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| ExitProcess*: PROCEDURE [winapi] (code: INTEGER); |
| ExitThread*: PROCEDURE [winapi] (code: INTEGER); |
| GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER; |
| strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER; |
| GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER; |
| 62,6 → 64,8 |
| lib := LoadLibraryA(sys.ADR("kernel32.dll")); |
| GetProc("ExitProcess", lib, sys.ADR(ExitProcess)); |
| GetProc("ExitThread", lib, sys.ADR(ExitThread)); |
| GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId)); |
| GetProc("GlobalAlloc", lib, sys.ADR(Alloc)); |
| GetProc("GlobalFree", lib, sys.ADR(Free)); |
| /programs/develop/oberon07/Lib/Windows32/HOST.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| (* |
| Copyright 2016, 2017 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 |
| 49,7 → 49,6 |
| ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER; |
| GetCommandLine*: PROCEDURE [winapi] (): INTEGER; |
| GetTickCount: PROCEDURE [winapi] (): INTEGER; |
| Alloc: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER; |
| ExitProcess*: PROCEDURE [winapi] (code: INTEGER); |
| SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; |
| 71,7 → 70,7 |
| END OutString; |
| PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER; |
| VAR res: INTEGER; |
| VAR res: INTEGER; |
| BEGIN |
| res := _CreateFile(sys.ADR(FName[0]), 0C0000000H, 0, 0, 2, 80H, 0); |
| IF res = -1 THEN |
| 112,12 → 111,12 |
| END Time; |
| PROCEDURE malloc*(size: INTEGER): INTEGER; |
| RETURN Alloc(64, size) |
| RETURN API.Alloc(64, size) |
| END malloc; |
| PROCEDURE init*; |
| VAR lib: INTEGER; |
| BEGIN |
| BEGIN |
| lib := API.LoadLibraryA(sys.ADR("kernel32.dll")); |
| GetProc("GetTickCount", lib, sys.ADR(GetTickCount)); |
| Time(sec, dsec); |
| 128,9 → 127,8 |
| GetProc("ReadFile", lib, sys.ADR(ReadFile)); |
| GetProc("WriteFile", lib, sys.ADR(WriteFile)); |
| GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine)); |
| GetProc("ExitProcess", lib, sys.ADR(ExitProcess)); |
| GetProc("GlobalAlloc", lib, sys.ADR(Alloc)); |
| GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer)); |
| ExitProcess := API.ExitProcess; |
| hConsoleOutput := GetStdHandle(-11) |
| END init; |
| /programs/develop/oberon07/Lib/Windows32/RTL.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| (* |
| Copyright 2016, 2017 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 |
| 28,6 → 28,8 |
| VAR |
| SelfName, rtab: INTEGER; CloseProc: PROC; |
| init: BOOLEAN; |
| main_thread_id: INTEGER; |
| PROCEDURE [stdcall] _halt*(n: INTEGER); |
| BEGIN |
| 116,26 → 118,18 |
| END |
| END _arrayrot; |
| PROCEDURE Min(a, b: INTEGER): INTEGER; |
| BEGIN |
| IF a > b THEN |
| a := b |
| END |
| RETURN a |
| END Min; |
| PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; |
| BEGIN |
| sys.CODE("8B4508"); // mov eax, [ebp + 08h] |
| sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] |
| sys.CODE("48"); // dec eax |
| // L1: |
| // L1: |
| sys.CODE("40"); // inc eax |
| sys.CODE("803800"); // cmp byte ptr [eax], 0 |
| sys.CODE("7403"); // jz L2 |
| sys.CODE("E2F8"); // loop L1 |
| sys.CODE("40"); // inc eax |
| // L2: |
| // L2: |
| sys.CODE("2B4508"); // sub eax, [ebp + 08h] |
| sys.CODE("C9"); // leave |
| sys.CODE("C20800"); // ret 08h |
| 144,7 → 138,7 |
| PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); |
| BEGIN |
| _savearr(Min(alen, blen), a, b); |
| _savearr(MIN(alen, blen), a, b); |
| IF blen > alen THEN |
| sys.PUT(b + alen, 0X) |
| END |
| 153,7 → 147,7 |
| PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b))); |
| i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); |
| IF i = 0 THEN |
| i := _length(a) - _length(b) |
| END; |
| 252,7 → 246,11 |
| Int(code, int); |
| StrAppend(int) |
| END; |
| API.DebugMsg(sys.ADR(msg), SelfName) |
| IF API.GetCurrentThreadId() = main_thread_id THEN |
| API.ExitProcess(0) |
| ELSE |
| API.ExitThread(0) |
| END |
| END _assrt; |
| PROCEDURE [stdcall] _close*; |
| 264,11 → 262,15 |
| PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); |
| BEGIN |
| API.zeromem(gsize, gadr); |
| API.init(esp); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL; |
| IF ~init THEN |
| API.zeromem(gsize, gadr); |
| init := TRUE; |
| API.init(esp); |
| main_thread_id := API.GetCurrentThreadId(); |
| SelfName := self; |
| rtab := rec; |
| CloseProc := NIL |
| END |
| END _init; |
| PROCEDURE SetClose*(proc: PROC); |
| /programs/develop/oberon07/Source/Compiler.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 Anton Krotov |
| This file is part of Compiler. |
| 52,10 → 52,10 |
| stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8; |
| stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15; |
| stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22; |
| stBITS = 23; stLSR = 24; stLENGTH = 25; |
| stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27; |
| sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105; |
| sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; |
| sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109; |
| TYPE |
| 198,11 → 198,11 |
| loc := id.Offset |
| ELSIF (id.VarKind = DECL.paramvar) OR (id.T.tType IN TSTRUCT) THEN |
| IF DECL.Dim(e.T) > 0 THEN |
| n := DECL.Dim(e.T); |
| FOR i := n TO 1 BY -1 DO |
| X86.LocalAdr(id.Offset + i * 4, bases); |
| X86.Load(TINTEGER) |
| END |
| n := DECL.Dim(e.T); |
| FOR i := n TO 1 BY -1 DO |
| X86.LocalAdr(id.Offset + i * 4, bases); |
| X86.Load(TINTEGER) |
| END |
| END; |
| X86.LocalAdr(id.Offset, bases); |
| X86.Load(TINTEGER) |
| 219,9 → 219,9 |
| ELSIF id.T.tType = TSTRING THEN |
| s := DECL.GetString(e.Value); |
| IF s.Len = 1 THEN |
| X86.PushConst(ORD(s.Str[0])) |
| X86.PushConst(ORD(s.Str[0])) |
| ELSE |
| X86.PushInt(s.Number) |
| X86.PushInt(s.Number) |
| END |
| END |
| |IDPROC: |
| 249,13 → 249,13 |
| e.deref := FALSE; |
| Assert2(e.T.tType IN TOBJECT, 105); |
| IF e.T.tType = TPOINTER THEN |
| e.Read := FALSE; |
| LoadVar; |
| e.T := e.T.Base; |
| X86.Load(TINTEGER); |
| IF ~guard THEN |
| X86.CheckNIL |
| END |
| e.Read := FALSE; |
| LoadVar; |
| e.T := e.T.Base; |
| X86.Load(TINTEGER); |
| IF ~guard THEN |
| X86.CheckNIL |
| END |
| END; |
| NextCheck(lxIDENT); |
| Coord(coord); |
| 262,19 → 262,19 |
| name := SCAN.id; |
| T := e.T; |
| REPEAT |
| f := DECL.GetField(T, name); |
| T := T.Base |
| f := DECL.GetField(T, name); |
| T := T.Base |
| UNTIL (f # NIL) OR (T = NIL); |
| Assert(f # NIL, coord, 99); |
| IF f.Unit # DECL.unit THEN |
| Assert(f.Export, coord, 99) |
| Assert(f.Export, coord, 99) |
| END; |
| IF glob # -1 THEN |
| glob := glob + f.Offset |
| glob := glob + f.Offset |
| ELSIF loc # -1 THEN |
| loc := loc + f.Offset |
| loc := loc + f.Offset |
| ELSE |
| X86.Field(f.Offset) |
| X86.Field(f.Offset) |
| END; |
| e.T := f.T; |
| e.vparam := FALSE; |
| 283,29 → 283,29 |
| |lxLSquare: |
| LoadVar; |
| REPEAT |
| Assert2(e.T.tType = TARRAY, 102); |
| NextCoord(coord); |
| pExpr(e1); |
| IntType(e1.T, coord); |
| Load(e1); |
| IF e.T.Len = 0 THEN |
| BaseT := DECL.OpenBase(e.T); |
| X86.PushConst(BaseT.Size); |
| X86.OpenIdx(DECL.Dim(e.T)) |
| ELSE |
| IF e1.eType = eCONST THEN |
| idx := FLOOR(e1.Value); |
| Assert((idx >= 0) & (idx < e.T.Len), coord, 159); |
| IF e.T.Base.Size # 1 THEN |
| X86.Drop; |
| X86.PushConst(e.T.Base.Size * idx) |
| END; |
| X86.Idx |
| ELSE |
| X86.FixIdx(e.T.Len, e.T.Base.Size) |
| END |
| END; |
| e.T := e.T.Base |
| Assert2(e.T.tType = TARRAY, 102); |
| NextCoord(coord); |
| pExpr(e1); |
| IntType(e1.T, coord); |
| Load(e1); |
| IF e.T.Len = 0 THEN |
| BaseT := DECL.OpenBase(e.T); |
| X86.PushConst(BaseT.Size); |
| X86.OpenIdx(DECL.Dim(e.T)) |
| ELSE |
| IF e1.eType = eCONST THEN |
| idx := FLOOR(e1.Value); |
| Assert((idx >= 0) & (idx < e.T.Len), coord, 159); |
| IF e.T.Base.Size # 1 THEN |
| X86.Drop; |
| X86.PushConst(e.T.Base.Size * idx) |
| END; |
| X86.Idx |
| ELSE |
| X86.FixIdx(e.T.Len, e.T.Base.Size) |
| END |
| END; |
| e.T := e.T.Base |
| UNTIL SCAN.tLex # lxComma; |
| Check(lxRSquare); |
| e.vparam := FALSE; |
| 317,7 → 317,7 |
| e.Read := FALSE; |
| X86.Load(TINTEGER); |
| IF ~guard THEN |
| X86.CheckNIL |
| X86.CheckNIL |
| END; |
| e.T := e.T.Base; |
| e.vparam := FALSE; |
| 327,36 → 327,36 |
| |lxLRound: |
| LoadVar; |
| IF e.T.tType IN TOBJECT THEN |
| IF e.T.tType = TRECORD THEN |
| Assert2(e.vparam, 108) |
| END; |
| NextCheck(lxIDENT); |
| Coord(coord); |
| T := DECL.IdType(coord); |
| Assert(T # NIL, coord, 42); |
| IF e.T.tType = TRECORD THEN |
| Assert(T.tType = TRECORD, coord, 106) |
| ELSE |
| Assert(T.tType = TPOINTER, coord, 107) |
| END; |
| Assert(BaseOf(e.T, T), coord, 108); |
| e.T := T; |
| Check(lxRRound); |
| Next; |
| IF e.T.tType = TPOINTER THEN |
| IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN |
| X86.DupLoadCheck |
| ELSE |
| X86.DupLoad |
| END; |
| guard := TRUE; |
| T := T.Base |
| ELSE |
| X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) |
| END; |
| X86.Guard(T.Number, FALSE) |
| IF e.T.tType = TRECORD THEN |
| Assert2(e.vparam, 108) |
| END; |
| NextCheck(lxIDENT); |
| Coord(coord); |
| T := DECL.IdType(coord); |
| Assert(T # NIL, coord, 42); |
| IF e.T.tType = TRECORD THEN |
| Assert(T.tType = TRECORD, coord, 106) |
| ELSE |
| Assert(T.tType = TPOINTER, coord, 107) |
| END; |
| Assert(BaseOf(e.T, T), coord, 108); |
| e.T := T; |
| Check(lxRRound); |
| Next; |
| IF e.T.tType = TPOINTER THEN |
| IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN |
| X86.DupLoadCheck |
| ELSE |
| X86.DupLoad |
| END; |
| guard := TRUE; |
| T := T.Base |
| ELSE |
| X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) |
| END; |
| X86.Guard(T.Number, FALSE) |
| ELSE |
| break := TRUE |
| break := TRUE |
| END |
| ELSE |
| break := TRUE |
| 393,8 → 393,10 |
| pExpr(b); |
| IntType(b.T, coord); |
| IF b.eType = eCONST THEN |
| Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53); |
| Assert(a.Value <= b.Value, coord, 54) |
| Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53); |
| IF a.eType = eCONST THEN |
| Assert(a.Value <= b.Value, coord, 54) |
| END |
| END; |
| Load(b) |
| ELSE |
| 547,10 → 549,10 |
| Load(e1); |
| IF e1.eType = eCONST THEN |
| IF e1.T.tType = TSTRING THEN |
| str := DECL.GetString(e1.Value); |
| e.Value := LONG(FLT(ORD(str.Str[0]))) |
| str := DECL.GetString(e1.Value); |
| e.Value := LONG(FLT(ORD(str.Str[0]))) |
| ELSE |
| e.Value := e1.Value |
| e.Value := e1.Value |
| END; |
| e.eType := eCONST |
| END; |
| 606,8 → 608,8 |
| IF e1.T.tType = TSTRING THEN |
| str := DECL.GetString(e1.Value); |
| IF str.Len = 1 THEN |
| X86.Mono(str.Number); |
| X86.StrMono |
| X86.Mono(str.Number); |
| X86.StrMono |
| END; |
| e.Value := LONG(FLT(LENGTH(str.Str))); |
| e.eType := eCONST |
| 615,6 → 617,32 |
| Str(e1); |
| e.T := inttype; |
| X86.StFunc(X86.stLENGTH) |
| |stMIN, stMAX: |
| pExpr(e1); |
| IntType(e1.T, coord); |
| Load(e1); |
| Check(lxComma); |
| NextCoord(coord); |
| pExpr(e2); |
| IntType(e2.T, coord); |
| Load(e2); |
| IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN |
| a := FLOOR(e1.Value); |
| b := FLOOR(e2.Value); |
| CASE func OF |
| |stMIN: a := MIN(a, b) |
| |stMAX: a := MAX(a, b) |
| ELSE |
| END; |
| e.Value := LONG(FLT(a)); |
| e.eType := eCONST |
| END; |
| IF func = stMIN THEN |
| X86.StFunc(X86.stMIN) |
| ELSE |
| X86.StFunc(X86.stMAX) |
| END; |
| e.T := inttype |
| |sysADR: |
| Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43); |
| IF SCAN.tLex = lxIDENT THEN |
| 621,7 → 649,7 |
| Designator(e1); |
| Assert((e1.eType = eVAR) OR (e1.eType = ePROC) OR (e1.T = strtype), coord, 43); |
| IF e1.eType = ePROC THEN |
| X86.PushInt(e1.id.Number) |
| X86.PushInt(e1.id.Number) |
| END |
| ELSE |
| pFactor(e1) |
| 629,8 → 657,8 |
| IF e1.T = strtype THEN |
| str := DECL.GetString(e1.Value); |
| IF str.Len = 1 THEN |
| X86.Drop; |
| X86.PushInt(str.Number) |
| X86.Drop; |
| X86.PushInt(str.Number) |
| END |
| END; |
| e.T := inttype; |
| 645,7 → 673,7 |
| e.T := inttype; |
| Assert(T.tType IN TOBJECT, coord, 47); |
| IF T.tType = TPOINTER THEN |
| T := T.Base |
| T := T.Base |
| END; |
| e.Value := LONG(FLT(T.Number)); |
| X86.PushConst(T.Number) |
| 676,9 → 704,9 |
| VAR Res: BOOLEAN; |
| BEGIN |
| IF (T1.tType = TARRAY) & (T2.tType = TARRAY) & (T1.Len = 0) & (T2.Len = 0) THEN |
| Res := TypeComp(T1.Base, T2.Base) |
| Res := TypeComp(T1.Base, T2.Base) |
| ELSE |
| Res := ProcTypeComp1(T1, T2) |
| Res := ProcTypeComp1(T1, T2) |
| END |
| RETURN Res |
| END TypeComp; |
| 689,8 → 717,8 |
| i := 0; |
| res := FALSE; |
| WHILE (i < sp) & ~res DO |
| res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1)); |
| INC(i) |
| res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1)); |
| INC(i) |
| END |
| RETURN res |
| END Check; |
| 703,16 → 731,16 |
| Res := TRUE |
| ELSE |
| IF (T1.tType = TPROC) & (T2.tType = TPROC) & (T1 # T2) THEN |
| Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base); |
| fp := T1.Fields.First(DECL.FIELD); |
| ft := T2.Fields.First(DECL.FIELD); |
| WHILE Res & (fp # NIL) DO |
| Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T); |
| fp := fp.Next(DECL.FIELD); |
| ft := ft.Next(DECL.FIELD) |
| END |
| Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base); |
| fp := T1.Fields.First(DECL.FIELD); |
| ft := T2.Fields.First(DECL.FIELD); |
| WHILE Res & (fp # NIL) DO |
| Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T); |
| fp := fp.Next(DECL.FIELD); |
| ft := ft.Next(DECL.FIELD) |
| END |
| ELSE |
| Res := T1 = T2 |
| Res := T1 = T2 |
| END |
| END; |
| DEC(sp) |
| 750,25 → 778,25 |
| |TARRAY: |
| IF param THEN |
| IF T.Len = 0 THEN |
| IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN |
| Res := TRUE |
| ELSE |
| Res := ArrComp(e.T, T) |
| END |
| IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN |
| Res := TRUE |
| ELSE |
| Res := ArrComp(e.T, T) |
| END |
| ELSE |
| IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN |
| Res := LenString(e.Value) <= T.Len |
| ELSE |
| Res := e.T = T |
| END |
| IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN |
| Res := LenString(e.Value) <= T.Len |
| ELSE |
| Res := e.T = T |
| END |
| END |
| ELSE |
| IF T.Len = 0 THEN |
| Res := FALSE |
| Res := FALSE |
| ELSIF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN |
| Res := LenString(e.Value) <= T.Len |
| Res := LenString(e.Value) <= T.Len |
| ELSE |
| Res := e.T = T |
| Res := e.T = T |
| END |
| END |
| |TRECORD: Res := BaseOf(T, e.T) |
| 789,17 → 817,17 |
| CASE T.tType OF |
| |TINTEGER, TREAL, TLONGREAL, TCHAR, |
| TSET, TBOOLEAN, TPOINTER, TCARD16: |
| Res := e.T = T |
| Res := e.T = T |
| |TARRAY: |
| IF T.Len > 0 THEN |
| Res := e.T = T |
| ELSE |
| Res := ArrComp(e.T, T) |
| END |
| IF T.Len > 0 THEN |
| Res := e.T = T |
| ELSE |
| Res := ArrComp(e.T, T) |
| END |
| |TRECORD: |
| Res := BaseOf(T, e.T) |
| Res := BaseOf(T, e.T) |
| |TPROC: |
| Res := ProcTypeComp(e.T, T) |
| Res := ProcTypeComp(e.T, T) |
| ELSE |
| END |
| ELSE |
| 826,12 → 854,12 |
| END; |
| IF param.ByRef & (e1.T.tType = TRECORD) THEN |
| IF e1.vparam THEN |
| X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); |
| X86.Load(TINTEGER) |
| X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); |
| X86.Load(TINTEGER) |
| ELSIF e1.deref THEN |
| X86.DerefType(0) |
| X86.DerefType(0) |
| ELSE |
| X86.PushConst(e1.T.Number) |
| X86.PushConst(e1.T.Number) |
| END |
| END; |
| IF ~param.ByRef & (param.T.tType IN TFLOAT) THEN |
| 840,11 → 868,11 |
| IF (e1.T.tType = TSTRING) & (param.T.tType = TARRAY) THEN |
| s := DECL.GetString(e1.Value); |
| IF s.Len = 1 THEN |
| X86.Mono(s.Number) |
| X86.Mono(s.Number) |
| END; |
| IF param.T.Len = 0 THEN |
| A[0] := s.Len + 1; |
| X86.OpenArray(A, 1) |
| A[0] := s.Len + 1; |
| X86.OpenArray(A, 1) |
| END |
| END; |
| IF (e1.T.tType = TARRAY) & (DECL.Dim(param.T) > DECL.Dim(e1.T)) THEN |
| 851,13 → 879,13 |
| n := DECL.Dim(param.T) - DECL.Dim(e1.T); |
| TA := DECL.OpenBase(e1.T); |
| FOR i := 0 TO n - 1 DO |
| A[i] := TA.Len; |
| TA := TA.Base |
| A[i] := TA.Len; |
| TA := TA.Base |
| END; |
| IF DECL.Dim(e1.T) = 0 THEN |
| X86.OpenArray(A, n) |
| X86.OpenArray(A, n) |
| ELSE |
| X86.ExtArray(A, n, DECL.Dim(e1.T)) |
| X86.ExtArray(A, n, DECL.Dim(e1.T)) |
| END |
| END; |
| param := param.Next(DECL.FIELD); |
| 881,24 → 909,24 |
| Designator(e); |
| IF e.eType = ePROC THEN |
| IF SCAN.tLex = lxLRound THEN |
| Assert2(e.id.T.Base.tType # TVOID, 73); |
| Next; |
| X86.PushCall(begcall); |
| Call(e.id.T.Fields.First(DECL.FIELD)); |
| X86.EndCall; |
| e.eType := eEXP; |
| e.T := e.id.T.Base; |
| IF e.id.Level = 3 THEN |
| ccall := 0 |
| ELSIF e.id.Level > DECL.curBlock.Level THEN |
| ccall := 1 |
| ELSE |
| ccall := 2 |
| END; |
| X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3, |
| DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize) |
| Assert2(e.id.T.Base.tType # TVOID, 73); |
| Next; |
| X86.PushCall(begcall); |
| Call(e.id.T.Fields.First(DECL.FIELD)); |
| X86.EndCall; |
| e.eType := eEXP; |
| e.T := e.id.T.Base; |
| IF e.id.Level = 3 THEN |
| ccall := 0 |
| ELSIF e.id.Level > DECL.curBlock.Level THEN |
| ccall := 1 |
| ELSE |
| ccall := 2 |
| END; |
| X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3, |
| DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize) |
| ELSE |
| X86.PushInt(e.id.Number) |
| X86.PushInt(e.id.Number) |
| END |
| ELSIF (e.eType = eVAR) & (e.T.tType = TPROC) & (SCAN.tLex = lxLRound) THEN |
| Assert2(e.T.Base.tType # TVOID, 73); |
| 934,9 → 962,9 |
| e.Value := LONG(FLT(p)); |
| s := DECL.GetString(e.Value); |
| IF s.Len = 1 THEN |
| X86.PushConst(ORD(s.Str[0])) |
| X86.PushConst(ORD(s.Str[0])) |
| ELSE |
| X86.PushInt(s.Number) |
| X86.PushInt(s.Number) |
| END |
| ELSE |
| str2 := DECL.AddMono(SCAN.vCHX); |
| 1037,17 → 1065,17 |
| Assert(m # 0, coord, 48); |
| n := log2(m); |
| IF n = -1 THEN |
| X86.idivmod(Op = lxMOD) |
| X86.idivmod(Op = lxMOD) |
| ELSE |
| X86.Drop; |
| IF Op = lxMOD THEN |
| n := ORD(-BITS(LSL(-1, n))); |
| X86.PushConst(n); |
| X86.Set(lxMult) |
| ELSE |
| X86.PushConst(n); |
| X86.StFunc(X86.stASR) |
| END |
| X86.Drop; |
| IF Op = lxMOD THEN |
| n := ORD(-BITS(LSL(-1, n))); |
| X86.PushConst(n); |
| X86.Set(lxMult) |
| ELSE |
| X86.PushConst(n); |
| X86.StFunc(X86.stASR) |
| END |
| END |
| ELSE |
| X86.idivmod(Op = lxMOD) |
| 1146,9 → 1174,9 |
| IF (uOp = lxMinus) & (e.eType = eCONST) THEN |
| CASE e.T.tType OF |
| |TINTEGER: |
| Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER) |
| Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER) |
| |TSET: |
| e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value))))) |
| e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value))))) |
| ELSE |
| END; |
| e.Value := -e.Value |
| 1189,7 → 1217,7 |
| IF Op = lxIS THEN |
| Assert(e.T.tType IN TOBJECT, coord, 37); |
| IF e.T.tType = TRECORD THEN |
| Assert(e.vparam, coord, 37) |
| Assert(e.vparam, coord, 37) |
| END; |
| Check(lxIDENT); |
| Coord(coord2); |
| 1196,18 → 1224,18 |
| T := DECL.IdType(coord2); |
| Assert(T # NIL, coord2, 42); |
| IF e.T.tType = TRECORD THEN |
| Assert(T.tType = TRECORD, coord2, 106) |
| Assert(T.tType = TRECORD, coord2, 106) |
| ELSE |
| Assert(T.tType = TPOINTER, coord2, 107) |
| Assert(T.tType = TPOINTER, coord2, 107) |
| END; |
| Assert(BaseOf(e.T, T), coord, 37); |
| IF e.T.tType = TRECORD THEN |
| X86.Drop; |
| X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) |
| X86.Drop; |
| X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) |
| END; |
| Load(e); |
| IF e.T.tType = TPOINTER THEN |
| T := T.Base |
| T := T.Base |
| END; |
| X86.Guard(T.Number, TRUE); |
| e.T := booltype; |
| 1228,16 → 1256,16 |
| IF ~DECL.Const THEN |
| CASE e.T.tType OF |
| |TREAL, TLONGREAL: |
| X86.PushFlt(e.Value) |
| X86.PushFlt(e.Value) |
| |TINTEGER, TSET, TBOOLEAN, TNIL: |
| X86.PushConst(FLOOR(e.Value)) |
| X86.PushConst(FLOOR(e.Value)) |
| |TSTRING: |
| s := DECL.GetString(e.Value); |
| IF s.Len = 1 THEN |
| X86.PushConst(ORD(s.Str[0])) |
| ELSE |
| X86.PushInt(s.Number) |
| END |
| s := DECL.GetString(e.Value); |
| IF s.Len = 1 THEN |
| X86.PushConst(ORD(s.Str[0])) |
| ELSE |
| X86.PushInt(s.Number) |
| END |
| ELSE |
| END |
| END |
| 1468,32 → 1496,32 |
| iValue := FLOOR(Value); |
| Assert(iValue # 0, coord, 122); |
| IF iValue < 0 THEN |
| IF proc = stINC THEN |
| proc := stDEC |
| ELSE |
| proc := stINC |
| END; |
| iValue := -iValue |
| IF proc = stINC THEN |
| proc := stDEC |
| ELSE |
| proc := stINC |
| END; |
| iValue := -iValue |
| END; |
| IF iValue # 1 THEN |
| X86.PushConst(iValue); |
| IF proc = stDEC THEN |
| X86.StProc(X86.stDEC) |
| ELSE |
| X86.StProc(X86.stINC) |
| END |
| X86.PushConst(iValue); |
| IF proc = stDEC THEN |
| X86.StProc(X86.stDEC) |
| ELSE |
| X86.StProc(X86.stINC) |
| END |
| ELSE |
| IF proc = stDEC THEN |
| X86.StProc(X86.stDEC1) |
| ELSE |
| X86.StProc(X86.stINC1) |
| END |
| IF proc = stDEC THEN |
| X86.StProc(X86.stDEC1) |
| ELSE |
| X86.StProc(X86.stINC1) |
| END |
| END |
| ELSE |
| IF proc = stDEC THEN |
| X86.StProc(X86.stDEC1) |
| X86.StProc(X86.stDEC1) |
| ELSE |
| X86.StProc(X86.stINC1) |
| X86.StProc(X86.stINC1) |
| END |
| END |
| |stINCL, stEXCL: |
| 1521,8 → 1549,8 |
| IF e1.T.tType = TSTRING THEN |
| str := DECL.GetString(e1.Value); |
| IF str.Len = 1 THEN |
| X86.Mono(str.Number); |
| X86.StrMono |
| X86.Mono(str.Number); |
| X86.StrMono |
| END |
| END; |
| Str(e1); |
| 1571,9 → 1599,9 |
| Assert(e2.T.tType = TINTEGER, coord, 128); |
| Assert(~e2.Read, coord, 115); |
| IF e1.T.tType = TLONGREAL THEN |
| X86.StProc(X86.stUNPK) |
| X86.StProc(X86.stUNPK) |
| ELSE |
| X86.StProc(X86.stUNPK1) |
| X86.StProc(X86.stUNPK1) |
| END |
| ELSE |
| Expr(e2); |
| 1580,9 → 1608,9 |
| IntType(e2.T, coord); |
| Load(e2); |
| IF e1.T.tType = TLONGREAL THEN |
| X86.StProc(X86.stPACK) |
| X86.StProc(X86.stPACK) |
| ELSE |
| X86.StProc(X86.stPACK1) |
| X86.StProc(X86.stPACK1) |
| END |
| END |
| |sysPUT, sysGET: |
| 1606,9 → 1634,9 |
| Expr(e2); |
| Assert(~(e2.T.tType IN TSTRUCT), coord, 90); |
| IF e2.T.tType = TSTRING THEN |
| Assert(LenString(e2.Value) = 1, coord, 94) |
| Assert(LenString(e2.Value) = 1, coord, 94) |
| ELSIF e2.T.tType = TVOID THEN |
| e2.T := inttype |
| e2.T := inttype |
| END; |
| Load(e2); |
| X86.Save(e2.T.tType) |
| 1636,12 → 1664,29 |
| Expr(e1); |
| IntType(e1.T, coord); |
| Load(e1); |
| |sysCOPY: |
| begcall := X86.current; |
| Designator(e1); |
| Assert(e1.eType = eVAR, coord, 63); |
| Check(lxComma); |
| X86.PushCall(begcall); |
| X86.Param; |
| NextCoord(coord); |
| Designator(e1); |
| Assert(e1.eType = eVAR, coord, 63); |
| Assert(~e1.Read, coord, 115); |
| Check(lxComma); |
| X86.EndCall; |
| NextCoord(coord); |
| Expr(e1); |
| IntType(e1.T, coord); |
| Load(e1); |
| ELSE |
| Assert(FALSE, coord2, 132) |
| END; |
| Check(lxRRound); |
| Next; |
| IF proc = sysMOVE THEN |
| IF (proc = sysMOVE) OR (proc = sysCOPY) THEN |
| X86.StProc(X86.sysMOVE) |
| END |
| END StProc; |
| 1664,12 → 1709,12 |
| X86.PushConst(e1.T.Size); |
| X86.PushConst(e1.T.Number); |
| IF e1.vparam THEN |
| X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); |
| X86.Load(TINTEGER) |
| X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); |
| X86.Load(TINTEGER) |
| ELSIF e1.deref THEN |
| X86.DerefType(12) |
| X86.DerefType(12) |
| ELSE |
| X86.PushConst(e1.T.Number) |
| X86.PushConst(e1.T.Number) |
| END |
| ELSIF e2.T.tType = TARRAY THEN |
| X86.PushConst(e2.T.Size) |
| 1676,9 → 1721,9 |
| ELSIF (e2.T.tType = TSTRING) & (e1.T.tType = TARRAY) THEN |
| s := DECL.GetString(e2.Value); |
| IF s.Len = 1 THEN |
| X86.Mono(s.Number) |
| X86.Mono(s.Number) |
| END; |
| X86.PushConst(UTILS.min(s.Len + 1, e1.T.Len)) |
| X86.PushConst(MIN(s.Len + 1, e1.T.Len)) |
| END; |
| X86.Save(e1.T.tType) |
| ELSIF e1.eType = ePROC THEN |
| 1718,7 → 1763,7 |
| Assert(AssComp(e2, e1.T, FALSE), coord, 131); |
| Assert(~((e2.eType = ePROC) & (e2.id.Level > 3)), coord, 116); |
| IF e2.eType = eVAR THEN |
| X86.Load(TPROC) |
| X86.Load(TPROC) |
| END; |
| X86.Save(TPROC) |
| ELSE |
| 1779,8 → 1824,8 |
| PROCEDURE hexdgt(c: CHAR): BOOLEAN; |
| RETURN ("0" <= c) & (c <= "9") OR |
| ("A" <= c) & (c <= "F") OR |
| ("a" <= c) & (c <= "f") |
| ("A" <= c) & (c <= "F") OR |
| ("a" <= c) & (c <= "f") |
| END hexdgt; |
| PROCEDURE hex(c: CHAR): INTEGER; |
| 1787,11 → 1832,11 |
| VAR res: INTEGER; |
| BEGIN |
| IF ("0" <= c) & (c <= "9") THEN |
| res := ORD(c) - ORD("0") |
| res := ORD(c) - ORD("0") |
| ELSIF ("A" <= c) & (c <= "F") THEN |
| res := ORD(c) - ORD("A") + 10 |
| res := ORD(c) - ORD("A") + 10 |
| ELSIF ("a" <= c) & (c <= "f") THEN |
| res := ORD(c) - ORD("a") + 10 |
| res := ORD(c) - ORD("a") + 10 |
| END |
| RETURN res |
| END hex; |
| /programs/develop/oberon07/Source/DECL.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 Anton Krotov |
| This file is part of Compiler. |
| 43,10 → 43,10 |
| stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8; |
| stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15; |
| stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22; |
| stBITS = 23; stLSR = 24; stLENGTH = 25; |
| stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27; |
| sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105; |
| sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; |
| sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109; |
| TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; TNIL = 8; |
| TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14; |
| 261,25 → 261,25 |
| BEGIN |
| IF SCAN.tLex # key THEN |
| CASE key OF |
| |lxMODULE: code := 21 |
| |lxIDENT: code := 22 |
| |lxSemi: code := 23 |
| |lxEND: code := 24 |
| |lxDot: code := 25 |
| |lxEQ: code := 35 |
| |lxRRound: code := 38 |
| |lxTO: code := 40 |
| |lxOF: code := 41 |
| |lxRCurly: code := 51 |
| |lxLRound: code := 56 |
| |lxComma: code := 61 |
| |lxTHEN: code := 98 |
| |lxMODULE: code := 21 |
| |lxIDENT: code := 22 |
| |lxSemi: code := 23 |
| |lxEND: code := 24 |
| |lxDot: code := 25 |
| |lxEQ: code := 35 |
| |lxRRound: code := 38 |
| |lxTO: code := 40 |
| |lxOF: code := 41 |
| |lxRCurly: code := 51 |
| |lxLRound: code := 56 |
| |lxComma: code := 61 |
| |lxTHEN: code := 98 |
| |lxRSquare: code := 109 |
| |lxDO: code := 118 |
| |lxUNTIL: code := 119 |
| |lxAssign: code := 120 |
| |lxRETURN: code := 124 |
| |lxColon: code := 157 |
| |lxDO: code := 118 |
| |lxUNTIL: code := 119 |
| |lxAssign: code := 120 |
| |lxRETURN: code := 124 |
| |lxColon: code := 157 |
| ELSE |
| END; |
| Assert2(FALSE, code) |
| 386,37 → 386,39 |
| PROCEDURE StIdent; |
| BEGIN |
| Guard; |
| PushStProc("ABS", stABS); |
| PushStProc("ASR", stASR); |
| PushStProc("ASSERT", stASSERT); |
| PushStProc("ABS", stABS); |
| PushStProc("ASR", stASR); |
| PushStProc("ASSERT", stASSERT); |
| PushStType("BOOLEAN", TBOOLEAN); |
| PushStType("CHAR", TCHAR); |
| PushStProc("CHR", stCHR); |
| PushStProc("COPY", stCOPY); |
| PushStProc("DEC", stDEC); |
| PushStType("CHAR", TCHAR); |
| PushStProc("CHR", stCHR); |
| PushStProc("COPY", stCOPY); |
| PushStProc("DEC", stDEC); |
| PushStProc("DISPOSE", stDISPOSE); |
| PushStProc("EXCL", stEXCL); |
| PushStProc("FLOOR", stFLOOR); |
| PushStProc("FLT", stFLT); |
| PushStProc("INC", stINC); |
| PushStProc("INCL", stINCL); |
| PushStProc("EXCL", stEXCL); |
| PushStProc("FLOOR", stFLOOR); |
| PushStProc("FLT", stFLT); |
| PushStProc("INC", stINC); |
| PushStProc("INCL", stINCL); |
| PushStType("INTEGER", TINTEGER); |
| PushStProc("LEN", stLEN); |
| PushStProc("LSL", stLSL); |
| PushStProc("LONG", stLONG); |
| PushStProc("LEN", stLEN); |
| PushStProc("LSL", stLSL); |
| PushStProc("LONG", stLONG); |
| PushStType("LONGREAL", TLONGREAL); |
| PushStProc("NEW", stNEW); |
| PushStProc("ODD", stODD); |
| PushStProc("ORD", stORD); |
| PushStProc("PACK", stPACK); |
| PushStType("REAL", TREAL); |
| PushStProc("ROR", stROR); |
| PushStType("SET", TSET); |
| PushStProc("SHORT", stSHORT); |
| PushStProc("UNPK", stUNPK); |
| PushStProc("BITS", stBITS); |
| PushStProc("LSR", stLSR); |
| PushStProc("LENGTH", stLENGTH); |
| PushStProc("NEW", stNEW); |
| PushStProc("ODD", stODD); |
| PushStProc("ORD", stORD); |
| PushStProc("PACK", stPACK); |
| PushStType("REAL", TREAL); |
| PushStProc("ROR", stROR); |
| PushStType("SET", TSET); |
| PushStProc("SHORT", stSHORT); |
| PushStProc("UNPK", stUNPK); |
| PushStProc("BITS", stBITS); |
| PushStProc("LSR", stLSR); |
| PushStProc("LENGTH", stLENGTH); |
| PushStProc("MIN", stMIN); |
| PushStProc("MAX", stMAX); |
| Guard |
| END StIdent; |
| 428,9 → 430,9 |
| WHILE (cur # NIL) & (cur.iType # IDGUARD) DO |
| IF cur.Name = Name THEN |
| IF (Unit # unit) & ~cur.Export THEN |
| res := NIL |
| res := NIL |
| ELSE |
| res := cur |
| res := cur |
| END; |
| cur := NIL |
| ELSE |
| 533,9 → 535,9 |
| Res := Arith(a, b, Ta, Op, coord) |
| ELSIF Ta.tType = TSET THEN |
| CASE Op OF |
| |lxPlus: Res := LONG(FLT(ORD(BITS(ai) + BITS(bi)))) |
| |lxPlus: Res := LONG(FLT(ORD(BITS(ai) + BITS(bi)))) |
| |lxMinus: Res := LONG(FLT(ORD(BITS(ai) - BITS(bi)))) |
| |lxMult: Res := LONG(FLT(ORD(BITS(ai) * BITS(bi)))) |
| |lxMult: Res := LONG(FLT(ORD(BITS(ai) * BITS(bi)))) |
| |lxSlash: Res := LONG(FLT(ORD(BITS(ai) / BITS(bi)))) |
| ELSE |
| END |
| 636,23 → 638,23 |
| NamePtrBase := Name; |
| id := GetQIdent(Unit, Name); |
| IF Unit # unit THEN |
| Assert2(id # NIL, 42); |
| Assert2(id.iType = IDTYPE, 77); |
| Coord(coord); |
| Next; |
| Res := id.T |
| Assert2(id # NIL, 42); |
| Assert2(id.iType = IDTYPE, 77); |
| Coord(coord); |
| Next; |
| Res := id.T |
| ELSE |
| IF id = NIL THEN |
| Assert2((unit.Level = 3) & unit.typedecl, 42); |
| Coord(coord); |
| Next; |
| Res := NIL |
| ELSE |
| Assert2(id.iType = IDTYPE, 77); |
| Coord(coord); |
| Next; |
| Res := id.T |
| END |
| IF id = NIL THEN |
| Assert2((unit.Level = 3) & unit.typedecl, 42); |
| Coord(coord); |
| Next; |
| Res := NIL |
| ELSE |
| Assert2(id.iType = IDTYPE, 77); |
| Coord(coord); |
| Next; |
| Res := id.T |
| END |
| END |
| ELSE |
| Assert2(FALSE, 77) |
| 689,21 → 691,21 |
| cur.T := Tf; |
| IF Rec THEN |
| IF Tf.Align > Tr.Align THEN |
| Tr.Align := Tf.Align |
| Tr.Align := Tf.Align |
| END; |
| IF Tr.Rec = record THEN |
| cur.Offset := FieldOffset(Tf.Align, Tr.Size); |
| Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); |
| Tr.Size := cur.Offset + Tf.Size |
| cur.Offset := FieldOffset(Tf.Align, Tr.Size); |
| Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); |
| Tr.Size := cur.Offset + Tf.Size |
| ELSIF Tr.Rec = noalign THEN |
| cur.Offset := FieldOffset(1, Tr.Size); |
| Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); |
| Tr.Size := cur.Offset + Tf.Size |
| cur.Offset := FieldOffset(1, Tr.Size); |
| Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); |
| Tr.Size := cur.Offset + Tf.Size |
| ELSIF Tr.Rec = union THEN |
| IF Tf.Size > Tr.Size THEN |
| Tr.Size := Tf.Size |
| END; |
| cur.Offset := 0 |
| IF Tf.Size > Tr.Size THEN |
| Tr.Size := Tf.Size |
| END; |
| cur.Offset := 0 |
| END |
| ELSE |
| Tr.Len := Tr.Len + 4 * (ORD((Tf.tType = TRECORD) & cur.ByRef) + Dim(Tf) + ORD((Tf.tType = TLONGREAL) & ~cur.ByRef) + 1) |
| 734,7 → 736,7 |
| field := GetField(T, Name); |
| IF field # NIL THEN |
| IF (field.Unit = unit) OR field.Export THEN |
| res := FALSE |
| res := FALSE |
| END |
| END; |
| T := T.Base |
| 744,7 → 746,7 |
| PROCEDURE notrecurs(id: BOOLEAN; T: pTYPE): BOOLEAN; |
| RETURN ~(id & (unit.Idents.Last(IDENT).iType = IDTYPE) & (unit.Idents.Last(IDENT).T = T) & |
| (T.tType IN TSTRUCT)) |
| (T.tType IN TSTRUCT)) |
| END notrecurs; |
| PROCEDURE ReadFields(T: pTYPE); |
| 776,9 → 778,9 |
| Assert(notrecurs(id_T, Tf), coord, 96); |
| SetFields(T, Tf, TRUE); |
| IF SCAN.tLex = lxSemi THEN |
| NextCheck(lxIDENT) |
| NextCheck(lxIDENT) |
| ELSE |
| Assert2(SCAN.tLex = lxEND, 86) |
| Assert2(SCAN.tLex = lxEND, 86) |
| END |
| ELSE |
| Assert2(FALSE, 85) |
| 819,9 → 821,9 |
| ProgSize := ProgSize + UTILS.Align(ProgSize) |
| ELSE |
| IF cur.VarKind = 0 THEN |
| cur.Offset := curBlock.ParamSize - curBlock.VarSize - n |
| cur.Offset := curBlock.ParamSize - curBlock.VarSize - n |
| ELSE |
| cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD))) |
| cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD))) |
| END |
| END; |
| Assert2(curBlock.VarSize <= SCAN.maxINT - n, 93); |
| 901,9 → 903,9 |
| INC(curBlock.ParamCount); |
| fp := unit.Idents.Last(IDENT); |
| IF ByRef THEN |
| fp.VarKind := paramvar |
| fp.VarKind := paramvar |
| ELSE |
| fp.VarKind := param |
| fp.VarKind := param |
| END |
| END; |
| Next; |
| 915,7 → 917,7 |
| Assert(Dim(Tf) <= X86.ADIM, coord, 110); |
| SetFields(T, Tf, FALSE); |
| IF proc THEN |
| SetVars(Tf) |
| SetVars(Tf) |
| END; |
| cont := FALSE |
| ELSE |
| 932,9 → 934,9 |
| REPEAT |
| Section(T); |
| IF SCAN.tLex = lxSemi THEN |
| Next |
| Next |
| ELSE |
| break := TRUE |
| break := TRUE |
| END |
| UNTIL break |
| END |
| 1054,6 → 1056,9 |
| Check(lxIDENT); |
| nov.Base := IdType(coord); |
| Assert(nov.Base # NIL, coord, 42); |
| IF (nov.Base.tType = TPOINTER) & (nov.Base.Base.tType = TRECORD) THEN |
| nov.Base := nov.Base.Base |
| END; |
| Assert(nov.Base.tType = TRECORD, coord, 80); |
| Assert(notrecurs(TRUE, nov.Base), coord, 96); |
| nov.Size := nov.Base.Size; |
| 1194,10 → 1199,16 |
| last := unit.Idents.Last(IDENT); |
| Check(lxEQ); |
| Next; |
| NEW(NewType); |
| MemErr(NewType = NIL); |
| last.T := NewType; |
| T := StructType(FALSE, NewType); |
| IF SCAN.tLex = lxIDENT THEN |
| last.T := ParseType(coord) |
| ELSE |
| NEW(NewType); |
| MemErr(NewType = NIL); |
| last.T := NewType; |
| T := StructType(FALSE, NewType) |
| END; |
| Check(lxSemi); |
| Next |
| END |
| 1210,16 → 1221,16 |
| IdentDef; |
| PushIdent(Name, coord, IDVAR, NIL, NIL, Export, 0); |
| IF SCAN.tLex = lxComma THEN |
| NextCheck(lxIDENT) |
| NextCheck(lxIDENT) |
| ELSIF SCAN.tLex = lxColon THEN |
| NextCoord(coord); |
| T := ParseType(coord); |
| Assert(T # NIL, coord, 42); |
| SetVars(T); |
| Check(lxSemi); |
| Next |
| NextCoord(coord); |
| T := ParseType(coord); |
| Assert(T # NIL, coord, 42); |
| SetVars(T); |
| Check(lxSemi); |
| Next |
| ELSE |
| Assert2(FALSE, 85) |
| Assert2(FALSE, 85) |
| END |
| END |
| END; |
| 1237,8 → 1248,8 |
| id.Proc := curproc; |
| IF id.Export & main THEN |
| IF Platform IN {1, 6} THEN |
| curproc.used := TRUE; |
| Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133) |
| curproc.used := TRUE; |
| Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133) |
| END; |
| X86.ProcExport(id.Number, Name, X86.NewLabel()) |
| END; |
| 1266,7 → 1277,7 |
| Expr(e); |
| Assert(AssComp(e, curBlock.T.Base, FALSE), coord, 125); |
| IF e.eType = eVAR THEN |
| X86.Load(e.T.tType) |
| X86.Load(e.T.tType) |
| END |
| ELSE |
| Assert2(SCAN.tLex # lxRETURN, 123) |
| 1335,12 → 1346,12 |
| SCAN.Backup(unit.scanner); |
| COPY(name.Name, FName); |
| IF ~((~self.Std & pReadModule(Path, FName, UTILS.Ext)) OR pReadModule(Std, FName, UTILS.Ext)) THEN |
| IF FName = "SYSTEM" THEN |
| unit := sys; |
| self.sys := TRUE |
| ELSE |
| Assert(FALSE, namecoord, 32) |
| END |
| IF FName = "SYSTEM" THEN |
| unit := sys; |
| self.sys := TRUE |
| ELSE |
| Assert(FALSE, namecoord, 32) |
| END |
| END; |
| SCAN.Recover(self.scanner); |
| u := unit; |
| 1363,28 → 1374,28 |
| Next; |
| CASE cond OF |
| |0: Check(lxIDENT); |
| name := SCAN.id; |
| Coord(coord); |
| Coord(namecoord); |
| alias := name; |
| cond := 1 |
| name := SCAN.id; |
| Coord(coord); |
| Coord(namecoord); |
| alias := name; |
| cond := 1 |
| |1: CASE SCAN.tLex OF |
| |lxComma: AddUnit(0) |
| |lxSemi: AddUnit(4); Next |
| |lxAssign: cond := 2 |
| ELSE |
| Assert2(FALSE, 28) |
| END |
| |lxComma: AddUnit(0) |
| |lxSemi: AddUnit(4); Next |
| |lxAssign: cond := 2 |
| ELSE |
| Assert2(FALSE, 28) |
| END |
| |2: Check(lxIDENT); |
| name := SCAN.id; |
| Coord(namecoord); |
| cond := 3 |
| name := SCAN.id; |
| Coord(namecoord); |
| cond := 3 |
| |3: CASE SCAN.tLex OF |
| |lxComma: AddUnit(0) |
| |lxSemi: AddUnit(4); Next |
| ELSE |
| Assert2(FALSE, 29) |
| END |
| |lxComma: AddUnit(0) |
| |lxSemi: AddUnit(4); Next |
| ELSE |
| Assert2(FALSE, 29) |
| END |
| ELSE |
| END |
| END |
| 1409,14 → 1420,15 |
| BEGIN |
| temp := unit; |
| Header(SCAN.AddNode("SYSTEM")); |
| PushSysProc("ADR", sysADR); |
| PushSysProc("SIZE", sysSIZE); |
| PushSysProc("ADR", sysADR); |
| PushSysProc("SIZE", sysSIZE); |
| PushSysProc("TYPEID", sysTYPEID); |
| PushSysProc("GET", sysGET); |
| PushSysProc("PUT", sysPUT); |
| PushSysProc("CODE", sysCODE); |
| PushSysProc("MOVE", sysMOVE); |
| PushSysProc("INF", sysINF); |
| PushSysProc("GET", sysGET); |
| PushSysProc("PUT", sysPUT); |
| PushSysProc("CODE", sysCODE); |
| PushSysProc("MOVE", sysMOVE); |
| PushSysProc("COPY", sysCOPY); |
| PushSysProc("INF", sysINF); |
| PushSysType("CARD16", TCARD16); |
| sys := unit; |
| unit := temp |
| 1531,7 → 1543,7 |
| WHILE cur # NIL DO |
| p := cur.Proc(Proc); |
| IF ~p.used THEN |
| ProcHandling(p) |
| ProcHandling(p) |
| END; |
| cur := cur.Next(IDENT) |
| END; |
| /programs/develop/oberon07/Source/ERRORS.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 Anton Krotov |
| This file is part of Compiler. |
| 200,7 → 200,7 |
| | 77: str := "®¦¨¤ «áï ¨¤¥â¨ä¨ª â®à ⨯ " |
| | 78: str := "¤«¨ ⨯ -¬ áᨢ ¤®«¦ ¡ëâì ¡®«ìè¥ ã«ï" |
| | 79: str := "®¦¨¤ «®áì 'OF' ¨«¨ ','" |
| | 80: str := "®¦¨¤ «áï ¨¤¥â¨ä¨ª â®à ⨯ -§ ¯¨á¨" |
| | 80: str := "®¦¨¤ «áï ¨¤¥â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ ⥫ï" |
| | 81: str := "¡ §®¢ë© ⨯ ⨯ -㪠§ â¥«ï ¤®«¦¥ ¡ëâì § ¯¨áìî" |
| | 82: str := "⨯ १ã«ìâ â ¯à®æ¥¤ãàë ¥ ¬®¦¥â ¡ëâì § ¯¨áìî ¨«¨ ¬ áᨢ®¬" |
| | 83: str := "à §¬¥à ⨯ ᫨誮¬ ¢¥«¨ª" |
| /programs/develop/oberon07/Source/UTILS.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 Anton Krotov |
| This file is part of Compiler. |
| 28,7 → 28,7 |
| Ext* = ".ob07"; |
| MAX_PATH = 1024; |
| MAX_PARAM = 1024; |
| Date* = 1451606400; (* 2016-01-01 *) |
| Date* = 1509580800; (* 2017-11-02 *) |
| TYPE |
| 53,7 → 53,7 |
| VAR |
| Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
| ParamCount*, Line*, Unit*: INTEGER; |
| ParamCount*, Line*, Unit*: INTEGER; |
| FileName: STRING; |
| PROCEDURE SetFile*(F: STRING); |
| 113,8 → 113,8 |
| WHILE (j < len) & (i <= Params[n, 1]) DO |
| c := GetChar(i); |
| IF c # 22X THEN |
| str[j] := c; |
| INC(j) |
| str[j] := c; |
| INC(j) |
| END; |
| INC(i) |
| END |
| 199,14 → 199,6 |
| Line := newLine |
| END UnitLine; |
| PROCEDURE min*(a, b: INTEGER): INTEGER; |
| BEGIN |
| IF a > b THEN |
| a := b |
| END |
| RETURN a |
| END min; |
| PROCEDURE Align*(n: INTEGER): INTEGER; |
| RETURN (4 - n MOD 4) MOD 4 |
| END Align; |
| 333,7 → 325,7 |
| END; |
| Path[i + 1] := 0X |
| END Split; |
| PROCEDURE LinuxParam; |
| VAR p, i, str: INTEGER; c: CHAR; |
| BEGIN |
| 350,7 → 342,7 |
| Params[i, 1] := str - 1 |
| END; |
| DEC(ParamCount) |
| END LinuxParam; |
| END LinuxParam; |
| PROCEDURE Time*; |
| VAR sec, dsec: INTEGER; |
| /programs/develop/oberon07/Source/X86.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016 Anton Krotov |
| Copyright 2016, 2017 Anton Krotov |
| This file is part of Compiler. |
| 36,7 → 36,7 |
| stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19; |
| stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24; |
| stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29; |
| stLENGTH* = 30; |
| stLENGTH* = 30; stMIN* = 31; stMAX* = 32; |
| sysMOVE* = 108; |
| 1232,7 → 1232,9 |
| |stASR: PopECX; OutCode("58D3F8"); PushEAX |
| |stLSL: PopECX; OutCode("58D3E0"); PushEAX |
| |stLSR: PopECX; OutCode("58D3E8"); PushEAX |
| |stORD: PopEDX; OutCode("85D274036A015A"); PushEDX |
| |stORD: PopEDX; OutCode("85D274036A015A"); PushEDX; |
| |stMIN: PopEDX; OutCode("3914247E025852"); |
| |stMAX: PopEDX; OutCode("3B14247E025852"); |
| |stLENGTH: CallRTL(_length); PushEAX |
| ELSE |
| END |
| 1269,12 → 1271,12 |
| |TCHAR, TBOOLEAN: |
| IF lastcmd.tcmd = ECMD THEN |
| del; |
| OutCode("33D28A"); |
| OutCode("0FB6"); |
| IntByte("55", "95", offset); |
| PushEDX |
| ELSE |
| PopEDX; |
| OutCode("33C98A0A"); |
| OutCode("0FB60A"); |
| PushECX |
| END |
| |TLONGREAL: |