goto.c
1 //! @file goto.c
2 //! @author J. Marcel van der Veer
3 //
4 //! @section Copyright
5 //
6 // This file is part of VIF - vintage FORTRAN compiler.
7 // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
8 //
9 //! @section License
10 //
11 // This program is free software; you can redistribute it and/or modify it
12 // under the terms of the GNU General Public License as published by the
13 // Free Software Foundation; either version 3 of the License, or
14 // (at your option) any later version.
15 //
16 // This program is distributed in the hope that it will be useful, but
17 // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 // more details. You should have received a copy of the GNU General Public
20 // License along with this program. If not, see <http://www.gnu.org/licenses/>.
21
22 //! @section Synopsis
23 //!
24 //! Compile GOTO statements.
25
26 #include <vif.h>
27
28 static LBL *get_label (void) {
29 LBL *L = find_label (curlex);
30 if (L == NO_LABEL) {
31 ERROR (1801, "no such label", curlex);
32 return NO_LABEL;
33 } else if (L->nonexe) {
34 ERROR (1802, "label of non-executable", curlex);
35 return NO_LABEL;
36 }
37 L->jumped++;
38 return L;
39 }
40
41 void jump (void)
42 {
43 int_4 rc = scan (EXPECT_LABEL);
44 if (rc == LABEL) {
45 // GOTO label
46 LBL *L = get_label ();
47 if (L == NO_LABEL) {
48 return;
49 }
50 RECORD str;
51 _srecordf (str, "goto _l%d;\n", L->num);
52 code (nprocs, BODY, str);
53 skip_card (FALSE);
54 } else if (TOKEN ("(")) {
55 // GOTO (...), expr
56 code (nprocs, BODY, "switch (");
57 int_4 apatch = code (nprocs, BODY, NO_TEXT);
58 code (nprocs, BODY, ") {\n");
59 code (nprocs, BODY, "default:\n");
60 rc = scan (EXPECT_LABEL);
61 int_4 N = 1;
62 while (rc == LABEL) {
63 RECORD str;
64 LBL *L = get_label ();
65 if (L == NO_LABEL) {
66 return;
67 }
68 _srecordf (str, "case %d: goto _l%d;\n", N++, L->num);
69 code (nprocs, BODY, str);
70 rc = scan (EXPECT_NONE);
71 if (TOKEN (",")) {
72 rc = scan (EXPECT_LABEL);
73 }
74 };
75 CHECKPOINT (1803, ")");
76 rc = scan (EXPECT_NONE);
77 if (TOKEN (",")) {
78 rc = scan (EXPECT_NONE);
79 }
80 EXPR var;
81 express (&var, INTEGER, 4);
82 patch (apatch, var.str);
83 code (nprocs, BODY, "}\n");
84 skip_card (FALSE);
85 } else if (rc == WORD) {
86 // GOTO idf [, (...)]
87 IDENT *idf = find_local (curlex, NO_MODE);
88 if (idf == NO_IDENT ) {
89 return;
90 }
91 if (idf->mode.type != INTEGER) {
92 EXPECT (1804, "integer variable");
93 }
94 RECORD str;
95 EXPR var; MODE mode;
96 var.str[0] = '\0';
97 factor_variable (&var, idf, &mode, curlex);
98 _srecordf (str, "switch (%s) {\n", var.str);
99 code (nprocs, BODY, str);
100 code (nprocs, BODY, "default:\n");
101 rc = scan (EXPECT_NONE);
102 if (TOKEN (",") || TOKEN ("(")) {
103 // Emit indicated labels.
104 if (TOKEN (",")) {
105 rc = scan (EXPECT_NONE);
106 }
107 CHECKPOINT (1805, "(");
108 rc = scan (EXPECT_LABEL);
109 while (rc == LABEL) {
110 LBL *L = get_label ();
111 if (L == NO_LABEL) {
112 return;
113 }
114 _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
115 code (nprocs, BODY, str);
116 rc = scan (EXPECT_LABEL);
117 if (TOKEN (",")) {
118 rc = scan (EXPECT_LABEL);
119 }
120 }
121 CHECKPOINT (1806, ")");
122 code (nprocs, BODY, "}\n");
123 skip_card (FALSE);
124 } else {
125 // Default, emit all labels.
126 for (int_4 k = 0; k < nlabels; k++) {
127 LBL *L = &labels[k];
128 if (! L->nonexe) {
129 L->jumped++;
130 _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
131 code (nprocs, BODY, str);
132 }
133 }
134 code (nprocs, BODY, "}\n");
135 skip_card (FALSE);
136 }
137 }
138 }
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|