Log.Mos 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522
  1. (* ported version of Minos to work with the ARM backend of the Fox Compiler Suite *)
  2. MODULE Log; (** AUTHOR "fof"; PURPOSE "configurable output "; **)
  3. IMPORT SYSTEM;
  4. (*** configurable output *)
  5. (*@
  6. 003 2007-07-09 tt formatted
  7. 002 2007-02-08 tt added set, Hex, flush
  8. 001 2006-06-22 fof created
  9. *)
  10. (**
  11. verbose: output for programmers
  12. normal: output understandable by a user
  13. error: error reports - assumed to be important
  14. *)
  15. CONST
  16. quiet* = -2; error* = -1; normal* = 0; verbose* = 1;
  17. TAB = 9X; (* ASCII number for tabulator *)
  18. TYPE
  19. strP* = PROCEDURE ( CONST str: ARRAY OF CHAR );
  20. setP* = PROCEDURE ( s: SET );
  21. intP* = PROCEDURE ( i: LONGINT );
  22. hexP* = PROCEDURE ( i: LONGINT );
  23. realP* = PROCEDURE ( real: REAL );
  24. boolP* = PROCEDURE ( b: BOOLEAN );
  25. trapModeP* = PROCEDURE ( b: BOOLEAN );
  26. chP* = PROCEDURE ( c: CHAR );
  27. lnP* = PROCEDURE;
  28. clearP* = PROCEDURE;
  29. flushP* = PROCEDURE;
  30. bufferP* = PROCEDURE ( CONST buf: ARRAY OF CHAR (*SYSTEM.BYTE*); offset, len: LONGINT );
  31. beepP* = PROCEDURE ( freq, duration: LONGINT );
  32. VAR
  33. gMode: LONGINT; str: strP; int: intP; real: realP; bool: boolP; ln: lnP; ch: chP;
  34. flush: flushP; hex: hexP; set: setP; buffer: bufferP; clear: clearP; beep: beepP;
  35. trapMode: trapModeP;
  36. (** output procedures, output only generated if mode <= current mode (gMode) *)
  37. PROCEDURE Str*( mode: LONGINT; CONST s: ARRAY OF CHAR );
  38. BEGIN
  39. IF gMode >= mode THEN str( s ) END;
  40. END Str;
  41. PROCEDURE StringA*( CONST s: ARRAY OF CHAR; CONST len : LONGINT; CONST addColon : BOOLEAN );
  42. VAR
  43. i : LONGINT;
  44. rest : LONGINT;
  45. BEGIN
  46. IF ( LEN( s ) < len ) THEN
  47. rest := len - LEN( s );
  48. ELSE
  49. rest := 0;
  50. END;
  51. str( s );
  52. FOR i := 0 TO rest -1 DO
  53. ch(' ');
  54. END;
  55. IF ( addColon ) THEN
  56. ch(':'); ch(' ');
  57. END;
  58. END StringA;
  59. PROCEDURE Int*( mode: LONGINT; i: LONGINT );
  60. BEGIN
  61. IF gMode >= mode THEN int( i ) END;
  62. END Int;
  63. PROCEDURE Hex*( mode: LONGINT; i: LONGINT );
  64. BEGIN
  65. IF gMode >= mode THEN hex( i ) END;
  66. END Hex;
  67. PROCEDURE Real*( mode: LONGINT; r: REAL );
  68. BEGIN
  69. IF gMode >= mode THEN real( r ) END;
  70. END Real;
  71. PROCEDURE Bool*( mode: LONGINT; b: BOOLEAN );
  72. BEGIN
  73. IF gMode >= mode THEN bool( b ) END;
  74. END Bool;
  75. PROCEDURE Ch*( mode: LONGINT; c: CHAR );
  76. BEGIN
  77. IF gMode >= mode THEN ch( c ) END;
  78. END Ch;
  79. PROCEDURE Buffer*( mode: LONGINT; CONST buf: ARRAY OF CHAR (* SYSTEM.BYTE *);
  80. offset, len: LONGINT );
  81. BEGIN
  82. IF gMode >= mode THEN buffer( buf, offset, len ) END;
  83. END Buffer;
  84. PROCEDURE Ln*( mode: LONGINT );
  85. BEGIN
  86. IF gMode >= mode THEN ln; END;
  87. END Ln;
  88. PROCEDURE Flush*( mode: LONGINT );
  89. BEGIN
  90. IF gMode >= mode THEN flush END;
  91. END Flush;
  92. PROCEDURE Clear*( mode: LONGINT );
  93. BEGIN
  94. IF gMode >= mode THEN clear END;
  95. END Clear;
  96. (*
  97. PROCEDURE ShowTD*( mode: LONGINT; ptr: LONGINT );
  98. VAR size, i: LONGINT;
  99. BEGIN
  100. IF gMode >= mode THEN
  101. SYSTEM.GET( ptr - 4, ptr ); ptr := ptr MOD 1000000H + Platform.RAMCore;
  102. str( "TD :" ); hex( ptr ); ln; str( "TD Size: " ); SYSTEM.GET( ptr - 4, size );
  103. int( size MOD 1000000H ); ln; str( "RECORD Size: " ); SYSTEM.GET( ptr, size ); int( size );
  104. ln; i := 0;
  105. WHILE i < 8 DO
  106. ch( 09X ); ch( '[' ); SYSTEM.GET( ptr + 4 + i * 4, size ); int( i ); ch( ']' );
  107. hex( size ); ln; INC( i )
  108. END;
  109. str( "Ptrs: " ); SYSTEM.GET( ptr + 36, size ); int( size ); ln;
  110. END;
  111. END ShowTD;
  112. *)
  113. PROCEDURE Time*( mode: LONGINT );
  114. VAR timer: LONGINT; len: LONGINT;
  115. BEGIN
  116. (* Int( mode, Kernel.GetTime() ); *)
  117. END Time;
  118. PROCEDURE Beep*( mode: LONGINT; freq, duration: LONGINT );
  119. BEGIN
  120. IF gMode >= mode THEN beep( freq, duration ) END;
  121. END Beep;
  122. PROCEDURE Tab*( mode: LONGINT);
  123. BEGIN
  124. Ch(mode, TAB);
  125. END Tab;
  126. (*** output procedures in normal mode, procedures with more than one argument add a line feed *)
  127. PROCEDURE S*( CONST s: ARRAY OF CHAR );
  128. BEGIN
  129. IF gMode >= normal THEN str( s ); END;
  130. END S;
  131. PROCEDURE Set*( s: SET );
  132. BEGIN
  133. IF gMode >= normal THEN set( s ); END;
  134. END Set;
  135. PROCEDURE SL*( CONST s: ARRAY OF CHAR );
  136. BEGIN
  137. IF gMode >= normal THEN str( s ); ln(); END;
  138. END SL;
  139. PROCEDURE IL*( i: LONGINT );
  140. BEGIN
  141. IF gMode >= normal THEN int( i ); ln(); END;
  142. END IL;
  143. PROCEDURE RL*( r: REAL );
  144. BEGIN
  145. IF gMode >= normal THEN real( r ); ln(); END;
  146. END RL;
  147. PROCEDURE I*( i: LONGINT );
  148. BEGIN
  149. IF gMode >= normal THEN int( i ); END;
  150. END I;
  151. PROCEDURE H*( i: LONGINT );
  152. BEGIN
  153. IF gMode >= normal THEN hex( i ); END;
  154. END H;
  155. PROCEDURE R*( r: REAL );
  156. BEGIN
  157. IF gMode >= normal THEN real( r ) END;
  158. END R;
  159. PROCEDURE C*( c: CHAR );
  160. BEGIN
  161. IF gMode >= normal THEN ch( c ) END;
  162. END C;
  163. PROCEDURE B*( b: BOOLEAN );
  164. BEGIN
  165. IF gMode >= normal THEN bool( b ) END;
  166. END B;
  167. PROCEDURE L*( );
  168. BEGIN
  169. IF gMode >= normal THEN ln(); END;
  170. END L;
  171. PROCEDURE T*( );
  172. BEGIN
  173. C(TAB);
  174. END T;
  175. PROCEDURE SS*( CONST s1, s2: ARRAY OF CHAR );
  176. BEGIN
  177. IF gMode >= normal THEN str( s1 ); ch( ':' ); str( s2 ); ln; END;
  178. END SS;
  179. PROCEDURE SI*( CONST s: ARRAY OF CHAR; i: LONGINT );
  180. BEGIN
  181. IF gMode >= normal THEN
  182. str( s ); ch( ':' );
  183. IF i = MAX(LONGINT) THEN str( "--" ); ELSE int( i ); END;
  184. ln;
  185. END;
  186. END SI;
  187. PROCEDURE SR*( CONST s: ARRAY OF CHAR; r: REAL );
  188. BEGIN
  189. IF gMode >= normal THEN
  190. str( s ); ch( ':' );
  191. IF r = MAX(REAL) THEN str( "--" ) ELSE real( r ); END;
  192. ln;
  193. END;
  194. END SR;
  195. PROCEDURE SC*( CONST s: ARRAY OF CHAR; c: CHAR );
  196. BEGIN
  197. IF gMode >= normal THEN str( s ); ch( ':' ); ch( c ); ln; END;
  198. END SC;
  199. (*** output procedures in error mode, procedures with more than one argument add a line feed *)
  200. PROCEDURE eS*( CONST s: ARRAY OF CHAR );
  201. BEGIN
  202. IF gMode >= error THEN str( s ); END;
  203. END eS;
  204. PROCEDURE eSet*( s: SET );
  205. BEGIN
  206. IF gMode >= error THEN set( s ); END;
  207. END eSet;
  208. PROCEDURE eSL*( CONST s: ARRAY OF CHAR );
  209. BEGIN
  210. IF gMode >= error THEN str( s ); ln(); END;
  211. END eSL;
  212. PROCEDURE eIL*( i: LONGINT );
  213. BEGIN
  214. IF gMode >= error THEN int( i ); ln(); END;
  215. END eIL;
  216. PROCEDURE eRL*( r: REAL );
  217. BEGIN
  218. IF gMode >= error THEN real( r ); ln(); END;
  219. END eRL;
  220. PROCEDURE eI*( i: LONGINT );
  221. BEGIN
  222. IF gMode >= error THEN int( i ); END;
  223. END eI;
  224. PROCEDURE eH*( i: LONGINT );
  225. BEGIN
  226. IF gMode >= error THEN hex( i ); END;
  227. END eH;
  228. PROCEDURE eR*( r: REAL );
  229. BEGIN
  230. IF gMode >= error THEN real( r ) END;
  231. END eR;
  232. PROCEDURE eC*( c: CHAR );
  233. BEGIN
  234. IF gMode >= error THEN ch( c ) END;
  235. END eC;
  236. PROCEDURE eB*( b: BOOLEAN );
  237. BEGIN
  238. IF gMode >= error THEN bool( b ) END;
  239. END eB;
  240. PROCEDURE eL*( );
  241. BEGIN
  242. IF gMode >= error THEN ln(); END;
  243. END eL;
  244. PROCEDURE eT*( );
  245. BEGIN
  246. eC(TAB);
  247. END eT;
  248. PROCEDURE eSS*( CONST s1, s2: ARRAY OF CHAR );
  249. BEGIN
  250. IF gMode >= error THEN str( s1 ); ch( ':' ); str( s2 ); ln; END;
  251. END eSS;
  252. PROCEDURE eSI*( CONST s: ARRAY OF CHAR; i: LONGINT );
  253. BEGIN
  254. IF gMode >= error THEN
  255. str( s ); ch( '=' );
  256. IF i = MAX(LONGINT) THEN str( "--" ); ELSE int( i ); END;
  257. ln;
  258. END;
  259. END eSI;
  260. PROCEDURE eSR*( CONST s: ARRAY OF CHAR; r: REAL );
  261. BEGIN
  262. IF gMode >= error THEN
  263. str( s ); ch( '=' );
  264. IF r = MAX(REAL) THEN str( "--" ) ELSE real( r ); END;
  265. ln;
  266. END;
  267. END eSR;
  268. PROCEDURE eSC*( CONST s: ARRAY OF CHAR; c: CHAR );
  269. BEGIN
  270. IF gMode >= error THEN str( s ); ch( ':' ); ch( c ); ln; END;
  271. END eSC;
  272. (*** output procedures in verbose mode, procedures with more than one argument add a line feed*)
  273. PROCEDURE vS*( CONST s: ARRAY OF CHAR );
  274. BEGIN
  275. IF gMode >= verbose THEN str( s ); END;
  276. END vS;
  277. PROCEDURE vSet*( s: SET );
  278. BEGIN
  279. IF gMode >= verbose THEN set( s ); END;
  280. END vSet;
  281. PROCEDURE vSL*( CONST s: ARRAY OF CHAR );
  282. BEGIN
  283. IF gMode >= verbose THEN str( s ); ln(); END;
  284. END vSL;
  285. PROCEDURE vI*( i: LONGINT );
  286. BEGIN
  287. IF gMode >= verbose THEN int( i ); END;
  288. END vI;
  289. PROCEDURE vIL*( i: LONGINT );
  290. BEGIN
  291. IF gMode >= verbose THEN int( i ); ln(); END;
  292. END vIL;
  293. PROCEDURE vRL*( r: REAL );
  294. BEGIN
  295. IF gMode >= verbose THEN real( r ); ln(); END;
  296. END vRL;
  297. PROCEDURE vH*( i: LONGINT );
  298. BEGIN
  299. IF gMode >= verbose THEN hex( i ); END;
  300. END vH;
  301. PROCEDURE vR*( r: REAL );
  302. BEGIN
  303. IF gMode >= verbose THEN real( r ) END;
  304. END vR;
  305. PROCEDURE vC*( c: CHAR );
  306. BEGIN
  307. IF gMode >= verbose THEN ch( c ) END;
  308. END vC;
  309. PROCEDURE vB*( b: BOOLEAN );
  310. BEGIN
  311. IF gMode >= verbose THEN bool( b ) END;
  312. END vB;
  313. PROCEDURE vL*( );
  314. BEGIN
  315. IF gMode >= verbose THEN ln(); END;
  316. END vL;
  317. PROCEDURE vT*( );
  318. BEGIN
  319. vC(TAB);
  320. END vT;
  321. PROCEDURE vSS*( CONST s1, s2: ARRAY OF CHAR );
  322. BEGIN
  323. IF gMode >= verbose THEN str( s1 ); ch( ':' ); str( s2 ); ln; END;
  324. END vSS;
  325. PROCEDURE vSI*( CONST s: ARRAY OF CHAR; i: LONGINT );
  326. BEGIN
  327. IF gMode >= verbose THEN
  328. str( s ); ch( '=' );
  329. IF i = MAX(LONGINT) THEN str( "--" ); ELSE int( i ); END;
  330. ln;
  331. END;
  332. END vSI;
  333. PROCEDURE vSR*( CONST s: ARRAY OF CHAR; r: REAL );
  334. BEGIN
  335. IF gMode >= verbose THEN
  336. str( s ); ch( '=' );
  337. IF r = MAX(REAL) THEN str( "--" ) ELSE real( r ); END;
  338. ln;
  339. END;
  340. END vSR;
  341. PROCEDURE vSC*( CONST s: ARRAY OF CHAR; c: CHAR );
  342. BEGIN
  343. IF gMode >= verbose THEN str( s ); ch( ':' ); ch( c ); ln; END;
  344. END vSC;
  345. (** set output procedures *)
  346. PROCEDURE Redirect1*( s: strP; i: intP; h: hexP; ss: setP; r: realP; b: boolP );
  347. BEGIN
  348. str := s; int := i; hex := h; set := ss; real := r; bool := b;
  349. END Redirect1;
  350. PROCEDURE Redirect2*( c: chP; l: lnP; buf: bufferP; cl: clearP; fl: flushP;
  351. be: beepP; trap: trapModeP );
  352. BEGIN
  353. ch := c; ln := l; buffer := buf; clear := cl; flush := fl; beep := be;
  354. trapMode := trap;
  355. END Redirect2;
  356. (** set output mode *)
  357. PROCEDURE SetMode*( mode: LONGINT );
  358. BEGIN
  359. gMode := mode;
  360. END SetMode;
  361. (** get output mode *)
  362. PROCEDURE GetMode*( ): LONGINT;
  363. BEGIN
  364. RETURN gMode
  365. END GetMode;
  366. (*** commands to set output modes *)
  367. PROCEDURE Verbose*;
  368. BEGIN
  369. SetMode( verbose );
  370. END Verbose;
  371. PROCEDURE Normal*;
  372. BEGIN
  373. SetMode( normal );
  374. END Normal;
  375. PROCEDURE Error*;
  376. BEGIN
  377. SetMode( error );
  378. END Error;
  379. PROCEDURE Quiet*;
  380. BEGIN
  381. SetMode( quiet );
  382. END Quiet;
  383. PROCEDURE SetTrapMode*( enable: BOOLEAN );
  384. BEGIN
  385. trapMode( enable );
  386. END SetTrapMode;
  387. PROCEDURE Null*;
  388. BEGIN
  389. END Null;
  390. PROCEDURE NullStr*( CONST str: ARRAY OF CHAR );
  391. BEGIN
  392. END NullStr;
  393. PROCEDURE NullSet*( s: SET );
  394. BEGIN
  395. END NullSet;
  396. PROCEDURE NullInt*( i: LONGINT );
  397. BEGIN
  398. END NullInt;
  399. PROCEDURE NullHex*( i: LONGINT );
  400. BEGIN
  401. END NullHex;
  402. PROCEDURE NullReal*( real: REAL );
  403. BEGIN
  404. END NullReal;
  405. PROCEDURE NullBool*( b: BOOLEAN );
  406. BEGIN
  407. END NullBool;
  408. PROCEDURE NullChar*( c: CHAR );
  409. BEGIN
  410. END NullChar;
  411. PROCEDURE NullBuffer*( CONST buf: ARRAY OF CHAR (* SYSTEM.BYTE *); offset, len: LONGINT );
  412. BEGIN
  413. END NullBuffer;
  414. PROCEDURE NullBeep*( freq, duration: LONGINT );
  415. BEGIN
  416. END NullBeep;
  417. PROCEDURE NullTrapMode*( trap: BOOLEAN );
  418. BEGIN
  419. END NullTrapMode;
  420. (** reset output mode and redirect output to Log *)
  421. PROCEDURE Reset*;
  422. BEGIN
  423. Redirect1( NullStr, NullInt, NullHex, NullSet, NullReal, NullBool );
  424. Redirect2( NullChar, Null, NullBuffer, Null, Null, NullBeep, NullTrapMode );
  425. SetMode( normal );
  426. END Reset;
  427. BEGIN
  428. Reset;
  429. END Log.