]>
Commit | Line | Data |
---|---|---|
7401123f GM |
1 | (* Debug.mod provides some simple debugging routines. |
2 | ||
3d864fce | 3 | Copyright (C) 2002-2022 Free Software Foundation, Inc. |
7401123f GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. *) | |
26 | ||
27 | IMPLEMENTATION MODULE Debug ; | |
28 | ||
29 | ||
30 | FROM ASCII IMPORT cr, nul, lf ; | |
31 | FROM NumberIO IMPORT CardToStr ; | |
32 | FROM libc IMPORT exit, write ; | |
33 | FROM SYSTEM IMPORT ADR ; | |
34 | ||
35 | ||
36 | CONST | |
37 | MaxStack = 10 ; | |
38 | ||
39 | VAR | |
40 | Stack: ARRAY [1..MaxStack] OF WriteP ; | |
41 | Ptr : CARDINAL ; | |
42 | ||
43 | ||
44 | PROCEDURE Write (ch: CHAR) ; | |
45 | BEGIN | |
46 | IF Ptr>0 | |
47 | THEN | |
48 | Stack[Ptr](ch) | |
49 | ELSE | |
50 | LocalWrite(ch) | |
51 | END | |
52 | END Write ; | |
53 | ||
54 | ||
55 | PROCEDURE LocalWrite (ch: CHAR) ; | |
56 | VAR | |
57 | r: INTEGER ; | |
58 | BEGIN | |
59 | r := write(2, ADR(ch), 1) | |
60 | END LocalWrite ; | |
61 | ||
62 | ||
63 | (* | |
64 | PushOutput - pushes the output procedure, p, which is used Debug. | |
65 | *) | |
66 | ||
67 | PROCEDURE PushOutput (p: WriteP) ; | |
68 | BEGIN | |
69 | IF Ptr=MaxStack | |
70 | THEN | |
71 | Halt(__FILE__, __LINE__, __FUNCTION__, 'stack exceeded') | |
72 | ELSE | |
73 | INC(Ptr) ; | |
74 | Stack[Ptr] := p | |
75 | END | |
76 | END PushOutput ; | |
77 | ||
78 | ||
79 | (* | |
80 | PopOutput - pops the current output procedure from the stack. | |
81 | *) | |
82 | ||
83 | PROCEDURE PopOutput ; | |
84 | BEGIN | |
85 | IF Ptr>1 | |
86 | THEN | |
87 | DEC(Ptr) | |
88 | END | |
89 | END PopOutput ; | |
90 | ||
91 | ||
92 | (* | |
93 | Halt - writes a message in the format: | |
94 | Module:Line:Message | |
95 | ||
96 | It then terminates by calling HALT. | |
97 | *) | |
98 | ||
99 | PROCEDURE Halt (File : ARRAY OF CHAR; | |
100 | LineNo : CARDINAL; | |
101 | Function, | |
102 | Message : ARRAY OF CHAR) ; | |
103 | CONST | |
104 | MaxNoOfDigits = 12 ; (* should be large enough for most source files.. *) | |
105 | VAR | |
106 | No : ARRAY [0..MaxNoOfDigits] OF CHAR ; | |
107 | BEGIN | |
108 | DebugString(File) ; | |
109 | CardToStr(LineNo, 0, No) ; | |
110 | DebugString(':') ; | |
111 | DebugString(No) ; | |
112 | DebugString(':') ; | |
113 | DebugString(Function) ; | |
114 | DebugString(':') ; | |
115 | DebugString(Message) ; | |
116 | DebugString('\n') ; | |
117 | HALT | |
118 | END Halt ; | |
119 | ||
120 | ||
121 | (* | |
122 | DebugString - writes a string to the debugging device (Scn.Write). | |
123 | It interprets \n as carriage return, linefeed. | |
124 | *) | |
125 | ||
126 | PROCEDURE DebugString (a: ARRAY OF CHAR) ; | |
127 | VAR | |
128 | n, high: CARDINAL ; | |
129 | BEGIN | |
130 | high := HIGH( a ) ; | |
131 | n := 0 ; | |
132 | WHILE (n <= high) AND (a[n] # nul) DO | |
133 | IF a[n]='\' | |
134 | THEN | |
135 | IF n+1<=high | |
136 | THEN | |
137 | IF a[n+1]='n' | |
138 | THEN | |
139 | WriteLn ; | |
140 | INC(n) | |
141 | ELSIF a[n+1]='\' | |
142 | THEN | |
143 | Write('\') ; | |
144 | INC(n) | |
145 | END | |
146 | END | |
147 | ELSE | |
148 | Write( a[n] ) | |
149 | END ; | |
150 | INC( n ) | |
151 | END | |
152 | END DebugString ; | |
153 | ||
154 | ||
155 | (* | |
156 | WriteLn - writes a carriage return and a newline | |
157 | character. | |
158 | *) | |
159 | ||
160 | PROCEDURE WriteLn ; | |
161 | BEGIN | |
162 | Write(cr) ; | |
163 | Write(lf) | |
164 | END WriteLn ; | |
165 | ||
166 | ||
167 | (* | |
168 | Init - initialises this module. | |
169 | *) | |
170 | ||
171 | PROCEDURE Init ; | |
172 | BEGIN | |
173 | Ptr := 0 ; | |
174 | PushOutput(LocalWrite) | |
175 | END Init ; | |
176 | ||
177 | ||
178 | BEGIN | |
179 | Init | |
180 | END Debug. |