Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0109/adres.lst
There is 1 other file named adres.lst in the archive. Click here to see a list.
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    1
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	    1	OPTIONS(/l); COMMENT address file handling and printing program;
	    2	COMMENT written by Jacob Palme, FOA 1, 104 50 Stockholm 80, SWEDEN;
	    3	COMMENT Version 0A, December 20, 1975;
B1	    4	BEGIN
	    5	  EXTERNAL TEXT PROCEDURE scanto, from, conc2, front;
	    6	  EXTERNAL INTEGER PROCEDURE search, trmop;
	    7	  EXTERNAL BOOLEAN PROCEDURE frontcompare, puttext, dotypeout;
	    8	  EXTERNAL REF (outfile) PROCEDURE findoutfile;
	    9	  EXTERNAL CHARACTER PROCEDURE findtrigger;
	   10	  EXTERNAL INTEGER PROCEDURE scanint;
	   11	  EXTERNAL LONG REAL PROCEDURE scanreal;
	   12	  EXTERNAL REF (infile) PROCEDURE findinfile;
	   13	  EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,
	   14	  checkextension;
	   15	  EXTERNAL PROCEDURE split;
	   16	  EXTERNAL CLASS safmin;
	   17	  EXTERNAL BOOLEAN PROCEDURE sqhelp;
	   18	  EXTERNAL CLASS decom;
	   19	  EXTERNAL CLASS select;
	   20	  INTEGER i, max_number_of_lines, lastline, lastlinep1,
	   21	  line_number, sortlength, page_step;
	   22	  INTEGER count_of_input, count_of_output, count_of_error;
	   23	  INTEGER count_of_rejected;
	   24	  INTEGER labels_per_width, left_margin, label_width, label_spacing;
	   25	  INTEGER line1_length, line2_length, line_dimension, in_dimension;
	   26	  BOOLEAN end_of_file, usetabs, select_output, line1_output,
	   27	  label_output, list_output, file_output, presort_output, asort_output;
	   28	  BOOLEAN caseshift;
	   29	  TEXT infilename, outfilename, blanktext, command;
	   30	  TEXT motoron, motoroff, removetabs, settab;
	   31	  TEXT mainline;
	   32	  CHARACTER altmode, formfeed, tab;
	   33	  REF (infile) infileref; REF (outfile) outfileref;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    2
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	   34	
	   35	
	   36	  select CLASS label_select;
B2	   37	  BEGIN
	   38	    REF (operator) line1_condition, line2_condition;
E2	   39	  END;
	   40	  line_dimension:= 40;
	   41	  outtext("[ADRES is here]"); outimage;
	   42	  outtext("[For HELP type ? followed by one word"
	   43	  " with the subject you want help on]"); outimage;
B3	   44	  decom(14) BEGIN
	   45	    margin:= 0;
	   46	    INSPECT NEW label_select DO
B4	   47	    BEGIN
	   48	      TEXT line1_selector, line2_selector;
	   49	      REF (label_data) first_label, last_label;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    3
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	   50	
	   51	      PROCEDURE setdependentparameters;
B5	   52	      BEGIN
	   53	        count_of_rejected:= count_of_error:=
	   54	        count_of_input:= count_of_output:= 0;
	   55	        end_of_file:= FALSE;
	   56	        IF asort_output OR presort_output OR file_output THEN
B6	   57	        BEGIN
	   58	          labels_per_width:= 1; usetabs:= FALSE;
	   59	          label_width:= line2_length;
	   60	          max_number_of_lines:= line_dimension-2;
E6	   61	        END;
	   62	        lastline:= max_number_of_lines+1;
	   63	        lastlinep1:= lastline+1;
	   64	        in_dimension:= line_dimension - 1 - line2_length//label_width;
	   65	        sysout.image:- blanks(line1_length);
	   66	        IF list_output THEN
B7	   67	        BEGIN page_step:= max_number_of_lines+1;
	   68	          page_step:= 60//page_step-1;
	   69	          page_step:= page_step*labels_per_width;
E7	   70	        END;
	   71	        linecopy_buffer:- blanks(
	   72	        IF select_output THEN
	   73	           (IF line2_condition == NONE THEN
	   74	               (IF caseshift THEN line1_length ELSE 0)
	   75	            ELSE line2_length*10)
	   76	        ELSE 0);
	   77	        IF line1_output THEN
B8	   78	        BEGIN
	   79	          IF line1_length > line2_length THEN line2_length:= line1_length
	   80	          ELSE line1_length:= line2_length;
E8	   81	        END;
	   82	      IF sysout == outfileref AND usetabs THEN
