#include <perms.h>
#undef Itos
#undef Trim
_imp_string Itos(int i) {
}
void Trim(_imp_string S, int *Flag) {
}
// ***********************************************************************
// * SOAP80 - IMP80 formatter *
// * Last altered 15/06/83 *
// * *
// * Created by E.N.Gregory, UKC. *
// * All syntax directed sections rewritten by P.D.S., ERCC *
// * using IMP80 syntax version 02. *
// * User interface and parameters revised by J.M.M., ERCC. *
// * *
// ***********************************************************************
// We''ll need to supply some lookalike routines for the various
// EMAS system library calls below. I''ve converted the external specs
// into bodies, but haven''t written them yet. - GT
//_imp_string Cliparam(void);
//void Prompt(_imp_string *S) {}
// ***********************************************************************
// * *
// * Record formats. *
// * *
// ***********************************************************************
typedef struct Fhdr {
int Dataend;
int Datastart;
int Filesize;
int Filetype;
} Fhdr;
typedef struct Chdr {
int Conad;
int Filetype;
int Datastart;
int Dataend;
} Chdr;
static const int Maxopt = 16;
static const int Numopt = 3;
typedef struct Pformat {
unsigned char Tab[21 /*0:20*/];
union {
struct {
union {
struct {
unsigned char dummy,
Line, Icontin, Poscom, Movecom, Uckey, Sepkey, Expkey,
Lcasnam, Spacnam, Spacass, Spacop, Lclist, Iblock, Istat,
Seplab, Spcomma;
};
unsigned char Optarr[1+ 16/*Maxopt*/];
};
};
unsigned char A[1+ 21+16/*Maxopt*/];
};
} Pformat;
// ***********************************************************************
// * *
// * System routines. *
// * *
// ***********************************************************************
void Connect(_imp_string *Name, int Mode, int Hole, int Prot, Chdr *Rec,
int *Eflag) {}
void Setfname(_imp_string File) {}
_imp_string Nexttemp(void) { return (_imp_str_literal("")); }
void Sendfile(_imp_string File, _imp_string Device, _imp_string Header,
int Copies, int Form, int *Eflag) {}
int Devcode(_imp_string Name) { return (0); }
void Disconnect(_imp_string *Filename, int *Eflag) {}
_imp_string Failuremessage(int Type) { return (_imp_str_literal("")); }
void Changefilesize(_imp_string *Filename, int Filesize, int *Eflag) {}
void Newgen(_imp_string *Filename, _imp_string *Newfilename, int *Eflag) {}
void Outfile(_imp_string *Filename, int Size, int Hole, int Prot, int *Conad,
int *Eflag) {}
void Readprofile(_imp_string Key, Pformat *Info, int *Version, int *Uflag) {}
void Writeprofile(_imp_string *Key, Pformat *Info, int *Version, int *Uflag) {}
int _imp_mainep(int _imp_argc, char **_imp_argv) {
_imp_string S; // argv[1]
// %external %routine soap80(%string (255) s)
int Ptr;
int Dataend;
int Inptr;
int Z;
int In;
int Obp;
int Eflag;
int Writeaddress;
int Wa0;
int Filesize;
int Conad;
int Errors;
int Line;
int Erptr;
int Startline;
int Stream;
int Filesizeptr;
int Ssalt;
int Strdelimiter;
int Str;
int Semicolon;
int Colon;
int Maxptr;
int Maxitem;
int Level;
int Stop;
int Increm;
int Inlabel;
int Charsin;
int Ersave;
int Inconst;
int Bheading;
int Inline;
_imp_string Outf;
_imp_string Workfile;
_imp_string Infile;
_imp_string Percentc;
Pformat P;
Chdr Rec;
Chdr Rr;
Fhdr *Outrec;
static const int Ccsize = 16384;
short Outbuf[16585 /*0:16584*/];
unsigned char Sc[16385 /*0:16384*/];
static const _imp_string Optname[1+16 /*1:16*/] = { _imp_str_literal(""),
_imp_str_literal("LINE"), _imp_str_literal("ICONTIN"),
_imp_str_literal("POSCOM"), _imp_str_literal("MOVECOM"),
_imp_str_literal("UCKEY"), _imp_str_literal("SEPKEY"),
_imp_str_literal("EXPKEY"), _imp_str_literal("LCASNAM"),
_imp_str_literal("SPACNAM"), _imp_str_literal("SPACASS"),
_imp_str_literal("SPACOP"), _imp_str_literal("LCLIST"),
_imp_str_literal("IBLOCK"), _imp_str_literal("ISTAT"),
_imp_str_literal("SEPLAB"), _imp_str_literal("SPCOMMA")};
// !%constant %string (255) %array optmess(0:1, 1:maxopt)= ...
static const _imp_string Optmess[2+32 /*2:33*/] = { _imp_str_literal(""),_imp_str_literal(""),
_imp_str_literal("Line length zero (!!!)"),
_imp_str_literal("Maximum line length"),
_imp_str_literal("Continued lines not indented"),
_imp_str_literal("Indentation of continued lines"),
_imp_str_literal("Right hand comments not positioned"),
_imp_str_literal("Right hand comment position"),
_imp_str_literal("Whole line comments indented normally"),
_imp_str_literal("Whole line comments moved to POSCOM"),
_imp_str_literal("Keywords output in lower case"),
_imp_str_literal("Keywords output in upper case"),
_imp_str_literal("Keywords not split"),
_imp_str_literal("Keywords split"),
_imp_str_literal("%FN, %CONST, %ELSE not expanded"),
_imp_str_literal("%FN, %CONST, (sometimes) %ELSE expanded"),
_imp_str_literal("Case of names controlled by UCKEY"),
_imp_str_literal("Case of names left alone"),
_imp_str_literal("Spaces removed from names"),
_imp_str_literal("Spaces preserved within names"),
_imp_str_literal("No spaces round assignment operators"),
_imp_str_literal("Spaces added round assignment operators"),
_imp_str_literal("No spaces round operators"),
_imp_str_literal("Spaces added round operators"),
_imp_str_literal("Constant lists formatted"),
_imp_str_literal("Constant lists left alone"),
_imp_str_literal("Block not indented w.r.t. block heading"),
_imp_str_literal("Block indented w.r.t. block heading"),
_imp_str_literal("Statements aligned with declarations"),
_imp_str_literal("Statements indented w.r.t. declarations"),
_imp_str_literal("Labels not on lines by themselves"),
_imp_str_literal("Labels on lines by themselves"),
_imp_str_literal("No space character after commas"),
_imp_str_literal("Space character after commas")};
static const int Charfile = 3; // Code for a character file.
static const int Underline = 128;
static const int Instring = 256;
static const int Incurly = 512;
static const int Bpoint = 1024;
static const int Bpoint2 = 2048;
static const int Terminal = 1;
static const int File = 2;
static const int Samefile = 3;
static const int Device = 4;
static const int True = 255;
static const int False = 0; // Synthetic boolean values.
// static const int Nl = 10;
static const int Dquotes = 34;
static const int Squotes = 39;
static const int Rs = 30; // RECORD SEPARATOR IS USED AS A DELETED(BY %c) Nl
static const int Rem = 0b00000001;
static const int Constart = 0b00000010;
static const int Quotes = 0b00000100;
static const int Endst = 0b00001000;
static const int Number = 0b00010000;
static const int Letter = 0b00100000;
static const unsigned char Constfirst = 0b01000000;
static const int Constcont = 0b10000000; //
static const unsigned char Onecase[128 /*0:127*/] = {
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,
64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123, 124, 125, 126, 127};
static const unsigned char Chartype[256 /*0:255*/] = {
0b00000001,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00001000,
[11 ... 32] = 0b00000000,
0b00000001,
0b00000100,
0b01000000,
0b00000000,
0b00000001,
0b00000000,
0b00000100,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b11000000,
0b00000000,
[48 ... 57] = 0b11010000,
0b00000000,
0b00001000,
0b01000000,
0b01000000,
0b01000000,
0b00000000,
0b00000000,
0b00100000,
0b00100010,
0b00100010,
0b00100010,
0b00100000,
0b00100000,
0b00100000,
0b00100000,
0b00100000,
0b00100000,
0b00100010,
0b00100000,
0b00100010,
0b00100000,
0b00100000,
0b00100000,
0b00100000,
0b00100010,
0b00100000,
0b00100000,
0b00100000,
[86 ... 87] = 0b00100000,
0b00100010,
0b00100000,
0b00100000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00000000,
0b00100000,
0b00100010,
0b00100010,
0b00100010,
[101 ... 106] = 0b00100000,
0b00100010,
0b00100000,
0b00100010,
[110 ... 113] = 0b00100000,
0b00100010,
[115 ... 119] = 0b00100000,
0b00100010,
[121 ... 122] = 0b00100000,
0b00000000,
0b00000001,
0b00000000,
0b00000000,
0b00000000,
[128 ... 194] = 0b0,
0b00000001,
[196 ... 255] = 0b0};
static const unsigned char Keycom[8 /*0:7*/] = {'%', 'C', 'O', 'M',
'M', 'E', 'N', 'T'};
static const int Fstable[1+ 3 /*1:3*/] = {0, 4096, 16384, 65536};
//
// Special delimiters noted by SOAP80.
//
static const int Offile = 133;
static const int Ofprogram = 123;
static const int Equals = 38;
static const int Comma = 10;
static const int If = 12;
static const int Unless = 15;
static const int While = 22;
static const int Until = 28;
static const int Else = 227;
static const int Then = 222;
static const int And = 158;
static const int Or = 162;
static const int Const = 204;
static const int Constant = 195;
static const int Fn = 96;
static const int Function = 103; //
// static const _imp_string Snl = _imp_str_literal("\n"); //
static const _imp_string Fault[1+ 4 /*1:4*/] = {_imp_str_literal(""),
_imp_str_literal("Statement is too long and could not be compiled."),
_imp_str_literal(
"End of file reached before end of program terminator found."),
_imp_str_literal(
"%END found, but could not match it to a start of routine."),
_imp_str_literal("Disaster *** Indentation too near line length limit.")};
//
//
//
auto void Fail(int Type, int Action);
auto void Opt(_imp_string Parm, Pformat * P); //
// Produced by oldps from impalgs_imp80ps04 on 19/01/83
static const unsigned char Clett[435 /*0:434*/] = {
1, 43, 1, 45, 1, 40, 1, 41, 1, 42, 1, 44, 2, 201, 198,
6, 213, 206, 204, 197, 211, 211, 5, 215, 200, 201, 204, 197, 5, 213,
206, 212, 201, 204, 3, 198, 207, 210, 1, 61, 5, 193, 204, 201, 193,
211, 7, 201, 206, 212, 197, 199, 197, 210, 4, 210, 197, 193, 204, 4,
204, 207, 206, 199, 4, 194, 217, 212, 197, 6, 211, 212, 210, 201, 206,
199, 4, 200, 193, 204, 198, 6, 210, 197, 195, 207, 210, 196, 7, 210,
207, 213, 212, 201, 206, 197, 2, 198, 206, 3, 205, 193, 208, 8, 198,
213, 206, 195, 212, 201, 207, 206, 4, 206, 193, 205, 197, 5, 193, 210,
210, 193, 217, 9, 207, 198, 208, 210, 207, 199, 210, 193, 205, 6, 207,
198, 198, 201, 204, 197, 6, 207, 198, 204, 201, 211, 212, 6, 198, 207,
210, 205, 193, 212, 3, 206, 207, 212, 3, 193, 206, 196, 2, 207, 210,
1, 58, 4, 211, 208, 197, 195, 3, 207, 215, 206, 8, 197, 216, 212,
197, 210, 206, 193, 204, 9, 197, 216, 212, 210, 201, 206, 211, 201, 195,
8, 195, 207, 206, 211, 212, 193, 206, 212, 5, 195, 207, 206, 211, 212,
5, 197, 214, 197, 206, 212, 5, 211, 212, 193, 210, 212, 4, 212, 200,
197, 206, 4, 197, 204, 211, 197, 1, 95, 6, 211, 217, 211, 212, 197,
205, 7, 196, 217, 206, 193, 205, 201, 195, 4, 80, 85, 84, 95, 5,
67, 78, 79, 80, 95, 2, 204, 61, 1, 60, 1, 62, 4, 40, 196,
210, 43, 2, 196, 210, 1, 194, 3, 212, 207, 211, 3, 204, 206, 194,
3, 216, 206, 194, 2, 208, 195, 3, 195, 212, 194, 2, 45, 62, 6,
210, 197, 212, 213, 210, 206, 6, 210, 197, 211, 213, 204, 212, 7, 205,
207, 206, 201, 212, 207, 210, 4, 211, 212, 207, 208, 6, 211, 201, 199,
206, 193, 204, 4, 197, 216, 201, 212, 8, 195, 207, 206, 212, 201, 206,
213, 197, 6, 198, 201, 206, 201, 211, 200, 5, 195, 217, 195, 204, 197,
6, 210, 197, 208, 197, 193, 212, 3, 197, 206, 196, 7, 201, 206, 195,
204, 213, 196, 197, 5, 194, 197, 199, 201, 206, 2, 207, 206, 6, 211,
215, 201, 212, 195, 200, 4, 204, 201, 211, 212, 14, 212, 210, 213, 211,
212, 197, 196, 208, 210, 207, 199, 210, 193, 205, 6, 205, 193, 201, 206,
197, 208, 7, 195, 207, 206, 212, 210, 207, 204, 4, 40, 42, 41, 58};
static const int Symbol[1300+ 868 /*1300:2167*/] = {[0 ... 1299] = 0,
1307, 1303, 0, 1305, 2, 1307, 1000, 1319, 1312, 1001, 1366, 1786,
1315, 1003, 1020, 1319, 4, 1345, 6, 1329, 1323, 1001, 1014, 1325,
1003, 1329, 4, 1329, 6, 1336, 1336, 1010, 1028, 1319, 1011, 1359,
1345, 1343, 1010, 1028, 1319, 1011, 1359, 1345, 8, 1352, 1352, 1010,
1028, 1307, 1011, 1352, 1359, 1357, 1026, 1307, 999, 1359, 1000, 1366,
1364, 1026, 1319, 999, 1366, 1000, 1374, 1372, 4, 1345, 1374, 6,
1374, 1000, 1381, 1379, 10, 1345, 999, 1381, 1000, 1386, 1384, 12,
1386, 15, 1410, 1393, 22, 1010, 1536, 1556, 1011, 1399, 28, 1010,
1536, 1556, 1011, 1410, 34, 1010, 1001, 38, 1345, 10, 1345, 10,
1345, 1011, 1416, 1414, 40, 1013, 1416, 1000, 1423, 1421, 10, 1001,
999, 1423, 1000, 1428, 1426, 46, 1428, 1000, 1436, 1431, 54, 1433,
46, 1436, 59, 54, 1458, 1439, 46, 1441, 54, 1444, 59, 1428,
1447, 64, 1423, 1450, 69, 1689, 1453, 76, 1423, 1458, 81, 4,
1848, 6, 1465, 1461, 88, 1465, 1004, 1436, 1465, 1472, 1468, 96,
1470, 99, 1472, 103, 1488, 1478, 1436, 1493, 1001, 1416, 1484, 1458,
1488, 1001, 1416, 1501, 1488, 112, 1001, 1416, 1493, 1491, 112, 1493,
1000, 1501, 1497, 117, 112, 1499, 112, 1501, 1000, 1511, 1509, 4,
1010, 1472, 1011, 1511, 6, 1511, 1000, 1520, 1518, 1030, 1010, 1472,
1011, 999, 1520, 1000, 1531, 1524, 123, 1016, 1526, 133, 1529, 140,
1018, 1531, 1016, 1536, 1534, 147, 1536, 1000, 1550, 1542, 1345, 1032,
1345, 1550, 1547, 4, 1536, 1556, 6, 1550, 154, 1536, 1556, 1554,
1037, 1345, 1556, 1000, 1567, 1561, 158, 1536, 1567, 1565, 162, 1536,
1574, 1567, 1000, 1574, 1572, 158, 1536, 999, 1574, 1000, 1581, 1579,
162, 1536, 999, 1581, 1000, 1589, 1585, 1033, 1345, 1587, 165, 1589,
1000, 1595, 1593, 167, 1008, 1595, 1015, 1599, 1598, 167, 1599, 1608,
1606, 10, 1345, 165, 1345, 1599, 1608, 1000, 1617, 1613, 1493, 1001,
1416, 1617, 117, 1531, 1617, 1623, 1623, 1001, 1416, 1794, 1623, 1629,
1627, 10, 1617, 1629, 1000, 1646, 1639, 1493, 1595, 1010, 1001, 1410,
1802, 1011, 1646, 1646, 117, 1531, 1595, 1001, 1794, 1668, 1657, 1655,
10, 1010, 1001, 1410, 1802, 1011, 1646, 1657, 1000, 1668, 1660, 172,
1662, 176, 1664, 185, 1666, 195, 1668, 204, 1679, 1677, 38, 1012,
1028, 1319, 1359, 1689, 1679, 1679, 1000, 1689, 1687, 10, 1028, 1319,
1359, 1689, 999, 1689, 1000, 1696, 1694, 4, 1336, 6, 1696, 1000,
1703, 1701, 10, 1329, 999, 1703, 1000, 1708, 1706, 210, 1708, 1000,
1714, 1712, 10, 1345, 1714, 1000, 1727, 1725, 10, 1001, 1416, 4,
1345, 165, 1345, 6, 999, 1727, 1000, 1734, 1732, 28, 1536, 1556,
1734, 1000, 1747, 1737, 1019, 1739, 1006, 1744, 1381, 1536, 1556, 1006,
1747, 1386, 1006, 1761, 1751, 216, 1034, 1755, 222, 216, 1034, 1761,
222, 1010, 2008, 1011, 1767, 1767, 1765, 158, 2008, 1767, 1000, 1773,
1771, 227, 1773, 1773, 1000, 1786, 1777, 216, 1034, 1784, 1381, 1010,
1536, 1556, 1011, 1747, 1786, 2008, 1794, 1792, 232, 1001, 1366, 1786,
1794, 1000, 1802, 1802, 4, 1345, 165, 1345, 1599, 6, 1810, 1808,
38, 1028, 1319, 1359, 1810, 1000, 1819, 1813, 234, 1815, 176, 1817,
241, 1819, 1000, 1830, 1828, 1001, 38, 1345, 10, 1345, 10, 1345,
1830, 1000, 1837, 1835, 10, 1855, 999, 1837, 1000, 1848, 1841, 167,
1001, 1848, 1001, 4, 1855, 1830, 1873, 6, 1855, 1851, 1001, 1855,
1855, 1830, 1873, 1865, 1859, 1436, 1865, 1865, 4, 1855, 1830, 1873,
6, 1873, 1870, 1493, 1001, 1416, 1873, 117, 1617, 1881, 1879, 162,
1855, 1830, 999, 1881, 1000, 1898, 1886, 249, 1002, 1006, 1890, 1022,
1898, 1006, 1896, 254, 1009, 10, 1009, 1006, 1898, 1031, 1912, 1902,
1023, 1912, 1907, 1024, 260, 1951, 1956, 1912, 1025, 1005, 10, 1935,
1935, 1917, 263, 1001, 265, 1919, 1984, 1924, 4, 1984, 1973, 6,
1928, 267, 1984, 6, 1933, 4, 272, 1973, 6, 1935, 275, 1951,
1940, 263, 1001, 265, 1942, 1984, 1947, 4, 272, 1973, 6, 1951,
267, 1005, 6, 1956, 1954, 272, 1956, 1005, 1964, 1962, 10, 1005,
10, 1005, 1964, 1000, 1973, 1968, 0, 1005, 1971, 2, 1005, 1973,
1000, 1979, 1977, 0, 275, 1979, 1000, 1984, 1982, 38, 1984, 1000,
1999, 1989, 1979, 1300, 1003, 1992, 1001, 1964, 1997, 4, 1999, 1964,
6, 1999, 277, 2008, 2002, 281, 2004, 285, 2006, 289, 2008, 292,
2041, 2017, 1010, 1001, 1366, 1786, 1011, 1581, 1761, 2021, 296, 1001,
1366, 2023, 299, 2027, 306, 1033, 1345, 2030, 313, 1761, 2032, 321,
2037, 326, 1703, 1329, 1708, 2039, 333, 2041, 338, 2168, 2048, 1027,
1010, 2008, 1011, 1734, 2050, 1007, 2058, 1381, 1010, 1536, 1556, 1011,
1747, 1006, 2063, 347, 1035, 1767, 1006, 2068, 354, 1029, 1819, 1006,
2073, 360, 1036, 1727, 1006, 2078, 1386, 354, 1029, 1006, 2086, 1004,
1008, 1010, 1436, 1011, 1608, 1006, 2090, 367, 1520, 1006, 2095, 81,
147, 1837, 1006, 2105, 1010, 1810, 1458, 1011, 1589, 1001, 1410, 1501,
1006, 2110, 1657, 1436, 1629, 1006, 2114, 371, 1003, 1038, 2118, 379,
1015, 1006, 2127, 385, 1021, 1703, 1329, 1696, 216, 1034, 1006, 2138,
388, 1001, 1416, 4, 1345, 165, 1345, 6, 1714, 1006, 2142, 395,
1006, 1017, 2148, 227, 1035, 1039, 1034, 1006, 2151, 8, 1881, 2154,
400, 1006, 2158, 415, 1001, 1006, 2162, 422, 1003, 1006, 2166, 1001,
430, 1019, 2168, 1006};
static const int Ss = 2041;
static const int Comment = 2; // alt of p<SS> of %comment
static const int Ownalt = 12; // alt of p<SS> for owns
static const int Eisss = 0x00017F00; // Flag declarative ss alts
// MAY CHANGE WITH NEW SYNTAX
static const int Opc[128 /*0:127*/] = {
0, ' JCC', ' JAT', ' JAF', [4 ... 7] = 0, ' VAL', ' CYD', 'INCA',
'MODD', 'PRCL', ' J', ' JLK', 'CALL', ' ADB', ' SBB', 'DEBJ',
' CPB', ' SIG', ' MYB', ' VMY', 'CPIB', ' LCT', 'MPSR', 'CPSR',
'STCT', 'EXIT', 'ESEX', ' OUT', ' ACT', ' SL', 'SLSS', 'SLSD',
'SLSQ', ' ST', 'STUH', 'STXN', 'IDLE', ' SLD', ' SLB', 'TDEC',
'INCT', ' STD', ' STB', 'STLN', 'STSF', ' L', ' LSS', ' LSD',
' LSQ', 'RRTC', ' LUH', 'RALN', ' ASF', 'LDRL', ' LDA', 'LDTB',
' LDB', ' LD', ' LB', ' LLN', ' LXN', ' TCH', 'ANDS', ' ORS',
'NEQS', 'EXPA', ' AND', ' OR', ' NEQ', ' PK', ' INS', 'SUPK',
' EXP', 'COMA', ' DDV', 'DRDV', 'DMDV', 'SWEQ', 'SWNE', ' CPS',
' TTR', ' FLT', ' IDV', 'IRDV', 'IMDV', ' MVL', ' MV', 'CHOV',
' COM', ' FIX', ' RDV', 'RRDV', 'RDVD', ' UAD', ' USB', 'URSB',
' UCP', ' USH', ' ROT', ' SHS', ' SHZ', ' DAD', ' DSB', 'DRSB',
' DCP', ' DSH', ' DMY', 'DMYD', 'CBIN', ' IAD', ' ISB', 'IRSB',
' ICP', ' ISH', ' IMY', 'IMYD', 'CDEC', ' RAD', ' RSB', 'RRSB',
' RCP', ' RSC', ' RMY', 'RMYD', ' PUT'};
void Cnptf(
void) { // ***********************************************************************
// * Create New Page To File :- This is called when the output
// file *
// * is full and must be extended to a new page. *
// ***********************************************************************
if (Filesizeptr < 3) {
Filesizeptr++;
Filesize = Fstable[Filesizeptr];
} else
Filesize += Fstable[3];
Changefilesize(&Workfile, Filesize, &Eflag);
if (Eflag == 261) { // V.M. hole is too small for the new file size.
Disconnect(&Workfile, &Eflag);
if (Eflag)
Fail(Eflag, 5);
Changefilesize(&Workfile, Filesize, &Eflag);
if (!Eflag) {
Writeaddress -= Conad;
Connect(&Workfile, 3, 0, 0, &Rr, &Eflag);
if (Eflag)
Fail(Eflag, 5);
Conad = Rr.Conad;
Writeaddress += Conad;
Outrec = Record(Conad);
}
}
if (Eflag)
Fail(Eflag, 5);
Outrec->Filesize = Filesize; // Update file size in header.
}
void Transfer(
int From,
int To) { // ***********************************************************************
// * Transfer copies the contents of OUTBUF from FROM to TO
// into the *
// * output file or channel. *
// ***********************************************************************
int I;
int Ch;
int Last;
if (Stream != Terminal) {
Last = To - From + 1 + Writeaddress - Conad;
if (Last > Filesize)
Cnptf();
Outrec->Dataend = Last;
}
for (I = From; I <= To; I++) {
Ch = Outbuf[I] & 0x7F;
if ((Ch & 127) == Rs)
continue;
if (Ch == Nl) {
Charsin = 0;
Line++;
if (Stream != Terminal)
while (Writeaddress > Wa0 && *Byteinteger(Writeaddress - 1) == ' ')
Writeaddress--;
} else
Charsin++;
if (Stream == Terminal)
Printsymbol(Ch);
else {
*Byteinteger(Writeaddress) = Ch;
Writeaddress++;
}
}
}
void Outstring(
_imp_string
Text) { // ***********************************************************************
// * Outstring copies TEXT to the output file or channel.
// *
// ***********************************************************************
int I;
int Ch;
int Last;
if (Stream != Terminal) {
Last = *Length(Text) + Writeaddress - Conad;
if (Last > Filesize)
Cnptf();
Outrec->Dataend = Last;
}
for (I = 1; I <= *Length(Text); I++) {
Ch = *Charno(Text, I);
if (Ch == Nl) {
Charsin = 0;
Line++;
} else
Charsin++;
if (Stream == Terminal)
Printsymbol(Ch);
else {
*Byteinteger(Writeaddress) = Ch;
Writeaddress++;
}
}
}
void Dupl(
int Char,
int Times) { // ***********************************************************************
// * Dupl copies CHAR, TIMES times to the output file or
// channel. *
// ***********************************************************************
int I;
int Last;
if (Times <= 0)
return;
Charsin += Times;
if (Stream != Terminal) {
Last = Times + Writeaddress - Conad;
if (Last > Filesize)
Cnptf();
Outrec->Dataend = Last;
}
for (I = 1; I <= Times; I++)
if (Stream == Terminal)
Printsymbol(Char);
else {
*Byteinteger(Writeaddress) = Char;
Writeaddress++;
}
}
void Insert(
int Chars, int Lsflag,
int Rsflag) { // ***********************************************************************
// * This will place upto four characters into the OUTBUF
// buffer this *
// * includes the option of have spaces around the
// characters. *
// ***********************************************************************
if (Lsflag == True && True != Inconst) {
Outbuf[Obp] = ' ';
Obp++;
}
do {
Outbuf[Obp] = Chars & 0xFF;
Chars = (unsigned)Chars >> 8;
Obp++;
} while (Chars);
if (Rsflag == True && True != Inconst) {
Outbuf[Obp] = ' ';
Obp++;
}
}
void Closedown(
int Success) { // ***********************************************************************
// * Closedown is called when the program is to
// terminate execution *
// * and is to print a suitable message and to close
// the output file *
// * if any. *
// ***********************************************************************
if (Success == True)
Printstring(_imp_join(
Itos(Line),
_imp_join(_imp_str_literal(" lines have been processed"), Snl)));
else {
Printstring(
_imp_join(_imp_str_literal("Soap80 fails :- "), Itos(Errors)));
if (Errors == 1)
Printstring(_imp_join(_imp_str_literal(" error."), Snl));
else
Printstring(_imp_join(_imp_str_literal(" errors."), Snl));
} // Is there a file to close?
if (Stream != Terminal) {
Outrec->Dataend = Writeaddress - Conad;
Trim(Workfile, &Eflag);
Disconnect(&Workfile, &Eflag);
if (Stream == Samefile)
if (Errors > 0)
Printstring(_imp_join(
_imp_str_literal("Output stored in "),
_imp_join(Workfile,
_imp_join(_imp_str_literal(", since "),
_imp_join(Infile,
_imp_join(_imp_str_literal(
" contains errors."),
Snl))))));
else {
Newgen(&Workfile, &Outf, &Eflag);
if (Eflag) {
Printstring(_imp_join(
_imp_str_literal("Attempt to create "),
_imp_join(Outf,
_imp_join(_imp_str_literal(" failed because "),
_imp_join(Failuremessage(Eflag), Snl)))));
Printstring(_imp_join(
_imp_str_literal("Output stored in "),
_imp_join(Workfile, _imp_join(_imp_str_literal("."), Snl))));
}
}
else if (Stream == Device) {
if (*Length(Infile) > 8)
*Length(Infile) = 8;
Sendfile(Workfile, Outf,
_imp_join(_imp_str_literal("Soap80: "), Infile), 1, 0, &Eflag);
if (Eflag)
Fail(Eflag, 5);
}
} // ! pprofile REMOVED GT
exit(0); // Exit from SOAP80.
}
void Punch(
void) { // ***********************************************************************
// * PUNCH is for tranferring the contents of the OUTBUF array *
// * to the output file or channel, using TRANSFER, OUTSTRING and DUPL.*
// * *
// * PUNCH decides where to break a line if it is too long. *
// ***********************************************************************
int Lst;
int Bk;
int I;
int Ubp;
int Lbp;
int Bbp;
int Tp;
int Inn;
int Ch;
int Curlend;
Inn = In;
if ((1 << Ssalt & Eisss) == 0 && P.Istat == True)
Inn++;
if (Ssalt != Comment && Semicolon == False)
Dupl(' ', P.Tab[Inn] - Charsin); /*%if ssalt#comment %and semicolon=false %then dupl(' ', p_tab(inn)-charsin)*/
if (Outbuf[Obp - 1] == ';')
Semicolon = True;
else
Semicolon = False;
if (Semicolon == True && P.Line - 20 < Charsin + Obp) {
Semicolon = False;
Outbuf[Obp - 1] = Nl;
}
if (Semicolon == True) {
Outbuf[Obp] = ' ';
Obp++;
}
if (Increm == True) {
Increm = False; // Is indenting value too near the line length limit?
if (P.Tab[In+1] + 20 > P.Line) /*%if p_tab(in+1)+20>p_line %then fail(4, 2) %else in = in+1*/
Fail(4, 2);
else
In++;
}
Lst = 1;
if (Ssalt == Comment) { // Look for RS in comment. If found, output as
// more than one line.
for (;;) {
if ((Chartype[Sc[1]] & Rem) == 0 ||
Semicolon == True) { // Comment does not start in column 1.
if ((Semicolon | Colon) == False && P.Movecom == False)
Dupl(' ', P.Tab[Inn] - Charsin); /*dupl(' ', p_tab(inn)-charsin) %else dupl(' ', p_poscom-charsin)*/
else
Dupl(' ', P.Poscom - Charsin);
}
I = Lst;
while (I < Obp && (Outbuf[I] & 127) != Rs)
I++;
if (I == Obp)
goto Finalpart;
Transfer(Lst, I - 1);
if ((Outbuf[I - 1] & 127) == ',')
Outstring(Snl);
else
Outstring(_imp_join(Percentc, Snl));
do
I++;
while (I != Obp && Outbuf[I] == ' ');
Lst = I;
}
}
for (;;) {
Ubp = P.Line + Lst - Charsin - 4; // RHMOST BREAK POINT
Lbp = (Ubp + Lst) / 2;
Bbp = (Ubp + 3 * Lst) / 4;
Curlend = 0; // First check for nl in string const or list
for (Bk = Lst; Bk <= Ubp + 3; Bk++) {
if (Bk >= Obp)
break;
Ch = Outbuf[Bk];
if ((Ch & 127) == Nl ||
((Ch & 127) == Rs && Ssalt == Ownalt && P.Lclist == True))
goto Printpart;
}
if (Obp < Ubp + 3)
break; // 3 FOR " %C"
for (Bk = Ubp; Bk >= Bbp; Bk--) { // CHECK FOR PRIMARY BREAK POINTS
if (Outbuf[Bk] & Bpoint) {
while (Outbuf[Bk + 1] == ' ')
Bk++;
goto Printpart;
}
}
for (Bk = Ubp; Bk >= Bbp; Bk--) { // CHECK FOR SECONDARY BREAK POINT
if (Outbuf[Bk] & Bpoint2) {
while (Outbuf[Bk + 1] == ' ')
Bk++;
goto Printpart;
}
}
for (Bk = Ubp; Bk >= Bbp; Bk--)
if (Outbuf[Bk] == ',')
goto Printpart;
if (Outbuf[Ubp] & Incurly) { // IN A CURLY COMMENT
Curlend = 1;
for (Bk = Ubp; Bk <= Obp - 2; Bk++)
if (!(Outbuf[Bk] & Incurly)) {
Curlend = 0;
break;
} // curlend indicates whether the curly comment goes to the end of
// the line.
for (Bk = Ubp; Bk >= Bbp; Bk--)
if (!(Outbuf[Bk] & Incurly)) {
Bk--;
goto Printpart;
}
if (Curlend == 1)
goto Finalpart;
// Overlong curly comment.
for (Bk = Ubp; Bk <= Obp - 2; Bk++)
if (!(Outbuf[Bk] & Incurly))
goto Printpart;
}
for (Bk = Ubp + 1; Bk >= Lbp; Bk--)
if (Outbuf[Bk] == ' ' && (Outbuf[Bk - 1] & Underline) != 0)
goto Printpart;
if (!P.Spacnam) { // MUST OMIT IF NAMES ARE SPACED
for (Bk = Ubp + 1; Bk >= Lbp; Bk--)
if (Outbuf[Bk] == ' ')
goto Printpart;
}
for (Bk = Ubp; Bk >= Lbp; Bk--)
if (Outbuf[Bk] == '%') {
Bk--;
goto Printpart;
}
for (Bk = Ubp; Bk >= Lbp; Bk--) {
if (Outbuf[Bk] == '.' || Outbuf[Bk] == ')')
goto Printpart;
if (Outbuf[Bk] == '(') {
Bk--;
goto Printpart;
}
}
if (Outbuf[Ubp] & Instring) { // Break point is inside a string.
for (Bk = Ubp; Bk >= Bbp; Bk--)
if (Outbuf[Bk] == ',' || Outbuf[Bk] == '.' || Outbuf[Bk] == '=')
goto Printpart;
for (I = Ubp; I >= Lst + 3; I--)
if (Outbuf[I] == Dquotes) {
Bk = I - 1;
goto Printpart;
}
for (I = Bk; I >= Lst; I--)
if (Outbuf[I] == Squotes) {
if (!(Chartype[Outbuf[I - 1]] & Constart))
Bk = I - 1;
else
Bk = I - 2;
goto Printpart;
} // Break string.
Printstring(
_imp_join(_imp_str_literal("Line:"),
_imp_join(Itos(Line), _imp_str_literal(" problem:"))));
for (I = Lst; I <= Ubp; I++)
Printsymbol(Outbuf[I]);
Printstring(Snl);
Tp = Ubp - 1;
Transfer(Lst, Tp);
Outstring(_imp_join(_imp_str_literal("\"."), _imp_join(Percentc, Snl)));
Dupl(' ', P.Tab[Inn] + P.Icontin); /*dupl(' ', p_tab(inn)+p_icontin)*/
Outstring(_imp_str_literal("\""));
Lst = Tp + 1;
continue;
} else
Bk = Ubp;
Printstring(
_imp_join(_imp_str_literal("Line:"),
_imp_join(Itos(Line), _imp_str_literal(" problem:"))));
for (I = Lst; I <= Ubp; I++)
Printsymbol(Outbuf[I]);
Printstring(Snl);
Printpart:;
I = Bk;
while (Outbuf[I] == ' ' || (Outbuf[I] & 127) == Rs)
I--;
Transfer(Lst, I);
if (I < Lst || (Outbuf[I] & 127) != Nl) { // NOT NATURAL BREAK
if ((Outbuf[I] & 127) != ',' && Outbuf[Bk] != (Rs | 128) &&
Curlend == 0)
Outstring(_imp_join(_imp_str_literal(" "), Percentc));
Outstring(Snl);
if (!Inconst)
Dupl(' ', P.Tab[Inn] + P.Icontin); /*dupl(' ', p_tab(inn)+p_icontin) %if inconst=false*/
if ((Outbuf[Bk + 1] & Underline) != 0 && Outbuf[Bk + 1] != (Rs | 128))
Outstring(_imp_str_literal("%"));
}
Lst = Bk + 1;
}
Finalpart:;
Transfer(Lst, Obp - 1);
Obp = 1;
}
int Nextnonsp(
int Print) { // If PRINT is True then ' ' or '%' or RS are transferred
// to the output buffer when encountered.
int Ch;
for (;;) {
Ch = Sc[Ptr];
if (Ch == '{') {
if (Obp > 1 && Print == False) {
Outbuf[Obp] = ' ';
Obp++;
}
Outbuf[Obp] = '{';
Obp++;
Ptr++;
do {
Ch = Sc[Ptr];
Outbuf[Obp] = Ch | Incurly;
Obp++;
Ptr++;
} while (Ch != '}');
continue;
}
if (Ch != ' ' && Ch != '%' && (Ch & 127) != Rs)
break;
if (Print == True) {
Outbuf[Obp] = Ch;
Obp++;
}
Ptr++;
}
return (Ch);
}
void Getline(
int Initptr) { // ***********************************************************************
// * GETLINE :- take from the input file and processes
// the data and *
// * it into the array SC. *
// * *
// * The following processing is done: *
// * 1) All delimiters have 128 added to each
// character in the word*
// * 2) Lines are joined togther if there is a %c or
// ',' at the end*
// * of the first line. The newline position is
// marked by RS. *
// ***********************************************************************
static const unsigned char Itoi[256 /*0:255*/] = {[0 ... 9] = 32,
10,
[11 ... 24] = 32,
25,
26,
[27 ... 31] = 32,
32,
33,
34,
35,
36,
37,
38,
39,
40,
41,
42,
43,
44,
45,
46,
47,
48,
49,
50,
51,
52,
53,
54,
55,
56,
57,
58,
59,
60,
61,
62,
63,
64,
65,
66,
67,
68,
69,
70,
71,
72,
73,
74,
75,
76,
77,
78,
79,
80,
81,
82,
83,
84,
85,
86,
87,
88,
89,
90,
91,
92,
93,
94,
95,
96,
97,
98,
99,
100,
101,
102,
103,
104,
105,
106,
107,
108,
109,
110,
111,
112,
113,
114,
115,
116,
117,
118,
119,
120,
121,
122,
123,
124,
125,
126,
32,
[128 ... 132] = 26,
10,
[134 ... 143] = 26,
[144 ... 159] = 26,
[160 ... 173] = 26,
92,
38,
[176 ... 186] = 26,
35,
[188 ... 191] = 26,
[192 ... 207] = 26,
[208 ... 216] = 26,
35,
[218 ... 222] = 26,
94,
[224 ... 255] = 26};
short Scurl[1+ 20 /*1:20*/];
short Ecurl[1+ 20 /*1:20*/];
int Inkeyword;
int Char;
int P;
int Ncurl;
static int Strdelimiter;
if (Initptr == 1)
Startline = Inptr;
Ptr = Initptr;
for (;;) {
Inkeyword = False;
Ncurl = 0;
for (;;) {
if (Ptr > Ccsize) {
Fail(1, 1);
break;
}
if (Inptr > Dataend)
Fail(2, 1);
Char = Itoi[*Byteinteger(Inptr)];
Inptr++;
if (Char == Nl) {
Inline++;
Sc[Ptr] = Nl;
Ptr++;
break;
}
if (Str == True) {
Sc[Ptr] = Char;
Ptr++;
if (Char == Strdelimiter)
Str = False;
continue;
}
if (Chartype[Char] & Endst) {
Sc[Ptr] = Char;
Ptr++;
break;
} // Deal with curly bracket comments noting start so as to permit
// continuations of the form ...,{...}.
// Note that any missing closing brace is replaced.
if (Char == '{') {
Ncurl++;
Scurl[Ncurl] = Ptr;
Sc[Ptr] = Char;
Ptr++;
for (;;) {
Char = Itoi[*Byteinteger(Inptr)];
if (Char == Nl)
Char = '}';
else
Inptr++;
if (Char == '}')
break;
Sc[Ptr] = Char;
Ptr++;
}
Ecurl[Ncurl] = Ptr;
}
if (Inkeyword == True)
if (!(Chartype[Char] & Letter))
Inkeyword = False;
else {
Sc[Ptr] = Onecase[Char] | Underline;
Ptr++;
continue;
}
if (Char == '%')
Inkeyword = True;
if (Char == Squotes || Char == Dquotes) {
Str = True;
Strdelimiter = Char;
}
Sc[Ptr] = Char;
Ptr++;
}
if (Char == Nl) { // TRAILING SPACES Check
while (Ptr > 2 && Sc[Ptr - 2] == ' ')
Ptr--;
Sc[Ptr - 1] = Nl;
if (!Str) {
P = Ptr - 2;
while (Ncurl > 0 && Ecurl[Ncurl] == P) { // Step past curly bracket.
P = Scurl[Ncurl] - 1;
Ncurl--;
while (P > 0 && Sc[P] == ' ')
P--;
} // Now p points at character determining continuation.
if (P > 0) {
Char = Sc[P];
if (Char == ',') {
Sc[Ptr - 1] = Rs | 128;
continue;
}
if (Char == 'C' + Underline) {
if (P > 1 && Sc[P - 1] == '%')
Sc[P - 1] = ' ';
Sc[P] = ' ';
Sc[Ptr - 1] = Rs;
continue;
}
if ((Char & 127) == Rs) {
Sc[Ptr - 1] = Rs | 128;
continue;
}
}
}
}
break;
}
Ptr = Initptr;
}
int Compare(int Test) {
int I;
int Ch;
int Key;
int J;
for (I = 1; I <= Clett[Test]; I++) {
Ch = Nextnonsp(Inconst);
if (Ch != Clett[I + Test])
return (False);
Ptr++;
}
if (Test == Offile || Test == Ofprogram)
Stop = True;
if (Test == Comma) {
Insert(',', False, P.Spcomma);
return (True);
}
if (Test == Equals) {
if (Ssalt == Ownalt)
Inconst = P.Lclist; // If in own or const declaration and p_lclist is
// set, then set
// inconst to true. The effect of this is leave the declaration
// unformatted. Inconst is not set earlier as we do not wish the
// leading spaces in the statement to be preserved - i.e. the first
// line of the statement is indented with the rest of the program.
Insert('=', P.Spacass, P.Spacass);
return (True);
}
if (P.Expkey == True) {
if (Test == Fn)
Test = Function;
if (Test == Const)
Test = Constant;
}
if (Obp == 1 ||
((Outbuf[Obp - 1] & Underline) == 0 && (Outbuf[Obp - 1] & 127) != '%'))
Key = False;
else
Key = True; // Current state of outbuf.
for (I = 1; I <= Clett[Test]; I++) {
Ch = Clett[Test + I];
if (Ch < Underline && Key == True) {
Outbuf[Obp] = ' ';
Obp++;
Key = False;
} else if (Ch > Underline)
if (!Key) {
if (Obp > 1 && '(' != Outbuf[Obp - 1] && Outbuf[Obp - 1] != ' ') {
Outbuf[Obp] = ' ';
Obp++;
}
Outbuf[Obp] = '%';
Obp++;
Key = True;
} else if (I == 1 && P.Sepkey == True) {
Outbuf[Obp] = ' ';
Outbuf[Obp + 1] = '%';
Obp += 2;
}
if ((Ch & Underline) != 0 && P.Uckey == False && Ch != (Rs | 128))
Ch = Ch | 32;
Outbuf[Obp] = Ch;
Obp++;
}
if ((Test == Offile || Test == Ofprogram) && P.Sepkey == True) {
if (Test == Offile)
J = 4;
else
J = 7;
Obp += 2;
for (I = 1; I <= J; I++)
Outbuf[Obp - I] = Outbuf[Obp - I - 2];
Outbuf[Obp - J - 2] = ' ';
Outbuf[Obp - J - 1] = '%';
}
if (Test == If || Test == Unless || Test == While || Test == Until ||
Test == Else || Test == Then)
Outbuf[Obp - 1] = Ch | Bpoint;
if (Test == And || Test == Or)
Outbuf[Obp - 1] = Ch | Bpoint2;
return (True);
}
int Check(int Pos) {
int Defend;
int Subdefend;
int Subdefstart;
int Res;
int Item;
int Rsptr;
int Z;
int Strdelimiter;
int Ch;
int Rsobj;
int Alt;
int I;
int J;
static _imp_string Fes = _imp_str_literal("FINISH %ELSE %START");
static int Uci;
static int Depth = 0;
static int Bip_sw;
static void *Bip[41 /*999:1039*/] = {
&&Bip_999, &&Bip_1000, &&Bip_1001, &&Bip_1002, &&Bip_1003, &&Bip_1004,
&&Bip_1005, &&Bip_1006, &&Bip_1007, &&Bip_1008, &&Bip_1009, &&Bip_1010,
&&Bip_1011, &&Bip_1012, &&Bip_1013, &&Bip_1014, &&Bip_1015, &&Bip_1016,
&&Bip_1017, &&Bip_1018, &&Bip_1019, &&Bip_1020, &&Bip_1021, &&Bip_1022,
&&Bip_1023, &&Bip_1024, &&Bip_1025, &&Bip_1026, &&Bip_1027, &&Bip_1028,
&&Bip_1029, &&Bip_1030, &&Bip_1031, &&Bip_1032, &&Bip_1033, &&Bip_1034,
&&Bip_1035, &&Bip_1036, &&Bip_1037, &&Bip_1038, &&Bip_1039,
};
// Built-in phrases.
Alt = 0;
Depth++; // Depth of recursion in check.
if (Depth == 1)
Ssalt = 0; // Initialise ssalt if in top-level call.
Rsptr = Ptr;
Rsobj = Obp;
Defend = Symbol[Pos];
Pos++;
while (Pos < Defend) {
Alt++;
if (Depth == 1) { // Outer level - i.e. trying ss alternatives.
Ssalt++;
Inconst = False;
}
Subdefend = Symbol[Pos];
Pos++;
Res = True;
Subdefstart = Pos;
while (Pos < Subdefend) {
Item = Symbol[Pos];
if (999 <= Item && Item < 1300)
goto *Bip[Bip_sw = (Item)-999];
if (Item < 999)
Res = Compare(Item);
if (Item >= 1300)
Res = Check(Item);
Pos++;
goto Bypass;
Bip_999:;
Pos = Subdefstart; // Star function.
Rsptr = Ptr;
Rsobj = Obp;
goto Bypass;
Bip_1000:;
Depth--;
return (True);
Bip_1001:; // Name
Ch = Nextnonsp(Inconst);
J = Ptr;
Ptr++;
I = Obp;
if (!(Chartype[Ch] & Letter)) {
Res = False;
goto Inc;
}
if ((Chartype[Ch] & Constart) != 0 &&
Nextnonsp(Inconst | P.Spacnam) == Squotes) {
Res = False;
goto Inc;
}
Ptr = J;
Obp = I;
J = Outbuf[Obp - 1]; // LAST CHAR OUT
if (J > 128 || (Chartype[J] & Letter) != 0 || J == ')') {
Outbuf[Obp] = ' ';
Obp++;
}
while (Chartype[Ch] & (Letter | Number)) {
if ((Chartype[Ch] & Letter) != 0 &&
P.Lcasnam == False) { // Letter case in names to be controlled
// by P_UCKEY.
if (P.Uckey == True)
Ch = Ch & (~32);
else
Ch = Ch | 32;
}
Outbuf[Obp] = Ch;
Obp++;
J = Obp; // Position after latest character of name.
Ptr++;
Ch = Nextnonsp(Inconst | P.Spacnam);
} // Now j gives posn in outbuf after last character of name, and obp
// gives next free posn in outbuf.
if (P.Spacnam == True && Inconst == False &&
J < Obp) { // Throw away bytes after name, apart from curly
// comments.
I = J;
for (;;) {
while (I < Obp && (Outbuf[I] & 127) != '{')
I++;
if (I == Obp)
break;
if (J < I) {
Outbuf[J] = ' ';
do {
J++;
Outbuf[J] = Outbuf[I];
I++;
} while ((Outbuf[J] & 127) != '}');
} else {
do
J++;
while ((Outbuf[J] & 127) != '}');
I = J + 1;
}
J++;
}
Obp = J;
}
goto Inc;
Bip_1005:; // N - Number.
Ch = Nextnonsp(Inconst);
if (!(Chartype[Ch] & Number)) {
Res = False;
goto Inc;
}
Bip_1002:; // Iconst.
Bip_1003:; // Const.
Ch = Nextnonsp(Inconst);
Ptr++;
if ((Chartype[Ch] & (Quotes | Constfirst)) == 0 &&
((Chartype[Ch] & Constart) == 0 || Nextnonsp(Inconst) != Squotes)) {
Res = False;
goto Inc;
}
if (Outbuf[Obp - 1] > 128 ||
(Chartype[Outbuf[Obp - 1]] & Letter) != 0) {
Outbuf[Obp] = ' ';
Obp++;
}
if (!(Chartype[Ch] & Constfirst)) {
if (Chartype[Ch] & Constart) {
Outbuf[Obp] = Ch;
Obp++;
Strdelimiter = Nextnonsp(Inconst);
Ptr++;
} else
Strdelimiter = Ch;
Outbuf[Obp] = Strdelimiter;
Obp++;
for (;;)
if (Sc[Ptr] == Strdelimiter) {
Outbuf[Obp] = Strdelimiter | Instring;
if (Sc[Ptr + 1] != Strdelimiter)
break;
Outbuf[Obp + 1] = Strdelimiter | Instring;
Obp += 2;
Ptr += 2;
} else {
Ch = Sc[Ptr];
Outbuf[Obp] = Ch | Instring;
Obp++;
Ptr++;
if (Ch == Nl)
Getline(Ptr);
}
Ptr++;
Obp++;
} else {
Ptr--;
for (;;) {
for (;;) {
if (!(Chartype[Ch] & Constcont))
break;
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
Ch = Nextnonsp(Inconst);
}
if ('_' != Ch && Ch != '@')
break;
if (Ch == '@')
J = Number;
else
J = Number | Letter; // Second part of @ and radix consts
do {
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
Ch = Nextnonsp(Inconst);
} while (Chartype[Ch] & J);
}
}
goto Inc;
Bip_1004:
// Phrase check extended type
Ch = Nextnonsp(Inconst);
if (Ch <= Underline ||
((unsigned)0x80000000 >> (Ch & 31) & 0x20C83000) == 0)
Res = False;
goto Inc;
Bip_1038:
// Include
Bip_1006:
// S - End statement.
Ch = Nextnonsp(Inconst);
if (!(Chartype[Ch] & Endst)) {
Res = False;
goto Inc;
}
while (Obp > 1 && Outbuf[Obp - 1] == ' ')
Obp--;
Outbuf[Obp] = Ch;
Obp++;
goto Inc;
Bip_1007:
// Text - comment string.
Ch = Nextnonsp(Inconst);
if (!(Chartype[Ch] & Rem)) {
Res = False;
goto Inc;
}
if ((Ch & Underline) != 0 && ((Outbuf[Obp - 1] & Underline) == 0)) {
Outbuf[Obp] = '%';
Obp++;
}
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
if (Ch == 'C' + Underline) {
if (!P.Uckey)
Outbuf[Obp - 1] = Ch | 32;
for (I = 2; I <= 7; I++) {
Ch = Nextnonsp(Inconst);
if (Ch != Keycom[I] + Underline) {
Res = False;
goto Inc;
}
if (!P.Uckey)
Ch = Ch | 32;
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
}
}
Str = False;
for (;;) {
while (Sc[Ptr] != Nl && (Str == True || Sc[Ptr] != ';')) {
Ch = Sc[Ptr];
if (Ch == Squotes || Ch == Dquotes)
if (!Str) {
Strdelimiter = Ch;
Str = True;
} else if (Ch == Strdelimiter)
Str = False;
if ((Ch & Underline) != 0 && P.Uckey == False && Ch != (Rs | 128))
Ch = Ch | 32;
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
}
Outbuf[Obp] = Sc[Ptr];
Obp++;
Ptr++;
if (Outbuf[Obp - 1] == Nl)
break; // Semi-colon terminated input - carry on reading.
Getline(1);
}
Str = False;
goto Inc;
Bip_1009:
// N255 - Test string declaration length.
Ch = Nextnonsp(Inconst);
if ('0' > Ch || Ch > '9') {
Res = False;
goto Inc;
}
Z = 0;
while ('0' <= Ch && Ch <= '9') {
Z = Z * 10 + Ch - '0';
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
Ch = Nextnonsp(Inconst);
}
if (Z > 255)
Res = False;
goto Inc;
Bip_1012:
// Readline?
Ch = Nextnonsp(Inconst); // Deal with "FRED(1:10) = <nl> .. init vals
// .." constructions.
if (Ch == Nl) {
Outbuf[Obp] = Nl;
Obp++;
Sc[Ptr] = Rs | 128;
Getline(Ptr + 1);
}
goto Inc;
Bip_1015:
// Down.
Level++;
Bheading = True;
if (P.Iblock == True)
Increm = True;
goto Inc;
Bip_1016:
// Up.
Level--;
Bheading = True;
if (P.Iblock == True && In > 0)
In--;
goto Inc;
Bip_1019:
// Colon - Is previous character a colon ':'?
if (Sc[Ptr - 1] != ':') {
Res = False;
goto Inc;
}
if (Charsin > 0)
Outstring(Snl);
Ch = Nextnonsp(Inconst);
Transfer(1, Obp - 1);
Obp = 1;
if (P.Seplab == True && Ch != Nl)
Outstring(Snl);
Inlabel = True;
goto Inc;
Bip_1022:
// Setnem.
Ch = Nextnonsp(Inconst);
Z = ' ';
while (Chartype[Ch] & Letter) {
Z = Z << 8 | Onecase[Ch];
Outbuf[Obp] = Ch;
Obp++;
Ptr++;
Ch = Nextnonsp(Inconst);
}
if (Ch != '_' || Z == ' ') {
Res = False;
goto Inc;
}
Outbuf[Obp] = '_';
Obp++;
Uci = Z;
Ptr++;
goto Inc;
Bip_1023:
// Primform
for (I = 7; I <= 127; I++)
if (Opc[I] == Uci)
goto Pfnd;
Res = False;
goto Inc;
Pfnd: // Mnemonic found
if (8 <= (unsigned)I >> 3 && (unsigned)I >> 3 <= 11 && (I & 7) <= 3)
Res = False;
goto Inc;
Bip_1024:
// Sectform.
for (I = 64; I <= 88; I += 8)
for (J = 0; J <= 3; J++)
if (Opc[I + J] == Uci)
goto Inc;
Res = False;
goto Inc;
Bip_1025:
// Tertform.
for (I = 3; I >= 1; I--)
if (Opc[I] == Uci)
goto Inc;
Res = False;
goto Inc;
Bip_1026:
// Op.
Ch = Nextnonsp(Inconst);
Ptr++;
if (32 >= Ch || Ch >= 127 ||
((unsigned)0x80000000 >> (Ch & 31) & 0x4237000A) == 0) {
Res = False;
goto Inc;
}
if (Ch == '&' || Ch == '+' || Ch == '-') {
Insert(Ch, P.Spacop, P.Spacop);
goto Inc;
}
if (Ch == '*') {
if (Ch != Nextnonsp(Inconst)) {
Insert('*', P.Spacop, P.Spacop);
goto Inc;
}
Ptr++;
J = Ptr;
Ch = Nextnonsp(Inconst);
Ptr++;
if ('*' == Ch && Ch == Nextnonsp(Inconst)) {
Insert('****', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
Insert('**', P.Spacop, P.Spacop);
Ptr = J;
goto Inc;
}
if (Ch == '/') {
if (Ch != Nextnonsp(Inconst)) {
Insert('/', P.Spacop, P.Spacop);
goto Inc;
}
Insert('//', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
if (Ch == '!') {
if (Ch != Nextnonsp(Inconst)) {
Insert('!', P.Spacop, P.Spacop);
goto Inc;
}
Insert('!!', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
if (Ch == '.') {
Outbuf[Obp] = '.';
Obp++;
goto Inc;
}
if (Ch == Nextnonsp(Inconst) && Nextnonsp(Inconst) == '>') {
Insert('>>', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
if (Ch == Nextnonsp(Inconst) && Nextnonsp(Inconst) == '<') {
Insert('<<', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
if (Ch == '\\') {
if (Ch != Nextnonsp(Inconst)) {
Insert('\\', P.Spacop, P.Spacop);
goto Inc;
}
Insert('\\', P.Spacop, P.Spacop);
Ptr++;
goto Inc;
}
Res = False;
goto Inc;
Bip_1027:
// Chui.
Ch = Nextnonsp(Inconst);
if ((Chartype[Ch] & Letter) == 0 && Ch != '-' &&
((unsigned)0x80000000 >> (Ch & 31) & 0x14043000) == 0)
Res = False;
goto Inc;
Bip_1028:
// +''.
Ch = Nextnonsp(Inconst);
if (Ch == '+' || Ch == '-' || Ch == '\\' || Ch == 0x7E) {
Insert(Ch, P.Spacop, P.Spacop);
Ptr++;
}
goto Inc;
Bip_1031:
// Ucwrong (unknown user code format - allow it through).
for (;;) {
Ch = Nextnonsp(Inconst);
Outbuf[Obp] = Ch;
Obp++;
if (Chartype[Ch] & Endst)
goto Inc;
Ptr++;
}
Bip_1030:
// ,''.
Ch = Nextnonsp(Inconst);
if (Ch == ')')
Res = False;
if (Res == True)
Insert(',', False, P.Spcomma);
if (Ch == ',')
Ptr++;
goto Inc;
Bip_1032:
// Chcomp.
Bip_1037:
// Comp2
Ch = Nextnonsp(Inconst);
Ptr++;
if (32 >= Ch || Ch > 92 ||
((unsigned)0x80000000 >> (Ch & 31) & 0x1004000E) == 0) {
Res = False;
goto Inc;
}
if (Ch == '=') {
if (Nextnonsp(Inconst) == Ch) {
Ptr++;
Insert('==', P.Spacop, P.Spacop);
goto Inc;
}
Insert('=', P.Spacop, P.Spacop);
goto Inc;
}
if (Ch == '#') {
if (Nextnonsp(Inconst) == Ch) {
Ptr++;
Insert('##', P.Spacop, P.Spacop);
goto Inc;
}
Insert('#', P.Spacop, P.Spacop);
goto Inc;
}
if (Ch == '\\' && Nextnonsp(Inconst) == '=') {
Ptr++;
if (Nextnonsp(Inconst) == '=') {
Ptr++;Insert('==\\',P.Spacop,P.Spacop);goto Inc;
} Insert('=\\',P.Spacop,P.Spacop);goto Inc;
}
if (Ch == '>') {
if (Nextnonsp(Inconst) == '=') {
Ptr++;
Insert('=>', P.Spacop, P.Spacop);
goto Inc;
}
Insert('>', P.Spacop, P.Spacop);
goto Inc;
}
if (Ch == '<') {
if (Nextnonsp(Inconst) == '=') {
Ptr++;
Insert('=<', P.Spacop, P.Spacop);
goto Inc;
}
if (Nextnonsp(Inconst) == '>') {
Ptr++;
Insert('><', P.Spacop, P.Spacop);
goto Inc;
}
Insert('<', P.Spacop, P.Spacop);
goto Inc;
}
if (Ch == '-' && Nextnonsp(Inconst) == '>') {
Ptr++;
Insert('>-', P.Spacop, P.Spacop);
goto Inc;
}
Res = False;
goto Inc;
Bip_1033:
// Assop.
Ch = Nextnonsp(Inconst);
Ptr++;
if (Ch == '=') {
if (Nextnonsp(Inconst) == '=') {
Ptr++;
Insert('==', P.Spacass, P.Spacass);
goto Inc;
}
Insert('=', P.Spacass, P.Spacass);
goto Inc;
}
if (Ch == '<' && Nextnonsp(Inconst) == '-') {
Ptr++;
Insert('-<', P.Spacass, P.Spacass);
goto Inc;
}
if (Ch == '-' && Nextnonsp(Inconst) == '>') {
Ptr++;
Insert('>-', P.Spacass, P.Spacass);
goto Inc;
}
Res = False;
Bip_1008:
// Bighole.
goto Inc;
Bip_1010:
// Hole.
Bip_1011:
// Mark.
goto Inc;
Bip_1013:
// Alias.
Ch = Nextnonsp(Inconst);
Ptr++;
if (Ch != '"') {
Res = False;
goto Inc;
}
Outbuf[Obp] = ' ';
Obp++;
Outbuf[Obp] = '"';
Obp++;
for (;;)
if (Sc[Ptr] == '"') {
Outbuf[Obp] = '"' | Instring;
if (Sc[Ptr + 1] != '"')
break;
Outbuf[Obp + 1] = '"' | Instring;
Obp += 2;
Ptr += 2;
} else {
Ch = Sc[Ptr];
Outbuf[Obp] = Ch | Instring;
Obp++;
Ptr++;
if (Ch == Nl)
Getline(Ptr);
}
Ptr++;
Obp++;
goto Inc;
Bip_1014:
// Dummyapp.
Bip_1017:
// Liston.
Bip_1018:
// List off.
Bip_1020:
// Note const.
Bip_1021:
// Trace.
goto Inc;
Bip_1039:
// Dummy start
if (P.Expkey == True) { // Expand %else to %finish %else %start
Obp -= 4;
for (I = 1; I <= 19; I++) {
J = *Charno(Fes, I);
if (P.Sepkey == False && (J == ' ' || J == '%'))
continue;
if (P.Uckey == False && 'A' <= J && J <= 'Z')
J = J | 32;
Outbuf[Obp] = J;
Obp++;
}
}
Bip_1029:
// Note cycle
Bip_1034:
// Note start
Increm = True;
goto Inc;
Bip_1035:
// Note finish
Bip_1036:
// Note repeat
if (In > 0)
In--;
goto Inc;
Inc:;
Pos++;
Bypass:;
if (!Res) {
Pos = Subdefend;
Obp = Rsobj;
if (Ptr > Maxptr) {
Maxptr = Ptr;
Maxitem = Item;
}
Ptr = Rsptr;
}
}
if (Res == True) {
Depth--;
return (True);
}
}
Ptr = Rsptr;
Obp = Rsobj;
Depth--;
return (False);
}
// ***********************************************************************
// * *
// * Main calling routine. *
// * *
// ***********************************************************************
S = _imp_str_literal(
"test.imp,.out,SPCOMMA=Y,EXPKEY=Y"); // cliparam
// printstring("preopt".snl)
Opt(S, &P); // Call option setting routine to set parameters.
// printstring("preconnect ".infile.snl)
Connect(&Infile, 0, 0, 0, &Rec, &Eflag); // Open input file.
// printstring("postconnect".snl)
if (Eflag)
Fail(Eflag, 5);
if (Rec.Filetype != Charfile) {
Setfname(Infile);
Fail(267, 5);
}
Inptr = Rec.Conad + Rec.Datastart; // Start of data.
Dataend =
Rec.Conad + Rec.Dataend; // End of data.
// Set output stream, possibilities are:
// Terminal, file, same file or output device.
if (_imp_strcmp(Outf, _imp_str_literal(".OUT")) == 0)
Stream = Terminal;
else if (_imp_strcmp(Infile, Outf) == 0)
Stream = Samefile;
else if (*Charno(Outf, 1) == '.')
if (Devcode(Outf) <= 0) { // Invalid output device.
Setfname(Outf);
Fail(264, 5);
} else
Stream = Device;
else
Stream = File; // Create tempory output file?
if (Stream == Samefile || Stream == Device)
Workfile = _imp_join(_imp_str_literal("T#"), Nexttemp());
else
Workfile = Outf;
if (Stream != Terminal) {
Filesizeptr = 1;
Filesize = Fstable[Filesizeptr]; // printstring("outfile: ".workfile.snl)
Outfile(&Workfile, Filesize, 0, 0, &Conad, &Eflag);
if (Eflag)
Fail(Eflag, 5);
Outrec = Record(Conad);
Writeaddress = Conad + Outrec->Datastart;
Wa0 = Writeaddress;
Outrec->Filetype = Charfile; // Rest of record elements to be fill in at
// end of indentation.
}
Outbuf[0] = 0;
Sc[0] = 0;
Level = 0;
Obp = 1;
In = 0;
Inline = 1;
Line = 0;
Errors = 0;
Erptr = 0;
Charsin = 0;
Str = False;
Stop = False;
Semicolon = False;
Increm = False;
Inlabel = False;
Ersave = False;
if (P.Uckey == True)
Percentc = _imp_str_literal("%C");
else
Percentc = _imp_str_literal("%c");
for (;;) {
Bheading = False;
Maxptr = 0; // Is there more to analyse in this statement.
Colon = Inlabel;
if (!Inlabel)
Getline(1);
else
Inlabel = False;
if (!Check(Ss)) {
Printstring(_imp_join(
Snl,
_imp_join(_imp_str_literal("Syntax analysis fails on input line "),
Itos(Inline - 1))));
Printstring(_imp_join(
_imp_str_literal(" (output line "),
_imp_join(Itos(Line + 1), _imp_join(_imp_str_literal(")"), Snl))));
Z = 1;
while (!(Chartype[Sc[Z]] & Endst)) {
if ((Sc[Z] & 127) == Rs)
Printstring(Snl);
else
Printsymbol(Sc[Z] & 127);
Z++;
}
if (Sc[Z] == ';')
Printsymbol(';');
Printstring(Snl);
Spaces(Maxptr - 1);
Printsymbol('!');
Printstring(Snl);
while (*Byteinteger(Startline) == ' ')
Startline++;
if (Stream != Terminal) {
Obp = 1; // Line failed - Input line to output routine.
Z = *Byteinteger(Startline);
while (!(Chartype[Z] & Endst)) {
if (Chartype[Z] & Quotes) {
Strdelimiter = Z;
Outbuf[Obp] = Strdelimiter;
Obp++;
Startline++;
Z = *Byteinteger(Startline);
while (Z != Strdelimiter) {
Outbuf[Obp] = Z;
Obp++;
Startline++;
Z = *Byteinteger(Startline);
}
}
Outbuf[Obp] = Z;
Obp++;
Startline++;
Z = *Byteinteger(Startline);
}
Outbuf[Obp] = Z;
Obp++;
Punch();
}
Str = False;
Errors++;
} else if (!Inlabel)
Punch();
if (Stop == True)
if (!Errors)
Closedown(True);
else
Closedown(False);
} // DOES NOT COME THROUGH HERE
void Fail(int Type, int Action) {
if (Action != 5)
if (!(Action & 2)) {
Printstring(_imp_join(Snl, _imp_str_literal("*** Error: ")));
Errors++;
} else
Printstring(_imp_join(Snl, _imp_str_literal("*** Warning: ")));
if (!(Action & 4)) {
Printstring(_imp_join(Fault[Type], Snl));
Printstring(_imp_join(
_imp_str_literal("*** In input line "),
_imp_join(
Itos(Inline),
_imp_join(_imp_str_literal(" (output line "),
_imp_join(Itos(Line),
_imp_join(_imp_str_literal(")"), Snl))))));
} else {
Printstring(_imp_join(_imp_str_literal("*** Soap80 fails -"),
Failuremessage(Type)));
exit(0);
}
if ((Action & 1) == 1)
Closedown(False);
}
void Opt(
_imp_string Parm,
Pformat *
P) { // ***********************************************************************
// * THIS ROUTINE PROCESSES THE USER OPTION LIST *
// ***********************************************************************
auto void Readline(void);
auto void Setline(void);
auto int Stoi(_imp_string Snum);
auto void Ask(int Optno);
int I;
int J;
int Temp;
int Flag;
int Profvsn;
_imp_string Line;
_imp_string Option;
_imp_string Value;
_imp_string Filename;
static const int Progvsn = 3;
static int Prof_sw;
static void *Prof[4 /*0:3*/] = {
&&Prof_0,
&&Prof_1,
&&Prof_2,
&&Prof_3,
};
Profvsn = 0;
Flag = 5; // read profile("Soap80key", p, prof vsn, flag)
if (Flag > 4)
Printstring(_imp_join(
_imp_str_literal(
"Failed to read file SS#PROFILE. Defaults options assumed."),
Snl));
goto *Prof[Prof_sw = Profvsn];
// In the following profile-handling code, we work with array p_a
// (alternative format) rather than the actual option names (p_sepkey
// etc.). This is because the p_a operations remain valid even if the
// record format is subsequently changed.
Prof_0
:; // Code to set up profile vsn 1 data:
// This consists of 14 options followed by 21 tab values.
// original defaults
// p_a(1) = 80; %comment line - lines are broken into two if length
// is greater than 80. p_a(2) = 3; %comment icontin - continuation of
// line have an addition indentation of 3. p_a(3) = 41; %comment
// poscom - position for right hand comments. p_a(4) = true; %comment
// movecom - main comment are indented to POSCOM. p_a(5) = true;
// %comment uckey - keywords output in upper case. p_a(6) = false;
// %comment sepkey - adjacent keywords are compounded. p_a(7) = true;
// %comment lcasnam - case of names left alone. p_a(8) = true;
// %comment spacnam - spaces are left within names. p_a(9) = true;
// %comment spacass - spaces are added round assignment operators.
// p_a(10) = false; %comment spacop - spaces are not added round
// other operators. p_a(11) = true; %comment lclist - const lists to
// be left alone. p_a(12) = true; %comment iblock - block contents
// are indented w.r.t. block heading. p_a(13) = false; %comment istat
// - statements are aligned with declarations. p_a(14) = false;
// %comment seplab - Labels and statements may occupy the same line.
// graham''s preferred defaults
P->A[1] = 80; // line - lines are broken into two if length is greater than 80.
P->A[2] = 2; // icontin - continuation of line have an addition indentation of 3.
P->A[3] = 41; // poscom - position for right hand comments.
P->A[4] = False; // movecom - main comment are indented to POSCOM.
P->A[5] = False; // uckey - keywords output in upper case.
P->A[6] = True; // sepkey - adjacent keywords are compounded.
P->A[7] = False; // lcasnam - case of names left alone.
P->A[8] = True; // spacnam - spaces are left within names.
P->A[9] = True; // spacass - spaces are added round assignment operators.
P->A[10] = False; // spacop - spaces are not added round other operators.
P->A[11] = True; // lclist - const lists to be left alone.
P->A[12] = True; // iblock - block contents are indented w.r.t. block heading.
P->A[13] = False; // istat - statements are aligned with declarations.
P->A[14] = False; // seplab - Labels and statements may occupy the same line.
// Set default indentation values.
for (I = 0; I <= 10; I++)
P->A[I+15] = 3 * I;
for (I = 11; I <= 20; I++)
P->A[I+15] = 5 * I - 20;
Prof_1:; // Code to set up profile vsn 2 data:
// This consists of 15 options followed by 21 tab values.
for (I = 36; I >= 16; I--)
P->A[I] = P->A[I=1]; // Move tab values down to make room.
Printstring(
_imp_join(_imp_str_literal("**New parameter available: SPCOMMA"), Snl));
Printstring(
_imp_join(_imp_str_literal(
" Y : One space character inserted after commas."),
Snl));
Printstring(_imp_join(
_imp_str_literal(
" N : No space character inserted after commas (default)."),
_imp_join(Snl, Snl)));
P->A[15] = False; // spcomma - default false.
Prof_2:; // Code to set up profile vsn 3 data:
// This consists of 21 tab values followed by 16 options.
{
int I;
unsigned char Tab[21 /*0:20*/];
for (I = 0; I <= 20; I++) /*tab(i) = p_a(i+16) %for i = 0, 1, 20; %comment Copy tab values out.*/
Tab[I] = P->A[I+16]; // Copy tab values out.
for (I = 1; I <= 6; I++)
P->A[I+21] = P->A[I]; // Move options down.
// Item _a(28) will be the new parameter (expkey).
for (I = 7; I <= 15; I++)
P->A[I+22] = P->A[I]; // Move options down.
for (I = 0; I <= 20; I++) /*p_a(i+1) = tab(i) %for i = 0, 1, 20; %comment Copy tab values back.*/
P->A[I+1] = Tab[I]; // Copy tab values back.
}
Printstring(
_imp_join(_imp_str_literal("**New parameter available: EXPKEY"), Snl));
Printstring(_imp_join(
_imp_str_literal(
" Y : Keywords %FN, %CONST and (sometimes) %ELSE expanded."),
Snl));
Printstring(
_imp_join(_imp_str_literal(
" N : %FN, %CONST and %ELSE left alone (default)."),
_imp_join(Snl, Snl)));
P->A[28] = False; // expkey default - false.
// The following two lines should always be just before the final 'prof'
// switch label.
Profvsn = Progvsn;
{
_imp_string Key;
Key = _imp_str_literal("Soap80key");
Writeprofile(&Key, P, &Profvsn, &Flag);
}
Prof_3:; // Split up parameters and change default values.
if (_imp_resolve(Parm, &Filename, _imp_str_literal(","), &Outf)) {
if (!_imp_resolve(Outf, &Outf, _imp_str_literal(","), &Parm))
Parm = _imp_str_literal("");
} else {
Filename = Parm;
Outf = Parm;
Parm = _imp_str_literal("");
}
Infile = Filename;
if (_imp_strcmp(Outf, _imp_str_literal("")) == 0)
Outf = Filename;
if (_imp_strcmp(Parm, _imp_str_literal("")) == 0)
return;
Temp = *Charno(Parm, *Length(Parm));
if (Temp != '*' && Temp != '?')
Parm = _imp_join(Parm, _imp_str_literal(",END"));
for (;;) {
if (_imp_strcmp(Parm, _imp_str_literal("")) == 0) {
{
_imp_string S;
S = _imp_str_literal("Soap80: ");
Prompt(S); // not a real imp prompt unfortunately
}
Readline();
} else
Setline();
if (_imp_strcmp(Line, _imp_str_literal("END")) == 0 || _imp_strcmp(Line, _imp_str_literal(".END")) == 0)
return; // End of parameter settings.
if (_imp_strcmp(Line, _imp_str_literal("GO")) == 0 || _imp_strcmp(Line, _imp_str_literal(".GO")) == 0)
return; // End of parameter settings.
if (_imp_strcmp(Line, _imp_str_literal("STOP")) == 0 || _imp_strcmp(Line, _imp_str_literal(".STOP")) == 0)
exit(0); // Abandon Soap80.
if (_imp_strcmp(Line, _imp_str_literal("SAVE")) == 0 ||
_imp_strcmp(Line, _imp_str_literal(".SAVE")) == 0) {
{
_imp_string Key;
Key = _imp_str_literal("Soap80key");
Writeprofile(&Key, P, &Profvsn, &Flag);
}
if (Flag == 1)
Printstring(
_imp_join(_imp_str_literal(
"Profile file SS#PROFILE created and cherished."),
Snl));
} else if (_imp_strcmp(Line, _imp_str_literal("?")) == 0) { // Print options so far.
Printstring(_imp_join(
_imp_str_literal(
"Option name:{current setting}Meaning of current setting"),
Snl));
for (I = 1; I <= Maxopt; I++) {
Printstring(Optname[I]);
Spaces(7 - *Length(Optname[I]));
Printstring(_imp_str_literal(":{"));
J = P->Optarr[I];
if (!J)
Printsymbol('N');
else if (J == True)
Printsymbol('Y');
else
Printstring(Itos(J));
if (J > 0)
J = 1;
Printstring(_imp_join(_imp_str_literal("}"),
_imp_join(Optmess[J + I * 2], Snl)));
}
Printstring(_imp_str_literal("TAB :{"));
for (I = 1; I <= 20; I++) {
Printstring(Itos(P->Tab[I])); /*printstring(itos(p_tab(i)))*/
if (I != 20)
Printsymbol(':');
}
Printsymbol('}');
Printstring(Snl);
Printstring(
_imp_join(_imp_str_literal(" Indenting values"), Snl));
Printstring(_imp_join(
_imp_str_literal(
"SAVE : Save current option settings, for defaults "
"henceforth.\nGO or END: Cause SOAP80 to start processing the "
"input.\nSTOP : Cause SOAP80 to stop immediately."),
Snl));
} else if (_imp_resolve(Line, &Option, _imp_str_literal("="), &Value) &&
_imp_strcmp(Value, _imp_str_literal("")) != 0) {
Flag = 0;
for (I = 1; I <= Maxopt; I++) {
if (_imp_strcmp(Option, Optname[I]) != 0)
continue;
Flag = 1; // Option identified.
if (_imp_strcmp(Value, _imp_str_literal("?")) == 0) {
Printstring(Optname[I]);
Spaces(7 - *Length(Optname[I]));
Printstring(_imp_str_literal(":{"));
J = P->Optarr[I];
if (!J)
Printsymbol('N');
else if (J == True)
Printsymbol('Y');
else
Printstring(Itos(J));
if (J > 0)
J = 1;
Printstring(_imp_join(_imp_str_literal("}"),
_imp_join(Optmess[J + I * 2], Snl)));
} else if (I <= Numopt) { // Numerical value.
Temp = Stoi(Value);
if (_imp_strcmp(Option, _imp_str_literal("LINE")) == 0 &&
(Temp < 30 || Temp > 160)) {
Printstring(_imp_join(
_imp_str_literal("Bad line length - Only from 30 to 160"),
Snl));
break;
}
if (Temp > 255)
Temp = -1;
if (Temp == -1)
Printstring(_imp_join(Value, _imp_join(_imp_str_literal(" - "),
Failuremessage(320))));
else
P->Optarr[I] = Temp;
} else
Ask(I);
break;
}
if (Flag == 1)
continue; // Cycle found option name.
if (_imp_strcmp(Option, _imp_str_literal("TAB"))) { // Set indenting value.
if (_imp_strcmp(Value, _imp_str_literal("?")) == 0) {
Printstring(_imp_str_literal("TAB :{"));
for (I = 1; I <= 20; I++) {
Printstring(Itos(P->Tab[I]));
if (I != 20)
Printsymbol(':');
}
Printsymbol('}');
Printstring(Snl);
Printstring(
_imp_join(_imp_str_literal(" Indenting values"), Snl));
} else {
I = 1;
while (I <= 20 && _imp_strcmp(Value, _imp_str_literal("")) != 0) {
Temp = Stoi(Value);
if (Temp == -1) {
Printstring(_imp_join(Value, _imp_join(_imp_str_literal(" - "),
Failuremessage(320))));
break;
}
P->Tab[I] = Temp; /*p_tab(i) = temp*/
if (!*Length(Value)) {
I++;
break;
}
if (*Charno(Value, 1) != ':') {
Printstring(_imp_join(Value, _imp_join(_imp_str_literal(" - "),
Failuremessage(320))));
I = 21;
} else
Value = Substring(Value, 2, *Length(Value));
I++;
} // End of indenting value, make up the rest
for (J = I; J <= 20; J++) {
P->Tab[J] = 2 * P->Tab[J-1] - P->Tab[J-2]; /*p_tab(j) = 2*p_tab(j-1)-p_tab(j-2)*/
if (P->Tab[J] > P->Line) /*%if p_tab(j)>p_line %then p_tab(j) = p_line*/
P->Tab[J] = P->Line;
}
}
continue;
}
Printstring(_imp_join(
Option,
_imp_join(_imp_str_literal(" - "),
Failuremessage(322)))); // Keyword not recognised.
} else
Printstring(_imp_join(
Line,
_imp_join(
_imp_str_literal(
" - invalid: format should be\n 'keyword = value' "
" or 'keyword = ?' or '?' or\n 'SAVE' "
" or 'END' or 'GO' or 'STOP'"),
Snl)));
} // %return
void Readline(
void) { // ***********************************************************************
// * READLINE creates a line from the input device,
// converting all *
// * lower case characters to upper case. *
// ***********************************************************************
int Ch;
for (;;) {
Line = _imp_str_literal("");
for (;;) {
Readsymbol(&Ch);
if (Ch == Nl)
break;
if (Ch == ' ')
continue; // Convert lower to upper.
Line = _imp_join(Line, Tostring(Onecase[Ch]));
} // Return only if the line has some thing on it.
if (*Length(Line) > 0)
return;
}
}
void Setline(
void) { // ***********************************************************************
// * SETLINE breaks the parameter list into single commands.
// *
// ************************************************************************
if (!_imp_resolve(Parm, &Line, _imp_str_literal(","), &Parm)) { // Last command in parameter.
if (*Charno(Parm, *Length(Parm)) == '*')
Readline();
else
Line = Parm;
Parm = _imp_str_literal("");
}
}
void Ask(
int I) { // ***********************************************************************
// * ASK checks that value starts with Y or N and *
// * assigns True or False accordingly to P_OPTARR(I). *
// ***********************************************************************
int S;
S = *Charno(Value, 1);
if (S == 'Y')
P->Optarr[I] = True;
else if (S == 'N')
P->Optarr[I] = False;
else
Printstring(_imp_join(_imp_str_literal("Answer Yes or No or ?"), Snl));
}
int Stoi(
_imp_string
Snum) { // ***********************************************************************
// * STOI builts up an integer in INUM from the string SNUM, in *
// * doing so characters are deleted from this string. *
// * It is an error if the first character of the string is not a *
// * number. This is signalled by returning -1. *
// ***********************************************************************
int I;
int Inum;
if ('0' > *Charno(Snum, 1) || *Charno(Snum, 1) > '9')
return (-1);
I = 1;
Inum = 0;
while ('0' <= *Charno(Snum, I) && *Charno(Snum, I) <= '9') {
Inum = Inum * 10 + *Charno(Snum, I) - '0';
I++;
if (I > *Length(Snum))
break;
}
if (I >= *Length(Snum))
Snum = _imp_str_literal("");
else
Snum = Substring(Snum, I, *Length(Snum));
return (Inum);
}
}
exit(0);
return (1);
}