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