B9	   83	      BEGIN
	   84	        if trmop(8R2005,sysout,1) = 0 then !IF TTY NO TAB;
B10	   85	        begin ! then .SET TTY TAB;
	   86	          outtext("TTY TAB has been set by the ADRES program.");
	   87	          outimage;
E10	   88	     	END;
E9	   89	     END;
	   90	     IF usetabs THEN
B11	   91	     BEGIN
	   92	          outtext("Make sure that your terminal really can handle"
	   93	          " tabs in the same way as"); outimage;
	   94	          outtext("GNT, Terminet and similar terminals. If not,"
	   95	          " use the /NOTABS switch"); outimage;
	   96	          outtext("to the input for the ADRES program.");
	   97	          outimage;
E11	   98	      end;
E5	   99	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    4
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  100	
	  101	
	  102	      PROCEDURE outline(t); NAME t; TEXT t;
B12	  103	      BEGIN
	  104	        sysout.image:= t; outimage;
E12	  105	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    5
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  106	
	  107	      BOOLEAN PROCEDURE adreshelp(selector);
	  108	      VALUE selector; TEXT selector;
B13	  109	      BEGIN
	  110	        IF selector == NOTEXT AND sysin.image =/= NOTEXT THEN
B14	  111	        BEGIN
	  112	          command:- sysin.image.strip;
	  113	          command.setpos(1); IF command.getchar = '?' THEN
	  114	          selector:- command.sub(2,command.length-1);
E14	  115	        END;
	  116	        sqhelp("ADRES",selector,19,72);
E13	  117	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    6
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  118	
	  119	      PROCEDURE interpretintegerswitches;
B15	  120	      BEGIN
	  121	        intswitch("LINES","5",max_number_of_lines,
	  122	        max_number_of_lines > 0 AND max_number_of_lines < 11,
	  123	        "Must be between 0 and 11",adres_help(" /LINES"));
	  124	        intswitch("LABELS","3",labels_per_width,
	  125	        labels_per_width >= 1,"Must be >= 1",adres_help(" /LINES"));
	  126	        intswitch("LEFT","0",left_margin,
	  127	        left_margin >= 0 AND left_margin < 114,
	  128	        "Must be between 0 and 114",
	  129	        adres_help(" /LABELS"));
	  130	        intswitch("WIDTH","36",label_width,
	  131	        label_width > 5 AND
	  132	        label_width < (132-left_margin)//labels_per_width,
	  133	        "Too large or < 6",adres_help(" /WIDTH"));
	  134	        IF boolswitch("SINGLE",TRUE,NOTEXT,adres_help(" /SINGLE")) THEN
B16	  135	        BEGIN
	  136	          labels_per_width:= 1; left_margin:= 1;
	  137	          label_width:= 48;
E16	  138	        END;
	  139	        intswitch("TAB","41",label_spacing,
	  140	        labels_per_width <= 1 OR
	  141	        (label_spacing < (132-left_margin)//labels_per_width AND
	  142	        label_spacing > label_width),
	  143	        "Too large or less than /WIDTH",adres_help(" /TAB"));
	  144	        intswitch("LINE1","300",line1_length,
	  145	        line1_length > 0,"Must be positive",adres_help(" /LINE1"));
	  146	        intswitch("LINE2","80",line2_length,
	  147	        line2_length > 0 AND line2_length >= label_width,
	  148	        "Must be positive and larger than /WIDTH",
	  149	        adres_help(" /LINE2"));
E15	  150	      END of interpret_integer_switches;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    7
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  151	
	  152	
	  153	      PROCEDURE interpret_boolean_switches;
B17	  154	      BEGIN
	  155	        usetabs:= NOT boolswitch("NOTABS",TRUE,NOTEXT,
	  156	        adres_help(" /NO"));
	  157	        list_output:= boolswitch("LIST",TRUE,NOTEXT,
	  158	        adres_help(" /LIST"));
	  159	        file_output:= boolswitch("FILE",NOT list_output,
	  160	        "Only one kind of output",adres_help(" /FILE"));
	  161	        presort_output:= boolswitch("PRESORT",
	  162	        NOT list_output AND NOT file_output,
	  163	        "Only one kind of output",adres_help(" /PRESORT"));
	  164	        asort_output:= boolswitch("ASORT",
	  165	        NOT list_output AND NOT file_output
	  166	        AND NOT presort_output, "Only one kind of output",
	  167	        adres_help(" /ASORT"));
	  168	        select_output:= boolswitch("SELECT",NOT asort_output,
	  169	        "/SELECT will not work combined with /ASORT",
	  170	        adres_help(" /SELECT"));
	  171	        caseshift:= NOT boolswitch("NOCASESHIFT",select_output,
	  172	        "/NOCASESHIFT only meaningful combined with /SELECT",
	  173	        adres_help(" /NOCASESHIFT"));
	  174	        label_output:= NOT (list_output OR
	  175	        file_output OR presort_output OR asort_output
	  176	        OR boolswitch("NOLABEL",list_output OR
	  177	        file_output OR presort_output OR asort_output,
	  178	        "No kind of output",
	  179	        adres_help(" /NOLABEL")));
	  180	        line1_output:= boolswitch("OUT1",
	  181	        label_output OR list_output,
	  182	        "/OUT1 only meaningful with /LIST or /LABEL",
	  183	        adres_help(" /OUT1"));
