Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50415/adres.sim
There are 2 other files named adres.sim in the archive. Click here to see a list.
OPTIONS(/l); COMMENT address file handling and printing program;
COMMENT written by Jacob Palme, FOA 1, 104 50 Stockholm 80, SWEDEN;
COMMENT Version 0A, December 20, 1975;
BEGIN
  EXTERNAL TEXT PROCEDURE scanto, from, conc2, front;
  EXTERNAL INTEGER PROCEDURE search, trmop;
  EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext, dotypeout;
  EXTERNAL REF (outfile) PROCEDURE findoutfile;
  EXTERNAL CHARACTER PROCEDURE findtrigger;
  EXTERNAL INTEGER PROCEDURE scanint;
  EXTERNAL LONG REAL PROCEDURE scanreal;
  EXTERNAL REF (infile) PROCEDURE findinfile;
  EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,
  checkextension;
  EXTERNAL PROCEDURE split;
  EXTERNAL CLASS safmin;
  EXTERNAL BOOLEAN PROCEDURE sqhelp;
  EXTERNAL CLASS decom;
  EXTERNAL CLASS select;
  INTEGER i, max_number_of_lines, lastline, lastlinep1,
  line_number, sortlength, page_step;
  INTEGER count_of_input, count_of_output, count_of_error;
  INTEGER count_of_rejected;
  INTEGER labels_per_width, left_margin, label_width, label_spacing;
  INTEGER line1_length, line2_length, line_dimension, in_dimension;
  BOOLEAN end_of_file, usetabs, select_output, line1_output,
  label_output, list_output, file_output, presort_output, asort_output;
  BOOLEAN caseshift;
  TEXT infilename, outfilename, blanktext, command;
  TEXT motoron, motoroff, removetabs, settab;
  TEXT mainline;
  CHARACTER altmode, formfeed, tab;
  REF (infile) infileref; REF (outfile) outfileref;

  select CLASS label_select;
  BEGIN
    REF (operator) line1_condition, line2_condition;
  END;
  line_dimension:= 40;
  outtext("[ADRES is here]"); outimage;
  outtext("[For HELP type ? followed by one word"
  " with the subject you want help on]"); outimage;
  decom(14) BEGIN
    margin:= 0;
    INSPECT NEW label_select DO
    BEGIN
      TEXT line1_selector, line2_selector;
      REF (label_data) first_label, last_label;
      PROCEDURE set_dependent_parameters;
      BEGIN
        count_of_rejected:= count_of_error:=
        count_of_input:= count_of_output:= 0;
        end_of_file:= FALSE;
        IF asort_output OR presort_output OR file_output THEN
        BEGIN
          labels_per_width:= 1; usetabs:= FALSE;
          label_width:= line2_length;
          max_number_of_lines:= line_dimension-2;
        END;
        lastline:= max_number_of_lines+1;
        lastlinep1:= lastline+1;
        in_dimension:= line_dimension - 1 - line2_length//label_width;
        sysout.image:- blanks(line1_length);
        IF list_output THEN
        BEGIN page_step:= max_number_of_lines+1;
          page_step:= 60//page_step-1;
          page_step:= page_step*labels_per_width;
        END;
        linecopy_buffer:- blanks(
        IF select_output THEN
           (IF line2_condition == NONE THEN
               (IF caseshift THEN line1_length ELSE 0)
            ELSE line2_length*10)
        ELSE 0);
        IF line1_output THEN
        BEGIN
          IF line1_length > line2_length THEN line2_length:= line1_length
          ELSE line1_length:= line2_length;
        END;
      IF sysout == outfileref AND usetabs THEN
      BEGIN
        if trmop(8R2005,sysout,1) = 0 then !IF TTY NO TAB;
        begin ! then .SET TTY TAB;
          outtext("TTY TAB has been set by the ADRES program.");
          outimage;
     	END;
     END;
     IF usetabs THEN
     BEGIN
          outtext("Make sure that your terminal really can handle"
          " tabs in the same way as"); outimage;
          outtext("GNT, Terminet and similar terminals. If not,"
          " use the /NOTABS switch"); outimage;
          outtext("to the input for the ADRES program.");
          outimage;
      end;
      END;

      PROCEDURE outline(t); NAME t; TEXT t;
      BEGIN
        sysout.image:= t; outimage;
      END;
      BOOLEAN PROCEDURE adres_help(selector);
      VALUE selector; TEXT selector;
      BEGIN
        IF selector == NOTEXT AND sysin.image =/= NOTEXT THEN
        BEGIN
          command:- sysin.image.strip;
          command.setpos(1); IF command.getchar = '?' THEN
          selector:- command.sub(2,command.length-1);
        END;
        sqhelp("ADRES",selector,19,72);
      END;
      PROCEDURE interpret_integer_switches;
      BEGIN
        intswitch("LINES","5",max_number_of_lines,
        max_number_of_lines > 0 AND max_number_of_lines < 11,
        "Must be between 0 and 11",adres_help(" /LINES"));
        intswitch("LABELS","3",labels_per_width,
        labels_per_width >= 1,"Must be >= 1",adres_help(" /LINES"));
        intswitch("LEFT","0",left_margin,
        left_margin >= 0 AND left_margin < 114,
        "Must be between 0 and 114",
        adres_help(" /LABELS"));
        intswitch("WIDTH","36",label_width,
        label_width > 5 AND
        label_width < (132-left_margin)//labels_per_width,
        "Too large or < 6",adres_help(" /WIDTH"));
        IF boolswitch("SINGLE",TRUE,NOTEXT,adres_help(" /SINGLE")) THEN
        BEGIN
          labels_per_width:= 1; left_margin:= 1;
          label_width:= 48;
        END;
        intswitch("TAB","41",label_spacing,
        labels_per_width <= 1 OR
        (label_spacing < (132-left_margin)//labels_per_width AND
        label_spacing > label_width),
        "Too large or less than /WIDTH",adres_help(" /TAB"));
        intswitch("LINE1","300",line1_length,
        line1_length > 0,"Must be positive",adres_help(" /LINE1"));
        intswitch("LINE2","80",line2_length,
        line2_length > 0 AND line2_length >= label_width,
        "Must be positive and larger than /WIDTH",
        adres_help(" /LINE2"));
      END of interpret_integer_switches;

      PROCEDURE interpret_boolean_switches;
      BEGIN
        usetabs:= NOT boolswitch("NOTABS",TRUE,NOTEXT,
        adres_help(" /NO"));
        list_output:= boolswitch("LIST",TRUE,NOTEXT,
        adres_help(" /LIST"));
        file_output:= boolswitch("FILE",NOT list_output,
        "Only one kind of output",adres_help(" /FILE"));
        presort_output:= boolswitch("PRESORT",
        NOT list_output AND NOT file_output,
        "Only one kind of output",adres_help(" /PRESORT"));
        asort_output:= boolswitch("ASORT",
        NOT list_output AND NOT file_output
        AND NOT presort_output, "Only one kind of output",
        adres_help(" /ASORT"));
        select_output:= boolswitch("SELECT",NOT asort_output,
        "/SELECT will not work combined with /ASORT",
        adres_help(" /SELECT"));
        caseshift:= NOT boolswitch("NOCASESHIFT",select_output,
        "/NOCASESHIFT only meaningful combined with /SELECT",
        adres_help(" /NOCASESHIFT"));
        label_output:= NOT (list_output OR
        file_output OR presort_output OR asort_output
        OR boolswitch("NOLABEL",list_output OR
        file_output OR presort_output OR asort_output,
        "No kind of output",
        adres_help(" /NOLABEL")));
        line1_output:= boolswitch("OUT1",
        label_output OR list_output,
        "/OUT1 only meaningful with /LIST or /LABEL",
        adres_help(" /OUT1"));
      END of interpret_boolean_switches;

      PROCEDURE request_selectors;
      BEGIN
        displaydefault:= FALSE;
        outtext("Give Boolean condition on line 1");
        outimage; request(":",
        NOTEXT,textinput(line1_selector,
        build_condition(line1_condition,line1_selector,caseshift)),
        select_errmess,adres_help(" /SELECT"));
        outchar('('); tree_print(line1_condition);
        outchar(')'); outimage;
        outtext("Give Boolean condition on lines after line 1");
        outimage; request(":",
        NOTEXT,textinput(line2_selector,
        build_condition(line2_condition,line2_selector,caseshift)),
        select_errmess,adres_help(" /SELECT"));
        outchar('('); tree_print(line2_condition);
        outchar(')'); outimage;
        displaydefault:= TRUE;
      END;
      BOOLEAN PROCEDURE files_can_be_created;
      BEGIN TEXT oldextension, newextension;
        IF outfilename = NOTEXT THEN outfilename:-copy("TTY:");
        IF infilename = NOTEXT THEN
        BEGIN
          IF (label_output OR list_output OR presort_output) THEN
          BEGIN
            infilename:- copy(outfilename);
            IF findtrigger(infilename,dottext) = '.' THEN
            infilename:- infilename.sub(1,infilename.pos-2);
          END ELSE
          BEGIN
            outtext("?ADRES - Both infile and outfile name must");
            outimage;
            outtext("be given when creating .ADR files");
            outimage; GOTO out;
          END;
        END;
        newextension:- copy(
        IF label_output THEN ".LAB" ELSE IF list_output THEN ".LST"
        ELSE IF presort_output THEN ".USR" ELSE ".ADR");
        oldextension:- copy(
        IF asort_output THEN ".SRT" ELSE ".ADR");
        createfiles(outfilename,infilename,
        newextension, oldextension,
        outfileref,infileref,adres_help("file"));
        files_can_be_created:= TRUE;
        out:
      END;
      BOOLEAN PROCEDURE interpret_legal_command;
      BEGIN
        IF NOT deccom(upcase(command),outfilename,infilename)
        THEN GOTO out;
        displaydefault:= TRUE;
        interpret_integer_switches;
        interpret_boolean_switches;
        IF select_output THEN request_selectors ELSE
        line1_condition:- line2_condition:- NONE;
        IF NOT illegalswitch(
        "Uninterpretable or duplicate switch: /",adres_help(""))
        THEN interpret_legal_command:= files_can_be_created;
        out:
      END;
