Баги Timer AmigaOS4.1

Forum > Russian

(1/1)

Smalovsky:
Я попробовал использовать библиотеку Timer для FreePascal 3.2.2 для AmigaOS 4.1 PPC. У меня эмулятор Amiga 4000 WinUAE с эмуляцией видеокарты Picasso4 на шине Zorro3 и ускорителя Cyberstorm с 126 МБ быстрой оперативной памяти и процессором 604e.
Я попытался узнать системное и машинное время с помощью листинга:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---Program Timer_test;uses exec,sysutils,utility,intuition,agraphics,timer; varts:TTimeval;pts:PTimeval;tm:TEClockval;ptm:PEClockval;beginpts:=PTimeval(@ts);ptm:=PEClockval(@tm);GetSysTime(pts);ReadEClock(ptm); writeln('ts sec= ',ts.tv_secs,' micro= ',ts.tv_micro);writeln('tm hi= ',tm.ev_hi,' lo= ',tm.ev_lo); end.
Но скомпилированная программа сразу вызывает ошибку при запуске.

TRon:
Apologies for responding in English.

Sorry to have to say that there are a lot of things that are wrong with the example as presented. For instance there are a lot of syntactical errors. edit: I see you've modified your example code :)

But besides that, this is not how you the timer.device should (and can) be addressed. For a more elaborated example see this example.

googly translate:
Приношу свои извинения за ответ на английском языке. Извините, что приходится говорить, что есть много вещей, которые не так с представленным примером. Например, много синтаксических ошибок. Но кроме этого, это не то, как вы должны (и можете) обращаться к таймеру. Более подробный пример смотрите в этом примере

Smalovsky:
Google translation:
Tron, thank you for your attention. But I can't see your example simple_timer.pas, because gitlab doesn't show it to me for some reason. Please place the example text in the code block.