E17	  184	      END of interpret_boolean_switches;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    8
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  185	
	  186	
	  187	      PROCEDURE request_selectors;
B18	  188	      BEGIN
	  189	        displaydefault:= FALSE;
	  190	        outtext("Give Boolean condition on line 1");
	  191	        outimage; request(":",
	  192	        NOTEXT,textinput(line1_selector,
	  193	        build_condition(line1_condition,line1_selector,caseshift)),
	  194	        select_errmess,adres_help(" /SELECT"));
	  195	        outchar('('); tree_print(line1_condition);
	  196	        outchar(')'); outimage;
	  197	        outtext("Give Boolean condition on lines after line 1");
	  198	        outimage; request(":",
	  199	        NOTEXT,textinput(line2_selector,
	  200	        build_condition(line2_condition,line2_selector,caseshift)),
	  201	        select_errmess,adres_help(" /SELECT"));
	  202	        outchar('('); tree_print(line2_condition);
	  203	        outchar(')'); outimage;
	  204	        displaydefault:= TRUE;
E18	  205	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE    9
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  206	
	  207	      BOOLEAN PROCEDURE filescanbecreated;
B19	  208	      BEGIN TEXT oldextension, newextension;
	  209	        IF outfilename = NOTEXT THEN outfilename:-copy("TTY:");
	  210	        IF infilename = NOTEXT THEN
B20	  211	        BEGIN
	  212	          IF (label_output OR list_output OR presort_output) THEN
B21	  213	          BEGIN
	  214	            infilename:- copy(outfilename);
	  215	            IF findtrigger(infilename,dottext) = '.' THEN
	  216	            infilename:- infilename.sub(1,infilename.pos-2);
E21	  217	          END ELSE
B22	  218	          BEGIN
	  219	            outtext("?ADRES - Both infile and outfile name must");
	  220	            outimage;
	  221	            outtext("be given when creating .ADR files");
	  222	            outimage; GOTO out;
E22	  223	          END;
E20	  224	        END;
	  225	        newextension:- copy(
	  226	        IF label_output THEN ".LAB" ELSE IF list_output THEN ".LST"
	  227	        ELSE IF presort_output THEN ".USR" ELSE ".ADR");
	  228	        oldextension:- copy(
	  229	        IF asort_output THEN ".SRT" ELSE ".ADR");
	  230	        createfiles(outfilename,infilename,
	  231	        newextension, oldextension,
	  232	        outfileref,infileref,adres_help("file"));
	  233	        files_can_be_created:= TRUE;
	  234	        out:
E19	  235	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   10
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  236	
	  237	      BOOLEAN PROCEDURE interpretlegalcommand;
B23	  238	      BEGIN
	  239	        IF NOT deccom(upcase(command),outfilename,infilename)
	  240	        THEN GOTO out;
	  241	        displaydefault:= TRUE;
	  242	        interpret_integer_switches;
	  243	        interpret_boolean_switches;
	  244	        IF select_output THEN request_selectors ELSE
	  245	        line1_condition:- line2_condition:- NONE;
	  246	        IF NOT illegalswitch(
	  247	        "Uninterpretable or duplicate switch: /",adres_help(""))
	  248	        THEN interpret_legal_command:= files_can_be_created;
	  249	        out:
E23	  250	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   11
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  251	PROCEDURE adjust_label_form;
B24	  252	BEGIN
	  253	  BOOLEAN positioned;
	  254	  WHILE NOT positioned DO
B25	  255	  BEGIN
	  256	  request("Is this first line on a label?","NO",boolinput(positioned),
	  257	  NOTEXT,adres_help("inserting label forms"));
E25	  258	  END;
E24	  259	END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   12
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  260	
	  261	      PROCEDURE readinputcommand;
