program AUTOCODER use BCD_TO_ASCII_M, ONLY: CodeCodes, Encoding, Encodings, Fill_Encoding, & & Init_BCD_to_Ascii use Bootstrap_m, only: BOOTLOADER, CORESIZE use ERROR_M, only: DO_ERROR, N_ERRORS use FLAGS, only: TRACES use INPUT_M, only: INUNIT use IO_UNITS, only: DIAG, INPUT, LIST, OBJ, TAPE, U_DIAG, U_ERROR,& & U_INPUT, U_LIST, U_OBJ, U_REL, U_SCRATCH, U_SCR2, U_TAPE use LITERALS_M, only: DUMP_LIT_TABLE, LONG_LITS use MACHINE, only: Get_Command_Argument, IO_ERROR use MACRO_PASS_M, only: ADD_EXT, ADD_PATH, MACRO_PASS, MA_MACRO use OBJECT_M, only: DO_DIAG, DO_OBJECT, DO_REL, DO_TAPE use OP_CODES_M, only: INIT_OP_CODES use PASS_1_M, only: PASS_1 use PASS_2_M, only: PASS_2 use PASS_3_M, only: EXTRA, INTERLEAVE, MAXLINE, & & NOTIN_1_80, PASS_3 use SYMTAB_M, only: DUMP_SYMTAB use ZONE_M, only: INIT_ZONED implicit NONE character(127) :: ARG ! Command line argument logical :: Do_List = .false. ! Make a listing (turned on by -l) logical :: Do_1440 = .false. ! Assemble 1440 I/O op codes integer :: I, J ! Subscript, loop inductor integer :: IOSTAT ! I/O status logical :: KeepScr = .false. ! Keep the scratch file logical :: NeedPass2 ! Undefined ORG's or EQU's after pass 1 integer :: PGLEN ! Page Length (from -p option) logical :: Saw_Rel ! Pass 1 saw relocatable stuff logical :: SYMTAB ! Dump the symbol table character(len=*), parameter :: & & Version = & & '1401 Autocoder (c) Van Snyder 2017-07-28 version 4.11' interleave = .false. inunit = -1 notIn_1_80 = .true. symtab = .false. traces = '' ! Initialize BCD_to_ASCII call init_BCD_to_ASCII ! Fill the default encoding call fill_encoding ( encodings(encoding) ) i = 0 do i = i + 1 call get_command_argument ( i, arg ) if ( arg(1:1) /= '-' ) exit if ( arg(2:3) == 'a ' ) then notIn_1_80 = .false. else if ( arg(2:2) == 'b' ) then ! Boot if (arg(3:) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if bootLoader = adjustl(arg(3:)) if ( bootLoader >= 'a' .and. bootLoader <= 'z' ) & & bootLoader = achar(iachar(bootLoader) + iachar('A') - iachar('a')) if ( bootLoader /= 'B' .and. bootLoader /= 'I' .and. bootLoader /= 'N' .and. & & bootLoader /= 'V' ) then print *, 'Boot Loader (-b option) must be I or N or B or V; IX used' bootLoader = 'I' arg(4:4) = 'X' end if if ( bootLoader == 'I' ) then select case ( arg(4:4) ) ! Core size flag case ( '0' ) coreSize = 0 ! IBM Boot only, with no clear case ( '1' ) coreSize = 1400 case ( '2' ) coreSize = 2000 case ( '4' ) coreSize = 4000 case ( '8' ) coreSize = 8000 case ( 'V', 'v' ) coreSize = 12000 case ( 'X', 'x' ) coreSize = 16000 case ( ' ' ) case default print *, 'Invalid core size flag. ', coreSize, ' used.' end select end if else if ( arg(2:2) == 'd' ) then ! "Diagnostic" object format file arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if do_diag = .true. diag = arg(3:) open ( u_diag, file=diag, form='formatted', access='sequential', & & iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening "diagnostic format" file', iostat, tape ) stop end if else if ( arg(2:2) == 'e' ) then ! Encodings arg(3:) = adjustl(arg(3:)) if (arg(3:) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if if ( arg(3:3) == '?' ) then ! Print encodings and stop print *, 'Built-in encodings, in BCD order, blank to GM:' print *, ' No zone + A (0) zone + B (11) zone + AB (12) zone +' print *, ' 123456789034567 123456789234567 123456789034567 123456789034567' print *, ' 88888 888888 88888 88888' do j = 1, size(codeCodes) print *, codeCodes(j), ': ', encodings(j) end do print *, '^ is used for blank on even-parity tapes. It does not have an' print *, 'input punch encoding, punches as zero, and prints as record mark.' print *, 'Characters using 5-8, 6-8 or 7-8 do not print on standard chains.' stop end if do j = 1, size(codeCodes) if ( codeCodes(j) == arg(3:) ) then encoding = j exit end if end do if ( arg(3:3) == '*' ) then if ( arg(4:) == '' ) then call get_command_argument ( i, arg ) else arg = arg(4:) end if if ( len_trim(arg) /= 63 ) then print *, 'Invalid encoding: Must be 63 characters in BCD order' else call fill_encoding ( arg(1:63) ) end if else if ( j > size(codeCodes) ) & & print *, 'Invalid encoding, ', codeCodes(encoding), ' used.' call fill_encoding ( encodings(encoding) ) end if else if ( arg(2:2) == 'I' ) then ! Macro search path if ( arg(3:3) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if call add_path ( trim(arg(3:)) ) else if ( arg(2:3) == 'i ' ) then ! Interleave interleave = .true. else if ( arg(2:2) == 'l' ) then ! Listing file arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if do_list = .true. list = arg(3:) open ( u_list, file=list, form='formatted', access='sequential', & & iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening "listing" file', iostat, list ) stop end if else if ( arg(2:3) == 'L ' ) then ! Allow long lits long_lits = .true. else if ( arg(2:3) == 'M ' ) then ! MA is a macro ma_macro = .true. else if ( arg(2:2) == 'm' ) then ! Macro extension if ( arg(3:3) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if call add_ext ( trim(arg(3:)) ) else if ( arg(2:2) == 'o' ) then ! Object file arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if do_object = .true. obj = arg(3:) open ( u_obj, file=obj, form='formatted', access='sequential', & & iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening "object deck" file', iostat, obj ) stop end if else if ( arg(2:2) == 'p' ) then ! Page length arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if read ( arg(3:), *, iostat=iostat ) pgLen if ( iostat == 0 ) then maxLine = pglen else call io_error ( 'While converting -p optipon', iostat ) stop end if else if ( arg(2:2) == 'r' ) then ! Relocatable file arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if do_rel = .true. obj = arg(3:) open ( u_rel, file=obj, form='formatted', access='sequential', & & iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening relocatable file', iostat, obj ) stop end if else if ( arg(2:3) == 's' ) then ! Dump symbol table symtab = .true. else if ( arg(2:2) == 't' ) then ! Object Tape arg(3:) = adjustl(arg(3:)) if ( arg(3:3) == ' ' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if do_tape = .true. tape = arg(3:) open ( u_tape, file=tape, form='formatted', access='sequential', & & iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening "loadable tape" file', iostat, tape ) stop end if else if ( arg(2:2) == 'T' ) then ! Traces arg(3:) = adjustl(arg(3:)) if ( arg(3:) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if traces = trim(traces) // arg(3:) else if ( arg(2:3) == 'V ' ) then ! Print version and stop print '(a)', version stop else if ( arg(2:2) == 'X' ) then ! Special switches arg(3:) = adjustl(arg(3:)) if ( arg(3:) == '' ) then i = i + 1 call get_command_argument ( i, arg(3:) ) end if read ( arg(3:), *, iostat=iostat ) extra if ( iostat /= 0 ) then call io_error ( 'While processing X option', iostat, input ) stop end if else if ( arg(2:) == '-keepscratch' ) then keepScr = .true. else if ( arg(2:) == '1440' ) then do_1440 = .true. else if ( arg(2:) == '' ) then exit else call get_command_argument ( 0, arg ) print 1, 'Usage: ', trim(arg), ' [options] [input-file]' print 1, ' Options:' print 1, ' -h => Print this information and stop' print 1, ' -a => Code in 1..80 is OK' print 1, ' -b[ ]X[#] => Select boot loader;' print 1, ' X = I => IBM, # is the core size selector:' print 1, ' 0 => Boot, no clear, sequence numbers start at 3,' print 1, ' 1 => 1400, 2 => 2000, 4 => 4000, 8 => 8000,' print 2, ' v => 12000, x => 16000. Default ', coreSize print 1, ' X = N => None,' print 1, ' X = B => Van''s favorite 1-card boot/no clear,' print 1, ' X = V => Van''s favorite 2-card boot/clear,' print 1, ' -d[ ]file => Diagnostic format "deck" file' print 1, ' -e[ ]X[ ][explicit] => Specify encoding, default ', codeCodes(encoding) print 1, ' X = A => Paul Pierce''s primary (IBM A) encoding' print 1, ' X = H => Paul Pierce''s alternative (IBM H) encoding' print 1, ' X = S => SIMH "traditional" encoding' print 1, ' X = I => Icelandic encoding' print 1, ' X = * => Explicit encoding; "explicit" must be 63 characters,' print 1, ' in BCD order, 1 ... GM. Blank is assumed first.' print 1, ' X = ? => Print built-in encodings and stop' print 1, ' Differences: 12 0 11 0 12 0 0 12' print 1, ' 2 3 3 4 4 4 5 7 7 7' print 1, ' 8 8 8 8 8 8 8 8 8 8' print 1, ' =================================================' print 1, ' A: Pierce Primary & | # $ @ % ) ~ { " }' print 1, ' H: Pierce Alternate + | = $ '' ( ) ~ { " }' print 1, ' S: Traditional SIMH & '' # $ @ % ) = ( + "' print 1, ' I: Icelandic Ð | Æ É Ö Þ Á ~ { " }' print 1, ' -I[ ]path => A path to search for macros. First is always' print 1, ' "." Any number of -I options can appear. Paths are' print 1, ' searched in the order specified. INCLD or CALL' print 1, ' file names are first three letters, macro file' print 1, ' names are all five, all caps or all lower case.' print 1, ' -i => Interleave object deck into listing ', & & '(needs -o and -l)' print 1, ' -l[ ]file => Listing file' print 1, ' -L => Store long literals once (unlike "real" Autocoder)' print 1, ' -M => MA is a macro in file ma or MA' print 1, ' -m[ ]ext => Add .ext to the list of extensions to use when' print 1, ' searching for macros. Macros are searched in lower' print 1, ' case first (including extensions), then upper case.' print 1, ' Any number of -m options can be specified. The path' print 1, ' loop is inside the extension loop' print 1, ' -o[ ]file => Object "deck" file' print 2, ' -p[ ]# => Page length in lines, default ', maxLine print 1, ' -r[ ]file => Relocatable object file' print 1, ' -s => Dump the symbol and literal tables (debug)' print 1, ' -t[ ]file => Loadable "tape" file' print 1, ' -T[ ]letters => Trace, depending on letters' print 1, ' l => Lexer, p => Parser, M => Macro files' print 1, ' P => PROCESS_LTORG' print 1, ' -V => Print version info and stop' print 1, ' -1440 => Assemble 1440 I/O op codes' print 1, ' -X[ ]flags => Set "extra" flags (sum them if needed):' print 1, ' flag 1 => Quick EX/XFR' print 1, ' flag 2 => Quick END' print 1, ' flag 4 => Queue SW instructions' print 1, ' flag 8 => No reloader after EX/XFR' print 1, 'If [input-file] is not on the command line it is taken from standard input' print 1, version stop 1 format (3a) 2 format (a,i0) end if end do if ( arg(1:1) /= '-' .and. arg /= '' ) then inunit = u_input input = arg open ( u_input, file=input, form='formatted', access='sequential', & & status='old', iostat=iostat ) if ( iostat /= 0 ) then call io_error ( 'While opening input file', iostat, input ) stop end if end if if ( keepScr ) then open ( u_scratch, form='formatted', access='sequential', & & file='scratch' ) open ( u_scr2, form='formatted', access='sequential', & & file='scr2' ) else open ( u_scratch, form='formatted', access='sequential', & & status='scratch' ) open ( u_scr2, form='formatted', access='sequential', & & status='scratch' ) end if call init_op_codes ( do_1440 ) call init_zoned call macro_pass rewind ( u_scr2 ) do n_errors = 0 u_error = u_scratch call pass_1 ( iostat, needPass2, saw_rel ) if ( saw_rel .and. ( do_object .or. do_tape .or. do_diag ) ) then print *, 'Relocatable output cannot be to -o, -t or -d file' cycle end if if ( iostat > 0 ) exit u_error = -1 if ( do_list ) u_error = u_list if ( symtab ) then call dump_symtab ( heading='After pass 1:' ) call dump_lit_table ( -1 ) end if if ( iostat > 0 ) exit if ( needPass2 ) then call pass_2 ( saw_rel )! Resolve forward EQU, ORG and LTORG references if ( symtab ) then call dump_symtab ( heading='After pass 2:' ) call dump_lit_table ( -1 ) end if end if call pass_3 ( do_list, saw_rel ) if ( n_errors > 0 ) then write ( arg(1:5), '(i5)' ) n_errors call do_error ( arg(1:5) // ' Errors' ) end if if ( keepScr ) exit if ( iostat /= 0 ) exit end do end program AUTOCODER ! $Log: $ ! Version 1: Initial working version ! Version 1.1: Minor bug fix ! Version 1.2: 2004-12-09 Make scratch file scratch instead of named; ! Version 1.3: ! Add Quick EX and Quick END; For Lahey, use getarg from Machine; ! Add SW queueing. ! Version 1.4: Allow ¢ for blank for even parity tape, skip pass 2 if not ! needed, some cannonball polishing. ! Version 1.5: Forgot to enter reason for it ! Version 1.6: Assemble without an END card ! Version 1.7: Bug fix to get rid of extra card after last card ! Version 1.8: Put "1040" in 68-71 of last object card if no END ! Version 1.9: Correct opcode for 7 is WRP ! Finish object card if JOB and no -X options ! Version 2.0: "Diagnostic deck" format with -d option, -bI0 option, ! repair bug DSA not announcing symbol error ! Version 2.1: Add Pierce's encodings and -e option to select encoding ! Version 2.2: Repair a bug in boot loader indexing ! Version 2.3: Print correct current encoding, print encodings if -e?, ! improve usage description, handle blanks after initial letter of option ! even if they're not in a different command-line field ! Version 2.4: Turn tabs in input into blanks. ! Version 2.5: Print GMARK for group marks instead of record marks. ! Version 2.6: Put NUM_LITS in scratch file if XFR. ! Version 2.7: Use BCD_TO_ASCII to get WM and GM for tape output. ! Version 2.8: Remove counts from bootable tape format ! Version 3.0: Implement INCLD, default encoding is Pierce A, ! finish getting group mark from bcd_to_ascii for tape output ! Version 3.1: Fix error in load address on tape if card obj also ! Version 3.2: Implement CALL, materialize INCLD at LTORG (wrong in 3.0). ! Version 3.3: Spiff up the help message ! Version 3.4: Add 1440 I/O op codes ! Version 3.5: Bugs in INCLD, lits, SFX handling, parsing ! Version 3.6: Macros, bugs in DA, DCW ! Version 3.7: Yet another DCW bug (cut off at 48 instead of 50) ! and a macro bug (need to left-adjust and trim macro arg) ! Version 3.8: Correct off-by-one in dcw &@xyz@ (was making yz@ lit). ! List card number on DA lines, DA with negative numeric operand. ! Four-character sequence numbers with 1401 overflow. Adcons with *. ! Version 3.9: Allow one blank in a label; allow zone on last digit ! of number, except in DA; no SFX printed on JOB, SFX or Macro lines. ! Version 3.10: Explicit error message for DC/DCW wider than 52 chars. ! Version 3.11: Make D-modifier optional on SS ! Version 3.12: Don't allow zone-signed number as offset, eg name+number ! Version 3.13: Add macro extensions ! Version 3.14: Make sure Operands variable is completely defined ! Version 3.15: Correct usage instructions for -I option. ! Version 3.16: Check macro name to be MA or at least three characters. ! Version 3.17: Made junk in 73-75 a warning instead of error. ! Version 3.18: Do top-of-form on bootstrap listings after the first program ! Version 3.19: Add SPS support ! Version 3.20: Correct errors and oversights in SPS support ! Version 3.21: Add Icelandic encoding ! Version 3.22: Arbitrary encodings allowed by -e* option, lexer works in BCD ! Version 3.23: Correct wrong BCD name for ) -- B_SQUARE instead of B_RPAREN ! Version 4.0: Relocatable output; substantial other changes ! Version 4.1: Correct position of undef for 5- and 8- character instructions ! Version 4.2: Repair some trivial bugs re more than one assembly ! Version 4.3: Version 4.2 broke something; revert to 4.1, fix bug in ORG *&X00. ! Version 4.4: Repair another bug in ORG *&X00, bug in CC, new tape boot ! Version 4.5: Junk in 73-75 OK for comment, print %, #, index in Platt field ! Version 4.6: Allow offset on END, EX, XFR ! Version 4.7: Tiny improvement in tape bootstrap record, repair bug in CU ! Version 4.8: Don't require A address for RP instruction ! Version 4.9: Correct third line of Differences in encodings help ! Version 4.10: Work around a gfortran 4.4.7 bug in BCD_to_ASCII ! Version 4.11: Output correct CW in card loader column 47 in all encodings