projects / simh.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
First Commit of my working state
[simh.git] / Ibm1130 / utils / asm1130.c
CommitLineData
196ba1fc
PH		 1/*\r
2 * (C) Copyright 2002, Brian Knittel.\r
3 * You may freely use this program, but: it offered strictly on an AS-IS, AT YOUR OWN\r
4 * RISK basis, there is no warranty of fitness for any purpose, and the rest of the\r
5 * usual yada-yada. Please keep this notice and the copyright in any distributions\r
6 * or modifications.\r
7 *\r
8 * This is not a supported product, but I welcome bug reports and fixes.\r
9 * Mail to sim@ibm1130.org\r
10 */\r
11\r
12#define VERSION "ASM1130 CROSS ASSEMBLER V1.14"\r
13\r
14// ---------------------------------------------------------------------------------\r
15// ASM1130 - IBM 1130 Cross Assembler\r
16//\r
17// Version\r
18// 1.14 - 2004Oct22 - Fixed problem with BSS complaining about negative\r
19// sizes. This may be a fundamental problem with my using\r
20// 32-bit expressions, but for now, it appears that just\r
21// truncating the BSS size to 16 bits is sufficient to build DMS.\r
22// 1.13 - 2004Jun05 - Fixed sign extension of constants in expressions. Statements\r
23// like LD /FFFF were being assembled incorrectly.\r
24// 1.12 - 2004Jun04 - Made WAIT instruction take a displacement value.\r
25// Doesn't affect operation, but these are used as indicators\r
26// in the IBM one-card diagnostic programs.\r
27// Also -- should mention that the .IPL directive was\r
28// removed some time ago. To create bootable cards, \r
29// use -b flag to create binary output, and post-process the\r
30// binary output with program "mkboot"\r
31// 1.11 - 2004May22 - Added CMP, DCM, and DECS instructions for 1800,\r
32// thanks to Kevin Everets.\r
33// 1.10 - 2003Dec08 - Fixed opcode value for XCH instruction, thanks to\r
34// Roger Simpson.\r
35// 1.09 - 2003Aug03 - Added fxwrite so asm will write little-endian files\r
36// on all CPUs.\r
37// 1.08 - 2003Mar18 - Fixed bug that complained about valid MDX displacement of +127\r
38// 1.07 - 2003Jan05 - Filenames are now left in lower case. SYMBOLS.SYS stays all upper case\r
39// 1.06 - 2002May02 - Fixed bug in ebdic constants (data goes into low byte)\r
40// First stab at adding ISS level # info, this is iffy\r
41// 1.05 - 2002Apr24 - Made negative BSS size a warning not an error, as it\r
42// it's looking like it happens twice in PTMASMBL.\r
43// This version still doesn't do fixed point numbers and\r
44// negative floats may be wrong.\r
45// 1.04 - 2002Apr18 - Added binary (card loader format) output, removed\r
46// interim IPL output formats and moved that to MKBOOT.\r
47// Enhanced relocatable code handling. Added floating\r
48// point constants, but don't know how to make fixed point\r
49// constants yet. Made amenable to syntax variations found\r
50// in the DMS sources. Doesn't properly handle ILS\r
51// modules yet and ISS is probably wrong.\r
52// 1.03 - 2002Apr10 - numerous fixes, began to add relative/absolute support\r
53// 1.02 - 2002Feb26 - replaced "strupr" with "upcase" for compatibility\r
54// 1.01 - 2002Feb25 - minor compiler compatibility changes\r
55// 1.00 - 2002Feb01 - first release. Tested only under Win32.\r
56// ---------------------------------------------------------------------------------\r
57//\r
58// Usage:\r
59// asm1130 [-bvsx] [-o[file]] [-l[file]] [-rN.M] file...\r
60//\r
61// Description:\r
62// -b binary output (.bin, relocatable absolute format)\r
63// -v verbose\r
64// -s print symbol table\r
65// -x print cross references\r
66// -o output file (default is name of first source file + extension .out or .bin)\r
67// -l listing file (default is name of first source file + extension .lst)\r
68// -y preload system symbol table SYMBOLS.SYS (from the current directory)\r
69// -w write the system symbol table SYMBOLS.SYS in the current directory\r
70// -W same as -w but don't prompt to confirm overwriting existing file\r
71// -r set DMS release to release N version M, for sbrk cards\r
72//\r
73// Listing and symbol table output can be turned on by *LIST directives in the source, too\r
74// Listing file default extension is .LST\r
75//\r
76// Input files can use strict IBM 1130 Assembler column format, or loose formatting\r
77// with tabs, or any mix on a line-by-line basis. Input files default extension is .ASM.\r
78//\r
79// Strict specification is:\r
80//\r
81// label columns 1 - 5\r
82// opcode 7 - 10\r
83// tag 12\r
84// index 13\r
85// arguments 15 - 51\r
86//\r
87// Loose, indicated by presence of ascii tab character(s):\r
88//\r
89// label<tab>opcode<tab>index and format indicators<tab>arguments\r
90//\r
91// In both cases, the IBM convention that the arguments section ends with the\r
92// first nonblank applies. This means that ".DC 1, 2, 3" assembles only the 1!\r
93//\r
94// Output file format is that used by the LOAD command in my 1130\r
95// simulator. Lines are any of the following. All values are in hex:\r
96//\r
97// @addr load address for subsequent words is addr\r
98// Znwords Zero the next "nwords" and increment load address by nwords.\r
99// =addr set IAR register to address addr (a convenience)\r
100// value load value at load address and increment load address\r
101//\r
102// Output file default extension is .OUT or .BIN for binary assemblies\r
103//\r
104// Note: this version does not handle relative assembly, and so doesn't carry\r
105// absolute/relative indication through expression calculation.\r
106//\r
107// Seems to work. Was able to assemble the resident monitor OK.\r
108// >>> Look for "bug here" though, for things to check out.\r
109//\r
110// Notes:\r
111// We assume that the computer on which the assembler runs uses ANSI floating point.\r
112// Also, the assembly of floating point values may be incorrect on non-Intel \r
113// architectures, this needs to be investigated.\r
114//\r
115// org_advanced tells whether * in an expression refers to the address AFTER the\r
116// instruction (1 or 2 words, depending on length). This is the case for opcodes\r
117// but not all directives.\r
118//\r
119// Revision History\r
120// 16Apr02 1.03 Added sector break, relocation flag output\r
121// 02Apr02 1.02 Fixed bug in BOSC: it CAN be a short instruction.\r
122// Added directives for 1130 and 1800 IPL output formats\r
123// Added conditional assembly directives\r
124// ---------------------------------------------------------------------------------\r
125\r
126#include <stdio.h>\r
127#include <string.h>\r
128#include <stdlib.h>\r
129#include <stdarg.h>\r
130#include <setjmp.h>\r
131#include <time.h>\r
132#include <ctype.h>\r
133#include "util_io.h"\r
134\r
135// ---------------------------------------------------------------1------------------\r
136// DEFINITIONS\r
137// ---------------------------------------------------------------------------------\r
138\r
139// I have found some IBM source code where @ and ' seem interchangable (likely due to the\r
140// use of 026 keypunches).\r
141// Comment out this define to make @ and ' different in symbol names, keep to make equivalent\r
142\r
143#if defined(VMS)\r
144 # include <unistd.h> /* to pick up 'unlink' */\r
145#endif\r
146\r
147#define BETWEEN(v,a,b) (((v) >= (a)) && ((v) <= (b)))\r
148#define MIN(a,b) (((a) <= (b)) ? (a) : (b))\r
149#define MAX(a,b) (((a) >= (b)) ? (a) : (b))\r
150\r
151#ifndef _WIN32\r
152 int strnicmp (char *a, char *b, int n);\r
153 int strcmpi (char *a, char *b);\r
154#endif\r
155\r
156#define FIX_ATS \r
157\r
158#define DMSVERSION "V2M12" /* required 5 characters on sector break card col 67-71 */\r
159\r
160#define DOLLAREXIT "/38" // hmmm, are these really fixed absolutely in all versions?\r
161#define DOLLARDUMP "/3F"\r
162\r
163#define SYSTEM_TABLE "SYMBOLS.SYS"\r
164\r
165#define BOOL int\r
166#define TRUE 1\r
167#define FALSE 0\r
168\r
169#define ISTV 0x33 // magic number from DMS R2V12 monitorm symbol @ISTV\r
170\r
171#define MAXLITERALS 300\r
172#define MAXENTRIES 14\r
173\r
174#define LINEFORMAT " %4ld | %s"\r
175#define LEFT_MARGIN " |"\r
176 // XXXX XXXX XXXX XXXX XXXX XXXX\r
177 // org w1 w2 w3 w4 w5\r
178 // XXXX 1111 2222 3333 4444 LLLL |\r
179 // 12345678901234567890123456789012\r
180\r
181typedef enum {ABSOLUTE = 0, RELATIVE = 1, LIBF = 2, CALL = 3} RELOC;\r
182\r
183typedef struct tag_symbol { // symbol table entry:\r
184 char *name; // name of symbol\r
185 int value; // value (absolute)\r
186 int pass; // defined during pass #\r
187 int defined; // definition state, see #defines below\r
188 RELOC relative; // ABSOLUTE = absolute, RELATIVE = relative\r
189 struct tag_symbol *next; // next symbol in list\r
190 struct tag_xref *xrefs; // cross references\r
191} SYMBOL, *PSYMBOL;\r
192\r
193#define S_UNDEFINED 0 // values of 'defined'\r
194#define S_PROVISIONAL 1 // usually an expression with forward references\r
195#define S_DEFINED 2 // ordering must be undef < prov < def\r
196\r
197typedef struct tag_xref { // cross reference entry\r
198 char *fname; // filename\r
199 int lno; // line number\r
200 BOOL definition; // true = definition, false = reference\r
201 struct tag_xref *next; // next reference\r
202} XREF, *PXREF;\r
203\r
204typedef struct tag_expr { // expression result: absolute or relative\r
205 int value;\r
206 RELOC relative;\r
207} EXPR;\r
208\r
209typedef enum {PROGTYPE_ABSOLUTE = 1, PROGTYPE_RELOCATABLE = 2, PROGTYPE_LIBF = 3, PROGTYPE_CALL = 4,\r
210 PROGTYPE_ISSLIBF = 5, PROGTYPE_ISSCALL = 6, PROGTYPE_ILS = 7} PROGTYPE;\r
211\r
212typedef enum {SUBTYPE_INCORE = 0, SUBTYPE_FORDISK = 1, SUBTYPE_ARITH = 2,\r
213 SUBTYPE_FORNONDISK = 3, SUBTYPE_FUNCTION=8} SUBTYPE;\r
214\r
215typedef enum {INTMODE_UNSPECIFIED = 0, INTMODE_MATCHREAL = 0x0080, INTMODE_ONEWORD = 0x0090} INTMODE;\r
216typedef enum {REALMODE_UNSPECIFIED = 0, REALMODE_STANDARD = 0x0001, REALMODE_EXTENDED = 0x0002} REALMODE;\r
217\r
218#define OP_INDEXED 0x0300 // 1130 opcode modifier bits\r
219#define OP_LONG 0x0400\r
220#define OP_INDIRECT 0x0080\r
221\r
222typedef enum {OUTMODE_LOAD, OUTMODE_1130, OUTMODE_1800, OUTMODE_BINARY} OUTMODE;\r
223\r
224#ifdef _WIN32\r
225# define OUTWRITEMODE "wb" // write outfile in binary mode\r
226# define ENDLINE "\r\n" // explictly write CR/LF\r
227#else\r
228# define OUTWRITEMODE "w" // use native mode\r
229# define ENDLINE "\n"\r
230#endif\r
231\r
232// ---------------------------------------------------------------------------------\r
233// GLOBALS\r
234// ---------------------------------------------------------------------------------\r
235\r
236// command line syntax\r
237char *usestr =\r
238"Usage: asm1130 [-bpsvwxy8] [-o[file]] [-l[file]] [-rN.M] file...\n\n"\r
239"-b binary (relocatable format) output; default is simulator LOAD format\n"\r
240"-p count passes required; no assembly output is created with this flag"\r
241"-s add symbol table to listing\n"\r
242"-v verbose mode\n"\r
243"-w write system symbol table as SYMBOLS.SYS\n"\r
244"-W same as -w but do not confirm overwriting previous file\n"\r
245"-x add cross reference table to listing\n"\r
246"-y preload system symbol table SYMBOLS.SYS\n"\r
247"-o set output file; default is first input file + .out or .bin\n"\r
248"-l create listing file; default is first input file + .lst\n"\r
249"-r set dms version to VN RM for system SBRK cards\n"\r
250"-8 enable IBM 1800 instructions"; // (alternately, rename or link executable to asm1800.exe)\r
251\r
252BOOL verbose = FALSE; // verbose mode flag\r
253BOOL tabformat = FALSE; // TRUE if tabs were seen in the file\r
254BOOL enable_1800 = FALSE; // TRUE if 1800 mode is enabled by flag or executable name\r
255int pass; // current assembler pass (1 or 2)\r
256char curfn[256]; // current input file name\r
257char progname[8]; // base name of primary input file\r
258char *outfn = NULL; // output file name\r
259int lno; // current input file line number\r
260BOOL preload = FALSE; // preload system symbol table\r
261BOOL savetable = FALSE; // write system symbol table\r
262BOOL saveprompt = TRUE; // prompt before overwriting\r
263int nerrors = 0; // count of errors\r
264int nwarnings = 0; // count of warnings\r
265FILE *fin = NULL; // current input file\r
266FILE *fout = NULL; // output file stream\r
267OUTMODE outmode = OUTMODE_LOAD; // output file mode\r
268int outcols = 0; // columns written in using card output\r
269int maxiplcols = 80;\r
270char cardid[9]; // characters used for IPL card ID\r
271FILE *flist = NULL; // listing file stream\r
272char *listfn = NULL; // listing filename\r
273BOOL do_list = FALSE; // flag: create listing\r
274BOOL passcount = FALSE; // flag: count passes only\r
275BOOL list_on = TRUE; // listing is currently enabled\r
276BOOL do_xref = FALSE; // cross reference listing\r
277BOOL do_syms = FALSE; // symbol table listing\r
278BOOL ended = FALSE; // end of current file\r
279BOOL hasforward = FALSE; // true if there are any forward references\r
280char listline[350]; // output listing line\r
281BOOL line_error; // already saw an error on current line\r
282RELOC relocate = RELATIVE; // relocatable assembly mode\r
283BOOL assembled = FALSE; // true if any output has been generated\r
284int nwout; // number of words written on current line\r
285int org = 0; // output address (origin)\r
286int org_advanced; // if TRUE, * means instruction addr+(value) during evaluation\r
287int pta = -1; // program transfer address\r
288BOOL cexpr = FALSE; // "C" expression syntax\r
289PSYMBOL symbols = NULL; // the symbol table (linear search)\r
290BOOL check_control = TRUE; // check for control cards\r
291PROGTYPE progtype = PROGTYPE_RELOCATABLE; // program type\r
292INTMODE intmode = INTMODE_UNSPECIFIED; // integer mode\r
293REALMODE realmode = REALMODE_UNSPECIFIED; // real mode\r
294int nintlevels = 0; // # of interrupt levels for ISS\r
295int intlevel_primary = 0; // primary level for ISS and level for ILS\r
296int intlevel_secondary = 0; // secondary level for ISS\r
297int iss_number = 0; // ISS number\r
298PSYMBOL entry[MAXENTRIES]; // entries for subroutines\r
299int nentries = 0;\r
300int ndefined_files = 0;\r
301\r
302struct lit { // accumulated literals waiting to be output\r
303 int value; // constant value\r
304 int tagno; // constant symbol tag number (e.g. _L001)\r
305 BOOL hex; // constant was expressed in hex\r
306 BOOL even; // constant was operand of a double-width instruction (e.g. AD)\r
307} literal[MAXLITERALS];\r
308\r
309int n_literals = 0, lit_tag = 0;\r
310BOOL requires_even_address; // target of current instruction\r
311BOOL dmes_saved; // odd character left over from dmes ending in '\r
312int dmes_savew;\r
313char opfield[256]; // extracted operand field from source line\r
314char dmsversion[12] = DMSVERSION; // version number for SBRK cards\r
315const char whitespace[] = " \t"; // whitespace\r
316\r
317int ascii_to_ebcdic_table[128] = \r
318{\r
319//\r
320 0x00,0x01,0x02,0x03,0x37,0x2d,0x2e,0x2f, 0x16,0x05,0x25,0x0b,0x0c,0x0d,0x0e,0x0f,\r
321//\r
322 0x10,0x11,0x12,0x13,0x3c,0x3d,0x32,0x26, 0x18,0x19,0x3f,0x27,0x1c,0x1d,0x1e,0x1f,\r
323// spac ! " # $ % & ' ( ) * + , - . /\r
324 0x40,0x5a,0x7f,0x7b,0x5b,0x6c,0x50,0x7d, 0x4d,0x5d,0x5c,0x4e,0x6b,0x60,0x4b,0x61,\r
325// 0 1 2 3 4 5 6 7 8 9 : ; < = > ?\r
326 0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7, 0xf8,0xf9,0x7a,0x5e,0x4c,0x7e,0x6e,0x6f,\r
327// @ A B C D E F G H I J K L M N O\r
328 0x7c,0xc1,0xc2,0xc3,0xc4,0xc5,0xc6,0xc7, 0xc8,0xc9,0xd1,0xd2,0xd3,0xd4,0xd5,0xd6,\r
329// P Q R S T U V W X Y Z [ \ ] & _\r
330 0xd7,0xd8,0xd9,0xe2,0xe3,0xe4,0xe5,0xe6, 0xe7,0xe8,0xe9,0xba,0xe0,0xbb,0xb0,0x6d,\r
331// a b c d e f g h i j k l m n o\r
332 0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87, 0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,\r
333// p q r s t u v w x y z { | } ~\r
334 0x97,0x98,0x99,0xa2,0xa3,0xa4,0xa5,0xa6, 0xa7,0xa8,0xa9,0xc0,0x4f,0xd0,0xa1,0x07,\r
335};\r
336\r
337int ascii_to_1403_table[128] = \r
338{ /* 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f */\r
339 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f, 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,\r
340 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f, 0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,0x7f,\r
341 0x7f,0x7f,0x7f,0x7f,0x62,0x7f,0x15,0x0b, 0x57,0x2f,0x23,0x6d,0x16,0x61,0x6e,0x4c,\r
342 0x49,0x40,0x01,0x02,0x43,0x04,0x45,0x46, 0x07,0x08,0x7f,0x7f,0x7f,0x4a,0x7f,0x7f,\r
343 0x7f,0x64,0x25,0x26,0x67,0x68,0x29,0x2a, 0x6b,0x2c,0x58,0x19,0x1a,0x5b,0x1c,0x5d,\r
344 0x5e,0x1f,0x20,0x0d,0x0e,0x4f,0x10,0x51, 0x52,0x13,0x54,0x7f,0x7f,0x7f,0x7f,0x7f,\r
345 0x7f,0x64,0x25,0x26,0x67,0x68,0x29,0x2a, 0x6b,0x2c,0x58,0x19,0x1a,0x5b,0x1c,0x5d,\r
346 0x5e,0x1f,0x20,0x0d,0x0e,0x4f,0x10,0x51, 0x52,0x13,0x54,0x7f,0x7f,0x7f,0x7f,0x7f\r
347};\r
348\r
349#include "../ibm1130_conout.h" /* conout_to_ascii_table */\r
350#include "../ibm1130_prtwheel.h" /* 1132 printer printwheel data */\r
351\r
352// ---------------------------------------------------------------------------------\r
353// PROTOTYPES\r
354// ---------------------------------------------------------------------------------\r
355\r
356void init (int argc, char **argv);\r
357void bail (char *msg);\r
358void flag (char *arg);\r
359void proc (char *fname);\r
360void startpass (int n);\r
361void errprintf (char *fmt, ...);\r
362void asm_error (char *fmt, ...);\r
363void asm_warning (char *fmt, ...);\r
364char *astring (char *str);\r
365PSYMBOL lookup_symbol (char *name, BOOL define);\r
366void add_xref (PSYMBOL s, BOOL definition);\r
367int get_symbol (char *name);\r
368void set_symbol (char *name, int value, int known, RELOC relative);\r
369char * gtok (char **pc, char *tok);\r
370char *skipbl (char *c);\r
371void sym_list (void);\r
372void xref_list (void);\r
373void listhdr (void);\r
374int getexpr (char *pc, BOOL undefined_ok, EXPR *expr);\r
375void passreport (void);\r
376void listout (BOOL reset);\r
377void output_literals (BOOL eof);\r
378char *upcase (char *str);\r
379void prep_line (char *line);\r
380int ascii_to_hollerith (int ch);\r
381char *detab (char *str);\r
382void preload_symbols (void);\r
383void save_symbols (void);\r
384void bincard_init (void);\r
385void bincard_writecard (char *sbrk_text);\r
386void bincard_writedata (void);\r
387void bincard_flush (void);\r
388void bincard_sbrk (char *line);\r
389void bincard_setorg (int neworg);\r
390void bincard_writew (int word, RELOC relative);\r
391void bincard_endcard (void);\r
392void handle_sbrk (char *line);\r
393void bincard_typecard (void);\r
394void namecode (unsigned short *words, char *tok);\r
395int signextend (int v);\r
396\r
397// ---------------------------------------------------------------------------------\r
398// main routine\r
399// ---------------------------------------------------------------------------------\r
400\r
401int main (int argc, char **argv)\r
402{\r
403 int i, sawfile = FALSE;\r
404\r
405 init(argc, argv); // initialize, process flags\r
406\r
407 startpass(1); // first pass, process files \r
408\r
409 for (i = 1; i < argc; i++)\r
410 if (*argv[i] != '-')\r
411 proc(argv[i]), sawfile = TRUE;\r
412\r
413 if (! sawfile) // should have seen at least one file\r
414 bail(usestr);\r
415\r
416 if (passcount) {\r
417 passreport();\r
418 return 0;\r
419 }\r
420\r
421 startpass(2); // second pass, process files again\r
422\r
423 for (i = 1; i < argc; i++)\r
424 if (*argv[i] != '-')\r
425 proc(argv[i]);\r
426\r
427 if (outmode == OUTMODE_LOAD) {\r
428 if (pta >= 0) // write start address to the load file\r
429 fprintf(fout, "=%04x" ENDLINE, pta & 0xFFFF);\r
430 }\r
431 else \r
432 bincard_endcard();\r
433\r
434 if (flist) {\r
435 if (nerrors || nwarnings) { // summarize (or summarise)\r
436 if (nerrors == 0)\r
437 fprintf(flist, "There %s ", (nwarnings == 1) ? "was" : "were");\r
438 else\r
439 fprintf(flist, "\nThere %s %d error%s %s",\r
440 (nerrors == 1) ? "was" : "were", nerrors, (nerrors == 1) ? "" : "s", nwarnings ? "and " : "");\r
441\r
442 if (nwarnings > 0)\r
443 fprintf(flist, "%d warning%s ", nwarnings, (nwarnings == 1) ? "" : "s");\r
444\r
445 fprintf(flist, "in this assembly\n");\r
446 }\r
447 else\r
448 fprintf(flist, "\nThere were no errors in this assembly\n"); \r
449 }\r
450\r
451 if (flist) { // finish the listing\r
452 if (pta >= 0)\r
453 fprintf(flist, "\nProgram transfer address = %04x\n", pta);\r
454\r
455 if (do_xref)\r
456 xref_list();\r
457 else if (do_syms)\r
458 sym_list();\r
459 }\r
460\r
461 if (savetable)\r
462 save_symbols();\r
463\r
464 return 0; // all done\r
465}\r
466\r
467// ---------------------------------------------------------------------------------\r
468// init - initialize assembler, process command line flags\r
469// ---------------------------------------------------------------------------------\r
470\r
471void init (int argc, char **argv)\r
472{\r
473 int i;\r
474\r
475 enable_1800 = strstr(argv[0], "1800") != NULL; // if "1800" appears in the executable name, enable 1800 extensions\r
476\r
477 for (i = 1; i < argc; i++) // process command line switches\r
478 if (*argv[i] == '-')\r
479 flag(argv[i]+1);\r
480}\r
481\r
482// ---------------------------------------------------------------------------------\r
483// flag - process one command line switch\r
484// ---------------------------------------------------------------------------------\r
485\r
486void flag (char *arg)\r
487{\r
488 int major, minor;\r
489\r
490 while (*arg) {\r
491 switch (*arg++) {\r
492 case 'o': // output (load) file name\r
493 if (! *arg)\r
494 bail(usestr);\r
495 outfn = arg;\r
496 return;\r
497\r
498 case 'p':\r
499 passcount = TRUE;\r
500 break;\r
501\r
502 case 'v': // mumble while running\r
503 verbose = TRUE;\r
504 break;\r
505\r
506 case 'x': // print cross reference table\r
507 do_xref = TRUE;\r
508 break;\r
509 \r
510 case 's': // print symbol table\r
511 do_syms = TRUE;\r
512 break;\r
513\r
514 case 'l': // listing file name\r
515 listfn = (* arg) ? arg : NULL;\r
516 do_list = TRUE;\r
517 return;\r
518\r
519 case 'W':\r
520 saveprompt = FALSE;\r
521 // fall through\r
522 case 'w':\r
523 savetable = TRUE;\r
524 break;\r
525\r
526 case 'y':\r
527 preload = TRUE;\r
528 break;\r
529\r
530 case 'b':\r
531 outmode = OUTMODE_BINARY;\r
532 break;\r
533\r
534 case '8':\r
535 enable_1800 = TRUE;\r
536 break;\r
537\r
538 case 'r':\r
539 if (sscanf(arg, "%d.%d", &major, &minor) != 2)\r
540 bail(usestr);\r
541 sprintf(dmsversion, "V%01.1dM%02.2d", major, minor);\r
542 return;\r
543\r
544 default:\r
545 bail(usestr);\r
546 break;\r
547 }\r
548 }\r
549}\r
550\r
551// ---------------------------------------------------------------------------------\r
552// bail - print error message on stderr (only) and exit\r
553// ---------------------------------------------------------------------------------\r
554\r
555void bail (char *msg)\r
556{\r
557 fprintf(stderr, "%s\n", msg);\r
558 exit(1);\r
559}\r
560\r
561// ---------------------------------------------------------------------------------\r
562// errprintf - print error message to stderr\r
563// ---------------------------------------------------------------------------------\r
564\r
565void errprintf (char *fmt, ...)\r
566{\r
567 va_list args;\r
568\r
569 va_start(args, fmt); // get pointer to argument list\r
570\r
571 vfprintf(stderr, fmt, args); // write errors to terminal (stderr)\r
572\r
573 va_end(args);\r
574}\r
575\r
576// ---------------------------------------------------------------------------------\r
577// asm_error - report an error to listing file and to user's console\r
578// ---------------------------------------------------------------------------------\r
579\r
580void asm_error (char *fmt, ...)\r
581{\r
582 va_list args;\r
583\r
584 if (pass == 1) // only print on pass 2\r
585 return;\r
586\r
587 va_start(args, fmt); // get pointer to argument list\r
588\r
589 fprintf(stderr, "E: %s (%d): ", curfn, lno);\r
590 vfprintf(stderr, fmt, args); // write errors to terminal (stderr)\r
591 putc('\n', stderr);\r
592\r
593 if (flist != NULL && list_on) {\r
594 listout(FALSE);\r
595 line_error = TRUE;\r
596\r
597 fprintf(flist, "**** Error: ");\r
598 vfprintf(flist, fmt, args); // write errors to listing file\r
599 putc('\n', flist);\r
600 }\r
601\r
602 nerrors++;\r
603 va_end(args);\r
604}\r
605\r
606// ---------------------------------------------------------------------------------\r
607// asm_warning - same but warnings are not counted\r
608// ---------------------------------------------------------------------------------\r
609\r
610void asm_warning (char *fmt, ...)\r
611{\r
612 va_list args;\r
613\r
614 if (pass == 1) // only print on pass 2\r
615 return;\r
616\r
617 va_start(args, fmt); // get pointer to argument list\r
618\r
619 fprintf(stderr, "W: %s (%d): ", curfn, lno);\r
620 vfprintf(stderr, fmt, args); // write errors to terminal (stderr)\r
621 putc('\n', stderr);\r
622\r
623 if (flist != NULL && list_on) {\r
624 listout(FALSE);\r
625 line_error = TRUE;\r
626\r
627 fprintf(flist, "**** Warning: ");\r
628 vfprintf(flist, fmt, args); // write errors to listing file\r
629 putc('\n', flist);\r
630 }\r
631\r
632 nwarnings++;\r
633}\r
634\r
635// ---------------------------------------------------------------------------------\r
636// sym_list - print the symbol table\r
637// ---------------------------------------------------------------------------------\r
638\r
639void sym_list (void)\r
640{\r
641 PSYMBOL s;\r
642 int n = 5;\r
643\r
644 if (symbols == NULL || flist == NULL)\r
645 return;\r
646\r
647 fprintf(flist, "\n=== SYMBOL TABLE ==============================================================\n");\r
648\r
649 for (s = symbols, n = 0; s != NULL; s = s->next) {\r
650 if (n >= 5) {\r
651 putc('\n', flist);\r
652 n = 0;\r
653 }\r
654 else if (n > 0)\r
655 fprintf(flist, " ");\r
656\r
657 fprintf(flist, "%-6s ", s->name);\r
658 if (s->defined == S_DEFINED)\r
659 fprintf(flist, "%04x%s", s->value & 0xFFFF, s->relative ? "R" : " ");\r
660 else\r
661 fprintf(flist, "UUUU ");\r
662\r
663 n++;\r
664 }\r
665 fprintf(flist, "\n");\r
666}\r
667\r
668// ---------------------------------------------------------------------------------\r
669// passreport - report # of passes required for assembly on the 1130\r
670// ---------------------------------------------------------------------------------\r
671\r
672void passreport (void)\r
673{\r
674 PSYMBOL s;\r
675\r
676 for (s = symbols; s != NULL; s = s->next) {\r
677 if (s->defined == S_UNDEFINED || s->defined == S_PROVISIONAL) {\r
678 printf("There are undefined symbols. Cannot determine pass requirement.\n");\r
679 return;\r
680 }\r
681 }\r
682\r
683 if (hasforward)\r
684 printf("There are forward references. Two passes are required.\n");\r
685 else\r
686 printf("There are no forward references. Only one pass is required.\n");\r
687}\r
688\r
689// ---------------------------------------------------------------------------------\r
690// xref_list - print the cross-reference table\r
691// ---------------------------------------------------------------------------------\r
692\r
693void xref_list (void)\r
694{\r
695 int n = 0;\r
696 PXREF x;\r
697 PSYMBOL s;\r
698\r
699 if (flist == NULL || symbols == NULL)\r
700 return;\r
701\r
702 fprintf(flist, "\n=== CROSS REFERENCES ==========================================================\n");\r
703\r
704 if (symbols == NULL || flist == NULL)\r
705 return;\r
706\r
707 fprintf(flist, "Name Val Defd Referenced\n");\r
708\r
709 for (s = symbols; s != NULL; s = s->next) {\r
710 fprintf(flist, "%-5s %04x%s", s->name, s->value & 0xFFFF, s->relative ? "R" : " ");\r
711\r
712 for (x = s->xrefs; x != NULL; x = x->next)\r
713 if (x->definition)\r
714 break;\r
715\r
716 if (x == NULL)\r
717 fprintf(flist, "----");\r
718 else\r
719 fprintf(flist, " %4d", x->lno);\r
720\r
721 for (n = 0, x = s->xrefs; x != NULL; x = x->next) {\r
722 if (x->definition)\r
723 continue;\r
724\r
725 if (n >= 12) {\r
726 n = 0;\r
727 fprintf(flist, "\n ");\r
728 }\r
729 fprintf(flist, " %4d", x->lno);\r
730 n++;\r
731 } \r
732 putc('\n', flist);\r
733 }\r
734}\r
735\r
736// ---------------------------------------------------------------------------------\r
737// listhdr - print a banner header in the listing file. Since it's not paginated\r
738// at this time, this is not used often.\r
739// ---------------------------------------------------------------------------------\r
740\r
741void listhdr (void)\r
742{\r
743 time_t t;\r
744 \r
745 time(&t);\r
746 fprintf(flist, "%s -- %s -- %s\n", VERSION, dmsversion, ctime(&t));\r
747}\r
748\r
749// ---------------------------------------------------------------------------------\r
750// astring - allocate a copy of a string\r
751// ---------------------------------------------------------------------------------\r
752\r
753char *astring (char *str)\r
754{\r
755 static char *s = NULL;\r
756\r
757 if (s != NULL)\r
758 if (strcmp(s, str) == 0) // if same as immediately previous allocation\r
759 return s; // return same pointer (why did I do this?)\r
760\r
761 if ((s = malloc(strlen(str)+1)) == NULL)\r
762 bail("out of memory");\r
763\r
764 strcpy(s, str);\r
765 return s;\r
766}\r
767\r
768// ---------------------------------------------------------------------------------\r
769// lookup_symbol - get pointer to a symbol.\r
770// If define is TRUE, creates and marks 'undefined' if not previously defined.\r
771// ---------------------------------------------------------------------------------\r
772\r
773PSYMBOL lookup_symbol (char *name, BOOL define)\r
774{\r
775 PSYMBOL s, n, prv = NULL;\r
776 int c;\r
777 char *at;\r
778\r
779 if (strlen(name) > 5) { // (sigh)\r
780 asm_error("Symbol '%s' is longer than 5 letters", name);\r
781 name[5] = '\0';\r
782 }\r
783\r
784#ifdef FIX_ATS\r
785 while ((at = strchr(name, '@')) != NULL)\r
786 *at = '\'';\r
787#endif\r
788 // search sorted list of symbols\r
789 for (s = symbols; s != NULL; prv = s, s = s->next) {\r
790 c = strcmpi(s->name, name);\r
791 if (c == 0)\r
792 return s;\r
793 if (c > 0)\r
794 break;\r
795 }\r
796\r
797 if (! define)\r
798 return NULL; // not found\r
799\r
800 if ((n = malloc(sizeof(SYMBOL))) == NULL)\r
801 bail("out of memory");\r
802\r
803 n->name = astring(name); // symbol was undefined -- add it now\r
804 n->value = 0;\r
805 n->defined = FALSE;\r
806 n->xrefs = NULL;\r
807 n->defined = FALSE;\r
808\r
809 n->next = s; // link in alpha order\r
810\r
811 if (prv == NULL) // we stopped before first item in list\r
812 symbols = n;\r
813 else\r
814 prv->next = n; // insert after item before place we stopped\r
815\r
816 return n;\r
817}\r
818\r
819// ---------------------------------------------------------------------------------\r
820// add_xref - add a cross reference entry to a symbol\r
821// ---------------------------------------------------------------------------------\r
822\r
823void add_xref (PSYMBOL s, BOOL definition)\r
824{\r
825 PXREF x, prv = NULL, n;\r
826\r
827 if (pass == 1 || ! do_xref) // define only during 2nd pass and only if listing was requested\r
828 return;\r
829\r
830 for (x = s->xrefs; x != NULL; prv = x, x = x->next)\r
831 if (strcmpi(x->fname, curfn) == 0 && x->lno == lno)\r
832 return; // ignore multiple refs on same line\r
833\r
834 if ((n = malloc(sizeof(XREF))) == NULL)\r
835 bail("out of memory");\r
836\r
837 n->fname = astring(curfn);\r
838 n->lno = lno;\r
839 n->definition = definition;\r
840\r
841 n->next = x; // link at end of existing list\r
842\r
843 if (prv == NULL)\r
844 s->xrefs = n;\r
845 else\r
846 prv->next = n;\r
847}\r
848\r
849// ---------------------------------------------------------------------------------\r
850// get_symbol - get a symbol value, defining if necessary\r
851// ---------------------------------------------------------------------------------\r
852\r
853int get_symbol (char *name) \r
854{\r
855 PSYMBOL s;\r
856\r
857 s = lookup_symbol(name, TRUE); // lookup, define if necessary\r
858 \r
859 if (pass == 2) // should be defined by now\r
860 if (! s->defined)\r
861 asm_error("Symbol '%s' is undefined", name);\r
862\r
863 add_xref(s, FALSE); // note the reference\r
864\r
865 return s->value; \r
866}\r
867\r
868// ---------------------------------------------------------------------------------\r
869// set_symbol - set a symbol value. Known = TRUE means we really know the value;\r
870// FALSE means we're calculating it with forward referenced values or something like\r
871// that.\r
872// ---------------------------------------------------------------------------------\r
873\r
874void set_symbol (char *name, int value, int known, RELOC relative) \r
875{\r
876 PSYMBOL s;\r
877 char *at;\r
878\r
879 if (strlen(name) > 5) {\r
880 asm_error("Symbol '%s' is longer than 5 letters", name);\r
881 name[5] = '\0';\r
882 }\r
883\r
884#ifdef FIX_ATS\r
885 while ((at = strchr(name, '@')) != NULL)\r
886 *at = '\'';\r
887#endif\r
888\r
889 s = lookup_symbol(name, TRUE);\r
890 \r
891 if (s->defined == S_DEFINED) // once defined, it should not change\r
892 if (s->value != value)\r
893 asm_error("Symbol '%s' %s", name, (s->pass == pass) ? "is multiply defined" : "changed between passes");\r
894\r
895 s->value = value;\r
896 s->relative = relative;\r
897 s->defined = known ? S_DEFINED : S_PROVISIONAL;\r
898 s->pass = pass;\r
899\r
900 if (! known)\r
901 hasforward = TRUE;\r
902\r
903 add_xref(s, TRUE); // record the place of definition\r
904}\r
905\r
906// ---------------------------------------------------------------------------------\r
907// skipbl - return pointer to first nonblank character in string s\r
908// ---------------------------------------------------------------------------------\r
909\r
910char *skipbl (char *s)\r
911{\r
912 while (*s && *s <= ' ')\r
913 s++;\r
914\r
915 return s;\r
916}\r
917\r
918// ---------------------------------------------------------------------------------\r
919// gtok - extracts a whitespace-delimited token from the string pointed to by *pc;\r
920// stores the token into the buffer tok and returns pointer to same. Returns NULL\r
921// when there are no tokens. Best to call repeatedly with a pointer to the source\r
922// buffer, e.g.\r
923// char *pbuf = buf;\r
924// while (gtok(&pbuf, token) != NULL) ...\r
925// ---------------------------------------------------------------------------------\r
926\r
927char * gtok (char **pc, char *tok)\r
928{\r
929 char *s = *pc, *otok = tok;\r
930\r
931 while (*s && *s <= ' ') // skip blanks\r
932 s++;\r
933\r
934 if (! *s) { // no tokens to be found\r
935 *tok = '\0';\r
936 *pc = s;\r
937 return NULL;\r
938 }\r
939\r
940 while (*s > ' ') // save nonblanks into 'tok'\r
941 *tok++ = *s++;\r
942\r
943 *tok = '\0'; // terminate\r
944 *pc = s; // adjust caller's pointer\r
945\r
946 return otok; // return pointer to token\r
947}\r
948\r
949// listing format:\r
950//\r
951// ADDR CODE SOURCE\r
952// 0000 0000 0000 0000 0000 | XXXXXXXXXXXXXXXXX\r
953\r
954// ---------------------------------------------------------------------------------\r
955// trim - remove trailing whitespace from string s\r
956// ---------------------------------------------------------------------------------\r
957\r
958char *trim (char *s)\r
959{\r
960 char *os = s, *nb;\r
961\r
962 for (nb = s-1; *s; s++)\r
963 if (*s > ' ')\r
964 nb = s;\r
965\r
966 nb[1] = '\0';\r
967 return os;\r
968}\r
969\r
970// ---------------------------------------------------------------------------------\r
971// listout - emit current constructed output listing line held in "listline" and\r
972// if "reset" is true, prepare listline for second and subsequent listing lines\r
973// for a given input statement.\r
974// ---------------------------------------------------------------------------------\r
975\r
976void listout (BOOL reset)\r
977{\r
978 if (flist && list_on && ! line_error) {\r
979 trim(listline);\r
980 fputs(listline, flist);\r
981 putc('\n', flist);\r
982 if (reset)\r
983 sprintf(listline, LEFT_MARGIN, org);\r
984 }\r
985}\r
986\r
987// ---------------------------------------------------------------------------------\r
988// storew - store a word in the output medium (hex or binary file). Most of the time\r
989// writew is used. Advances the origin!\r
990// ---------------------------------------------------------------------------------\r
991\r
992void storew (int word, RELOC relative)\r
993{\r
994 if (pass == 2) { // save in output (load) file.\r
995 switch (outmode) {\r
996 case OUTMODE_BINARY:\r
997 bincard_writew(word, relative);\r
998 break;\r
999\r
1000 case OUTMODE_LOAD:\r
1001 fprintf(fout, " %04x%s" ENDLINE, word & 0xFFFF,\r
1002 (relative == ABSOLUTE) ? "" : (relative == RELATIVE) ? "R" :\r
1003 (relative == LIBF) ? "L" : (relative == CALL) ? "$" : "?");\r
1004 break;\r
1005\r
1006 default:\r
1007 bail("in storew, can't happen");\r
1008 }\r
1009 }\r
1010\r
1011 if (relative != LIBF)\r
1012 org++;\r
1013\r
1014 assembled = TRUE; // remember that we wrote something\r
1015}\r
1016\r
1017// ---------------------------------------------------------------------------------\r
1018// setw - store a word value in the current listing output line in position 'pos'.\r
1019// ---------------------------------------------------------------------------------\r
1020\r
1021void setw (int pos, int word, RELOC relative)\r
1022{\r
1023 char tok[10], *p;\r
1024 int i;\r
1025 \r
1026 if (flist == NULL || ! list_on)\r
1027 return;\r
1028\r
1029 sprintf(tok, "%04x", word & 0xFFFF);\r
1030\r
1031 for (i = 0, p = listline + 5*pos; i < 4; i++)\r
1032 p[i] = tok[i];\r
1033\r
1034 if (relative == RELATIVE)\r
1035 p[i] = 'R';\r
1036 else if (relative != ABSOLUTE)\r
1037 p[i] = '*';\r
1038}\r
1039\r
1040// ---------------------------------------------------------------------------------\r
1041// writew - emit an assembled word value. Words are also displayed in the listing file.\r
1042// if relative is true, a relocation entry should be recorded.\r
1043// ---------------------------------------------------------------------------------\r
1044\r
1045void writew (int word, RELOC relative)\r
1046{ // first, the listing stuff...\r
1047 if (nwout == 0) { // on first output word, display address in column 0\r
1048 setw(0, org, FALSE);\r
1049 }\r
1050 else if (nwout >= 4) { // if 4 words have already been written, start new line\r
1051 listout(TRUE);\r
1052 nwout = 0;\r
1053 }\r
1054\r
1055 nwout++;\r
1056 setw(nwout, word, relative); // display word in the listing line\r
1057\r
1058 storew(word, relative); // write it to the output medium\r
1059}\r
1060\r
1061// ---------------------------------------------------------------------------------\r
1062// setorg - take note of new load address\r
1063// ---------------------------------------------------------------------------------\r
1064\r
1065void setorg (int neworg)\r
1066{\r
1067 if (pass == 2) {\r
1068 setw(0, neworg, FALSE); // display in listing file in column 0\r
1069\r
1070 if (outmode == OUTMODE_LOAD) { // write new load address to the output file\r
1071 fprintf(fout, "@%04x%s" ENDLINE, neworg & 0xFFFF, relocate ? "R" : "");\r
1072 }\r
1073 else {\r
1074 bincard_setorg(neworg);\r
1075 }\r
1076 }\r
1077\r
1078 org = neworg;\r
1079}\r
1080\r
1081// ---------------------------------------------------------------------------------\r
1082// org_even - force load address to an even address\r
1083// ---------------------------------------------------------------------------------\r
1084\r
1085void org_even (void)\r
1086{\r
1087 if (org & 1)\r
1088 setorg(org+1);\r
1089}\r
1090\r
1091// ---------------------------------------------------------------------------------\r
1092// tabtok - get the token in tab-delimited column number i, from source string c,\r
1093// saving in string 'tok'. If save is nonnull, we copy the entire remainder of\r
1094// the input string in buffer 'save' (in contrast to 'tok' which gets only the\r
1095// first whitespace delimited token).\r
1096// ---------------------------------------------------------------------------------\r
1097\r
1098void tabtok (char *c, char *tok, int i, char *save)\r
1099{\r
1100 *tok = '\0';\r
1101\r
1102 while (--i >= 0) { // skip to i'th tab-delimited field\r
1103 if ((c = strchr(c, '\t')) == NULL) {\r
1104 if (save) // was none\r
1105 *save = '\0';\r
1106 return;\r
1107 }\r
1108 c++;\r
1109 }\r
1110\r
1111 while (*c == ' ') // skip leading blanks\r
1112 c++;\r
1113\r
1114 if (save != NULL) // save copy of entire remainder\r
1115 strcpy(save, c);\r
1116\r
1117 while (*c > ' ') { // take up to any whitespace\r
1118 if (*c == '(') { // if we start with a paren, take all up to closing paren including spaces\r
1119 while (*c && *c != ')')\r
1120 *tok++ = *c++;\r
1121 }\r
1122 else if (*c == '.') { // period means literal character following\r
1123 *tok++ = *c++;\r
1124 if (*c)\r
1125 *tok++ = *c++;\r
1126 }\r
1127 else\r
1128 *tok++ = *c++;\r
1129 }\r
1130\r
1131 *tok = '\0';\r
1132}\r
1133\r
1134// ---------------------------------------------------------------------------------\r
1135// coltok - extract a token from string c, saving to buffer tok, by examining\r
1136// columns ifrom through ito only. If save is nonnull, the entire remainder\r
1137// of the input from ifrom to the end is saved there. In this routine\r
1138// if condense is true, we save all nonwhite characters in the column range;\r
1139// not the usual thing. This helps us coalesce the format, tag, & index things\r
1140// nto one string for the simple minded parser. If condense is FALSE, we terminate\r
1141// on the first nonblank, except that if we start with a (, we take up to ) and\r
1142// then terminate on a space.\r
1143//\r
1144// ifrom and ito on entry are column numbers, not indices; we change that right away\r
1145// ---------------------------------------------------------------------------------\r
1146\r
1147void coltok (char *c, char *tok, int ifrom, int ito, BOOL condense, char *save)\r
1148{\r
1149 char *otok = tok;\r
1150 int i;\r
1151\r
1152 ifrom--;\r
1153 ito--;\r
1154\r
1155 for (i = 0; i < ifrom; i++) {\r
1156 if (c[i] == '\0') { // line ended before this column\r
1157 *tok = '\0';\r
1158 if (save)\r
1159 *save = '\0';\r
1160 return;\r
1161 }\r
1162 }\r
1163\r
1164 if (save) // save from ifrom on\r
1165 strcpy(save, c+i);\r
1166\r
1167 if (condense) {\r
1168 for (; i <= ito; i++) { // save only nonwhite characters\r
1169 if (c[i] > ' ')\r
1170 *tok++ = c[i];\r
1171 }\r
1172 }\r
1173 else {\r
1174 if (c[i] == ' ' && save != NULL)// if it starts with a space, it's empty\r
1175 *save = '\0';\r
1176\r
1177 while (i <= ito) { // take up to any whitespace\r
1178 if (c[i] <= ' ')\r
1179 break;\r
1180 else if (c[i] == '(') { // starts with paren? take to close paren\r
1181 while (i <= ito && c[i]) {\r
1182 if ((*tok++ = c[i++]) == ')')\r
1183 break;\r
1184 }\r
1185 }\r
1186 else if (c[i] == '.') { // period means literal character following\r
1187 *tok++ = c[i++];\r
1188 if (i <= ito && c[i])\r
1189 *tok++ = c[i++];\r
1190 }\r
1191 else\r
1192 *tok++ = c[i++];\r
1193 }\r
1194 }\r
1195\r
1196 *tok = '\0';\r
1197 trim(otok);\r
1198}\r
1199\r
1200// ---------------------------------------------------------------------------------\r
1201// opcode table\r
1202// ---------------------------------------------------------------------------------\r
1203\r
1204// modifiers for the opcode definition table:\r
1205\r
1206#define L "L" // long\r
1207#define X "X" // absolute displacement\r
1208#define I "I" // indirect\r
1209#define IDX "0123" // indexed (some LDX commands in the DMS source say LDX L0, so accept 0\r
1210#define E "E" // even address\r
1211#define NONE ""\r
1212#define ALL L X I IDX // hope non-Microsoft C accepts and concatenates strings like this\r
1213#define ANY "\xFF"\r
1214#define NUMS "0123456789"\r
1215\r
1216#define IS_DBL 0x0001 // double word operand implies even address\r
1217#define IS_ABS 0x0002 // always uses absolute addressing mode (implied X)\r
1218#define NO_IDX 0x0004 // even with 1 or 2 modifier, this is not really indexed (for STX/LDX)\r
1219#define NO_ARGS 0x0008 // statement takes no arguments\r
1220#define IS_1800 0x0010 // 1800-only directive or instruction, flagged if 1800 mode is not enabled\r
1221#define TRAP 0x1000 // debug this instruction\r
1222\r
1223struct tag_op { // OPCODE TABLE\r
1224 char *mnem;\r
1225 int opcode;\r
1226 void (*handler)(struct tag_op *op, char *label, char *mods, char *arg);\r
1227 char *mods_allowed;\r
1228 char *mods_implied;\r
1229 int flags;\r
1230};\r
1231 // special opcode handlers\r
1232void std_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1233void b_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1234void bsc_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1235void bsi_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1236void mdx_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1237void shf_op (struct tag_op *op, char *label, char *mods, char *arg);\r
1238\r
1239void x_aif (struct tag_op *op, char *label, char *mods, char *arg);\r
1240void x_aifb (struct tag_op *op, char *label, char *mods, char *arg);\r
1241void x_ago (struct tag_op *op, char *label, char *mods, char *arg);\r
1242void x_agob (struct tag_op *op, char *label, char *mods, char *arg);\r
1243void x_anop (struct tag_op *op, char *label, char *mods, char *arg);\r
1244void x_abs (struct tag_op *op, char *label, char *mods, char *arg);\r
1245void x_call (struct tag_op *op, char *label, char *mods, char *arg);\r
1246void x_dsa (struct tag_op *op, char *label, char *mods, char *arg);\r
1247void x_file (struct tag_op *op, char *label, char *mods, char *arg);\r
1248void x_link (struct tag_op *op, char *label, char *mods, char *arg);\r
1249void x_libf (struct tag_op *op, char *label, char *mods, char *arg);\r
1250void x_org (struct tag_op *op, char *label, char *mods, char *arg);\r
1251void x_opt (struct tag_op *op, char *label, char *mods, char *arg);\r
1252void x_ces (struct tag_op *op, char *label, char *mods, char *arg);\r
1253void x_bes (struct tag_op *op, char *label, char *mods, char *arg);\r
1254void x_bss (struct tag_op *op, char *label, char *mods, char *arg);\r
1255void x_dc (struct tag_op *op, char *label, char *mods, char *arg);\r
1256void x_dec (struct tag_op *op, char *label, char *mods, char *arg);\r
1257void x_decs (struct tag_op *op, char *label, char *mods, char *arg);\r
1258void x_ebc (struct tag_op *op, char *label, char *mods, char *arg);\r
1259void x_end (struct tag_op *op, char *label, char *mods, char *arg);\r
1260void x_ent (struct tag_op *op, char *label, char *mods, char *arg);\r
1261void x_epr (struct tag_op *op, char *label, char *mods, char *arg);\r
1262void x_equ (struct tag_op *op, char *label, char *mods, char *arg);\r
1263void x_exit (struct tag_op *op, char *label, char *mods, char *arg);\r
1264void x_ils (struct tag_op *op, char *label, char *mods, char *arg);\r
1265void x_iss (struct tag_op *op, char *label, char *mods, char *arg);\r
1266void x_libr (struct tag_op *op, char *label, char *mods, char *arg);\r
1267void x_lorg (struct tag_op *op, char *label, char *mods, char *arg);\r
1268void x_dmes (struct tag_op *op, char *label, char *mods, char *arg);\r
1269void x_dn (struct tag_op *op, char *label, char *mods, char *arg);\r
1270void x_dump (struct tag_op *op, char *label, char *mods, char *arg);\r
1271void x_pdmp (struct tag_op *op, char *label, char *mods, char *arg);\r
1272void x_hdng (struct tag_op *op, char *label, char *mods, char *arg);\r
1273void x_list (struct tag_op *op, char *label, char *mods, char *arg);\r
1274void x_spac (struct tag_op *op, char *label, char *mods, char *arg);\r
1275void x_spr (struct tag_op *op, char *label, char *mods, char *arg);\r
1276void x_ejct (struct tag_op *op, char *label, char *mods, char *arg);\r
1277void x_trap (struct tag_op *op, char *label, char *mods, char *arg);\r
1278void x_xflc (struct tag_op *op, char *label, char *mods, char *arg);\r
1279\r
1280struct tag_op ops[] = {\r
1281 ".OPT", 0, x_opt, NONE, NONE, 0, // non-IBM extensions\r
1282 "TRAP", 0, x_trap, NONE, NONE, 0, // assembler breakpoint trap\r
1283 ".CES", 0, x_ces, NONE, NONE, 0, // lets us specify simulated console entry switch values for startup\r
1284\r
1285 "ABS", 0, x_abs, NONE, NONE, 0,\r
1286 "BES", 0, x_bes, E, NONE, 0, // standard pseudo-ops\r
1287 "BSS", 0, x_bss, E, NONE, 0,\r
1288 "DC", 0, x_dc, NONE, NONE, 0,\r
1289 "DEC", 0, x_dec, E, E, IS_DBL,\r
1290 "DECS", 0, x_decs, E, E, IS_DBL, // this is an IBM 1800 directive\r
1291 "DMES", 0, x_dmes, ANY, NONE, 0,\r
1292 "DN", 0, x_dn, NONE, NONE, 0,\r
1293 "DSA", 0, x_dsa, NONE, NONE, 0,\r
1294 "DUMP", 0, x_dump, NONE, NONE, 0,\r
1295 "EBC", 0, x_ebc, NONE, NONE, 0,\r
1296 "EJCT", 0, x_ejct, NONE, NONE, 0,\r
1297 "END", 0, x_end, NONE, NONE, 0,\r
1298 "ENT", 0, x_ent, NONE, NONE, 0,\r
1299 "EPR", 0, x_epr, NONE, NONE, 0,\r
1300 "EQU", 0, x_equ, NONE, NONE, 0,\r
1301 "EXIT", 0, x_exit, NONE, NONE, 0, // alias for call $exit since we don't have macros yet\r
1302 "FILE", 0, x_file, NONE, NONE, 0,\r
1303 "HDNG", 0, x_hdng, ANY, NONE, 0,\r
1304 "ILS", 0, x_ils, NUMS, NONE, 0,\r
1305 "ISS", 0, x_iss, NUMS, NONE, 0,\r
1306 "LIBF", 0, x_libf, NONE, NONE, 0,\r
1307 "LIBR", 0, x_libr, NONE, NONE, 0,\r
1308 "LINK", 0, x_link, NONE, NONE, 0,\r
1309 "LIST", 0, x_list, NONE, NONE, 0,\r
1310 "LORG", 0, x_lorg, NONE, NONE, 0,\r
1311 "ORG", 0, x_org, NONE, NONE, 0,\r
1312 "PDMP", 0, x_pdmp, NONE, NONE, 0,\r
1313 "SPAC", 0, x_spac, NONE, NONE, 0,\r
1314 "SPR", 0, x_spr, NONE, NONE, 0,\r
1315 "XFLC", 0, x_xflc, NONE, NONE, 0,\r
1316\r
1317 "A", 0x8000, std_op, ALL, NONE, 0, // standard addressing ops\r
1318 "AD", 0x8800, std_op, ALL, NONE, IS_DBL,\r
1319 "AND", 0xE000, std_op, ALL, NONE, 0,\r
1320 "BSI", 0x4000, bsi_op, ALL, NONE, 0,\r
1321 "CALL", 0x4000, x_call, ALL, L, 0, // alias for BSI L, or external call\r
1322 "CMP", 0xB000, std_op, ALL, NONE, IS_1800, // this is an IBM 1800-only instruction\r
1323 "DCM", 0xB800, std_op, ALL, NONE, IS_1800, // this is an IBM 1800-only instruction\r
1324 "D" , 0xA800, std_op, ALL, NONE, 0,\r
1325 "EOR", 0xF000, std_op, ALL, NONE, 0,\r
1326 "LD", 0xC000, std_op, ALL, NONE, 0,\r
1327 "LDD", 0xC800, std_op, ALL, NONE, IS_DBL,\r
1328 "LDS", 0x2000, std_op, NONE, NONE, IS_ABS,\r
1329 "LDX", 0x6000, std_op, ALL, NONE, IS_ABS|NO_IDX,\r
1330 "M", 0xA000, std_op, ALL, NONE, 0,\r
1331 "MDX", 0x7000, mdx_op, ALL, NONE, 0,\r
1332 "MDM", 0x7000, mdx_op, L, L, 0, // like MDX L\r
1333 "NOP", 0x1000, std_op, NONE, NONE, NO_ARGS,\r
1334 "OR", 0xE800, std_op, ALL, NONE, 0,\r
1335 "S", 0x9000, std_op, ALL, NONE, 0,\r
1336 "SD", 0x9800, std_op, ALL, NONE, IS_DBL,\r
1337 "STD", 0xD800, std_op, ALL, NONE, IS_DBL,\r
1338 "STO", 0xD000, std_op, ALL, NONE, 0,\r
1339 "STS", 0x2800, std_op, ALL, NONE, 0,\r
1340 "STX", 0x6800, std_op, ALL, NONE, NO_IDX,\r
1341 "WAIT", 0x3000, std_op, NONE, NONE, IS_ABS,\r
1342 "XCH", 0x18D0, std_op, NONE, NONE, 0, // same as RTE 16, 18C0 + 10\r
1343 "XIO", 0x0800, std_op, ALL, NONE, IS_DBL,\r
1344\r
1345 "BSC", 0x4800, bsc_op, ALL, NONE, 0, // branch family\r
1346 "BOSC", 0x4840, bsc_op, ALL, NONE, 0, // is BOSC always long form? No.\r
1347 "SKP", 0x4800, bsc_op, NONE, NONE, 0, // alias for BSC one word version\r
1348\r
1349 "B", 0x4800, b_op, ALL, NONE, 0, // alias for MDX or BSC L \r
1350 "BC", 0x4802, std_op, ALL, L, 0, // alias for BSC L \r
1351 "BN", 0x4828, std_op, ALL, L, 0, // alias for BSC L \r
1352 "BNN", 0x4810, std_op, ALL, L, 0, // alias for BSC L \r
1353 "BNP", 0x4808, std_op, ALL, L, 0, // alias for BSC L \r
1354 "BNZ", 0x4820, std_op, ALL, L, 0, // alias for BSC L \r
1355 "BO", 0x4801, std_op, ALL, L, 0, // alias for BSC L \r
1356 "BOD", 0x4840, std_op, ALL, L, 0, // alias for BSC L \r
1357 "BP", 0x4830, std_op, ALL, L, 0, // alias for BSC L \r
1358 "BZ", 0x4818, std_op, ALL, L, 0, // alias for BSC L \r
1359\r
1360 "RTE", 0x18C0, shf_op, IDX X, X, 0, // shift family\r
1361 "SLA", 0x1000, shf_op, IDX X, X, 0,\r
1362 "SLC", 0x10C0, shf_op, IDX X, X, 0,\r
1363 "SLCA", 0x1040, shf_op, IDX X, X, 0,\r
1364 "SLT", 0x1080, shf_op, IDX X, X, 0,\r
1365 "SRA", 0x1800, shf_op, IDX X, X, 0,\r
1366 "SRT", 0x1880, shf_op, IDX X, X, 0,\r
1367\r
1368 "AIF", 0, x_aif, NONE, NONE, 0, // assemble if\r
1369 "AIFB", 0, x_aifb, NONE, NONE, 0, // assemble if\r
1370 "AGO", 0, x_ago, NONE, NONE, 0, // assemble goto\r
1371 "AGOB", 0, x_agob, NONE, NONE, 0, // assemble goto\r
1372 "ANOP", 0, x_anop, NONE, NONE, 0, // assemble target\r
1373\r
1374 NULL // end of table\r
1375};\r
1376\r
1377// ---------------------------------------------------------------------------------\r
1378// addextn - apply file extension 'extn' to filename 'fname' and put result in 'outbuf'\r
1379// if outbuf is NULL, we allocate a buffer\r
1380// ---------------------------------------------------------------------------------\r
1381\r
1382char *addextn (char *fname, char *extn, char *outbuf)\r
1383{\r
1384 char *buf, line[500], *c;\r
1385\r
1386 buf = (outbuf == NULL) ? line : outbuf;\r
1387\r
1388 strcpy(buf, fname); // create listfn from first source filename (e.g. xxx.lst);\r
1389 if ((c = strrchr(buf, '\\')) == NULL)\r
1390 if ((c = strrchr(buf, '/')) == NULL)\r
1391 if ((c = strrchr(buf, ':')) == NULL)\r
1392 c = buf;\r
1393\r
1394 if ((c = strrchr(c, '.')) == NULL)\r
1395 strcat(buf, extn);\r
1396 else\r
1397 strcpy(c, extn);\r
1398\r
1399 return (outbuf == NULL) ? astring(line) : outbuf;\r
1400}\r
1401\r
1402// ---------------------------------------------------------------------------------\r
1403// controlcard - examine an assembler control card (* in column 1)\r
1404// ---------------------------------------------------------------------------------\r
1405\r
1406BOOL controlcard (char *line)\r
1407{\r
1408 if (strnicmp(line, "*LIST", 5) == 0) { // turn on listing file even if not specified on command line\r
1409 do_list = list_on = TRUE;\r
1410 return TRUE;\r
1411 }\r
1412 \r
1413 if (strnicmp(line, "*XREF", 5) == 0) {\r
1414 do_xref = TRUE;\r
1415 return TRUE;\r
1416 }\r
1417\r
1418 if (strnicmp(line, "*PRINT SYMBOL TABLE", 19) == 0) {\r
1419 do_syms = TRUE;\r
1420 return TRUE;\r
1421 }\r
1422\r
1423 if (strnicmp(line, "*SAVE SYMBOL TABLE", 18) == 0) {\r
1424 savetable = TRUE;\r
1425 return TRUE;\r
1426 }\r
1427\r
1428 if (strnicmp(line, "*SYSTEM SYMBOL TABLE", 20) == 0) {\r
1429 preload = TRUE;\r
1430 preload_symbols();\r
1431 return TRUE;\r
1432 }\r
1433\r
1434 return FALSE;\r
1435}\r
1436\r
1437// ---------------------------------------------------------------------------------\r
1438// stuff - insert characters into a line\r
1439// ---------------------------------------------------------------------------------\r
1440\r
1441void stuff (char *buf, char *tok, int maxchars)\r
1442{\r
1443 while (*tok) {\r
1444 *buf++ = *tok++;\r
1445 \r
1446 if (maxchars)\r
1447 if (--maxchars <= 0)\r
1448 break; \r
1449 }\r
1450}\r
1451\r
1452// ---------------------------------------------------------------------------------\r
1453// format_line - construct a source code input line from components\r
1454// ---------------------------------------------------------------------------------\r
1455\r
1456void format_line (char *buf, char *label, char *op, char *mods, char *args, char *remarks)\r
1457{\r
1458 int i;\r
1459\r
1460 if (tabformat) {\r
1461 sprintf(buf, "%s\t%s\t%s\t%s\t%s", label, op, mods, args, remarks);\r
1462 }\r
1463 else {\r
1464 for (i = 0; i < 72; i++)\r
1465 buf[i] = ' ';\r
1466 buf[i] = '\0';\r
1467\r
1468 stuff(buf+20, label, 5);\r
1469 stuff(buf+26, op, 4);\r
1470 stuff(buf+31, mods, 2);\r
1471 stuff(buf+34, args, 72-34);\r
1472 }\r
1473}\r
1474\r
1475// ---------------------------------------------------------------------------------\r
1476// lookup_op - find an opcode\r
1477// ---------------------------------------------------------------------------------\r
1478\r
1479struct tag_op * lookup_op (char *mnem)\r
1480{\r
1481 struct tag_op *op;\r
1482 int i;\r
1483\r
1484 for (op = ops; op->mnem != NULL; op++) {\r
1485 if ((i = strcmp(op->mnem, mnem)) == 0)\r
1486 return op;\r
1487\r
1488 if (i > 0)\r
1489 break;\r
1490 }\r
1491 return NULL;\r
1492}\r
1493\r
1494// ---------------------------------------------------------------------------------\r
1495// bincard - routines to write IBM 1130 Card object format\r
1496// ---------------------------------------------------------------------------------\r
1497\r
1498unsigned short bincard[54]; // the 54 data words that can fit on a binary format card\r
1499char binflag[45]; // the relocation flags of the 45 buffered object words (0, 1, 2, 3)\r
1500int bincard_n = 0; // number of object words stored in bincard (0-45)\r
1501int bincard_seq = 0; // card output sequence number\r
1502int bincard_org = 0; // origin of current card-full\r
1503int bincard_maxaddr = 0;\r
1504BOOL bincard_first = TRUE; // TRUE when we're to write the program type card\r
1505\r
1506// bincard_init - prepare a new object data output card\r
1507\r
1508void bincard_init (void)\r
1509{\r
1510 memset(bincard, 0, sizeof(bincard)); // clear card data\r
1511 memset(binflag, 0, sizeof(binflag)); // clear relocation data\r
1512 bincard_n = 0; // no data\r
1513 bincard[0] = bincard_org; // store load address\r
1514 bincard_maxaddr = MAX(bincard_maxaddr, bincard_org-1); // save highest address written-to (this may be a BSS)\r
1515}\r
1516\r
1517// binard_writecard - emit a card. sbrk_text = NULL for normal data cards, points to comment text for sbrk card\r
1518// note: sbrk_text if not NULL MUST be a writeable buffer of at LEAST 71 characters\r
1519\r
1520void bincard_writecard (char *sbrk_text)\r
1521{\r
1522 unsigned short binout[80];\r
1523 char ident[12];\r
1524 int i, j;\r
1525\r
1526 if (sbrk_text != NULL) { // sbrk card has 4 binary words followed by comment text\r
1527 for (j = 66; j < 71; j++) // be sure input columns 67..71 are nonblank (have version number)\r
1528 if (sbrk_text[j] <= ' ')\r
1529 break;\r
1530 \r
1531 if (j < 71) // sbrk card didn't have the info, stuff in current release\r
1532 for (j = 0; j < 5; j++)\r
1533 sbrk_text[66+j] = dmsversion[j];\r
1534\r
1535 binout[0] = 0;\r
1536 binout[1] = 0;\r
1537 binout[2] = 0;\r
1538 binout[3] = 0x1000;\r
1539\r
1540 sbrk_text += 5; // start at the real column 6 (after *SBRK\r
1541 for (j = 5; j < 72; j++)\r
1542 binout[j] = (*sbrk_text) ? ascii_to_hollerith(*sbrk_text++) : 0;\r
1543\r
1544 }\r
1545 else { // binary card format packs 54 words into 72 columns\r
1546 for (i = j = 0; i < 54; i += 3, j += 4) {\r
1547 binout[j ] = ( bincard[i] & 0xFFF0);\r
1548 binout[j+1] = ((bincard[i] << 12) & 0xF000) | ((bincard[i+1] >> 4) & 0x0FF0);\r
1549 binout[j+2] = ((bincard[i+1] << 8) & 0xFF00) | ((bincard[i+2] >> 8) & 0x00F0);\r
1550 binout[j+3] = ((bincard[i+2] << 4) & 0xFFF0);\r
1551 }\r
1552 }\r
1553\r
1554 sprintf(ident, "%08ld", ++bincard_seq); // append sequence text\r
1555 memmove(ident, progname, MIN(strlen(progname), 4));\r
1556\r
1557 for (i = 0; i < 8; i++)\r
1558 binout[j++] = ascii_to_hollerith(ident[i]);\r
1559 \r
1560 fxwrite(binout, sizeof(binout[0]), 80, fout); // write card image\r
1561}\r
1562\r
1563// binard_writedata - emit an object data card\r
1564\r
1565void bincard_writedata (void)\r
1566{\r
1567 unsigned short rflag = 0;\r
1568 int i, j, nflag = 0;\r
1569\r
1570 bincard[1] = 0; // checksum\r
1571 bincard[2] = 0x0A00 | bincard_n; // data card type + word count\r
1572\r
1573 for (i = 0, j = 3; i < bincard_n; i++) { // construct relocation indicator bitmap\r
1574 if (nflag == 8) {\r
1575 bincard[j++] = rflag;\r
1576 rflag = 0;\r
1577 nflag = 0;\r
1578 }\r
1579 rflag = (rflag << 2) | (binflag[i] & 3);\r
1580 nflag++;\r
1581 }\r
1582\r
1583 if (nflag > 0)\r
1584 bincard[j] = rflag << (16 - 2*nflag);\r
1585\r
1586 bincard_writecard(FALSE); // emit the card\r
1587}\r
1588\r
1589// bincard_flush - flush any pending binary data\r
1590\r
1591void bincard_flush (void)\r
1592{\r
1593 if (bincard_n > 0)\r
1594 bincard_writedata();\r
1595\r
1596 bincard_init();\r
1597}\r
1598\r
1599// bincard_sbrk - emit an SBRK card\r
1600\r
1601void bincard_sbrk (char *line)\r
1602{\r
1603 if (bincard_first)\r
1604 bincard_typecard();\r
1605 else\r
1606 bincard_flush();\r
1607\r
1608 bincard_writecard(line);\r
1609}\r
1610\r
1611// bincard_setorg - set the origin\r
1612\r
1613void bincard_setorg (int neworg)\r
1614{\r
1615 bincard_org = neworg; // set origin for next card\r
1616 bincard_flush(); // flush any current data & store origin\r
1617}\r
1618\r
1619// bincard_endcard - write end of program card\r
1620\r
1621void bincard_endcard (void)\r
1622{\r
1623 bincard_flush();\r
1624\r
1625 bincard[0] = (bincard_maxaddr + 2) & ~1; // effective length: add 1 to max origin, then 1 more to round up\r
1626 bincard[1] = 0;\r
1627 bincard[2] = 0x0F00;\r
1628 bincard[3] = pta & 0xFFFF;\r
1629\r
1630 bincard_writecard(NULL);\r
1631}\r
1632\r
1633// bincard_typecard - write the program type \r
1634\r
1635void bincard_typecard (void)\r
1636{\r
1637 int i;\r
1638\r
1639 if (! bincard_first) \r
1640 return;\r
1641\r
1642 bincard_first = FALSE;\r
1643\r
1644 memset(bincard, 0, sizeof(bincard));\r
1645\r
1646 bincard[2] = (unsigned short) ((progtype << 8) | intmode | realmode);\r
1647\r
1648// all indices not listed are documented as 'reserved'\r
1649\r
1650 switch (progtype) {\r
1651 case PROGTYPE_ABSOLUTE:\r
1652 case PROGTYPE_RELOCATABLE:\r
1653// bincard[ 4] = 0; // length of common (fortran only)\r
1654 bincard[ 5] = 0x0003;\r
1655// bincard[ 6] = 0; // length of work area (fortran only)\r
1656 bincard[ 8] = ndefined_files;\r
1657 namecode(&bincard[9], progname);\r
1658 bincard[11] = (pta < 0) ? 0 : pta;\r
1659 break;\r
1660\r
1661 case PROGTYPE_LIBF:\r
1662 case PROGTYPE_CALL:\r
1663 bincard[ 5] = 3*nentries;\r
1664 for (i = 0; i < nentries; i++) {\r
1665 namecode(&bincard[9+3*i], entry[i]->name);\r
1666 bincard[11+3*i] = entry[i]->value;\r
1667 }\r
1668 break;\r
1669\r
1670 case PROGTYPE_ISSLIBF:\r
1671 case PROGTYPE_ISSCALL:\r
1672 bincard[ 5] = 6+nintlevels;\r
1673 namecode(&bincard[9], entry[0]->name);\r
1674 bincard[11] = entry[0]->value;\r
1675 bincard[12] = iss_number + ISTV; // magic number ISTV is 0x33 in DMS R2V12\r
1676 bincard[13] = iss_number;\r
1677 bincard[14] = nintlevels;\r
1678 bincard[15] = intlevel_primary;\r
1679 bincard[16] = intlevel_secondary;\r
1680 bincard[29] = 1;\r
1681 break;\r
1682\r
1683 case PROGTYPE_ILS:\r
1684 bincard[ 2] = (unsigned short) (progtype << 8);\r
1685 bincard[ 5] = 4;\r
1686 bincard[12] = intlevel_primary;\r
1687 break;\r
1688\r
1689 default:\r
1690 bail("in bincard_typecard, can't happen");\r
1691 }\r
1692\r
1693 bincard[1] = 0; // checksum\r
1694\r
1695 bincard_writecard(NULL);\r
1696\r
1697 bincard_init();\r
1698}\r
1699\r
1700// bincard_writew - write a word to the current output card.\r
1701\r
1702void bincard_writew (int word, RELOC relative)\r
1703{\r
1704 if (pass != 2)\r
1705 return;\r
1706\r
1707 if (bincard_first)\r
1708 bincard_typecard();\r
1709 else if (bincard_n >= 45) // flush full card buffer\r
1710 bincard_flush();\r
1711\r
1712 binflag[bincard_n] = relative & 3; // store relocation bits and data word\r
1713 bincard[9+bincard_n++] = word;\r
1714\r
1715 if (relative != LIBF) {\r
1716 bincard_maxaddr = MAX(bincard_maxaddr, bincard_org);\r
1717 bincard_org++;\r
1718 }\r
1719}\r
1720\r
1721// writetwo - notification that we are about to write two words which must stay together\r
1722\r
1723void writetwo (void)\r
1724{\r
1725 if (pass == 2 && outmode == OUTMODE_BINARY && bincard_n >= 44)\r
1726 bincard_flush();\r
1727}\r
1728\r
1729// handle_sbrk - handle an SBRK directive.\r
1730// This was not part of the 1130 assembler; they assembled DMS on a 360\r
1731\r
1732void handle_sbrk (char *line)\r
1733{\r
1734 char rline[90];\r
1735\r
1736 if (pass != 2)\r
1737 return;\r
1738\r
1739 strncpy(rline, line, 81); // get a copy and pad it if necessary to 80 characters\r
1740 rline[80] = '\0';\r
1741 while (strlen(rline) < 80)\r
1742 strcat(rline, " ");\r
1743\r
1744 switch (outmode) {\r
1745 case OUTMODE_LOAD:\r
1746 fprintf(fout, "#SBRK%s\n", trim(rline+5));\r
1747\r
1748 case OUTMODE_BINARY:\r
1749 bincard_sbrk(rline);\r
1750 break;\r
1751\r
1752 default:\r
1753 bail("in handle_sbrk, can't happen");\r
1754 }\r
1755}\r
1756\r
1757// ---------------------------------------------------------------------------------\r
1758// namecode - turn a string into a two-word packed name\r
1759// ---------------------------------------------------------------------------------\r
1760\r
1761void namecode (unsigned short *words, char *tok)\r
1762{\r
1763 long val = 0;\r
1764 int i, ch;\r
1765\r
1766 for (i = 0; i < 5; i++) { // pick up bits\r
1767 if (*tok)\r
1768 ch = *tok++;\r
1769 else\r
1770 ch = ' ';\r
1771\r
1772 val = (val << 6) | (ascii_to_ebcdic_table[ch] & 0x3F);\r
1773 }\r
1774\r
1775 words[0] = (unsigned short) (val >> 16);\r
1776 words[1] = (unsigned short) val;\r
1777}\r
1778\r
1779// ---------------------------------------------------------------------------------\r
1780// parse_line - parse one input line.\r
1781// ---------------------------------------------------------------------------------\r
1782\r
1783void parse_line (char *line)\r
1784{\r
1785 char label[100], mnem[100], arg[200], mods[20], *c;\r
1786 struct tag_op *op;\r
1787\r
1788 if (line[0] == '/' && line[1] == '/') // job control card? probably best to ignore it\r
1789 return;\r
1790\r
1791 if (line[0] == '*') { // control card comment or comment in tab-format file\r
1792 if (check_control) // pay attention to control cards only at top of file\r
1793 if (! controlcard(line))\r
1794 check_control = FALSE; // first non-control card shuts off sensitivity to them\r
1795\r
1796 if (strnicmp(line+1, "SBRK", 4) == 0)\r
1797 handle_sbrk(line);\r
1798\r
1799 return;\r
1800 }\r
1801\r
1802 check_control = FALSE; // non-control card, consider them no more\r
1803\r
1804 label[0] = '\0'; // prepare to extract fields\r
1805 mods[0] = '\0';\r
1806 mnem[0] = '\0';\r
1807 arg[0] = '\0';\r
1808\r
1809 if (tabformat || strchr(line, '\t') != NULL) { // if input line has tabs, parse loosely\r
1810 tabformat = TRUE; // this is a tab-formatted file\r
1811\r
1812 for (c = line; *c && *c <= ' '; c++) // find first nonblank\r
1813 ;\r
1814\r
1815 if (*c == '*' || ! *c) // ignore as a comment\r
1816 return;\r
1817\r
1818 tabtok(line, label, 0, NULL);\r
1819 tabtok(line, mnem, 1, NULL);\r
1820 tabtok(line, mods, 2, NULL);\r
1821 tabtok(line, arg, 3, opfield);\r
1822 }\r
1823 else { // if no tabs, use strict card-column format\r
1824 if (line[20] == '*') // comment\r
1825 return;\r
1826\r
1827 line[72] = '\0'; // clip off sequence\r
1828\r
1829 coltok(line, label, 21, 25, TRUE, NULL);\r
1830 coltok(line, mnem, 27, 30, TRUE, NULL);\r
1831 coltok(line, mods, 32, 33, TRUE, NULL);\r
1832 coltok(line, arg, 35, 72, FALSE, opfield);\r
1833 }\r
1834\r
1835// I don't know where I got this idea, but it's wrong...\r
1836// if (strchr(mods, '1') || strchr(mods, '2') || strchr(mods, '3')) { // index + X means ignore X\r
1837// if ((c = strchr(mods, 'X')) != NULL)\r
1838// strcpy(c, c+1); // remove the X\r
1839// }\r
1840\r
1841 if (*label) // display org in any line with a label\r
1842 setw(0, org, FALSE);\r
1843\r
1844 if (! *mnem) { // label w/o mnemonic, just define the symbol\r
1845 if (*label)\r
1846 set_symbol(label, org, TRUE, relocate);\r
1847 return;\r
1848 }\r
1849\r
1850 if ((op = lookup_op(mnem)) == NULL) { // look up mnemonic\r
1851 if (*label)\r
1852 set_symbol(label, org, TRUE, relocate);// at least define the label\r
1853\r
1854 asm_error("Unknown opcode '%s'", mnem);\r
1855 return;\r
1856 }\r
1857\r
1858 if (op->flags & TRAP) // assembler debugging breakpoint\r
1859 x_trap(op, label, mods, arg);\r
1860\r
1861 if (*op->mods_allowed != '\xFF') { // validate modifiers against list of allowed characters\r
1862 for (c = mods; *c; ) {\r
1863 if (strchr(op->mods_allowed, *c) == NULL) {\r
1864 asm_warning("Modifier '%c' not permitted", *c);\r
1865 strcpy(c, c+1); // remove it and keep parsing\r
1866 }\r
1867 else\r
1868 c++;\r
1869 }\r
1870 }\r
1871\r
1872 strcat(mods, op->mods_implied); // tack on implied modifiers\r
1873\r
1874 if (strchr(mods, 'I')) // indirect implies long\r
1875 strcat(mods, "L");\r
1876\r
1877 requires_even_address = op->flags & IS_DBL;\r
1878\r
1879 org_advanced = strchr(mods, 'L') ? 2 : 1; // by default, * means address + 1 or 2. Sometimes it doesn't\r
1880 (op->handler)(op, label, mods, arg);\r
1881\r
1882 if ((op->flags & IS_1800) && ! enable_1800)\r
1883 asm_warning("%s is IBM 1800-specific; use the -8 command line option", op->mnem);\r
1884}\r
1885\r
1886// ---------------------------------------------------------------------------------\r
1887// get one input line from current file or macro\r
1888// ---------------------------------------------------------------------------------\r
1889\r
1890BOOL get_line (char *buf, int nbuf, BOOL onelevel)\r
1891{\r
1892 char *retval;\r
1893\r
1894 if (ended) // we hit the END command\r
1895 return FALSE;\r
1896 \r
1897 // if macro active, return line from macro buffer, otherwise read from file\r
1898 // do not pop end-of-macro if onelevel is TRUE \r
1899\r
1900 if ((retval = fgets(buf, nbuf, fin)) == NULL)\r
1901 return FALSE;\r
1902\r
1903 lno++; // count the line\r
1904 return TRUE;\r
1905}\r
1906\r
1907// ---------------------------------------------------------------------------------\r
1908// proc - process one pass of one source file\r
1909// ---------------------------------------------------------------------------------\r
1910\r
1911void proc (char *fname)\r
1912{ \r
1913 char line[256], *c;\r
1914 int i;\r
1915\r
1916 if (strchr(fname, '.') == NULL) // if input file has no extension,\r
1917 addextn(fname, ".asm", curfn); // set appropriate file extension\r
1918 else\r
1919 strcpy(curfn, fname); // otherwise use extension specified\r
1920\r
1921// let's leave filename case alone even if it doesn't matter\r
1922//#if (defined(_WIN32) || defined(VMS))\r
1923// upcase(curfn); // only force uppercase of name on Windows and VMS\r
1924//#endif\r
1925\r
1926 if (progname[0] == '\0') { // pick up primary filename\r
1927 if ((c = strrchr(curfn, '\\')) == NULL)\r
1928 if ((c = strrchr(curfn, '/')) == NULL)\r
1929 if ((c = strrchr(curfn, ':')) == NULL)\r
1930 c = curfn;\r
1931\r
1932 strncpy(progname, c, sizeof(progname)); // take name after path\r
1933 progname[sizeof(progname)-1] = '\0';\r
1934 if ((c = strchr(progname, '.')) != NULL)// remove extension\r
1935 *c = '\0';\r
1936 }\r
1937\r
1938 lno = 0; // reset global input line number\r
1939 ended = FALSE; // have not seen END statement\r
1940\r
1941 if (listfn == NULL) // if list file name is undefined,\r
1942 listfn = addextn(fname, ".lst", NULL); // create from first filename\r
1943\r
1944 if (verbose)\r
1945 fprintf(stderr, "--- Starting file %s pass %d\n", curfn, pass);\r
1946\r
1947 if ((fin = fopen(curfn, "r")) == NULL) {\r
1948 perror(curfn); // oops\r
1949 exit(1);\r
1950 }\r
1951\r
1952 if (flist) { // put banner in listing file\r
1953 strcpy(listline,"=== FILE ======================================================================");\r
1954 for (i = 9, c = curfn; *c;)\r
1955 listline[i++] = *c++;\r
1956 listline[i] = ' ';\r
1957 fputs(listline, flist);\r
1958 putc('\n', flist);\r
1959 list_on = TRUE;\r
1960 }\r
1961 // read all lines till EOF or END statement\r
1962 while (get_line(line, sizeof(line), FALSE)) {\r
1963 prep_line(line); // preform standard line prep\r
1964 parse_line(line); // parse\r
1965 listout(FALSE); // complete the listing\r
1966 }\r
1967\r
1968 fclose(fin);\r
1969\r
1970 if (n_literals > 0) { // force out any pending literal constants at end of file\r
1971 output_literals(TRUE);\r
1972 listout(FALSE);\r
1973 }\r
1974}\r
1975\r
1976// ---------------------------------------------------------------------------------\r
1977// prep_line - prepare input line for parsing\r
1978// ---------------------------------------------------------------------------------\r
1979\r
1980void prep_line (char *line)\r
1981{\r
1982 char *c;\r
1983\r
1984 upcase(line); // uppercase it\r
1985 nwout = 0; // number of words output so far\r
1986 line_error = FALSE; // no errors on this line so far\r
1987\r
1988 for (c = line; *c; c++) { // truncate at newline\r
1989 if (*c == '\r' || *c == '\n') {\r
1990 *c = '\0';\r
1991 break;\r
1992 }\r
1993 }\r
1994\r
1995 if (flist && list_on) { // construct beginning of listing line\r
1996 if (tabformat)\r
1997 sprintf(listline, LINEFORMAT, lno, detab(line));\r
1998 else {\r
1999 if (strlen(line) > 20) // get the part where the commands start\r
2000 c = line+20;\r
2001 else\r
2002 c = "";\r
2003\r
2004 sprintf(listline, LINEFORMAT, lno, c);\r
2005 stuff(listline, line, 20); // stuff the left margin in to the left side\r
2006 }\r
2007 }\r
2008}\r
2009\r
2010// ---------------------------------------------------------------------------------\r
2011// opcmp - operand name comparison routine for qsort\r
2012// ---------------------------------------------------------------------------------\r
2013\r
2014int opcmp (const void *a, const void *b)\r
2015{\r
2016 return strcmp(((struct tag_op *) a)->mnem, ((struct tag_op *) b)->mnem);\r
2017}\r
2018\r
2019// ---------------------------------------------------------------------------------\r
2020// preload_symbols - load a saved symbol table\r
2021// ---------------------------------------------------------------------------------\r
2022\r
2023void preload_symbols (void)\r
2024{\r
2025 FILE *fd;\r
2026 char str[200], sym[20];\r
2027 int v;\r
2028 static BOOL preloaded_already = FALSE;\r
2029\r
2030 if (pass > 1 || preloaded_already)\r
2031 return;\r
2032\r
2033 preloaded_already = TRUE;\r
2034\r
2035 if ((fd = fopen(SYSTEM_TABLE, "r")) == NULL) // read the system symbol tabl\r
2036 perror(SYSTEM_TABLE);\r
2037 else {\r
2038 while (fgets(str, sizeof(str), fd) != NULL) {\r
2039 if (sscanf(str, "%s %x", sym, &v) == 2)\r
2040 set_symbol(sym, v, TRUE, FALSE);\r
2041 }\r
2042 fclose(fd);\r
2043 }\r
2044}\r
2045\r
2046// ---------------------------------------------------------------------------------\r
2047// save_symbols - save a symbol table\r
2048// ---------------------------------------------------------------------------------\r
2049\r
2050void save_symbols (void)\r
2051{\r
2052 FILE *fd;\r
2053 char str[20];\r
2054 PSYMBOL s;\r
2055\r
2056 if (relocate) {\r
2057 fprintf(stderr, "Can't save symbol table unless ABS assembly\n");\r
2058 return;\r
2059 }\r
2060\r
2061 if ((fd = fopen(SYSTEM_TABLE, "r")) != NULL) {\r
2062 fclose(fd);\r
2063 if (saveprompt) {\r
2064 printf("Overwrite system symbol table %s? ", SYSTEM_TABLE);\r
2065 fgets(str, sizeof(str), stdin);\r
2066 if (str[0] != 'y' && str[0] != 'Y')\r
2067 return;\r
2068 }\r
2069 unlink(SYSTEM_TABLE);\r
2070 }\r
2071\r
2072 if ((fd = fopen(SYSTEM_TABLE, "w")) == NULL) {\r
2073 perror(SYSTEM_TABLE);\r
2074 return;\r
2075 }\r
2076\r
2077 for (s = symbols; s != NULL; s = s->next)\r
2078 fprintf(fd, "%-5s %04x\n", s->name, s->value);\r
2079\r
2080 fclose(fd);\r
2081}\r
2082\r
2083// ---------------------------------------------------------------------------------\r
2084// startpass - initialize data structures, prepare to start a pass\r
2085// ---------------------------------------------------------------------------------\r
2086\r
2087void startpass (int n)\r
2088{\r
2089 int nops;\r
2090 struct tag_op *p;\r
2091\r
2092 pass = n; // reset globals: pass number\r
2093 nerrors = 0; // error count\r
2094 org = 0; // load address (origin)\r
2095 lno = 0; // input line number\r
2096 relocate = TRUE; // relocatable assembly mode\r
2097 assembled = FALSE; // true if any output has been generated\r
2098 list_on = do_list; // listing enable\r
2099 dmes_saved = FALSE; // partial character strings output\r
2100\r
2101 n_literals = 0; // literal values pending output\r
2102 lit_tag = 0;\r
2103\r
2104 if (pass == 1) { // first pass only\r
2105 for (nops = 0, p = ops; p->mnem != NULL; p++, nops++) // count opcodes\r
2106 ;\r
2107\r
2108 qsort(ops, nops, sizeof(*p), opcmp); // sort the opcode table\r
2109\r
2110 if (preload)\r
2111 preload_symbols();\r
2112 }\r
2113 else { // second pass only\r
2114 if (outfn == NULL)\r
2115 outfn = addextn(curfn, (outmode == OUTMODE_LOAD) ? ".out" : ".bin" , NULL);\r
2116\r
2117 if ((fout = fopen(outfn, OUTWRITEMODE)) == NULL) { // open output file\r
2118 perror(outfn);\r
2119 exit(1);\r
2120 }\r
2121\r
2122 if (do_list) { // open listing file\r
2123 if ((flist = fopen(listfn, "w")) == NULL) {\r
2124 perror(listfn);\r
2125 exit(1);\r
2126 }\r
2127 listhdr(); // print banner\r
2128 }\r
2129 }\r
2130}\r
2131\r
2132// ---------------------------------------------------------------------------------\r
2133// x_dc - DC define constant directive\r
2134// ---------------------------------------------------------------------------------\r
2135\r
2136void x_dc (struct tag_op *op, char *label, char *mods, char *arg)\r
2137{ \r
2138 EXPR expr;\r
2139// char *tok;\r
2140\r
2141 org_advanced = 1; // assume * means this address+1\r
2142// doesn't make sense, but I think I found DMS listings to support it\r
2143\r
2144 if (strchr(mods, 'E') != NULL) // force even address\r
2145 org_even();\r
2146\r
2147 setw(0, org, FALSE); // display org in listing line\r
2148\r
2149 if (*label) // define label\r
2150 set_symbol(label, org, TRUE, relocate);\r
2151\r
2152// just one!?\r
2153 getexpr(arg, FALSE, &expr);\r
2154 writew(expr.value, expr.relative); // store value\r
2155\r
2156 // pick up values, comma delimited\r
2157// for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {\r
2158// getexpr(tok, FALSE, &expr);\r
2159// writew(expr.value, expr.relative); // store value\r
2160// }\r
2161}\r
2162\r
2163// ---------------------------------------------------------------------------------\r
2164// x_dec - DEC define double word constant directive.\r
2165// ---------------------------------------------------------------------------------\r
2166\r
2167// wd[0]: 8 unused bits | characteristic (= exponent+128)\r
2168// wd[1]: sign + 15 msb of mantissa in 2's complement \r
2169// wd[2]: 16 lsb of mantissa\r
2170\r
2171// NOTE: these are wrong with Fixed point numbers\r
2172\r
2173void convert_double_to_extended (double d, unsigned short *wd)\r
2174{\r
2175 int neg, exp;\r
2176 unsigned long mantissa;\r
2177 unsigned char *byte = (unsigned char *) &d;\r
2178\r
2179 if (d == 0.) {\r
2180 wd[0] = wd[1] = wd[2] = 0;\r
2181 return;\r
2182 }\r
2183 // 7 6 5 4 0\r
2184 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM\r
2185\r
2186 neg = byte[7] & 0x80;\r
2187 exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4); // extract exponent\r
2188 exp -= 1023; // remove bias\r
2189\r
2190 exp++; // shift to account for implied 1 we added\r
2191\r
2192 // get 32 bits worth of mantissa. add the implied point\r
2193 mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);\r
2194\r
2195 if (mantissa & (0x80000000L >> 31)) // keep 31 bits, round if necessary\r
2196 mantissa += (0x80000000L >> 31);\r
2197\r
2198 mantissa >>= (32-31); // get into low 31 bits\r
2199\r
2200 // now turn into IBM 1130 extended precision\r
2201\r
2202 exp += 128;\r
2203\r
2204 if (neg)\r
2205 mantissa = (unsigned long) (- (long) mantissa); // two's complement\r
2206\r
2207 wd[0] = (unsigned short) (exp & 0xFF);\r
2208 wd[1] = (unsigned short) ((neg ? 0x8000 : 0) | ((mantissa >> (31-15)) & 0x7FFF));\r
2209 wd[2] = (unsigned short) (mantissa & 0xFFFF);\r
2210}\r
2211\r
2212// ---------------------------------------------------------------------------------\r
2213// ---------------------------------------------------------------------------------\r
2214\r
2215void convert_double_to_standard (double d, unsigned short *wd)\r
2216{\r
2217 int neg, exp;\r
2218 unsigned long mantissa;\r
2219 unsigned char *byte = (unsigned char *) &d;\r
2220\r
2221 if (d == 0.) {\r
2222 wd[0] = wd[1] = 0;\r
2223 return;\r
2224 }\r
2225 // 7 6 5 4 0\r
2226 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM\r
2227\r
2228 neg = byte[7] & 0x80;\r
2229 exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4); // extract exponent\r
2230 exp -= 1023; // remove bias\r
2231\r
2232 exp++; // shift to account for implied 1 we added\r
2233\r
2234 // get 32 bits worth of mantissa. add the implied point\r
2235 mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);\r
2236\r
2237// if (mantissa & (0x80000000L >> 23)) // keep 23 bits, round if necessary\r
2238// mantissa += (0x80000000L >> 23);\r
2239\r
2240// DEBUG\r
2241// printf("%8.4lf: %08lx %d\n", d, mantissa, exp);\r
2242\r
2243 mantissa >>= (32-23); // get into low 23 bits\r
2244\r
2245 // now turn into IBM 1130 standard precision\r
2246\r
2247 exp += 128;\r
2248\r
2249 if (neg)\r
2250 mantissa = (unsigned long) (- (long) mantissa); // two's complement\r
2251\r
2252 wd[0] = (unsigned short) ((neg ? 0x8000 : 0) | ((mantissa >> (23-15)) & 0x7FFF));\r
2253 wd[1] = (unsigned short) ((mantissa & 0x00FF) << 8) | (exp & 0xFF);\r
2254\r
2255// DEBUG\r
2256// printf(" D %04x%04x\n", wd[0], wd[1]);\r
2257}\r
2258\r
2259// ---------------------------------------------------------------------------------\r
2260// ---------------------------------------------------------------------------------\r
2261\r
2262void convert_double_to_fixed (double d, unsigned short *wd, int bexp)\r
2263{\r
2264 int neg, exp, rshift;\r
2265 unsigned long mantissa;\r
2266 unsigned char *byte = (unsigned char *) &d;\r
2267\r
2268 if (d == 0.) {\r
2269 wd[0] = wd[1] = 0;\r
2270 return;\r
2271 }\r
2272\r
2273 // note: we assume that this computer uses ANSI floating point\r
2274\r
2275 // 7 6 5 4 0\r
2276 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM\r
2277\r
2278 neg = byte[7] & 0x80;\r
2279 exp = ((byte[7] & 0x7F) << 4) | ((byte[6] & 0xF0) >> 4); // extract exponent\r
2280 exp -= 1023; // remove bias\r
2281\r
2282 exp++; // shift to account for implied 1 we added\r
2283\r
2284 // get 32 bits worth of mantissa. add the implied point\r
2285 mantissa = 0x80000000L | ((byte[6] & 0x0F) << 27) | (byte[5] << 19) | (byte[4] << 11) | (byte[3] << 3) | ((byte[2] & 0xE0) >> 5);\r
2286\r
2287 mantissa >>= 1; // shift it out of the sign bit\r
2288\r
2289// DEBUG\r
2290// printf("%8.4lf: %08lx %d\n", d, mantissa, exp);\r
2291\r
2292 rshift = bexp - exp;\r
2293\r
2294 if (rshift > 0) {\r
2295 mantissa >>= rshift;\r
2296 }\r
2297 else if (rshift < 0) {\r
2298 mantissa >>= (-rshift);\r
2299 asm_warning("Fixed point overflow");\r
2300 }\r
2301\r
2302 if (neg)\r
2303 mantissa = (unsigned long) (- (long) mantissa); // two's complement\r
2304\r
2305// DEBUG\r
2306// printf(" B %08lx\n", mantissa);\r
2307\r
2308 wd[0] = (unsigned short) ((mantissa >> 16) & 0xFFFF); // return all of the bits; no exponent here\r
2309 wd[1] = (unsigned short) (mantissa & 0xFFFF);\r
2310}\r
2311\r
2312// ---------------------------------------------------------------------------------\r
2313// ---------------------------------------------------------------------------------\r
2314\r
2315void getDconstant (char *tok, unsigned short *wd)\r
2316{\r
2317 unsigned long l;\r
2318 char *b, *fmt;\r
2319 double d;\r
2320 int bexp, fixed;\r
2321\r
2322 wd[0] = 0;\r
2323 wd[1] = 0;\r
2324\r
2325 if (strchr(tok, '.') == NULL && strchr(tok, 'B') == NULL && strchr(tok, 'E') == NULL) {\r
2326 fmt = "%ld";\r
2327 if (*tok == '/') { // I don't see that this is legal but can't hurt to allow it\r
2328 fmt = "%lx";\r
2329 tok++;\r
2330 }\r
2331 if (sscanf(tok, fmt, &l) != 1) { // no decimal means it's an integer?\r
2332 asm_error("Syntax error in constant");\r
2333 }\r
2334 else {\r
2335 wd[0] = (unsigned short) ((l >> 16) & 0xFFFF); // high word\r
2336 wd[1] = (unsigned short) (l & 0xFFFF); // low word\r
2337 }\r
2338 return;\r
2339 }\r
2340\r
2341 fixed = 0;\r
2342 if ((b = strchr(tok, 'B')) != NULL) {\r
2343 fixed = 1;\r
2344 bexp = atoi(b+1);\r
2345 *b = '\0'; // truncate at the b\r
2346 }\r
2347 if (sscanf(tok, "%lg", &d) != 1) {\r
2348 asm_error("Syntax error in constant");\r
2349 return;\r
2350 }\r
2351\r
2352 if (fixed)\r
2353 convert_double_to_fixed(d, wd, bexp);\r
2354 else\r
2355 convert_double_to_standard(d, wd);\r
2356}\r
2357\r
2358// ---------------------------------------------------------------------------------\r
2359// If the input value is an integer with no decimal point and no B or E,\r
2360// DEC generates a double INTEGER value.\r
2361// IBM documentation ranges from ambiguous to wrong on this point, but\r
2362// examination of the DMS microfiche supports this.\r
2363// ---------------------------------------------------------------------------------\r
2364\r
2365void x_dec (struct tag_op *op, char *label, char *mods, char *arg)\r
2366{ \r
2367 unsigned short wd[2];\r
2368\r
2369 org_advanced = 2; // assume * means address after this location, since it's +1 for dc?\r
2370\r
2371 org_even(); // even address is implied\r
2372 setw(0, org, FALSE); // display the origin\r
2373\r
2374 if (*label) // define label\r
2375 set_symbol(label, org, TRUE, relocate);\r
2376\r
2377// just one!?\r
2378 getDconstant(arg, wd);\r
2379 writew(wd[0], FALSE); // write hiword, then loword\r
2380 writew(wd[1], FALSE);\r
2381\r
2382 // pick up values, comma delimited\r
2383// for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {\r
2384// getDconstant(tok, wd);\r
2385//\r
2386// writew(wd[0], FALSE); // write hiword, then loword\r
2387// writew(wd[1], FALSE);\r
2388}\r
2389\r
2390// ---------------------------------------------------------------------------------\r
2391// DECS directive. Writes just the high word of a DEC value\r
2392// ---------------------------------------------------------------------------------\r
2393\r
2394void x_decs (struct tag_op *op, char *label, char *mods, char *arg)\r
2395{ \r
2396 unsigned short wd[2];\r
2397\r
2398 org_advanced = 1; // assume * means address after this location\r
2399\r
2400 setw(0, org, FALSE); // display the origin\r
2401\r
2402 if (*label) // define label\r
2403 set_symbol(label, org, TRUE, relocate);\r
2404\r
2405 getDconstant(arg, wd);\r
2406 writew(wd[0], FALSE); // write hiword ONLY\r
2407}\r
2408\r
2409// ---------------------------------------------------------------------------------\r
2410// ---------------------------------------------------------------------------------\r
2411\r
2412void x_xflc (struct tag_op *op, char *label, char *mods, char *arg)\r
2413{ \r
2414 char *tok, *b;\r
2415 double d;\r
2416 int bexp, fixed;\r
2417 unsigned short wd[3];\r
2418\r
2419 org_advanced = 2; // who knows?\r
2420\r
2421 setw(0, org, FALSE); // display the origin\r
2422\r
2423 if (*label) // define label\r
2424 set_symbol(label, org, TRUE, relocate);\r
2425 // pick up values, comma delimited\r
2426 for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {\r
2427 bexp = 0;\r
2428 if ((b = strchr(tok, 'B')) != NULL) {\r
2429 bexp = atoi(b+1);\r
2430 fixed = TRUE;\r
2431 *b = '\0'; // truncate at the b\r
2432 asm_warning("Fixed point extended floating constant?");\r
2433 }\r
2434\r
2435 if (sscanf(tok, "%lg", &d) != 1) {\r
2436 asm_error("Syntax error in constant");\r
2437 d = 0.;\r
2438 }\r
2439\r
2440 convert_double_to_extended(d, wd);\r
2441\r
2442 writew(wd[0], ABSOLUTE);\r
2443 writew(wd[1], ABSOLUTE);\r
2444 writew(wd[2], ABSOLUTE);\r
2445 }\r
2446}\r
2447\r
2448// ---------------------------------------------------------------------------------\r
2449// x_equ - EQU directive\r
2450// ---------------------------------------------------------------------------------\r
2451\r
2452void x_equ (struct tag_op *op, char *label, char *mods, char *arg)\r
2453{ \r
2454 EXPR expr;\r
2455\r
2456 org_advanced = FALSE; // * means this address, not incremented\r
2457\r
2458 getexpr(arg, FALSE, &expr);\r
2459\r
2460 setw(0, expr.value, expr.relative); // show this as address\r
2461\r
2462 if (*label) // EQU is all about defining labels, better have one\r
2463 set_symbol(label, expr.value, TRUE, expr.relative);\r
2464// else // IBM assembler doesn't complain about this\r
2465// asm_error("EQU without label?");\r
2466}\r
2467\r
2468// ---------------------------------------------------------------------------------\r
2469// x_lorg - LORG directive -- output queued literal values\r
2470// ---------------------------------------------------------------------------------\r
2471\r
2472void x_lorg (struct tag_op *op, char *label, char *mods, char *arg)\r
2473{\r
2474 org_advanced = FALSE; // * means this address (not used, though)\r
2475 output_literals(FALSE); // generate .DC's for queued literal values\r
2476}\r
2477\r
2478// ---------------------------------------------------------------------------------\r
2479// x_abs - ABS directive\r
2480// ---------------------------------------------------------------------------------\r
2481\r
2482void x_abs (struct tag_op *op, char *label, char *mods, char *arg)\r
2483{\r
2484 if (assembled)\r
2485 asm_error("ABS must be first statement");\r
2486\r
2487 relocate = ABSOLUTE;\r
2488\r
2489 switch (progtype) {\r
2490 case PROGTYPE_ABSOLUTE:\r
2491 case PROGTYPE_RELOCATABLE:\r
2492 progtype = PROGTYPE_ABSOLUTE; // change program type, still assumed to be mainline\r
2493 break;\r
2494\r
2495 case PROGTYPE_LIBF:\r
2496 case PROGTYPE_CALL:\r
2497 case PROGTYPE_ISSLIBF:\r
2498 case PROGTYPE_ISSCALL:\r
2499 case PROGTYPE_ILS:\r
2500 asm_error("ABS not allowed with LIBF, ENT, ILS or ISS");\r
2501 break;\r
2502\r
2503 default:\r
2504 bail("in x_libr, can't happen");\r
2505 }\r
2506}\r
2507\r
2508// ---------------------------------------------------------------------------------\r
2509// x_call - ORG pseudo-op\r
2510// ---------------------------------------------------------------------------------\r
2511\r
2512void x_call (struct tag_op *op, char *label, char *mods, char *arg)\r
2513{\r
2514 unsigned short words[2];\r
2515 static struct tag_op *bsi = NULL;\r
2516\r
2517 if (*label) // define label\r
2518 set_symbol(label, org, TRUE, relocate);\r
2519\r
2520 if (! *arg) {\r
2521 asm_error("CALL missing argument");\r
2522 return;\r
2523 }\r
2524\r
2525 if (pass == 1) { // it will take two words in any case\r
2526 org += 2;\r
2527 return;\r
2528 }\r
2529\r
2530 setw(0, org, FALSE); // display origin\r
2531\r
2532 if (lookup_symbol(arg, FALSE) != NULL) { // it's a defined symbol?\r
2533 if (bsi == NULL)\r
2534 if ((bsi = lookup_op("BSI")) == NULL)\r
2535 bail("Can't find BSI op");\r
2536\r
2537 (bsi->handler)(bsi, "", "L", arg);\r
2538 }\r
2539 else {\r
2540 namecode(words, arg); // emit namecode for loader\r
2541\r
2542 writetwo();\r
2543 writew(words[0], CALL);\r
2544 writew(words[1], ABSOLUTE);\r
2545 }\r
2546}\r
2547\r
2548// ---------------------------------------------------------------------------------\r
2549// x_org - ORG directive\r
2550// ---------------------------------------------------------------------------------\r
2551\r
2552void x_org (struct tag_op *op, char *label, char *mods, char *arg)\r
2553{\r
2554 EXPR expr;\r
2555\r
2556 org_advanced = FALSE; // * means this address\r
2557\r
2558 if (*label) // label is defined BEFORE the new origin is set!!!\r
2559 set_symbol(label, org, TRUE, relocate);\r
2560\r
2561 if (getexpr(arg, FALSE, &expr) != S_DEFINED)\r
2562 return;\r
2563\r
2564 setorg(expr.value); // set origin to this value\r
2565}\r
2566\r
2567// ---------------------------------------------------------------------------------\r
2568// x_end - END directive\r
2569// ---------------------------------------------------------------------------------\r
2570\r
2571void x_end (struct tag_op *op, char *label, char *mods, char *arg)\r
2572{\r
2573 EXPR expr;\r
2574\r
2575 org_advanced = FALSE; // * means this address\r
2576\r
2577 if (*arg) { // they're specifing the program start address\r
2578 if (getexpr(arg, FALSE, &expr) == S_DEFINED)\r
2579 pta = expr.value;\r
2580 }\r
2581\r
2582 if (*label) // define label\r
2583 set_symbol(label, org, TRUE, relocate);\r
2584\r
2585 setw(0, org, FALSE); // display origin\r
2586\r
2587 ended = TRUE; // assembly is done, stop reading file\r
2588}\r
2589\r
2590// ---------------------------------------------------------------------------------\r
2591// x_ent - ENT op\r
2592// ---------------------------------------------------------------------------------\r
2593\r
2594void x_ent (struct tag_op *op, char *label, char *mods, char *arg)\r
2595{\r
2596 PSYMBOL s;\r
2597\r
2598 org_advanced = FALSE; // * means this address\r
2599\r
2600 if (pass < 2)\r
2601 return;\r
2602\r
2603// if (*label) // define label\r
2604// set_symbol(label, org, TRUE, relocate);\r
2605//\r
2606// setw(0, org, FALSE); // display origin\r
2607\r
2608 if (! *arg)\r
2609 asm_error("No entry label specified");\r
2610\r
2611 else if ((s = lookup_symbol(arg, FALSE)) == NULL)\r
2612 asm_error("Entry symbol %s not defined", arg);\r
2613\r
2614 else if (nentries >= MAXENTRIES)\r
2615 asm_error("Too many entries, limit is %d", MAXENTRIES);\r
2616\r
2617 else\r
2618 entry[nentries++] = s; // save symbol pointer\r
2619\r
2620 switch (progtype) {\r
2621 case PROGTYPE_ABSOLUTE:\r
2622 asm_error("ENT not allowed with ABS");\r
2623 break;\r
2624 case PROGTYPE_RELOCATABLE:\r
2625 progtype = PROGTYPE_CALL;\r
2626 break;\r
2627 case PROGTYPE_LIBF:\r
2628 case PROGTYPE_CALL:\r
2629 case PROGTYPE_ISSLIBF:\r
2630 case PROGTYPE_ISSCALL:\r
2631 break;\r
2632 case PROGTYPE_ILS:\r
2633 asm_error("Can't mix ENT and ILS, can you?");\r
2634 break;\r
2635 default:\r
2636 bail("in x_libr, can't happen");\r
2637 }\r
2638}\r
2639\r
2640// ---------------------------------------------------------------------------------\r
2641// declare a libf-type subprogram\r
2642// ---------------------------------------------------------------------------------\r
2643\r
2644void x_libr (struct tag_op *op, char *label, char *mods, char *arg)\r
2645{\r
2646 switch (progtype) {\r
2647 case PROGTYPE_ABSOLUTE:\r
2648 asm_error("LIBR not allowed with ABS");\r
2649 break;\r
2650 case PROGTYPE_RELOCATABLE:\r
2651 case PROGTYPE_LIBF:\r
2652 case PROGTYPE_CALL:\r
2653 progtype = PROGTYPE_LIBF;\r
2654 break;\r
2655 case PROGTYPE_ISSLIBF:\r
2656 case PROGTYPE_ISSCALL:\r
2657 progtype = PROGTYPE_ISSLIBF;\r
2658 break;\r
2659 case PROGTYPE_ILS:\r
2660 asm_error("Can't use LIBR in an ILS");\r
2661 break;\r
2662 default:\r
2663 bail("in x_libr, can't happen");\r
2664 }\r
2665}\r
2666\r
2667// ---------------------------------------------------------------------------------\r
2668// x_ils - ILS directive\r
2669// ---------------------------------------------------------------------------------\r
2670\r
2671void x_ils (struct tag_op *op, char *label, char *mods, char *arg)\r
2672{\r
2673 switch (progtype) {\r
2674 case PROGTYPE_ABSOLUTE:\r
2675 asm_error("ILS not allowed with ABS");\r
2676 break;\r
2677 case PROGTYPE_RELOCATABLE:\r
2678 case PROGTYPE_ILS:\r
2679 progtype = PROGTYPE_ILS;\r
2680 break;\r
2681 case PROGTYPE_LIBF:\r
2682 case PROGTYPE_CALL:\r
2683 asm_error("Invalid placement of ILS");\r
2684 break;\r
2685 case PROGTYPE_ISSLIBF:\r
2686 case PROGTYPE_ISSCALL:\r
2687 break;\r
2688 default:\r
2689 bail("in x_libr, can't happen");\r
2690 }\r
2691\r
2692 intlevel_primary = atoi(mods);\r
2693}\r
2694\r
2695// ---------------------------------------------------------------------------------\r
2696// x_iss - ISS directive\r
2697// ---------------------------------------------------------------------------------\r
2698\r
2699void x_iss (struct tag_op *op, char *label, char *mods, char *arg)\r
2700{\r
2701 char *tok;\r
2702\r
2703 switch (progtype) {\r
2704 case PROGTYPE_ABSOLUTE:\r
2705 asm_error("ISS not allowed with ABS");\r
2706 break;\r
2707 case PROGTYPE_RELOCATABLE:\r
2708 case PROGTYPE_CALL:\r
2709 case PROGTYPE_ISSCALL:\r
2710 progtype = PROGTYPE_ISSCALL;\r
2711 break;\r
2712 case PROGTYPE_LIBF:\r
2713 case PROGTYPE_ISSLIBF:\r
2714 progtype = PROGTYPE_ISSLIBF;\r
2715 break;\r
2716 case PROGTYPE_ILS:\r
2717 asm_error("Can't mix ISS and ILS");\r
2718 default:\r
2719 bail("in x_libr, can't happen");\r
2720 }\r
2721\r
2722 iss_number = atoi(mods); // get ISS number\r
2723\r
2724 opfield[16] = '\0'; // be sure not to look too far into this\r
2725\r
2726 nintlevels = 0; // # of interrupt levels for ISS\r
2727 intlevel_primary = 0; // primary level for ISS and level for ILS\r
2728 intlevel_secondary = 0; // secondary level for ISS\r
2729\r
2730 if ((tok = strtok(opfield, " ")) == NULL)\r
2731 asm_error("ISS missing entry label");\r
2732 else\r
2733 x_ent(NULL, label, "", arg); // process as an ENT\r
2734\r
2735 if ((tok = strtok(NULL, " ")) != NULL) { // get associated levels\r
2736 nintlevels++;\r
2737 intlevel_primary = atoi(tok);\r
2738 }\r
2739\r
2740 if ((tok = strtok(NULL, " ")) != NULL) {\r
2741 nintlevels++;\r
2742 intlevel_secondary = atoi(tok);\r
2743 }\r
2744}\r
2745\r
2746void x_spr (struct tag_op *op, char *label, char *mods, char *arg)\r
2747{\r
2748 realmode = REALMODE_STANDARD;\r
2749}\r
2750\r
2751void x_epr (struct tag_op *op, char *label, char *mods, char *arg)\r
2752{\r
2753 realmode = REALMODE_EXTENDED;\r
2754}\r
2755\r
2756void x_dsa (struct tag_op *op, char *label, char *mods, char *arg)\r
2757{\r
2758 unsigned short words[2];\r
2759\r
2760 setw(0, org, FALSE); // display origin\r
2761\r
2762 if (*label) // define label\r
2763 set_symbol(label, org, TRUE, relocate);\r
2764\r
2765 if (! *arg) {\r
2766 asm_error("DSA missing filename");\r
2767 }\r
2768 else {\r
2769 namecode(words, arg); \r
2770 writetwo();\r
2771 writew(words[0], CALL); // special relocation bits here 3 and 1\r
2772 writew(words[1], RELATIVE);\r
2773 }\r
2774}\r
2775\r
2776void x_link (struct tag_op *op, char *label, char *mods, char *arg)\r
2777{\r
2778 unsigned short words[2];\r
2779 char nline[128];\r
2780\r
2781 setw(0, org, FALSE); // display origin\r
2782\r
2783 if (*label) // define label\r
2784 set_symbol(label, org, TRUE, relocate);\r
2785\r
2786 if (! *arg) {\r
2787 asm_error("LINK missing program name");\r
2788 }\r
2789 else {\r
2790 format_line(nline, label, "CALL", "", "$LINK", "");\r
2791 parse_line(nline);\r
2792\r
2793 namecode(words, arg); \r
2794 writew(words[0], ABSOLUTE); // special relocation bits here 3 and 1\r
2795 writew(words[1], ABSOLUTE);\r
2796 }\r
2797}\r
2798\r
2799void x_libf (struct tag_op *op, char *label, char *mods, char *arg)\r
2800{\r
2801 unsigned short words[2];\r
2802\r
2803 if (*label) // define label\r
2804 set_symbol(label, org, TRUE, relocate);\r
2805\r
2806 if (! *arg) {\r
2807 asm_error("LIBF missing argument");\r
2808 return;\r
2809 }\r
2810\r
2811 if (pass == 1) { // it will take one words in any case\r
2812 org++;\r
2813 return;\r
2814 }\r
2815\r
2816 setw(0, org, FALSE); // display origin\r
2817\r
2818 namecode(words, arg); // emit namecode for loader\r
2819\r
2820 writetwo();\r
2821 writew(words[0], LIBF); // this one does NOT advance org!\r
2822 writew(words[1], ABSOLUTE);\r
2823}\r
2824\r
2825void x_file (struct tag_op *op, char *label, char *mods, char *arg)\r
2826{\r
2827 int i, n, r;\r
2828 EXPR vals[5];\r
2829 char *tok;\r
2830\r
2831 for (i = 0; i < 5; i++) {\r
2832 if ((tok = strtok(arg, ",")) == NULL) {\r
2833 asm_error("FILE has insufficient arguments");\r
2834 return;\r
2835 }\r
2836 arg = NULL; // for next strtok call\r
2837\r
2838 if (i == 3) {\r
2839 if (strcmpi(tok, "U") != 0)\r
2840 asm_error("Argument 4 must be the letter U");\r
2841 }\r
2842 else if (getexpr(tok, FALSE, &vals[i]) == S_DEFINED) {\r
2843 if (i <= 3 && vals[i].relative)\r
2844 asm_error("Argument %d must be absolute", i+1);\r
2845 else if (pass == 2 && vals[i].value == 0)\r
2846 asm_error("Argument %d must be nonzero", i+1);\r
2847 }\r
2848 }\r
2849\r
2850 writew(vals[0].value, ABSOLUTE);\r
2851 writew(vals[1].value, ABSOLUTE);\r
2852 writew(vals[2].value, ABSOLUTE);\r
2853 writew(vals[4].value, vals[i].relative);\r
2854 writew(0, ABSOLUTE);\r
2855 n = MAX(1, vals[2].value);\r
2856 r = 320/n;\r
2857 writew(r, ABSOLUTE);\r
2858 r = MAX(1, r);\r
2859 writew((16*vals[1].value)/r, ABSOLUTE);\r
2860\r
2861 if (pass == 2)\r
2862 ndefined_files++;\r
2863}\r
2864\r
2865// ---------------------------------------------------------------------------------\r
2866// x_trap - place to set a breakpoint\r
2867// ---------------------------------------------------------------------------------\r
2868\r
2869void x_trap (struct tag_op *op, char *label, char *mods, char *arg)\r
2870{\r
2871 // debugging breakpoint\r
2872}\r
2873\r
2874// ---------------------------------------------------------------------------------\r
2875// x_ces - .CES directive (nonstandard). Specify a value for the console entry\r
2876// switches. When this program is loaded into the simulator, the switches will\r
2877// be set accordingly. Handy for bootstraps and other programs that read\r
2878// the switches.\r
2879// ---------------------------------------------------------------------------------\r
2880\r
2881void x_ces (struct tag_op *op, char *label, char *mods, char *arg)\r
2882{\r
2883 EXPR expr;\r
2884\r
2885 if (outmode != OUTMODE_LOAD) // this works only in our loader format\r
2886 return;\r
2887\r
2888 if (getexpr(arg, FALSE, &expr) != S_DEFINED)\r
2889 return;\r
2890\r
2891 if (pass == 2)\r
2892 fprintf(fout, "S%04x" ENDLINE, expr.value & 0xFFFF);\r
2893}\r
2894\r
2895// ---------------------------------------------------------------------------------\r
2896// x_bss - BSS directive - reserve space in core\r
2897// ---------------------------------------------------------------------------------\r
2898\r
2899void x_bss (struct tag_op *op, char *label, char *mods, char *arg)\r
2900{\r
2901 EXPR expr;\r
2902\r
2903 org_advanced = FALSE; // * means this address\r
2904\r
2905 if (! *arg) {\r
2906 expr.value = 0;\r
2907 expr.relative = ABSOLUTE;\r
2908 }\r
2909 else if (getexpr(arg, FALSE, &expr) != S_DEFINED)\r
2910 return;\r
2911\r
2912 if (strchr(mods, 'E') != NULL) // force even address\r
2913 org_even();\r
2914\r
2915 if (expr.relative)\r
2916 asm_error("BSS size must be an absolute value");\r
2917\r
2918 setw(0, org, FALSE); // display origin\r
2919\r
2920 if (*label) // define label\r
2921 set_symbol(label, org, TRUE, relocate);\r
2922\r
2923 expr.value &= 0xFFFF; // truncate to 16 bits\r
2924\r
2925 if (expr.value & 0x8000)\r
2926 asm_warning("Negative BSS size");\r
2927 else if (expr.value > 0) {\r
2928 if (outmode == OUTMODE_LOAD) {\r
2929 org += expr.value; // advance the origin by appropriate number of words\r
2930 if (pass == 2) // emit new load address in output file\r
2931 fprintf(fout, "@%04x%s" ENDLINE, org & 0xFFFF, relocate ? "R" : "");\r
2932 }\r
2933 else {\r
2934 org += expr.value; // advance the origin by appropriate number of words\r
2935 if (pass == 2)\r
2936 bincard_setorg(org);\r
2937 }\r
2938 }\r
2939}\r
2940\r
2941// ---------------------------------------------------------------------------------\r
2942// x_bes - Block Ended by Symbol directive. Like BSS but label gets address AFTER the space, instead of first address\r
2943// ---------------------------------------------------------------------------------\r
2944\r
2945void x_bes (struct tag_op *op, char *label, char *mods, char *arg)\r
2946{\r
2947 EXPR expr;\r
2948\r
2949 org_advanced = FALSE; // * means this address\r
2950\r
2951 if (! *arg) { // arg field = space\r
2952 expr.value = 0;\r
2953 expr.relative = ABSOLUTE;\r
2954 }\r
2955 else if (getexpr(arg, FALSE, &expr) != S_DEFINED)\r
2956 return;\r
2957\r
2958 if (strchr(mods, 'E') != NULL && (org & 1) != 0)\r
2959 org_even(); // force even address\r
2960\r
2961 if (expr.relative)\r
2962 asm_error("BES size must be an absolute value");\r
2963\r
2964 if (expr.value < 0)\r
2965 asm_warning("Negative BES size");\r
2966\r
2967 else if (expr.value > 0) {\r
2968 setw(0, org+expr.value, FALSE); // display NEW origin\r
2969\r
2970 if (outmode == OUTMODE_LOAD) {\r
2971 org += expr.value; // advance the origin\r
2972 if (pass == 2) // emit new load address in output file\r
2973 fprintf(fout, "@%04x%s" ENDLINE, org & 0xFFFF, relocate ? "R" : "");\r
2974 }\r
2975 else {\r
2976 org += expr.value; // advance the origin\r
2977 bincard_setorg(org);\r
2978 }\r
2979 }\r
2980\r
2981 if (*label) // NOW define the label\r
2982 set_symbol(label, org, TRUE, relocate);\r
2983}\r
2984\r
2985// ---------------------------------------------------------------------------------\r
2986// x_dmes - DMES define message directive. Various encodings, none pretty.\r
2987// ---------------------------------------------------------------------------------\r
2988\r
2989int dmes_wd;\r
2990int dmes_nc;\r
2991enum {CODESET_CONSOLE, CODESET_1403, CODESET_1132, CODESET_EBCDIC} dmes_cs;\r
2992void stuff_dmes (int ch, int rpt);\r
2993\r
2994void x_dmes (struct tag_op *op, char *label, char *mods, char *arg)\r
2995{\r
2996 int rpt;\r
2997 char *c = opfield;\r
2998 BOOL cont = FALSE;\r
2999\r
3000 if (dmes_saved) { // previous DMES had an odd character saved\r
3001 dmes_wd = dmes_savew;\r
3002 dmes_nc = 1; // stick it into the outbut buffer\r
3003 }\r
3004 else\r
3005 dmes_nc = dmes_wd = 0; // clear output buffer\r
3006\r
3007 trim(opfield); // remove trailing blanks from rest of input line (use whole thing)\r
3008 setw(0, org, FALSE); // display origin\r
3009\r
3010 if (*label) // define label\r
3011 set_symbol(label, org, TRUE, relocate);\r
3012\r
3013 if (strchr(mods, '1') != NULL) // determine the encoding scheme\r
3014 dmes_cs = CODESET_1403;\r
3015 else if (strchr(mods, '2') != NULL)\r
3016 dmes_cs = CODESET_1132;\r
3017 else if (strchr(mods, '0') != NULL || ! *mods)\r
3018 dmes_cs = CODESET_CONSOLE;\r
3019 else {\r
3020 asm_error("Invalid printer code in tag field");\r
3021 dmes_cs = CODESET_EBCDIC;\r
3022 }\r
3023\r
3024 while (*c) { // pick up characters\r
3025 if (*c == '\'') { // quote (') is the escape character\r
3026 c++;\r
3027\r
3028 rpt = 0; // get repeat count\r
3029 while (BETWEEN(*c, '0', '9')) {\r
3030 rpt = rpt*10 + *c++ - '0';\r
3031 }\r
3032 if (rpt <= 0) // no count = insert one copy\r
3033 rpt = 1;\r
3034\r
3035 switch (*c) { // handle escape codes\r
3036 case '\'':\r
3037 stuff_dmes(*c, 1);\r
3038 break;\r
3039\r
3040 case 'E':\r
3041 *c = '\0'; // end\r
3042 break;\r
3043\r
3044 case 'X':\r
3045 case 'S':\r
3046 stuff_dmes(' ', rpt);\r
3047 break;\r
3048\r
3049 case 'F':\r
3050 stuff_dmes(*++c, rpt); // repeat character\r
3051 break;\r
3052\r
3053 case ' ':\r
3054 case '\0':\r
3055 cont = TRUE;\r
3056 *c = '\0'; // end\r
3057 break;\r
3058\r
3059 case 'T':\r
3060 if (dmes_cs != CODESET_CONSOLE) {\r
3061badcode: asm_error("Invalid ' escape for selected printer");\r
3062 break;\r
3063 }\r
3064 stuff_dmes(0x41, -rpt); // tab\r
3065 break;\r
3066\r
3067 case 'D':\r
3068 if (dmes_cs != CODESET_CONSOLE) goto badcode;\r
3069 stuff_dmes(0x11, -rpt); // backspace\r
3070 break;\r
3071\r
3072 case 'B':\r
3073 if (dmes_cs != CODESET_CONSOLE) goto badcode;\r
3074 stuff_dmes(0x05, -rpt); // black\r
3075 break;\r
3076\r
3077 case 'A':\r
3078 if (dmes_cs != CODESET_CONSOLE) goto badcode;\r
3079 stuff_dmes(0x09, -rpt); // red\r
3080 break;\r
3081\r
3082 case 'R':\r
3083 if (dmes_cs != CODESET_CONSOLE) goto badcode;\r
3084 stuff_dmes(0x81, -rpt); // return\r
3085 break;\r
3086\r
3087 case 'L':\r
3088 if (dmes_cs != CODESET_CONSOLE) goto badcode;\r
3089 stuff_dmes(0x03, -rpt); // line feed\r
3090 break;\r
3091 \r
3092 default:\r
3093 asm_error("Invalid ' escape in DMES");\r
3094 *c = '\0';\r
3095 break;\r
3096 }\r
3097 }\r
3098 else // just copy literal character\r
3099 stuff_dmes(*c, 1);\r
3100\r
3101 if (*c)\r
3102 c++;\r
3103 }\r
3104\r
3105 dmes_saved = FALSE;\r
3106\r
3107 if (dmes_nc) { // odd number of characters\r
3108 if (cont) {\r
3109 dmes_saved = TRUE;\r
3110 dmes_savew = dmes_wd; // save for next time\r
3111 }\r
3112 else\r
3113 stuff_dmes(' ', 1); // pad with a space to force out even # of characters\r
3114 }\r
3115}\r
3116\r
3117// ---------------------------------------------------------------------------------\r
3118// stuff_dmes - insert 'rpt' copies of character 'ch' into output words\r
3119// ---------------------------------------------------------------------------------\r
3120\r
3121void stuff_dmes (int ch, int rpt)\r
3122{\r
3123 int nch, i; // nch is translated output value\r
3124\r
3125 if (rpt < 0) { // negative repeat means no translation needed\r
3126 rpt = -rpt;\r
3127 nch = ch;\r
3128 }\r
3129 else {\r
3130 switch (dmes_cs) {\r
3131 case CODESET_CONSOLE:\r
3132 nch = 0x21;\r
3133 for (i = 0; i < 256; i++) {\r
3134 if (conout_to_ascii[i] == ch) {\r
3135 nch = i;\r
3136 break;\r
3137 }\r
3138 }\r
3139 break;\r
3140\r
3141 case CODESET_EBCDIC:\r
3142 nch = ascii_to_ebcdic_table[ch & 0x7F];\r
3143 if (nch == 0)\r
3144 nch = 0x7F;\r
3145 break;\r
3146\r
3147 case CODESET_1403:\r
3148 nch = ascii_to_1403_table[ch & 0x7F];\r
3149 if (nch == 0)\r
3150 nch = 0x7F;\r
3151 break;\r
3152\r
3153 case CODESET_1132:\r
3154 nch = 0x40;\r
3155 for (i = 0; i < WHEELCHARS_1132; i++) {\r
3156 if (codewheel1132[i].ascii == ch) {\r
3157 nch = codewheel1132[i].ebcdic;\r
3158 break;\r
3159 }\r
3160 }\r
3161 break;\r
3162\r
3163 default:\r
3164 bail("bad cs in x_dmes, can't happen");\r
3165 break;\r
3166 }\r
3167 }\r
3168 \r
3169 while (--rpt >= 0) { // pack them into words, output when we have two\r
3170 if (dmes_nc == 0) {\r
3171 dmes_wd = (nch & 0xFF) << 8;\r
3172 dmes_nc = 1;\r
3173 }\r
3174 else {\r
3175 dmes_wd |= (nch & 0xFF);\r
3176 writew(dmes_wd, FALSE);\r
3177 dmes_nc = 0;\r
3178 }\r
3179 }\r
3180}\r
3181\r
3182// ---------------------------------------------------------------------------------\r
3183// x_ebc - handle EBCDIC string definition (delimited with periods)\r
3184// ---------------------------------------------------------------------------------\r
3185\r
3186void x_ebc (struct tag_op *op, char *label, char *mods, char *arg)\r
3187{\r
3188 char *p;\r
3189\r
3190// setw(0, org, FALSE);\r
3191 if (*label)\r
3192 set_symbol(label, org, TRUE, relocate);\r
3193\r
3194 p = trim(opfield); // remove trailing blanks from rest of input line (use whole thing)\r
3195\r
3196 if (*p != '.') {\r
3197 asm_error("EBC data must start with .");\r
3198 return;\r
3199 }\r
3200 p++; // skip leading period\r
3201\r
3202 dmes_nc = dmes_wd = 0; // clear output buffer (we're borrowing the DMES packer)\r
3203 dmes_cs = CODESET_EBCDIC;\r
3204\r
3205 while (*p && *p != '.') // store packed ebcdic\r
3206 stuff_dmes(*p++, 1);\r
3207\r
3208 if (dmes_nc) // odd number of characters\r
3209 stuff_dmes(' ', 1); // pad with a space to force out even # of characters\r
3210\r
3211 if (*p != '.')\r
3212 asm_error("EBC missing closing .");\r
3213}\r
3214\r
3215// ---------------------------------------------------------------------------------\r
3216// x_dn - define name DN directive. Pack 5 characters into two words. This by the\r
3217// way is the reason the language Forth is not Fourth.\r
3218// ---------------------------------------------------------------------------------\r
3219\r
3220void x_dn (struct tag_op *op, char *label, char *mods, char *arg)\r
3221{\r
3222 unsigned short words[2];\r
3223\r
3224 setw(0, org, FALSE); // display origin\r
3225\r
3226 if (*label) // define label\r
3227 set_symbol(label, org, TRUE, relocate);\r
3228\r
3229 namecode(words, arg); \r
3230\r
3231 writew(words[0], ABSOLUTE);\r
3232 writew(words[1], ABSOLUTE);\r
3233}\r
3234\r
3235// ---------------------------------------------------------------------------------\r
3236// x_dump - DUMP directive - pretend we saw "call $dump, call $exit"\r
3237// ---------------------------------------------------------------------------------\r
3238\r
3239void x_dump (struct tag_op *op, char *label, char *mods, char *arg)\r
3240{\r
3241 x_pdmp(op, label, mods, arg);\r
3242 x_exit(NULL, "", "", ""); // compile "call $exit"\r
3243}\r
3244\r
3245// ---------------------------------------------------------------------------------\r
3246// x_pdmp - PDMP directive - like DUMP but without the call $exit\r
3247// ---------------------------------------------------------------------------------\r
3248\r
3249void x_pdmp (struct tag_op *op, char *label, char *mods, char *arg)\r
3250{\r
3251 char nline[200], *tok;\r
3252 EXPR addr[3];\r
3253 int i;\r
3254\r
3255 for (i = 0, tok = strtok(arg, ","); i < 3 && tok != NULL; i++, tok = strtok(NULL, ",")) {\r
3256 if (getexpr(tok, FALSE, addr+i) != S_DEFINED) {\r
3257 addr[i].value = (i == 1) ? 0x3FFF : 0;\r
3258 addr[i].relative = ABSOLUTE;\r
3259 }\r
3260 }\r
3261\r
3262 org_advanced = FALSE; // * means this address+1\r
3263\r
3264 format_line(nline, label, "BSI", "L", DOLLARDUMP, "");\r
3265 parse_line(nline); // compile "call $dump"\r
3266\r
3267 writew(addr[2].value, ABSOLUTE); // append arguments (0, start, end address)\r
3268 writew(addr[0].value, addr[0].relative);\r
3269 writew(addr[1].value, addr[1].relative);\r
3270}\r
3271\r
3272// ---------------------------------------------------------------------------------\r
3273// x_hdng - HDNG directive\r
3274// ---------------------------------------------------------------------------------\r
3275\r
3276void x_hdng (struct tag_op *op, char *label, char *mods, char *arg)\r
3277{\r
3278 char *c;\r
3279\r
3280 // label is not entered into the symbol table\r
3281\r
3282 if (flist == NULL || ! list_on) {\r
3283 line_error = TRUE; // inhibit listing: don't print the HDNG statement\r
3284 return;\r
3285 }\r
3286\r
3287 line_error = TRUE; // don't print the statement\r
3288\r
3289 c = skipbl(opfield);\r
3290 trim(c);\r
3291 fprintf(flist, "\f%s\n\n", c); // print page header\r
3292}\r
3293\r
3294// ---------------------------------------------------------------------------------\r
3295// x_list - LIST directive. enable or disable listing\r
3296// ---------------------------------------------------------------------------------\r
3297\r
3298void x_list (struct tag_op *op, char *label, char *mods, char *arg)\r
3299{\r
3300 BOOL on;\r
3301\r
3302 // label is not entered into the symbol table\r
3303\r
3304 line_error = TRUE; // don't print the LIST statement\r
3305\r
3306 if (flist == NULL || ! list_on) {\r
3307 return;\r
3308 }\r
3309\r
3310 if (strcmpi(arg, "ON") == 0)\r
3311 on = TRUE;\r
3312 else if (strcmpi(arg, "OFF") == 0)\r
3313 on = FALSE;\r
3314 else\r
3315 on = do_list;\r
3316\r
3317 list_on = on;\r
3318}\r
3319\r
3320// ---------------------------------------------------------------------------------\r
3321// x_spac - SPAC directive. Put blank lines in listing\r
3322// ---------------------------------------------------------------------------------\r
3323\r
3324void x_spac (struct tag_op *op, char *label, char *mods, char *arg)\r
3325{\r
3326 EXPR expr;\r
3327\r
3328 // label is not entered into the symbol table\r
3329\r
3330 if (flist == NULL || ! list_on) {\r
3331 line_error = TRUE; // don't print the SPAC statement\r
3332 return;\r
3333 }\r
3334\r
3335 if (getexpr(arg, FALSE, &expr) != S_DEFINED)\r
3336 return;\r
3337\r
3338 line_error = TRUE; // don't print the statement\r
3339\r
3340 while (--expr.value >= 0) \r
3341 putc('\n', flist);\r
3342}\r
3343\r
3344// ---------------------------------------------------------------------------------\r
3345// x_ejct - EJCT directive - put formfeed in listing\r
3346// ---------------------------------------------------------------------------------\r
3347\r
3348void x_ejct (struct tag_op *op, char *label, char *mods, char *arg)\r
3349{\r
3350 // label is not entered into the symbol table\r
3351\r
3352 if (flist == NULL || ! list_on) {\r
3353 line_error = TRUE; // don't print the EJCT statement\r
3354 return;\r
3355 }\r
3356\r
3357 line_error = TRUE; // don't print the statement\r
3358\r
3359 putc('\f', flist);\r
3360}\r
3361\r
3362// ---------------------------------------------------------------------------------\r
3363// basic_opcode - construct a standard opcode value from op table entry and modifier chars\r
3364// ---------------------------------------------------------------------------------\r
3365\r
3366int basic_opcode (struct tag_op *op, char *mods)\r
3367{\r
3368 int opcode = op->opcode; // basic code value\r
3369\r
3370 if (strchr(mods, '1') != 0) // indexing\r
3371 opcode |= 0x0100;\r
3372 else if (strchr(mods, '2') != 0)\r
3373 opcode |= 0x0200;\r
3374 else if (strchr(mods, '3') != 0)\r
3375 opcode |= 0x0300;\r
3376\r
3377 if (strchr(mods, 'L')) { // two-word format\r
3378 opcode |= OP_LONG;\r
3379 if (strchr(mods, 'I') != 0) // and indirect to boot\r
3380 opcode |= OP_INDIRECT;\r
3381 }\r
3382\r
3383 return opcode;\r
3384}\r
3385\r
3386// ---------------------------------------------------------------------------------\r
3387// std_op - assemble a vanilla opcode\r
3388// ---------------------------------------------------------------------------------\r
3389\r
3390void std_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3391{\r
3392 EXPR expr;\r
3393 int opcode = basic_opcode(op, mods);\r
3394 BOOL val_ok = FALSE;\r
3395\r
3396 if (*label) // define label\r
3397 set_symbol(label, org, TRUE, relocate);\r
3398\r
3399 if (*arg && ! (op->flags & NO_ARGS)) { // get value argument\r
3400 if (getexpr(arg, FALSE, &expr) == S_DEFINED) \r
3401 val_ok = TRUE;\r
3402 }\r
3403 else {\r
3404 expr.value = 0;\r
3405 expr.relative = FALSE;\r
3406 }\r
3407\r
3408 if (opcode & OP_LONG) { // two-word format, just write code and value\r
3409 writew(opcode, FALSE);\r
3410 writew(expr.value, expr.relative);\r
3411 }\r
3412 else { // one-word format\r
3413 if (strchr(mods, 'I') != 0)\r
3414 asm_error("Indirect mode not permitted on one-word instructions");\r
3415\r
3416 if (val_ok && ! (strchr(mods, 'X') || (op->flags & IS_ABS) || ((opcode & OP_INDEXED) && ! (op->flags & NO_IDX))))\r
3417 expr.value -= (org+1); // compute displacement\r
3418\r
3419 if (expr.value < -128 || expr.value > 127) {// check range\r
3420 asm_error("Offset of %d is too large", expr.value);\r
3421 expr.value = 0;\r
3422 }\r
3423\r
3424 writew(opcode | (expr.value & 0x00FF), FALSE);// that's the code\r
3425 }\r
3426}\r
3427\r
3428// ---------------------------------------------------------------------------------\r
3429// mdx_op - assemble a MDX family instruction\r
3430// ---------------------------------------------------------------------------------\r
3431\r
3432void mdx_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3433{\r
3434 EXPR dest, incr = {0, FALSE};\r
3435 int opcode = basic_opcode(op, mods);\r
3436 char *tok;\r
3437\r
3438 if (*label) // define label\r
3439 set_symbol(label, org, TRUE, relocate);\r
3440\r
3441 if ((tok = strtok(arg, ",")) == NULL) { // argument format is dest[,increment]\r
3442// asm_error("Destination not specified"); // seems not to be an error, IBM omits it sometimes\r
3443 dest.value = 0;\r
3444 dest.relative = ABSOLUTE;\r
3445 }\r
3446 else\r
3447 getexpr(tok, FALSE, &dest); // parse the address\r
3448\r
3449 tok = strtok(NULL, ","); // look for second argument\r
3450\r
3451 if (opcode & OP_LONG) { // two word format\r
3452 if (opcode & OP_INDEXED) { // format: MDX 2 dest\r
3453 if (tok != NULL)\r
3454 asm_error("This format takes only one argument");\r
3455 }\r
3456 else { // format: MDX dest,increment\r
3457 if (opcode & OP_INDIRECT)\r
3458 asm_error("Indirect can't be used without indexing");\r
3459\r
3460 if (tok == NULL) {\r
3461// asm_error("This format takes two arguments");\r
3462 incr.value = 0;\r
3463 incr.relative = ABSOLUTE;\r
3464 }\r
3465 else \r
3466 getexpr(tok, FALSE, &incr);\r
3467\r
3468 if (incr.value < -128 || incr.value > 127) // displacement style (fixed in ver 1.08)\r
3469 asm_error("Invalid increment value (8 bits signed)");\r
3470\r
3471 opcode |= (incr.value & 0xFF);\r
3472 }\r
3473\r
3474 writew(opcode, ABSOLUTE);\r
3475 writew(dest.value, dest.relative);\r
3476 }\r
3477 else { // one word format MDX val\r
3478 if (tok != NULL)\r
3479 asm_error("This format takes only one argument");\r
3480\r
3481 if (! (strchr(mods, 'X') || (opcode & OP_INDEXED)))\r
3482 dest.value -= (org+1); // compute displacement\r
3483\r
3484 if (dest.value < -128 || dest.value > 127)\r
3485 asm_error("Offset/Increment of %d is too large", dest.value);\r
3486\r
3487 writew(opcode | (dest.value & 0xFF), FALSE);\r
3488 }\r
3489}\r
3490\r
3491// ---------------------------------------------------------------------------------\r
3492// bsi_op - BSI long instruction is like a BSC L, short is standard\r
3493// ---------------------------------------------------------------------------------\r
3494\r
3495void bsi_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3496{\r
3497 if (strchr(mods, 'L') || strchr(mods, 'I'))\r
3498 bsc_op(op, label, mods, arg);\r
3499 else\r
3500 std_op(op, label, mods, arg);\r
3501}\r
3502\r
3503// ---------------------------------------------------------------------------------\r
3504// b_op - branch; use short or long version\r
3505// --------------------------------------------------------------------------------\r
3506\r
3507void b_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3508{\r
3509 static struct tag_op *mdx = NULL;\r
3510\r
3511 if (strchr(mods, 'L') || strchr(mods, 'I')) {\r
3512 bsi_op(op, label, mods, arg); \r
3513 return;\r
3514 }\r
3515\r
3516 if (mdx == NULL)\r
3517 if ((mdx = lookup_op("MDX")) == NULL)\r
3518 bail("Can't find MDX op");\r
3519\r
3520 (mdx->handler)(mdx, label, mods, arg);\r
3521}\r
3522\r
3523// ---------------------------------------------------------------------------------\r
3524// bsc_op - compute a BSC family instruction\r
3525// ---------------------------------------------------------------------------------\r
3526\r
3527void bsc_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3528{\r
3529 EXPR dest;\r
3530 int opcode = basic_opcode(op, mods);\r
3531 char *tok, *tests;\r
3532\r
3533 if (*label) // define label\r
3534 set_symbol(label, org, TRUE, relocate);\r
3535\r
3536 if (opcode & OP_LONG) { // two word format\r
3537 if ((tok = strtok(arg, ",")) == NULL) { // format is BSC dest[,tests]\r
3538 asm_error("Destination not specified");\r
3539 dest.value = 0;\r
3540 dest.relative = ABSOLUTE;\r
3541 }\r
3542 else\r
3543 getexpr(tok, FALSE, &dest);\r
3544\r
3545 tests = strtok(NULL, ","); // get test characters\r
3546 }\r
3547 else\r
3548 tests = arg; // short format is BSC tests\r
3549\r
3550 if (tests != NULL) { // stick in the testing bits\r
3551 for (; *tests; tests++) {\r
3552 switch (*tests) {\r
3553 // bit 0x40 is the BOSC bit\r
3554 case 'Z': opcode |= 0x20; break;\r
3555 case '-': opcode |= 0x10; break;\r
3556 case '+':\r
3557 case '&': opcode |= 0x08; break;\r
3558 case 'E': opcode |= 0x04; break;\r
3559 case 'C': opcode |= 0x02; break;\r
3560 case 'O': opcode |= 0x01; break;\r
3561 default:\r
3562 asm_error("Invalid test flag: '%c'", *tests);\r
3563 }\r
3564 }\r
3565 }\r
3566\r
3567 writew(opcode, ABSOLUTE); // emit code\r
3568 if (opcode & OP_LONG)\r
3569 writew(dest.value, dest.relative);\r
3570}\r
3571\r
3572// ---------------------------------------------------------------------------------\r
3573// shf_op - assemble a shift instruction\r
3574// ---------------------------------------------------------------------------------\r
3575\r
3576void shf_op (struct tag_op *op, char *label, char *mods, char *arg)\r
3577{\r
3578 EXPR expr;\r
3579 int opcode = basic_opcode(op, mods);\r
3580\r
3581 if (*label) // define label\r
3582 set_symbol(label, org, TRUE, relocate);\r
3583\r
3584 if (opcode & OP_INDEXED) { // shift value comes from index register\r
3585 expr.value = 0;\r
3586 expr.relative = ABSOLUTE;\r
3587 }\r
3588 else\r
3589 getexpr(arg, FALSE, &expr);\r
3590\r
3591 if (expr.relative) {\r
3592 asm_error("Shift value is a relative address");\r
3593 expr.relative = ABSOLUTE;\r
3594 }\r
3595\r
3596 if (expr.value < 0 || expr.value > 32) { // check range\r
3597 asm_error("Shift count of %d is invalid", expr.value);\r
3598 expr.value = 0;\r
3599 }\r
3600\r
3601 writew(opcode | (expr.value & 0x3F), FALSE); // put shift count into displacement field\r
3602}\r
3603\r
3604// ---------------------------------------------------------------------------------\r
3605// x_mdm - MDM instruction\r
3606// ---------------------------------------------------------------------------------\r
3607\r
3608void x_mdm (struct tag_op *op, char *label, char *mods, char *arg)\r
3609{\r
3610 int opcode = basic_opcode(op, mods);\r
3611\r
3612 if (*label) // define label\r
3613 set_symbol(label, org, TRUE, relocate);\r
3614 // oh dear: bug here\r
3615 asm_error("'%s' is not yet supported", op->mnem);\r
3616}\r
3617\r
3618// ---------------------------------------------------------------------------------\r
3619// x_exit - EXIT directive. Assembler manual says it treats like CALL $EXIT, but\r
3620// object code reveals the truth: jump to $EXIT, which is a small value, so we can use LDX.\r
3621// ---------------------------------------------------------------------------------\r
3622\r
3623void x_exit (struct tag_op *op, char *label, char *mods, char *arg)\r
3624{\r
3625 char nline[120];\r
3626\r
3627 format_line(nline, label, "LDX", "X", DOLLAREXIT, "");\r
3628 parse_line(nline);\r
3629}\r
3630\r
3631// ---------------------------------------------------------------------------------\r
3632// x_opt - .OPT directive. Nonstandard. Possible values:\r
3633//\r
3634// .OPT CEXPR - use C precedence in evaluating expressions rather than strict left-right\r
3635// ---------------------------------------------------------------------------------\r
3636\r
3637void x_opt (struct tag_op *op, char *label, char *mods, char *arg)\r
3638{\r
3639 char *tok;\r
3640\r
3641 org_advanced = FALSE; // * means this address\r
3642\r
3643 if (*label) {\r
3644 asm_error("Label not permitted on .OPT statement");\r
3645 return;\r
3646 }\r
3647 // look for OPT arguments\r
3648 for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {\r
3649 if (strcmp(tok, "CEXPR") == 0) {\r
3650 cexpr = TRUE; // use C expression precedence (untested)\r
3651 }\r
3652 else\r
3653 asm_error("Unknown .OPT: '%s'", tok);\r
3654 }\r
3655}\r
3656\r
3657// ---------------------------------------------------------------------------------\r
3658// askip - skip input lines until a line with the target label appears\r
3659// ---------------------------------------------------------------------------------\r
3660\r
3661void askip (char *target)\r
3662{\r
3663 char nline[200], cur_label[20], *c;\r
3664\r
3665 while (get_line(nline, sizeof(nline), TRUE)) { // read next line (but don't exit a macro)\r
3666 listout(FALSE); // end listing of previous input line\r
3667\r
3668 prep_line(nline); // preform standard line prep\r
3669\r
3670 strncpy(cur_label, nline, 6); // get first 5 characters\r
3671 cur_label[5] = '\0';\r
3672\r
3673 for (c = cur_label; *c > ' '; c++) // truncate at first whitespace\r
3674 ;\r
3675 *c = '\0';\r
3676 // stop if there's a match\r
3677 if ((target == NULL) ? (cur_label[0] == '\0') : strcmp(target, cur_label) == 0) {\r
3678 parse_line(nline); // process this line\r
3679 return;\r
3680 }\r
3681 }\r
3682\r
3683 if (target != NULL)\r
3684 asm_error("Label %s not found", target);\r
3685}\r
3686\r
3687// ---------------------------------------------------------------------------------\r
3688// x_aif - process conditional assembly jump\r
3689// ---------------------------------------------------------------------------------\r
3690\r
3691void x_aif (struct tag_op *op, char *label, char *mods, char *arg)\r
3692{\r
3693 char *target, *tok;\r
3694 EXPR expr1, expr2;\r
3695 BOOL istrue;\r
3696 enum {OP_EQ, OP_LT, OP_GT, OP_NE, OP_LE, OP_GE} cmp_op;\r
3697\r
3698 // label is not entered into the symbol table\r
3699\r
3700 arg = skipbl(arg);\r
3701 if (*arg != '(') {\r
3702 asm_error("AIF operand must start with (");\r
3703 return;\r
3704 }\r
3705\r
3706 arg++; // skip the paren\r
3707\r
3708 // normally whitespace is never found in the arg string (see tabtok and coltok).\r
3709 // However, spaces inside parens are permitted. \r
3710\r
3711 if ((tok = strtok(arg, whitespace)) == NULL) {\r
3712 asm_error("AIF missing first expression");\r
3713 return;\r
3714 }\r
3715\r
3716 getexpr(tok, FALSE, &expr1);\r
3717\r
3718 if ((tok = strtok(NULL, whitespace)) == NULL) {\r
3719 asm_error("AIF missing conditional operator");\r
3720 return;\r
3721 }\r
3722\r
3723 if (strcmp(tok, "EQ") == 0)\r
3724 cmp_op = OP_EQ;\r
3725 else if (strcmp(tok, "LT") == 0)\r
3726 cmp_op = OP_LT;\r
3727 else if (strcmp(tok, "GT") == 0)\r
3728 cmp_op = OP_GT;\r
3729 else if (strcmp(tok, "NE") == 0)\r
3730 cmp_op = OP_NE;\r
3731 else if (strcmp(tok, "LE") == 0)\r
3732 cmp_op = OP_LE;\r
3733 else if (strcmp(tok, "GE") == 0)\r
3734 cmp_op = OP_GE;\r
3735 else {\r
3736 asm_error("AIF: %s is not a valid conditional operator", tok);\r
3737 return;\r
3738 }\r
3739\r
3740 if ((tok = strtok(NULL, ")")) == NULL) {\r
3741 asm_error("AIF missing second expression");\r
3742 return;\r
3743 }\r
3744\r
3745 getexpr(tok, FALSE, &expr2);\r
3746\r
3747 switch (cmp_op) { // test the condition\r
3748 case OP_EQ: istrue = expr1.value == expr2.value; break;\r
3749 case OP_LT: istrue = expr1.value < expr2.value; break;\r
3750 case OP_GT: istrue = expr1.value > expr2.value; break;\r
3751 case OP_NE: istrue = expr1.value != expr2.value; break;\r
3752 case OP_LE: istrue = expr1.value <= expr2.value; break;\r
3753 case OP_GE: istrue = expr1.value >= expr2.value; break;\r
3754 default: bail("in aif, can't happen");\r
3755 }\r
3756\r
3757 // After the closing paren coltok and tabtok guarantee we will have no whitespace\r
3758\r
3759 if ((target = strtok(arg, ",")) == NULL) // get target label\r
3760 asm_warning("Missing target label");\r
3761\r
3762 if (istrue)\r
3763 askip(target); // skip to the target\r
3764}\r
3765\r
3766// ---------------------------------------------------------------------------------\r
3767// x_aifb - conditional assembly jump back (macro only)\r
3768// ---------------------------------------------------------------------------------\r
3769\r
3770void x_aifb (struct tag_op *op, char *label, char *mods, char *arg)\r
3771{\r
3772 asm_error("aifb valid in macros only and not implemented in any case");\r
3773}\r
3774\r
3775// ---------------------------------------------------------------------------------\r
3776// x_ago \r
3777// ---------------------------------------------------------------------------------\r
3778\r
3779void x_ago (struct tag_op *op, char *label, char *mods, char *arg)\r
3780{\r
3781 char *target;\r
3782\r
3783 // label is not entered into the symbol table\r
3784\r
3785 // handle differently in a macro\r
3786\r
3787 if ((target = strtok(arg, ",")) == NULL) // get target label\r
3788 asm_warning("Missing target label");\r
3789\r
3790 askip(target); // skip to the target\r
3791}\r
3792\r
3793// ---------------------------------------------------------------------------------\r
3794// ---------------------------------------------------------------------------------\r
3795\r
3796void x_agob (struct tag_op *op, char *label, char *mods, char *arg)\r
3797{\r
3798 asm_error("agob valid in macros only and not implemented in any case");\r
3799}\r
3800\r
3801// ---------------------------------------------------------------------------------\r
3802// ---------------------------------------------------------------------------------\r
3803\r
3804void x_anop (struct tag_op *op, char *label, char *mods, char *arg)\r
3805{\r
3806 // label is not entered into the symbol table\r
3807 // do nothing else\r
3808}\r
3809\r
3810// ---------------------------------------------------------------------------------\r
3811// expression parser, borrowed from older code, no comments, sorry\r
3812// ---------------------------------------------------------------------------------\r
3813\r
3814char *exprptr, *oexprptr;\r
3815\r
3816#define GETNEXT (*exprptr++)\r
3817#define UNGET --exprptr\r
3818\r
3819#define LETTER 0 /* character types */\r
3820#define DIGIT 1\r
3821#define ETC 2\r
3822#define ILL 3\r
3823#define SPACE 4\r
3824#define MULOP 5\r
3825#define ADDOP 6\r
3826#define EXPOP 7\r
3827\r
3828int getnb (void);\r
3829void c_expr (EXPR *ap);\r
3830void c_expr_m (EXPR *ap);\r
3831void c_expr_e (EXPR *ap);\r
3832void c_expr_u (EXPR *ap);\r
3833void c_term (EXPR *ap);\r
3834int c_number (int c, int r, int nchar);\r
3835int digit (int c, int r);\r
3836int c_esc (int c);\r
3837void exprerr (int n);\r
3838void a1130_expr (EXPR *ap);\r
3839void a1130_term (EXPR *ap);\r
3840 \r
3841char ctype[128] = { // character types\r
3842/*^0ABCDEFG */ ILL, ILL, ILL, ILL, ILL, ILL, ILL, ILL,\r
3843/*^HIJKLMNO */ ILL, SPACE, SPACE, ILL, SPACE, SPACE, ILL, ILL,\r
3844/*^PQRSTUVW */ ILL, ILL, ILL, ILL, ILL, ILL, ILL, ILL,\r
3845/*^XYZ */ ILL, ILL, ILL, ILL, ILL, ILL, ILL, ILL,\r
3846/* !"#$%&' */ SPACE, ETC, ETC, LETTER, LETTER, MULOP, MULOP, LETTER, /* $ # @ and ' are letters here */\r
3847/* ()*+,-./ */ ETC, ETC, MULOP, ADDOP, ETC, ADDOP, ETC, MULOP,\r
3848/* 01234567 */ DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT,\r
3849/* 89:;<=>? */ DIGIT, DIGIT, ETC, ETC, MULOP, ETC, MULOP, ETC,\r
3850/* @ABCDEFG */ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3851/* HIJKLMNO */ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3852/* PQRSTUVW */ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3853/* XYZ[\]^_ */ LETTER, LETTER, LETTER, ETC, ETC, ETC, EXPOP, LETTER,\r
3854/* `abcdefg */ ETC, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3855/* hijklmno */ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3856/* pqrstuvw */ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,\r
3857/* xyz{|}~ */ LETTER, LETTER, LETTER, ETC, ADDOP, ETC, ETC, ETC\r
3858};\r
3859\r
3860char *errstr[] = {\r
3861 "Missing exponent", // 0\r
3862 "Undefined symbol", // 1\r
3863 "Division by zero", // 2\r
3864 "Illegal operator", // 3\r
3865 ") expected", // 4\r
3866 "Char expected after '", // 5\r
3867 "Char expected after .", // 6\r
3868 "Number expected after =", // 7\r
3869 "Syntax error", // 8\r
3870 "Number syntax", // 9\r
3871 "Char expected after \\", // 10\r
3872 "Relocation error" // 11\r
3873};\r
3874\r
3875int getnb () {\r
3876 int c;\r
3877\r
3878 if (cexpr) { // in C mode, handle normally\r
3879 while (ctype[(c = GETNEXT)] == SPACE)\r
3880 ;\r
3881 } // in 1130 mode, a space terminates the expression. Here, eat the rest\r
3882 else if ((c = GETNEXT) == ' ') {\r
3883 while ((c = GETNEXT) != '\0')\r
3884 ;\r
3885 }\r
3886\r
3887 return c;\r
3888}\r
3889\r
3890int symbest, exprerrno;\r
3891jmp_buf exprjmp;\r
3892\r
3893// ---------------------------------------------------------------------------------\r
3894// getexpr\r
3895// ---------------------------------------------------------------------------------\r
3896\r
3897int getexpr (char *pc, BOOL undefined_ok, EXPR *pval)\r
3898{\r
3899 symbest = S_DEFINED; // assume no questionable symbols\r
3900\r
3901 pval->value = 0;\r
3902 pval->relative = ABSOLUTE;\r
3903\r
3904 if (! *pc) // blank expression is same as zero, ok?\r
3905 return S_DEFINED;\r
3906\r
3907 if (setjmp(exprjmp) != 0) { // encountered a syntax error & bailed\r
3908 pval->value = 0;\r
3909 pval->relative = ABSOLUTE;\r
3910 return S_UNDEFINED;\r
3911 }\r
3912\r
3913 exprptr = oexprptr = pc; // make global the buffer pointer\r
3914\r
3915 c_expr(pval);\r
3916\r
3917 if (GETNEXT) // expression should have been entirely eaten\r
3918 exprerr(8); // if characters are left, it's an error\r
3919\r
3920 if (pval->relative < 0 || pval->relative > 1)\r
3921 exprerr(11); // has to work out to an absolute or a single relative term\r
3922\r
3923 if (symbest == S_DEFINED) // tell how it came out\r
3924 return S_DEFINED;\r
3925\r
3926 pval->value = 0;\r
3927 pval->relative = ABSOLUTE;\r
3928 return (pass == 1 && undefined_ok) ? S_PROVISIONAL : S_UNDEFINED;\r
3929}\r
3930\r
3931// ---------------------------------------------------------------------------------\r
3932// output_literals - construct .DC assembler lines to assemble pending literal\r
3933// constant values that have accumulated.\r
3934// ---------------------------------------------------------------------------------\r
3935\r
3936void output_literals (BOOL eof)\r
3937{\r
3938 char line[120], label[12], num[20];\r
3939 int i;\r
3940\r
3941 for (i = 0; i < n_literals; i++) { // generate DC statements for any pending literal constants\r
3942 if (literal[i].even && literal[i].hex) // create the value string\r
3943 sprintf(num, "/%08lx", literal[i].value);\r
3944 else if (literal[i].even)\r
3945 sprintf(num, "%ld", literal[i].value);\r
3946 else if (literal[i].hex)\r
3947 sprintf(num, "/%04x", literal[i].value & 0xFFFF);\r
3948 else\r
3949 sprintf(num, "%d", literal[i].value);\r
3950\r
3951 sprintf(label, "_L%03d", literal[i].tagno);\r
3952 format_line(line, label, literal[i].even ? "DEC" : "DC", "", num, "GENERATED LITERAL CONSTANT");\r
3953\r
3954 if (eof) {\r
3955 eof = FALSE; // at end of file, for first literal, only prepare blank line\r
3956 sprintf(listline, LEFT_MARGIN, org);\r
3957 }\r
3958 else\r
3959 listout(TRUE); // push out any pending line(s)\r
3960\r
3961 if (flist && list_on) // this makes stuff appear in the listing\r
3962 sprintf(listline, LEFT_MARGIN " %s", detab(line));\r
3963\r
3964 nwout = 0;\r
3965\r
3966 parse_line(line); // assemble the constant definition\r
3967 }\r
3968\r
3969 n_literals = 0; // clear list\r
3970}\r
3971\r
3972// ---------------------------------------------------------------------------------\r
3973// a1130_term - extract one term of an expression\r
3974// ---------------------------------------------------------------------------------\r
3975\r
3976void a1130_term (EXPR *ap)\r
3977{\r
3978 PSYMBOL s;\r
3979 char token[80], *t;\r
3980 int c;\r
3981\r
3982 if (cexpr) { // use C syntax\r
3983 c_term(ap);\r
3984 return;\r
3985 }\r
3986\r
3987 c = GETNEXT;\r
3988\r
3989 if (ctype[c] == DIGIT) { /* number */\r
3990 ap->value = signextend(c_number(c,10,-1));\r
3991 ap->relative = ABSOLUTE;\r
3992 }\r
3993 else if (c == '+') { /* unary + */\r
3994 a1130_term(ap);\r
3995 }\r
3996 else if (c == '-') { /* unary - */\r
3997 a1130_term(ap);\r
3998 ap->value = - ap->value;\r
3999 }\r
4000 else if (c == '/') { /* / starts a hex constant */\r
4001 ap->value = signextend(c_number(c,16,-1));\r
4002 ap->relative = ABSOLUTE;\r
4003 }\r
4004 else if (c == '*') { /* asterisk alone = org */\r
4005 ap->value = org + org_advanced; // here is where that offset matters!\r
4006 ap->relative = relocate;\r
4007 }\r
4008 else if (c == '.') { /* EBCDIC constant */\r
4009 c = GETNEXT;\r
4010 if (c == '\0') {\r
4011 UNGET;\r
4012 c = ' ';\r
4013 }\r
4014 c = ascii_to_ebcdic_table[c];\r
4015 ap->value = c; // VALUE IS IN LOW BYTE!!!\r
4016 ap->relative = ABSOLUTE;\r
4017 }\r
4018 else if (ctype[c] == LETTER) { /* symbol */\r
4019 t = token;\r
4020 do {\r
4021 *t++ = c;\r
4022 c = GETNEXT;\r
4023 } while (ctype[c] == LETTER || ctype[c] == DIGIT);\r
4024 UNGET;\r
4025 *t++ = '\0';\r
4026\r
4027 s = lookup_symbol(token, TRUE);\r
4028 add_xref(s, FALSE);\r
4029 ap->value = s->value;\r
4030 ap->relative = s->relative;\r
4031\r
4032 symbest = MIN(symbest, s->defined); // this goes to lowest value (undefined < provisional < defined)\r
4033 if (pass == 2 && s->defined != S_DEFINED)\r
4034 exprerr(1);\r
4035 }\r
4036 else\r
4037 exprerr(8);\r
4038}\r
4039\r
4040// ---------------------------------------------------------------------------------\r
4041// signextend - sign-extend a 16-bit constant value to whatever "int" is.\r
4042// ---------------------------------------------------------------------------------\r
4043\r
4044int signextend (int v)\r
4045{\r
4046 v &= 0xFFFF; // clip to 16 bits (this may not be necessary, but best to be safe?)\r
4047\r
4048 if (v & 0x8000) // if sign bit is set\r
4049 v |= ~0xFFFF; // sign extend\r
4050\r
4051 return v;\r
4052}\r
4053\r
4054// ---------------------------------------------------------------------------------\r
4055// c_expr - evalate an expression\r
4056// ---------------------------------------------------------------------------------\r
4057\r
4058void c_expr (EXPR *ap)\r
4059{\r
4060 int c;\r
4061 EXPR rop;\r
4062\r
4063 c_expr_m(ap); // get combined multiplicative terms\r
4064 for (;;) { // handle +/- precedence operators\r
4065 if (ctype[c=getnb()] != ADDOP) {\r
4066 UNGET;\r
4067 break;\r
4068 }\r
4069 c_expr_m(&rop); // right hand operand\r
4070 switch (c) {\r
4071 case '+':\r
4072 ap->value += rop.value;\r
4073 ap->relative += rop.relative;\r
4074 break;\r
4075\r
4076 case '-':\r
4077 ap->value -= rop.value;\r
4078 ap->relative -= rop.relative;\r
4079 break;\r
4080\r
4081 case '|':\r
4082 if (ap->relative || rop.relative)\r
4083 exprerr(11);\r
4084 ap->value = ((long) (ap->value)) | ((long) rop.value);\r
4085 break;\r
4086\r
4087 default:\r
4088 printf("In expr, can't happen\n");\r
4089 }\r
4090 }\r
4091}\r
4092\r
4093// ---------------------------------------------------------------------------------\r
4094// c_expr_m - get multiplicative precedence terms. Again, this is not usually used\r
4095// ---------------------------------------------------------------------------------\r
4096\r
4097void c_expr_m (EXPR *ap)\r
4098{\r
4099 int c;\r
4100 EXPR rop;\r
4101\r
4102 c_expr_e(ap); // get exponential precedence term\r
4103 for (;;) { // get operator\r
4104 c = getnb();\r
4105 if ((c=='<') || (c=='>'))\r
4106 if (c != getnb()) // << or >>\r
4107 exprerr(3);\r
4108 if (ctype[c] != MULOP) {\r
4109 UNGET;\r
4110 break;\r
4111 }\r
4112 c_expr_e(&rop); // right hand operand\r
4113\r
4114 switch(c) {\r
4115 case '*':\r
4116 if (ap->relative && rop.relative)\r
4117 exprerr(11);\r
4118\r
4119 ap->value *= rop.value;\r
4120 ap->relative = (ap->relative || rop.relative) ? RELATIVE : ABSOLUTE;\r
4121 break;\r
4122\r
4123 case '/':\r
4124 if (rop.value == 0)\r
4125 exprerr(2);\r
4126 if (ap->relative || rop.relative)\r
4127 exprerr(11);\r
4128\r
4129 ap->value /= rop.value;\r
4130 break;\r
4131\r
4132 case '%':\r
4133 if (rop.value == 0)\r
4134 exprerr(2);\r
4135 if (ap->relative || rop.relative)\r
4136 exprerr(11);\r
4137\r
4138 ap->value = ((long) (ap->value)) % ((long) rop.value);\r
4139 break;\r
4140\r
4141 case '&':\r
4142 if (ap->relative || rop.relative)\r
4143 exprerr(11);\r
4144\r
4145 ap->value = ((long) (ap->value)) & ((long) rop.value);\r
4146 break;\r
4147\r
4148 case '>':\r
4149 if (ap->relative || rop.relative)\r
4150 exprerr(11);\r
4151\r
4152 ap->value = ((long) (ap->value)) >> ((long) rop.value);\r
4153 break;\r
4154\r
4155 case '<':\r
4156 if (ap->relative || rop.relative)\r
4157 exprerr(11);\r
4158\r
4159 ap->value = ((long) (ap->value)) << ((long) rop.value);\r
4160 break;\r
4161\r
4162 default:\r
4163 printf("In expr_m, can't happen\n");\r
4164 }\r
4165 }\r
4166}\r
4167\r
4168// ---------------------------------------------------------------------------------\r
4169// c_expr_e - get exponential precedence terms. Again, this is not usually used\r
4170// ---------------------------------------------------------------------------------\r
4171\r
4172void c_expr_e (EXPR *ap)\r
4173{\r
4174 int c, i, v;\r
4175 EXPR rop;\r
4176\r
4177 c_expr_u(ap);\r
4178 for (;;) {\r
4179 c = getnb();\r
4180 if (ctype[c] != EXPOP) {\r
4181 UNGET;\r
4182 break;\r
4183 }\r
4184 c_expr_u(&rop);\r
4185\r
4186 switch(c) {\r
4187 case '^':\r
4188 if (ap->relative || rop.relative)\r
4189 exprerr(11);\r
4190\r
4191 v = ap->value;\r
4192 ap->value = 1;\r
4193 for (i = 0; i < rop.value; i++)\r
4194 ap->value *= v;\r
4195 break;\r
4196\r
4197 default:\r
4198 printf("In expr_e, can't happen\n");\r
4199 }\r
4200 }\r
4201}\r
4202\r
4203// ---------------------------------------------------------------------------------\r
4204// c_expr_u - get unary precedence terms. Again, this is not usually used\r
4205// ---------------------------------------------------------------------------------\r
4206\r
4207void c_expr_u (EXPR *ap)\r
4208{\r
4209 int c;\r
4210\r
4211 if ((c = getnb()) == '!') {\r
4212 a1130_term(ap);\r
4213 ap->value = ~ ((long)(ap->value));\r
4214 if (ap->relative)\r
4215 exprerr(11);\r
4216 }\r
4217 else if (c == '-') {\r
4218 a1130_term(ap);\r
4219 ap->value = - ap->value;\r
4220 if (ap->relative)\r
4221 exprerr(11);\r
4222 }\r
4223 else {\r
4224 UNGET;\r
4225 a1130_term(ap);\r
4226 }\r
4227}\r
4228\r
4229// ---------------------------------------------------------------------------------\r
4230// c_term - get basic operand or parenthesized expression. Again, this is not usually used\r
4231// ---------------------------------------------------------------------------------\r
4232\r
4233void c_term (EXPR *ap)\r
4234{\r
4235 int c, cc;\r
4236 PSYMBOL s;\r
4237 char token[80], *t;\r
4238\r
4239 ap->relative = ABSOLUTE; /* assume absolute */\r
4240\r
4241 if ((c = getnb()) == '(') { /* parenthesized expr */\r
4242 c_expr(ap); /* start over at the top! */\r
4243 if ((cc = getnb()) != ')')\r
4244 exprerr(4);\r
4245 }\r
4246 else if (c == '\'') { /* single quote: char */\r
4247 if ((c = GETNEXT) == '\0')\r
4248 c = ' ';\r
4249 ap->value = c_esc(c);\r
4250 }\r
4251 else if (ctype[c] == DIGIT) { /* number */\r
4252 ap->value = signextend(c_number(c,10,-1));\r
4253 }\r
4254 else if (c == '0') { /* 0 starts a hex or octal constant */\r
4255 if ((c = GETNEXT) == 'x') {\r
4256 c = GETNEXT;\r
4257 ap->value = signextend(c_number(c,16,-1));\r
4258 }\r
4259 else {\r
4260 ap->value = signextend(c_number(c,8,-1));\r
4261 }\r
4262 }\r
4263 else if (c == '*') { /* asterisk alone = org */\r
4264 ap->value = org + org_advanced;\r
4265 ap->relative = relocate;\r
4266 }\r
4267 else if (ctype[c] == LETTER) { /* symbol */\r
4268 t = token;\r
4269 do {\r
4270 *t++ = c;\r
4271 c = GETNEXT;\r
4272 } while (ctype[c] == LETTER || ctype[c] == DIGIT);\r
4273 UNGET;\r
4274 *t++ = '\0';\r
4275\r
4276 s = lookup_symbol(token, TRUE);\r
4277 ap->value = s->value;\r
4278 ap->relative = s->relative;\r
4279 add_xref(s, FALSE);\r
4280 symbest = MIN(symbest, s->defined); // this goes to lowest value (undefined < provisional < defined)\r
4281\r
4282 if (pass == 2 && s->defined != S_DEFINED)\r
4283 exprerr(1);\r
4284 }\r
4285 else\r
4286 exprerr(8);\r
4287}\r
4288\r
4289// ---------------------------------------------------------------------------------\r
4290// c_number - get a C format constant value. Again, this is not usually used\r
4291// ---------------------------------------------------------------------------------\r
4292\r
4293int c_number (int c, int r, int nchar)\r
4294{\r
4295 int v, n;\r
4296\r
4297 nchar--;\r
4298\r
4299 if (c == '/' && ! cexpr) { /* special radix stuff */\r
4300 r = 16;\r
4301 c = GETNEXT;\r
4302 }\r
4303 else if (r == 10 && c == '0' && cexpr) { /* accept C style 0x## also */\r
4304 c = GETNEXT;\r
4305 if (c == 'x') {\r
4306 r = 16;\r
4307 c = GETNEXT;\r
4308 }\r
4309 else {\r
4310 r = 8;\r
4311 UNGET;\r
4312 c = '0';\r
4313 }\r
4314 }\r
4315\r
4316 n = 0; /* decode number */\r
4317 while ((nchar-- != 0) && (v = digit(c, r)) >= 0) {\r
4318 if (v >= r) /* out of range! */\r
4319 exprerr(9);\r
4320\r
4321 n = r*n + v;\r
4322\r
4323 c = GETNEXT;\r
4324 if (c == '.') { // maybe make it decimal?\r
4325 c = GETNEXT;\r
4326 break;\r
4327 }\r
4328 }\r
4329\r
4330 UNGET;\r
4331 return (n);\r
4332}\r
4333\r
4334// ---------------------------------------------------------------------------------\r
4335// digit - get digit value of character c in radix r\r
4336// ---------------------------------------------------------------------------------\r
4337\r
4338int digit (int c, int r)\r
4339{\r
4340 if (r == 16) {\r
4341 if (c >= 'A' && c <= 'F')\r
4342 return (c - 'A' + 10);\r
4343 }\r
4344\r
4345 if (c >= '0' && c <= '9')\r
4346 return (c - '0');\r
4347\r
4348 return (-1);\r
4349}\r
4350\r
4351// ---------------------------------------------------------------------------------\r
4352// c_esc - handle C character escape\r
4353// ---------------------------------------------------------------------------------\r
4354\r
4355int c_esc (int c)\r
4356{\r
4357 if (c != '\\') /* not escaped */\r
4358 return(c);\r
4359\r
4360 if ((c = GETNEXT) == '\0') /* must be followed by something */\r
4361 exprerr(10);\r
4362 if ((c >= 'A') && (c <= 'Z')) /* handle upper case */\r
4363 c += 'a'-'A';\r
4364 if (ctype[c] == LETTER) /* control character abbrevs */\r
4365 switch (c) {\r
4366 case 'b': c = '\b'; break; /* backspace */\r
4367 case 'e': c = 27 ; break; /* escape */\r
4368 case 'f': c = '\f'; break; /* formfeed */\r
4369 case 'n': c = '\n'; break; /* newline */\r
4370 case 'r': c = '\r'; break; /* return */\r
4371 case 't': c = '\t'; break; /* horiz. tab */\r
4372 }\r
4373 else if (ctype[c] == DIGIT) { /* get character by the numbers */\r
4374 c = c_number(c,8,3); /* force octal */\r
4375 }\r
4376\r
4377 return c;\r
4378}\r
4379\r
4380// ---------------------------------------------------------------------------------\r
4381// exprerr - note an expression syntax error. Longjumps back to caller with failure code\r
4382// ---------------------------------------------------------------------------------\r
4383\r
4384void exprerr (int n)\r
4385{\r
4386 char msg[256];\r
4387 int nex = exprptr-oexprptr;\r
4388\r
4389 strncpy(msg, oexprptr, nex); // show where the problem was\r
4390 msg[nex] = '\0';\r
4391 strcat(msg, " << ");\r
4392 strcat(msg, errstr[n]);\r
4393\r
4394 asm_error(msg);\r
4395\r
4396 exprerrno = n;\r
4397 longjmp(exprjmp, 1);\r
4398}\r
4399\r
4400/* ------------------------------------------------------------------------ \r
4401 * upcase - force a string to uppercase (ASCII)\r
4402 * ------------------------------------------------------------------------ */\r
4403\r
4404char *upcase (char *str)\r
4405{\r
4406 char *s;\r
4407\r
4408 for (s = str; *s; s++) {\r
4409 if (*s >= 'a' && *s <= 'z')\r
4410 *s -= 32;\r
4411 } \r
4412\r
4413 return str;\r
4414}\r
4415\r
4416/* ------------------------------------------------------------------------ \r
4417 * hollerith table for IPL card ident field\r
4418 * ------------------------------------------------------------------------ */\r
4419\r
4420typedef struct {\r
4421 int hollerith;\r
4422 char ascii;\r
4423} CPCODE;\r
4424\r
4425static CPCODE cardcode_029[] =\r
4426{\r
4427 0x0000, ' ',\r
4428 0x8000, '&', // + in 026 Fortran\r
4429 0x4000, '-',\r
4430 0x2000, '0',\r
4431 0x1000, '1',\r
4432 0x0800, '2',\r
4433 0x0400, '3',\r
4434 0x0200, '4',\r
4435 0x0100, '5',\r
4436 0x0080, '6',\r
4437 0x0040, '7',\r
4438 0x0020, '8',\r
4439 0x0010, '9',\r
4440 0x9000, 'A',\r
4441 0x8800, 'B',\r
4442 0x8400, 'C',\r
4443 0x8200, 'D',\r
4444 0x8100, 'E',\r
4445 0x8080, 'F',\r
4446 0x8040, 'G',\r
4447 0x8020, 'H',\r
4448 0x8010, 'I',\r
4449 0x5000, 'J',\r
4450 0x4800, 'K',\r
4451 0x4400, 'L',\r
4452 0x4200, 'M',\r
4453 0x4100, 'N',\r
4454 0x4080, 'O',\r
4455 0x4040, 'P',\r
4456 0x4020, 'Q',\r
4457 0x4010, 'R',\r
4458 0x3000, '/',\r
4459 0x2800, 'S',\r
4460 0x2400, 'T',\r
4461 0x2200, 'U',\r
4462 0x2100, 'V',\r
4463 0x2080, 'W',\r
4464 0x2040, 'X',\r
4465 0x2020, 'Y',\r
4466 0x2010, 'Z',\r
4467 0x0820, ':',\r
4468 0x0420, '#', // = in 026 Fortran\r
4469 0x0220, '@', // ' in 026 Fortran\r
4470 0x0120, '\'',\r
4471 0x00A0, '=',\r
4472 0x0060, '"',\r
4473 0x8820, 'c', // cent\r
4474 0x8420, '.',\r
4475 0x8220, '<', // ) in 026 Fortran\r
4476 0x8120, '(',\r
4477 0x80A0, '+',\r
4478 0x8060, '|',\r
4479 0x4820, '!',\r
4480 0x4420, '$',\r
4481 0x4220, '*',\r
4482 0x4120, ')',\r
4483 0x40A0, ';',\r
4484 0x4060, 'n', // not\r
4485 0x2820, 'x', // what?\r
4486 0x2420, ',',\r
4487 0x2220, '%', // ( in 026 Fortran\r
4488 0x2120, '_',\r
4489 0x20A0, '>',\r
4490 0x2060, '>',\r
4491};\r
4492\r
4493int ascii_to_hollerith (int ch)\r
4494{\r
4495 int i;\r
4496\r
4497 for (i = 0; i < sizeof(cardcode_029) / sizeof(CPCODE); i++)\r
4498 if (cardcode_029[i].ascii == ch)\r
4499 return cardcode_029[i].hollerith;\r
4500\r
4501 return 0;\r
4502}\r
4503\r
4504/* ------------------------------------------------------------------------ \r
4505 * detab - replace tabs with spaces for listing files\r
4506 * ------------------------------------------------------------------------ */\r
4507\r
4508char *detab (char *instr)\r
4509{\r
4510 static char outstr[256];\r
4511 char *out = outstr;\r
4512 int col = 0;\r
4513\r
4514 while (*instr) {\r
4515 if (*instr == '\t') {\r
4516 do {\r
4517 *out++ = ' ';\r
4518 col++;\r
4519 }\r
4520 while (col & 7);\r
4521 }\r
4522 else {\r
4523 *out++ = *instr;\r
4524 col++;\r
4525 }\r
4526\r
4527 instr++;\r
4528 }\r
4529 \r
4530 *out = '\0';\r
4531\r
4532 return outstr;\r
4533}\r
4534\r
4535#ifndef _WIN32\r
4536\r
4537int strnicmp (char *a, char *b, int n)\r
4538{\r
4539 int ca, cb;\r
4540\r
4541 for (;;) {\r
4542 if (--n < 0) // still equal after n characters? quit now\r
4543 return 0;\r
4544\r
4545 if ((ca = *a) == 0) // get character, stop on null terminator\r
4546 return *b ? -1 : 0;\r
4547\r
4548 if (ca >= 'a' && ca <= 'z') // fold lowercase to uppercase\r
4549 ca -= 32;\r
4550\r
4551 cb = *b;\r
4552 if (cb >= 'a' && cb <= 'z')\r
4553 cb -= 32;\r
4554\r
4555 if ((ca -= cb) != 0) // if different, return comparison\r
4556 return ca;\r
4557\r
4558 a++, b++;\r
4559 }\r
4560}\r
4561\r
4562int strcmpi (char *a, char *b)\r
4563{\r
4564 int ca, cb;\r
4565\r
4566 for (;;) {\r
4567 if ((ca = *a) == 0) // get character, stop on null terminator\r
4568 return *b ? -1 : 0;\r
4569\r
4570 if (ca >= 'a' && ca <= 'z') // fold lowercase to uppercase\r
4571 ca -= 32;\r
4572\r
4573 cb = *b;\r
4574 if (cb >= 'a' && cb <= 'z')\r
4575 cb -= 32;\r
4576\r
4577 if ((ca -= cb) != 0) // if different, return comparison\r
4578 return ca;\r
4579\r
4580 a++, b++;\r
4581 }\r
4582}\r
4583\r
4584#endif\r
4585\r
Magically enhanced SIMH