B26	  262	      BEGIN CHARACTER c;
	  263	        prompt:
	  264	        displaydefault:= FALSE;
	  265	        request("*",nodefault,textinput(command,
	  266	        interpret_legal_command),
	  267	        NOTEXT,adres_help(""));
	  268	        set_dependent_parameters;
	  269	        IF label_output AND outfileref == sysout THEN
	  270	        adjust_label_form;
E26	  271	      END of read_input_command;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   13
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  272	
	  273	
	  274	      CLASS label_data;
B27	  275	      BEGIN
	  276	        REF (label_data) next;
	  277	        TEXT line_buffer, sort_buffer;
	  278	        TEXT ARRAY line(1:line_dimension), stripline(1:line_dimension);
	  279	        TEXT second_alg_buffer;
	  280	        INTEGER number_of_lines, line_number;
	  281	        BOOLEAN faulty_address, erased_address;
	  282	        IF first_label == NONE THEN first_label:- THIS label_data
	  283	        ELSE last_label.next:- THIS label_data;
	  284	        next:- first_label;
	  285	        last_label:- THIS label_data;
	  286	          line_buffer:-
	  287	          blanks(5+line1_length+(line_dimension-1)*line2_length);
	  288	          sort_buffer:- line_buffer.sub(6,line_buffer.length-5);
	  289	          line(1):- line_buffer.sub(6,line1_length);
	  290	          FOR i:= 2 STEP 1 UNTIL line_dimension DO
	  291	          line(i):- line_buffer.sub
	  292	          (6+line1_length+(i-2)*line2_length,line2_length);
	  293	        second_alg_buffer:- blanks(label_width*max_number_of_lines);
E27	  294	      END of label_data;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   14
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  295	
	  296	
	  297	      label_data CLASS label_operations;
B28	  298	      BEGIN
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   15
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  299	
	  300	
	  301	        PROCEDURE erase_address;
B29	  302	        BEGIN
	  303	          erased_address:= TRUE;
	  304	          line[1]:= stripline[1]:= NOTEXT;
	  305	          FOR number_of_lines:= 2 STEP 1 UNTIL lastline DO
B30	  306	          BEGIN
	  307	            line[number_of_lines]:=
	  308	            IF presort_output THEN NOTEXT ELSE "*****";
	  309	            stripline[number_of_lines]:- line[number_of_lines].strip;
E30	  310	          END;
	  311	          number_of_lines:= lastline;
E29	  312	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   16
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  313	
	  314	
	  315	        PROCEDURE error(errmess); NAME errmess; TEXT errmess;
B31	  316	        BEGIN INTEGER i, addcount;
	  317	          faulty_address:= TRUE;
	  318	          outtext("?ADRES - "); outtext(errmess);
	  319	          outimage;
	  320	          i:= number_of_lines; IF i > 4 THEN i:= 4;
	  321	          FOR line_number:= 1 STEP 1 UNTIL i DO
B32	  322	          BEGIN
	  323	            image:= stripline(line_number); outimage;
E32	  324	          END;
	  325	          outimage;
	  326	addcount:= 2+i; addcount:= lastline-mod(addcount,lastline);
	  327	If addcount = lastline then addcount:= 0;
	  328	for i:= 1 step 1 until addcount do outimage;
	  329	          erase_address;
E31	  330	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   17
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  331	
	  332	
	  333	        PROCEDURE divide_line;
B33	  334	        BEGIN
	  335	          line[number_of_lines+1]:= line[number_of_lines].
	  336	          sub(label_width+1,line2_length-label_width);
	  337	          line[number_of_lines].sub(label_width+1,
	  338	          line2_length-label_width)
	  339	          := NOTEXT;
	  340	          stripline[number_of_lines]:- line[number_of_lines].sub(1,
	  341	          label_width);
	  342	          number_of_lines:= number_of_lines+1;
	  343	          stripline[number_of_lines]:- line[number_of_lines].strip;
E33	  344	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   18
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  345	
	  346	
	  347	        PROCEDURE too_many_lines;
	  348	        INSPECT infileref DO
B34	  349	        BEGIN
	  350	          error("Too many lines in input address.");
	  351	          WHILE TRUE DO
B35	  352	          BEGIN
	  353	            inimage; image.setpos(image.strip.length);
	  354	            IF (IF image.more THEN image.getchar ELSE ' ')
	  355	            = formfeed THEN GOTO out;
E35	  356	          END;
	  357	          out: image:= NOTEXT;
E34	  358	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   19
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  359	
	  360	
	  361	        BOOLEAN PROCEDURE select_this_address;
