gcc/m2/gm2-compiler/M2Swig.mod

   1 (* M2Swig.mod generates a swig interface file for the main module.
   2
   3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 IMPLEMENTATION MODULE M2Swig ;
  23
  24 FROM Storage IMPORT ALLOCATE ;
  25 FROM M2Options IMPORT GenerateSwig ;
  26 FROM SFIO IMPORT OpenToWrite ;
  27 FROM FIO IMPORT File, Close ;
  28 FROM NameKey IMPORT Name, KeyToCharStar ;
  29 FROM M2Error IMPORT InternalError ;
  30 FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2, fprintf3, fprintf4 ;
  31 FROM M2AsmUtil IMPORT GetFullScopeAsmName ;
  32 FROM SYSTEM IMPORT WORD ;
  33
  34 FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, Mark,
  35                            KillString ;
  36
  37 FROM Lists IMPORT List, InitList, KillList, IsItemInList,
  38                   IncludeItemIntoList, RemoveItemFromList,
  39                   ForeachItemInListDo, NoOfItemsInList,
  40                   GetItemFromList ;
  41
  42 FROM M2Quads IMPORT IsProcedureScope ;
  43 FROM M2System IMPORT IsSystemType, Address, Byte, Loc, Word ;
  44 FROM M2Bitset IMPORT Bitset ;
  45 FROM Indexing IMPORT Index, InitIndex, KillIndex, HighIndice, PutIndice, GetIndice ;
  46 FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock ;
  47
  48 FROM M2Base IMPORT IsBaseType, Char, Cardinal, Integer, Real, LongReal, ShortReal,
  49                    LongCard, ShortCard, LongInt, ShortInt, Boolean ;
  50
  51 FROM SymbolTable IMPORT GetSymName, IsType, IsProcedure, IsConst, IsVar,
  52                         GetType, GetNthParam, IsUnbounded, GetMode, ModeOfAddr,
  53                         NoOfParam, IsConstString, IsConstLit, IsPointer,
  54                         IsExported, ForeachExportedDo, IsUnboundedParam,
  55                         IsParameter, IsParameterUnbounded, IsParameterVar,
  56                         GetParameterShadowVar, GetReadQuads, GetWriteQuads,
  57                         NulSym ;
  58
  59 FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks,
  60                          ForeachBasicBlockDo ;
  61
  62
  63 TYPE
  64    UnboundedSig = POINTER TO RECORD
  65                                 type: CARDINAL ;
  66                                 name: Name ;
  67                              END ;
  68
  69 VAR
  70    includedArray: BOOLEAN ;
  71    uKey         : Index ;
  72    mainModule   : CARDINAL ;
  73    Done,
  74    ToDo         : List ;
  75    f            : File ;
  76    name         : String ;
  77
  78
  79 (*
  80    DoExported - includes, sym, into the, ToDo, list.
  81 *)
  82
  83 PROCEDURE DoExported (sym: CARDINAL) ;
  84 BEGIN
  85    IncludeItemIntoList(ToDo, sym)
  86 END DoExported ;
  87
  88
  89 (*
  90    MoveToDone - moves a sym to the, Done, list,
  91                 providing that it is not already on it.
  92                 It returns TRUE if the lists were modified.
  93 *)
  94
  95 PROCEDURE MoveToDone (sym: CARDINAL) : BOOLEAN ;
  96 BEGIN
  97    IF IsItemInList(Done, sym)
  98    THEN
  99       RETURN( FALSE )
 100    ELSIF IsItemInList(ToDo, sym)
 101    THEN
 102       RemoveItemFromList(ToDo, sym) ;
 103       IncludeItemIntoList(Done, sym) ;
 104       RETURN( TRUE )
 105    END ;
 106    IncludeItemIntoList(Done, sym) ;
 107    RETURN( TRUE )
 108 END MoveToDone ;
 109
 110
 111 (*
 112    MoveToToDo - moves a sym to the, ToDo, list,
 113                 providing that it is not already on it.
 114                 It returns TRUE if the lists were modified.
 115 *)
 116
 117 PROCEDURE MoveToToDo (sym: CARDINAL) : BOOLEAN ;
 118 BEGIN
 119    IF IsItemInList(Done, sym)
 120    THEN
 121       InternalError ('not expecting to get here')
 122    ELSIF IsItemInList(ToDo, sym)
 123    THEN
 124       RETURN( FALSE )
 125    ELSE
 126       IncludeItemIntoList(ToDo, sym) ;
 127       RETURN( TRUE )
 128    END
 129 END MoveToToDo ;
 130
 131
 132 (*
 133    Trybase - returns TRUE
 134 *)
 135
 136 PROCEDURE TryBase (sym: CARDINAL) : BOOLEAN ;
 137 BEGIN
 138    IF (sym=Cardinal) OR (sym=Integer) OR (sym=LongInt) OR
 139       (sym=LongCard) OR (sym=Char) OR (sym=ShortCard) OR
 140       (sym=ShortInt) OR (sym=Real) OR (sym=LongReal) OR
 141       (sym=ShortReal) OR (sym=Boolean)
 142    THEN
 143       RETURN( MoveToDone(sym) )
 144    ELSE
 145       RETURN( FALSE )
 146    END
 147 END TryBase ;
 148
 149
 150 (*
 151    TrySystem - returns TRUE if sym can be moved to the done list.
 152 *)
 153
 154 PROCEDURE TrySystem (sym: CARDINAL) : BOOLEAN ;
 155 BEGIN
 156    IF (sym=Bitset) OR (sym=Address) OR (sym=Byte) OR (sym=Loc) OR
 157       (sym=Word)
 158    THEN
 159       RETURN( MoveToDone(sym) )
 160    ELSE
 161       RETURN( FALSE )
 162    END
 163 END TrySystem ;
 164
 165
 166 (*
 167    TryMove - tries to move sym to the done queue as long
 168              as type is known.
 169 *)
 170
 171 PROCEDURE TryMove (sym, type: CARDINAL) : BOOLEAN ;
 172 BEGIN
 173    IF IsItemInList(Done, type)
 174    THEN
 175       IF MoveToDone(sym)
 176       THEN
 177          RETURN( TRUE )
 178       END
 179    ELSE
 180       IF MoveToToDo(sym)
 181       THEN
 182          RETURN( TRUE )
 183       END
 184    END ;
 185    RETURN( FALSE )
 186 END TryMove ;
 187
 188
 189 (*
 190    TryType -
 191 *)
 192
 193 PROCEDURE TryType (sym: CARDINAL) : BOOLEAN ;
 194 VAR
 195    type  : CARDINAL ;
 196    result: BOOLEAN ;
 197 BEGIN
 198    type := GetType(sym) ;
 199    result := TryDependents(type) ;
 200    IF TryMove(sym, type)
 201    THEN
 202       RETURN( TRUE )
 203    ELSE
 204       RETURN( result )
 205    END
 206 END TryType ;
 207
 208
 209 (*
 210    TryVar -
 211 *)
 212
 213 PROCEDURE TryVar (sym: CARDINAL) : BOOLEAN ;
 214 VAR
 215    type  : CARDINAL ;
 216    result: BOOLEAN ;
 217 BEGIN
 218    type := GetType(sym) ;
 219    result := TryDependents(type) ;
 220    IF TryMove(sym, type)
 221    THEN
 222       RETURN( TRUE )
 223    ELSE
 224       RETURN( result )
 225    END
 226 END TryVar ;
 227
 228
 229 (*
 230    TryProcedure -
 231 *)
 232
 233 PROCEDURE TryProcedure (sym: CARDINAL) : BOOLEAN ;
 234 VAR
 235    son,
 236    p, i,
 237    type  : CARDINAL ;
 238    solved,
 239    result: BOOLEAN ;
 240 BEGIN
 241    type := GetType(sym) ;
 242    result := FALSE ;
 243    solved := TRUE ;
 244    IF type#NulSym
 245    THEN
 246       IF TryDependents(type)
 247       THEN
 248          result := TRUE
 249       END ;
 250       IF NOT IsItemInList(Done, type)
 251       THEN
 252          solved := FALSE
 253       END
 254    END ;
 255    p := NoOfParam(sym) ;
 256    i := 1 ;
 257    WHILE i<=p DO
 258       son := GetNthParam(sym, i) ;
 259       IF TryDependents(son)
 260       THEN
 261          result := TRUE
 262       END ;
 263       IF NOT IsItemInList(Done, son)
 264       THEN
 265          solved := FALSE
 266       END ;
 267       INC(i)
 268    END ;
 269    IF solved
 270    THEN
 271       IF MoveToDone(sym)
 272       THEN
 273          RETURN( TRUE )
 274       END
 275    ELSE
 276       IF MoveToToDo(sym)
 277       THEN
 278          RETURN( TRUE )
 279       END
 280    END ;
 281    RETURN( result )
 282 END TryProcedure ;
 283
 284
 285 (*
 286    TryUnbounded -
 287 *)
 288
 289 PROCEDURE TryUnbounded (sym: CARDINAL) : BOOLEAN ;
 290 VAR
 291    type  : CARDINAL ;
 292    result: BOOLEAN ;
 293 BEGIN
 294    type := GetType(sym) ;
 295    result := TryDependents(type) ;
 296    IF TryMove(sym, type)
 297    THEN
 298       RETURN( TRUE )
 299    ELSE
 300       RETURN( result )
 301    END
 302 END TryUnbounded ;
 303
 304
 305 (*
 306    TryParameter -
 307 *)
 308
 309 PROCEDURE TryParameter (sym: CARDINAL) : BOOLEAN ;
 310 VAR
 311    type  : CARDINAL ;
 312    result: BOOLEAN ;
 313 BEGIN
 314    type := GetType(sym) ;
 315    result := TryDependents(type) ;
 316    IF TryMove(sym, type)
 317    THEN
 318       RETURN( TRUE )
 319    ELSE
 320       RETURN( result )
 321    END
 322 END TryParameter ;
 323
 324
 325 (*
 326    TryDependents - returns TRUE if any alteration occurred to any
 327                    of the lists.
 328 *)
 329
 330 PROCEDURE TryDependents (sym: CARDINAL) : BOOLEAN ;
 331 BEGIN
 332    IF IsBaseType(sym)
 333    THEN
 334       RETURN( TryBase(sym) )
 335    ELSIF IsSystemType(sym)
 336    THEN
 337       RETURN( TrySystem(sym) )
 338    ELSIF IsType(sym)
 339    THEN
 340       RETURN( TryType(sym) )
 341    ELSIF IsParameter(sym)
 342    THEN
 343       RETURN( TryParameter(sym) )
 344    ELSIF IsProcedure(sym)
 345    THEN
 346       RETURN( TryProcedure(sym) )
 347    ELSIF IsConstString(sym)
 348    THEN
 349       RETURN( MoveToDone(sym) )
 350    ELSIF IsConstLit(sym)
 351    THEN
 352       RETURN( MoveToDone(sym) )
 353    ELSIF IsVar(sym) AND (GetMode(sym)=ImmediateValue)
 354    THEN
 355       RETURN( MoveToDone(sym) )
 356    ELSIF IsVar(sym)
 357    THEN
 358       RETURN( TryVar(sym) )
 359    ELSIF IsUnbounded(sym)
 360    THEN
 361       RETURN( TryUnbounded(sym) )
 362    ELSE
 363       RETURN( FALSE )
 364    END
 365 END TryDependents ;
 366
 367
 368 (*
 369    DoResolveOrder - resolves the declaration order for swig (C).
 370 *)
 371
 372 PROCEDURE DoResolveOrder ;
 373 VAR
 374    sym,
 375    i, n    : CARDINAL ;
 376    movement: BOOLEAN ;
 377 BEGIN
 378    REPEAT
 379       n := NoOfItemsInList(ToDo) ;
 380       movement := FALSE ;
 381       i := 1 ;
 382       WHILE (i<=n) AND (NOT movement) DO
 383          sym := GetItemFromList(ToDo, i) ;
 384          movement := TryDependents(sym) ;
 385          INC(i)
 386       END
 387    UNTIL NOT movement
 388 END DoResolveOrder ;
 389
 390
 391 (*
 392    DoName -
 393 *)
 394
 395 PROCEDURE DoName (sym: CARDINAL) ;
 396 VAR
 397    n: Name ;
 398 BEGIN
 399    n := GetFullScopeAsmName(sym) ;
 400    fprintf1(f, "%a", n)
 401 END DoName ;
 402
 403
 404 (*
 405    DoParamName -
 406 *)
 407
 408 PROCEDURE DoParamName (sym: CARDINAL) ;
 409 VAR
 410    n: Name ;
 411 BEGIN
 412    n := GetSymName(sym) ;
 413    fprintf1(f, "%a", n)
 414 END DoParamName ;
 415
 416
 417 (*
 418    DoVar -
 419 *)
 420
 421 PROCEDURE DoVar (sym: CARDINAL) ;
 422 BEGIN
 423    fprintf0(f, 'extern "C" ') ;
 424    DoType(GetType(sym)) ;
 425    fprintf0(f, ' ') ;
 426    DoName(sym) ;
 427    fprintf0(f, ';\n')
 428 END DoVar ;
 429
 430
 431 (*
 432    DoType -
 433 *)
 434
 435 PROCEDURE DoType (sym: CARDINAL) ;
 436 BEGIN
 437    IF IsPointer(sym)
 438    THEN
 439       DoType(GetType(sym)) ;
 440       fprintf0(f, ' *')
 441    ELSIF sym=Cardinal
 442    THEN
 443       fprintf0(f, "unsigned int")
 444    ELSIF sym=Integer
 445    THEN
 446       fprintf0(f, "int")
 447    ELSIF sym=Boolean
 448    THEN
 449       fprintf0(f, "unsigned int")
 450    ELSIF sym=LongInt
 451    THEN
 452       fprintf0(f, "long long int")
 453    ELSIF sym=LongCard
 454    THEN
 455       fprintf0(f, "long long unsigned int")
 456    ELSIF sym=Char
 457    THEN
 458       fprintf0(f, "char")
 459    ELSIF sym=ShortCard
 460    THEN
 461       fprintf0(f, "short unsigned int")
 462    ELSIF sym=ShortInt
 463    THEN
 464       fprintf0(f, "short int")
 465    ELSIF sym=Real
 466    THEN
 467       fprintf0(f, "double")
 468    ELSIF sym=LongReal
 469    THEN
 470       fprintf0(f, "long double")
 471    ELSIF sym=ShortReal
 472    THEN
 473       fprintf0(f, "float")
 474    ELSIF sym=Bitset
 475    THEN
 476       fprintf0(f, "unsigned int")
 477    ELSIF sym=Address
 478    THEN
 479       fprintf0(f, "void *")
 480    ELSIF sym=Byte
 481    THEN
 482       fprintf0(f, "unsigned char")
 483    ELSIF sym=Loc
 484    THEN
 485       fprintf0(f, "unsigned char")
 486    ELSIF sym=Word
 487    THEN
 488       fprintf0(f, "unsigned int")
 489    END
 490 END DoType ;
 491
 492
 493 (*
 494    DoUnbounded -
 495 *)
 496
 497 PROCEDURE DoUnbounded (sym: CARDINAL) ;
 498 VAR
 499    n   : Name ;
 500    type: CARDINAL ;
 501 BEGIN
 502    type := GetType(sym) ;
 503    DoType(GetType(type)) ;
 504    n := GetSymName(sym) ;
 505    fprintf2(f, ' *_m2_address_%a, int _m2_high_%a', n, n)
 506 END DoUnbounded ;
 507
 508
 509 VAR
 510    FirstBasicBlock,
 511    Input,
 512    Output,
 513    InOut,
 514    CanGuess,
 515    IsKnown        : BOOLEAN ;
 516    rs, ws         : CARDINAL ;
 517
 518
 519 (*
 520    DoBasicBlock -
 521 *)
 522
 523 PROCEDURE DoBasicBlock (start, end: CARDINAL) ;
 524 BEGIN
 525    IF IsProcedureScope(start)
 526    THEN
 527       (* skip this basic block, as this will not modify the parameter *)
 528       RETURN
 529    ELSIF IsKnown OR CanGuess
 530    THEN
 531       (* already resolved *)
 532       RETURN
 533    ELSE
 534       IF (ws=0) AND (rs=0)
 535       THEN
 536          FirstBasicBlock := FALSE
 537       ELSIF rs=0
 538       THEN
 539          (* only written *)
 540          IF ws<=end
 541          THEN
 542             Output := TRUE ;
 543             IF FirstBasicBlock
 544             THEN
 545                IsKnown := TRUE
 546             ELSE
 547                CanGuess := TRUE
 548             END ;
 549             FirstBasicBlock := FALSE
 550          END
 551       ELSIF ws=0
 552       THEN
 553          (* only read *)
 554          Input := TRUE ;
 555          IF (rs<=end) AND FirstBasicBlock
 556          THEN
 557             IsKnown := TRUE
 558          ELSE
 559             CanGuess := TRUE
 560          END ;
 561          FirstBasicBlock := FALSE
 562       ELSIF rs<=ws
 563       THEN
 564          (* read before write *)
 565          InOut := TRUE ;
 566          IF (rs<=end) AND (ws<=end) AND FirstBasicBlock
 567          THEN
 568             IsKnown := TRUE
 569          ELSE
 570             CanGuess := TRUE
 571          END ;
 572          FirstBasicBlock := FALSE
 573       ELSE
 574          (* must be written before read *)
 575          Output := TRUE ;
 576          IF (rs<=end) AND (ws<=end) AND FirstBasicBlock
 577          THEN
 578             IsKnown := TRUE
 579          ELSE
 580             CanGuess := TRUE
 581          END ;
 582          FirstBasicBlock := FALSE
 583       END
 584    END
 585 END DoBasicBlock ;
 586
 587
 588 (*
 589    DetermineParameter -
 590 *)
 591
 592 PROCEDURE DetermineParameter (procedure, param: CARDINAL) ;
 593 VAR
 594    sb: ScopeBlock ;
 595    bb: BasicBlock ;
 596    we,
 597    re: CARDINAL ;
 598 BEGIN
 599    sb := InitScopeBlock(procedure) ;
 600    bb := InitBasicBlocks(sb) ;
 601    Input := FALSE ;
 602    Output := FALSE ;
 603    InOut := FALSE ;
 604    CanGuess := FALSE ;
 605    IsKnown := FALSE ;
 606    FirstBasicBlock := TRUE ;
 607    GetReadQuads(param, RightValue, rs, re) ;
 608    GetWriteQuads(param, RightValue, ws, we) ;
 609    ForeachBasicBlockDo(bb, DoBasicBlock) ;
 610    KillBasicBlocks(bb) ;
 611    KillScopeBlock(sb)
 612 END DetermineParameter ;
 613
 614
 615 (*
 616    PrintDirection -
 617 *)
 618
 619 PROCEDURE PrintDirection ;
 620 BEGIN
 621    IF Input
 622    THEN
 623       fprintf0(f, 'INPUT')
 624    ELSIF Output
 625    THEN
 626       fprintf0(f, 'OUTPUT')
 627    ELSE
 628       fprintf0(f, 'INOUT')
 629    END
 630 END PrintDirection ;
 631
 632
 633 (*
 634    CalculateVarDirective -
 635 *)
 636
 637 PROCEDURE CalculateVarDirective (procedure, param: CARDINAL; annotate: BOOLEAN) ;
 638 VAR
 639    sym: CARDINAL ;
 640 BEGIN
 641    sym := GetParameterShadowVar(param) ;
 642    IF sym=NulSym
 643    THEN
 644       InternalError ('why did we get here')
 645    ELSE
 646       DetermineParameter(procedure, sym) ;
 647       IF annotate
 648       THEN
 649          DoParamName(sym) ;
 650          IF IsKnown
 651          THEN
 652             fprintf0(f, ' is known to be an ') ;
 653             PrintDirection
 654          ELSIF CanGuess
 655          THEN
 656             fprintf0(f, ' is guessed to be an ') ;
 657             PrintDirection
 658          ELSE
 659             fprintf0(f, ' is unknown')
 660          END
 661       ELSE
 662          fprintf0(f, '*') ;
 663          IF IsKnown OR CanGuess
 664          THEN
 665             PrintDirection
 666          ELSE
 667             DoParamName(sym)
 668          END
 669       END
 670    END
 671 END CalculateVarDirective ;
 672
 673
 674 (*
 675    AnnotateProcedure -
 676 *)
 677
 678 PROCEDURE AnnotateProcedure (sym: CARDINAL) ;
 679 VAR
 680    son, p, i: CARDINAL ;
 681    needComma: BOOLEAN ;
 682 BEGIN
 683    fprintf0(f, '/*  parameter: ') ;
 684    p := NoOfParam(sym) ;
 685    i := 1 ;
 686    needComma := FALSE ;
 687    WHILE i<=p DO
 688       son := GetNthParam(sym, i) ;
 689       IF IsParameterVar(son)
 690       THEN
 691          IF needComma
 692          THEN
 693             fprintf0(f, ', ')
 694          END ;
 695          CalculateVarDirective(sym, son, TRUE) ;
 696          needComma := TRUE
 697       END ;
 698       INC(i)
 699    END ;
 700    fprintf0(f, ' */\n\n')
 701 END AnnotateProcedure ;
 702
 703
 704 (*
 705    DoProcedure -
 706 *)
 707
 708 PROCEDURE DoProcedure (sym: CARDINAL) : BOOLEAN ;
 709 VAR
 710    son,
 711    p, i : CARDINAL ;
 712    found: BOOLEAN ;
 713 BEGIN
 714    found := FALSE ;
 715    fprintf0(f, 'extern "C" ') ;
 716    IF GetType(sym)=NulSym
 717    THEN
 718       fprintf0(f, 'void') ;
 719    ELSE
 720       DoType(GetType(sym))
 721    END ;
 722    fprintf0(f, ' ') ;
 723    DoName(sym) ;
 724    fprintf0(f, ' (') ;
 725    p := NoOfParam(sym) ;
 726    IF p=0
 727    THEN
 728       fprintf0(f, 'void') ;
 729    ELSE
 730       i := 1 ;
 731       WHILE i<=p DO
 732          son := GetNthParam(sym, i) ;
 733          IF IsUnboundedParam(sym, i)
 734          THEN
 735             DoUnbounded(son)
 736          ELSE
 737             DoType(GetType(son)) ;
 738             fprintf0(f, ' ') ;
 739             IF IsParameterVar(son)
 740             THEN
 741                found := TRUE ;
 742                CalculateVarDirective(sym, son, FALSE)
 743             ELSE
 744                DoParamName(son)
 745             END
 746          END ;
 747          IF i<p
 748          THEN
 749             fprintf0(f, ', ')
 750          END ;
 751          INC(i)
 752       END
 753    END ;
 754    fprintf0(f, ');\n') ;
 755    RETURN( found )
 756 END DoProcedure ;
 757
 758
 759 (*
 760    DoWriteSymbol -
 761 *)
 762
 763 PROCEDURE DoWriteSymbol (sym: CARDINAL) ;
 764 BEGIN
 765    IF IsBaseType(sym)
 766    THEN
 767    ELSIF IsSystemType(sym)
 768    THEN
 769    ELSIF IsType(sym)
 770    THEN
 771    ELSIF IsProcedure(sym)
 772    THEN
 773       IF DoProcedure(sym)
 774       THEN
 775          AnnotateProcedure(sym)
 776       END
 777    ELSIF IsConstString(sym)
 778    THEN
 779    ELSIF IsConstLit(sym)
 780    THEN
 781    ELSIF IsVar(sym) AND (GetMode(sym)=ImmediateValue)
 782    THEN
 783    ELSIF IsVar(sym)
 784    THEN
 785       DoVar(sym)
 786    END
 787 END DoWriteSymbol ;
 788
 789
 790 (*
 791    DoCheckExported -
 792 *)
 793
 794 PROCEDURE DoCheckExported (sym: WORD) ;
 795 BEGIN
 796    IF IsExported(mainModule, sym)
 797    THEN
 798       DoWriteSymbol(sym)
 799    END
 800 END DoCheckExported ;
 801
 802
 803 (*
 804    IsUnique - returns TRUE if the combination of, n, and, t,
 805               is unique.
 806 *)
 807
 808 PROCEDURE IsUnique (n: Name; t: CARDINAL) : BOOLEAN ;
 809 VAR
 810    p   : UnboundedSig ;
 811    h, i: CARDINAL ;
 812 BEGIN
 813    i := 1 ;
 814    h := HighIndice(uKey) ;
 815    WHILE i<=h DO
 816       p := GetIndice(uKey, i) ;
 817       IF (p^.type=t) AND (p^.name=n)
 818       THEN
 819          RETURN( FALSE )
 820       END ;
 821       INC(i)
 822    END ;
 823    INC(h) ;
 824    NEW(p) ;
 825    WITH p^ DO
 826       type := t ;
 827       name := n
 828    END ;
 829    PutIndice(uKey, h, p) ;
 830    RETURN( TRUE )
 831 END IsUnique ;
 832
 833
 834 (*
 835    IsTypeUnique - returns TRUE if type, t, has not been entered yet.
 836 *)
 837
 838 PROCEDURE IsTypeUnique (t: CARDINAL) : BOOLEAN ;
 839 VAR
 840    p   : UnboundedSig ;
 841    h, i: CARDINAL ;
 842 BEGIN
 843    i := 1 ;
 844    h := HighIndice(uKey) ;
 845    WHILE i<=h DO
 846       p := GetIndice(uKey, i) ;
 847       IF p^.type=t
 848       THEN
 849          RETURN( FALSE )
 850       END ;
 851       INC(i)
 852    END ;
 853    RETURN( TRUE )
 854 END IsTypeUnique ;
 855
 856
 857 (*
 858    DoCheckUnbounded -
 859 *)
 860
 861 PROCEDURE DoCheckUnbounded (sym: WORD) ;
 862 VAR
 863    name      : Name ;
 864    type      : CARDINAL ;
 865    typeUnique: BOOLEAN ;
 866 BEGIN
 867    IF IsParameter(sym) AND IsParameterUnbounded(sym)
 868    THEN
 869       name := GetSymName(sym) ;
 870       type := GetType(GetType(sym)) ;
 871       typeUnique := IsTypeUnique(type) ;
 872       IF IsUnique(name, type)
 873       THEN
 874          IF NOT includedArray
 875          THEN
 876             includedArray := TRUE ;
 877             fprintf0(f, '%include "carrays.i"\n')
 878          END ;
 879          fprintf0(f, '%') ;
 880          fprintf0(f, 'apply (char *STRING, int LENGTH) { (') ;
 881          DoUnbounded(sym) ;
 882          fprintf0(f, ') };\n') ;
 883          IF typeUnique
 884          THEN
 885             fprintf0(f, '%array_functions(') ;
 886             DoType(type) ;
 887             fprintf0(f, ', ') ;
 888             DoType(type) ;
 889             fprintf0(f, 'Array);\n')
 890          END
 891       END
 892    END
 893 END DoCheckUnbounded ;
 894
 895
 896 (*
 897    DoWriteFile -
 898 *)
 899
 900 PROCEDURE DoWriteFile (sym: CARDINAL) ;
 901 VAR
 902    n: Name ;
 903 BEGIN
 904    mainModule := sym ;
 905    n := GetSymName(sym) ;
 906    fprintf0(f, '/* automatically generated by gm2 -fswig */\n') ;
 907    fprintf0(f, '%') ;
 908    fprintf1(f, 'module %a\n\n', n) ;
 909    fprintf0(f, '%') ;
 910    fprintf1(f, 'include exception.i\n\n', n) ;
 911    fprintf0(f, '%') ;
 912    fprintf0(f, 'exception {\n') ;
 913    fprintf0(f, '  try {\n') ;
 914    fprintf0(f, '     $action\n') ;
 915    fprintf0(f, '  } catch (int i) {\n') ;
 916    fprintf0(f, '     return NULL;\n') ;
 917    fprintf0(f, '  }\n') ;
 918    fprintf0(f, '}\n\n') ;
 919    ForeachItemInListDo(Done, DoCheckUnbounded) ;
 920    fprintf0(f, '\n%{\n') ;
 921    ForeachItemInListDo(Done, DoCheckExported) ;
 922    fprintf0(f, '%}\n\n') ;
 923    ForeachItemInListDo(Done, DoCheckExported)
 924 END DoWriteFile ;
 925
 926
 927 (*
 928    DoGenerateSwig -
 929 *)
 930
 931 PROCEDURE DoGenerateSwig (sym: CARDINAL) ;
 932 BEGIN
 933    Init ;
 934    name := ConCat (InitStringCharStar (KeyToCharStar (GetSymName (sym))),
 935                    Mark (InitString ('.i'))) ;
 936    f := OpenToWrite (name) ;
 937    ForeachExportedDo (sym, DoExported) ;
 938    DoResolveOrder ;
 939    DoWriteFile (sym) ;
 940    Close (f) ;
 941    name := KillString (name) ;
 942    Kill
 943 END DoGenerateSwig ;
 944
 945
 946 (*
 947    GenerateSwigFile - if the -fswig option was specified then generate
 948                       a swig interface file for the main module.
 949 *)
 950
 951 PROCEDURE GenerateSwigFile (sym: CARDINAL) ;
 952 BEGIN
 953    IF GenerateSwig
 954    THEN
 955       DoGenerateSwig(sym)
 956    END
 957 END GenerateSwigFile ;
 958
 959
 960 (*
 961    Init -
 962 *)
 963
 964 PROCEDURE Init ;
 965 BEGIN
 966    InitList(Done) ;
 967    InitList(ToDo) ;
 968    uKey := InitIndex(1) ;
 969    includedArray := FALSE
 970 END Init ;
 971
 972
 973 (*
 974    Kill -
 975 *)
 976
 977 PROCEDURE Kill ;
 978 BEGIN
 979    KillList(Done) ;
 980    KillList(ToDo) ;
 981    uKey := KillIndex(uKey)
 982 END Kill ;
 983
 984
 985 END M2Swig.