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.
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 (2101, "no such label", curlex);
32 return NO_LABEL;
33 } else if (L->nonexe) {
34 ERROR (2102, "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 NEW_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 NEW_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 (2103, ")");
76 rc = scan (EXPECT_NONE);
77 if (TOKEN (",")) {
78 rc = scan (EXPECT_NONE);
79 }
80 EXPR var;
81 macro_depth = 0;
82 express (&var, INTEGER, 4);
83 patch (apatch, var.str);
84 code (nprocs, BODY, "}\n");
85 skip_card (FALSE);
86 } else if (rc == WORD) {
87 // GOTO idf [, (...)]
88 IDENT *idf = find_local (curlex, NO_MODE);
89 if (idf == NO_IDENT ) {
90 return;
91 }
92 if (idf->mode.type != INTEGER) {
93 EXPECT (2104, "integer variable");
94 }
95 NEW_RECORD (str);
96 EXPR var; MODE mode;
97 var.str[0] = '\0';
98 factor_variable (&var, idf, &mode, curlex);
99 _srecordf (str, "switch (%s) {\n", var.str);
100 code (nprocs, BODY, str);
101 code (nprocs, BODY, "default:\n");
102 rc = scan (EXPECT_NONE);
103 if (TOKEN (",") || TOKEN ("(")) {
104 // Emit indicated labels.
105 if (TOKEN (",")) {
106 rc = scan (EXPECT_NONE);
107 }
108 CHECKPOINT (2105, "(");
109 rc = scan (EXPECT_LABEL);
110 while (rc == LABEL) {
111 LBL *L = get_label ();
112 if (L == NO_LABEL) {
113 return;
114 }
115 _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
116 code (nprocs, BODY, str);
117 rc = scan (EXPECT_LABEL);
118 if (TOKEN (",")) {
119 rc = scan (EXPECT_LABEL);
120 }
121 }
122 CHECKPOINT (2106, ")");
123 code (nprocs, BODY, "}\n");
124 skip_card (FALSE);
125 } else {
126 // Default, emit all labels.
127 for (int_4 k = 0; k < nlabels; k++) {
128 LBL *L = &labels[k];
129 if (! L->nonexe) {
130 L->jumped++;
131 _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
132 code (nprocs, BODY, str);
133 }
134 }
135 code (nprocs, BODY, "}\n");
136 skip_card (FALSE);
137 }
138 }
139 }
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|