B36	  362	        BEGIN
	  363	          BOOLEAN select;
	  364	          IF line_scan(line1_condition,stripline(1)) THEN
B37	  365	          BEGIN
	  366	            IF array_scan(line2_condition,
	  367	            stripline,2,number_of_lines)
	  368	            THEN
	  369	            select:= TRUE;
E37	  370	          END;
	  371	          IF NOT select THEN count_of_rejected:= count_of_rejected+1;
	  372	          select_this_address:= select;
E36	  373	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   20
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  374	
	  375	
	  376	        PROCEDURE read_an_address;
	  377	        INSPECT infileref DO
B38	  378	        BEGIN
	  379	          top: number_of_lines:= IF line1_output THEN 2 ELSE 1;
	  380	          IF faulty_address THEN count_of_error:= count_of_error+1;
	  381	          erased_address:= faulty_address:= FALSE;
	  382	          IF endfile THEN
B39	  383	          BEGIN
	  384	            end_of_file:= TRUE; erase_address;
E39	  385	          END ELSE
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   21
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  386	
	  387	
B40	  388	          BEGIN
	  389	            count_input;
	  390	            again:
	  391	            WHILE NOT endfile AND number_of_lines <= in_dimension DO
B41	  392	            BEGIN
	  393	              image:- line[number_of_lines];
	  394	              inimage; IF endfile THEN image:= NOTEXT;
	  395	              stripline[number_of_lines]:- line[number_of_lines].strip;
	  396	              IF stripline[number_of_lines] == NOTEXT AND
	  397	              number_of_lines
	  398	              > 1 THEN GOTO again;
	  399	              stripline[number_of_lines].setpos(stripline[
	  400	              number_of_lines
	  401	              ].length);
	  402	              IF number_of_lines > 1 THEN
	  403	              WHILE stripline[number_of_lines].length >
	  404	              label_width DO divide_line;
	  405	              IF (IF stripline[number_of_lines] = NOTEXT THEN ' ' ELSE
	  406	              stripline[number_of_lines].getchar) = formfeed THEN
B42	  407	              BEGIN COMMENT end of address;
	  408	                stripline[number_of_lines]:-
	  409	                stripline[number_of_lines].sub(1,
	  410	                stripline[number_of_lines].length-1);
	  411	                IF stripline[number_of_lines] = NOTEXT THEN
	  412	                number_of_lines:= number_of_lines-1;
	  413	                GOTO out;
E42	  414	              END;
	  415	              number_of_lines:= number_of_lines+1;
E41	  416	            END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   22
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  417	
	  418	
	  419	            IF endfile THEN number_of_lines:= number_of_lines-1;
	  420	            IF number_of_lines > in_dimension THEN
B43	  421	            BEGIN
	  422	              too_many_lines; GOTO top;
E43	  423	            END;
	  424	            out: IF number_of_lines <= 1 THEN
B44	  425	            BEGIN IF endfile or count_of_input = 1 THEN
	  426	              count_of_input:= count_of_input-1 ELSE
B45	  427	              BEGIN
	  428	                number_of_lines:= 10;
	  429	                error("No text in address after or at:");
E45	  430	              END;
	  431	              GOTO top;
E44	  432	            END;
	  433	            IF select_output THEN
B46	  434	            BEGIN IF NOT select_this_address THEN GOTO top;
E46	  435	            END;
E40	  436	          END;
E38	  437	        END of read_an_address;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   23
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  438	
	  439	
	  440	        PROCEDURE count_input;
B47	  441	        BEGIN
	  442	          count_of_input:= count_of_input+1;
	  443	          IF mod(count_of_input,10) = 0 AND sysout =/= outfileref THEN
B48	  444	          BEGIN sysout.outchar('.'); sysout.breakoutimage;
E48	  445	          END;
E47	  446	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   24
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  447	
	  448	
	  449	        BOOLEAN PROCEDURE reformat_first_algorithm;
B49	  450	        BEGIN
	  451	          INTEGER firstno, secondno;
	  452	          reformat_first_algorithm:= TRUE;
	  453	          WHILE number_of_lines > lastline DO
B50	  454	          BEGIN
	  455	            firstno:= 2; secondno:= 3;
	  456	            FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
B51	  457	            BEGIN
	  458	              while stripline[secondno] == NOTEXT DO
	  459	              secondno:= secondno+1;
	  460	              IF stripline[firstno].length +
	  461	              stripline[secondno].length + 2 < label_width THEN