cdbc:
Hi

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program simpletimer; uses exec, timer, amigados, amigalib; { manifest constants -- 'never will change' }const SECSPERMIN = (60); SECSPERHOUR = (60*60); SECSPERDAY = (60*60*24); var seconds : longint; tr : ptimerequest; { IO block for timer commands } oldtimeval : ttimeval; { timevals to store times } mytimeval : ttimeval; currentval : ttimeval; Function Create_Timer(theUnit : longint) : pTimeRequest;var Error : longint; TimerPort : pMsgPort; TimeReq : pTimeRequest;begin TimerPort := CreatePort(Nil, 0); if TimerPort = Nil then Create_Timer := Nil; TimeReq := pTimeRequest(CreateExtIO(TimerPort,sizeof(tTimeRequest))); if TimeReq = Nil then begin DeletePort(TimerPort); Create_Timer := Nil; end; Error := OpenDevice(TIMERNAME, theUnit, pIORequest(TimeReq), 0); if Error <> 0 then begin DeleteExtIO(pIORequest(TimeReq)); DeletePort(TimerPort); Create_Timer := Nil; end; TimerBase := pointer(TimeReq^.tr_Node.io_Device); Create_Timer := pTimeRequest(TimeReq);end; Procedure Delete_Timer(WhichTimer : pTimeRequest);var WhichPort : pMsgPort;begin WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort; if assigned(WhichTimer) then begin CloseDevice(pIORequest(WhichTimer)); DeleteExtIO(pIORequest(WhichTimer)); end; if assigned(WhichPort) then DeletePort(WhichPort);end; procedure wait_for_timer(tr : ptimerequest; tv : ptimeval);begin tr^.tr_node.io_Command := TR_ADDREQUEST; { add a new timer request } { structure assignment } tr^.tr_time.tv_secs := tv^.tv_secs; tr^.tr_time.tv_micro := tv^.tv_micro; { post request to the timer -- will go to sleep till done } DoIO(pIORequest(tr));end; { more precise timer than AmigaDOS Delay() }function time_delay(tv : ptimeval; theunit : longint): longint;var tr : ptimerequest;begin { get a pointer to an initialized timer request block } tr := create_timer(theunit); { any nonzero return says timedelay routine didn't work. } if tr = NIL then time_delay := -1; wait_for_timer(tr, tv); { deallocate temporary structures } delete_timer(tr); time_delay := 0;end; function set_new_time(secs : longint): longint;var tr : ptimerequest;begin tr := create_timer(UNIT_MICROHZ); { non zero return says error } if tr = nil then set_new_time := -1; tr^.tr_time.tv_secs := secs; tr^.tr_time.tv_micro := 0; tr^.tr_node.io_Command := TR_SETSYSTIME; DoIO(pIORequest(tr)); delete_timer(tr); set_new_time := 0;end; function get_sys_time(tv : ptimeval): longint;var tr : ptimerequest;begin tr := create_timer( UNIT_MICROHZ ); { non zero return says error } if tr = nil then get_sys_time := -1; tr^.tr_node.io_Command := TR_GETSYSTIME; DoIO(pIORequest(tr)); { structure assignment } tv^ := tr^.tr_time; delete_timer(tr); get_sys_time := 0;end; procedure show_time(secs : longint);var days,hrs,mins : longint;begin { Compute days, hours, etc. } mins := secs div 60; hrs := mins div 60; days := hrs div 24; secs := secs mod 60; mins := mins mod 60; hrs := hrs mod 24; { Display the time } writeln('* Hour Minute Second (Days since Jan.1,1978)'); writeln('* ', hrs, ': ',mins,': ', secs,' ( ',days, ' )'); writeln;end; begin writeln('Timer test'); { sleep for two seconds } currentval.tv_secs := 2; currentval.tv_micro := 0; time_delay(@currentval, UNIT_VBLANK); writeln('After 2 seconds delay'); { sleep for four seconds } currentval.tv_secs := 4; currentval.tv_micro := 0; time_delay(@currentval, UNIT_VBLANK); writeln('After 4 seconds delay'); { sleep for 500,000 micro-seconds = 1/2 second } currentval.tv_secs := 0; currentval.tv_micro := 500000; time_delay(@currentval, UNIT_MICROHZ); writeln('After 1/2 second delay'); writeln('DOS Date command shows: '); Execute('date', 0, 0); { save what system thinks is the time....we'll advance it temporarily } get_sys_time(@oldtimeval); writeln('Original system time is:'); show_time(oldtimeval.tv_secs ); writeln('Setting a new system time'); seconds := 1000 * SECSPERDAY + oldtimeval.tv_secs; set_new_time( seconds ); { (if user executes the AmigaDOS DATE command now, he will} { see that the time has advanced something over 1000 days } write('DOS Date command now shows: '); Execute('date', 0, 0); get_sys_time(@mytimeval); writeln('Current system time is:'); show_time(mytimeval.tv_secs); { Added the microseconds part to show that time keeps } { increasing even though you ask many times in a row } writeln('Now do three TR_GETSYSTIMEs in a row (notice how the microseconds increase)'); writeln; get_sys_time(@mytimeval); writeln('First TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro); get_sys_time(@mytimeval); writeln('Second TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro); get_sys_time(@mytimeval); writeln('Third TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro); writeln; writeln('Resetting to former time'); set_new_time(oldtimeval.tv_secs); get_sys_time(@mytimeval); writeln('Current system time is:'); show_time(mytimeval.tv_secs); end. Here you go, lifted from Gitlab.
Regards Benny

TRon:
Thank you very much @cdbc, you're a lifesaver 👍

@Smalovsky:
Alternative methods are:
- direct using github: https://github.com/fpc/FPCSource/tree/main/packages/amunits/examples
- download the fpc-3.2.2 source-tree from sourceforge https://sourceforge.net/projects/freepascal/files/Source/3.2.2/
- download the fpc-3.2.2 sources from the fpc download server: https://www.freepascal.org/down/source/sources-hungary.html

When downloading the source-tree, the archive needs to be extracted but the file-path for the example is the same. fwiw there are many more Amiga specific examples listed.

In case neither of the suggested alternatives work for you then please give out a shout because there are other solutions/sources available (I only listed the common ones).

Googly translate:
Альтернативными методами являются:
- Напрямую с помощью GitHub: https://github.com/fpc/FPCSource/tree/main/packages/amunits/examples
- Загрузите дерево исходных текстов FPC-3.2.2 с SourceForge https://sourceforge.net/projects/freepascal/files/Source/3.2.2/
- Загрузите исходники FPC-3.2.2 с сервера загрузки FPC: https://www.freepascal.org/down/source/sources-hungary.html

При загрузке дерева исходных текстов архив необходимо распаковать, но путь к файлу для примера тот же. Кроме того, в списке есть еще много примеров, специфичных для Amiga.

Если ни одна из предложенных альтернатив не работает для вас, пожалуйста, сообщите об этом, потому что есть другие доступные решения/источники (я перечислил только те, которые являются общеупотребительными).

Navigation

[0] Message Index