         Edinburgh IMP77 Compiler - Version 8.4

    1  ! compiles OK with imp2021 but lots of work to be done. Look for ARRAY() maps.
    2  ! and commented machine code sections. (Search for !! in both cases)
    3  ! Next, fix file parameters and I/O
    4  ! Then worry about shorts and byte sex assumptions.
    5  
    6  ! May need to convert to C and compile in big-endian MIPS environment
    7  
    8  %CONSTSHORTINTEGERARRAY MAIN(1 : 217) =    %C
    9+     1,    5,   14,   20,   26,   38,   43,   48,   54,   61,   68,   74,
   10+    79,   82,   84,   89,   96,  102,  108,  115,  122,  126,    0,  129,
   11+   133,  137,  142,  145,  152,  156,  161,  164,  168,    0,  171,    0,
   12+   178,  184,  185,  189,  190,  193,  196,  199,    0,  202,  205,  206,
   13+   208,    0,  211,  213,  215,  216,  219,  222,  225,    0,  228,  231,
   14+   236,  241,  244,  249,    0,  253,  259,  260,  264,  266,  267,  270,
   15+   271,  274,  277,  279,  280,  283,  286,  289,  292,  295,  298,  302,
   16+   305,  308,  311,  314,  317,  320,  324,  328,  332,  336,  340,  344,
   17+   348,  352,  355,  358,    0,  361,  363,  365,  373,    0,  381,    0,
   18+   385,  392,  393,  396,  397,  400,  403,  405,  406,  410,    0,  413,
   19+   418,  425,  432,    0,  435,  437,    0,  440,  445,  446,  450,  453,
   20+   456,    0,  459,  462,  463,    0,  469,  472,  473,  475,    0,  477,
   21+   489,  499,  506,    0,  509,  511,  512,  517,    0,  520,    0,  530,
   22+   534,  535,  538,  539,    0,  543,  546,  547,    0,  558,  565,  566,
   23+   571,  572,  576,  579,    0,  585,  587,  588,  591,    0,  594,  597,
   24+     0,  600,  602,  603,  608,  609,  614,  615,  618,    0,  620,  622,
   25+   623,  627,  628,  631,  634,  637,    0,  640,  646,    0,  651,  656,
   26+   657,  660,  661,  665,    0,  667,    0,  670,  674,  675,  678,  681,
   27+   683
   28  %CONSTSHORTINTEGERARRAY SUB(2 : 684) =    %C
   29+   4119,  4288, -8192,     0,  4149,  4168,  4197,  4166,  4286,
   30+   4119,  4230, -8192,     0,     1,  8200, 24576,  4230, -8192,
   31+      0,     8,  8221, 24576, 16384, -8192,     0,    15,  8204,
   32+  20480, 16384,  4202,    21,  8244,  4168,  4197,  4166, -8192,
   33+      0,  4154,  4246,-20480, -8192,     0,  4290,  4154,  4295,
   34+ -20480,     0,    23,  8223,  4255, -8192,-20480,     0,  4208,
   35+   4271,  4212, -4096,  4261, -8192,     0,    30,  8197, -4096,
   36+   4261, -8192,-20480,     0,    35,  8196, 20480, -8192,-16384,
   37+      0,    41,  8198,  4215, -8192,     0,  4130,  4096,     0,
   38+   4225,     0,    45,  8199, -8192,-20480,     0,  4309,    50,
   39+   8201,  4239, -8192,-20480,     0,    57,-20480,  8202, 12288,
   40+  -8192,     0,    65,  8203,  4232, -8192,-20480,     0,    71,
   41+     77,  8193,  8205, -8192,-20480,     0,    85,    93,  8206,
   42+   8207, -8192,-20480,     0,   101,  8257,-32768,     0,-12288,
   43+  -8192,     0,  4202,  4134,  4141,     0,   103,  8246,  4143,
   44+      0,   106,  8208, 12288,  4141,     0,   116,  8209,     0,
   45+    123,  8210,  4136,  4168,  4197,  4166,     0,   130,  8211,
   46+  20480,     0,    15,  8204, 20480, 16384,     0,   136,  8212,
   47+      0,   141,  8213,  4146,     0,   149,  8214,     0,  8292,
   48+   4220,   154,  8245,  8192,  4132,     0,  8292,  4220,   154,
   49+   8245,  8192,  4132,     0,  4136,  4168,  4197,  4166,     0,
   50+    156,  8247,     0,    21,  8244,     0,   159,  8248,     0,
   51+    103,  8246,     0,   162,  8215,  4119,     0, 12288,     0,
   52+  -4096,  4204,     0, 12288,     0,   136,  8212,     0,   166,
   53+   8216,     0,   169,  8218,     0,   175,  8217,     0,   182,
   54+   8219,     0,   188,  8220,     0,   196,   188,  8194,  8220,
   55+      0,    71,   188,  8193,  8220,     0,   201,  8222,     0,
   56+    206,   201,  8195,  8222,     0,   211,  8224,  4161,     0,
   57+    218,  8249, 12288,   220,  8250,  8271,     0,   222,  8225,
   58+   8226,     0,   232,  8226,     0,  4172,  4197,  4166,     0,
   59+    237,  8251,     0,   239,  8252,     0,   241,  8253,     0,
   60+    237,  8251,     0,   103,  8246,     0,   239,  8252,     0,
   61+    243,  8254,     0,   245,  8255,     0,   248,  8256,     0,
   62+    250,  8257,  8257,     0,   101,  8257,     0,   253,  8258,
   63+      0,   256,  8259,     0,   258,  8260,     0,   260,  8261,
   64+      0,   263,  8262,     0,    21,  8244,  4168,     0,   266,
   65+   8263,  4168,     0,   269,  8264,  4168,     0,   271,  8267,
   66+   4168,     0,   273,  8265,  4168,     0,   276,  8266,  4168,
   67+      0,   278,  8268,  4168,     0,   281,  8272,  4168,     0,
   68+    162,  8215,     0,   283,  8227,     0,   154,  8245,     0,
   69+  12288,     0,  4202,     0,   218,  8249,  4168,  4197,  4166,
   70+    220,  8250,     0,   248,  8256,  4168,  4197,  4166,   248,
   71+   8256,     0, -4096,  4204,  4206,     0,   218,  8249,  4168,
   72+   4197,  4166,   220,  8250,     0,   286,  8270,  4202,     0,
   73+    288,  8231,     0,   297,  8232,     0,   304,  8233,     0,
   74+     30,  8197,-20480,     0, 20480,-16384,     0,   312,  8234,
   75+   8199,-20480,     0,   319,  8234,  8207, 28672, 24576, 20480,
   76+      0,   329,  8234,  8235, 28672, 24576, 20480,     0, 24576,
   77+  28672,     0, 12288,     0, -4096,  4223,     0,   218,  8249,
   78+  12288,   220,  8250,     0,   248, -8191,-28672,     0,   336,
   79+ -24576,     0,   248,-28672,     0,   339,-28672,     0,   347,
   80+   8237,  4119,     0, 12288,   103,  8246,  4236,  4234,     0,
   81+    281,  8269,  4232,     0, 12288,     0, -4096,     0,   352,
   82+   8238, -4096,   218,  8249,  4283,  4246,  4279,  4281,   220,
   83+   8250,     0,    30,  8197, -4096,  4253,   218,  8249, -4096,
   84+    220,  8250,     0,  4246,   218,  8249, -4096,   220,  8250,
   85+      0,   232,  8226,     0,   352,  8238,     0,   359,  8225,
   86+   4244,  4249,     0,  4163,  4305,     0,  4305,   218,  8249,
   87+   4168,  4197,  4166,   220,  8250,  4251,     0,   281,  8269,
   88+   4249,  4251,     0,   286,  8270, -4096,     0,  4305,  4259,
   89+   4257,     0,   281,  8269,  4255,     0,   218,  8249,  4168,
   90+  12288,   154,  8245,  4168, 12288,   220,  8250,     0,   218,
   91+   8249,  4265,  4305,  4263,   220,  8250,     0,   281,  8269,
   92+   4265,  4305,  4263,     0,  4271,   232,  8226,     0,  4154,
   93+   4163,     0,    50,  8201,  4269,   232,  8226,     0,   359,
   94+   8225,     0,    77,  8205,     0,  4154,  4274,     0,   365,
   95+   8239,     0,   368,  8240,     0,   281,  8269,     0,   218,
   96+   8249, -4096,   220,  8250,     0,  4277,  4283,  4246,  4279,
   97+   4281,     0,    50,  8201,     0,  4154,     0,   372,  8241,
   98+      0,  4149,  4168,  4197,  4166,     0,   377,  8228,     0,
   99+    381,  8229,     0,   387,  8230,     0,   288,  8231,     0,
  100+    359,  8225, -4096,  4259,  4302,     0,  4305,  4300,  4298,
  101+  -8192,     0,   281,  8269,  4305,  4300,  4298,     0,    21,
  102+   8244, 12288,     0,    21,  8244,-32768,     0, -8192,     0,
  103+  -4096,  4307,     0,   281,  8269, -4096,  4307,     0,   377,
  104+   8228,     0,   288,  8231,     0,   387,  8230,    0
  105  %CONSTBYTEINTEGERARRAY LITERAL(1 : 396) =    %C
  106+     6,  102,  105,  110,  105,  115,  104,    6,  114,  101,  112,  101,
  107+    97,  116,    5,   99,  121,   99,  108,  101,    1,   61,    6,  115,
  108+   119,  105,  116,   99,  104,    4,  115,  112,  101,   99,    5,   98,
  109+   101,  103,  105,  110,    3,  101,  110,  100,    4,  108,  105,  115,
  110+   116,    6,  114,  101,   99,  111,  114,  100,    7,   99,  111,  110,
  111+   116,  114,  111,  108,    5,  102,   97,  117,  108,  116,    5,  115,
  112+   104,  111,  114,  116,    7,  114,  111,  117,  116,  105,  110,  101,
  113+     7,  116,  114,  117,  115,  116,  101,  100,    7,  112,  114,  111,
  114+   103,  114,   97,  109,    1,   42,    2,   45,   62,    9,  112,  114,
  115+   105,  110,  116,  116,  101,  120,  116,    6,  114,  101,  116,  117,
  116+   114,  110,    6,  114,  101,  115,  117,  108,  116,    5,  115,  116,
  117+    97,  114,  116,    4,  115,  116,  111,  112,    7,  109,  111,  110,
  118+   105,  116,  111,  114,    4,  101,  120,  105,  116,    1,   58,    2,
  119+    61,   61,    2,   60,   45,    3,   97,  110,  100,    2,  105,  102,
  120+     5,  119,  104,  105,  108,  101,    6,  117,  110,  108,  101,  115,
  121+   115,    5,  117,  110,  116,  105,  108,    7,  105,  110,  116,  101,
  122+   103,  101,  114,    4,   98,  121,  116,  101,    4,  114,  101,   97,
  123+   108,    4,  108,  111,  110,  103,    6,  115,  116,  114,  105,  110,
  124+   103,    1,   40,    1,   41,    9,   97,  114,  114,   97,  121,  110,
  125+    97,  109,  101,    4,  110,   97,  109,  101,    1,   43,    1,   45,
  126+     1,   92,    1,   38,    2,   33,   33,    1,   33,    2,   42,   42,
  127+     2,   47,   47,    1,   47,    1,   46,    2,   60,   60,    2,   62,
  128+    62,    2,   60,   61,    1,   60,    1,   35,    2,   62,   61,    1,
  129+    62,    2,   92,   61,    1,   44,    2,  111,  114,    1,   95,    8,
  130+   101,  120,  116,  101,  114,  110,   97,  108,    6,  115,  121,  115,
  131+   116,  101,  109,    7,  100,  121,  110,   97,  109,  105,   99,    6,
  132+   111,  102,  108,  105,  115,  116,    9,  111,  102,  112,  114,  111,
  133+   103,  114,   97,  109,    6,  111,  102,  102,  105,  108,  101,    2,
  134+    33,   42,    7,   99,  111,  109,  109,  101,  110,  116,    4,  101,
  135+   108,  115,  101,    6,  102,  111,  114,  109,   97,  116,    5,   97,
  136+   114,  114,   97,  121,    2,  102,  110,    3,  109,   97,  112,    4,
  137+   116,  104,  101,  110,    3,  111,  119,  110,    5,   99,  111,  110,
  138+   115,  116,    9,  101,  120,  116,  114,  105,  110,  115,  105,   99
  139  %CONSTBYTEINTEGERARRAY SFLAGS(1 : 80) =    %C
  140+  3, 3, 3, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1,
  141+  1, 1, 1, 4, 0, 4, 0, 4, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0,
  142+  2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  143+  0, 0, 0, 0, 0, 0, 0, 0
  144  {%CONST}%OWNBYTEINTEGERARRAY KEYSYMS(1 : 381) =    %C
  145+   5, 83, 72, 79, 82, 84,  4, 66, 89, 84, 69,  4, 76, 79, 78, 71,  5, 66,
  146+  69, 71, 73, 78,  4, 83, 80, 69, 67,  3, 69, 78, 68,  4, 76, 73, 83, 84,
  147+   6, 70, 73, 78, 73, 83, 72,  6, 82, 69, 67, 79, 82, 68,  7, 67, 79, 78,
  148+  84, 82, 79, 76,  5, 70, 65, 85, 76, 84,  5, 67, 89, 67, 76, 69,  7, 82,
  149+  79, 85, 84, 73, 78, 69,  7, 84, 82, 85, 83, 84, 69, 68,  7, 80, 82, 79,
  150+  71, 82, 65, 77,  9, 80, 82, 73, 78, 84, 84, 69, 88, 84,  6, 82, 69, 84,
  151+  85, 82, 78,  6, 82, 69, 83, 85, 76, 84,  5, 83, 84, 65, 82, 84,  4, 83,
  152+  84, 79, 80,  7, 77, 79, 78, 73, 84, 79, 82,  4, 69, 88, 73, 84,  3, 65,
  153+  78, 68,  2, 73, 70,  6, 85, 78, 76, 69, 83, 83,  5, 87, 72, 73, 76, 69,
  154+   5, 85, 78, 84, 73, 76,  7, 73, 78, 84, 69, 71, 69, 82,  6, 82, 69, 80,
  155+  69, 65, 84,  4, 82, 69, 65, 76,  6, 83, 87, 73, 84, 67, 72,  6, 83, 84,
  156+  82, 73, 78, 71,  5, 65, 82, 82, 65, 89,  4, 78, 65, 77, 69,  2, 79, 82,
  157+   3, 79, 87, 78,  5, 67, 79, 78, 83, 84,  9, 69, 88, 84, 82, 73, 78, 83,
  158+  73, 67,  8, 69, 88, 84, 69, 82, 78, 65, 76,  6, 83, 89, 83, 84, 69, 77,
  159+   7, 68, 89, 78, 65, 77, 73, 67,  2, 79, 70,  4, 70, 73, 76, 69,  7, 67,
  160+  79, 77, 77, 69, 78, 84,  4, 69, 76, 83, 69,  6, 70, 79, 82, 77, 65, 84,
  161+   2, 70, 78,  3, 77, 65, 80,  4, 84, 72, 69, 78,  5, 82, 69, 65, 76, 83,
  162+   6, 78, 79, 82, 77, 65, 76,  1, 61,  1, 58,  2, 45, 62,  2, 61, 61,  2,
  163+  60, 45,  1, 40,  1, 41,  1, 43,  1, 45,  1, 92,  1, 38,  2, 33, 33,  1,
  164+  33,  1, 42,  2, 47, 47,  1, 47,  1, 46,  2, 60, 60,  2, 62, 62,  2, 60,
  165+  61,  1, 60,  2, 62, 61,  1, 62,  1, 35,  2, 92, 61,  1, 44,  1, 95,  1,
  166+  32,  1, 44
  167  %CONSTSHORTINTEGERARRAY KEYWORD(1 : 80) =    %C
  168+    0,   6,  11,  16,  22,  27,  31,  36,  43,  50,  58,  64,  70,  78,
  169+   86,  94, 104, 111, 118, 124, 129, 137, 142, 146, 149, 156, 162, 168,
  170+  176, 183, 188, 195, 202, 208, 213, 216, 220, 226, 236, 245, 252, 260,
  171+  263, 268, 276, 281, 288, 291, 295, 300, 306, 313, 315, 317, 320, 323,
  172+  326, 328, 330, 332, 334, 336, 338, 341, 343, 345, 348, 350, 352, 355,
  173+  358, 361, 363, 366, 368, 370, 373, 375, 377, 379
  174  %CONSTBYTEINTEGERARRAY KFLAGS(1 : 80) =    %C
  175+  144, 144, 144, 128, 129, 128, 128, 128, 128, 128, 128, 128, 128, 144,
  176+  128, 128, 128, 128, 128, 128, 144, 128, 160, 130, 130, 130, 130, 128,
  177+  128, 128, 128, 128, 145, 129, 128, 144, 144, 144, 144, 144, 144, 145,
  178+  128, 128, 162, 129, 129, 129, 160, 144, 128,   8,   8,   8,   8,   8,
  179+    4,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  180+    8,   8,   8,   8,   8,   8,  64,   0,   0,   0
  181  %OWNBYTEINTEGER ISOLATE BRACKETS = 0;   !  'IB'
  182  %OWNBYTEINTEGER LEAVE BLANKS = 0;       !  'LB'
  183  %OWNBYTEINTEGER SEP BLOCKS = 1;         !  'SB'
  184  %OWNBYTEINTEGER INDENT BLOCKS = 1;      !  'TB'
  185  %OWNBYTEINTEGER SPLIT KEYWORDS = 0;     !  'SK'
  186  %OWNBYTEINTEGER PACK NAMES = 0;         !  'PN'
  187  %OWNBYTEINTEGER SPLIT STATS = 0;        !  'SS'
  188  %OWNBYTEINTEGER COMMENTS NORMAL = 0;    !  'CN'
  189  %OWNBYTEINTEGER BREAK COMMENTS = 1;     !  'BC'
  190  %OWNBYTEINTEGER LEAVE STARS = 1;        !  'LS'
  191  %OWNBYTEINTEGER JUSTIFY ALL = 0;        !  'JA'
  192  %OWNBYTEINTEGER LABELS RELATIVE = 0;    !  'LR'
  193  %OWNBYTEINTEGER SPLIT CONDS = 1;        !  'SC'
  194  %OWNBYTEINTEGER DECS RELATIVE = 1;      !  'DR'
  195  %OWNBYTEINTEGER SPACE LISTS = 1;        !  'SL'
  196  %OWNBYTEINTEGER SPACE EQUALS = 1;       !  'SE'
  197  %OWNBYTEINTEGER ISOLATE LOOPS = 1;      !  'IL'
  198  %OWNBYTEINTEGER EXTRA MARGIN = 0;       !  'EM'
  199  %OWNBYTEINTEGER LEAVE OWNS = 0;         !  'LO'
  200  %OWNBYTEINTEGER COMMENTS RELATIVE = 1;  !  'CR'
  201  %OWNBYTEINTEGER EXTEND COMMENTS = 1;    !  'EC'
  202  %OWNBYTEINTEGER MI = 3;                 !  MARGIN INCREMENT
  203  %OWNBYTEINTEGER LL = 72;                !  LINE LENGTH
  204  %OWNBYTEINTEGER CT = 40;                !  COMMENT TAB
  205  %OWNBYTEINTEGER ML = 40;                !  MARGIN LIMIT
  206  %OWNBYTEINTEGER COMMENT EXTENSION = 5;  !  'CE'
  207  %OWNBYTEINTEGER EXT NUM = 2;            !  'XN'
  208  %OWNBYTEINTEGER INITIAL MARGIN = 7;     !  'IM'
  209  %OWNBYTEINTEGER SECONDARY MARGIN = 3;   !  'SM'
  210  %OWNBYTEINTEGER COMMENT LIMIT = 20;     !  'CL'
  211  %OWNBYTEINTEGER COMMENT LINE = 120;     !  'LC'
  212  %OWNSHORTINTEGER SAFETY FACTOR = 5
  213  %OWNINTEGER DELTA MARGIN = 3
  214  %OWNINTEGER LINE LENGTH = 70
  215  %OWNINTEGER COMMENT TAB = 40
  216  %OWNINTEGER LEVEL = 1, MLIMIT = 0, SEC MARGIN = 3
  217  %OWNBYTEINTEGER COMMENT FLAG
  218  %OWNBYTEINTEGER CMODE, LOOP FLAG
  219  %OWNINTEGER LINESIZE, CS, DISP, D, RMARGIN, FIRST DISP
  220  %OWNINTEGER SIZE, CSTART, LINE BASE, FULL LINE
  221  %EXTERNALROUTINE PROMPT(%STRING (63) S)
  222    PRINT STRING(S)
  223  %END
  224  
  225  !%EXTERNALROUTINESPEC DEFINE(%STRING (63) S)
  226  %EXTERNALROUTINESPEC SEND(%STRING (63) S)
  227  %EXTERNALROUTINESPEC LIST(%STRING (63) S)
  228  %EXTERNALROUTINESPEC DESTROY(%STRING (63) S)
  229  %EXTERNALROUTINESPEC RENAME(%STRING (63) S)
  230  %INTEGERFNSPEC PARSE(%INTEGER EP)
  231  %OWNSTRING (255) INPUT, OUTPUT, OPTION FILE, ST, OPLIST
  232  %OWNINTEGER SPT, SAD, S
  233  %OWNBYTEINTEGER SPACES, MODE
  234  %OWNBYTEINTEGER OK, THIS SEP
  235  %CONSTINTEGER LAST TEXT = 51
  236  %OWNINTEGER HEADER, SEGS
  237  %OWNINTEGERARRAY STRINGS(1 : 100); !(-100 : -1)
  238  %OWNINTEGER COMMENT LENGTH
  239  %OWNSHORTINTEGERARRAY REM(1 : 4)
  240  %OWNBYTEINTEGERARRAY SYMFILE(0 : 300)
  241  %OWNBYTEINTEGERARRAY TLENGTH(1 : 100);!(-100 : -1)
  242  %OWNINTEGERARRAY REC(1 : 100)
  243  %OWNBYTEINTEGER STATUS, OPTIONS, LAST SEP, FLAG, PMODE
  244  %OWNBYTEINTEGER QUOTES = 0, OWNFLAG = ';'
  245  %OWNINTEGER NVAL
  246  !%REGISTER CURRIN(14)
  247  %OWNINTEGER CURRIN
  248  %OWNINTEGER CURROUT, SLENGTH, LIMIT, MARGIN, INBASE, STATSIZE
  249  %OWNINTEGER STAT, KEYBASE, TEXTBASE, J, SN, RP, RPLIM, RPINC
  250  %OWNINTEGER MAXMARGIN, ENDOFFILE
  251  %CONSTINTEGER CCC = X'2025430A'
  252  %CONSTINTEGER CONNEKTEP = 1
  253  %CONSTINTEGER CREATEEP = 162
  254  %CONSTINTEGER READEP = 7
  255  %CONSTINTEGER INFOEP = 5
  256  %CONSTINTEGER CHANGEEP = 6
  257  %ROUTINESPEC SET UP FILES(%STRING(*)%NAME S)
  258  %ROUTINESPEC CLOSE FILES
  259  %ROUTINESPEC SET OPTIONS
  260  
  261  %DYNAMICROUTINESPEC CHERISH(%STRING(63) S)
  262  
  263  
  264  %ROUTINE CONTINUE
  265  !%SHORTROUTINE
  266  %ROUTINESPEC ADJUST
  267  %INTEGERARRAY HOLD(1 : 4)
  268  %INTEGER J, K, L, M, N, Z, LIM, XES
  269  !!%BYTEINTEGERARRAYFORMAT NFM(1 : 4)
  270  %BYTEINTEGERARRAYNAME NEST
  271  %BYTEINTEGER S, CFLAG
  272            !!NEST == ARRAY(ADDR(NVAL),NFM)
  273            THIS SEP = NL;  LIM = MARGIN+SAFETY FACTOR+SEC MARGIN
  274            Z = SLENGTH+CURROUT
  275            %RETURN %IF Z < LIMIT %OR (Z-SAFETY FACTOR-LIMIT < -4 %C
  276+              %AND REC(RP+1) = 0)
  277  !         LEAVE TWO SPACES FOR " %" IF NESC.
  278            XES = Z-LIMIT;                ! EXCESS LINE LENGTH
  279  
  280            %CYCLE J = 1,1,4;  HOLD(J) = NEST(J)+CURROUT-LINE BASE
  281            %REPEAT
  282  
  283            %IF LAST SEP = ';' %THEN %START
  284               N = CURROUT;  QUOTES = 0
  285  
  286               %CYCLE
  287                  N = N-1;  S = BYTEINTEGER(N)
  288                  QUOTES = QUOTES!!1 %IF S = ''''
  289               %REPEAT %UNTIL S = ';' %AND QUOTES = 0
  290  
  291               BYTEINTEGER(N) = NL;  LIMIT = N+LINELENGTH
  292               LINE BASE = N
  293               K = CURROUT+80;  M = K
  294  
  295               %CYCLE L = N+3,1,CURROUT
  296                  K = K+1;  BYTEINTEGER(K) = BYTEINTEGER(L)
  297               %REPEAT
  298  
  299               %CYCLE L = 1,1,MARGIN
  300                  N = N+1;  BYTEINTEGER(N) = ' '
  301               %REPEAT
  302  
  303               %CYCLE L = M+1,1,K
  304                  N = N+1;  BYTEINTEGER(N) = BYTEINTEGER(L)
  305               %REPEAT
  306  
  307               CURROUT = N
  308               LAST SEP = NL
  309               ADJUST
  310               %RETURN %IF CURROUT+SLENGTH < LIMIT
  311            %FINISH
  312            NEST(3) = 0 %IF NEST(4) # 0 %AND REC(REM(4)-1) >= 4
  313            CFLAG = 0
  314  
  315            %CYCLE J = 1,1,4
  316               N = NEST(J)
  317               %IF N > LIM %START
  318                  N = N+LINE BASE
  319                  CFLAG = 1 %AND %EXIT %IF N < CURROUT
  320               %FINISH
  321            %REPEAT
  322  
  323            %IF CFLAG # 0 %START
  324               %IF NEST(J)-MARGIN-SEC MARGIN-SAFETY FACTOR < XES %START
  325                  K = J
  326  
  327                  %WHILE K < 4 %CYCLE
  328                     K = K+1
  329                     CFLAG = 0 %AND %EXIT %IF NEST(K) # 0
  330                  %REPEAT
  331  
  332                  %IF CFLAG = 0 %START
  333                     L = NEST(K)+LINE BASE
  334                     J = K %AND N = L %C
  335+                       %IF NEST(K) > LIM %AND L < CURROUT
  336                  %FINISH
  337               %FINISH
  338               J = 3 %AND N = NEST(3)+LINE BASE %C
  339+                 %IF J = 4 %AND REM(3) = REM(4)-1
  340               LIM = NEST(J)+SAFETY FACTOR+SEC MARGIN
  341               K = CURROUT+80;  M = K
  342  
  343               %CYCLE L = N+1,1,CURROUT
  344                  K = K+1;  BYTEINTEGER(K) = BYTEINTEGER(L)
  345               %REPEAT
  346  
  347               !!*L_1,N
  348               !!*MVC_1(4,1),CCC
  349               !!*LA_1,4(1)
  350               !!*ST_1,CURROUT
  351               !!*ST_1,LINEBASE
  352  
  353               %CYCLE J = 1,1,MARGIN+SEC MARGIN
  354                  CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = ' '
  355               %REPEAT
  356  
  357               M = M+1 %IF BYTEINTEGER(M+1) = ' '
  358               %IF BYTEINTEGER(M+1) # '%' %START
  359                  CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = '%'
  360               %FINISH
  361  
  362               %CYCLE L = M+1,1,K
  363                  CURROUT = CURROUT+1
  364                  BYTEINTEGER(CURROUT) = BYTEINTEGER(L)
  365               %REPEAT
  366  
  367  !??          ADJUST
  368            %FINISH %ELSE %START
  369               LIM = CURROUT-LINEBASE+SAFETY FACTOR
  370               !!*L_1,CURROUT
  371               !!*MVC_1(4,1),CCC
  372               !!*LA_1,4(1)
  373               !!*ST_1,CURROUT
  374               !!*ST_1,LINE BASE
  375  
  376               %CYCLE J = 1,1,MARGIN+SEC MARGIN
  377                  CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = ' '
  378               %REPEAT
  379  
  380               PMODE = 128;               ! NO LONGER IN RANGE OF '%'
  381            %FINISH
  382            LIMIT = LINEBASE+LINE LENGTH
  383            STATSIZE = STATSIZE-LINELENGTH+MARGIN
  384            RPLIM = RPLIM+RPINC %IF STATSIZE+MARGIN >= LINE LENGTH
  385            NVAL = 0
  386  
  387  %ROUTINE ADJUST
  388  
  389               %CYCLE J = 1,1,4
?Non-local
  390                  %IF NEST(J) <= LIM %THEN NEST(J) = 0 %C
  391+                    %ELSE NEST(J) = HOLD(J)-CURROUT+LINE BASE
  392               %REPEAT
  393  
  394  %END
  395  %END
  396  
  397  %ROUTINE BREAK
  398  !%SHORTROUTINE
  399            CURROUT = CURROUT-2 %UNLESS BYTEINTEGER(CURROUT) = ';'
  400            BYTEINTEGER(CURROUT) = NL
  401            SIZE = 0;  LINE BASE = CURROUT
  402            LIMIT = LINE BASE+LINE SIZE
  403            NVAL = 0
  404  %END
  405  
  406  %EXTERNALROUTINE SOAP(%STRING (128) FILES)
  407  !%SHORTROUTINE
  408  %OWNINTEGER MOVEX = X'D2002001', MOVEY = X'10010000'
  409  %ROUTINESPEC PERCENT
  410  %ROUTINESPEC SPACE
  411  %INTEGERNAME MID MARGIN
  412  %INTEGER N, P, K, M, Z
  413  !!%BYTEINTEGERARRAYFORMAT NFM(1 : 4)
  414  %BYTEINTEGERARRAYNAME NEST
  415            PRINT STRING( "SOAP");  {PRINTCH(7);}  NEWLINE
  416            !!NEST == ARRAY(ADDR(NVAL),NFM)
  417            SET UP FILES(FILES);  %RETURN %IF OK = 0
  418            SET OPTIONS;  %RETURN %IF OK = 0
  419            MID MARGIN == MARGIN
  420            MID MARGIN == RMARGIN %IF COMMENTS RELATIVE = 0
  421  !*                32             16      8     4     2      1
  422  !* STATUS:  SPECIAL COMMENT : COMMENT : OWN : END : DOWN : UP
  423  TOP:                                    !    HEAD OF MAIN LOOP
  424  
  425            %CYCLE
  426               NVAL = 0
  427               LOOP FLAG = 0
  428               RP = 0;  SPT = 0;  MODE = 0;  STATUS = 0
  429               SAD = TEXTBASE
  430               LIMIT = CURROUT+LINELENGTH %IF LAST SEP # ';'
  431               INBASE = CURRIN
  432               %IF PARSE(0) # 0 %THEN %START
  433                                          !    SYNTAX ??
  434  OWNS:           J = CURRIN;  QUOTES = 0;  K = 0
  435  
  436                  %CYCLE
  437                     K = K+1
  438                     J = J+1;  S = BYTEINTEGER(J)
  439                     QUOTES = QUOTES!!1 %IF S = ''''
  440                  %REPEAT %UNTIL (S = NL %OR S = ';') %AND (QUOTES = 0 %OR K > 300)
  441  
  442                  SLENGTH = J-CURRIN
  443                  %IF CURROUT+SLENGTH > LIMIT %AND LAST SEP = ';' %C
  444+                    %THEN %START
  445                     BREAK
  446                     STAT = CURROUT+MARGIN
  447  
  448                     %CYCLE J = 1,1,MARGIN