B52	  462	              BEGIN
	  463	                mainline:- line[firstno];
	  464	                mainline.setpos(stripline[firstno].length+1);
	  465	                puttext(mainline,", ");
	  466	                puttext(mainline,stripline[secondno]);
	  467	                stripline[firstno]:- mainline.strip;
	  468	                stripline[secondno]:- NOTEXT;
	  469	                number_of_lines:= number_of_lines-1;
	  470	                GOTO compressmore;
E52	  471	              END;
	  472	              firstno:= secondno; secondno:= firstno+1;
E51	  473	            END;
	  474	            reformat_first_algorithm:= FALSE; GOTO out;
	  475	            compressmore:
E50	  476	          END;
	  477	          out: secondno:= 3;
	  478	          FOR line_number:= 3 STEP 1 UNTIL number_of_lines DO
B53	  479	          BEGIN
	  480	            WHILE stripline[secondno] == NOTEXT
	  481	            DO secondno:= secondno+1;
	  482	            stripline[line_number]:- stripline[secondno];
	  483	            secondno:= secondno+1;
E53	  484	          END;
E49	  485	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   25
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  486	
	  487	
	  488	        BOOLEAN PROCEDURE reformat_second_algorithm;
B54	  489	        BEGIN
	  490	          TEXT rest_of_buffer;
	  491	          rest_of_buffer:- second_alg_buffer;
	  492	          FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
B55	  493	          BEGIN
	  494	            i:= stripline[line_number].length;
	  495	            IF rest_of_buffer.length <= i THEN GOTO bad;
	  496	            rest_of_buffer:= stripline[line_number];
	  497	            rest_of_buffer:- rest_of_buffer.sub(i+1,
	  498	            rest_of_buffer.length-i);
	  499	            IF rest_of_buffer.length >= 2 AND i < label_width AND
	  500	            line_number < number_of_lines THEN
B56	  501	            BEGIN
	  502	              rest_of_buffer.sub(1,2):= ", ";
	  503	              rest_of_buffer:- rest_of_buffer.sub(3,
	  504	              rest_of_buffer.length-2);
E56	  505	            END;
	  506	            IF line_number <= max_number_of_lines+1 THEN
	  507	            stripline[line_number]:- second_alg_buffer.
	  508	            sub(1+(line_number-2)*label_width,label_width);
E55	  509	          END;
	  510	          number_of_lines:= max_number_of_lines+1;
	  511	          reformat_second_algorithm:= TRUE;
	  512	          bad:
E54	  513	        END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   26
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  514	
	  515	
	  516	        BOOLEAN PROCEDURE can_be_reformatted;
B57	  517	        BEGIN
	  518	          IF reformat_first_algorithm THEN can_be_reformatted:= TRUE ELSE
	  519	          IF reformat_second_algorithm THEN can_be_reformatted:= TRUE ELSE
	  520	          error("Too much text in this address");
E57	  521	        END of can_be_reformatted;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   27
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  522	
	  523	
	  524	        PROCEDURE write_line(this_line);
	  525	        TEXT this_line;
	  526	        INSPECT outfileref DO
B58	  527	        BEGIN
	  528	          outtext(this_line);
	  529	          IF next == first_label THEN
B59	  530	          BEGIN outimage; IF NOT usetabs THEN setpos(left_margin+1);
E59	  531	          END ELSE IF usetabs THEN outchar(tab)
	  532	          ELSE setpos(pos+label_spacing-this_line.length);
E58	  533	        END of write_line;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   28
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  534	
	  535	
	  536	        PROCEDURE output_count;
B60	  537	        BEGIN
	  538	          count_of_output:= count_of_output+1;
	  539	          IF list_output THEN
B61	  540	          BEGIN
	  541	            IF mod(count_of_output,page_step) = 1
	  542	            THEN outfileref.outchar(formfeed);
E61	  543	          END;
E60	  544	        END of output_count;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   29
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  545	
	  546	
E28	  547	      END of label_operations;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   30
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  548	
	  549	
	  550	      label_operations CLASS label_address;
B62	  551	      BEGIN
	  552	        detach; WHILE TRUE DO
B63	  553	        BEGIN
	  554	          nextin: read_an_address;
	  555	          IF NOT can_be_reformatted AND NOT end_of_file THEN GOTO nextin;
	  556	          IF THIS label_address == first_label AND end_of_file THEN detach
	  557	          ELSE IF labels_per_width > 1 THEN resume(next);
	  558	          IF NOT erased_address THEN output_count;
	  559	          FOR line_number:= 2 STEP 1 UNTIL lastlinep1 DO
