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
8 * This is not a supported product, but I welcome bug reports and fixes.
9 * Mail to sim@ibm1130.org
12 #define VERSION "ASM1130 CROSS ASSEMBLER V1.14"
14 // ---------------------------------------------------------------------------------
15 // ASM1130 - IBM 1130 Cross Assembler
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
35 // 1.09 - 2003Aug03 - Added fxwrite so asm will write little-endian files
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 // ---------------------------------------------------------------------------------
59 // asm1130 [-bvsx] [-o[file]] [-l[file]] [-rN.M] file...
62 // -b binary output (.bin, relocatable absolute format)
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
73 // Listing and symbol table output can be turned on by *LIST directives in the source, too
74 // Listing file default extension is .LST
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.
79 // Strict specification is:
81 // label columns 1 - 5
87 // Loose, indicated by presence of ascii tab character(s):
89 // label<tab>opcode<tab>index and format indicators<tab>arguments
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!
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:
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
102 // Output file default extension is .OUT or .BIN for binary assemblies
104 // Note: this version does not handle relative assembly, and so doesn't carry
105 // absolute/relative indication through expression calculation.
107 // Seems to work. Was able to assemble the resident monitor OK.
108 // >>> Look for "bug here" though, for things to check out.
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.
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.
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 // ---------------------------------------------------------------------------------
135 // ---------------------------------------------------------------1------------------
137 // ---------------------------------------------------------------------------------
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
144 # include <unistd.h> /* to pick up 'unlink' */
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))
152 int strnicmp (char *a
, char *b
, int n
);
153 int strcmpi (char *a
, char *b
);
158 #define DMSVERSION "V2M12" /* required 5 characters on sector break card col 67-71 */
160 #define DOLLAREXIT "/38" // hmmm, are these really fixed absolutely in all versions?
161 #define DOLLARDUMP "/3F"
163 #define SYSTEM_TABLE "SYMBOLS.SYS"
169 #define ISTV 0x33 // magic number from DMS R2V12 monitorm symbol @ISTV
171 #define MAXLITERALS 300
172 #define MAXENTRIES 14
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
181 typedef enum {ABSOLUTE
= 0, RELATIVE
= 1, LIBF
= 2, CALL
= 3} RELOC
;
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
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
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
204 typedef struct tag_expr
{ // expression result: absolute or relative
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
;
212 typedef enum {SUBTYPE_INCORE
= 0, SUBTYPE_FORDISK
= 1, SUBTYPE_ARITH
= 2,
213 SUBTYPE_FORNONDISK
= 3, SUBTYPE_FUNCTION
=8} SUBTYPE
;
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
;
218 #define OP_INDEXED 0x0300 // 1130 opcode modifier bits
219 #define OP_LONG 0x0400
220 #define OP_INDIRECT 0x0080
222 typedef enum {OUTMODE_LOAD
, OUTMODE_1130
, OUTMODE_1800
, OUTMODE_BINARY
} OUTMODE
;
225 # define OUTWRITEMODE "wb" // write outfile in binary mode
226 # define ENDLINE "\r\n" // explictly write CR/LF
228 # define OUTWRITEMODE "w" // use native mode
229 # define ENDLINE "\n"
232 // ---------------------------------------------------------------------------------
234 // ---------------------------------------------------------------------------------
236 // command line syntax
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"
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)
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
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
300 int ndefined_files
= 0;
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
];
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 '
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
317 int ascii_to_ebcdic_table
[128] =
320 0x00,0x01,0x02,0x03,0x37,0x2d,0x2e,0x2f, 0x16,0x05,0x25,0x0b,0x0c,0x0d,0x0e,0x0f,
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,
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
349 #include "../ibm1130_conout.h" /* conout_to_ascii_table */
350 #include "../ibm1130_prtwheel.h" /* 1132 printer printwheel data */
352 // ---------------------------------------------------------------------------------
354 // ---------------------------------------------------------------------------------
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);
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
);
397 // ---------------------------------------------------------------------------------
399 // ---------------------------------------------------------------------------------
401 int main (int argc
, char **argv
)
403 int i
, sawfile
= FALSE
;
405 init(argc
, argv
); // initialize, process flags
407 startpass(1); // first pass, process files
409 for (i
= 1; i
< argc
; i
++)
411 proc(argv
[i
]), sawfile
= TRUE
;
413 if (! sawfile
) // should have seen at least one file
421 startpass(2); // second pass, process files again
423 for (i
= 1; i
< argc
; i
++)
427 if (outmode
== OUTMODE_LOAD
) {
428 if (pta
>= 0) // write start address to the load file
429 fprintf(fout
, "=%04x" ENDLINE
, pta
& 0xFFFF);
435 if (nerrors
|| nwarnings
) { // summarize (or summarise)
437 fprintf(flist
, "There %s ", (nwarnings
== 1) ? "was" : "were");
439 fprintf(flist
, "\nThere %s %d error%s %s",
440 (nerrors
== 1) ? "was" : "were", nerrors
, (nerrors
== 1) ? "" : "s", nwarnings
? "and " : "");
443 fprintf(flist
, "%d warning%s ", nwarnings
, (nwarnings
== 1) ? "" : "s");
445 fprintf(flist
, "in this assembly\n");
448 fprintf(flist
, "\nThere were no errors in this assembly\n");
451 if (flist
) { // finish the listing
453 fprintf(flist
, "\nProgram transfer address = %04x\n", pta
);
464 return 0; // all done
467 // ---------------------------------------------------------------------------------
468 // init - initialize assembler, process command line flags
469 // ---------------------------------------------------------------------------------
471 void init (int argc
, char **argv
)
475 enable_1800
= strstr(argv
[0], "1800") != NULL
; // if "1800" appears in the executable name, enable 1800 extensions
477 for (i
= 1; i
< argc
; i
++) // process command line switches
482 // ---------------------------------------------------------------------------------
483 // flag - process one command line switch
484 // ---------------------------------------------------------------------------------
486 void flag (char *arg
)
492 case 'o': // output (load) file name
502 case 'v': // mumble while running
506 case 'x': // print cross reference table
510 case 's': // print symbol table
514 case 'l': // listing file name
515 listfn
= (* arg
) ? arg
: NULL
;
531 outmode
= OUTMODE_BINARY
;
539 if (sscanf(arg
, "%d.%d", &major
, &minor
) != 2)
541 sprintf(dmsversion
, "V%01.1dM%02.2d", major
, minor
);
551 // ---------------------------------------------------------------------------------
552 // bail - print error message on stderr (only) and exit
553 // ---------------------------------------------------------------------------------
555 void bail (char *msg
)
557 fprintf(stderr
, "%s\n", msg
);
561 // ---------------------------------------------------------------------------------
562 // errprintf - print error message to stderr
563 // ---------------------------------------------------------------------------------
565 void errprintf (char *fmt
, ...)
569 va_start(args
, fmt
); // get pointer to argument list
571 vfprintf(stderr
, fmt
, args
); // write errors to terminal (stderr)
576 // ---------------------------------------------------------------------------------
577 // asm_error - report an error to listing file and to user's console
578 // ---------------------------------------------------------------------------------
580 void asm_error (char *fmt
, ...)
584 if (pass
== 1) // only print on pass 2
587 va_start(args
, fmt
); // get pointer to argument list
589 fprintf(stderr
, "E: %s (%d): ", curfn
, lno
);
590 vfprintf(stderr
, fmt
, args
); // write errors to terminal (stderr)
593 if (flist
!= NULL
&& list_on
) {
597 fprintf(flist
, "**** Error: ");
598 vfprintf(flist
, fmt
, args
); // write errors to listing file
606 // ---------------------------------------------------------------------------------
607 // asm_warning - same but warnings are not counted
608 // ---------------------------------------------------------------------------------
610 void asm_warning (char *fmt
, ...)
614 if (pass
== 1) // only print on pass 2
617 va_start(args
, fmt
); // get pointer to argument list
619 fprintf(stderr
, "W: %s (%d): ", curfn
, lno
);
620 vfprintf(stderr
, fmt
, args
); // write errors to terminal (stderr)
623 if (flist
!= NULL
&& list_on
) {
627 fprintf(flist
, "**** Warning: ");
628 vfprintf(flist
, fmt
, args
); // write errors to listing file
635 // ---------------------------------------------------------------------------------
636 // sym_list - print the symbol table
637 // ---------------------------------------------------------------------------------
644 if (symbols
== NULL
|| flist
== NULL
)
647 fprintf(flist
, "\n=== SYMBOL TABLE ==============================================================\n");
649 for (s
= symbols
, n
= 0; s
!= NULL
; s
= s
->next
) {
657 fprintf(flist
, "%-6s ", s
->name
);
658 if (s
->defined
== S_DEFINED
)
659 fprintf(flist
, "%04x%s", s
->value
& 0xFFFF, s
->relative
? "R" : " ");
661 fprintf(flist
, "UUUU ");
665 fprintf(flist
, "\n");
668 // ---------------------------------------------------------------------------------
669 // passreport - report # of passes required for assembly on the 1130
670 // ---------------------------------------------------------------------------------
672 void passreport (void)
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");
684 printf("There are forward references. Two passes are required.\n");
686 printf("There are no forward references. Only one pass is required.\n");
689 // ---------------------------------------------------------------------------------
690 // xref_list - print the cross-reference table
691 // ---------------------------------------------------------------------------------
693 void xref_list (void)
699 if (flist
== NULL
|| symbols
== NULL
)
702 fprintf(flist
, "\n=== CROSS REFERENCES ==========================================================\n");
704 if (symbols
== NULL
|| flist
== NULL
)
707 fprintf(flist
, "Name Val Defd Referenced\n");
709 for (s
= symbols
; s
!= NULL
; s
= s
->next
) {
710 fprintf(flist
, "%-5s %04x%s", s
->name
, s
->value
& 0xFFFF, s
->relative
? "R" : " ");
712 for (x
= s
->xrefs
; x
!= NULL
; x
= x
->next
)
717 fprintf(flist
, "----");
719 fprintf(flist
, " %4d", x
->lno
);
721 for (n
= 0, x
= s
->xrefs
; x
!= NULL
; x
= x
->next
) {
727 fprintf(flist
, "\n ");
729 fprintf(flist
, " %4d", x
->lno
);
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 // ---------------------------------------------------------------------------------
746 fprintf(flist
, "%s -- %s -- %s\n", VERSION
, dmsversion
, ctime(&t
));
749 // ---------------------------------------------------------------------------------
750 // astring - allocate a copy of a string
751 // ---------------------------------------------------------------------------------
753 char *astring (char *str
)
755 static char *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?)
761 if ((s
= malloc(strlen(str
)+1)) == NULL
)
762 bail("out of memory");
768 // ---------------------------------------------------------------------------------
769 // lookup_symbol - get pointer to a symbol.
770 // If define is TRUE, creates and marks 'undefined' if not previously defined.
771 // ---------------------------------------------------------------------------------
773 PSYMBOL
lookup_symbol (char *name
, BOOL define
)
775 PSYMBOL s
, n
, prv
= NULL
;
779 if (strlen(name
) > 5) { // (sigh)
780 asm_error("Symbol '%s' is longer than 5 letters", name
);
785 while ((at
= strchr(name
, '@')) != NULL
)
788 // search sorted list of symbols
789 for (s
= symbols
; s
!= NULL
; prv
= s
, s
= s
->next
) {
790 c
= strcmpi(s
->name
, name
);
798 return NULL
; // not found
800 if ((n
= malloc(sizeof(SYMBOL
))) == NULL
)
801 bail("out of memory");
803 n
->name
= astring(name
); // symbol was undefined -- add it now
809 n
->next
= s
; // link in alpha order
811 if (prv
== NULL
) // we stopped before first item in list
814 prv
->next
= n
; // insert after item before place we stopped
819 // ---------------------------------------------------------------------------------
820 // add_xref - add a cross reference entry to a symbol
821 // ---------------------------------------------------------------------------------
823 void add_xref (PSYMBOL s
, BOOL definition
)
825 PXREF x
, prv
= NULL
, n
;
827 if (pass
== 1 || ! do_xref
) // define only during 2nd pass and only if listing was requested
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
834 if ((n
= malloc(sizeof(XREF
))) == NULL
)
835 bail("out of memory");
837 n
->fname
= astring(curfn
);
839 n
->definition
= definition
;
841 n
->next
= x
; // link at end of existing list
849 // ---------------------------------------------------------------------------------
850 // get_symbol - get a symbol value, defining if necessary
851 // ---------------------------------------------------------------------------------
853 int get_symbol (char *name
)
857 s
= lookup_symbol(name
, TRUE
); // lookup, define if necessary
859 if (pass
== 2) // should be defined by now
861 asm_error("Symbol '%s' is undefined", name
);
863 add_xref(s
, FALSE
); // note the reference
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
872 // ---------------------------------------------------------------------------------
874 void set_symbol (char *name
, int value
, int known
, RELOC relative
)
879 if (strlen(name
) > 5) {
880 asm_error("Symbol '%s' is longer than 5 letters", name
);
885 while ((at
= strchr(name
, '@')) != NULL
)
889 s
= lookup_symbol(name
, TRUE
);
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");
896 s
->relative
= relative
;
897 s
->defined
= known
? S_DEFINED
: S_PROVISIONAL
;
903 add_xref(s
, TRUE
); // record the place of definition
906 // ---------------------------------------------------------------------------------
907 // skipbl - return pointer to first nonblank character in string s
908 // ---------------------------------------------------------------------------------
910 char *skipbl (char *s
)
912 while (*s
&& *s
<= ' ')
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
924 // while (gtok(&pbuf, token) != NULL) ...
925 // ---------------------------------------------------------------------------------
927 char * gtok (char **pc
, char *tok
)
929 char *s
= *pc
, *otok
= tok
;
931 while (*s
&& *s
<= ' ') // skip blanks
934 if (! *s
) { // no tokens to be found
940 while (*s
> ' ') // save nonblanks into 'tok'
943 *tok
= '\0'; // terminate
944 *pc
= s
; // adjust caller's pointer
946 return otok
; // return pointer to token
952 // 0000 0000 0000 0000 0000 | XXXXXXXXXXXXXXXXX
954 // ---------------------------------------------------------------------------------
955 // trim - remove trailing whitespace from string s
956 // ---------------------------------------------------------------------------------
962 for (nb
= s
-1; *s
; s
++)
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 // ---------------------------------------------------------------------------------
976 void listout (BOOL reset
)
978 if (flist
&& list_on
&& ! line_error
) {
980 fputs(listline
, flist
);
983 sprintf(listline
, LEFT_MARGIN
, org
);
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 // ---------------------------------------------------------------------------------
992 void storew (int word
, RELOC relative
)
994 if (pass
== 2) { // save in output (load) file.
997 bincard_writew(word
, relative
);
1001 fprintf(fout
, " %04x%s" ENDLINE
, word
& 0xFFFF,
1002 (relative
== ABSOLUTE
) ? "" : (relative
== RELATIVE
) ? "R" :
1003 (relative
== LIBF
) ? "L" : (relative
== CALL
) ? "$" : "?");
1007 bail("in storew, can't happen");
1011 if (relative
!= LIBF
)
1014 assembled
= TRUE
; // remember that we wrote something
1017 // ---------------------------------------------------------------------------------
1018 // setw - store a word value in the current listing output line in position 'pos'.
1019 // ---------------------------------------------------------------------------------
1021 void setw (int pos
, int word
, RELOC relative
)
1026 if (flist
== NULL
|| ! list_on
)
1029 sprintf(tok
, "%04x", word
& 0xFFFF);
1031 for (i
= 0, p
= listline
+ 5*pos
; i
< 4; i
++)
1034 if (relative
== RELATIVE
)
1036 else if (relative
!= ABSOLUTE
)
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 // ---------------------------------------------------------------------------------
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
);
1050 else if (nwout
>= 4) { // if 4 words have already been written, start new line
1056 setw(nwout
, word
, relative
); // display word in the listing line
1058 storew(word
, relative
); // write it to the output medium
1061 // ---------------------------------------------------------------------------------
1062 // setorg - take note of new load address
1063 // ---------------------------------------------------------------------------------
1065 void setorg (int neworg
)
1068 setw(0, neworg
, FALSE
); // display in listing file in column 0
1070 if (outmode
== OUTMODE_LOAD
) { // write new load address to the output file
1071 fprintf(fout
, "@%04x%s" ENDLINE
, neworg
& 0xFFFF, relocate
? "R" : "");
1074 bincard_setorg(neworg
);
1081 // ---------------------------------------------------------------------------------
1082 // org_even - force load address to an even address
1083 // ---------------------------------------------------------------------------------
1085 void org_even (void)
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 // ---------------------------------------------------------------------------------
1098 void tabtok (char *c
, char *tok
, int i
, char *save
)
1102 while (--i
>= 0) { // skip to i'th tab-delimited field
1103 if ((c
= strchr(c
, '\t')) == NULL
) {
1104 if (save
) // was none
1111 while (*c
== ' ') // skip leading blanks
1114 if (save
!= NULL
) // save copy of entire remainder
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
!= ')')
1122 else if (*c
== '.') { // period means literal character following
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.
1144 // ifrom and ito on entry are column numbers, not indices; we change that right away
1145 // ---------------------------------------------------------------------------------
1147 void coltok (char *c
, char *tok
, int ifrom
, int ito
, BOOL condense
, char *save
)
1155 for (i
= 0; i
< ifrom
; i
++) {
1156 if (c
[i
] == '\0') { // line ended before this column
1164 if (save
) // save from ifrom on
1168 for (; i
<= ito
; i
++) { // save only nonwhite characters
1174 if (c
[i
] == ' ' && save
!= NULL
)// if it starts with a space, it's empty
1177 while (i
<= ito
) { // take up to any whitespace
1180 else if (c
[i
] == '(') { // starts with paren? take to close paren
1181 while (i
<= ito
&& c
[i
]) {
1182 if ((*tok
++ = c
[i
++]) == ')')
1186 else if (c
[i
] == '.') { // period means literal character following
1188 if (i
<= ito
&& c
[i
])
1200 // ---------------------------------------------------------------------------------
1202 // ---------------------------------------------------------------------------------
1204 // modifiers for the opcode definition table:
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
1212 #define ALL L X I IDX // hope non-Microsoft C accepts and concatenates strings like this
1214 #define NUMS "0123456789"
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
1223 struct tag_op
{ // OPCODE TABLE
1226 void (*handler
)(struct tag_op
*op
, char *label
, char *mods
, char *arg
);
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
);
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
);
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
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,
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
,
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
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
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,
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
1374 NULL
// end of table
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 // ---------------------------------------------------------------------------------
1382 char *addextn (char *fname
, char *extn
, char *outbuf
)
1384 char *buf
, line
[500], *c
;
1386 buf
= (outbuf
== NULL
) ? line
: outbuf
;
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
)
1394 if ((c
= strrchr(c
, '.')) == NULL
)
1399 return (outbuf
== NULL
) ? astring(line
) : outbuf
;
1402 // ---------------------------------------------------------------------------------
1403 // controlcard - examine an assembler control card (* in column 1)
1404 // ---------------------------------------------------------------------------------
1406 BOOL
controlcard (char *line
)
1408 if (strnicmp(line
, "*LIST", 5) == 0) { // turn on listing file even if not specified on command line
1409 do_list
= list_on
= TRUE
;
1413 if (strnicmp(line
, "*XREF", 5) == 0) {
1418 if (strnicmp(line
, "*PRINT SYMBOL TABLE", 19) == 0) {
1423 if (strnicmp(line
, "*SAVE SYMBOL TABLE", 18) == 0) {
1428 if (strnicmp(line
, "*SYSTEM SYMBOL TABLE", 20) == 0) {
1437 // ---------------------------------------------------------------------------------
1438 // stuff - insert characters into a line
1439 // ---------------------------------------------------------------------------------
1441 void stuff (char *buf
, char *tok
, int maxchars
)
1447 if (--maxchars
<= 0)
1452 // ---------------------------------------------------------------------------------
1453 // format_line - construct a source code input line from components
1454 // ---------------------------------------------------------------------------------
1456 void format_line (char *buf
, char *label
, char *op
, char *mods
, char *args
, char *remarks
)
1461 sprintf(buf
, "%s\t%s\t%s\t%s\t%s", label
, op
, mods
, args
, remarks
);
1464 for (i
= 0; i
< 72; i
++)
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);
1475 // ---------------------------------------------------------------------------------
1476 // lookup_op - find an opcode
1477 // ---------------------------------------------------------------------------------
1479 struct tag_op
* lookup_op (char *mnem
)
1484 for (op
= ops
; op
->mnem
!= NULL
; op
++) {
1485 if ((i
= strcmp(op
->mnem
, mnem
)) == 0)
1494 // ---------------------------------------------------------------------------------
1495 // bincard - routines to write IBM 1130 Card object format
1496 // ---------------------------------------------------------------------------------
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
1506 // bincard_init - prepare a new object data output card
1508 void bincard_init (void)
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)
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
1520 void bincard_writecard (char *sbrk_text
)
1522 unsigned short binout
[80];
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
] <= ' ')
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
];
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;
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);
1554 sprintf(ident
, "%08ld", ++bincard_seq
); // append sequence text
1555 memmove(ident
, progname
, MIN(strlen(progname
), 4));
1557 for (i
= 0; i
< 8; i
++)
1558 binout
[j
++] = ascii_to_hollerith(ident
[i
]);
1560 fxwrite(binout
, sizeof(binout
[0]), 80, fout
); // write card image
1563 // binard_writedata - emit an object data card
1565 void bincard_writedata (void)
1567 unsigned short rflag
= 0;
1568 int i
, j
, nflag
= 0;
1570 bincard
[1] = 0; // checksum
1571 bincard
[2] = 0x0A00 | bincard_n
; // data card type + word count
1573 for (i
= 0, j
= 3; i
< bincard_n
; i
++) { // construct relocation indicator bitmap
1575 bincard
[j
++] = rflag
;
1579 rflag
= (rflag
<< 2) | (binflag
[i
] & 3);
1584 bincard
[j
] = rflag
<< (16 - 2*nflag
);
1586 bincard_writecard(FALSE
); // emit the card
1589 // bincard_flush - flush any pending binary data
1591 void bincard_flush (void)
1594 bincard_writedata();
1599 // bincard_sbrk - emit an SBRK card
1601 void bincard_sbrk (char *line
)
1608 bincard_writecard(line
);
1611 // bincard_setorg - set the origin
1613 void bincard_setorg (int neworg
)
1615 bincard_org
= neworg
; // set origin for next card
1616 bincard_flush(); // flush any current data & store origin
1619 // bincard_endcard - write end of program card
1621 void bincard_endcard (void)
1625 bincard
[0] = (bincard_maxaddr
+ 2) & ~1; // effective length: add 1 to max origin, then 1 more to round up
1627 bincard
[2] = 0x0F00;
1628 bincard
[3] = pta
& 0xFFFF;
1630 bincard_writecard(NULL
);
1633 // bincard_typecard - write the program type
1635 void bincard_typecard (void)
1639 if (! bincard_first
)
1642 bincard_first
= FALSE
;
1644 memset(bincard
, 0, sizeof(bincard
));
1646 bincard
[2] = (unsigned short) ((progtype
<< 8) | intmode
| realmode
);
1648 // all indices not listed are documented as 'reserved'
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
;
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
;
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
;
1684 bincard
[ 2] = (unsigned short) (progtype
<< 8);
1686 bincard
[12] = intlevel_primary
;
1690 bail("in bincard_typecard, can't happen");
1693 bincard
[1] = 0; // checksum
1695 bincard_writecard(NULL
);
1700 // bincard_writew - write a word to the current output card.
1702 void bincard_writew (int word
, RELOC relative
)
1709 else if (bincard_n
>= 45) // flush full card buffer
1712 binflag
[bincard_n
] = relative
& 3; // store relocation bits and data word
1713 bincard
[9+bincard_n
++] = word
;
1715 if (relative
!= LIBF
) {
1716 bincard_maxaddr
= MAX(bincard_maxaddr
, bincard_org
);
1721 // writetwo - notification that we are about to write two words which must stay together
1723 void writetwo (void)
1725 if (pass
== 2 && outmode
== OUTMODE_BINARY
&& bincard_n
>= 44)
1729 // handle_sbrk - handle an SBRK directive.
1730 // This was not part of the 1130 assembler; they assembled DMS on a 360
1732 void handle_sbrk (char *line
)
1739 strncpy(rline
, line
, 81); // get a copy and pad it if necessary to 80 characters
1741 while (strlen(rline
) < 80)
1746 fprintf(fout
, "#SBRK%s\n", trim(rline
+5));
1748 case OUTMODE_BINARY
:
1749 bincard_sbrk(rline
);
1753 bail("in handle_sbrk, can't happen");
1757 // ---------------------------------------------------------------------------------
1758 // namecode - turn a string into a two-word packed name
1759 // ---------------------------------------------------------------------------------
1761 void namecode (unsigned short *words
, char *tok
)
1766 for (i
= 0; i
< 5; i
++) { // pick up bits
1772 val
= (val
<< 6) | (ascii_to_ebcdic_table
[ch
] & 0x3F);
1775 words
[0] = (unsigned short) (val
>> 16);
1776 words
[1] = (unsigned short) val
;
1779 // ---------------------------------------------------------------------------------
1780 // parse_line - parse one input line.
1781 // ---------------------------------------------------------------------------------
1783 void parse_line (char *line
)
1785 char label
[100], mnem
[100], arg
[200], mods
[20], *c
;
1788 if (line
[0] == '/' && line
[1] == '/') // job control card? probably best to ignore it
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
1796 if (strnicmp(line
+1, "SBRK", 4) == 0)
1802 check_control
= FALSE
; // non-control card, consider them no more
1804 label
[0] = '\0'; // prepare to extract fields
1809 if (tabformat
|| strchr(line
, '\t') != NULL
) { // if input line has tabs, parse loosely
1810 tabformat
= TRUE
; // this is a tab-formatted file
1812 for (c
= line
; *c
&& *c
<= ' '; c
++) // find first nonblank
1815 if (*c
== '*' || ! *c
) // ignore as a comment
1818 tabtok(line
, label
, 0, NULL
);
1819 tabtok(line
, mnem
, 1, NULL
);
1820 tabtok(line
, mods
, 2, NULL
);
1821 tabtok(line
, arg
, 3, opfield
);
1823 else { // if no tabs, use strict card-column format
1824 if (line
[20] == '*') // comment
1827 line
[72] = '\0'; // clip off sequence
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
);
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
1841 if (*label
) // display org in any line with a label
1842 setw(0, org
, FALSE
);
1844 if (! *mnem
) { // label w/o mnemonic, just define the symbol
1846 set_symbol(label
, org
, TRUE
, relocate
);
1850 if ((op
= lookup_op(mnem
)) == NULL
) { // look up mnemonic
1852 set_symbol(label
, org
, TRUE
, relocate
);// at least define the label
1854 asm_error("Unknown opcode '%s'", mnem
);
1858 if (op
->flags
& TRAP
) // assembler debugging breakpoint
1859 x_trap(op
, label
, mods
, arg
);
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
1872 strcat(mods
, op
->mods_implied
); // tack on implied modifiers
1874 if (strchr(mods
, 'I')) // indirect implies long
1877 requires_even_address
= op
->flags
& IS_DBL
;
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
);
1882 if ((op
->flags
& IS_1800
) && ! enable_1800
)
1883 asm_warning("%s is IBM 1800-specific; use the -8 command line option", op
->mnem
);
1886 // ---------------------------------------------------------------------------------
1887 // get one input line from current file or macro
1888 // ---------------------------------------------------------------------------------
1890 BOOL
get_line (char *buf
, int nbuf
, BOOL onelevel
)
1894 if (ended
) // we hit the END command
1897 // if macro active, return line from macro buffer, otherwise read from file
1898 // do not pop end-of-macro if onelevel is TRUE
1900 if ((retval
= fgets(buf
, nbuf
, fin
)) == NULL
)
1903 lno
++; // count the line
1907 // ---------------------------------------------------------------------------------
1908 // proc - process one pass of one source file
1909 // ---------------------------------------------------------------------------------
1911 void proc (char *fname
)
1916 if (strchr(fname
, '.') == NULL
) // if input file has no extension,
1917 addextn(fname
, ".asm", curfn
); // set appropriate file extension
1919 strcpy(curfn
, fname
); // otherwise use extension specified
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
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
)
1932 strncpy(progname
, c
, sizeof(progname
)); // take name after path
1933 progname
[sizeof(progname
)-1] = '\0';
1934 if ((c
= strchr(progname
, '.')) != NULL
)// remove extension
1938 lno
= 0; // reset global input line number
1939 ended
= FALSE
; // have not seen END statement
1941 if (listfn
== NULL
) // if list file name is undefined,
1942 listfn
= addextn(fname
, ".lst", NULL
); // create from first filename
1945 fprintf(stderr
, "--- Starting file %s pass %d\n", curfn
, pass
);
1947 if ((fin
= fopen(curfn
, "r")) == NULL
) {
1948 perror(curfn
); // oops
1952 if (flist
) { // put banner in listing file
1953 strcpy(listline
,"=== FILE ======================================================================");
1954 for (i
= 9, c
= curfn
; *c
;)
1955 listline
[i
++] = *c
++;
1957 fputs(listline
, flist
);
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
1970 if (n_literals
> 0) { // force out any pending literal constants at end of file
1971 output_literals(TRUE
);
1976 // ---------------------------------------------------------------------------------
1977 // prep_line - prepare input line for parsing
1978 // ---------------------------------------------------------------------------------
1980 void prep_line (char *line
)
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
1988 for (c
= line
; *c
; c
++) { // truncate at newline
1989 if (*c
== '\r' || *c
== '\n') {
1995 if (flist
&& list_on
) { // construct beginning of listing line
1997 sprintf(listline
, LINEFORMAT
, lno
, detab(line
));
1999 if (strlen(line
) > 20) // get the part where the commands start
2004 sprintf(listline
, LINEFORMAT
, lno
, c
);
2005 stuff(listline
, line
, 20); // stuff the left margin in to the left side
2010 // ---------------------------------------------------------------------------------
2011 // opcmp - operand name comparison routine for qsort
2012 // ---------------------------------------------------------------------------------
2014 int opcmp (const void *a
, const void *b
)
2016 return strcmp(((struct tag_op
*) a
)->mnem
, ((struct tag_op
*) b
)->mnem
);
2019 // ---------------------------------------------------------------------------------
2020 // preload_symbols - load a saved symbol table
2021 // ---------------------------------------------------------------------------------
2023 void preload_symbols (void)
2026 char str
[200], sym
[20];
2028 static BOOL preloaded_already
= FALSE
;
2030 if (pass
> 1 || preloaded_already
)
2033 preloaded_already
= TRUE
;
2035 if ((fd
= fopen(SYSTEM_TABLE
, "r")) == NULL
) // read the system symbol tabl
2036 perror(SYSTEM_TABLE
);
2038 while (fgets(str
, sizeof(str
), fd
) != NULL
) {
2039 if (sscanf(str
, "%s %x", sym
, &v
) == 2)
2040 set_symbol(sym
, v
, TRUE
, FALSE
);
2046 // ---------------------------------------------------------------------------------
2047 // save_symbols - save a symbol table
2048 // ---------------------------------------------------------------------------------
2050 void save_symbols (void)
2057 fprintf(stderr
, "Can't save symbol table unless ABS assembly\n");
2061 if ((fd
= fopen(SYSTEM_TABLE
, "r")) != NULL
) {
2064 printf("Overwrite system symbol table %s? ", SYSTEM_TABLE
);
2065 fgets(str
, sizeof(str
), stdin
);
2066 if (str
[0] != 'y' && str
[0] != 'Y')
2069 unlink(SYSTEM_TABLE
);
2072 if ((fd
= fopen(SYSTEM_TABLE
, "w")) == NULL
) {
2073 perror(SYSTEM_TABLE
);
2077 for (s
= symbols
; s
!= NULL
; s
= s
->next
)
2078 fprintf(fd
, "%-5s %04x\n", s
->name
, s
->value
);
2083 // ---------------------------------------------------------------------------------
2084 // startpass - initialize data structures, prepare to start a pass
2085 // ---------------------------------------------------------------------------------
2087 void startpass (int n
)
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
2101 n_literals
= 0; // literal values pending output
2104 if (pass
== 1) { // first pass only
2105 for (nops
= 0, p
= ops
; p
->mnem
!= NULL
; p
++, nops
++) // count opcodes
2108 qsort(ops
, nops
, sizeof(*p
), opcmp
); // sort the opcode table
2113 else { // second pass only
2115 outfn
= addextn(curfn
, (outmode
== OUTMODE_LOAD
) ? ".out" : ".bin" , NULL
);
2117 if ((fout
= fopen(outfn
, OUTWRITEMODE
)) == NULL
) { // open output file
2122 if (do_list
) { // open listing file
2123 if ((flist
= fopen(listfn
, "w")) == NULL
) {
2127 listhdr(); // print banner
2132 // ---------------------------------------------------------------------------------
2133 // x_dc - DC define constant directive
2134 // ---------------------------------------------------------------------------------
2136 void x_dc (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2141 org_advanced
= 1; // assume * means this address+1
2142 // doesn't make sense, but I think I found DMS listings to support it
2144 if (strchr(mods
, 'E') != NULL
) // force even address
2147 setw(0, org
, FALSE
); // display org in listing line
2149 if (*label
) // define label
2150 set_symbol(label
, org
, TRUE
, relocate
);
2153 getexpr(arg
, FALSE
, &expr
);
2154 writew(expr
.value
, expr
.relative
); // store value
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
2163 // ---------------------------------------------------------------------------------
2164 // x_dec - DEC define double word constant directive.
2165 // ---------------------------------------------------------------------------------
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
2171 // NOTE: these are wrong with Fixed point numbers
2173 void convert_double_to_extended (double d
, unsigned short *wd
)
2176 unsigned long mantissa
;
2177 unsigned char *byte
= (unsigned char *) &d
;
2180 wd
[0] = wd
[1] = wd
[2] = 0;
2184 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM
2186 neg
= byte
[7] & 0x80;
2187 exp
= ((byte
[7] & 0x7F) << 4) | ((byte
[6] & 0xF0) >> 4); // extract exponent
2188 exp
-= 1023; // remove bias
2190 exp
++; // shift to account for implied 1 we added
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);
2195 if (mantissa
& (0x80000000L
>> 31)) // keep 31 bits, round if necessary
2196 mantissa
+= (0x80000000L
>> 31);
2198 mantissa
>>= (32-31); // get into low 31 bits
2200 // now turn into IBM 1130 extended precision
2205 mantissa
= (unsigned long) (- (long) mantissa
); // two's complement
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);
2212 // ---------------------------------------------------------------------------------
2213 // ---------------------------------------------------------------------------------
2215 void convert_double_to_standard (double d
, unsigned short *wd
)
2218 unsigned long mantissa
;
2219 unsigned char *byte
= (unsigned char *) &d
;
2226 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM
2228 neg
= byte
[7] & 0x80;
2229 exp
= ((byte
[7] & 0x7F) << 4) | ((byte
[6] & 0xF0) >> 4); // extract exponent
2230 exp
-= 1023; // remove bias
2232 exp
++; // shift to account for implied 1 we added
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);
2237 // if (mantissa & (0x80000000L >> 23)) // keep 23 bits, round if necessary
2238 // mantissa += (0x80000000L >> 23);
2241 // printf("%8.4lf: %08lx %d\n", d, mantissa, exp);
2243 mantissa
>>= (32-23); // get into low 23 bits
2245 // now turn into IBM 1130 standard precision
2250 mantissa
= (unsigned long) (- (long) mantissa
); // two's complement
2252 wd
[0] = (unsigned short) ((neg
? 0x8000 : 0) | ((mantissa
>> (23-15)) & 0x7FFF));
2253 wd
[1] = (unsigned short) ((mantissa
& 0x00FF) << 8) | (exp
& 0xFF);
2256 // printf(" D %04x%04x\n", wd[0], wd[1]);
2259 // ---------------------------------------------------------------------------------
2260 // ---------------------------------------------------------------------------------
2262 void convert_double_to_fixed (double d
, unsigned short *wd
, int bexp
)
2264 int neg
, exp
, rshift
;
2265 unsigned long mantissa
;
2266 unsigned char *byte
= (unsigned char *) &d
;
2273 // note: we assume that this computer uses ANSI floating point
2276 // d = ansi real*8 SXXX XXXX XXXX MMMM MMMM MMMM MMMM MMMM ... MMMM MMMM
2278 neg
= byte
[7] & 0x80;
2279 exp
= ((byte
[7] & 0x7F) << 4) | ((byte
[6] & 0xF0) >> 4); // extract exponent
2280 exp
-= 1023; // remove bias
2282 exp
++; // shift to account for implied 1 we added
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);
2287 mantissa
>>= 1; // shift it out of the sign bit
2290 // printf("%8.4lf: %08lx %d\n", d, mantissa, exp);
2292 rshift
= bexp
- exp
;
2295 mantissa
>>= rshift
;
2297 else if (rshift
< 0) {
2298 mantissa
>>= (-rshift
);
2299 asm_warning("Fixed point overflow");
2303 mantissa
= (unsigned long) (- (long) mantissa
); // two's complement
2306 // printf(" B %08lx\n", mantissa);
2308 wd
[0] = (unsigned short) ((mantissa
>> 16) & 0xFFFF); // return all of the bits; no exponent here
2309 wd
[1] = (unsigned short) (mantissa
& 0xFFFF);
2312 // ---------------------------------------------------------------------------------
2313 // ---------------------------------------------------------------------------------
2315 void getDconstant (char *tok
, unsigned short *wd
)
2325 if (strchr(tok
, '.') == NULL
&& strchr(tok
, 'B') == NULL
&& strchr(tok
, 'E') == NULL
) {
2327 if (*tok
== '/') { // I don't see that this is legal but can't hurt to allow it
2331 if (sscanf(tok
, fmt
, &l
) != 1) { // no decimal means it's an integer?
2332 asm_error("Syntax error in constant");
2335 wd
[0] = (unsigned short) ((l
>> 16) & 0xFFFF); // high word
2336 wd
[1] = (unsigned short) (l
& 0xFFFF); // low word
2342 if ((b
= strchr(tok
, 'B')) != NULL
) {
2345 *b
= '\0'; // truncate at the b
2347 if (sscanf(tok
, "%lg", &d
) != 1) {
2348 asm_error("Syntax error in constant");
2353 convert_double_to_fixed(d
, wd
, bexp
);
2355 convert_double_to_standard(d
, wd
);
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 // ---------------------------------------------------------------------------------
2365 void x_dec (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2367 unsigned short wd
[2];
2369 org_advanced
= 2; // assume * means address after this location, since it's +1 for dc?
2371 org_even(); // even address is implied
2372 setw(0, org
, FALSE
); // display the origin
2374 if (*label
) // define label
2375 set_symbol(label
, org
, TRUE
, relocate
);
2378 getDconstant(arg
, wd
);
2379 writew(wd
[0], FALSE
); // write hiword, then loword
2380 writew(wd
[1], FALSE
);
2382 // pick up values, comma delimited
2383 // for (tok = strtok(arg, ","); tok != NULL; tok = strtok(NULL, ",")) {
2384 // getDconstant(tok, wd);
2386 // writew(wd[0], FALSE); // write hiword, then loword
2387 // writew(wd[1], FALSE);
2390 // ---------------------------------------------------------------------------------
2391 // DECS directive. Writes just the high word of a DEC value
2392 // ---------------------------------------------------------------------------------
2394 void x_decs (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2396 unsigned short wd
[2];
2398 org_advanced
= 1; // assume * means address after this location
2400 setw(0, org
, FALSE
); // display the origin
2402 if (*label
) // define label
2403 set_symbol(label
, org
, TRUE
, relocate
);
2405 getDconstant(arg
, wd
);
2406 writew(wd
[0], FALSE
); // write hiword ONLY
2409 // ---------------------------------------------------------------------------------
2410 // ---------------------------------------------------------------------------------
2412 void x_xflc (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2417 unsigned short wd
[3];
2419 org_advanced
= 2; // who knows?
2421 setw(0, org
, FALSE
); // display the origin
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
, ",")) {
2428 if ((b
= strchr(tok
, 'B')) != NULL
) {
2431 *b
= '\0'; // truncate at the b
2432 asm_warning("Fixed point extended floating constant?");
2435 if (sscanf(tok
, "%lg", &d
) != 1) {
2436 asm_error("Syntax error in constant");
2440 convert_double_to_extended(d
, wd
);
2442 writew(wd
[0], ABSOLUTE
);
2443 writew(wd
[1], ABSOLUTE
);
2444 writew(wd
[2], ABSOLUTE
);
2448 // ---------------------------------------------------------------------------------
2449 // x_equ - EQU directive
2450 // ---------------------------------------------------------------------------------
2452 void x_equ (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2456 org_advanced
= FALSE
; // * means this address, not incremented
2458 getexpr(arg
, FALSE
, &expr
);
2460 setw(0, expr
.value
, expr
.relative
); // show this as address
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?");
2468 // ---------------------------------------------------------------------------------
2469 // x_lorg - LORG directive -- output queued literal values
2470 // ---------------------------------------------------------------------------------
2472 void x_lorg (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2474 org_advanced
= FALSE
; // * means this address (not used, though)
2475 output_literals(FALSE
); // generate .DC's for queued literal values
2478 // ---------------------------------------------------------------------------------
2479 // x_abs - ABS directive
2480 // ---------------------------------------------------------------------------------
2482 void x_abs (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2485 asm_error("ABS must be first statement");
2487 relocate
= ABSOLUTE
;
2490 case PROGTYPE_ABSOLUTE
:
2491 case PROGTYPE_RELOCATABLE
:
2492 progtype
= PROGTYPE_ABSOLUTE
; // change program type, still assumed to be mainline
2497 case PROGTYPE_ISSLIBF
:
2498 case PROGTYPE_ISSCALL
:
2500 asm_error("ABS not allowed with LIBF, ENT, ILS or ISS");
2504 bail("in x_libr, can't happen");
2508 // ---------------------------------------------------------------------------------
2509 // x_call - ORG pseudo-op
2510 // ---------------------------------------------------------------------------------
2512 void x_call (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2514 unsigned short words
[2];
2515 static struct tag_op
*bsi
= NULL
;
2517 if (*label
) // define label
2518 set_symbol(label
, org
, TRUE
, relocate
);
2521 asm_error("CALL missing argument");
2525 if (pass
== 1) { // it will take two words in any case
2530 setw(0, org
, FALSE
); // display origin
2532 if (lookup_symbol(arg
, FALSE
) != NULL
) { // it's a defined symbol?
2534 if ((bsi
= lookup_op("BSI")) == NULL
)
2535 bail("Can't find BSI op");
2537 (bsi
->handler
)(bsi
, "", "L", arg
);
2540 namecode(words
, arg
); // emit namecode for loader
2543 writew(words
[0], CALL
);
2544 writew(words
[1], ABSOLUTE
);
2548 // ---------------------------------------------------------------------------------
2549 // x_org - ORG directive
2550 // ---------------------------------------------------------------------------------
2552 void x_org (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2556 org_advanced
= FALSE
; // * means this address
2558 if (*label
) // label is defined BEFORE the new origin is set!!!
2559 set_symbol(label
, org
, TRUE
, relocate
);
2561 if (getexpr(arg
, FALSE
, &expr
) != S_DEFINED
)
2564 setorg(expr
.value
); // set origin to this value
2567 // ---------------------------------------------------------------------------------
2568 // x_end - END directive
2569 // ---------------------------------------------------------------------------------
2571 void x_end (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2575 org_advanced
= FALSE
; // * means this address
2577 if (*arg
) { // they're specifing the program start address
2578 if (getexpr(arg
, FALSE
, &expr
) == S_DEFINED
)
2582 if (*label
) // define label
2583 set_symbol(label
, org
, TRUE
, relocate
);
2585 setw(0, org
, FALSE
); // display origin
2587 ended
= TRUE
; // assembly is done, stop reading file
2590 // ---------------------------------------------------------------------------------
2592 // ---------------------------------------------------------------------------------
2594 void x_ent (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2598 org_advanced
= FALSE
; // * means this address
2603 // if (*label) // define label
2604 // set_symbol(label, org, TRUE, relocate);
2606 // setw(0, org, FALSE); // display origin
2609 asm_error("No entry label specified");
2611 else if ((s
= lookup_symbol(arg
, FALSE
)) == NULL
)
2612 asm_error("Entry symbol %s not defined", arg
);
2614 else if (nentries
>= MAXENTRIES
)
2615 asm_error("Too many entries, limit is %d", MAXENTRIES
);
2618 entry
[nentries
++] = s
; // save symbol pointer
2621 case PROGTYPE_ABSOLUTE
:
2622 asm_error("ENT not allowed with ABS");
2624 case PROGTYPE_RELOCATABLE
:
2625 progtype
= PROGTYPE_CALL
;
2629 case PROGTYPE_ISSLIBF
:
2630 case PROGTYPE_ISSCALL
:
2633 asm_error("Can't mix ENT and ILS, can you?");
2636 bail("in x_libr, can't happen");
2640 // ---------------------------------------------------------------------------------
2641 // declare a libf-type subprogram
2642 // ---------------------------------------------------------------------------------
2644 void x_libr (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2647 case PROGTYPE_ABSOLUTE
:
2648 asm_error("LIBR not allowed with ABS");
2650 case PROGTYPE_RELOCATABLE
:
2653 progtype
= PROGTYPE_LIBF
;
2655 case PROGTYPE_ISSLIBF
:
2656 case PROGTYPE_ISSCALL
:
2657 progtype
= PROGTYPE_ISSLIBF
;
2660 asm_error("Can't use LIBR in an ILS");
2663 bail("in x_libr, can't happen");
2667 // ---------------------------------------------------------------------------------
2668 // x_ils - ILS directive
2669 // ---------------------------------------------------------------------------------
2671 void x_ils (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2674 case PROGTYPE_ABSOLUTE
:
2675 asm_error("ILS not allowed with ABS");
2677 case PROGTYPE_RELOCATABLE
:
2679 progtype
= PROGTYPE_ILS
;
2683 asm_error("Invalid placement of ILS");
2685 case PROGTYPE_ISSLIBF
:
2686 case PROGTYPE_ISSCALL
:
2689 bail("in x_libr, can't happen");
2692 intlevel_primary
= atoi(mods
);
2695 // ---------------------------------------------------------------------------------
2696 // x_iss - ISS directive
2697 // ---------------------------------------------------------------------------------
2699 void x_iss (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2704 case PROGTYPE_ABSOLUTE
:
2705 asm_error("ISS not allowed with ABS");
2707 case PROGTYPE_RELOCATABLE
:
2709 case PROGTYPE_ISSCALL
:
2710 progtype
= PROGTYPE_ISSCALL
;
2713 case PROGTYPE_ISSLIBF
:
2714 progtype
= PROGTYPE_ISSLIBF
;
2717 asm_error("Can't mix ISS and ILS");
2719 bail("in x_libr, can't happen");
2722 iss_number
= atoi(mods
); // get ISS number
2724 opfield
[16] = '\0'; // be sure not to look too far into this
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
2730 if ((tok
= strtok(opfield
, " ")) == NULL
)
2731 asm_error("ISS missing entry label");
2733 x_ent(NULL
, label
, "", arg
); // process as an ENT
2735 if ((tok
= strtok(NULL
, " ")) != NULL
) { // get associated levels
2737 intlevel_primary
= atoi(tok
);
2740 if ((tok
= strtok(NULL
, " ")) != NULL
) {
2742 intlevel_secondary
= atoi(tok
);
2746 void x_spr (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2748 realmode
= REALMODE_STANDARD
;
2751 void x_epr (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2753 realmode
= REALMODE_EXTENDED
;
2756 void x_dsa (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2758 unsigned short words
[2];
2760 setw(0, org
, FALSE
); // display origin
2762 if (*label
) // define label
2763 set_symbol(label
, org
, TRUE
, relocate
);
2766 asm_error("DSA missing filename");
2769 namecode(words
, arg
);
2771 writew(words
[0], CALL
); // special relocation bits here 3 and 1
2772 writew(words
[1], RELATIVE
);
2776 void x_link (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2778 unsigned short words
[2];
2781 setw(0, org
, FALSE
); // display origin
2783 if (*label
) // define label
2784 set_symbol(label
, org
, TRUE
, relocate
);
2787 asm_error("LINK missing program name");
2790 format_line(nline
, label
, "CALL", "", "$LINK", "");
2793 namecode(words
, arg
);
2794 writew(words
[0], ABSOLUTE
); // special relocation bits here 3 and 1
2795 writew(words
[1], ABSOLUTE
);
2799 void x_libf (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2801 unsigned short words
[2];
2803 if (*label
) // define label
2804 set_symbol(label
, org
, TRUE
, relocate
);
2807 asm_error("LIBF missing argument");
2811 if (pass
== 1) { // it will take one words in any case
2816 setw(0, org
, FALSE
); // display origin
2818 namecode(words
, arg
); // emit namecode for loader
2821 writew(words
[0], LIBF
); // this one does NOT advance org!
2822 writew(words
[1], ABSOLUTE
);
2825 void x_file (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2831 for (i
= 0; i
< 5; i
++) {
2832 if ((tok
= strtok(arg
, ",")) == NULL
) {
2833 asm_error("FILE has insufficient arguments");
2836 arg
= NULL
; // for next strtok call
2839 if (strcmpi(tok
, "U") != 0)
2840 asm_error("Argument 4 must be the letter U");
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);
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
);
2857 writew(r
, ABSOLUTE
);
2859 writew((16*vals
[1].value
)/r
, ABSOLUTE
);
2865 // ---------------------------------------------------------------------------------
2866 // x_trap - place to set a breakpoint
2867 // ---------------------------------------------------------------------------------
2869 void x_trap (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2871 // debugging breakpoint
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
2879 // ---------------------------------------------------------------------------------
2881 void x_ces (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2885 if (outmode
!= OUTMODE_LOAD
) // this works only in our loader format
2888 if (getexpr(arg
, FALSE
, &expr
) != S_DEFINED
)
2892 fprintf(fout
, "S%04x" ENDLINE
, expr
.value
& 0xFFFF);
2895 // ---------------------------------------------------------------------------------
2896 // x_bss - BSS directive - reserve space in core
2897 // ---------------------------------------------------------------------------------
2899 void x_bss (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2903 org_advanced
= FALSE
; // * means this address
2907 expr
.relative
= ABSOLUTE
;
2909 else if (getexpr(arg
, FALSE
, &expr
) != S_DEFINED
)
2912 if (strchr(mods
, 'E') != NULL
) // force even address
2916 asm_error("BSS size must be an absolute value");
2918 setw(0, org
, FALSE
); // display origin
2920 if (*label
) // define label
2921 set_symbol(label
, org
, TRUE
, relocate
);
2923 expr
.value
&= 0xFFFF; // truncate to 16 bits
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" : "");
2934 org
+= expr
.value
; // advance the origin by appropriate number of words
2936 bincard_setorg(org
);
2941 // ---------------------------------------------------------------------------------
2942 // x_bes - Block Ended by Symbol directive. Like BSS but label gets address AFTER the space, instead of first address
2943 // ---------------------------------------------------------------------------------
2945 void x_bes (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
2949 org_advanced
= FALSE
; // * means this address
2951 if (! *arg
) { // arg field = space
2953 expr
.relative
= ABSOLUTE
;
2955 else if (getexpr(arg
, FALSE
, &expr
) != S_DEFINED
)
2958 if (strchr(mods
, 'E') != NULL
&& (org
& 1) != 0)
2959 org_even(); // force even address
2962 asm_error("BES size must be an absolute value");
2965 asm_warning("Negative BES size");
2967 else if (expr
.value
> 0) {
2968 setw(0, org
+expr
.value
, FALSE
); // display NEW origin
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" : "");
2976 org
+= expr
.value
; // advance the origin
2977 bincard_setorg(org
);
2981 if (*label
) // NOW define the label
2982 set_symbol(label
, org
, TRUE
, relocate
);
2985 // ---------------------------------------------------------------------------------
2986 // x_dmes - DMES define message directive. Various encodings, none pretty.
2987 // ---------------------------------------------------------------------------------
2991 enum {CODESET_CONSOLE
, CODESET_1403
, CODESET_1132
, CODESET_EBCDIC
} dmes_cs
;
2992 void stuff_dmes (int ch
, int rpt
);
2994 void x_dmes (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
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
3005 dmes_nc
= dmes_wd
= 0; // clear output buffer
3007 trim(opfield
); // remove trailing blanks from rest of input line (use whole thing)
3008 setw(0, org
, FALSE
); // display origin
3010 if (*label
) // define label
3011 set_symbol(label
, org
, TRUE
, relocate
);
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
;
3020 asm_error("Invalid printer code in tag field");
3021 dmes_cs
= CODESET_EBCDIC
;
3024 while (*c
) { // pick up characters
3025 if (*c
== '\'') { // quote (') is the escape character
3028 rpt
= 0; // get repeat count
3029 while (BETWEEN(*c
, '0', '9')) {
3030 rpt
= rpt
*10 + *c
++ - '0';
3032 if (rpt
<= 0) // no count = insert one copy
3035 switch (*c
) { // handle escape codes
3046 stuff_dmes(' ', rpt
);
3050 stuff_dmes(*++c
, rpt
); // repeat character
3060 if (dmes_cs
!= CODESET_CONSOLE
) {
3061 badcode
: asm_error("Invalid ' escape for selected printer");
3064 stuff_dmes(0x41, -rpt
); // tab
3068 if (dmes_cs
!= CODESET_CONSOLE
) goto badcode
;
3069 stuff_dmes(0x11, -rpt
); // backspace
3073 if (dmes_cs
!= CODESET_CONSOLE
) goto badcode
;
3074 stuff_dmes(0x05, -rpt
); // black
3078 if (dmes_cs
!= CODESET_CONSOLE
) goto badcode
;
3079 stuff_dmes(0x09, -rpt
); // red
3083 if (dmes_cs
!= CODESET_CONSOLE
) goto badcode
;
3084 stuff_dmes(0x81, -rpt
); // return
3088 if (dmes_cs
!= CODESET_CONSOLE
) goto badcode
;
3089 stuff_dmes(0x03, -rpt
); // line feed
3093 asm_error("Invalid ' escape in DMES");
3098 else // just copy literal character
3107 if (dmes_nc
) { // odd number of characters
3110 dmes_savew
= dmes_wd
; // save for next time
3113 stuff_dmes(' ', 1); // pad with a space to force out even # of characters
3117 // ---------------------------------------------------------------------------------
3118 // stuff_dmes - insert 'rpt' copies of character 'ch' into output words
3119 // ---------------------------------------------------------------------------------
3121 void stuff_dmes (int ch
, int rpt
)
3123 int nch
, i
; // nch is translated output value
3125 if (rpt
< 0) { // negative repeat means no translation needed
3131 case CODESET_CONSOLE
:
3133 for (i
= 0; i
< 256; i
++) {
3134 if (conout_to_ascii
[i
] == ch
) {
3141 case CODESET_EBCDIC
:
3142 nch
= ascii_to_ebcdic_table
[ch
& 0x7F];
3148 nch
= ascii_to_1403_table
[ch
& 0x7F];
3155 for (i
= 0; i
< WHEELCHARS_1132
; i
++) {
3156 if (codewheel1132
[i
].ascii
== ch
) {
3157 nch
= codewheel1132
[i
].ebcdic
;
3164 bail("bad cs in x_dmes, can't happen");
3169 while (--rpt
>= 0) { // pack them into words, output when we have two
3171 dmes_wd
= (nch
& 0xFF) << 8;
3175 dmes_wd
|= (nch
& 0xFF);
3176 writew(dmes_wd
, FALSE
);
3182 // ---------------------------------------------------------------------------------
3183 // x_ebc - handle EBCDIC string definition (delimited with periods)
3184 // ---------------------------------------------------------------------------------
3186 void x_ebc (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3190 // setw(0, org, FALSE);
3192 set_symbol(label
, org
, TRUE
, relocate
);
3194 p
= trim(opfield
); // remove trailing blanks from rest of input line (use whole thing)
3197 asm_error("EBC data must start with .");
3200 p
++; // skip leading period
3202 dmes_nc
= dmes_wd
= 0; // clear output buffer (we're borrowing the DMES packer)
3203 dmes_cs
= CODESET_EBCDIC
;
3205 while (*p
&& *p
!= '.') // store packed ebcdic
3206 stuff_dmes(*p
++, 1);
3208 if (dmes_nc
) // odd number of characters
3209 stuff_dmes(' ', 1); // pad with a space to force out even # of characters
3212 asm_error("EBC missing closing .");
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 // ---------------------------------------------------------------------------------
3220 void x_dn (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3222 unsigned short words
[2];
3224 setw(0, org
, FALSE
); // display origin
3226 if (*label
) // define label
3227 set_symbol(label
, org
, TRUE
, relocate
);
3229 namecode(words
, arg
);
3231 writew(words
[0], ABSOLUTE
);
3232 writew(words
[1], ABSOLUTE
);
3235 // ---------------------------------------------------------------------------------
3236 // x_dump - DUMP directive - pretend we saw "call $dump, call $exit"
3237 // ---------------------------------------------------------------------------------
3239 void x_dump (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3241 x_pdmp(op
, label
, mods
, arg
);
3242 x_exit(NULL
, "", "", ""); // compile "call $exit"
3245 // ---------------------------------------------------------------------------------
3246 // x_pdmp - PDMP directive - like DUMP but without the call $exit
3247 // ---------------------------------------------------------------------------------
3249 void x_pdmp (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3251 char nline
[200], *tok
;
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
;
3262 org_advanced
= FALSE
; // * means this address+1
3264 format_line(nline
, label
, "BSI", "L", DOLLARDUMP
, "");
3265 parse_line(nline
); // compile "call $dump"
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
);
3272 // ---------------------------------------------------------------------------------
3273 // x_hdng - HDNG directive
3274 // ---------------------------------------------------------------------------------
3276 void x_hdng (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3280 // label is not entered into the symbol table
3282 if (flist
== NULL
|| ! list_on
) {
3283 line_error
= TRUE
; // inhibit listing: don't print the HDNG statement
3287 line_error
= TRUE
; // don't print the statement
3289 c
= skipbl(opfield
);
3291 fprintf(flist
, "\f%s\n\n", c
); // print page header
3294 // ---------------------------------------------------------------------------------
3295 // x_list - LIST directive. enable or disable listing
3296 // ---------------------------------------------------------------------------------
3298 void x_list (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3302 // label is not entered into the symbol table
3304 line_error
= TRUE
; // don't print the LIST statement
3306 if (flist
== NULL
|| ! list_on
) {
3310 if (strcmpi(arg
, "ON") == 0)
3312 else if (strcmpi(arg
, "OFF") == 0)
3320 // ---------------------------------------------------------------------------------
3321 // x_spac - SPAC directive. Put blank lines in listing
3322 // ---------------------------------------------------------------------------------
3324 void x_spac (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3328 // label is not entered into the symbol table
3330 if (flist
== NULL
|| ! list_on
) {
3331 line_error
= TRUE
; // don't print the SPAC statement
3335 if (getexpr(arg
, FALSE
, &expr
) != S_DEFINED
)
3338 line_error
= TRUE
; // don't print the statement
3340 while (--expr
.value
>= 0)
3344 // ---------------------------------------------------------------------------------
3345 // x_ejct - EJCT directive - put formfeed in listing
3346 // ---------------------------------------------------------------------------------
3348 void x_ejct (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3350 // label is not entered into the symbol table
3352 if (flist
== NULL
|| ! list_on
) {
3353 line_error
= TRUE
; // don't print the EJCT statement
3357 line_error
= TRUE
; // don't print the statement
3362 // ---------------------------------------------------------------------------------
3363 // basic_opcode - construct a standard opcode value from op table entry and modifier chars
3364 // ---------------------------------------------------------------------------------
3366 int basic_opcode (struct tag_op
*op
, char *mods
)
3368 int opcode
= op
->opcode
; // basic code value
3370 if (strchr(mods
, '1') != 0) // indexing
3372 else if (strchr(mods
, '2') != 0)
3374 else if (strchr(mods
, '3') != 0)
3377 if (strchr(mods
, 'L')) { // two-word format
3379 if (strchr(mods
, 'I') != 0) // and indirect to boot
3380 opcode
|= OP_INDIRECT
;
3386 // ---------------------------------------------------------------------------------
3387 // std_op - assemble a vanilla opcode
3388 // ---------------------------------------------------------------------------------
3390 void std_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3393 int opcode
= basic_opcode(op
, mods
);
3394 BOOL val_ok
= FALSE
;
3396 if (*label
) // define label
3397 set_symbol(label
, org
, TRUE
, relocate
);
3399 if (*arg
&& ! (op
->flags
& NO_ARGS
)) { // get value argument
3400 if (getexpr(arg
, FALSE
, &expr
) == S_DEFINED
)
3405 expr
.relative
= FALSE
;
3408 if (opcode
& OP_LONG
) { // two-word format, just write code and value
3409 writew(opcode
, FALSE
);
3410 writew(expr
.value
, expr
.relative
);
3412 else { // one-word format
3413 if (strchr(mods
, 'I') != 0)
3414 asm_error("Indirect mode not permitted on one-word instructions");
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
3419 if (expr
.value
< -128 || expr
.value
> 127) {// check range
3420 asm_error("Offset of %d is too large", expr
.value
);
3424 writew(opcode
| (expr
.value
& 0x00FF), FALSE
);// that's the code
3428 // ---------------------------------------------------------------------------------
3429 // mdx_op - assemble a MDX family instruction
3430 // ---------------------------------------------------------------------------------
3432 void mdx_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3434 EXPR dest
, incr
= {0, FALSE
};
3435 int opcode
= basic_opcode(op
, mods
);
3438 if (*label
) // define label
3439 set_symbol(label
, org
, TRUE
, relocate
);
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
3444 dest
.relative
= ABSOLUTE
;
3447 getexpr(tok
, FALSE
, &dest
); // parse the address
3449 tok
= strtok(NULL
, ","); // look for second argument
3451 if (opcode
& OP_LONG
) { // two word format
3452 if (opcode
& OP_INDEXED
) { // format: MDX 2 dest
3454 asm_error("This format takes only one argument");
3456 else { // format: MDX dest,increment
3457 if (opcode
& OP_INDIRECT
)
3458 asm_error("Indirect can't be used without indexing");
3461 // asm_error("This format takes two arguments");
3463 incr
.relative
= ABSOLUTE
;
3466 getexpr(tok
, FALSE
, &incr
);
3468 if (incr
.value
< -128 || incr
.value
> 127) // displacement style (fixed in ver 1.08)
3469 asm_error("Invalid increment value (8 bits signed)");
3471 opcode
|= (incr
.value
& 0xFF);
3474 writew(opcode
, ABSOLUTE
);
3475 writew(dest
.value
, dest
.relative
);
3477 else { // one word format MDX val
3479 asm_error("This format takes only one argument");
3481 if (! (strchr(mods
, 'X') || (opcode
& OP_INDEXED
)))
3482 dest
.value
-= (org
+1); // compute displacement
3484 if (dest
.value
< -128 || dest
.value
> 127)
3485 asm_error("Offset/Increment of %d is too large", dest
.value
);
3487 writew(opcode
| (dest
.value
& 0xFF), FALSE
);
3491 // ---------------------------------------------------------------------------------
3492 // bsi_op - BSI long instruction is like a BSC L, short is standard
3493 // ---------------------------------------------------------------------------------
3495 void bsi_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3497 if (strchr(mods
, 'L') || strchr(mods
, 'I'))
3498 bsc_op(op
, label
, mods
, arg
);
3500 std_op(op
, label
, mods
, arg
);
3503 // ---------------------------------------------------------------------------------
3504 // b_op - branch; use short or long version
3505 // --------------------------------------------------------------------------------
3507 void b_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3509 static struct tag_op
*mdx
= NULL
;
3511 if (strchr(mods
, 'L') || strchr(mods
, 'I')) {
3512 bsi_op(op
, label
, mods
, arg
);
3517 if ((mdx
= lookup_op("MDX")) == NULL
)
3518 bail("Can't find MDX op");
3520 (mdx
->handler
)(mdx
, label
, mods
, arg
);
3523 // ---------------------------------------------------------------------------------
3524 // bsc_op - compute a BSC family instruction
3525 // ---------------------------------------------------------------------------------
3527 void bsc_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3530 int opcode
= basic_opcode(op
, mods
);
3533 if (*label
) // define label
3534 set_symbol(label
, org
, TRUE
, relocate
);
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");
3540 dest
.relative
= ABSOLUTE
;
3543 getexpr(tok
, FALSE
, &dest
);
3545 tests
= strtok(NULL
, ","); // get test characters
3548 tests
= arg
; // short format is BSC tests
3550 if (tests
!= NULL
) { // stick in the testing bits
3551 for (; *tests
; tests
++) {
3553 // bit 0x40 is the BOSC bit
3554 case 'Z': opcode
|= 0x20; break;
3555 case '-': opcode
|= 0x10; break;
3557 case '&': opcode
|= 0x08; break;
3558 case 'E': opcode
|= 0x04; break;
3559 case 'C': opcode
|= 0x02; break;
3560 case 'O': opcode
|= 0x01; break;
3562 asm_error("Invalid test flag: '%c'", *tests
);
3567 writew(opcode
, ABSOLUTE
); // emit code
3568 if (opcode
& OP_LONG
)
3569 writew(dest
.value
, dest
.relative
);
3572 // ---------------------------------------------------------------------------------
3573 // shf_op - assemble a shift instruction
3574 // ---------------------------------------------------------------------------------
3576 void shf_op (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3579 int opcode
= basic_opcode(op
, mods
);
3581 if (*label
) // define label
3582 set_symbol(label
, org
, TRUE
, relocate
);
3584 if (opcode
& OP_INDEXED
) { // shift value comes from index register
3586 expr
.relative
= ABSOLUTE
;
3589 getexpr(arg
, FALSE
, &expr
);
3591 if (expr
.relative
) {
3592 asm_error("Shift value is a relative address");
3593 expr
.relative
= ABSOLUTE
;
3596 if (expr
.value
< 0 || expr
.value
> 32) { // check range
3597 asm_error("Shift count of %d is invalid", expr
.value
);
3601 writew(opcode
| (expr
.value
& 0x3F), FALSE
); // put shift count into displacement field
3604 // ---------------------------------------------------------------------------------
3605 // x_mdm - MDM instruction
3606 // ---------------------------------------------------------------------------------
3608 void x_mdm (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3610 int opcode
= basic_opcode(op
, mods
);
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
);
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 // ---------------------------------------------------------------------------------
3623 void x_exit (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3627 format_line(nline
, label
, "LDX", "X", DOLLAREXIT
, "");
3631 // ---------------------------------------------------------------------------------
3632 // x_opt - .OPT directive. Nonstandard. Possible values:
3634 // .OPT CEXPR - use C precedence in evaluating expressions rather than strict left-right
3635 // ---------------------------------------------------------------------------------
3637 void x_opt (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3641 org_advanced
= FALSE
; // * means this address
3644 asm_error("Label not permitted on .OPT statement");
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)
3653 asm_error("Unknown .OPT: '%s'", tok
);
3657 // ---------------------------------------------------------------------------------
3658 // askip - skip input lines until a line with the target label appears
3659 // ---------------------------------------------------------------------------------
3661 void askip (char *target
)
3663 char nline
[200], cur_label
[20], *c
;
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
3668 prep_line(nline
); // preform standard line prep
3670 strncpy(cur_label
, nline
, 6); // get first 5 characters
3671 cur_label
[5] = '\0';
3673 for (c
= cur_label
; *c
> ' '; c
++) // truncate at first whitespace
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
3684 asm_error("Label %s not found", target
);
3687 // ---------------------------------------------------------------------------------
3688 // x_aif - process conditional assembly jump
3689 // ---------------------------------------------------------------------------------
3691 void x_aif (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3696 enum {OP_EQ
, OP_LT
, OP_GT
, OP_NE
, OP_LE
, OP_GE
} cmp_op
;
3698 // label is not entered into the symbol table
3702 asm_error("AIF operand must start with (");
3706 arg
++; // skip the paren
3708 // normally whitespace is never found in the arg string (see tabtok and coltok).
3709 // However, spaces inside parens are permitted.
3711 if ((tok
= strtok(arg
, whitespace
)) == NULL
) {
3712 asm_error("AIF missing first expression");
3716 getexpr(tok
, FALSE
, &expr1
);
3718 if ((tok
= strtok(NULL
, whitespace
)) == NULL
) {
3719 asm_error("AIF missing conditional operator");
3723 if (strcmp(tok
, "EQ") == 0)
3725 else if (strcmp(tok
, "LT") == 0)
3727 else if (strcmp(tok
, "GT") == 0)
3729 else if (strcmp(tok
, "NE") == 0)
3731 else if (strcmp(tok
, "LE") == 0)
3733 else if (strcmp(tok
, "GE") == 0)
3736 asm_error("AIF: %s is not a valid conditional operator", tok
);
3740 if ((tok
= strtok(NULL
, ")")) == NULL
) {
3741 asm_error("AIF missing second expression");
3745 getexpr(tok
, FALSE
, &expr2
);
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");
3757 // After the closing paren coltok and tabtok guarantee we will have no whitespace
3759 if ((target
= strtok(arg
, ",")) == NULL
) // get target label
3760 asm_warning("Missing target label");
3763 askip(target
); // skip to the target
3766 // ---------------------------------------------------------------------------------
3767 // x_aifb - conditional assembly jump back (macro only)
3768 // ---------------------------------------------------------------------------------
3770 void x_aifb (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3772 asm_error("aifb valid in macros only and not implemented in any case");
3775 // ---------------------------------------------------------------------------------
3777 // ---------------------------------------------------------------------------------
3779 void x_ago (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3783 // label is not entered into the symbol table
3785 // handle differently in a macro
3787 if ((target
= strtok(arg
, ",")) == NULL
) // get target label
3788 asm_warning("Missing target label");
3790 askip(target
); // skip to the target
3793 // ---------------------------------------------------------------------------------
3794 // ---------------------------------------------------------------------------------
3796 void x_agob (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3798 asm_error("agob valid in macros only and not implemented in any case");
3801 // ---------------------------------------------------------------------------------
3802 // ---------------------------------------------------------------------------------
3804 void x_anop (struct tag_op
*op
, char *label
, char *mods
, char *arg
)
3806 // label is not entered into the symbol table
3810 // ---------------------------------------------------------------------------------
3811 // expression parser, borrowed from older code, no comments, sorry
3812 // ---------------------------------------------------------------------------------
3814 char *exprptr
, *oexprptr
;
3816 #define GETNEXT (*exprptr++)
3817 #define UNGET --exprptr
3819 #define LETTER 0 /* character types */
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
);
3837 void exprerr (int n
);
3838 void a1130_expr (EXPR
*ap
);
3839 void a1130_term (EXPR
*ap
);
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
3861 "Missing exponent", // 0
3862 "Undefined symbol", // 1
3863 "Division by zero", // 2
3864 "Illegal operator", // 3
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
3878 if (cexpr
) { // in C mode, handle normally
3879 while (ctype
[(c
= GETNEXT
)] == SPACE
)
3881 } // in 1130 mode, a space terminates the expression. Here, eat the rest
3882 else if ((c
= GETNEXT
) == ' ') {
3883 while ((c
= GETNEXT
) != '\0')
3890 int symbest
, exprerrno
;
3893 // ---------------------------------------------------------------------------------
3895 // ---------------------------------------------------------------------------------
3897 int getexpr (char *pc
, BOOL undefined_ok
, EXPR
*pval
)
3899 symbest
= S_DEFINED
; // assume no questionable symbols
3902 pval
->relative
= ABSOLUTE
;
3904 if (! *pc
) // blank expression is same as zero, ok?
3907 if (setjmp(exprjmp
) != 0) { // encountered a syntax error & bailed
3909 pval
->relative
= ABSOLUTE
;
3913 exprptr
= oexprptr
= pc
; // make global the buffer pointer
3917 if (GETNEXT
) // expression should have been entirely eaten
3918 exprerr(8); // if characters are left, it's an error
3920 if (pval
->relative
< 0 || pval
->relative
> 1)
3921 exprerr(11); // has to work out to an absolute or a single relative term
3923 if (symbest
== S_DEFINED
) // tell how it came out
3927 pval
->relative
= ABSOLUTE
;
3928 return (pass
== 1 && undefined_ok
) ? S_PROVISIONAL
: S_UNDEFINED
;
3931 // ---------------------------------------------------------------------------------
3932 // output_literals - construct .DC assembler lines to assemble pending literal
3933 // constant values that have accumulated.
3934 // ---------------------------------------------------------------------------------
3936 void output_literals (BOOL eof
)
3938 char line
[120], label
[12], num
[20];
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);
3949 sprintf(num
, "%d", literal
[i
].value
);
3951 sprintf(label
, "_L%03d", literal
[i
].tagno
);
3952 format_line(line
, label
, literal
[i
].even
? "DEC" : "DC", "", num
, "GENERATED LITERAL CONSTANT");
3955 eof
= FALSE
; // at end of file, for first literal, only prepare blank line
3956 sprintf(listline
, LEFT_MARGIN
, org
);
3959 listout(TRUE
); // push out any pending line(s)
3961 if (flist
&& list_on
) // this makes stuff appear in the listing
3962 sprintf(listline
, LEFT_MARGIN
" %s", detab(line
));
3966 parse_line(line
); // assemble the constant definition
3969 n_literals
= 0; // clear list
3972 // ---------------------------------------------------------------------------------
3973 // a1130_term - extract one term of an expression
3974 // ---------------------------------------------------------------------------------
3976 void a1130_term (EXPR
*ap
)
3982 if (cexpr
) { // use C syntax
3989 if (ctype
[c
] == DIGIT
) { /* number */
3990 ap
->value
= signextend(c_number(c
,10,-1));
3991 ap
->relative
= ABSOLUTE
;
3993 else if (c
== '+') { /* unary + */
3996 else if (c
== '-') { /* unary - */
3998 ap
->value
= - ap
->value
;
4000 else if (c
== '/') { /* / starts a hex constant */
4001 ap
->value
= signextend(c_number(c
,16,-1));
4002 ap
->relative
= ABSOLUTE
;
4004 else if (c
== '*') { /* asterisk alone = org */
4005 ap
->value
= org
+ org_advanced
; // here is where that offset matters!
4006 ap
->relative
= relocate
;
4008 else if (c
== '.') { /* EBCDIC constant */
4014 c
= ascii_to_ebcdic_table
[c
];
4015 ap
->value
= c
; // VALUE IS IN LOW BYTE!!!
4016 ap
->relative
= ABSOLUTE
;
4018 else if (ctype
[c
] == LETTER
) { /* symbol */
4023 } while (ctype
[c
] == LETTER
|| ctype
[c
] == DIGIT
);
4027 s
= lookup_symbol(token
, TRUE
);
4029 ap
->value
= s
->value
;
4030 ap
->relative
= s
->relative
;
4032 symbest
= MIN(symbest
, s
->defined
); // this goes to lowest value (undefined < provisional < defined)
4033 if (pass
== 2 && s
->defined
!= S_DEFINED
)
4040 // ---------------------------------------------------------------------------------
4041 // signextend - sign-extend a 16-bit constant value to whatever "int" is.
4042 // ---------------------------------------------------------------------------------
4044 int signextend (int v
)
4046 v
&= 0xFFFF; // clip to 16 bits (this may not be necessary, but best to be safe?)
4048 if (v
& 0x8000) // if sign bit is set
4049 v
|= ~0xFFFF; // sign extend
4054 // ---------------------------------------------------------------------------------
4055 // c_expr - evalate an expression
4056 // ---------------------------------------------------------------------------------
4058 void c_expr (EXPR
*ap
)
4063 c_expr_m(ap
); // get combined multiplicative terms
4064 for (;;) { // handle +/- precedence operators
4065 if (ctype
[c
=getnb()] != ADDOP
) {
4069 c_expr_m(&rop
); // right hand operand
4072 ap
->value
+= rop
.value
;
4073 ap
->relative
+= rop
.relative
;
4077 ap
->value
-= rop
.value
;
4078 ap
->relative
-= rop
.relative
;
4082 if (ap
->relative
|| rop
.relative
)
4084 ap
->value
= ((long) (ap
->value
)) | ((long) rop
.value
);
4088 printf("In expr, can't happen\n");
4093 // ---------------------------------------------------------------------------------
4094 // c_expr_m - get multiplicative precedence terms. Again, this is not usually used
4095 // ---------------------------------------------------------------------------------
4097 void c_expr_m (EXPR
*ap
)
4102 c_expr_e(ap
); // get exponential precedence term
4103 for (;;) { // get operator
4105 if ((c
=='<') || (c
=='>'))
4106 if (c
!= getnb()) // << or >>
4108 if (ctype
[c
] != MULOP
) {
4112 c_expr_e(&rop
); // right hand operand
4116 if (ap
->relative
&& rop
.relative
)
4119 ap
->value
*= rop
.value
;
4120 ap
->relative
= (ap
->relative
|| rop
.relative
) ? RELATIVE
: ABSOLUTE
;
4126 if (ap
->relative
|| rop
.relative
)
4129 ap
->value
/= rop
.value
;
4135 if (ap
->relative
|| rop
.relative
)
4138 ap
->value
= ((long) (ap
->value
)) % ((long) rop
.value
);
4142 if (ap
->relative
|| rop
.relative
)
4145 ap
->value
= ((long) (ap
->value
)) & ((long) rop
.value
);
4149 if (ap
->relative
|| rop
.relative
)
4152 ap
->value
= ((long) (ap
->value
)) >> ((long) rop
.value
);
4156 if (ap
->relative
|| rop
.relative
)
4159 ap
->value
= ((long) (ap
->value
)) << ((long) rop
.value
);
4163 printf("In expr_m, can't happen\n");
4168 // ---------------------------------------------------------------------------------
4169 // c_expr_e - get exponential precedence terms. Again, this is not usually used
4170 // ---------------------------------------------------------------------------------
4172 void c_expr_e (EXPR
*ap
)
4180 if (ctype
[c
] != EXPOP
) {
4188 if (ap
->relative
|| rop
.relative
)
4193 for (i
= 0; i
< rop
.value
; i
++)
4198 printf("In expr_e, can't happen\n");
4203 // ---------------------------------------------------------------------------------
4204 // c_expr_u - get unary precedence terms. Again, this is not usually used
4205 // ---------------------------------------------------------------------------------
4207 void c_expr_u (EXPR
*ap
)
4211 if ((c
= getnb()) == '!') {
4213 ap
->value
= ~ ((long)(ap
->value
));
4217 else if (c
== '-') {
4219 ap
->value
= - ap
->value
;
4229 // ---------------------------------------------------------------------------------
4230 // c_term - get basic operand or parenthesized expression. Again, this is not usually used
4231 // ---------------------------------------------------------------------------------
4233 void c_term (EXPR
*ap
)
4239 ap
->relative
= ABSOLUTE
; /* assume absolute */
4241 if ((c
= getnb()) == '(') { /* parenthesized expr */
4242 c_expr(ap
); /* start over at the top! */
4243 if ((cc
= getnb()) != ')')
4246 else if (c
== '\'') { /* single quote: char */
4247 if ((c
= GETNEXT
) == '\0')
4249 ap
->value
= c_esc(c
);
4251 else if (ctype
[c
] == DIGIT
) { /* number */
4252 ap
->value
= signextend(c_number(c
,10,-1));
4254 else if (c
== '0') { /* 0 starts a hex or octal constant */
4255 if ((c
= GETNEXT
) == 'x') {
4257 ap
->value
= signextend(c_number(c
,16,-1));
4260 ap
->value
= signextend(c_number(c
,8,-1));
4263 else if (c
== '*') { /* asterisk alone = org */
4264 ap
->value
= org
+ org_advanced
;
4265 ap
->relative
= relocate
;
4267 else if (ctype
[c
] == LETTER
) { /* symbol */
4272 } while (ctype
[c
] == LETTER
|| ctype
[c
] == DIGIT
);
4276 s
= lookup_symbol(token
, TRUE
);
4277 ap
->value
= s
->value
;
4278 ap
->relative
= s
->relative
;
4280 symbest
= MIN(symbest
, s
->defined
); // this goes to lowest value (undefined < provisional < defined)
4282 if (pass
== 2 && s
->defined
!= S_DEFINED
)
4289 // ---------------------------------------------------------------------------------
4290 // c_number - get a C format constant value. Again, this is not usually used
4291 // ---------------------------------------------------------------------------------
4293 int c_number (int c
, int r
, int nchar
)
4299 if (c
== '/' && ! cexpr
) { /* special radix stuff */
4303 else if (r
== 10 && c
== '0' && cexpr
) { /* accept C style 0x## also */
4316 n
= 0; /* decode number */
4317 while ((nchar
-- != 0) && (v
= digit(c
, r
)) >= 0) {
4318 if (v
>= r
) /* out of range! */
4324 if (c
== '.') { // maybe make it decimal?
4334 // ---------------------------------------------------------------------------------
4335 // digit - get digit value of character c in radix r
4336 // ---------------------------------------------------------------------------------
4338 int digit (int c
, int r
)
4341 if (c
>= 'A' && c
<= 'F')
4342 return (c
- 'A' + 10);
4345 if (c
>= '0' && c
<= '9')
4351 // ---------------------------------------------------------------------------------
4352 // c_esc - handle C character escape
4353 // ---------------------------------------------------------------------------------
4357 if (c
!= '\\') /* not escaped */
4360 if ((c
= GETNEXT
) == '\0') /* must be followed by something */
4362 if ((c
>= 'A') && (c
<= 'Z')) /* handle upper case */
4364 if (ctype
[c
] == LETTER
) /* control character abbrevs */
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 */
4373 else if (ctype
[c
] == DIGIT
) { /* get character by the numbers */
4374 c
= c_number(c
,8,3); /* force octal */
4380 // ---------------------------------------------------------------------------------
4381 // exprerr - note an expression syntax error. Longjumps back to caller with failure code
4382 // ---------------------------------------------------------------------------------
4384 void exprerr (int n
)
4387 int nex
= exprptr
-oexprptr
;
4389 strncpy(msg
, oexprptr
, nex
); // show where the problem was
4391 strcat(msg
, " << ");
4392 strcat(msg
, errstr
[n
]);
4397 longjmp(exprjmp
, 1);
4400 /* ------------------------------------------------------------------------
4401 * upcase - force a string to uppercase (ASCII)
4402 * ------------------------------------------------------------------------ */
4404 char *upcase (char *str
)
4408 for (s
= str
; *s
; s
++) {
4409 if (*s
>= 'a' && *s
<= 'z')
4416 /* ------------------------------------------------------------------------
4417 * hollerith table for IPL card ident field
4418 * ------------------------------------------------------------------------ */
4425 static CPCODE cardcode_029
[] =
4428 0x8000, '&', // + in 026 Fortran
4468 0x0420, '#', // = in 026 Fortran
4469 0x0220, '@', // ' in 026 Fortran
4473 0x8820, 'c', // cent
4475 0x8220, '<', // ) in 026 Fortran
4485 0x2820, 'x', // what?
4487 0x2220, '%', // ( in 026 Fortran
4493 int ascii_to_hollerith (int ch
)
4497 for (i
= 0; i
< sizeof(cardcode_029
) / sizeof(CPCODE
); i
++)
4498 if (cardcode_029
[i
].ascii
== ch
)
4499 return cardcode_029
[i
].hollerith
;
4504 /* ------------------------------------------------------------------------
4505 * detab - replace tabs with spaces for listing files
4506 * ------------------------------------------------------------------------ */
4508 char *detab (char *instr
)
4510 static char outstr
[256];
4515 if (*instr
== '\t') {
4537 int strnicmp (char *a
, char *b
, int n
)
4542 if (--n
< 0) // still equal after n characters? quit now
4545 if ((ca
= *a
) == 0) // get character, stop on null terminator
4548 if (ca
>= 'a' && ca
<= 'z') // fold lowercase to uppercase
4552 if (cb
>= 'a' && cb
<= 'z')
4555 if ((ca
-= cb
) != 0) // if different, return comparison
4562 int strcmpi (char *a
, char *b
)
4567 if ((ca
= *a
) == 0) // get character, stop on null terminator
4570 if (ca
>= 'a' && ca
<= 'z') // fold lowercase to uppercase
4574 if (cb
>= 'a' && cb
<= 'z')
4577 if ((ca
-= cb
) != 0) // if different, return comparison