PROCEDURE adjust_label_form;
BEGIN
  BOOLEAN positioned;
  WHILE NOT positioned DO
  BEGIN
  request("Is this first line on a label?","NO",boolinput(positioned),
  NOTEXT,adres_help("inserting label forms"));
  END;
END;
      PROCEDURE read_input_command;
      BEGIN CHARACTER c;
        prompt:
        displaydefault:= FALSE;
        request("*",nodefault,textinput(command,
        interpret_legal_command),
        NOTEXT,adres_help(""));
        set_dependent_parameters;
        IF label_output AND outfileref == sysout THEN
        adjust_label_form;
      END of read_input_command;

      CLASS label_data;
      BEGIN
        REF (label_data) next;
        TEXT line_buffer, sort_buffer;
        TEXT ARRAY line(1:line_dimension), stripline(1:line_dimension);
        TEXT second_alg_buffer;
        INTEGER number_of_lines, line_number;
        BOOLEAN faulty_address, erased_address;
        IF first_label == NONE THEN first_label:- THIS label_data
        ELSE last_label.next:- THIS label_data;
        next:- first_label;
        last_label:- THIS label_data;
          line_buffer:-
          blanks(5+line1_length+(line_dimension-1)*line2_length);
          sort_buffer:- line_buffer.sub(6,line_buffer.length-5);
          line(1):- line_buffer.sub(6,line1_length);
          FOR i:= 2 STEP 1 UNTIL line_dimension DO
          line(i):- line_buffer.sub
          (6+line1_length+(i-2)*line2_length,line2_length);
        second_alg_buffer:- blanks(label_width*max_number_of_lines);
      END of label_data;

      label_data CLASS label_operations;
      BEGIN

        PROCEDURE erase_address;
        BEGIN
          erased_address:= TRUE;
          line[1]:= stripline[1]:= NOTEXT;
          FOR number_of_lines:= 2 STEP 1 UNTIL lastline DO
          BEGIN
            line[number_of_lines]:=
            IF presort_output THEN NOTEXT ELSE "*****";
            stripline[number_of_lines]:- line[number_of_lines].strip;
          END;
          number_of_lines:= lastline;
        END;

        PROCEDURE error(errmess); NAME errmess; TEXT errmess;
        BEGIN INTEGER i, addcount;
          faulty_address:= TRUE;
          outtext("?ADRES - "); outtext(errmess);
          outimage;
          i:= number_of_lines; IF i > 4 THEN i:= 4;
          FOR line_number:= 1 STEP 1 UNTIL i DO
          BEGIN
            image:= stripline(line_number); outimage;
          END;
          outimage;