B64	  560	          BEGIN
	  561	            write_line(IF line_number <= number_of_lines THEN
	  562	            stripline[line_number] ELSE NOTEXT);
	  563	            IF labels_per_width > 1 THEN resume(next);
E64	  564	          END of for loop;
E63	  565	        END of while loop;
E62	  566	      END of label_address;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   31
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  567	
	  568	
	  569	      label_operations CLASS file_address;
B65	  570	      BEGIN
	  571	        TEXT line1m1;
	  572	        line1m1:- line[1].main.sub(5,line1_length+1);
	  573	        detach; WHILE TRUE DO
B66	  574	        BEGIN
	  575	          nextin: read_an_address;
	  576	          IF end_of_file THEN detach;
	  577	          IF NOT erased_address THEN INSPECT outfileref DO
B67	  578	          BEGIN
	  579	            count_of_output:= count_of_output+1;
	  580	            IF count_of_output = 1 THEN image:- line[1] ELSE
B68	  581	            BEGIN image:- line1m1; image.putchar(formfeed);
E68	  582	            END;
	  583	            outimage;
	  584	            FOR line_number:= 2 STEP 1 UNTIL number_of_lines DO
B69	  585	            BEGIN
	  586	              image:- stripline[line_number]; outimage;
E69	  587	            END of for loop;
E67	  588	          END of inspect;
E66	  589	        END of while loop;
E65	  590	      END of label_address;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   32
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  591	
	  592	
	  593	      label_operations CLASS asort_address;
B70	  594	      BEGIN
	  595	        TEXT line1m1;
	  596	        line1m1:- line[1].main.sub(5,line1_length+1);
	  597	        infileref.image:- sort_buffer;
	  598	        detach; WHILE TRUE DO
B71	  599	        BEGIN
	  600	          nextin: infileref.inimage;
	  601	          IF infileref.endfile THEN detach;
	  602	          count_input;
	  603	          IF NOT erased_address THEN INSPECT outfileref DO
B72	  604	          BEGIN
	  605	            count_of_output:= count_of_output+1;
	  606	            IF count_of_output = 1 THEN image:- line[1] ELSE
B73	  607	            BEGIN image:- line1m1; image.putchar(formfeed);
E73	  608	            END;
	  609	            outimage;
	  610	            FOR line_number:= 2 STEP 1 UNTIL line_dimension DO
B74	  611	            BEGIN
	  612	              image:- line[line_number].strip;
	  613	              IF image = NOTEXT THEN GOTO out;
	  614	              outimage;
E74	  615	            END of for loop;
	  616	            out:
E72	  617	          END of inspect;
E71	  618	        END of while loop;
E70	  619	      END of asort_address;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   33
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  620	
	  621	
	  622	      label_operations CLASS presort_address;
B75	  623	      BEGIN
	  624	        detach; WHILE TRUE DO
B76	  625	        BEGIN
	  626	          nextin: read_an_address;
	  627	          IF end_of_file THEN detach;
	  628	          IF NOT erased_address THEN INSPECT outfileref DO
B77	  629	          BEGIN
	  630	            count_of_output:= count_of_output+1;
	  631	            image:- sort_buffer.strip;
	  632	            IF image.sub(image.length,1).getchar=formfeed THEN
B78	  633	            BEGIN image.sub(image.length,1).putchar(' ');
	  634	              image:- image.sub(1,image.length-1);
E78	  635	            END;
	  636	            IF sortlength < image.length THEN sortlength:= image.length;
	  637	            outimage;
E77	  638	          END of inspect;
E76	  639	        END of while loop;
E75	  640	      END of label_address;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   34
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  641	
	  642	
	  643	      PROCEDURE create_labels;
B79	  644	      BEGIN
	  645	        INTEGER label_no;
	  646	        first_label:- NONE;
	  647	        FOR label_no:= 1 STEP 1 UNTIL labels_per_width DO
	  648	        IF file_output THEN NEW file_address ELSE
	  649	        IF presort_output THEN NEW presort_address ELSE
	  650	        IF asort_output THEN NEW asort_address ELSE
	  651	        NEW label_address;
E79	  652	      END of create_labels;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   35
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  653	
	  654	
	  655	      PROCEDURE set_tab_settings_on_the_terminal;
	  656	      INSPECT outfileref DO
B80	  657	      BEGIN
	  658	        outtext(motoron); outtext(removetabs); outimage;
	  659	        setpos(pos+left_margin); outtext(settab);
	  660	        FOR i:= 2 STEP 1 UNTIL labels_per_width DO
B81	  661	        BEGIN
	  662	          setpos(pos+label_spacing); outtext(settab);
