PROGRAM TLOAD(input,output);
{$U+} {^C active stop}
{$V-} {PARAMETER PASSING CHECKING EASED UP}
{This program takes a file *.PRN and converts it to
to *.PAS with the machine language converted to
TURBO's INLINE requirements for machine language code
----Author Rudy Rawlins,
           Toronto, Ont,
           416-463-2133
           May 6, 1984  }

TYPE

    JMPSET = SET OF $00..$FF;
    str=string[14];
    NAME=STRING[14];
    single_line=STRING[120];
CONST
 FIELD_WIDTH=18;
 TAB=24;
 jmpoffset :jmpset=[$DA,$FA,$D2,$C3,$CD,$D4,$C4,
                    $C2,$F2,$EA,$E2,$DC,$FC,$3A,
                    $CA,$32,$22,$2A,$F4,$EC,$CC];
                   {Opcodes that will be adjusted
                   for proper offset }
VAR
   ok:boolean;
   op1,op2,lin2:integer;
   LINE:STRING[4];
   str2:string[4];
   OPCODE:STRING[26];
   sp,CH:char;
   infilename,FILENAME:NAME;
   COLUMN_COUNT,CHAR_COUNT,I,ERROR_CODE:INTEGER;
   infile,OUTFILE: text;
   sentence:single_line;

 FUNCTION UPPCASE (var sTRG:STR) : STR;
{ALL CHARACTERS IN THE STRG
 ARE CONVERTED TO UPPERCASE}
VAR
    A:ARRAY [1..25] OF CHAR;
    STRG2:STR;
 BEGIN
  strg2:=strg;
  strg:='';
  FOR CHAR_COUNT:=1 TO LENGTH(STRG2) DO
  BEGIN
  A[CHAR_COUNT] := UPCASE (COPY(STRG2,CHAR_COUNT,1));
  strg := strg + A[CHAR_COUNT];
 END;{for}
 uppcase:=strg;
END;{uppcase}

PROCEDURE CHECK_FILE;
 {CHECKS FOR SUFFIX IN FILENAME AS ENTERED BY USER
 ADDS SUFFIX OF '.PRN' IF NOT ENTERED, THEN
 INITIALIZES ALL WORK FILES}

begin
     repeat
      Write ('   Enter name of input file: ');
      readln(filename);
      FILENAME:=UPPCASE(FILENAME);
                INFILENAME:=FILENAME;
 IF POS('.PRN',INFILENAME) = 0 THEN
  BEGIN
   INFILENAME:=INFILENAME+'.PRN';
    {ADDING SUFFIX}
  END {IF..THEN}
   ELSE  BEGIN
    FILENAME:=COPY(FILENAME,1,(LENGTH(FILENAME)-4)); FILENAME:=FILENAME+'.PAS';
   END;{IF.. THEN.. ELSE}

  FILENAME:=FILENAME+'.PAS' ;

  ASSIGN(OUTFILE,FILENAME);
       assign(INfilE,INfilename);
 {$I-}RESET(INFILE) {$I+};
{$I-} REWRITE(OUTFILE) {$I+} ;{OPEN NEW FILE}
      ok := (ioresult = 0);
      if not ok then begin
       writeln ('     Cannot find ' ,infileNAME);
       end; {if..then}
     until ok;
END; {CHECK_FILE}



PROCEDURE CLEAN_UP;

BEGIN

 CLOSE(OUTFILE);
 CLOSE(INFILE);

 END;{CLEAN_UP}

PROCEDURE PROCESS_OFFSET;{nuff said...}
 begin
     STR2:=copy(line,3,2);
     insert('$',STR2,1);
     VAL(STR2,LIN2,ERROR_CODE);
     LIN2 := LIN2 + $03;
     VAL(copy(opcode,5,3),op2,ERROR_CODE);
      if op2 > lin2 then
       begin
        op2:= op2-lin2;
        str(op2,str2);{convert op2 to string to insert
                       in opcode}
        insert('*+'+str2+'/',opcode,5);
       end
     else
       begin
        op2:=lin2-op2;
        str(op2,str2);{convert op2 to string to insert
                        in opcode}
        insert('*-'+str2+'/',opcode,5);
       end;
     if length(str2) >= 2 then delete(opcode,10,8)
     else delete(opcode,9,8);
  end;{process_offset}

PROCEDURE PROCESS_OPCODE; {Processess the opcode from the file
                           and checks for opcode requiring adjustments}
BEGIN
  IF LENGTH(OPCODE)= 6 THEN
    BEGIN
     INSERT('$',OPCODE,1);
     INSERT('/$',OPCODE,4);
     INSERT('/$',OPCODE,8) ;
     INSERT('/',OPCODE,12);
     VAL(copy(opcode,1,3),op1,ERROR_CODE);
  IF OP1 in jmpoffset THEN PROCESS_OFFSET;
    END;{IF..THEN}

  IF LENGTH(OPCODE) = 4 THEN
    BEGIN
     INSERT('$',OPCODE,1);
     INSERT('/$',OPCODE,4);
     INSERT('/',OPCODE,8);
    END;{IF...THEN}

  IF LENGTH(OPCODE) = 2 THEN
    BEGIN
     INSERT('$',OPCODE,1);
     INSERT('/',OPCODE,5);
    END;{IF.. THEN}


     END; {PROCESS_OPCODE}

PROCEDURE PROCESS_FILE; { READS INPUT FILE AND
                         PROCESSES EVERYTHING}
   BEGIN
WHILE NOT EOF(INFILE) DO
  BEGIN

 CH:=' '; OPCODE:=''; SENTENCE:='';
     READ(INFILE,sp,line,sp);
     IF pos(' ',LINE) = 0 THEN
        BEGIN
        READ(infile,CH);

         WHILE (CH <> ' ')  and (ch <> '=') DO
         BEGIN
          OPCODE:=OPCODE+CH;
          READ(infile,CH);
         END;{WHILE}

      PROCESS_OPCODE;
      repeat
       READ(infile,ch);
       if ch= '	' then ch:=' ';
{looking for horizontal tabs (	)
- replace them, more readable }
       sentence:=sentence+ch;
       until eoln(infile);
      COLUMN_COUNT:=FIELD_WIDTH+6-LENGTH(OPCODE);

      WRITELN(outfile,OPCODE ,' {':COLUMN_COUNT , SENTENCE ,' }' );

     END {IF.....THEN}

        ELSE
         BEGIN
           repeat
           READ(infile,ch);
           if ch= '	' then ch:=' ';
{looking for horizontal tabs (	)
- replace them, more readable }
           sentence:= sentence + ch;
           until eoln(infile);
          writeln(outfile,' {':TAB,sentence,' }' );
         END;

          readln(infile);

end;{eof}
END;{PROCDURE}
{*****************Main Programme************}
BEGIN
  REPEAT
   CHECK_FILE;
   PROCESS_FILE;
   CLEAN_UP;
   WRITEln('.......DONE');
   write('Again........ ? ');
   read (kbd, ch);
  until upcase(ch) ='N'
END.{MAIN PROGAM}