?Non-local
  449                        CURROUT = CURROUT+1
  450                        BYTEINTEGER(CURROUT) = ' '
  451                     %REPEAT
  452  
  453                  %FINISH
  454                  %IF OWNFLAG = 0 %THEN %START
  455                     OWNFLAG = ';'
  456                     %IF CURROUT+SLENGTH+SAFETY FACTOR > LIMIT %C
  457+                       %THEN %START
  458                        !!*L_1,CURROUT
  459                        !!*MVC_1(4,1),CCC;  ! PUSH IN CONTINUATION
  460                        !!*LA_1,4(1)
  461                        !!*ST_1,CURROUT
  462                        !!*ST_1,LINE BASE
  463                     %FINISH
  464                  %FINISH
  465  
  466                  %CYCLE J = 1,1,SLENGTH
?Non-local
  467                     CURRIN = CURRIN+1;  CURROUT = CURROUT+1
  468                     BYTEINTEGER(CURROUT) = BYTEINTEGER(CURRIN)
  469                  %REPEAT
  470  
  471                  LAST SEP = BYTEINTEGER(CURRIN)
  472                  %IF LAST SEP = ';' %THEN %START
  473                     BYTEINTEGER(CURROUT+1) = ' '
  474                     BYTEINTEGER(CURROUT+2) = ' '
  475                     CURROUT = CURROUT+2
  476                  %FINISH %ELSE LINE BASE = CURROUT
  477               %FINISH %ELSE %START
  478                  PMODE = 128
  479                  STATSIZE = CURRIN-INBASE
  480                  %IF STATSIZE+MARGIN > LINE LENGTH %START
  481                     RPINC = RP//(STATSIZE//(LINE LENGTH-MARGIN))
  482                     RPLIM = RPINC
  483                  %FINISH %ELSE RPLIM = RP
  484                  %IF STATUS&11 # 0 %AND LAST SEP = ';' %THEN %START
  485                     LAST SEP = NL
  486                     BREAK
  487                  %FINISH
  488                  %IF STATUS&136 # 0 %THEN %START
  489                                          !    BLANK LINE OR BLOCK
  490                     %IF (LEAVE BLANKS # 0 %AND THIS SEP # ';') %C
  491+                       %OR (STATUS&128 # 0 %AND SEP BLOCKS # 0) %C
  492+                       %THEN %START
  493  NULL:
  494                        CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = NL
  495                        LINE BASE = CURROUT
  496                     %FINISH
  497                     -> TOP %IF STATUS&8 # 0 %AND RP <= 1
  498                                          !    IN CASE OF LONELY LABELS
  499                  %FINISH
  500                  RP = 0
  501                  %IF LOOP FLAG # 0 %AND STATUS&1 # 0 %C
  502+                    %AND BYTEINTEGER(CURROUT-1) # NL %START
  503                     CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = NL
  504                     LINE BASE = CURROUT
  505                     LIMIT = LIMIT+1
  506                  %FINISH
  507                  %IF STATUS&2 # 0 %THEN %START
  508                                          !    DOWN
  509                     STATUS = STATUS!64 %C
  510+                       %IF EXTRA MARGIN # 0 %AND STATUS&4 # 0
  511                     LEVEL = LEVEL>>1
  512                     LEVEL = 1 %IF LEVEL = 0
  513                     MARGIN = MARGIN-DELTA MARGIN %IF MLIMIT&1 = 0
  514                     MLIMIT = MLIMIT>>1
  515                     MARGIN = 0 %IF MARGIN < 0
  516                  %FINISH
  517                  STAT = CURROUT+MARGIN %IF LAST SEP # ';'
  518  
  519                  %WHILE REC(RP+1) = 100 %CYCLE
  520                                          !    DEAL WITH LABELS
  521                     RP = RP+1
  522                     %IF LAST SEP = ';' %OR LAST SEP = ':' %THEN %START
  523                        N = -2;  N = 1 %IF LAST SEP = ':'
  524                        CURROUT = CURROUT+N;  BYTEINTEGER(CURROUT) = NL
  525                        LINE BASE = CURROUT
  526                        LIMIT = CURROUT+LINELENGTH
  527                        STAT = CURROUT+MARGIN
  528                        LAST SEP = NL
  529                     %FINISH
  530                     %IF LABELS RELATIVE # 0 %AND LAST SEP # ':' %C
  531+                       %THEN %START
  532                        N = LEVEL;  M = MARGIN
  533                        M = M+FIRST DISP %C
  534+                          %IF EXTRA MARGIN # 0 %AND LEVEL = 1
  535  
  536                        %CYCLE
  537                           M = M-DELTA MARGIN
  538                           %EXIT %IF N&1 # 0
  539                           N = N>>1
  540                        %REPEAT
  541  
  542                        %WHILE M > 0 %CYCLE
  543                           M = M-1
  544                           CURROUT = CURROUT+1
  545                           BYTEINTEGER(CURROUT) = ' '
  546                        %REPEAT
  547  
  548                     %FINISH
  549  
  550                     %CYCLE
  551                        RP = RP+1;  N = REC(RP);  %EXIT %IF N = 0
  552                        %IF N < 0 %THEN SN = STRINGS(-N) %C
  553+                          %ELSE SN = KEYWORD(N)+KEYBASE
  554  
  555                        %CYCLE J = SN+1,1,SN+BYTEINTEGER(SN)
?Non-local
  556                           CURROUT = CURROUT+1
  557                           BYTEINTEGER(CURROUT) = BYTEINTEGER(J)
  558                        %REPEAT
  559  
  560                     %REPEAT
  561  
  562                     %IF CURROUT > STAT %AND STATUS&16 = 0 %THEN %START
  563                        CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = NL
  564                        LINE BASE = CURROUT
  565                        LIMIT = CURROUT+LINELENGTH
  566                        STAT = CURROUT+MARGIN
  567                     %FINISH
  568                     LAST SEP = ':'
  569                  %REPEAT
  570  
  571                  RP = 0 %AND -> NULL %IF STATUS&8 # 0
  572                                          !    NOW DEAL WITH COMMENTS
  573                  %IF STATUS&16 # 0 %THEN %START
  574                     RP = RP+1;  DISP = REC(RP)
  575                                          !   STARTING DISP OF INPUT
  576                                          !  COMMENT
  577                     D = 0;  CMODE = 0
  578                     J = CURRIN;          !   FIND THE END OF THE COMMENT
  579                     J = J+1 %WHILE BYTEINTEGER(J) # NL %C
  580+                       %AND BYTEINTEGER(J) # ';'
  581                     CS = J-CURRIN;       !   COMMENT SIZE
  582                     %IF COMMENT FLAG = 0 %C
  583+                       %THEN CSTART = COMMENT TAB %ELSE %START
  584                        %IF COMMENTS NORMAL # 0 %START
  585                           CMODE = 1;  CSTART = MARGIN
  586                        %FINISH %ELSE %START
  587                           %IF LAST SEP = ';' %C
  588+                             %THEN CSTART = COMMENT TAB %ELSE %START
  589                              %IF DISP = 0 %THEN CSTART = 0 %ELSE %START
  590                                 %IF DISP <= MID MARGIN %C
  591+                                   %AND STATUS&32 = 0 %C
  592+                                   %THEN CSTART = MARGIN %C
  593+                                   %ELSE CSTART = COMMENT TAB
  594                              %FINISH
  595                           %FINISH
  596                        %FINISH
  597                     %FINISH
  598                     CSTART = 0 %IF STATUS&32 # 0 %AND LEAVE STARS # 0
  599                     SIZE = CURROUT-LINE BASE
  600                     %IF LAST SEP = ';' %START
  601                        %IF BYTEINTEGER(CURROUT) = NL %START
  602                                          ! COMMENT AFTER REPEAT+NL
  603                           LOOP FLAG = 1
  604                           LINE BASE = LINE BASE-1 %C
  605+                             %UNTIL BYTEINTEGER(LINE BASE) = NL
  606                           SIZE = CURROUT-LINE BASE
  607                        %FINISH
  608                        CURROUT = CURROUT-2;  SIZE = SIZE-2
  609                                          ! TO REMOVE SPACES AFTER SEMI"S
  610                        %IF EXTEND COMMENTS # 0 %AND CSTART < SIZE %START
  611                           P = CSTART;    ! REMEMBER IT JUST IN CASE
  612                           N = EXT NUM;   ! NUMBER OF EXTENSION TRIES
  613  
  614                           %CYCLE
  615                              %EXIT %IF N <= 0
  616                              CSTART = CSTART+COMMENT EXTENSION
  617                              %EXIT %IF CSTART >= SIZE
  618                              N = N-1
  619                           %REPEAT
  620  
  621                           CSTART = P %IF N <= 0 %C
  622+                             %OR CS+CSTART > COMMENT LINE
  623  ! RESTORE IT IF TOO LONG
  624                        %FINISH
  625                        %IF CSTART < SIZE %START
  626                           %IF CMODE # 0 %THEN CSTART = 0 %ELSE BREAK
  627                        %FINISH %ELSE %START
  628                           D = COMMENT LINE-CSTART-CS
  629                           %IF D < 0 %AND BREAK COMMENTS = 0 %START
  630                              CSTART = LINE SIZE-CS
  631                              BREAK
  632                              D = 0
  633                           %FINISH
  634                        %FINISH
  635                     %FINISH %ELSE %START
  636                        D = COMMENT LINE-CSTART-CS
  637                        %IF D < 0 %AND BREAKCOMMENTS = 0 %THEN %START
  638                           CSTART = COMMENT LINE-CS
  639                           D = 0
  640                        %FINISH
  641                     %FINISH
  642  
  643                     %CYCLE
  644                        N = CSTART-SIZE
  645  
  646                        %WHILE N > 0 %CYCLE
  647                           N = N-1;  CURROUT = CURROUT+1
  648                           BYTEINTEGER(CURROUT) = ' '
  649                        %REPEAT
  650  
  651                        CURROUT = CURROUT+1
  652                        BYTEINTEGER(CURROUT) = '!'
  653                        CURROUT = CURROUT+1 %C
  654+                          %AND BYTEINTEGER(CURROUT) = '*' %C
  655+                          %IF STATUS&32 # 0
  656                        P = J
  657                        %IF D < 0 %START
  658                           P = J+D
  659                           P = P-1 %WHILE BYTEINTEGER(P) # ' ' %C
  660+                             %AND BYTEINTEGER(P) # ',' %C
  661+                             %AND BYTEINTEGER(P) # '.' %AND P > CURRIN
  662                           P = P-1
  663                           P = J+D %IF P = CURRIN
  664                        %FINISH
  665  
  666                        %CYCLE K = CURRIN+1,1,P
  667                           CURROUT = CURROUT+1
  668                           BYTEINTEGER(CURROUT) = BYTEINTEGER(K)
  669                        %REPEAT
  670  
  671                        CURRIN = P
  672                        %EXIT %IF D >= 0
  673                        CURROUT = CURROUT+1
  674                        BYTEINTEGER(CURROUT) = NL
  675                        SIZE = 0;  D = LINE LENGTH-MARGIN+D
  676                     %REPEAT
  677  
  678                     BYTEINTEGER(CURROUT) = NL
  679                     %IF LOOP FLAG # 0 %START
  680                        LOOP FLAG = 0
  681                        CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = NL
  682                     %FINISH
  683                     SIZE = 0;  LINE BASE = CURROUT;  LAST SEP = NL
  684                                          !   END OF COMMENT HANDLING
  685                  %FINISH %ELSE %START
  686                     N = 0
  687                     %IF STATUS&64 # 0 %START
  688                        N = DELTA MARGIN
  689                        N = MARGIN %IF EXTRA MARGIN # 0
  690                     %FINISH
  691                     STAT = STAT-N
  692                     CURROUT = CURROUT+1 %C
  693+                       %AND BYTEINTEGER(CURROUT) = ' ' %C
  694+                       %WHILE CURROUT < STAT
  695                     LIMIT = CURROUT+LINELENGTH-MARGIN+N %C
  696+                       %IF LAST SEP # ';'
  697  
  698                     %CYCLE
  699                        RP = RP+1;  N = REC(RP);  %EXIT %IF N = 0
  700                        %IF N > 0 %THEN %START
  701                           SN = KEYWORD(N)+KEYBASE
  702                           FLAG = KFLAGS(N)
  703                           Z = SFLAGS(N)
  704                           SLENGTH = BYTEINTEGER(SN)
  705                        %FINISH %ELSE %START
  706                           SN = STRINGS(-N)
  707                           FLAG = 0;  Z = 0
  708                           SLENGTH = TLENGTH(-N)
  709                        %FINISH
  710                        %IF RP >= RPLIM %C
  711+                          %OR (SLENGTH+CURROUT > LIMIT %C
  712+                          %AND N <= LAST TEXT) %THEN CONTINUE
  713                        %IF Z # 0 %START
  714                           NEST(Z) = CURROUT-LINE BASE
  715                           REM(Z) = RP
  716                        %FINISH
  717                        SPACE %IF FLAG&OPTIONS&15 # 0 %C
  718+                          %OR (PMODE!!FLAG)&128 = 0
  719                        PERCENT %IF FLAG&PMODE # 0
  720                        %CYCLE J=SN+1, 1, SN+BYTEINTEGER(SN)
?Non-local
  721                          CURROUT=CURROUT+1
  722                          BYTEINTEGER(CURROUT)=BYTEINTEGER(J)
  723                        %REPEAT
  724                        SPACE %IF FLAG&OPTIONS&120 # 0
  725                        PMODE = 128 %UNLESS 0 < N <= LAST TEXT
  726                     %REPEAT
  727  
  728                     -> OWNS %IF OWNFLAG = 0
  729                     CURROUT = CURROUT+1
  730                     BYTEINTEGER(CURROUT) = THIS SEP
  731                     LAST SEP = THIS SEP
  732                     %IF LOOP FLAG # 0 %AND STATUS&2 # 0 %START
  733                        CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = NL
  734                     %FINISH
  735                     %IF STATUS&1 # 0 %THEN %START
  736                                          !    UP
  737                        LEVEL = LEVEL<<1
  738                        LEVEL = LEVEL!1 %IF STATUS&128 # 0
  739                        MLIMIT = MLIMIT<<1
  740                        MLIMIT = MLIMIT!1 %C
  741+                          %IF MARGIN >= MAX MARGIN %OR ( %C
  742+                          INDENT BLOCKS = 0 %AND STATUS&128 # 0)
  743                        %IF MARGIN = 0 %AND EXTRA MARGIN # 0 %C
  744+                          %THEN MARGIN = INITIAL MARGIN %ELSE %START
  745                           MARGIN = MARGIN+DELTA MARGIN %IF MLIMIT&1 = 0
  746                        %FINISH
  747                     %FINISH
  748                     %IF LAST SEP = ';' %THEN %START
  749                        BYTEINTEGER(CURROUT+1) = ' '
  750                        CURROUT = CURROUT+2
  751                        BYTEINTEGER(CURROUT) = ' '
  752                     %FINISH %ELSE LINE BASE = CURROUT
  753                     %EXIT %IF CURRIN >= ENDOFFILE %OR STATUS&7 = 7
  754                  %FINISH
  755               %FINISH
  756            %REPEAT
  757  
  758            CLOSE FILES
  759            %RETURN
  760  
  761  %ROUTINE SPACE
  762               %IF ' ' # BYTEINTEGER(CURROUT) # NL %C
  763+                 %AND BYTEINTEGER(CURROUT) # '(' %THEN %START
  764                  CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = ' '
  765                  PMODE = 128
  766               %FINISH
  767  %END
  768  
  769  %ROUTINE PERCENT
  770               %IF PMODE # 0 %THEN %START
  771                  %IF ' ' # BYTEINTEGER(CURROUT) # NL %C
  772+                    %AND BYTEINTEGER(CURROUT) # '(' %THEN %START
  773                     CURROUT = CURROUT+1;  BYTEINTEGER(CURROUT) = ' '
  774                  %FINISH
  775                  CURROUT = CURROUT+1
  776                  BYTEINTEGER(CURROUT) = '%'
  777                  PMODE = 0
  778               %FINISH
  779  %END
  780  %END
?MOVEY unused
?MOVEX unused
  781  
  782  %ROUTINE CONNEKT(%STRING (17) FILE, %INTEGERNAME MODE, FLAG)
  783  %INTEGER J
  784            J = 0
  785            !FDP(CONNEKTEP,FILE,MODE,ADDR(J),FLAG)
  786            MODE = J
  787            FLAG = 0 %IF FLAG = 5
  788  %END
?FILE unused
  789  
  790  %INTEGERFN PARSE(%INTEGER ENTRY)
  791  !%SHORTROUTINE
  792  %INTEGER SS, SP, TRP, TPT, L
  793  %BYTEINTEGER MODES
  794  
  795  %INTEGERFN PUT
  796               SPT = SPT-1
  797               RP = RP+1
  798               REC(RP) = SPT
  799               TLENGTH(-SPT) = SLENGTH
  800               STRINGS(-SPT) = SAD
  801               STRING(SAD) = ST
  802               SAD = SAD+1+BYTEINTEGER(ADDR(ST))
  803               %RESULT = SPT
  804  %END
  805  
  806  %ROUTINE SYM
  807  
  808               %CYCLE
  809                  CURRIN = CURRIN+1;  S = BYTEINTEGER(CURRIN)
  810                  MODE = 0 %UNLESS 'A' <= S <= 'Z'
  811                  %IF S = '%' %THEN MODE = 32 %ELSE %START
  812                     %IF S # ' ' %THEN %START
  813                        S = S+MODE
  814                        %RETURN %IF S # 'C'+32 %C
  815+                          %OR BYTEINTEGER(CURRIN+1) # NL
  816                        CURRIN = CURRIN+1
  817                        MODE = 0
  818                     %FINISH
  819                     SPACES = PACK NAMES
  820                  %FINISH
  821               %REPEAT
  822  
  823  %END
  824  
  825  %INTEGERFN CONSTANT
  826  %INTEGER T, LIM
  827  %INTEGER CS
  828               SLENGTH = 0
  829               ST = ""
  830               SYM
  831               CS = CURRIN %AND ST = ST.TOSTRING(S) %AND SYM %C
  832+                 %WHILE '0' <= S <= '9' %OR S = '.' %OR S = '@'
  833               CURRIN = CS %AND %RESULT = PUT %IF ST # ""
  834               %IF S = 'M' %OR S = 'X' %OR S = 'B' %THEN %START
  835                  ST = TOSTRING(S)
  836                  T = CURRIN
  837                  SYM
  838                  CURRIN = T %AND %RESULT = 0 %IF S # ''''
  839               %FINISH
  840               LIM = CURRIN+255
  841  
  842               %WHILE S = '''' %CYCLE
  843  
  844                  %CYCLE
  845                     SLENGTH = BYTEINTEGER(ADDR(ST)) %C
  846+                       %IF S = NL %AND SLENGTH = 0
  847                     ST = ST.TOSTRING(S)
  848                     CURRIN = CURRIN+1
  849                     S = BYTEINTEGER(CURRIN)
  850                  %REPEAT %UNTIL S = '''' %OR CURRIN > LIM
  851  
  852                  ST = ST."'"
  853                  CS = CURRIN
  854                  SYM
  855               %REPEAT
  856  
  857               SLENGTH = BYTEINTEGER(ADDR(ST)) %IF SLENGTH = 0
  858               CURRIN = CS %AND %RESULT = PUT %IF ST # ""
  859               %RESULT = 0
  860  %END
  861  
  862  %INTEGERFN NAME
  863  %INTEGER Z
  864               SYM
  865               %RESULT = 0 %UNLESS 'A' <= S <= 'Z'
  866               ST = ""
  867  
  868               %CYCLE
  869                  SPACES = 1
  870                  ST = ST.TOSTRING(S)
  871                  Z = CURRIN
  872                  SYM
  873                  SLENGTH = BYTEINTEGER(ADDR(ST)) %AND CURRIN = Z %C
  874+                    %AND %RESULT = PUT %C
  875+                    %UNLESS 'A' <= S <= 'Z' %OR '0' <= S <= '9'
  876                  ST = ST." " %IF SPACES = 0
  877               %REPEAT
  878  
  879  %END
  880  %SWITCH BIP(0 : 15)
  881                                          !
  882            TRP = RP
  883            TPT = CURRIN
  884            MODES = MODE
  885  FAILURE:
  886            RP = TRP
  887            CURRIN = TPT
  888            MODE = MODES
  889            ENTRY = ENTRY+1
  890            SP = MAIN(ENTRY)
  891            %RESULT = 1 %IF SP = 0
  892  SUCCESS:
  893            SP = SP+1
  894            SS = SUB(SP)
  895            %RESULT = 0 %IF S S = 0
  896            -> BIP(SS>>12&15)
  897  BIP(1):                                 !    SUB-PHRASE
  898            -> SUCCESS %IF PARSE(SS&X'FFF') = 0
  899            -> FAILURE
  900  BIP(0):                                 !    LITERAL
  901            SS = SS&X'FFF'
  902            L = LITERAL(SS);              ! LENGTH
  903  
  904            %CYCLE SS = SS+1,1,SS+L
  905               SYM
  906               -> FAILURE %UNLESS S = LITERAL(SS)
  907            %REPEAT
  908  
  909            -> SUCCESS
  910  BIP(15):                                !    (NAME)
  911            -> SUCCESS %IF NAME # 0
  912            -> FAILURE
  913  BIP(3):                                 !    CONSTANT
  914            -> SUCCESS %IF CONSTANT # 0
  915            -> FAILURE
  916  BIP(4):                                 ! (*LOOP)
  917            LOOP FLAG = 1 %IF ISOLATE LOOPS # 0
  918            -> SUCCESS
  919  BIP(5):                                 !    (UP)
  920            STATUS = STATUS!1;  -> SUCCESS
  921  BIP(6):                                 !    (DOWN)
  922            STATUS = STATUS!2;  -> SUCCESS
  923  BIP(7):                                 !    (END)
  924            STATUS = STATUS!4;  -> SUCCESS
  925  BIP(8):                                 !    (OWN)
  926            -> FAILURE %IF LEAVE OWNS # 0 %C
  927+              %AND BYTEINTEGER(CURRIN) # '*'
  928  ! MACHINE CODE
  929            OWN FLAG = 0
  930            RP = RP+1;  REC(RP) = 0
  931                                          !    TO FIDDLE THE END OF STAT.
  932            THIS SEP = NL
  933            -> SUCCESS
  934  BIP(10):                                !    (SPECIAL COMMENT)
  935            INBASE = INBASE+1;            ! TO SET DISP PROPERLY
  936            STATUS = STATUS!32
  937  BIP(9):                                 !     (COMMENT)
  938            STATUS = STATUS!16
  939            RP = RP+1;  REC(RP) = CURRIN-INBASE-1
  940            -> SUCCESS
  941  BIP(11):                                !    (*DEC)
  942            STATUS = STATUS!64 %IF DECS RELATIVE # 0;  -> SUCCESS
  943  BIP(12):                                !     (*BLOCK)
  944            STATUS = STATUS!64 %IF EXTRA MARGIN # 0
  945            STATUS = STATUS!128;  -> SUCCESS
  946  BIP(13):                                !     (*NULL)
  947            STATUS = STATUS!8;  -> SUCCESS
  948  BIP(14):                                !    (S)
  949            SYM
  950            -> FAILURE %UNLESS S = NL %OR S = ';'
  951            THIS SEP = S
  952            THISSEP = NL %IF SPLIT STATS # 0
  953            RP = RP+1
  954            REC(RP) = 0
  955            -> SUCCESS
  956  BIP(2):                                 !    <>
  957            RP = RP+1
  958            REC(RP) = SS&X'FFF'
  959            -> SUCCESS
  960  %END
  961  
  962  %ROUTINE CREATE(%STRING (8) FILE, %INTEGERNAME SIZE, FLAG)
  963            !FDP(CREATEEP,FILE,SIZE,0,FLAG)
  964            SIZE = 3
  965            %IF FLAG = 0 %OR FLAG = 3 %THEN CONNEKT(FILE,SIZE,FLAG)
  966  %END
  967  
  968  %ROUTINE COMPRESS(%STRING (8) FILE)
  969  %END
?FILE unused
  970  
  971  %ROUTINE SET UP FILES(%STRING(*)%NAME S)
  972  !%SHORTROUTINE
  973  %INTEGER FLAG, SIZE
  974            OK = 0
  975            INPUT = ""
  976            OUTPUT = ""
  977            OPTION FILE = ""
  978            INPUT = S %UNLESS S -> INPUT.("/").OUTPUT
  979            OPTION FILE = "" %UNLESS INPUT -> INPUT.(",").OPTION FILE
  980            OUTPUT = INPUT %IF OUTPUT = ""
  981            SIZE = 0
  982            !FDP(7, INPUT, 0, ADDR(SIZE), FLAG)
  983            CURRIN = SIZE
  984            %IF FLAG # 0 %THEN %START
  985               PRINTSTRING("CANNOT CONNECT ".INPUT.": ");  WRITE(FLAG,1)
  986               NEWLINE
  987               %RETURN
  988            %FINISH
  989            %IF INTEGER(CURRIN+12) # 0 %THEN %START
  990               PRINTSTRING(INPUT." IS NOT A SOURCE FILE\n")
  991               %RETURN
  992            %FINISH
  993            SIZE = INTEGER(CURRIN)
  994            %IF SIZE < 10 %THEN %START
  995               PRINTSTRING(INPUT." IS A NULL FILE\n")
  996               %RETURN
  997            %FINISH
  998            ENDOFFILE = CURRIN+SIZE
  999            ENDOFFILE = ENDOFFILE-1 %WHILE BYTEINTEGER(ENDOFFILE) # NL
 1000            CURROUT = ((SIZE*6)+4095)>>12;!    I HOPE IT"S BIG ENOUGH
 1001            SEGS = (CURROUT+15)>>4
 1002            CREATE("SP#WORK",CURROUT,FLAG)
 1003            %IF FLAG # 0 %THEN %START
 1004               PRINT STRING( "CANNOT CREATE WORK FILE");  WRITE(FLAG,1)
 1005               NEWLINE
 1006               %RETURN
 1007            %FINISH
 1008            HEADER = CURROUT
 1009            CURROUT = CURROUT+16
 1010            BYTEINTEGER(CURROUT) = NL
 1011            CURRIN = CURRIN+15
 1012            INTEGER(HEADER) = 1<<16;      !    JUST FOR TESTING
 1013            INTEGER(HEADER+4) = 16
 1014            INTEGER(HEADER+8) = SEGS
 1015            INTEGER(HEADER+12) = 0
 1016            OK = 1
 1017  %END
 1018  
 1019  %ROUTINE CLOSE FILES
 1020     %ROUTINE NEWGENS
 1021     %END
 1022  %END
?NEWGENS unused
 1023  
 1024  %ROUTINE SET OPTIONS
 1025  !%SHORTROUTINE
 1026  %STRING (255) S, T
 1027  %INTEGER J
 1028  %BYTEINTEGER OPT FLAG
 1029  !!%BYTEINTEGERARRAYFORMAT FM(1 : 31)
 1030  %BYTEINTEGERARRAYNAME WORD
 1031  
 1032  %ROUTINE LINE(%STRING(*)%NAME S)
 1033  %INTEGER J
 1034               %RETURN %IF OPT FLAG = 0
 1035               S = ""
 1036  
 1037               %CYCLE
 1038  
 1039                  %CYCLE
 1040                     READSYMBOL(J) %UNTIL J # ' '
 1041                     %EXIT %IF J = NL
 1042                     S = S.TOSTRING(J)
 1043                  %REPEAT
 1044  
 1045               %REPEAT %UNTIL S # ""
 1046  
 1047  %END
 1048  
 1049  %ROUTINE SET(%STRING(*)%NAME S)
 1050  %STRING (255) N, OPT
 1051  %INTEGER V, K, C, NUM
 1052  %BYTEINTEGER NOT
 1053  %CONSTSTRING (2) %ARRAY PARAM(1 : 31) =          %C
 1054+ "IB", "LB", "SB", "TB", "SK", "PN", "SS", "CN", "BC",
 1055+ "LS", "JA", "LR", "SC",
 1056+ "DR", "SL", "SE", "IL", "EM",
 1057+ "LO", "CR", "EC",
 1058+ "MI", "LL", "CT", "ML",
 1059+ "CE",  "XN",  "IM", "SM",
 1060+ "CL", "LC"
 1061  %OWNINTEGER PARAMS = 31, BOOLS = 21
 1062               OPT = S
 1063               NOT = 1;  NUM = 0
 1064               %IF S -> S.("=").N %THEN %START
 1065                  NUM = -1;  V = 0;  J = ADDR(N)
 1066  
 1067                  %CYCLE J = J+1,1,J+LENGTH(N)
?Non-local
 1068                     C = BYTEINTEGER(J)-'0'
 1069                     %UNLESS 0 <= C <= 9 %THEN %START
 1070                        PRINTSTRING(N." ?\n")
 1071                        %RETURN
 1072                     %FINISH
 1073                     V = V*10+C
 1074                  %REPEAT
 1075  
 1076                  %IF V > 255 %THEN %START
 1077                     PRINTSTRING(N." ?\n")
 1078                     %RETURN
 1079                  %FINISH
 1080               %FINISH
 1081               NOT = 0 %IF NUM = 0 %AND S -> ("\").S
 1082  
 1083               %CYCLE J = 1,1,PARAMS
?Non-local
 1084                  %IF PARAM(J) = S %THEN %START
 1085                     %IF (BOOLS-J)!!NUM < 0 %THEN %START
 1086                        PRINTSTRING(S."= ?\n")
 1087                        %RETURN
 1088                     %FINISH
 1089                     K = NOT;  K = V %IF NUM < 0
 1090                     WORD(J) = K
 1091                     OPLIST = OPLIST." ".OPT
 1092                     %RETURN
 1093                  %FINISH
 1094               %REPEAT
 1095  
 1096               PRINTSTRING(S." ?\n")
 1097  %END
 1098            OPLIST = "\n!! OPTIONS:"
 1099            !!WORD == ARRAY(ADDR(ISOLATE BRACKETS),FM)
 1100            OK = 1
 1101            %IF OPTIONFILE # "" %THEN %START
 1102               OK = 0
 1103               OPT FLAG = 0
 1104               %IF OPTIONFILE -> ("[").S %THEN %START
 1105                  OPT FLAG = 0 %IF S -> S.("]")
 1106                  S = S.",*"
 1107               %FINISH %ELSE %START
 1108                  OPT FLAG = 1
 1109                  PROMPT("OPTIONS:")
 1110                  !DEFINE("ST76,".OPTION FILE)
 1111                  SELECTINPUT(76)
 1112               %FINISH
 1113  
 1114               %CYCLE
 1115                  LINE(S)
 1116                  SET(T) %WHILE S -> T.(",").S
 1117                  %EXIT %IF S = "*"
 1118                  SET(S)
 1119               %REPEAT
 1120  
 1121               %IF CHARNO(OUTPUT,1) = '.' %START
 1122                                          ! SHOW OPTIONS
 1123                  STRING(CURROUT) = OPLIST."\n\n"
 1124                  BYTEINTEGER(CURROUT) = NL
 1125                  CURROUT = CURROUT+LENGTH(OPLIST)+2
 1126               %FINISH
 1127            %FINISH
 1128            DELTA MARGIN = MI
 1129            LINE LENGTH = LL
 1130            COMMENT TAB = CT
 1131            MAXMARGIN = ML
 1132            SEC MARGIN = SECONDARY MARGIN
 1133            %UNLESS 40 < LINELENGTH < 133 %THEN %START
 1134               PRINT STRING( "INVALID LINE LENGTH\n")
 1135               %RETURN
 1136            %FINISH
 1137            %UNLESS 0 < COMMENT TAB < LINE LENGTH-20 %THEN %START
 1138               PRINT STRING( "INVALID COMMENT MARGIN\n")
 1139               %RETURN
 1140            %FINISH
 1141            %UNLESS MAX MARGIN < LINE LENGTH-20 %THEN %START
 1142               PRINT STRING( "INVALID MAX MARGIN\n")
 1143               %RETURN
 1144            %FINISH
 1145            %UNLESS DELTA MARGIN <= MAX MARGIN<<1 %START
 1146               PRINT STRING( "INVALID MARGIN INCREMENT\n")
 1147               %RETURN
 1148            %FINISH
 1149            %IF SEC MARGIN > DELTA MARGIN<<1+SAFETY FACTOR %START
 1150               PRINT STRING( "INVALID SECONDARY MARGIN\n")
 1151               %RETURN
 1152            %FINISH
 1153            %IF INITIAL MARGIN > 30 %THEN %START
 1154               PRINT STRING( "INVALID INITIAL MARGIN\n")
 1155               %RETURN
 1156            %FINISH
 1157            MARGIN = 1 %IF DELTA MARGIN = 0 %AND SEC MARGIN = 0 %C
 1158+              %AND INITIAL MARGIN = 0
 1159            MARGIN = INITIAL MARGIN %IF EXTRA MARGIN # 0
 1160            SPLIT CONDS = 1 %IF SPLIT KEYWORDS # 0
 1161            COMMENT LENGTH = LINE LENGTH-COMMENT TAB
 1162            TEXTBASE = ADDR(SYMFILE(0))
 1163            KEYBASE = ADDR(KEYSYMS(1))
 1164            RMARGIN = COMMENT LIMIT
 1165            FULL LINE = LINE LENGTH
 1166            LINE LENGTH = LINE LENGTH-SAFETY FACTOR
 1167            OPTIONS = 17*SPLIT KEYWORDS+34*SPLIT CONDS+SPACE LISTS<<6 %C
 1168+              +ISOLATE BRACKETS<<2+SPACE EQUALS<<3+128
 1169            LINE BASE = CURROUT;  SIZE = 0
 1170            COMMENT FLAG = JUSTIFY ALL<<1!COMMENTSNORMAL
 1171            COMMENT FLAG = COMMENT FLAG!!B'010'
 1172            FIRST DISP = DELTA MARGIN-INITIAL MARGIN
 1173            COMMENT LINE = FULL LINE %IF COMMENT LINE = 0
 1174            OK = 1
 1175  %END
 1176  
 1177  %BEGIN
 1178    SOAP("test.imp") ;! need CLIPARAM ...
 1179  %ENDOFPROGRAM

  853 Statements compiled
