automat.pas

This is Pascal compiler

  1097                      if lsp^.rangetype <> lsp1 then error(107)
  1098                    end;
  1099                  if lsp <> nil then
  1100                    with lsp^ do
  1101                      if form = subrange then
  1102                        if rangetype <> nil then
  1103                          if rangetype = realptr then error(399)
  1104                          else
  1105                            if min.ival > max.ival then error(102)
  1106                end;
  1107              fsp := lsp;
  1108              if not (sy in fsys) then
  1109                begin error(6); skip(fsys) end
  1110            end
  1111              else fsp := nil
  1112        end (*simpletype*) ;
  1113  
  1114        procedure fieldlist(fsys: setofsys; var frecvar: stp);
  1115          var lcp,lcp1,nxt,nxt1: ctp; lsp,lsp1,lsp2,lsp3,lsp4: stp;
  1116              minsize,maxsize,lsize: addrrange; lvalu: valu;
  1117        begin nxt1 := nil; lsp := nil;
  1118          if not (sy in (fsys+[ident,casesy])) then
  1119            begin error(19); skip(fsys + [ident,casesy]) end;
  1120          while sy = ident do
  1121            begin nxt := nxt1;
  1122              repeat
  1123                if sy = ident then
  1124                  begin new(lcp,field);
  1125                    with lcp^ do
  1126                      begin name := id; idtype := nil; next := nxt;
  1127                        klass := field
  1128                      end;
  1129                    nxt := lcp;
  1130                    enterid(lcp);
  1131                    insymbol
  1132                  end
  1133                else error(2);
  1134                if not (sy in [comma,colon]) then
  1135                  begin error(6); skip(fsys + [comma,colon,semicolon,casesy])
  1136                  end;
  1137                test := sy <> comma;
  1138                if not test  then insymbol
  1139              until test;
  1140              if sy = colon then insymbol else error(5);
  1141              typ(fsys + [casesy,semicolon],lsp,lsize);
  1142              while nxt <> nxt1 do
  1143                with nxt^ do
  1144                  begin align(lsp,displ);
  1145                    idtype := lsp; fldaddr := displ;
  1146                    nxt := next; displ := displ + lsize
  1147                  end;
  1148              nxt1 := lcp;
  1149              while sy = semicolon do
  1150                begin insymbol;
  1151                  if not (sy in fsys + [ident,casesy,semicolon]) then
  1152                    begin error(19); skip(fsys + [ident,casesy]) end
  1153                end
  1154            end (*while*);
  1155          nxt := nil;
  1156          while nxt1 <> nil do
  1157            with nxt1^ do
  1158              begin lcp := next; next := nxt; nxt := nxt1; nxt1 := lcp end;
  1159          if sy = casesy then
  1160            begin new(lsp,tagfld);
  1161              with lsp^ do
  1162                begin tagfieldp := nil; fstvar := nil; form:=tagfld end;
  1163              frecvar := lsp;
  1164              insymbol;
  1165              if sy = ident then
  1166                begin new(lcp,field);
  1167                  with lcp^ do
  1168                    begin name := id; idtype := nil; klass:=field;
  1169                      next := nil; fldaddr := displ
  1170                    end;
  1171                  enterid(lcp);
  1172                  insymbol;
  1173                  if sy = colon then insymbol else error(5);
  1174                  if sy = ident then
  1175                    begin searchid([types],lcp1);
  1176                      lsp1 := lcp1^.idtype;
  1177                      if lsp1 <> nil then
  1178                        begin align(lsp1,displ);
  1179                          lcp^.fldaddr := displ;
  1180                          displ := displ+lsp1^.size;
  1181                          if (lsp1^.form <= subrange) or string(lsp1) then
  1182                            begin if comptypes(realptr,lsp1) then error(109)
  1183                              else if string(lsp1) then error(399);
  1184                              lcp^.idtype := lsp1; lsp^.tagfieldp := lcp;
  1185                            end
  1186                          else error(110);
  1187                        end;
  1188                      insymbol;
  1189                    end
  1190                  else begin error(2); skip(fsys + [ofsy,lparent]) end
  1191                end
  1192              else begin error(2); skip(fsys + [ofsy,lparent]) end;
  1193              lsp^.size := displ;
  1194              if sy = ofsy then insymbol else error(8);
  1195              lsp1 := nil; minsize := displ; maxsize := displ;
  1196              repeat lsp2 := nil;
  1197                if not (sy in fsys + [semicolon]) then
  1198                begin
  1199                  repeat constant(fsys + [comma,colon,lparent],lsp3,lvalu);
  1200                    if lsp^.tagfieldp <> nil then
  1201                     if not comptypes(lsp^.tagfieldp^.idtype,lsp3)then error(111);
  1202                    new(lsp3,variant);
  1203                    with lsp3^ do
  1204                      begin nxtvar := lsp1; subvar := lsp2; varval := lvalu;
  1205                        form := variant
  1206                      end;
  1207                    lsp4 := lsp1;
  1208                    while lsp4 <> nil do
  1209                      with lsp4^ do
  1210                        begin
  1211                          if varval.ival = lvalu.ival then error(178);
  1212                          lsp4 := nxtvar
  1213                        end;
  1214                    lsp1 := lsp3; lsp2 := lsp3;
  1215                    test := sy <> comma;
  1216                    if not test then insymbol
  1217                  until test;
  1218                  if sy = colon then insymbol else error(5);
  1219                  if sy = lparent then insymbol else error(9);
  1220                  fieldlist(fsys + [rparent,semicolon],lsp2);
  1221                  if displ > maxsize then maxsize := displ;
  1222                  while lsp3 <> nil do
  1223                    begin lsp4 := lsp3^.subvar; lsp3^.subvar := lsp2;
  1224                      lsp3^.size := displ;
  1225                      lsp3 := lsp4
  1226                    end;
  1227                  if sy = rparent then
  1228                    begin insymbol;
  1229                      if not (sy in fsys + [semicolon]) then
  1230                        begin error(6); skip(fsys + [semicolon]) end
  1231                    end
  1232                  else error(4);
  1233                end;
  1234                test := sy <> semicolon;
  1235                if not test then
  1236                  begin displ := minsize;
  1237                        insymbol
  1238                  end
  1239              until test;
  1240              displ := maxsize;
  1241              lsp^.fstvar := lsp1;
  1242            end
  1243          else frecvar := nil
  1244        end (*fieldlist*) ;
  1245  
  1246      begin (*typ*)
  1247        if not (sy in typebegsys) then
  1248           begin error(10); skip(fsys + typebegsys) end;
  1249        if sy in typebegsys then
  1250          begin
  1251            if sy in simptypebegsys then simpletype(fsys,fsp,fsize)
  1252            else
  1253      (*^*)     if sy = arrow then
  1254                begin new(lsp,pointer); fsp := lsp;
  1255                  with lsp^ do
  1256                    begin eltype := nil; size := ptrsize; form:=pointer end;
  1257                  insymbol;
  1258                  if sy = ident then
  1259                    begin prterr := false; (*no error if search not successful*)
  1260                      searchid([types],lcp); prterr := true;
  1261                      if lcp = nil then   (*forward referenced type id*)
  1262                        begin new(lcp,types);
  1263                          with lcp^ do
  1264                            begin name := id; idtype := lsp;
  1265                              next := fwptr; klass := types
  1266                            end;
  1267                          fwptr := lcp
  1268                        end
  1269                      else
  1270                        begin
  1271                          if lcp^.idtype <> nil then
  1272                            if lcp^.idtype^.form = files then error(108)
  1273                            else lsp^.eltype := lcp^.idtype
  1274                        end;
  1275                      insymbol;
  1276                    end
  1277                  else error(2);
  1278                end
  1279              else
  1280                begin
  1281                  if sy = packedsy then
  1282                    begin insymbol;
  1283                      if not (sy in typedels) then
  1284                        begin
  1285                          error(10); skip(fsys + typedels)
  1286                        end
  1287                    end;
  1288      (*array*)     if sy = arraysy then
  1289                    begin insymbol;
  1290                      if sy = lbrack then insymbol else error(11);
  1291                      lsp1 := nil;
  1292                      repeat new(lsp,arrays);
  1293                        with lsp^ do
  1294                          begin aeltype := lsp1; inxtype := nil; form:=arrays end;
  1295                        lsp1 := lsp;
  1296                        simpletype(fsys + [comma,rbrack,ofsy],lsp2,lsize);
  1297                        lsp1^.size := lsize;
  1298                        if lsp2 <> nil then
  1299                          if lsp2^.form <= subrange then
  1300                            begin
  1301                              if lsp2 = realptr then
  1302                                begin error(109); lsp2 := nil end
  1303                              else
  1304                                if lsp2 = intptr then
  1305                                  begin error(149); lsp2 := nil end;
  1306                              lsp^.inxtype := lsp2
  1307                            end
  1308                          else begin error(113); lsp2 := nil end;
  1309                        test := sy <> comma;
  1310                        if not test then insymbol
  1311                      until test;
  1312                      if sy = rbrack then insymbol else error(12);
  1313                      if sy = ofsy then insymbol else error(8);
  1314                      typ(fsys,lsp,lsize);
  1315                      repeat
  1316                        with lsp1^ do
  1317                          begin lsp2 := aeltype; aeltype := lsp;
  1318                            if inxtype <> nil then
  1319                              begin getbounds(inxtype,lmin,lmax);
  1320                                align(lsp,lsize);
  1321                                lsize := lsize*(lmax - lmin + 1);
  1322                                size := lsize
  1323                              end
  1324                          end;
  1325                        lsp := lsp1; lsp1 := lsp2
  1326                      until lsp1 = nil
  1327                    end
  1328                  else
  1329      (*record*)      if sy = recordsy then
  1330                      begin insymbol;
  1331                        oldtop := top;
  1332                        if top < displimit then
  1333                          begin top := top + 1;
  1334                            with display[top] do
  1335                              begin fname := nil;
  1336                                    flabel := nil;
  1337                                    occur := rec
  1338                              end
  1339                          end
  1340                        else error(250);
  1341                        displ := 0;
  1342                        fieldlist(fsys-[semicolon]+[endsy],lsp1);
  1343                        new(lsp,records);
  1344                        with lsp^ do
  1345                          begin fstfld := display[top].fname;
  1346                            recvar := lsp1; size := displ; form := records
  1347                          end;
  1348                        top := oldtop;
  1349                        if sy = endsy then insymbol else error(13)
  1350                      end
  1351                    else
  1352      (*set*)        if sy = setsy then
  1353                        begin insymbol;
  1354                          if sy = ofsy then insymbol else error(8);
  1355                          simpletype(fsys,lsp1,lsize);
  1356                          if lsp1 <> nil then
  1357                            if lsp1^.form > subrange then
  1358                              begin error(115); lsp1 := nil end
  1359                            else
  1360                              if lsp1 = realptr then
  1361                                begin error(114); lsp1 := nil end
  1362                              else if lsp1 = intptr then
  1363                                begin error(169); lsp1 := nil end
  1364                              else
  1365                                begin getbounds(lsp1,lmin,lmax);
  1366                                  if (lmin < setlow) or (lmax > sethigh)
  1367                                    then error(169);
  1368                                end;
  13