00001 #if 0
00002 <<'SKIP';
00003 #endif
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480
00481
00482
00483
00484
00485
00486
00487
00488
00489
00490
00491
00492
00493
00494
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506
00507
00508
00509
00510
00511
00512
00513
00514
00515
00516
00517
00518
00519
00520
00521
00522
00523
00524
00525
00526
00527
00528
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550
00551
00552
00553
00554
00555
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565
00566
00567
00568
00569
00570
00571
00572
00573
00574
00575
00576
00577
00578
00579
00580
00581
00582
00583
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596
00597
00598
00599
00600
00601
00602
00603
00604
00605
00606
00607
00608
00609
00610
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623
00624
00625
00626
00627
00628
00629
00630
00631
00632
00633
00634
00635
00636
00637
00638
00639
00640
00641
00642
00643
00644
00645
00646
00647
00648
00649
00650
00651
00652
00653
00654
00655
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671
00672
00673
00674
00675
00676
00677
00678
00679
00680
00681
00682
00683
00684
00685
00686
00687
00688
00689
00690
00691
00692
00693
00694
00695
00696
00697
00698
00699
00700
00701
00702
00703
00704
00705
00706
00707
00708
00709
00710
00711
00712
00713
00714
00715
00716
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728
00729
00730
00731
00732
00733
00734
00735
00736
00737
00738
00739
00740
00741
00742
00743
00744
00745
00746
00747
00748
00749
00750
00751
00752
00753
00754
00755
00756
00757
00758
00759
00760
00761
00762
00763
00764
00765
00766
00767
00768
00769
00770
00771
00772
00773
00774
00775
00776
00777
00778
00779
00780
00781
00782
00783
00784
00785
00786
00787
00788
00789
00790
00791
00792
00793
00794
00795
00796
00797
00798
00799
00800
00801
00802
00803
00804
00805
00806
00807
00808
00809
00810
00811
00812
00813
00814
00815
00816
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844
00845
00846
00847
00848
00849
00850
00851
00852
00853
00854
00855
00856
00857
00858
00859
00860
00861
00862
00863
00864
00865
00866
00867
00868
00869
00870
00871
00872
00873
00874
00875
00876
00877
00878
00879
00880
00881
00882
00883
00884
00885
00886
00887
00888
00889
00890
00891
00892
00893
00894
00895
00896
00897
00898
00899
00900
00901
00902
00903
00904
00905
00906
00907
00908
00909
00910
00911
00912
00913
00914
00915
00916
00917
00918
00919
00920
00921
00922
00923
00924
00925
00926
00927
00928
00929
00930
00931
00932
00933
00934
00935
00936
00937
00938
00939
00940
00941
00942
00943
00944
00945
00946
00947
00948
00949
00950
00951
00952
00953
00954
00955
00956
00957
00958
00959
00960
00961
00962
00963
00964
00965
00966
00967
00968
00969
00970
00971
00972
00973
00974
00975
00976
00977
00978
00979
00980
00981
00982
00983
00984
00985
00986
00987
00988
00989
00990
00991
00992
00993
00994
00995
00996
00997
00998
00999
01000
01001
01002
01003
01004
01005
01006
01007
01008
01009
01010
01011
01012
01013
01014
01015
01016
01017
01018
01019
01020
01021
01022
01023
01024
01025
01026
01027
01028
01029
01030
01031
01032
01033
01034
01035
01036
01037
01038
01039
01040
01041
01042
01043
01044
01045
01046
01047
01048
01049
01050
01051
01052
01053
01054
01055
01056
01057
01058
01059
01060
01061
01062
01063
01064
01065
01066
01067
01068
01069
01070
01071
01072
01073
01074
01075
01076
01077
01078
01079
01080
01081
01082
01083
01084
01085
01086
01087
01088
01089
01090
01091
01092
01093
01094
01095
01096
01097
01098
01099
01100
01101
01102
01103
01104
01105
01106
01107
01108
01109
01110
01111
01112
01113
01114
01115
01116
01117
01118
01119
01120
01121
01122
01123
01124
01125
01126
01127
01128
01129
01130
01131
01132
01133
01134
01135
01136
01137
01138
01139
01140
01141
01142
01143
01144
01145
01146
01147
01148
01149
01150
01151
01152
01153
01154
01155
01156
01157
01158
01159
01160
01161
01162
01163
01164
01165
01166
01167
01168
01169
01170
01171
01172
01173
01174
01175
01176
01177
01178
01179
01180
01181
01182
01183
01184
01185
01186
01187
01188
01189
01190
01191
01192
01193
01194
01195
01196
01197
01198
01199
01200
01201
01202
01203
01204
01205
01206
01207
01208
01209
01210
01211
01212
01213
01214
01215
01216
01217
01218
01219
01220
01221
01222
01223
01224
01225
01226
01227
01228
01229
01230
01231
01232
01233
01234
01235
01236
01237
01238
01239
01240
01241
01242
01243
01244
01245
01246
01247
01248
01249
01250
01251
01252
01253
01254
01255
01256
01257
01258
01259
01260
01261
01262
01263
01264
01265
01266
01267
01268
01269
01270
01271
01272
01273
01274
01275
01276
01277
01278
01279
01280
01281
01282
01283
01284
01285
01286
01287
01288
01289
01290
01291
01292
01293
01294
01295
01296
01297
01298
01299
01300
01301
01302
01303
01304
01305
01306
01307
01308
01309
01310
01311
01312
01313
01314
01315
01316
01317
01318
01319
01320
01321
01322
01323
01324
01325
01326
01327
01328
01329
01330
01331
01332
01333
01334
01335
01336
01337
01338
01339
01340
01341
01342
01343
01344
01345
01346
01347
01348
01349
01350
01351
01352
01353
01354
01355
01356
01357
01358
01359
01360
01361
01362
01363
01364
01365
01366
01367
01368
01369
01370
01371
01372
01373
01374
01375
01376
01377
01378
01379
01380
01381
01382
01383
01384
01385
01386
01387
01388
01389
01390
01391
01392
01393
01394
01395
01396
01397
01398
01399
01400
01401
01402
01403
01404
01405
01406
01407
01408
01409
01410
01411
01412
01413
01414
01415
01416
01417
01418
01419
01420
01421
01422
01423
01424
01425
01426
01427
01428
01429
01430
01431
01432
01433
01434
01435
01436
01437
01438
01439
01440
01441
01442
01443
01444
01445
01446
01447
01448
01449
01450
01451
01452
01453
01454
01455
01456
01457
01458
01459
01460
01461
01462
01463
01464
01465
01466
01467
01468
01469
01470
01471
01472
01473
01474
01475
01476
01477
01478
01479
01480
01481
01482
01483
01484
01485
01486
01487
01488
01489
01490
01491
01492
01493
01494
01495
01496
01497
01498
01499
01500
01501
01502
01503
01504
01505
01506
01507
01508
01509
01510
01511
01512
01513
01514
01515
01516
01517
01518
01519
01520
01521
01522
01523
01524
01525
01526
01527
01528
01529
01530
01531
01532
01533
01534
01535
01536
01537
01538
01539
01540
01541
01542
01543
01544
01545
01546
01547
01548
01549
01550
01551
01552
01553
01554
01555
01556
01557
01558
01559
01560
01561
01562
01563
01564
01565
01566
01567
01568
01569
01570
01571
01572
01573
01574
01575
01576
01577
01578
01579
01580
01581
01582
01583
01584
01585
01586
01587
01588
01589
01590
01591
01592
01593
01594
01595
01596
01597
01598
01599
01600
01601
01602
01603
01604
01605
01606
01607
01608
01609
01610
01611
01612
01613
01614
01615
01616
01617
01618
01619
01620
01621
01622
01623
01624
01625
01626
01627
01628
01629
01630
01631
01632
01633
01634
01635
01636
01637
01638
01639
01640
01641
01642
01643
01644
01645
01646
01647
01648
01649
01650
01651
01652
01653
01654
01655
01656
01657
01658
01659
01660
01661
01662
01663
01664
01665
01666
01667
01668
01669
01670
01671
01672
01673
01674
01675
01676
01677
01678
01679
01680
01681
01682
01683
01684
01685
01686
01687
01688
01689
01690
01691
01692
01693
01694
01695
01696
01697
01698
01699
01700
01701
01702
01703
01704
01705
01706
01707
01708
01709
01710
01711
01712
01713
01714
01715
01716
01717
01718
01719
01720
01721
01722
01723
01724
01725
01726
01727
01728
01729
01730
01731
01732
01733
01734
01735
01736
01737
01738
01739
01740
01741
01742
01743
01744
01745
01746
01747
01748
01749
01750
01751
01752
01753
01754
01755
01756
01757
01758
01759
01760
01761
01762
01763
01764
01765
01766
01767
01768
01769
01770
01771
01772
01773
01774
01775
01776
01777
01778
01779
01780
01781
01782
01783
01784
01785
01786
01787
01788
01789
01790
01791
01792
01793
01794
01795
01796
01797
01798
01799
01800
01801
01802
01803
01804
01805
01806
01807
01808
01809
01810
01811
01812
01813
01814
01815
01816
01817
01818
01819
01820
01821
01822
01823
01824
01825
01826
01827
01828
01829
01830
01831
01832
01833
01834
01835
01836
01837
01838
01839
01840
01841
01842
01843
01844
01845
01846
01847
01848
01849
01850
01851
01852
01853
01854
01855
01856
01857
01858
01859
01860
01861
01862
01863
01864
01865
01866
01867
01868
01869
01870
01871
01872
01873
01874
01875
01876
01877
01878
01879
01880
01881
01882
01883
01884
01885
01886
01887
01888
01889
01890
01891
01892
01893
01894
01895
01896
01897
01898
01899
01900
01901
01902
01903
01904
01905
01906
01907
01908
01909
01910
01911
01912
01913
01914
01915
01916
01917
01918
01919
01920
01921
01922
01923
01924
01925
01926
01927
01928
01929
01930
01931
01932
01933
01934
01935
01936
01937
01938
01939
01940
01941
01942
01943
01944
01945
01946
01947
01948
01949
01950
01951
01952
01953
01954
01955
01956
01957
01958
01959
01960
01961
01962
01963
01964
01965
01966
01967
01968
01969
01970
01971
01972
01973
01974
01975
01976
01977
01978
01979
01980
01981
01982
01983
01984
01985
01986
01987
01988
01989
01990
01991
01992
01993
01994
01995
01996
01997
01998
01999
02000
02001
02002
02003
02004
02005
02006
02007
02008
02009
02010
02011
02012
02013
02014
02015
02016
02017
02018
02019
02020
02021
02022
02023
02024
02025
02026
02027
02028
02029
02030
02031
02032
02033
02034
02035
02036
02037
02038
02039
02040
02041
02042
02043
02044
02045
02046
02047
02048
02049
02050
02051
02052
02053
02054
02055
02056
02057
02058
02059
02060
02061
02062
02063
02064
02065
02066
02067
02068
02069
02070
02071
02072
02073
02074
02075
02076
02077
02078
02079
02080
02081
02082
02083
02084
02085
02086
02087
02088
02089
02090
02091
02092
02093
02094
02095
02096
02097
02098
02099
02100
02101
02102
02103
02104
02105
02106
02107
02108
02109
02110
02111
02112
02113
02114
02115
02116
02117
02118
02119
02120
02121
02122
02123
02124
02125
02126
02127
02128
02129
02130
02131
02132
02133
02134
02135
02136
02137
02138
02139
02140
02141
02142
02143
02144
02145
02146
02147
02148
02149
02150
02151
02152
02153
02154
02155
02156
02157
02158
02159
02160
02161
02162
02163
02164
02165
02166
02167
02168
02169
02170
02171
02172
02173
02174
02175
02176
02177
02178
02179
02180
02181
02182
02183
02184
02185
02186
02187
02188
02189
02190
02191
02192
02193
02194
02195
02196
02197
02198
02199
02200
02201
02202
02203
02204
02205
02206
02207
02208
02209
02210
02211
02212
02213
02214
02215
02216
02217
02218
02219
02220
02221
02222
02223
02224
02225
02226
02227
02228
02229
02230
02231
02232
02233
02234
02235
02236
02237
02238
02239
02240
02241
02242
02243
02244
02245
02246
02247
02248
02249
02250
02251
02252
02253
02254
02255
02256
02257
02258
02259
02260
02261
02262
02263
02264
02265
02266
02267
02268
02269
02270
02271
02272
02273
02274
02275
02276
02277
02278
02279
02280
02281
02282
02283
02284
02285
02286
02287
02288
02289
02290
02291
02292
02293
02294
02295
02296
02297
02298
02299
02300
02301
02302
02303
02304
02305
02306
02307
02308
02309
02310
02311
02312
02313
02314
02315
02316
02317
02318
02319
02320
02321
02322
02323
02324
02325
02326
02327
02328
02329
02330
02331
02332
02333
02334
02335
02336
02337
02338
02339
02340
02341
02342
02343
02344
02345
02346
02347
02348
02349
02350
02351
02352
02353
02354
02355
02356
02357
02358
02359
02360
02361
02362
02363
02364
02365
02366
02367
02368
02369
02370
02371
02372
02373
02374
02375
02376
02377
02378
02379
02380
02381
02382
02383
02384
02385
02386
02387
02388
02389
02390
02391
02392
02393
02394
02395
02396
02397
02398
02399
02400
02401
02402
02403
02404
02405
02406
02407
02408
02409
02410
02411
02412
02413
02414
02415
02416
02417
02418
02419
02420
02421
02422
02423
02424
02425
02426
02427
02428
02429
02430
02431
02432
02433
02434
02435
02436
02437
02438
02439
02440
02441
02442
02443
02444
02445
02446
02447
02448
02449
02450
02451
02452
02453
02454
02455
02456
02457
02458
02459
02460
02461
02462
02463
02464
02465
02466
02467
02468
02469
02470
02471
02472
02473
02474
02475
02476
02477
02478
02479
02480
02481
02482
02483
02484
02485
02486
02487
02488
02489
02490
02491
02492
02493
02494
02495
02496
02497
02498
02499
02500
02501
02502
02503
02504
02505
02506
02507
02508
02509
02510
02511
02512
02513
02514
02515
02516
02517
02518
02519
02520
02521
02522
02523
02524
02525
02526
02527
02528
02529
02530
02531
02532
02533
02534
02535
02536
02537
02538
02539
02540
02541
02542
02543
02544
02545
02546
02547
02548
02549
02550
02551
02552
02553
02554
02555
02556
02557
02558
02559
02560
02561
02562
02563
02564
02565
02566
02567
02568
02569
02570
02571
02572
02573
02574
02575
02576
02577
02578
02579
02580
02581
02582
02583
02584
02585
02586
02587
02588
02589
02590
02591
02592
02593
02594
02595
02596
02597
02598
02599
02600
02601
02602
02603
02604
02605
02606
02607
02608
02609
02610
02611
02612
02613
02614
02615
02616
02617
02618
02619
02620
02621
02622
02623
02624
02625
02626
02627
02628
02629
02630
02631
02632
02633
02634
02635
02636
02637
02638
02639
02640
02641
02642
02643
02644
02645
02646
02647
02648
02649
02650
02651
02652
02653
02654
02655
02656
02657
02658
02659
02660
02661
02662
02663
02664
02665
02666
02667
02668
02669
02670
02671
02672
02673
02674
02675
02676
02677
02678
02679
02680
02681
02682
02683
02684
02685
02686
02687
02688
02689
02690
02691
02692
02693
02694
02695
02696
02697
02698
02699
02700
02701
02702
02703
02704
02705
02706
02707
02708
02709
02710
02711
02712
02713
02714
02715
02716
02717
02718
02719
02720
02721
02722
02723
02724
02725
02726
02727
02728
02729
02730
02731
02732
02733
02734
02735
02736
02737
02738
02739
02740
02741
02742
02743
02744
02745
02746
02747
02748
02749
02750
02751
02752
02753
02754
02755
02756
02757
02758
02759
02760
02761
02762
02763
02764
02765
02766
02767
02768
02769
02770
02771
02772
02773
02774
02775
02776
02777
02778
02779
02780
02781
02782
02783
02784
02785
02786
02787
02788
02789
02790
02791
02792
02793
02794
02795
02796
02797
02798
02799
02800
02801
02802
02803
02804
02805
02806
02807
02808
02809
02810
02811
02812
02813
02814
02815
02816
02817
02818
02819
02820
02821
02822
02823
02824
02825
02826
02827
02828
02829
02830
02831
02832
02833
02834
02835
02836
02837
02838
02839
02840
02841
02842
02843
02844
02845
02846
02847
02848
02849
02850
02851
02852
02853
02854
02855
02856
02857
02858
02859
02860
02861
02862
02863
02864
02865
02866
02867
02868
02869
02870
02871
02872
02873
02874
02875
02876
02877
02878
02879
02880
02881
02882
02883
02884
02885
02886
02887
02888
02889
02890
02891
02892
02893
02894
02895
02896
02897
02898
02899
02900
02901
02902
02903
02904
02905
02906
02907
02908
02909
02910
02911
02912
02913
02914
02915
02916
02917
02918
02919
02920
02921
02922
02923
02924
02925
02926
02927
02928
02929
02930
02931
02932
02933
02934
02935
02936
02937
02938
02939
02940
02941
02942
02943
02944
02945
02946
02947
02948
02949
02950
02951
02952
02953
02954
02955
02956
02957
02958
02959
02960
02961
02962
02963
02964
02965
02966
02967
02968
02969
02970
02971
02972
02973
02974
02975
02976
02977
02978
02979
02980
02981
02982
02983
02984
02985
02986
02987
02988
02989
02990
02991
02992
02993
02994
02995
02996
02997
02998
02999
03000
03001
03002
03003
03004
03005
03006
03007
03008
03009
03010
03011
03012
03013
03014
03015
03016
03017
03018
03019
03020
03021
03022
03023
03024
03025
03026
03027
03028
03029
03030
03031
03032
03033
03034
03035
03036
03037
03038
03039
03040
03041
03042
03043
03044
03045
03046
03047
03048
03049
03050
03051
03052
03053
03054
03055
03056
03057
03058
03059
03060
03061
03062
03063
03064
03065
03066
03067
03068
03069
03070
03071
03072
03073
03074
03075
03076
03077
03078
03079
03080
03081
03082
03083
03084
03085
03086
03087
03088
03089
03090
03091
03092
03093
03094
03095
03096
03097
03098
03099
03100
03101
03102
03103
03104
03105
03106
03107
03108
03109
03110
03111
03112
03113
03114
03115
03116
03117
03118
03119
03120
03121
03122
03123
03124
03125
03126
03127
03128
03129
03130
03131
03132
03133
03134
03135
03136
03137
03138
03139
03140
03141
03142
03143
03144
03145
03146
03147
03148
03149
03150
03151
03152
03153
03154 #ifndef _P_P_PORTABILITY_H_
03155 #define _P_P_PORTABILITY_H_
03156
03157 #ifndef DPPP_NAMESPACE
03158 # define DPPP_NAMESPACE DPPP_
03159 #endif
03160
03161 #define DPPP_CAT2(x,y) CAT2(x,y)
03162 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
03163
03164 #ifndef PERL_REVISION
03165 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
03166 # define PERL_PATCHLEVEL_H_IMPLICIT
03167 # include <patchlevel.h>
03168 # endif
03169 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
03170 # include <could_not_find_Perl_patchlevel.h>
03171 # endif
03172 # ifndef PERL_REVISION
03173 # define PERL_REVISION (5)
03174
03175 # define PERL_VERSION PATCHLEVEL
03176 # define PERL_SUBVERSION SUBVERSION
03177
03178
03179 # endif
03180 #endif
03181
03182 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
03183 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
03184
03185
03186
03187
03188 #if PERL_REVISION != 5
03189 # error ppport.h only works with Perl version 5
03190 #endif
03191 #ifndef dTHR
03192 # define dTHR dNOOP
03193 #endif
03194 #ifndef dTHX
03195 # define dTHX dNOOP
03196 #endif
03197
03198 #ifndef dTHXa
03199 # define dTHXa(x) dNOOP
03200 #endif
03201 #ifndef pTHX
03202 # define pTHX void
03203 #endif
03204
03205 #ifndef pTHX_
03206 # define pTHX_
03207 #endif
03208
03209 #ifndef aTHX
03210 # define aTHX
03211 #endif
03212
03213 #ifndef aTHX_
03214 # define aTHX_
03215 #endif
03216
03217 #if (PERL_BCDVERSION < 0x5006000)
03218 # ifdef USE_THREADS
03219 # define aTHXR thr
03220 # define aTHXR_ thr,
03221 # else
03222 # define aTHXR
03223 # define aTHXR_
03224 # endif
03225 # define dTHXR dTHR
03226 #else
03227 # define aTHXR aTHX
03228 # define aTHXR_ aTHX_
03229 # define dTHXR dTHX
03230 #endif
03231 #ifndef dTHXoa
03232 # define dTHXoa(x) dTHXa(x)
03233 #endif
03234
03235 #ifdef I_LIMITS
03236 # include <limits.h>
03237 #endif
03238
03239 #ifndef PERL_UCHAR_MIN
03240 # define PERL_UCHAR_MIN ((unsigned char)0)
03241 #endif
03242
03243 #ifndef PERL_UCHAR_MAX
03244 # ifdef UCHAR_MAX
03245 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
03246 # else
03247 # ifdef MAXUCHAR
03248 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
03249 # else
03250 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
03251 # endif
03252 # endif
03253 #endif
03254
03255 #ifndef PERL_USHORT_MIN
03256 # define PERL_USHORT_MIN ((unsigned short)0)
03257 #endif
03258
03259 #ifndef PERL_USHORT_MAX
03260 # ifdef USHORT_MAX
03261 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
03262 # else
03263 # ifdef MAXUSHORT
03264 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
03265 # else
03266 # ifdef USHRT_MAX
03267 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
03268 # else
03269 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
03270 # endif
03271 # endif
03272 # endif
03273 #endif
03274
03275 #ifndef PERL_SHORT_MAX
03276 # ifdef SHORT_MAX
03277 # define PERL_SHORT_MAX ((short)SHORT_MAX)
03278 # else
03279 # ifdef MAXSHORT
03280 # define PERL_SHORT_MAX ((short)MAXSHORT)
03281 # else
03282 # ifdef SHRT_MAX
03283 # define PERL_SHORT_MAX ((short)SHRT_MAX)
03284 # else
03285 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
03286 # endif
03287 # endif
03288 # endif
03289 #endif
03290
03291 #ifndef PERL_SHORT_MIN
03292 # ifdef SHORT_MIN
03293 # define PERL_SHORT_MIN ((short)SHORT_MIN)
03294 # else
03295 # ifdef MINSHORT
03296 # define PERL_SHORT_MIN ((short)MINSHORT)
03297 # else
03298 # ifdef SHRT_MIN
03299 # define PERL_SHORT_MIN ((short)SHRT_MIN)
03300 # else
03301 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
03302 # endif
03303 # endif
03304 # endif
03305 #endif
03306
03307 #ifndef PERL_UINT_MAX
03308 # ifdef UINT_MAX
03309 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
03310 # else
03311 # ifdef MAXUINT
03312 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
03313 # else
03314 # define PERL_UINT_MAX (~(unsigned int)0)
03315 # endif
03316 # endif
03317 #endif
03318
03319 #ifndef PERL_UINT_MIN
03320 # define PERL_UINT_MIN ((unsigned int)0)
03321 #endif
03322
03323 #ifndef PERL_INT_MAX
03324 # ifdef INT_MAX
03325 # define PERL_INT_MAX ((int)INT_MAX)
03326 # else
03327 # ifdef MAXINT
03328 # define PERL_INT_MAX ((int)MAXINT)
03329 # else
03330 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
03331 # endif
03332 # endif
03333 #endif
03334
03335 #ifndef PERL_INT_MIN
03336 # ifdef INT_MIN
03337 # define PERL_INT_MIN ((int)INT_MIN)
03338 # else
03339 # ifdef MININT
03340 # define PERL_INT_MIN ((int)MININT)
03341 # else
03342 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
03343 # endif
03344 # endif
03345 #endif
03346
03347 #ifndef PERL_ULONG_MAX
03348 # ifdef ULONG_MAX
03349 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
03350 # else
03351 # ifdef MAXULONG
03352 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
03353 # else
03354 # define PERL_ULONG_MAX (~(unsigned long)0)
03355 # endif
03356 # endif
03357 #endif
03358
03359 #ifndef PERL_ULONG_MIN
03360 # define PERL_ULONG_MIN ((unsigned long)0L)
03361 #endif
03362
03363 #ifndef PERL_LONG_MAX
03364 # ifdef LONG_MAX
03365 # define PERL_LONG_MAX ((long)LONG_MAX)
03366 # else
03367 # ifdef MAXLONG
03368 # define PERL_LONG_MAX ((long)MAXLONG)
03369 # else
03370 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
03371 # endif
03372 # endif
03373 #endif
03374
03375 #ifndef PERL_LONG_MIN
03376 # ifdef LONG_MIN
03377 # define PERL_LONG_MIN ((long)LONG_MIN)
03378 # else
03379 # ifdef MINLONG
03380 # define PERL_LONG_MIN ((long)MINLONG)
03381 # else
03382 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
03383 # endif
03384 # endif
03385 #endif
03386
03387 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
03388 # ifndef PERL_UQUAD_MAX
03389 # ifdef ULONGLONG_MAX
03390 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
03391 # else
03392 # ifdef MAXULONGLONG
03393 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
03394 # else
03395 # define PERL_UQUAD_MAX (~(unsigned long long)0)
03396 # endif
03397 # endif
03398 # endif
03399
03400 # ifndef PERL_UQUAD_MIN
03401 # define PERL_UQUAD_MIN ((unsigned long long)0L)
03402 # endif
03403
03404 # ifndef PERL_QUAD_MAX
03405 # ifdef LONGLONG_MAX
03406 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
03407 # else
03408 # ifdef MAXLONGLONG
03409 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
03410 # else
03411 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
03412 # endif
03413 # endif
03414 # endif
03415
03416 # ifndef PERL_QUAD_MIN
03417 # ifdef LONGLONG_MIN
03418 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
03419 # else
03420 # ifdef MINLONGLONG
03421 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
03422 # else
03423 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
03424 # endif
03425 # endif
03426 # endif
03427 #endif
03428
03429
03430 #ifdef HAS_QUAD
03431 # ifdef cray
03432 #ifndef IVTYPE
03433 # define IVTYPE int
03434 #endif
03435
03436 #ifndef IV_MIN
03437 # define IV_MIN PERL_INT_MIN
03438 #endif
03439
03440 #ifndef IV_MAX
03441 # define IV_MAX PERL_INT_MAX
03442 #endif
03443
03444 #ifndef UV_MIN
03445 # define UV_MIN PERL_UINT_MIN
03446 #endif
03447
03448 #ifndef UV_MAX
03449 # define UV_MAX PERL_UINT_MAX
03450 #endif
03451
03452 # ifdef INTSIZE
03453 #ifndef IVSIZE
03454 # define IVSIZE INTSIZE
03455 #endif
03456
03457 # endif
03458 # else
03459 # if defined(convex) || defined(uts)
03460 #ifndef IVTYPE
03461 # define IVTYPE long long
03462 #endif
03463
03464 #ifndef IV_MIN
03465 # define IV_MIN PERL_QUAD_MIN
03466 #endif
03467
03468 #ifndef IV_MAX
03469 # define IV_MAX PERL_QUAD_MAX
03470 #endif
03471
03472 #ifndef UV_MIN
03473 # define UV_MIN PERL_UQUAD_MIN
03474 #endif
03475
03476 #ifndef UV_MAX
03477 # define UV_MAX PERL_UQUAD_MAX
03478 #endif
03479
03480 # ifdef LONGLONGSIZE
03481 #ifndef IVSIZE
03482 # define IVSIZE LONGLONGSIZE
03483 #endif
03484
03485 # endif
03486 # else
03487 #ifndef IVTYPE
03488 # define IVTYPE long
03489 #endif
03490
03491 #ifndef IV_MIN
03492 # define IV_MIN PERL_LONG_MIN
03493 #endif
03494
03495 #ifndef IV_MAX
03496 # define IV_MAX PERL_LONG_MAX
03497 #endif
03498
03499 #ifndef UV_MIN
03500 # define UV_MIN PERL_ULONG_MIN
03501 #endif
03502
03503 #ifndef UV_MAX
03504 # define UV_MAX PERL_ULONG_MAX
03505 #endif
03506
03507 # ifdef LONGSIZE
03508 #ifndef IVSIZE
03509 # define IVSIZE LONGSIZE
03510 #endif
03511
03512 # endif
03513 # endif
03514 # endif
03515 #ifndef IVSIZE
03516 # define IVSIZE 8
03517 #endif
03518
03519 #ifndef PERL_QUAD_MIN
03520 # define PERL_QUAD_MIN IV_MIN
03521 #endif
03522
03523 #ifndef PERL_QUAD_MAX
03524 # define PERL_QUAD_MAX IV_MAX
03525 #endif
03526
03527 #ifndef PERL_UQUAD_MIN
03528 # define PERL_UQUAD_MIN UV_MIN
03529 #endif
03530
03531 #ifndef PERL_UQUAD_MAX
03532 # define PERL_UQUAD_MAX UV_MAX
03533 #endif
03534
03535 #else
03536 #ifndef IVTYPE
03537 # define IVTYPE long
03538 #endif
03539
03540 #ifndef IV_MIN
03541 # define IV_MIN PERL_LONG_MIN
03542 #endif
03543
03544 #ifndef IV_MAX
03545 # define IV_MAX PERL_LONG_MAX
03546 #endif
03547
03548 #ifndef UV_MIN
03549 # define UV_MIN PERL_ULONG_MIN
03550 #endif
03551
03552 #ifndef UV_MAX
03553 # define UV_MAX PERL_ULONG_MAX
03554 #endif
03555
03556 #endif
03557
03558 #ifndef IVSIZE
03559 # ifdef LONGSIZE
03560 # define IVSIZE LONGSIZE
03561 # else
03562 # define IVSIZE 4
03563 # endif
03564 #endif
03565 #ifndef UVTYPE
03566 # define UVTYPE unsigned IVTYPE
03567 #endif
03568
03569 #ifndef UVSIZE
03570 # define UVSIZE IVSIZE
03571 #endif
03572 #ifndef sv_setuv
03573 # define sv_setuv(sv, uv) \
03574 STMT_START { \
03575 UV TeMpUv = uv; \
03576 if (TeMpUv <= IV_MAX) \
03577 sv_setiv(sv, TeMpUv); \
03578 else \
03579 sv_setnv(sv, (double)TeMpUv); \
03580 } STMT_END
03581 #endif
03582 #ifndef newSVuv
03583 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
03584 #endif
03585 #ifndef sv_2uv
03586 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
03587 #endif
03588
03589 #ifndef SvUVX
03590 # define SvUVX(sv) ((UV)SvIVX(sv))
03591 #endif
03592
03593 #ifndef SvUVXx
03594 # define SvUVXx(sv) SvUVX(sv)
03595 #endif
03596
03597 #ifndef SvUV
03598 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
03599 #endif
03600
03601 #ifndef SvUVx
03602 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
03603 #endif
03604
03605
03606
03607
03608 #ifndef sv_uv
03609 # define sv_uv(sv) SvUVx(sv)
03610 #endif
03611
03612 #if !defined(SvUOK) && defined(SvIOK_UV)
03613 # define SvUOK(sv) SvIOK_UV(sv)
03614 #endif
03615 #ifndef XST_mUV
03616 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
03617 #endif
03618
03619 #ifndef XSRETURN_UV
03620 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
03621 #endif
03622 #ifndef PUSHu
03623 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
03624 #endif
03625
03626 #ifndef XPUSHu
03627 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
03628 #endif
03629
03630 #ifdef HAS_MEMCMP
03631 #ifndef memNE
03632 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
03633 #endif
03634
03635 #ifndef memEQ
03636 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
03637 #endif
03638
03639 #else
03640 #ifndef memNE
03641 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
03642 #endif
03643
03644 #ifndef memEQ
03645 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
03646 #endif
03647
03648 #endif
03649 #ifndef MoveD
03650 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
03651 #endif
03652
03653 #ifndef CopyD
03654 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
03655 #endif
03656
03657 #ifdef HAS_MEMSET
03658 #ifndef ZeroD
03659 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
03660 #endif
03661
03662 #else
03663 #ifndef ZeroD
03664 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
03665 #endif
03666
03667 #endif
03668 #ifndef PoisonWith
03669 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
03670 #endif
03671
03672 #ifndef PoisonNew
03673 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
03674 #endif
03675
03676 #ifndef PoisonFree
03677 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
03678 #endif
03679
03680 #ifndef Poison
03681 # define Poison(d,n,t) PoisonFree(d,n,t)
03682 #endif
03683 #ifndef Newx
03684 # define Newx(v,n,t) New(0,v,n,t)
03685 #endif
03686
03687 #ifndef Newxc
03688 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
03689 #endif
03690
03691 #ifndef Newxz
03692 # define Newxz(v,n,t) Newz(0,v,n,t)
03693 #endif
03694
03695 #ifndef PERL_UNUSED_DECL
03696 # ifdef HASATTRIBUTE
03697 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
03698 # define PERL_UNUSED_DECL
03699 # else
03700 # define PERL_UNUSED_DECL __attribute__((unused))
03701 # endif
03702 # else
03703 # define PERL_UNUSED_DECL
03704 # endif
03705 #endif
03706
03707 #ifndef PERL_UNUSED_ARG
03708 # if defined(lint) && defined(S_SPLINT_S)
03709 # include <note.h>
03710 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
03711 # else
03712 # define PERL_UNUSED_ARG(x) ((void)x)
03713 # endif
03714 #endif
03715
03716 #ifndef PERL_UNUSED_VAR
03717 # define PERL_UNUSED_VAR(x) ((void)x)
03718 #endif
03719
03720 #ifndef PERL_UNUSED_CONTEXT
03721 # ifdef USE_ITHREADS
03722 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
03723 # else
03724 # define PERL_UNUSED_CONTEXT
03725 # endif
03726 #endif
03727 #ifndef NOOP
03728 # define NOOP (void)0
03729 #endif
03730
03731 #ifndef dNOOP
03732 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
03733 #endif
03734
03735 #ifndef NVTYPE
03736 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
03737 # define NVTYPE long double
03738 # else
03739 # define NVTYPE double
03740 # endif
03741 typedef NVTYPE NV;
03742 #endif
03743
03744 #ifndef INT2PTR
03745 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
03746 # define PTRV UV
03747 # define INT2PTR(any,d) (any)(d)
03748 # else
03749 # if PTRSIZE == LONGSIZE
03750 # define PTRV unsigned long
03751 # else
03752 # define PTRV unsigned
03753 # endif
03754 # define INT2PTR(any,d) (any)(PTRV)(d)
03755 # endif
03756 #endif
03757
03758 #ifndef PTR2ul
03759 # if PTRSIZE == LONGSIZE
03760 # define PTR2ul(p) (unsigned long)(p)
03761 # else
03762 # define PTR2ul(p) INT2PTR(unsigned long,p)
03763 # endif
03764 #endif
03765 #ifndef PTR2nat
03766 # define PTR2nat(p) (PTRV)(p)
03767 #endif
03768
03769 #ifndef NUM2PTR
03770 # define NUM2PTR(any,d) (any)PTR2nat(d)
03771 #endif
03772
03773 #ifndef PTR2IV
03774 # define PTR2IV(p) INT2PTR(IV,p)
03775 #endif
03776
03777 #ifndef PTR2UV
03778 # define PTR2UV(p) INT2PTR(UV,p)
03779 #endif
03780
03781 #ifndef PTR2NV
03782 # define PTR2NV(p) NUM2PTR(NV,p)
03783 #endif
03784
03785 #undef START_EXTERN_C
03786 #undef END_EXTERN_C
03787 #undef EXTERN_C
03788 #ifdef __cplusplus
03789 # define START_EXTERN_C extern "C" {
03790 # define END_EXTERN_C }
03791 # define EXTERN_C extern "C"
03792 #else
03793 # define START_EXTERN_C
03794 # define END_EXTERN_C
03795 # define EXTERN_C extern
03796 #endif
03797
03798 #if defined(PERL_GCC_PEDANTIC)
03799 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
03800 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
03801 # endif
03802 #endif
03803
03804 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
03805 # ifndef PERL_USE_GCC_BRACE_GROUPS
03806 # define PERL_USE_GCC_BRACE_GROUPS
03807 # endif
03808 #endif
03809
03810 #undef STMT_START
03811 #undef STMT_END
03812 #ifdef PERL_USE_GCC_BRACE_GROUPS
03813 # define STMT_START (void)(
03814 # define STMT_END )
03815 #else
03816 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
03817 # define STMT_START if (1)
03818 # define STMT_END else (void)0
03819 # else
03820 # define STMT_START do
03821 # define STMT_END while (0)
03822 # endif
03823 #endif
03824 #ifndef boolSV
03825 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
03826 #endif
03827
03828
03829 #ifndef DEFSV
03830 # define DEFSV GvSV(PL_defgv)
03831 #endif
03832
03833 #ifndef SAVE_DEFSV
03834 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
03835 #endif
03836
03837 #ifndef DEFSV_set
03838 # define DEFSV_set(sv) (DEFSV = (sv))
03839 #endif
03840
03841
03842 #ifndef AvFILLp
03843 # define AvFILLp AvFILL
03844 #endif
03845 #ifndef ERRSV
03846 # define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* Replace: 1 */
#ifndef get_cv
# define get_cv perl_get_cv
#endif
#ifndef get_sv
# define get_sv perl_get_sv
#endif
#ifndef get_av
# define get_av perl_get_av
#endif
#ifndef get_hv
# define get_hv perl_get_hv
#endif
/* Replace: 0 */
#ifndef dUNDERBAR
# define dUNDERBAR dNOOP
#endif
#ifndef UNDERBAR
# define UNDERBAR DEFSV
#endif
#ifndef dAX
# define dAX I32 ax = MARK - PL_stack_base + 1
#endif
#ifndef dITEMS
# define dITEMS I32 items = SP - MARK
#endif
#ifndef dXSTARG
# define dXSTARG SV * targ = sv_newmortal()
#endif
#ifndef dAXMARK
# define dAXMARK I32 ax = POPMARK; \
register SV ** const mark = PL_stack_base + ax++
#endif
#ifndef XSprePUSH
# define XSprePUSH (sp = PL_stack_base + ax - 1)
#endif
#if (PERL_BCDVERSION < 0x5005000)
# undef XSRETURN
# define XSRETURN(off) \
STMT_START { \
PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
return; \
} STMT_END
#endif
#ifndef PERL_ABS
# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#endif
#ifndef dVAR
# define dVAR dNOOP
#endif
#ifndef SVf
# define SVf "_"
03847 #endif
03848 #ifndef UTF8_MAXBYTES
03849 # define UTF8_MAXBYTES UTF8_MAXLEN
03850 #endif
03851 #ifndef CPERLscope
03852 # define CPERLscope(x) x
03853 #endif
03854 #ifndef PERL_HASH
03855 # define PERL_HASH(hash,str,len) \
03856 STMT_START { \
03857 const char *s_PeRlHaSh = str; \
03858 I32 i_PeRlHaSh = len; \
03859 U32 hash_PeRlHaSh = 0; \
03860 while (i_PeRlHaSh--) \
03861 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
03862 (hash) = hash_PeRlHaSh; \
03863 } STMT_END
03864 #endif
03865
03866 #ifndef PERLIO_FUNCS_DECL
03867 # ifdef PERLIO_FUNCS_CONST
03868 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
03869 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
03870 # else
03871 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
03872 # define PERLIO_FUNCS_CAST(funcs) (funcs)
03873 # endif
03874 #endif
03875
03876
03877 #if (PERL_BCDVERSION < 0x5009003)
03878
03879 # ifdef ARGSproto
03880 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
03881 # else
03882 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
03883 # endif
03884
03885 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
03886
03887 #endif
03888 #ifndef isPSXSPC
03889 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
03890 #endif
03891
03892 #ifndef isBLANK
03893 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
03894 #endif
03895
03896 #ifdef EBCDIC
03897 #ifndef isALNUMC
03898 # define isALNUMC(c) isalnum(c)
03899 #endif
03900
03901 #ifndef isASCII
03902 # define isASCII(c) isascii(c)
03903 #endif
03904
03905 #ifndef isCNTRL
03906 # define isCNTRL(c) iscntrl(c)
03907 #endif
03908
03909 #ifndef isGRAPH
03910 # define isGRAPH(c) isgraph(c)
03911 #endif
03912
03913 #ifndef isPRINT
03914 # define isPRINT(c) isprint(c)
03915 #endif
03916
03917 #ifndef isPUNCT
03918 # define isPUNCT(c) ispunct(c)
03919 #endif
03920
03921 #ifndef isXDIGIT
03922 # define isXDIGIT(c) isxdigit(c)
03923 #endif
03924
03925 #else
03926 # if (PERL_BCDVERSION < 0x5010000)
03927
03928
03929
03930
03931
03932 # undef isPRINT
03933 # endif
03934 #ifndef isALNUMC
03935 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
03936 #endif
03937
03938 #ifndef isASCII
03939 # define isASCII(c) ((c) <= 127)
03940 #endif
03941
03942 #ifndef isCNTRL
03943 # define isCNTRL(c) ((c) < ' ' || (c) == 127)
03944 #endif
03945
03946 #ifndef isGRAPH
03947 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
03948 #endif
03949
03950 #ifndef isPRINT
03951 # define isPRINT(c) (((c) >= 32 && (c) < 127))
03952 #endif
03953
03954 #ifndef isPUNCT
03955 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
03956 #endif
03957
03958 #ifndef isXDIGIT
03959 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
03960 #endif
03961
03962 #endif
03963
03964 #ifndef PERL_SIGNALS_UNSAFE_FLAG
03965
03966 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
03967
03968 #if (PERL_BCDVERSION < 0x5008000)
03969 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
03970 #else
03971 # define D_PPP_PERL_SIGNALS_INIT 0
03972 #endif
03973
03974 #if defined(NEED_PL_signals)
03975 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
03976 #elif defined(NEED_PL_signals_GLOBAL)
03977 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
03978 #else
03979 extern U32 DPPP_(my_PL_signals);
03980 #endif
03981 #define PL_signals DPPP_(my_PL_signals)
03982
03983 #endif
03984
03985
03986
03987
03988
03989
03990
03991
03992 #if (PERL_BCDVERSION <= 0x5005005)
03993
03994 # define PL_ppaddr ppaddr
03995 # define PL_no_modify no_modify
03996
03997 #endif
03998
03999 #if (PERL_BCDVERSION <= 0x5004005)
04000
04001 # define PL_DBsignal DBsignal
04002 # define PL_DBsingle DBsingle
04003 # define PL_DBsub DBsub
04004 # define PL_DBtrace DBtrace
04005 # define PL_Sv Sv
04006 # define PL_bufend bufend
04007 # define PL_bufptr bufptr
04008 # define PL_compiling compiling
04009 # define PL_copline copline
04010 # define PL_curcop curcop
04011 # define PL_curstash curstash
04012 # define PL_debstash debstash
04013 # define PL_defgv defgv
04014 # define PL_diehook diehook
04015 # define PL_dirty dirty
04016 # define PL_dowarn dowarn
04017 # define PL_errgv errgv
04018 # define PL_expect expect
04019 # define PL_hexdigit hexdigit
04020 # define PL_hints hints
04021 # define PL_laststatval laststatval
04022 # define PL_lex_state lex_state
04023 # define PL_lex_stuff lex_stuff
04024 # define PL_linestr linestr
04025 # define PL_na na
04026 # define PL_perl_destruct_level perl_destruct_level
04027 # define PL_perldb perldb
04028 # define PL_rsfp_filters rsfp_filters
04029 # define PL_rsfp rsfp
04030 # define PL_stack_base stack_base
04031 # define PL_stack_sp stack_sp
04032 # define PL_statcache statcache
04033 # define PL_stdingv stdingv
04034 # define PL_sv_arenaroot sv_arenaroot
04035 # define PL_sv_no sv_no
04036 # define PL_sv_undef sv_undef
04037 # define PL_sv_yes sv_yes
04038 # define PL_tainted tainted
04039 # define PL_tainting tainting
04040 # define PL_tokenbuf tokenbuf
04041
04042 #endif
04043
04044
04045
04046
04047
04048
04049
04050
04051
04052
04053
04054 #if (PERL_BCDVERSION >= 0x5009005)
04055 # ifdef DPPP_PL_parser_NO_DUMMY
04056 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
04057 (croak("panic: PL_parser == NULL in %s:%d", \
04058 __FILE__, __LINE__), (yy_parser *) NULL))->var)
04059 # else
04060 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
04061 # define D_PPP_parser_dummy_warning(var)
04062 # else
04063 # define D_PPP_parser_dummy_warning(var) \
04064 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
04065 # endif
04066 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
04067 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
04068 #if defined(NEED_PL_parser)
04069 static yy_parser DPPP_(dummy_PL_parser);
04070 #elif defined(NEED_PL_parser_GLOBAL)
04071 yy_parser DPPP_(dummy_PL_parser);
04072 #else
04073 extern yy_parser DPPP_(dummy_PL_parser);
04074 #endif
04075
04076 # endif
04077
04078
04079
04080
04081
04082
04083
04084
04085
04086
04087
04088
04089
04090
04091
04092
04093 # define PL_expect D_PPP_my_PL_parser_var(expect)
04094 # define PL_copline D_PPP_my_PL_parser_var(copline)
04095 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
04096 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
04097 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
04098 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
04099 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
04100 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
04101 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
04102 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
04103
04104 #else
04105
04106
04107 # define PL_parser ((void *) 1)
04108
04109 #endif
04110 #ifndef mPUSHs
04111 # define mPUSHs(s) PUSHs(sv_2mortal(s))
04112 #endif
04113
04114 #ifndef PUSHmortal
04115 # define PUSHmortal PUSHs(sv_newmortal())
04116 #endif
04117
04118 #ifndef mPUSHp
04119 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
04120 #endif
04121
04122 #ifndef mPUSHn
04123 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
04124 #endif
04125
04126 #ifndef mPUSHi
04127 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
04128 #endif
04129
04130 #ifndef mPUSHu
04131 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
04132 #endif
04133 #ifndef mXPUSHs
04134 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
04135 #endif
04136
04137 #ifndef XPUSHmortal
04138 # define XPUSHmortal XPUSHs(sv_newmortal())
04139 #endif
04140
04141 #ifndef mXPUSHp
04142 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
04143 #endif
04144
04145 #ifndef mXPUSHn
04146 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
04147 #endif
04148
04149 #ifndef mXPUSHi
04150 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
04151 #endif
04152
04153 #ifndef mXPUSHu
04154 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
04155 #endif
04156
04157
04158 #ifndef call_sv
04159 # define call_sv perl_call_sv
04160 #endif
04161
04162 #ifndef call_pv
04163 # define call_pv perl_call_pv
04164 #endif
04165
04166 #ifndef call_argv
04167 # define call_argv perl_call_argv
04168 #endif
04169
04170 #ifndef call_method
04171 # define call_method perl_call_method
04172 #endif
04173 #ifndef eval_sv
04174 # define eval_sv perl_eval_sv
04175 #endif
04176
04177
04178 #ifndef PERL_LOADMOD_DENY
04179 # define PERL_LOADMOD_DENY 0x1
04180 #endif
04181
04182 #ifndef PERL_LOADMOD_NOIMPORT
04183 # define PERL_LOADMOD_NOIMPORT 0x2
04184 #endif
04185
04186 #ifndef PERL_LOADMOD_IMPORT_OPS
04187 # define PERL_LOADMOD_IMPORT_OPS 0x4
04188 #endif
04189
04190 #ifndef G_METHOD
04191 # define G_METHOD 64
04192 # ifdef call_sv
04193 # undef call_sv
04194 # endif
04195 # if (PERL_BCDVERSION < 0x5006000)
04196 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
04197 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
04198 # else
04199 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
04200 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
04201 # endif
04202 #endif
04203
04204
04205
04206 #ifndef eval_pv
04207 #if defined(NEED_eval_pv)
04208 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
04209 static
04210 #else
04211 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
04212 #endif
04213
04214 #ifdef eval_pv
04215 # undef eval_pv
04216 #endif
04217 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
04218 #define Perl_eval_pv DPPP_(my_eval_pv)
04219
04220 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
04221
04222 SV*
04223 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
04224 {
04225 dSP;
04226 SV* sv = newSVpv(p, 0);
04227
04228 PUSHMARK(sp);
04229 eval_sv(sv, G_SCALAR);
04230 SvREFCNT_dec(sv);
04231
04232 SPAGAIN;
04233 sv = POPs;
04234 PUTBACK;
04235
04236 if (croak_on_error && SvTRUE(GvSV(errgv)))
04237 croak(SvPVx(GvSV(errgv), na));
04238
04239 return sv;
04240 }
04241
04242 #endif
04243 #endif
04244
04245 #ifndef vload_module
04246 #if defined(NEED_vload_module)
04247 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
04248 static
04249 #else
04250 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
04251 #endif
04252
04253 #ifdef vload_module
04254 # undef vload_module
04255 #endif
04256 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
04257 #define Perl_vload_module DPPP_(my_vload_module)
04258
04259 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
04260
04261 void
04262 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
04263 {
04264 dTHR;
04265 dVAR;
04266 OP *veop, *imop;
04267
04268 OP * const modname = newSVOP(OP_CONST, 0, name);
04269
04270
04271
04272
04273
04274 SvREADONLY_off(((SVOP*)modname)->op_sv);
04275 modname->op_private |= OPpCONST_BARE;
04276 if (ver) {
04277 veop = newSVOP(OP_CONST, 0, ver);
04278 }
04279 else
04280 veop = NULL;
04281 if (flags & PERL_LOADMOD_NOIMPORT) {
04282 imop = sawparens(newNULLLIST());
04283 }
04284 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
04285 imop = va_arg(*args, OP*);
04286 }
04287 else {
04288 SV *sv;
04289 imop = NULL;
04290 sv = va_arg(*args, SV*);
04291 while (sv) {
04292 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
04293 sv = va_arg(*args, SV*);
04294 }
04295 }
04296 {
04297 const line_t ocopline = PL_copline;
04298 COP * const ocurcop = PL_curcop;
04299 const int oexpect = PL_expect;
04300
04301 #if (PERL_BCDVERSION >= 0x5004000)
04302 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
04303 veop, modname, imop);
04304 #else
04305 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
04306 modname, imop);
04307 #endif
04308 PL_expect = oexpect;
04309 PL_copline = ocopline;
04310 PL_curcop = ocurcop;
04311 }
04312 }
04313
04314 #endif
04315 #endif
04316
04317 #ifndef load_module
04318 #if defined(NEED_load_module)
04319 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
04320 static
04321 #else
04322 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
04323 #endif
04324
04325 #ifdef load_module
04326 # undef load_module
04327 #endif
04328 #define load_module DPPP_(my_load_module)
04329 #define Perl_load_module DPPP_(my_load_module)
04330
04331 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
04332
04333 void
04334 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
04335 {
04336 va_list args;
04337 va_start(args, ver);
04338 vload_module(flags, name, ver, &args);
04339 va_end(args);
04340 }
04341
04342 #endif
04343 #endif
04344 #ifndef newRV_inc
04345 # define newRV_inc(sv) newRV(sv)
04346 #endif
04347
04348 #ifndef newRV_noinc
04349 #if defined(NEED_newRV_noinc)
04350 static SV * DPPP_(my_newRV_noinc)(SV *sv);
04351 static
04352 #else
04353 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
04354 #endif
04355
04356 #ifdef newRV_noinc
04357 # undef newRV_noinc
04358 #endif
04359 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
04360 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
04361
04362 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
04363 SV *
04364 DPPP_(my_newRV_noinc)(SV *sv)
04365 {
04366 SV *rv = (SV *)newRV(sv);
04367 SvREFCNT_dec(sv);
04368 return rv;
04369 }
04370 #endif
04371 #endif
04372
04373
04374
04375
04376
04377
04378
04379 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
04380 #if defined(NEED_newCONSTSUB)
04381 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
04382 static
04383 #else
04384 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
04385 #endif
04386
04387 #ifdef newCONSTSUB
04388 # undef newCONSTSUB
04389 #endif
04390 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
04391 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
04392
04393 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
04394
04395
04396
04397 #define D_PPP_PL_copline PL_copline
04398
04399 void
04400 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
04401 {
04402 U32 oldhints = PL_hints;
04403 HV *old_cop_stash = PL_curcop->cop_stash;
04404 HV *old_curstash = PL_curstash;
04405 line_t oldline = PL_curcop->cop_line;
04406 PL_curcop->cop_line = D_PPP_PL_copline;
04407
04408 PL_hints &= ~HINT_BLOCK_SCOPE;
04409 if (stash)
04410 PL_curstash = PL_curcop->cop_stash = stash;
04411
04412 newSUB(
04413
04414 #if (PERL_BCDVERSION < 0x5003022)
04415 start_subparse(),
04416 #elif (PERL_BCDVERSION == 0x5003022)
04417 start_subparse(0),
04418 #else
04419 start_subparse(FALSE, 0),
04420 #endif
04421
04422 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
04423 newSVOP(OP_CONST, 0, &PL_sv_no),
04424 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
04425 );
04426
04427 PL_hints = oldhints;
04428 PL_curcop->cop_stash = old_cop_stash;
04429 PL_curstash = old_curstash;
04430 PL_curcop->cop_line = oldline;
04431 }
04432 #endif
04433 #endif
04434
04435
04436
04437
04438
04439
04440
04441
04442
04443
04444
04445
04446
04447
04448
04449
04450
04451
04452
04453
04454 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
04455 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
04456
04457 #ifndef START_MY_CXT
04458
04459
04460
04461
04462 #define START_MY_CXT
04463
04464 #if (PERL_BCDVERSION < 0x5004068)
04465
04466 #define dMY_CXT_SV \
04467 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
04468 #else
04469 #define dMY_CXT_SV \
04470 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
04471 sizeof(MY_CXT_KEY)-1, TRUE)
04472 #endif
04473
04474
04475
04476 #define dMY_CXT \
04477 dMY_CXT_SV; \
04478 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
04479
04480
04481
04482
04483 #define MY_CXT_INIT \
04484 dMY_CXT_SV; \
04485 \
04486 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
04487 Zero(my_cxtp, 1, my_cxt_t); \
04488 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
04489
04490
04491
04492 #define MY_CXT (*my_cxtp)
04493
04494
04495
04496 #define pMY_CXT my_cxt_t *my_cxtp
04497 #define pMY_CXT_ pMY_CXT,
04498 #define _pMY_CXT ,pMY_CXT
04499 #define aMY_CXT my_cxtp
04500 #define aMY_CXT_ aMY_CXT,
04501 #define _aMY_CXT ,aMY_CXT
04502
04503 #endif
04504
04505 #ifndef MY_CXT_CLONE
04506
04507 #define MY_CXT_CLONE \
04508 dMY_CXT_SV; \
04509 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
04510 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
04511 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
04512 #endif
04513
04514 #else
04515
04516 #ifndef START_MY_CXT
04517
04518 #define START_MY_CXT static my_cxt_t my_cxt;
04519 #define dMY_CXT_SV dNOOP
04520 #define dMY_CXT dNOOP
04521 #define MY_CXT_INIT NOOP
04522 #define MY_CXT my_cxt
04523
04524 #define pMY_CXT void
04525 #define pMY_CXT_
04526 #define _pMY_CXT
04527 #define aMY_CXT
04528 #define aMY_CXT_
04529 #define _aMY_CXT
04530
04531 #endif
04532
04533 #ifndef MY_CXT_CLONE
04534 #define MY_CXT_CLONE NOOP
04535 #endif
04536
04537 #endif
04538
04539 #ifndef IVdf
04540 # if IVSIZE == LONGSIZE
04541 # define IVdf "ld"
04542 # define UVuf "lu"
04543 # define UVof "lo"
04544 # define UVxf "lx"
04545 # define UVXf "lX"
04546 # else
04547 # if IVSIZE == INTSIZE
04548 # define IVdf "d"
04549 # define UVuf "u"
04550 # define UVof "o"
04551 # define UVxf "x"
04552 # define UVXf "X"
04553 # endif
04554 # endif
04555 #endif
04556
04557 #ifndef NVef
04558 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
04559 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
04560
04561 # define NVef PERL_PRIeldbl
04562 # define NVff PERL_PRIfldbl
04563 # define NVgf PERL_PRIgldbl
04564 # else
04565 # define NVef "e"
04566 # define NVff "f"
04567 # define NVgf "g"
04568 # endif
04569 #endif
04570
04571 #ifndef SvREFCNT_inc
04572 # ifdef PERL_USE_GCC_BRACE_GROUPS
04573 # define SvREFCNT_inc(sv) \
04574 ({ \
04575 SV * const _sv = (SV*)(sv); \
04576 if (_sv) \
04577 (SvREFCNT(_sv))++; \
04578 _sv; \
04579 })
04580 # else
04581 # define SvREFCNT_inc(sv) \
04582 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
04583 # endif
04584 #endif
04585
04586 #ifndef SvREFCNT_inc_simple
04587 # ifdef PERL_USE_GCC_BRACE_GROUPS
04588 # define SvREFCNT_inc_simple(sv) \
04589 ({ \
04590 if (sv) \
04591 (SvREFCNT(sv))++; \
04592 (SV *)(sv); \
04593 })
04594 # else
04595 # define SvREFCNT_inc_simple(sv) \
04596 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
04597 # endif
04598 #endif
04599
04600 #ifndef SvREFCNT_inc_NN
04601 # ifdef PERL_USE_GCC_BRACE_GROUPS
04602 # define SvREFCNT_inc_NN(sv) \
04603 ({ \
04604 SV * const _sv = (SV*)(sv); \
04605 SvREFCNT(_sv)++; \
04606 _sv; \
04607 })
04608 # else
04609 # define SvREFCNT_inc_NN(sv) \
04610 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
04611 # endif
04612 #endif
04613
04614 #ifndef SvREFCNT_inc_void
04615 # ifdef PERL_USE_GCC_BRACE_GROUPS
04616 # define SvREFCNT_inc_void(sv) \
04617 ({ \
04618 SV * const _sv = (SV*)(sv); \
04619 if (_sv) \
04620 (void)(SvREFCNT(_sv)++); \
04621 })
04622 # else
04623 # define SvREFCNT_inc_void(sv) \
04624 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
04625 # endif
04626 #endif
04627 #ifndef SvREFCNT_inc_simple_void
04628 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
04629 #endif
04630
04631 #ifndef SvREFCNT_inc_simple_NN
04632 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
04633 #endif
04634
04635 #ifndef SvREFCNT_inc_void_NN
04636 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
04637 #endif
04638
04639 #ifndef SvREFCNT_inc_simple_void_NN
04640 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
04641 #endif
04642
04643 #if (PERL_BCDVERSION < 0x5006000)
04644 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
04645 #else
04646 # define D_PPP_CONSTPV_ARG(x) (x)
04647 #endif
04648 #ifndef newSVpvn
04649 # define newSVpvn(data,len) ((data) \
04650 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
04651 : newSV(0))
04652 #endif
04653 #ifndef newSVpvn_utf8
04654 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
04655 #endif
04656 #ifndef SVf_UTF8
04657 # define SVf_UTF8 0
04658 #endif
04659
04660 #ifndef newSVpvn_flags
04661
04662 #if defined(NEED_newSVpvn_flags)
04663 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
04664 static
04665 #else
04666 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
04667 #endif
04668
04669 #ifdef newSVpvn_flags
04670 # undef newSVpvn_flags
04671 #endif
04672 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
04673 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
04674
04675 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
04676
04677 SV *
04678 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
04679 {
04680 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
04681 SvFLAGS(sv) |= (flags & SVf_UTF8);
04682 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
04683 }
04684
04685 #endif
04686
04687 #endif
04688
04689
04690 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
04691 # define NEED_sv_2pv_flags
04692 #endif
04693 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
04694 # define NEED_sv_2pv_flags_GLOBAL
04695 #endif
04696
04697
04698
04699
04700 #ifndef sv_2pv_nolen
04701 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
04702 #endif
04703
04704 #ifdef SvPVbyte
04705
04706
04707
04708
04709
04710
04711 #if (PERL_BCDVERSION < 0x5007000)
04712
04713 #if defined(NEED_sv_2pvbyte)
04714 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
04715 static
04716 #else
04717 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
04718 #endif
04719
04720 #ifdef sv_2pvbyte
04721 # undef sv_2pvbyte
04722 #endif
04723 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
04724 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
04725
04726 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
04727
04728 char *
04729 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
04730 {
04731 sv_utf8_downgrade(sv,0);
04732 return SvPV(sv,*lp);
04733 }
04734
04735 #endif
04736
04737
04738
04739
04740
04741 #undef SvPVbyte
04742
04743 #define SvPVbyte(sv, lp) \
04744 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
04745 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
04746
04747 #endif
04748
04749 #else
04750
04751 # define SvPVbyte SvPV
04752 # define sv_2pvbyte sv_2pv
04753
04754 #endif
04755 #ifndef sv_2pvbyte_nolen
04756 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
04757 #endif
04758
04759
04760
04761
04762
04763
04764
04765
04766
04767
04768 #ifndef SV_IMMEDIATE_UNREF
04769 # define SV_IMMEDIATE_UNREF 0
04770 #endif
04771
04772 #ifndef SV_GMAGIC
04773 # define SV_GMAGIC 0
04774 #endif
04775
04776 #ifndef SV_COW_DROP_PV
04777 # define SV_COW_DROP_PV 0
04778 #endif
04779
04780 #ifndef SV_UTF8_NO_ENCODING
04781 # define SV_UTF8_NO_ENCODING 0
04782 #endif
04783
04784 #ifndef SV_NOSTEAL
04785 # define SV_NOSTEAL 0
04786 #endif
04787
04788 #ifndef SV_CONST_RETURN
04789 # define SV_CONST_RETURN 0
04790 #endif
04791
04792 #ifndef SV_MUTABLE_RETURN
04793 # define SV_MUTABLE_RETURN 0
04794 #endif
04795
04796 #ifndef SV_SMAGIC
04797 # define SV_SMAGIC 0
04798 #endif
04799
04800 #ifndef SV_HAS_TRAILING_NUL
04801 # define SV_HAS_TRAILING_NUL 0
04802 #endif
04803
04804 #ifndef SV_COW_SHARED_HASH_KEYS
04805 # define SV_COW_SHARED_HASH_KEYS 0
04806 #endif
04807
04808 #if (PERL_BCDVERSION < 0x5007002)
04809
04810 #if defined(NEED_sv_2pv_flags)
04811 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04812 static
04813 #else
04814 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04815 #endif
04816
04817 #ifdef sv_2pv_flags
04818 # undef sv_2pv_flags
04819 #endif
04820 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
04821 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
04822
04823 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
04824
04825 char *
04826 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
04827 {
04828 STRLEN n_a = (STRLEN) flags;
04829 return sv_2pv(sv, lp ? lp : &n_a);
04830 }
04831
04832 #endif
04833
04834 #if defined(NEED_sv_pvn_force_flags)
04835 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04836 static
04837 #else
04838 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04839 #endif
04840
04841 #ifdef sv_pvn_force_flags
04842 # undef sv_pvn_force_flags
04843 #endif
04844 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
04845 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
04846
04847 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
04848
04849 char *
04850 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
04851 {
04852 STRLEN n_a = (STRLEN) flags;
04853 return sv_pvn_force(sv, lp ? lp : &n_a);
04854 }
04855
04856 #endif
04857
04858 #endif
04859
04860 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
04861 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
04862 #else
04863 # define DPPP_SVPV_NOLEN_LP_ARG 0
04864 #endif
04865 #ifndef SvPV_const
04866 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
04867 #endif
04868
04869 #ifndef SvPV_mutable
04870 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
04871 #endif
04872 #ifndef SvPV_flags
04873 # define SvPV_flags(sv, lp, flags) \
04874 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04875 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
04876 #endif
04877 #ifndef SvPV_flags_const
04878 # define SvPV_flags_const(sv, lp, flags) \
04879 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04880 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
04881 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
04882 #endif
04883 #ifndef SvPV_flags_const_nolen
04884 # define SvPV_flags_const_nolen(sv, flags) \
04885 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04886 ? SvPVX_const(sv) : \
04887 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
04888 #endif
04889 #ifndef SvPV_flags_mutable
04890 # define SvPV_flags_mutable(sv, lp, flags) \
04891 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04892 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
04893 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
04894 #endif
04895 #ifndef SvPV_force
04896 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
04897 #endif
04898
04899 #ifndef SvPV_force_nolen
04900 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
04901 #endif
04902
04903 #ifndef SvPV_force_mutable
04904 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
04905 #endif
04906
04907 #ifndef SvPV_force_nomg
04908 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
04909 #endif
04910
04911 #ifndef SvPV_force_nomg_nolen
04912 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
04913 #endif
04914 #ifndef SvPV_force_flags
04915 # define SvPV_force_flags(sv, lp, flags) \
04916 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
04917 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
04918 #endif
04919 #ifndef SvPV_force_flags_nolen
04920 # define SvPV_force_flags_nolen(sv, flags) \
04921 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
04922 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
04923 #endif
04924 #ifndef SvPV_force_flags_mutable
04925 # define SvPV_force_flags_mutable(sv, lp, flags) \
04926 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
04927 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
04928 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
04929 #endif
04930 #ifndef SvPV_nolen
04931 # define SvPV_nolen(sv) \
04932 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04933 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
04934 #endif
04935 #ifndef SvPV_nolen_const
04936 # define SvPV_nolen_const(sv) \
04937 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
04938 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
04939 #endif
04940 #ifndef SvPV_nomg
04941 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
04942 #endif
04943
04944 #ifndef SvPV_nomg_const
04945 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
04946 #endif
04947
04948 #ifndef SvPV_nomg_const_nolen
04949 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
04950 #endif
04951 #ifndef SvPV_renew
04952 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
04953 SvPV_set((sv), (char *) saferealloc( \
04954 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
04955 } STMT_END
04956 #endif
04957 #ifndef SvMAGIC_set
04958 # define SvMAGIC_set(sv, val) \
04959 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
04960 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
04961 #endif
04962
04963 #if (PERL_BCDVERSION < 0x5009003)
04964 #ifndef SvPVX_const
04965 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
04966 #endif
04967
04968 #ifndef SvPVX_mutable
04969 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
04970 #endif
04971 #ifndef SvRV_set
04972 # define SvRV_set(sv, val) \
04973 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
04974 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
04975 #endif
04976
04977 #else
04978 #ifndef SvPVX_const
04979 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
04980 #endif
04981
04982 #ifndef SvPVX_mutable
04983 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
04984 #endif
04985 #ifndef SvRV_set
04986 # define SvRV_set(sv, val) \
04987 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
04988 ((sv)->sv_u.svu_rv = (val)); } STMT_END
04989 #endif
04990
04991 #endif
04992 #ifndef SvSTASH_set
04993 # define SvSTASH_set(sv, val) \
04994 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
04995 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
04996 #endif
04997
04998 #if (PERL_BCDVERSION < 0x5004000)
04999 #ifndef SvUV_set
05000 # define SvUV_set(sv, val) \
05001 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
05002 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
05003 #endif
05004
05005 #else
05006 #ifndef SvUV_set
05007 # define SvUV_set(sv, val) \
05008 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
05009 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
05010 #endif
05011
05012 #endif
05013
05014 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
05015 #if defined(NEED_vnewSVpvf)
05016 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
05017 static
05018 #else
05019 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
05020 #endif
05021
05022 #ifdef vnewSVpvf
05023 # undef vnewSVpvf
05024 #endif
05025 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
05026 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
05027
05028 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
05029
05030 SV *
05031 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
05032 {
05033 register SV *sv = newSV(0);
05034 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
05035 return sv;
05036 }
05037
05038 #endif
05039 #endif
05040
05041 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
05042 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
05043 #endif
05044
05045 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
05046 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
05047 #endif
05048
05049 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
05050 #if defined(NEED_sv_catpvf_mg)
05051 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05052 static
05053 #else
05054 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05055 #endif
05056
05057 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
05058
05059 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
05060
05061 void
05062 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
05063 {
05064 va_list args;
05065 va_start(args, pat);
05066 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05067 SvSETMAGIC(sv);
05068 va_end(args);
05069 }
05070
05071 #endif
05072 #endif
05073
05074 #ifdef PERL_IMPLICIT_CONTEXT
05075 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
05076 #if defined(NEED_sv_catpvf_mg_nocontext)
05077 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05078 static
05079 #else
05080 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05081 #endif
05082
05083 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
05084 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
05085
05086 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
05087
05088 void
05089 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
05090 {
05091 dTHX;
05092 va_list args;
05093 va_start(args, pat);
05094 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05095 SvSETMAGIC(sv);
05096 va_end(args);
05097 }
05098
05099 #endif
05100 #endif
05101 #endif
05102
05103
05104 #ifndef sv_catpvf_mg
05105 # ifdef PERL_IMPLICIT_CONTEXT
05106 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
05107 # else
05108 # define sv_catpvf_mg Perl_sv_catpvf_mg
05109 # endif
05110 #endif
05111
05112 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
05113 # define sv_vcatpvf_mg(sv, pat, args) \
05114 STMT_START { \
05115 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
05116 SvSETMAGIC(sv); \
05117 } STMT_END
05118 #endif
05119
05120 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
05121 #if defined(NEED_sv_setpvf_mg)
05122 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05123 static
05124 #else
05125 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05126 #endif
05127
05128 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
05129
05130 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
05131
05132 void
05133 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
05134 {
05135 va_list args;
05136 va_start(args, pat);
05137 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05138 SvSETMAGIC(sv);
05139 va_end(args);
05140 }
05141
05142 #endif
05143 #endif
05144
05145 #ifdef PERL_IMPLICIT_CONTEXT
05146 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
05147 #if defined(NEED_sv_setpvf_mg_nocontext)
05148 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05149 static
05150 #else
05151 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05152 #endif
05153
05154 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
05155 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
05156
05157 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
05158
05159 void
05160 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
05161 {
05162 dTHX;
05163 va_list args;
05164 va_start(args, pat);
05165 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05166 SvSETMAGIC(sv);
05167 va_end(args);
05168 }
05169
05170 #endif
05171 #endif
05172 #endif
05173
05174
05175 #ifndef sv_setpvf_mg
05176 # ifdef PERL_IMPLICIT_CONTEXT
05177 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
05178 # else
05179 # define sv_setpvf_mg Perl_sv_setpvf_mg
05180 # endif
05181 #endif
05182
05183 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
05184 # define sv_vsetpvf_mg(sv, pat, args) \
05185 STMT_START { \
05186 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
05187 SvSETMAGIC(sv); \
05188 } STMT_END
05189 #endif
05190
05191 #ifndef newSVpvn_share
05192
05193 #if defined(NEED_newSVpvn_share)
05194 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
05195 static
05196 #else
05197 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
05198 #endif
05199
05200 #ifdef newSVpvn_share
05201 # undef newSVpvn_share
05202 #endif
05203 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
05204 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
05205
05206 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
05207
05208 SV *
05209 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
05210 {
05211 SV *sv;
05212 if (len < 0)
05213 len = -len;
05214 if (!hash)
05215 PERL_HASH(hash, (char*) src, len);
05216 sv = newSVpvn((char *) src, len);
05217 sv_upgrade(sv, SVt_PVIV);
05218 SvIVX(sv) = hash;
05219 SvREADONLY_on(sv);
05220 SvPOK_on(sv);
05221 return sv;
05222 }
05223
05224 #endif
05225
05226 #endif
05227 #ifndef SvSHARED_HASH
05228 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
05229 #endif
05230 #ifndef WARN_ALL
05231 # define WARN_ALL 0
05232 #endif
05233
05234 #ifndef WARN_CLOSURE
05235 # define WARN_CLOSURE 1
05236 #endif
05237
05238 #ifndef WARN_DEPRECATED
05239 # define WARN_DEPRECATED 2
05240 #endif
05241
05242 #ifndef WARN_EXITING
05243 # define WARN_EXITING 3
05244 #endif
05245
05246 #ifndef WARN_GLOB
05247 # define WARN_GLOB 4
05248 #endif
05249
05250 #ifndef WARN_IO
05251 # define WARN_IO 5
05252 #endif
05253
05254 #ifndef WARN_CLOSED
05255 # define WARN_CLOSED 6
05256 #endif
05257
05258 #ifndef WARN_EXEC
05259 # define WARN_EXEC 7
05260 #endif
05261
05262 #ifndef WARN_LAYER
05263 # define WARN_LAYER 8
05264 #endif
05265
05266 #ifndef WARN_NEWLINE
05267 # define WARN_NEWLINE 9
05268 #endif
05269
05270 #ifndef WARN_PIPE
05271 # define WARN_PIPE 10
05272 #endif
05273
05274 #ifndef WARN_UNOPENED
05275 # define WARN_UNOPENED 11
05276 #endif
05277
05278 #ifndef WARN_MISC
05279 # define WARN_MISC 12
05280 #endif
05281
05282 #ifndef WARN_NUMERIC
05283 # define WARN_NUMERIC 13
05284 #endif
05285
05286 #ifndef WARN_ONCE
05287 # define WARN_ONCE 14
05288 #endif
05289
05290 #ifndef WARN_OVERFLOW
05291 # define WARN_OVERFLOW 15
05292 #endif
05293
05294 #ifndef WARN_PACK
05295 # define WARN_PACK 16
05296 #endif
05297
05298 #ifndef WARN_PORTABLE
05299 # define WARN_PORTABLE 17
05300 #endif
05301
05302 #ifndef WARN_RECURSION
05303 # define WARN_RECURSION 18
05304 #endif
05305
05306 #ifndef WARN_REDEFINE
05307 # define WARN_REDEFINE 19
05308 #endif
05309
05310 #ifndef WARN_REGEXP
05311 # define WARN_REGEXP 20
05312 #endif
05313
05314 #ifndef WARN_SEVERE
05315 # define WARN_SEVERE 21
05316 #endif
05317
05318 #ifndef WARN_DEBUGGING
05319 # define WARN_DEBUGGING 22
05320 #endif
05321
05322 #ifndef WARN_INPLACE
05323 # define WARN_INPLACE 23
05324 #endif
05325
05326 #ifndef WARN_INTERNAL
05327 # define WARN_INTERNAL 24
05328 #endif
05329
05330 #ifndef WARN_MALLOC
05331 # define WARN_MALLOC 25
05332 #endif
05333
05334 #ifndef WARN_SIGNAL
05335 # define WARN_SIGNAL 26
05336 #endif
05337
05338 #ifndef WARN_SUBSTR
05339 # define WARN_SUBSTR 27
05340 #endif
05341
05342 #ifndef WARN_SYNTAX
05343 # define WARN_SYNTAX 28
05344 #endif
05345
05346 #ifndef WARN_AMBIGUOUS
05347 # define WARN_AMBIGUOUS 29
05348 #endif
05349
05350 #ifndef WARN_BAREWORD
05351 # define WARN_BAREWORD 30
05352 #endif
05353
05354 #ifndef WARN_DIGIT
05355 # define WARN_DIGIT 31
05356 #endif
05357
05358 #ifndef WARN_PARENTHESIS
05359 # define WARN_PARENTHESIS 32
05360 #endif
05361
05362 #ifndef WARN_PRECEDENCE
05363 # define WARN_PRECEDENCE 33
05364 #endif
05365
05366 #ifndef WARN_PRINTF
05367 # define WARN_PRINTF 34
05368 #endif
05369
05370 #ifndef WARN_PROTOTYPE
05371 # define WARN_PROTOTYPE 35
05372 #endif
05373
05374 #ifndef WARN_QW
05375 # define WARN_QW 36
05376 #endif
05377
05378 #ifndef WARN_RESERVED
05379 # define WARN_RESERVED 37
05380 #endif
05381
05382 #ifndef WARN_SEMICOLON
05383 # define WARN_SEMICOLON 38
05384 #endif
05385
05386 #ifndef WARN_TAINT
05387 # define WARN_TAINT 39
05388 #endif
05389
05390 #ifndef WARN_THREADS
05391 # define WARN_THREADS 40
05392 #endif
05393
05394 #ifndef WARN_UNINITIALIZED
05395 # define WARN_UNINITIALIZED 41
05396 #endif
05397
05398 #ifndef WARN_UNPACK
05399 # define WARN_UNPACK 42
05400 #endif
05401
05402 #ifndef WARN_UNTIE
05403 # define WARN_UNTIE 43
05404 #endif
05405
05406 #ifndef WARN_UTF8
05407 # define WARN_UTF8 44
05408 #endif
05409
05410 #ifndef WARN_VOID
05411 # define WARN_VOID 45
05412 #endif
05413
05414 #ifndef WARN_ASSERTIONS
05415 # define WARN_ASSERTIONS 46
05416 #endif
05417 #ifndef packWARN
05418 # define packWARN(a) (a)
05419 #endif
05420
05421 #ifndef ckWARN
05422 # ifdef G_WARN_ON
05423 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
05424 # else
05425 # define ckWARN(a) PL_dowarn
05426 # endif
05427 #endif
05428
05429 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
05430 #if defined(NEED_warner)
05431 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
05432 static
05433 #else
05434 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
05435 #endif
05436
05437 #define Perl_warner DPPP_(my_warner)
05438
05439 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
05440
05441 void
05442 DPPP_(my_warner)(U32 err, const char *pat, ...)
05443 {
05444 SV *sv;
05445 va_list args;
05446
05447 PERL_UNUSED_ARG(err);
05448
05449 va_start(args, pat);
05450 sv = vnewSVpvf(pat, &args);
05451 va_end(args);
05452 sv_2mortal(sv);
05453 warn("%s", SvPV_nolen(sv));
05454 }
05455
05456 #define warner Perl_warner
05457
05458 #define Perl_warner_nocontext Perl_warner
05459
05460 #endif
05461 #endif
05462
05463
05464
05465
05466
05467 #ifndef STR_WITH_LEN
05468 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
05469 #endif
05470 #ifndef newSVpvs
05471 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
05472 #endif
05473
05474 #ifndef newSVpvs_flags
05475 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
05476 #endif
05477
05478 #ifndef sv_catpvs
05479 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
05480 #endif
05481
05482 #ifndef sv_setpvs
05483 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
05484 #endif
05485
05486 #ifndef hv_fetchs
05487 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
05488 #endif
05489
05490 #ifndef hv_stores
05491 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
05492 #endif
05493 #ifndef SvGETMAGIC
05494 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
05495 #endif
05496 #ifndef PERL_MAGIC_sv
05497 # define PERL_MAGIC_sv '\0'
05498 #endif
05499
05500 #ifndef PERL_MAGIC_overload
05501 # define PERL_MAGIC_overload 'A'
05502 #endif
05503
05504 #ifndef PERL_MAGIC_overload_elem
05505 # define PERL_MAGIC_overload_elem 'a'
05506 #endif
05507
05508 #ifndef PERL_MAGIC_overload_table
05509 # define PERL_MAGIC_overload_table 'c'
05510 #endif
05511
05512 #ifndef PERL_MAGIC_bm
05513 # define PERL_MAGIC_bm 'B'
05514 #endif
05515
05516 #ifndef PERL_MAGIC_regdata
05517 # define PERL_MAGIC_regdata 'D'
05518 #endif
05519
05520 #ifndef PERL_MAGIC_regdatum
05521 # define PERL_MAGIC_regdatum 'd'
05522 #endif
05523
05524 #ifndef PERL_MAGIC_env
05525 # define PERL_MAGIC_env 'E'
05526 #endif
05527
05528 #ifndef PERL_MAGIC_envelem
05529 # define PERL_MAGIC_envelem 'e'
05530 #endif
05531
05532 #ifndef PERL_MAGIC_fm
05533 # define PERL_MAGIC_fm 'f'
05534 #endif
05535
05536 #ifndef PERL_MAGIC_regex_global
05537 # define PERL_MAGIC_regex_global 'g'
05538 #endif
05539
05540 #ifndef PERL_MAGIC_isa
05541 # define PERL_MAGIC_isa 'I'
05542 #endif
05543
05544 #ifndef PERL_MAGIC_isaelem
05545 # define PERL_MAGIC_isaelem 'i'
05546 #endif
05547
05548 #ifndef PERL_MAGIC_nkeys
05549 # define PERL_MAGIC_nkeys 'k'
05550 #endif
05551
05552 #ifndef PERL_MAGIC_dbfile
05553 # define PERL_MAGIC_dbfile 'L'
05554 #endif
05555
05556 #ifndef PERL_MAGIC_dbline
05557 # define PERL_MAGIC_dbline 'l'
05558 #endif
05559
05560 #ifndef PERL_MAGIC_mutex
05561 # define PERL_MAGIC_mutex 'm'
05562 #endif
05563
05564 #ifndef PERL_MAGIC_shared
05565 # define PERL_MAGIC_shared 'N'
05566 #endif
05567
05568 #ifndef PERL_MAGIC_shared_scalar
05569 # define PERL_MAGIC_shared_scalar 'n'
05570 #endif
05571
05572 #ifndef PERL_MAGIC_collxfrm
05573 # define PERL_MAGIC_collxfrm 'o'
05574 #endif
05575
05576 #ifndef PERL_MAGIC_tied
05577 # define PERL_MAGIC_tied 'P'
05578 #endif
05579
05580 #ifndef PERL_MAGIC_tiedelem
05581 # define PERL_MAGIC_tiedelem 'p'
05582 #endif
05583
05584 #ifndef PERL_MAGIC_tiedscalar
05585 # define PERL_MAGIC_tiedscalar 'q'
05586 #endif
05587
05588 #ifndef PERL_MAGIC_qr
05589 # define PERL_MAGIC_qr 'r'
05590 #endif
05591
05592 #ifndef PERL_MAGIC_sig
05593 # define PERL_MAGIC_sig 'S'
05594 #endif
05595
05596 #ifndef PERL_MAGIC_sigelem
05597 # define PERL_MAGIC_sigelem 's'
05598 #endif
05599
05600 #ifndef PERL_MAGIC_taint
05601 # define PERL_MAGIC_taint 't'
05602 #endif
05603
05604 #ifndef PERL_MAGIC_uvar
05605 # define PERL_MAGIC_uvar 'U'
05606 #endif
05607
05608 #ifndef PERL_MAGIC_uvar_elem
05609 # define PERL_MAGIC_uvar_elem 'u'
05610 #endif
05611
05612 #ifndef PERL_MAGIC_vstring
05613 # define PERL_MAGIC_vstring 'V'
05614 #endif
05615
05616 #ifndef PERL_MAGIC_vec
05617 # define PERL_MAGIC_vec 'v'
05618 #endif
05619
05620 #ifndef PERL_MAGIC_utf8
05621 # define PERL_MAGIC_utf8 'w'
05622 #endif
05623
05624 #ifndef PERL_MAGIC_substr
05625 # define PERL_MAGIC_substr 'x'
05626 #endif
05627
05628 #ifndef PERL_MAGIC_defelem
05629 # define PERL_MAGIC_defelem 'y'
05630 #endif
05631
05632 #ifndef PERL_MAGIC_glob
05633 # define PERL_MAGIC_glob '*'
05634 #endif
05635
05636 #ifndef PERL_MAGIC_arylen
05637 # define PERL_MAGIC_arylen '#'
05638 #endif
05639
05640 #ifndef PERL_MAGIC_pos
05641 # define PERL_MAGIC_pos '.'
05642 #endif
05643
05644 #ifndef PERL_MAGIC_backref
05645 # define PERL_MAGIC_backref '<'
05646 #endif
05647
05648 #ifndef PERL_MAGIC_ext
05649 # define PERL_MAGIC_ext '~'
05650 #endif
05651
05652
05653 #ifndef sv_catpvn_nomg
05654 # define sv_catpvn_nomg sv_catpvn
05655 #endif
05656
05657 #ifndef sv_catsv_nomg
05658 # define sv_catsv_nomg sv_catsv
05659 #endif
05660
05661 #ifndef sv_setsv_nomg
05662 # define sv_setsv_nomg sv_setsv
05663 #endif
05664
05665 #ifndef sv_pvn_nomg
05666 # define sv_pvn_nomg sv_pvn
05667 #endif
05668
05669 #ifndef SvIV_nomg
05670 # define SvIV_nomg SvIV
05671 #endif
05672
05673 #ifndef SvUV_nomg
05674 # define SvUV_nomg SvUV
05675 #endif
05676
05677 #ifndef sv_catpv_mg
05678 # define sv_catpv_mg(sv, ptr) \
05679 STMT_START { \
05680 SV *TeMpSv = sv; \
05681 sv_catpv(TeMpSv,ptr); \
05682 SvSETMAGIC(TeMpSv); \
05683 } STMT_END
05684 #endif
05685
05686 #ifndef sv_catpvn_mg
05687 # define sv_catpvn_mg(sv, ptr, len) \
05688 STMT_START { \
05689 SV *TeMpSv = sv; \
05690 sv_catpvn(TeMpSv,ptr,len); \
05691 SvSETMAGIC(TeMpSv); \
05692 } STMT_END
05693 #endif
05694
05695 #ifndef sv_catsv_mg
05696 # define sv_catsv_mg(dsv, ssv) \
05697 STMT_START { \
05698 SV *TeMpSv = dsv; \
05699 sv_catsv(TeMpSv,ssv); \
05700 SvSETMAGIC(TeMpSv); \
05701 } STMT_END
05702 #endif
05703
05704 #ifndef sv_setiv_mg
05705 # define sv_setiv_mg(sv, i) \
05706 STMT_START { \
05707 SV *TeMpSv = sv; \
05708 sv_setiv(TeMpSv,i); \
05709 SvSETMAGIC(TeMpSv); \
05710 } STMT_END
05711 #endif
05712
05713 #ifndef sv_setnv_mg
05714 # define sv_setnv_mg(sv, num) \
05715 STMT_START { \
05716 SV *TeMpSv = sv; \
05717 sv_setnv(TeMpSv,num); \
05718 SvSETMAGIC(TeMpSv); \
05719 } STMT_END
05720 #endif
05721
05722 #ifndef sv_setpv_mg
05723 # define sv_setpv_mg(sv, ptr) \
05724 STMT_START { \
05725 SV *TeMpSv = sv; \
05726 sv_setpv(TeMpSv,ptr); \
05727 SvSETMAGIC(TeMpSv); \
05728 } STMT_END
05729 #endif
05730
05731 #ifndef sv_setpvn_mg
05732 # define sv_setpvn_mg(sv, ptr, len) \
05733 STMT_START { \
05734 SV *TeMpSv = sv; \
05735 sv_setpvn(TeMpSv,ptr,len); \
05736 SvSETMAGIC(TeMpSv); \
05737 } STMT_END
05738 #endif
05739
05740 #ifndef sv_setsv_mg
05741 # define sv_setsv_mg(dsv, ssv) \
05742 STMT_START { \
05743 SV *TeMpSv = dsv; \
05744 sv_setsv(TeMpSv,ssv); \
05745 SvSETMAGIC(TeMpSv); \
05746 } STMT_END
05747 #endif
05748
05749 #ifndef sv_setuv_mg
05750 # define sv_setuv_mg(sv, i) \
05751 STMT_START { \
05752 SV *TeMpSv = sv; \
05753 sv_setuv(TeMpSv,i); \
05754 SvSETMAGIC(TeMpSv); \
05755 } STMT_END
05756 #endif
05757
05758 #ifndef sv_usepvn_mg
05759 # define sv_usepvn_mg(sv, ptr, len) \
05760 STMT_START { \
05761 SV *TeMpSv = sv; \
05762 sv_usepvn(TeMpSv,ptr,len); \
05763 SvSETMAGIC(TeMpSv); \
05764 } STMT_END
05765 #endif
05766 #ifndef SvVSTRING_mg
05767 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
05768 #endif
05769
05770
05771
05772
05773
05774
05775
05776
05777
05778
05779
05780 #if (PERL_BCDVERSION < 0x5004000)
05781
05782
05783
05784 #elif (PERL_BCDVERSION < 0x5008000)
05785
05786 # define sv_magic_portable(sv, obj, how, name, namlen) \
05787 STMT_START { \
05788 SV *SvMp_sv = (sv); \
05789 char *SvMp_name = (char *) (name); \
05790 I32 SvMp_namlen = (namlen); \
05791 if (SvMp_name && SvMp_namlen == 0) \
05792 { \
05793 MAGIC *mg; \
05794 sv_magic(SvMp_sv, obj, how, 0, 0); \
05795 mg = SvMAGIC(SvMp_sv); \
05796 mg->mg_len = -42; \
05797 mg->mg_ptr = SvMp_name; \
05798 } \
05799 else \
05800 { \
05801 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
05802 } \
05803 } STMT_END
05804
05805 #else
05806
05807 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
05808
05809 #endif
05810
05811 #ifdef USE_ITHREADS
05812 #ifndef CopFILE
05813 # define CopFILE(c) ((c)->cop_file)
05814 #endif
05815
05816 #ifndef CopFILEGV
05817 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
05818 #endif
05819
05820 #ifndef CopFILE_set
05821 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
05822 #endif
05823
05824 #ifndef CopFILESV
05825 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
05826 #endif
05827
05828 #ifndef CopFILEAV
05829 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
05830 #endif
05831
05832 #ifndef CopSTASHPV
05833 # define CopSTASHPV(c) ((c)->cop_stashpv)
05834 #endif
05835
05836 #ifndef CopSTASHPV_set
05837 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
05838 #endif
05839
05840 #ifndef CopSTASH
05841 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
05842 #endif
05843
05844 #ifndef CopSTASH_set
05845 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
05846 #endif
05847
05848 #ifndef CopSTASH_eq
05849 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
05850 || (CopSTASHPV(c) && HvNAME(hv) \
05851 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
05852 #endif
05853
05854 #else
05855 #ifndef CopFILEGV
05856 # define CopFILEGV(c) ((c)->cop_filegv)
05857 #endif
05858
05859 #ifndef CopFILEGV_set
05860 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
05861 #endif
05862
05863 #ifndef CopFILE_set
05864 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
05865 #endif
05866
05867 #ifndef CopFILESV
05868 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
05869 #endif
05870
05871 #ifndef CopFILEAV
05872 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
05873 #endif
05874
05875 #ifndef CopFILE
05876 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
05877 #endif
05878
05879 #ifndef CopSTASH
05880 # define CopSTASH(c) ((c)->cop_stash)
05881 #endif
05882
05883 #ifndef CopSTASH_set
05884 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
05885 #endif
05886
05887 #ifndef CopSTASHPV
05888 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
05889 #endif
05890
05891 #ifndef CopSTASHPV_set
05892 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
05893 #endif
05894
05895 #ifndef CopSTASH_eq
05896 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
05897 #endif
05898
05899 #endif
05900 #ifndef IN_PERL_COMPILETIME
05901 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
05902 #endif
05903
05904 #ifndef IN_LOCALE_RUNTIME
05905 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
05906 #endif
05907
05908 #ifndef IN_LOCALE_COMPILETIME
05909 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
05910 #endif
05911
05912 #ifndef IN_LOCALE
05913 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
05914 #endif
05915 #ifndef IS_NUMBER_IN_UV
05916 # define IS_NUMBER_IN_UV 0x01
05917 #endif
05918
05919 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
05920 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
05921 #endif
05922
05923 #ifndef IS_NUMBER_NOT_INT
05924 # define IS_NUMBER_NOT_INT 0x04
05925 #endif
05926
05927 #ifndef IS_NUMBER_NEG
05928 # define IS_NUMBER_NEG 0x08
05929 #endif
05930
05931 #ifndef IS_NUMBER_INFINITY
05932 # define IS_NUMBER_INFINITY 0x10
05933 #endif
05934
05935 #ifndef IS_NUMBER_NAN
05936 # define IS_NUMBER_NAN 0x20
05937 #endif
05938 #ifndef GROK_NUMERIC_RADIX
05939 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
05940 #endif
05941 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
05942 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
05943 #endif
05944
05945 #ifndef PERL_SCAN_SILENT_ILLDIGIT
05946 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
05947 #endif
05948
05949 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
05950 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
05951 #endif
05952
05953 #ifndef PERL_SCAN_DISALLOW_PREFIX
05954 # define PERL_SCAN_DISALLOW_PREFIX 0x02
05955 #endif
05956
05957 #ifndef grok_numeric_radix
05958 #if defined(NEED_grok_numeric_radix)
05959 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
05960 static
05961 #else
05962 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
05963 #endif
05964
05965 #ifdef grok_numeric_radix
05966 # undef grok_numeric_radix
05967 #endif
05968 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
05969 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
05970
05971 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
05972 bool
05973 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
05974 {
05975 #ifdef USE_LOCALE_NUMERIC
05976 #ifdef PL_numeric_radix_sv
05977 if (PL_numeric_radix_sv && IN_LOCALE) {
05978 STRLEN len;
05979 char* radix = SvPV(PL_numeric_radix_sv, len);
05980 if (*sp + len <= send && memEQ(*sp, radix, len)) {
05981 *sp += len;
05982 return TRUE;
05983 }
05984 }
05985 #else
05986
05987
05988
05989 #include <locale.h>
05990 dTHR;
05991 struct lconv *lc = localeconv();
05992 char *radix = lc->decimal_point;
05993 if (radix && IN_LOCALE) {
05994 STRLEN len = strlen(radix);
05995 if (*sp + len <= send && memEQ(*sp, radix, len)) {
05996 *sp += len;
05997 return TRUE;
05998 }
05999 }
06000 #endif
06001 #endif
06002
06003
06004 if (*sp < send && **sp == '.') {
06005 ++*sp;
06006 return TRUE;
06007 }
06008 return FALSE;
06009 }
06010 #endif
06011 #endif
06012
06013 #ifndef grok_number
06014 #if defined(NEED_grok_number)
06015 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
06016 static
06017 #else
06018 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
06019 #endif
06020
06021 #ifdef grok_number
06022 # undef grok_number
06023 #endif
06024 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
06025 #define Perl_grok_number DPPP_(my_grok_number)
06026
06027 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
06028 int
06029 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
06030 {
06031 const char *s = pv;
06032 const char *send = pv + len;
06033 const UV max_div_10 = UV_MAX / 10;
06034 const char max_mod_10 = UV_MAX % 10;
06035 int numtype = 0;
06036 int sawinf = 0;
06037 int sawnan = 0;
06038
06039 while (s < send && isSPACE(*s))
06040 s++;
06041 if (s == send) {
06042 return 0;
06043 } else if (*s == '-') {
06044 s++;
06045 numtype = IS_NUMBER_NEG;
06046 }
06047 else if (*s == '+')
06048 s++;
06049
06050 if (s == send)
06051 return 0;
06052
06053
06054 if (isDIGIT(*s)) {
06055
06056
06057 UV value = *s - '0';
06058
06059
06060
06061
06062
06063 if (++s < send) {
06064 int digit = *s - '0';
06065 if (digit >= 0 && digit <= 9) {
06066 value = value * 10 + digit;
06067 if (++s < send) {
06068 digit = *s - '0';
06069 if (digit >= 0 && digit <= 9) {
06070 value = value * 10 + digit;
06071 if (++s < send) {
06072 digit = *s - '0';
06073 if (digit >= 0 && digit <= 9) {
06074 value = value * 10 + digit;
06075 if (++s < send) {
06076 digit = *s - '0';
06077 if (digit >= 0 && digit <= 9) {
06078 value = value * 10 + digit;
06079 if (++s < send) {
06080 digit = *s - '0';
06081 if (digit >= 0 && digit <= 9) {
06082 value = value * 10 + digit;
06083 if (++s < send) {
06084 digit = *s - '0';
06085 if (digit >= 0 && digit <= 9) {
06086 value = value * 10 + digit;
06087 if (++s < send) {
06088 digit = *s - '0';
06089 if (digit >= 0 && digit <= 9) {
06090 value = value * 10 + digit;
06091 if (++s < send) {
06092 digit = *s - '0';
06093 if (digit >= 0 && digit <= 9) {
06094 value = value * 10 + digit;
06095 if (++s < send) {
06096
06097
06098 digit = *s - '0';
06099 while (digit >= 0 && digit <= 9
06100 && (value < max_div_10
06101 || (value == max_div_10
06102 && digit <= max_mod_10))) {
06103 value = value * 10 + digit;
06104 if (++s < send)
06105 digit = *s - '0';
06106 else
06107 break;
06108 }
06109 if (digit >= 0 && digit <= 9
06110 && (s < send)) {
06111
06112
06113
06114 do {
06115 s++;
06116 } while (s < send && isDIGIT(*s));
06117 numtype |=
06118 IS_NUMBER_GREATER_THAN_UV_MAX;
06119 goto skip_value;
06120 }
06121 }
06122 }
06123 }
06124 }
06125 }
06126 }
06127 }
06128 }
06129 }
06130 }
06131 }
06132 }
06133 }
06134 }
06135 }
06136 }
06137 }
06138 numtype |= IS_NUMBER_IN_UV;
06139 if (valuep)
06140 *valuep = value;
06141
06142 skip_value:
06143 if (GROK_NUMERIC_RADIX(&s, send)) {
06144 numtype |= IS_NUMBER_NOT_INT;
06145 while (s < send && isDIGIT(*s))
06146 s++;
06147 }
06148 }
06149 else if (GROK_NUMERIC_RADIX(&s, send)) {
06150 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV;
06151
06152 if (s < send && isDIGIT(*s)) {
06153 do {
06154 s++;
06155 } while (s < send && isDIGIT(*s));
06156 if (valuep) {
06157
06158 *valuep = 0;
06159 }
06160 }
06161 else
06162 return 0;
06163 } else if (*s == 'I' || *s == 'i') {
06164 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06165 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
06166 s++; if (s < send && (*s == 'I' || *s == 'i')) {
06167 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06168 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
06169 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
06170 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
06171 s++;
06172 }
06173 sawinf = 1;
06174 } else if (*s == 'N' || *s == 'n') {
06175
06176 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
06177 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06178 s++;
06179 sawnan = 1;
06180 } else
06181 return 0;
06182
06183 if (sawinf) {
06184 numtype &= IS_NUMBER_NEG;
06185 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
06186 } else if (sawnan) {
06187 numtype &= IS_NUMBER_NEG;
06188 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
06189 } else if (s < send) {
06190
06191 if (*s == 'e' || *s == 'E') {
06192
06193 numtype &= IS_NUMBER_NEG;
06194 numtype |= IS_NUMBER_NOT_INT;
06195 s++;
06196 if (s < send && (*s == '-' || *s == '+'))
06197 s++;
06198 if (s < send && isDIGIT(*s)) {
06199 do {
06200 s++;
06201 } while (s < send && isDIGIT(*s));
06202 }
06203 else
06204 return 0;
06205 }
06206 }
06207 while (s < send && isSPACE(*s))
06208 s++;
06209 if (s >= send)
06210 return numtype;
06211 if (len == 10 && memEQ(pv, "0 but true", 10)) {
06212 if (valuep)
06213 *valuep = 0;
06214 return IS_NUMBER_IN_UV;
06215 }
06216 return 0;
06217 }
06218 #endif
06219 #endif
06220
06221
06222
06223
06224
06225
06226
06227 #ifndef grok_bin
06228 #if defined(NEED_grok_bin)
06229 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06230 static
06231 #else
06232 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06233 #endif
06234
06235 #ifdef grok_bin
06236 # undef grok_bin
06237 #endif
06238 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
06239 #define Perl_grok_bin DPPP_(my_grok_bin)
06240
06241 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
06242 UV
06243 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06244 {
06245 const char *s = start;
06246 STRLEN len = *len_p;
06247 UV value = 0;
06248 NV value_nv = 0;
06249
06250 const UV max_div_2 = UV_MAX / 2;
06251 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06252 bool overflowed = FALSE;
06253
06254 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
06255
06256
06257
06258 if (len >= 1) {
06259 if (s[0] == 'b') {
06260 s++;
06261 len--;
06262 }
06263 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
06264 s+=2;
06265 len-=2;
06266 }
06267 }
06268 }
06269
06270 for (; len-- && *s; s++) {
06271 char bit = *s;
06272 if (bit == '0' || bit == '1') {
06273
06274
06275
06276 redo:
06277 if (!overflowed) {
06278 if (value <= max_div_2) {
06279 value = (value << 1) | (bit - '0');
06280 continue;
06281 }
06282
06283 warn("Integer overflow in binary number");
06284 overflowed = TRUE;
06285 value_nv = (NV) value;
06286 }
06287 value_nv *= 2.0;
06288
06289
06290
06291
06292
06293
06294 value_nv += (NV)(bit - '0');
06295 continue;
06296 }
06297 if (bit == '_' && len && allow_underscores && (bit = s[1])
06298 && (bit == '0' || bit == '1'))
06299 {
06300 --len;
06301 ++s;
06302 goto redo;
06303 }
06304 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06305 warn("Illegal binary digit '%c' ignored", *s);
06306 break;
06307 }
06308
06309 if ( ( overflowed && value_nv > 4294967295.0)
06310 #if UVSIZE > 4
06311 || (!overflowed && value > 0xffffffff )
06312 #endif
06313 ) {
06314 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
06315 }
06316 *len_p = s - start;
06317 if (!overflowed) {
06318 *flags = 0;
06319 return value;
06320 }
06321 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06322 if (result)
06323 *result = value_nv;
06324 return UV_MAX;
06325 }
06326 #endif
06327 #endif
06328
06329 #ifndef grok_hex
06330 #if defined(NEED_grok_hex)
06331 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06332 static
06333 #else
06334 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06335 #endif
06336
06337 #ifdef grok_hex
06338 # undef grok_hex
06339 #endif
06340 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
06341 #define Perl_grok_hex DPPP_(my_grok_hex)
06342
06343 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
06344 UV
06345 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06346 {
06347 const char *s = start;
06348 STRLEN len = *len_p;
06349 UV value = 0;
06350 NV value_nv = 0;
06351
06352 const UV max_div_16 = UV_MAX / 16;
06353 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06354 bool overflowed = FALSE;
06355 const char *xdigit;
06356
06357 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
06358
06359
06360
06361 if (len >= 1) {
06362 if (s[0] == 'x') {
06363 s++;
06364 len--;
06365 }
06366 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
06367 s+=2;
06368 len-=2;
06369 }
06370 }
06371 }
06372
06373 for (; len-- && *s; s++) {
06374 xdigit = strchr((char *) PL_hexdigit, *s);
06375 if (xdigit) {
06376
06377
06378
06379 redo:
06380 if (!overflowed) {
06381 if (value <= max_div_16) {
06382 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
06383 continue;
06384 }
06385 warn("Integer overflow in hexadecimal number");
06386 overflowed = TRUE;
06387 value_nv = (NV) value;
06388 }
06389 value_nv *= 16.0;
06390
06391
06392
06393
06394
06395
06396 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
06397 continue;
06398 }
06399 if (*s == '_' && len && allow_underscores && s[1]
06400 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
06401 {
06402 --len;
06403 ++s;
06404 goto redo;
06405 }
06406 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06407 warn("Illegal hexadecimal digit '%c' ignored", *s);
06408 break;
06409 }
06410
06411 if ( ( overflowed && value_nv > 4294967295.0)
06412 #if UVSIZE > 4
06413 || (!overflowed && value > 0xffffffff )
06414 #endif
06415 ) {
06416 warn("Hexadecimal number > 0xffffffff non-portable");
06417 }
06418 *len_p = s - start;
06419 if (!overflowed) {
06420 *flags = 0;
06421 return value;
06422 }
06423 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06424 if (result)
06425 *result = value_nv;
06426 return UV_MAX;
06427 }
06428 #endif
06429 #endif
06430
06431 #ifndef grok_oct
06432 #if defined(NEED_grok_oct)
06433 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06434 static
06435 #else
06436 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06437 #endif
06438
06439 #ifdef grok_oct
06440 # undef grok_oct
06441 #endif
06442 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
06443 #define Perl_grok_oct DPPP_(my_grok_oct)
06444
06445 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
06446 UV
06447 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06448 {
06449 const char *s = start;
06450 STRLEN len = *len_p;
06451 UV value = 0;
06452 NV value_nv = 0;
06453
06454 const UV max_div_8 = UV_MAX / 8;
06455 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06456 bool overflowed = FALSE;
06457
06458 for (; len-- && *s; s++) {
06459
06460
06461 int digit = *s - '0';
06462 if (digit >= 0 && digit <= 7) {
06463
06464
06465
06466 redo:
06467 if (!overflowed) {
06468 if (value <= max_div_8) {
06469 value = (value << 3) | digit;
06470 continue;
06471 }
06472
06473 warn("Integer overflow in octal number");
06474 overflowed = TRUE;
06475 value_nv = (NV) value;
06476 }
06477 value_nv *= 8.0;
06478
06479
06480
06481
06482
06483
06484 value_nv += (NV)digit;
06485 continue;
06486 }
06487 if (digit == ('_' - '0') && len && allow_underscores
06488 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
06489 {
06490 --len;
06491 ++s;
06492 goto redo;
06493 }
06494
06495
06496
06497 if (digit == 8 || digit == 9) {
06498 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06499 warn("Illegal octal digit '%c' ignored", *s);
06500 }
06501 break;
06502 }
06503
06504 if ( ( overflowed && value_nv > 4294967295.0)
06505 #if UVSIZE > 4
06506 || (!overflowed && value > 0xffffffff )
06507 #endif
06508 ) {
06509 warn("Octal number > 037777777777 non-portable");
06510 }
06511 *len_p = s - start;
06512 if (!overflowed) {
06513 *flags = 0;
06514 return value;
06515 }
06516 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06517 if (result)
06518 *result = value_nv;
06519 return UV_MAX;
06520 }
06521 #endif
06522 #endif
06523
06524 #if !defined(my_snprintf)
06525 #if defined(NEED_my_snprintf)
06526 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
06527 static
06528 #else
06529 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
06530 #endif
06531
06532 #define my_snprintf DPPP_(my_my_snprintf)
06533 #define Perl_my_snprintf DPPP_(my_my_snprintf)
06534
06535 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
06536
06537 int
06538 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
06539 {
06540 dTHX;
06541 int retval;
06542 va_list ap;
06543 va_start(ap, format);
06544 #ifdef HAS_VSNPRINTF
06545 retval = vsnprintf(buffer, len, format, ap);
06546 #else
06547 retval = vsprintf(buffer, format, ap);
06548 #endif
06549 va_end(ap);
06550 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
06551 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
06552 return retval;
06553 }
06554
06555 #endif
06556 #endif
06557
06558 #if !defined(my_sprintf)
06559 #if defined(NEED_my_sprintf)
06560 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
06561 static
06562 #else
06563 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
06564 #endif
06565
06566 #define my_sprintf DPPP_(my_my_sprintf)
06567 #define Perl_my_sprintf DPPP_(my_my_sprintf)
06568
06569 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
06570
06571 int
06572 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
06573 {
06574 va_list args;
06575 va_start(args, pat);
06576 vsprintf(buffer, pat, args);
06577 va_end(args);
06578 return strlen(buffer);
06579 }
06580
06581 #endif
06582 #endif
06583
06584 #ifdef NO_XSLOCKS
06585 # ifdef dJMPENV
06586 # define dXCPT dJMPENV; int rEtV = 0
06587 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
06588 # define XCPT_TRY_END JMPENV_POP;
06589 # define XCPT_CATCH if (rEtV != 0)
06590 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
06591 # else
06592 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
06593 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
06594 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
06595 # define XCPT_CATCH if (rEtV != 0)
06596 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
06597 # endif
06598 #endif
06599
06600 #if !defined(my_strlcat)
06601 #if defined(NEED_my_strlcat)
06602 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
06603 static
06604 #else
06605 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
06606 #endif
06607
06608 #define my_strlcat DPPP_(my_my_strlcat)
06609 #define Perl_my_strlcat DPPP_(my_my_strlcat)
06610
06611 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
06612
06613 Size_t
06614 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
06615 {
06616 Size_t used, length, copy;
06617
06618 used = strlen(dst);
06619 length = strlen(src);
06620 if (size > 0 && used < size - 1) {
06621 copy = (length >= size - used) ? size - used - 1 : length;
06622 memcpy(dst + used, src, copy);
06623 dst[used + copy] = '\0';
06624 }
06625 return used + length;
06626 }
06627 #endif
06628 #endif
06629
06630 #if !defined(my_strlcpy)
06631 #if defined(NEED_my_strlcpy)
06632 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
06633 static
06634 #else
06635 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
06636 #endif
06637
06638 #define my_strlcpy DPPP_(my_my_strlcpy)
06639 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
06640
06641 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
06642
06643 Size_t
06644 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
06645 {
06646 Size_t length, copy;
06647
06648 length = strlen(src);
06649 if (size > 0) {
06650 copy = (length >= size) ? size - 1 : length;
06651 memcpy(dst, src, copy);
06652 dst[copy] = '\0';
06653 }
06654 return length;
06655 }
06656
06657 #endif
06658 #endif
06659 #ifndef PERL_PV_ESCAPE_QUOTE
06660 # define PERL_PV_ESCAPE_QUOTE 0x0001
06661 #endif
06662
06663 #ifndef PERL_PV_PRETTY_QUOTE
06664 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
06665 #endif
06666
06667 #ifndef PERL_PV_PRETTY_ELLIPSES
06668 # define PERL_PV_PRETTY_ELLIPSES 0x0002
06669 #endif
06670
06671 #ifndef PERL_PV_PRETTY_LTGT
06672 # define PERL_PV_PRETTY_LTGT 0x0004
06673 #endif
06674
06675 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
06676 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
06677 #endif
06678
06679 #ifndef PERL_PV_ESCAPE_UNI
06680 # define PERL_PV_ESCAPE_UNI 0x0100
06681 #endif
06682
06683 #ifndef PERL_PV_ESCAPE_UNI_DETECT
06684 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
06685 #endif
06686
06687 #ifndef PERL_PV_ESCAPE_ALL
06688 # define PERL_PV_ESCAPE_ALL 0x1000
06689 #endif
06690
06691 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
06692 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
06693 #endif
06694
06695 #ifndef PERL_PV_ESCAPE_NOCLEAR
06696 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
06697 #endif
06698
06699 #ifndef PERL_PV_ESCAPE_RE
06700 # define PERL_PV_ESCAPE_RE 0x8000
06701 #endif
06702
06703 #ifndef PERL_PV_PRETTY_NOCLEAR
06704 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
06705 #endif
06706 #ifndef PERL_PV_PRETTY_DUMP
06707 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
06708 #endif
06709
06710 #ifndef PERL_PV_PRETTY_REGPROP
06711 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
06712 #endif
06713
06714
06715
06716
06717
06718
06719
06720 #ifndef pv_escape
06721 #if defined(NEED_pv_escape)
06722 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
06723 static
06724 #else
06725 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
06726 #endif
06727
06728 #ifdef pv_escape
06729 # undef pv_escape
06730 #endif
06731 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
06732 #define Perl_pv_escape DPPP_(my_pv_escape)
06733
06734 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
06735
06736 char *
06737 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
06738 const STRLEN count, const STRLEN max,
06739 STRLEN * const escaped, const U32 flags)
06740 {
06741 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
06742 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
06743 char octbuf[32] = "%123456789ABCDF";
06744 STRLEN wrote = 0;
06745 STRLEN chsize = 0;
06746 STRLEN readsize = 1;
06747 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06748 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
06749 #endif
06750 const char *pv = str;
06751 const char * const end = pv + count;
06752 octbuf[0] = esc;
06753
06754 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
06755 sv_setpvs(dsv, "");
06756
06757 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06758 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
06759 isuni = 1;
06760 #endif
06761
06762 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
06763 const UV u =
06764 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06765 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
06766 #endif
06767 (U8)*pv;
06768 const U8 c = (U8)u & 0xFF;
06769
06770 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
06771 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
06772 chsize = my_snprintf(octbuf, sizeof octbuf,
06773 "%"UVxf, u);
06774 else
06775 chsize = my_snprintf(octbuf, sizeof octbuf,
06776 "%cx{%"UVxf"}", esc, u);
06777 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
06778 chsize = 1;
06779 } else {
06780 if (c == dq || c == esc || !isPRINT(c)) {
06781 chsize = 2;
06782 switch (c) {
06783 case '\\' :
06784 case '%' : if (c == esc)
06785 octbuf[1] = esc;
06786 else
06787 chsize = 1;
06788 break;
06789 case '\v' : octbuf[1] = 'v'; break;
06790 case '\t' : octbuf[1] = 't'; break;
06791 case '\r' : octbuf[1] = 'r'; break;
06792 case '\n' : octbuf[1] = 'n'; break;
06793 case '\f' : octbuf[1] = 'f'; break;
06794 case '"' : if (dq == '"')
06795 octbuf[1] = '"';
06796 else
06797 chsize = 1;
06798 break;
06799 default: chsize = my_snprintf(octbuf, sizeof octbuf,
06800 pv < end && isDIGIT((U8)*(pv+readsize))
06801 ? "%c%03o" : "%c%o", esc, c);
06802 }
06803 } else {
06804 chsize = 1;
06805 }
06806 }
06807 if (max && wrote + chsize > max) {
06808 break;
06809 } else if (chsize > 1) {
06810 sv_catpvn(dsv, octbuf, chsize);
06811 wrote += chsize;
06812 } else {
06813 char tmp[2];
06814 my_snprintf(tmp, sizeof tmp, "%c", c);
06815 sv_catpvn(dsv, tmp, 1);
06816 wrote++;
06817 }
06818 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
06819 break;
06820 }
06821 if (escaped != NULL)
06822 *escaped= pv - str;
06823 return SvPVX(dsv);
06824 }
06825
06826 #endif
06827 #endif
06828
06829 #ifndef pv_pretty
06830 #if defined(NEED_pv_pretty)
06831 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
06832 static
06833 #else
06834 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
06835 #endif
06836
06837 #ifdef pv_pretty
06838 # undef pv_pretty
06839 #endif
06840 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
06841 #define Perl_pv_pretty DPPP_(my_pv_pretty)
06842
06843 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
06844
06845 char *
06846 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
06847 const STRLEN max, char const * const start_color, char const * const end_color,
06848 const U32 flags)
06849 {
06850 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
06851 STRLEN escaped;
06852
06853 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
06854 sv_setpvs(dsv, "");
06855
06856 if (dq == '"')
06857 sv_catpvs(dsv, "\"");
06858 else if (flags & PERL_PV_PRETTY_LTGT)
06859 sv_catpvs(dsv, "<");
06860
06861 if (start_color != NULL)
06862 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
06863
06864 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
06865
06866 if (end_color != NULL)
06867 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
06868
06869 if (dq == '"')
06870 sv_catpvs(dsv, "\"");
06871 else if (flags & PERL_PV_PRETTY_LTGT)
06872 sv_catpvs(dsv, ">");
06873
06874 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
06875 sv_catpvs(dsv, "...");
06876
06877 return SvPVX(dsv);
06878 }
06879
06880 #endif
06881 #endif
06882
06883 #ifndef pv_display
06884 #if defined(NEED_pv_display)
06885 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
06886 static
06887 #else
06888 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
06889 #endif
06890
06891 #ifdef pv_display
06892 # undef pv_display
06893 #endif
06894 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
06895 #define Perl_pv_display DPPP_(my_pv_display)
06896
06897 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
06898
06899 char *
06900 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
06901 {
06902 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
06903 if (len > cur && pv[cur] == '\0')
06904 sv_catpvs(dsv, "\\0");
06905 return SvPVX(dsv);
06906 }
06907
06908 #endif
06909 #endif
06910
06911 #endif
06912
06913
06914