addcount:= 2+i; addcount:= lastline-mod(addcount,lastline);
If addcount = lastline then addcount:= 0;
for i:= 1 step 1 until addcount do outimage;
          erase_address;
        END;

        PROCEDURE divide_line;
        BEGIN
          line[number_of_lines+1]:= line[number_of_lines].
          sub(label_width+1,line2_length-label_width);
          line[number_of_lines].sub(label_width+1,
          line2_length-label_width)
          := NOTEXT;
          stripline[number_of_lines]:- line[number_of_lines].sub(1,
          label_width);
          number_of_lines:= number_of_lines+1;
          stripline[number_of_lines]:- line[number_of_lines].strip;
        END;

        PROCEDURE too_many_lines;
        INSPECT infileref DO
        BEGIN
          error("Too many lines in input address.");
          WHILE TRUE DO
          BEGIN
            inimage; image.setpos(image.strip.length);
            IF (IF image.more THEN image.getchar ELSE ' ')
            = formfeed THEN GOTO out;
          END;
          out: image:= NOTEXT;
        END;

        BOOLEAN PROCEDURE select_this_address;
        BEGIN
          BOOLEAN select;
          IF line_scan(line1_condition,stripline(1)) THEN
          BEGIN
            IF array_scan(line2_condition,
            stripline,2,number_of_lines)
            THEN
            select:= TRUE;
          END;
          IF NOT select THEN count_of_rejected:= count_of_rejected+1;
          select_this_address:= select;
        END;

        PROCEDURE read_an_address;
        INSPECT infileref DO
        BEGIN
          top: number_of_lines:= IF line1_output THEN 2 ELSE 1;
          IF faulty_address THEN count_of_error:= count_of_error+1;
          erased_address:= faulty_address:= FALSE;
          IF endfile THEN
          BEGIN
            end_of_file:= TRUE; erase_address;
          END ELSE

          BEGIN
            count_input;
            again:
            WHILE NOT endfile AND number_of_lines <= in_dimension DO
            BEGIN
              image:- line[number_of_lines];
              inimage; IF endfile THEN image:= NOTEXT;
              stripline[number_of_lines]:- line[number_of_lines].strip;
              IF stripline[number_of_lines] == NOTEXT AND
              number_of_lines
              > 1 THEN GOTO again;
              stripline[number_of_lines].setpos(stripline[
              number_of_lines
              ].length);
              IF number_of_lines > 1 THEN
              WHILE stripline[number_of_lines].length >
              label_width DO divide_line;
              IF (IF stripline[number_of_lines] = NOTEXT THEN ' ' ELSE
              stripline[number_of_lines].getchar) = formfeed THEN
              BEGIN COMMENT end of address;
                stripline[number_of_lines]:-
                stripline[number_of_lines].sub(1,
                stripline[number_of_lines].length-1);
                IF stripline[number_of_lines] = NOTEXT THEN
                number_of_lines:= number_of_lines-1;
                GOTO out;
              END;
              number_of_lines:= number_of_lines+1;
            END;

            IF endfile THEN number_of_lines:= number_of_lines-1;
            IF number_of_lines > in_dimension THEN
            BEGIN
              too_many_lines; GOTO top;
            END;
            out: IF number_of_lines <= 1 THEN
            BEGIN IF endfile or count_of_input = 1 THEN
              count_of_input:= count_of_input-1 ELSE
              BEGIN
                number_of_lines:= 10;
                error("No text in address after or at:");
              END;
              GOTO top;
            END;
            IF select_output THEN
            BEGIN IF NOT select_this_address THEN GOTO top;
            END;
          END;
        END of read_an_address;

        PROCEDURE count_input;
        BEGIN
          count_of_input:= count_of_input+1;
          IF mod(count_of_input,10) = 0 AND sysout =/= outfileref THEN
          BEGIN sysout.outchar('.'); sysout.breakoutimage;
          END;
        END;

        BOOLEAN PROCEDURE reformat_first_algorithm;
        BEGIN
          INTEGER firstno, secondno;
          reformat_first_algorithm:= TRUE;
          WHILE number_of_lines > lastline DO
          BEGIN
            firstno:= 2; secondno:= 3;
            FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
            BEGIN
              while stripline[secondno] == NOTEXT DO
              secondno:= secondno+1;
              IF stripline[firstno].length +
              stripline[secondno].length + 2 < label_width THEN
              BEGIN
                mainline:- line[firstno];
                mainline.setpos(stripline[firstno].length+1);
                puttext(mainline,", ");
                puttext(mainline,stripline[secondno]);
                stripline[firstno]:- mainline.strip;
                stripline[secondno]:- NOTEXT;
                number_of_lines:= number_of_lines-1;
                GOTO compressmore;
              END;
              firstno:= secondno; secondno:= firstno+1;
            END;
            reformat_first_algorithm:= FALSE; GOTO out;
            compressmore:
          END;
          out: secondno:= 3;
          FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
          BEGIN
            WHILE stripline[secondno] == NOTEXT
            DO secondno:= secondno+1;
            stripline[line_number]:- stripline[secondno];
            secondno:= secondno+1;
          END;
        END;

        BOOLEAN PROCEDURE reformat_second_algorithm;
        BEGIN
          TEXT rest_of_buffer;
          rest_of_buffer:- second_alg_buffer;
          FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
          BEGIN
            i:= stripline[line_number].length;
            IF rest_of_buffer.length <= i THEN GOTO bad;
            rest_of_buffer:= stripline[line_number];
            rest_of_buffer:- rest_of_buffer.sub(i+1,
            rest_of_buffer.length-i);
            IF rest_of_buffer.length >= 2 AND i < label_width AND
            line_number < number_of_lines THEN
            BEGIN
              rest_of_buffer.sub(1,2):= ", ";
              rest_of_buffer:- rest_of_buffer.sub(3,
              rest_of_buffer.length-2);
            END;
            IF line_number <= max_number_of_lines+1 THEN
            stripline[line_number]:- second_alg_buffer.
            sub(1+(line_number-2)*label_width,label_width);
          END;
          number_of_lines:= max_number_of_lines+1;
          reformat_second_algorithm:= TRUE;
          bad:
        END;

        BOOLEAN PROCEDURE can_be_reformatted;
        BEGIN
          IF reformat_first_algorithm THEN can_be_reformatted:= TRUE ELSE
          IF reformat_second_algorithm THEN can_be_reformatted:= TRUE ELSE
          error("Too much text in this address");
        END of can_be_reformatted;

        PROCEDURE write_line(this_line);
        TEXT this_line;
        INSPECT outfileref DO
        BEGIN
          outtext(this_line);
          IF next == first_label THEN
          BEGIN outimage; IF NOT usetabs THEN setpos(left_margin+1);
          END ELSE IF usetabs THEN outchar(tab)
          ELSE setpos(pos+label_spacing-this_line.length);
        END of write_line;

        PROCEDURE output_count;
        BEGIN
          count_of_output:= count_of_output+1;
          IF list_output THEN
          BEGIN
            IF mod(count_of_output,page_step) = 1
            THEN outfileref.outchar(formfeed);
          END;
        END of output_count;

      END of label_operations;

      label_operations CLASS label_address;
      BEGIN
        detach; WHILE TRUE DO
        BEGIN
          nextin: read_an_address;
          IF NOT can_be_reformatted AND NOT end_of_file THEN GOTO nextin;
          IF THIS label_address == first_label AND end_of_file THEN detach
          ELSE IF labels_per_width > 1 THEN resume(next);
          IF NOT erased_address THEN output_count;
          FOR line_number:= 2 STEP 1 UNTIL lastlinep1 DO
          BEGIN
            write_line(IF line_number <= number_of_lines THEN
            stripline[line_number] ELSE NOTEXT);
            IF labels_per_width > 1 THEN resume(next);
          END of for loop;
        END of while loop;
      END of label_address;

      label_operations CLASS file_address;
      BEGIN
        TEXT line1m1;
        line1m1:- line[1].main.sub(5,line1_length+1);
        detach; WHILE TRUE DO
        BEGIN
          nextin: read_an_address;
          IF end_of_file THEN detach;
          IF NOT erased_address THEN INSPECT outfileref DO
          BEGIN
            count_of_output:= count_of_output+1;
            IF count_of_output = 1 THEN image:- line[1] ELSE
            BEGIN image:- line1m1; image.putchar(formfeed);
            END;
            outimage;
            FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
            BEGIN
              image:- stripline[line_number]; outimage;
            END of for loop;
          END of inspect;
        END of while loop;
      END of label_address;

      label_operations CLASS asort_address;
      BEGIN
        TEXT line1m1;
        line1m1:- line[1].main.sub(5,line1_length+1);
        infileref.image:- sort_buffer;
        detach; WHILE TRUE DO
        BEGIN
          nextin: infileref.inimage;
          IF infileref.endfile THEN detach;
          count_input;
          IF NOT erased_address THEN INSPECT outfileref DO
          BEGIN
            count_of_output:= count_of_output+1;
            IF count_of_output = 1 THEN image:- line[1] ELSE
            BEGIN image:- line1m1; image.putchar(formfeed);
            END;
            outimage;
            FOR line_number:= 2 STEP 1 UNTIL line_dimension DO
            BEGIN
              image:- line[line_number].strip;
              IF image = NOTEXT THEN GOTO out;
              outimage;
            END of for loop;
            out:
          END of inspect;
        END of while loop;
      END of asort_address;

      label_operations CLASS presort_address;
      BEGIN
        detach; WHILE TRUE DO
        BEGIN
          nextin: read_an_address;
          IF end_of_file THEN detach;
          IF NOT erased_address THEN INSPECT outfileref DO
          BEGIN
            count_of_output:= count_of_output+1;
            image:- sort_buffer.strip;
            IF image.sub(image.length,1).getchar=formfeed THEN
            BEGIN image.sub(image.length,1).putchar(' ');
              image:- image.sub(1,image.length-1);
            END;
            IF sortlength < image.length THEN sortlength:= image.length;
            outimage;
          END of inspect;
        END of while loop;
      END of label_address;

      PROCEDURE create_labels;
      BEGIN
        INTEGER label_no;
        first_label:- NONE;
        FOR label_no:= 1 STEP 1 UNTIL labels_per_width DO
        IF file_output THEN NEW file_address ELSE
        IF presort_output THEN NEW presort_address ELSE
        IF asort_output THEN NEW asort_address ELSE
        NEW label_address;
      END of create_labels;

      PROCEDURE set_tab_settings_on_the_terminal;
      INSPECT outfileref DO
      BEGIN
        outtext(motoron); outtext(removetabs); outimage;
        setpos(pos+left_margin); outtext(settab);
        FOR i:= 2 STEP 1 UNTIL labels_per_width DO
        BEGIN
          setpos(pos+label_spacing); outtext(settab);
        END;
      END;

      PROCEDURE open_files;
      BEGIN
        infileref.open(blanks(80));
        IF outfileref =/= sysout and label_output then
        BEGIN
          outtext("You must do .TTY NO CRLF");
          if usetabs then
          outtext(" and perhaps .TTY TABS");
          outimage;
          outtext("on the output terminal"); outimage;
          outtext("if different from this terminal"); outimage;
        END;
        IF outfileref =/= sysout THEN outfileref.open(blanks(132));
        IF file_output THEN
        BEGIN outfileref.outchar(formfeed);
          outfileref.breakoutimage;
        END ELSE
        IF label_output OR list_output THEN
        BEGIN
          IF usetabs THEN set_tab_settings_on_the_terminal
          ELSE outfileref.outimage;
          FOR i:= 2 STEP 1 UNTIL max_number_of_lines DO
          outfileref.outimage;
          IF NOT usetabs THEN outfileref.setpos(left_margin+1);
        END;
      END;

      PROCEDURE close_files;
      INSPECT outfileref DO
      BEGIN
        infileref.close;
        IF label_output THEN
        BEGIN
          outfileref.outimage;
        END;
        IF usetabs THEN
        BEGIN outtext(motoroff); outimage;
        END;
        IF outfileref =/= sysout THEN close;
      END;

      PROCEDURE initialize_constants;
      BEGIN
        trmop(8r2010,sysout,1); ! .TTY NO CRLF;
        blanktext:- blanks(132);
        altmode:= char(27); formfeed:= char(12); tab:= char(9);
        motoron:- copy(" h"); motoroff:- copy(" j");
        removetabs:- copy(" 2"); settab:- copy(" 1");
        motoron.putchar(altmode); motoroff.putchar(altmode);
        removetabs.putchar(altmode); settab.putchar(altmode);
        linesperpage(-1);
      END;

      PROCEDURE countprint(t,count);
      NAME t; TEXT t; INTEGER count;
      BEGIN
        outtext(t); outint(count,5);
      END;

      PROCEDURE message_end_of_processing;
      BEGIN
        dotypeout(sysout); outimage;
        outline("[ADRES processing is ready.]");
        countprint("LABELS IN: ",count_of_input);
        countprint("  LABELS OUT: ",count_of_output);
        IF count_of_error > 0 THEN
        BEGIN
          countprint("  UNACCEPTABLE LABELS IN: ",count_of_error);
        END;
        outimage;
        IF select_output THEN
        BEGIN
          countprint(
          "NUMBER OF LABELS REJECTED BECAUSE OF SELECTION CRITERIA: "
          ,count_of_rejected); outimage;
        END;
        IF presort_output THEN
        BEGIN
          countprint("MINIMUM RECORD SIZE FOR SORTING: ",sortlength);
          outimage;
        END;
      END;

      initialize_constants;
      WHILE TRUE DO
      BEGIN
        read_input_command;
        open_files;
        create_labels;
        resume(first_label);
        close_files;
        message_end_of_processing;
      END of input_command_loop;
    END of select block;
  END of decom block;
quit: END of the whole program;