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