E81	  663	        END;
E80	  664	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   36
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  665	
	  666	
	  667	      PROCEDURE open_files;
B82	  668	      BEGIN
	  669	        infileref.open(blanks(80));
	  670	        IF outfileref =/= sysout and label_output then
B83	  671	        BEGIN
	  672	          outtext("You must do .TTY NO CRLF");
	  673	          if usetabs then
	  674	          outtext(" and perhaps .TTY TABS");
	  675	          outimage;
	  676	          outtext("on the output terminal"); outimage;
	  677	          outtext("if different from this terminal"); outimage;
E83	  678	        END;
	  679	        IF outfileref =/= sysout THEN outfileref.open(blanks(132));
	  680	        IF file_output THEN
B84	  681	        BEGIN outfileref.outchar(formfeed);
	  682	          outfileref.breakoutimage;
E84	  683	        END ELSE
	  684	        IF label_output OR list_output THEN
B85	  685	        BEGIN
	  686	          IF usetabs THEN set_tab_settings_on_the_terminal
	  687	          ELSE outfileref.outimage;
	  688	          FOR i:= 2 STEP 1 UNTIL max_number_of_lines DO
	  689	          outfileref.outimage;
	  690	          IF NOT usetabs THEN outfileref.setpos(left_margin+1);
E85	  691	        END;
E82	  692	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   37
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  693	
	  694	
	  695	      PROCEDURE close_files;
	  696	      INSPECT outfileref DO
B86	  697	      BEGIN
	  698	        infileref.close;
	  699	        IF label_output THEN
B87	  700	        BEGIN
	  701	          outfileref.outimage;
E87	  702	        END;
	  703	        IF usetabs THEN
B88	  704	        BEGIN outtext(motoroff); outimage;
E88	  705	        END;
	  706	        IF outfileref =/= sysout THEN close;
E86	  707	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   38
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  708	
	  709	
	  710	      PROCEDURE initialize_constants;
B89	  711	      BEGIN
	  712	        trmop(8r2010,sysout,1); ! .TTY NO CRLF;
	  713	        blanktext:- blanks(132);
	  714	        altmode:= char(27); formfeed:= char(12); tab:= char(9);
	  715	        motoron:- copy(" h"); motoroff:- copy(" j");
	  716	        removetabs:- copy(" 2"); settab:- copy(" 1");
	  717	        motoron.putchar(altmode); motoroff.putchar(altmode);
	  718	        removetabs.putchar(altmode); settab.putchar(altmode);
	  719	        linesperpage(-1);
E89	  720	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   39
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  721	
	  722	
	  723	      PROCEDURE countprint(t,count);
	  724	      NAME t; TEXT t; INTEGER count;
B90	  725	      BEGIN
	  726	        outtext(t); outint(count,5);
E90	  727	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   40
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  728	
	  729	
	  730	      PROCEDURE message_end_of_processing;
B91	  731	      BEGIN
	  732	        dotypeout(sysout); outimage;
	  733	        outline("[ADRES processing is ready.]");
	  734	        countprint("LABELS IN: ",count_of_input);
	  735	        countprint("  LABELS OUT: ",count_of_output);
	  736	        IF count_of_error > 0 THEN
B92	  737	        BEGIN
	  738	          countprint("  UNACCEPTABLE LABELS IN: ",count_of_error);
E92	  739	        END;
	  740	        outimage;
	  741	        IF select_output THEN
B93	  742	        BEGIN
	  743	          countprint(
	  744	          "NUMBER OF LABELS REJECTED BECAUSE OF SELECTION CRITERIA: "
	  745	          ,count_of_rejected); outimage;
E93	  746	        END;
	  747	        IF presort_output THEN
B94	  748	        BEGIN
	  749	          countprint("MINIMUM RECORD SIZE FOR SORTING: ",sortlength);
	  750	          outimage;
E94	  751	        END;
E91	  752	      END;
DECsystem-20 SIMULA  %4A(310)                1-FEB-1981  14:50				 PAGE   41
DSK:ADRES.SIM	  20-FEB-1977  19:00	

	  753	
	  754	
	  755	      initialize_constants;
	  756	      WHILE TRUE DO
B95	  757	      BEGIN
	  758	        read_input_command;
	  759	        open_files;
	  760	        create_labels;
	  761	        resume(first_label);
	  762	        close_files;
	  763	        message_end_of_processing;
E95	  764	      END of input_command_loop;
E4	  765	    END of select block;
E3	  766	  END of decom block;
E1	  767	quit: END of the whole program;


DEFAULT SWITCHES USED

NO ERRORS DETECTED