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
03155
03156
03157
03158
03159
03160
03161
03162
03163
03164
03165
03166
03167 #ifndef _P_P_PORTABILITY_H_
03168 #define _P_P_PORTABILITY_H_
03169
03170 #ifndef DPPP_NAMESPACE
03171 # define DPPP_NAMESPACE DPPP_
03172 #endif
03173
03174 #define DPPP_CAT2(x,y) CAT2(x,y)
03175 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
03176
03177 #ifndef PERL_REVISION
03178 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
03179 # define PERL_PATCHLEVEL_H_IMPLICIT
03180 # include <patchlevel.h>
03181 # endif
03182 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
03183 # include <could_not_find_Perl_patchlevel.h>
03184 # endif
03185 # ifndef PERL_REVISION
03186 # define PERL_REVISION (5)
03187
03188 # define PERL_VERSION PATCHLEVEL
03189 # define PERL_SUBVERSION SUBVERSION
03190
03191
03192 # endif
03193 #endif
03194
03195 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
03196 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
03197
03198
03199
03200
03201 #if PERL_REVISION != 5
03202 # error ppport.h only works with Perl version 5
03203 #endif
03204 #ifndef dTHR
03205 # define dTHR dNOOP
03206 #endif
03207 #ifndef dTHX
03208 # define dTHX dNOOP
03209 #endif
03210
03211 #ifndef dTHXa
03212 # define dTHXa(x) dNOOP
03213 #endif
03214 #ifndef pTHX
03215 # define pTHX void
03216 #endif
03217
03218 #ifndef pTHX_
03219 # define pTHX_
03220 #endif
03221
03222 #ifndef aTHX
03223 # define aTHX
03224 #endif
03225
03226 #ifndef aTHX_
03227 # define aTHX_
03228 #endif
03229
03230 #if (PERL_BCDVERSION < 0x5006000)
03231 # ifdef USE_THREADS
03232 # define aTHXR thr
03233 # define aTHXR_ thr,
03234 # else
03235 # define aTHXR
03236 # define aTHXR_
03237 # endif
03238 # define dTHXR dTHR
03239 #else
03240 # define aTHXR aTHX
03241 # define aTHXR_ aTHX_
03242 # define dTHXR dTHX
03243 #endif
03244 #ifndef dTHXoa
03245 # define dTHXoa(x) dTHXa(x)
03246 #endif
03247
03248 #ifdef I_LIMITS
03249 # include <limits.h>
03250 #endif
03251
03252 #ifndef PERL_UCHAR_MIN
03253 # define PERL_UCHAR_MIN ((unsigned char)0)
03254 #endif
03255
03256 #ifndef PERL_UCHAR_MAX
03257 # ifdef UCHAR_MAX
03258 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
03259 # else
03260 # ifdef MAXUCHAR
03261 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
03262 # else
03263 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
03264 # endif
03265 # endif
03266 #endif
03267
03268 #ifndef PERL_USHORT_MIN
03269 # define PERL_USHORT_MIN ((unsigned short)0)
03270 #endif
03271
03272 #ifndef PERL_USHORT_MAX
03273 # ifdef USHORT_MAX
03274 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
03275 # else
03276 # ifdef MAXUSHORT
03277 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
03278 # else
03279 # ifdef USHRT_MAX
03280 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
03281 # else
03282 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
03283 # endif
03284 # endif
03285 # endif
03286 #endif
03287
03288 #ifndef PERL_SHORT_MAX
03289 # ifdef SHORT_MAX
03290 # define PERL_SHORT_MAX ((short)SHORT_MAX)
03291 # else
03292 # ifdef MAXSHORT
03293 # define PERL_SHORT_MAX ((short)MAXSHORT)
03294 # else
03295 # ifdef SHRT_MAX
03296 # define PERL_SHORT_MAX ((short)SHRT_MAX)
03297 # else
03298 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
03299 # endif
03300 # endif
03301 # endif
03302 #endif
03303
03304 #ifndef PERL_SHORT_MIN
03305 # ifdef SHORT_MIN
03306 # define PERL_SHORT_MIN ((short)SHORT_MIN)
03307 # else
03308 # ifdef MINSHORT
03309 # define PERL_SHORT_MIN ((short)MINSHORT)
03310 # else
03311 # ifdef SHRT_MIN
03312 # define PERL_SHORT_MIN ((short)SHRT_MIN)
03313 # else
03314 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
03315 # endif
03316 # endif
03317 # endif
03318 #endif
03319
03320 #ifndef PERL_UINT_MAX
03321 # ifdef UINT_MAX
03322 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
03323 # else
03324 # ifdef MAXUINT
03325 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
03326 # else
03327 # define PERL_UINT_MAX (~(unsigned int)0)
03328 # endif
03329 # endif
03330 #endif
03331
03332 #ifndef PERL_UINT_MIN
03333 # define PERL_UINT_MIN ((unsigned int)0)
03334 #endif
03335
03336 #ifndef PERL_INT_MAX
03337 # ifdef INT_MAX
03338 # define PERL_INT_MAX ((int)INT_MAX)
03339 # else
03340 # ifdef MAXINT
03341 # define PERL_INT_MAX ((int)MAXINT)
03342 # else
03343 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
03344 # endif
03345 # endif
03346 #endif
03347
03348 #ifndef PERL_INT_MIN
03349 # ifdef INT_MIN
03350 # define PERL_INT_MIN ((int)INT_MIN)
03351 # else
03352 # ifdef MININT
03353 # define PERL_INT_MIN ((int)MININT)
03354 # else
03355 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
03356 # endif
03357 # endif
03358 #endif
03359
03360 #ifndef PERL_ULONG_MAX
03361 # ifdef ULONG_MAX
03362 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
03363 # else
03364 # ifdef MAXULONG
03365 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
03366 # else
03367 # define PERL_ULONG_MAX (~(unsigned long)0)
03368 # endif
03369 # endif
03370 #endif
03371
03372 #ifndef PERL_ULONG_MIN
03373 # define PERL_ULONG_MIN ((unsigned long)0L)
03374 #endif
03375
03376 #ifndef PERL_LONG_MAX
03377 # ifdef LONG_MAX
03378 # define PERL_LONG_MAX ((long)LONG_MAX)
03379 # else
03380 # ifdef MAXLONG
03381 # define PERL_LONG_MAX ((long)MAXLONG)
03382 # else
03383 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
03384 # endif
03385 # endif
03386 #endif
03387
03388 #ifndef PERL_LONG_MIN
03389 # ifdef LONG_MIN
03390 # define PERL_LONG_MIN ((long)LONG_MIN)
03391 # else
03392 # ifdef MINLONG
03393 # define PERL_LONG_MIN ((long)MINLONG)
03394 # else
03395 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
03396 # endif
03397 # endif
03398 #endif
03399
03400 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
03401 # ifndef PERL_UQUAD_MAX
03402 # ifdef ULONGLONG_MAX
03403 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
03404 # else
03405 # ifdef MAXULONGLONG
03406 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
03407 # else
03408 # define PERL_UQUAD_MAX (~(unsigned long long)0)
03409 # endif
03410 # endif
03411 # endif
03412
03413 # ifndef PERL_UQUAD_MIN
03414 # define PERL_UQUAD_MIN ((unsigned long long)0L)
03415 # endif
03416
03417 # ifndef PERL_QUAD_MAX
03418 # ifdef LONGLONG_MAX
03419 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
03420 # else
03421 # ifdef MAXLONGLONG
03422 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
03423 # else
03424 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
03425 # endif
03426 # endif
03427 # endif
03428
03429 # ifndef PERL_QUAD_MIN
03430 # ifdef LONGLONG_MIN
03431 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
03432 # else
03433 # ifdef MINLONGLONG
03434 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
03435 # else
03436 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
03437 # endif
03438 # endif
03439 # endif
03440 #endif
03441
03442
03443 #ifdef HAS_QUAD
03444 # ifdef cray
03445 #ifndef IVTYPE
03446 # define IVTYPE int
03447 #endif
03448
03449 #ifndef IV_MIN
03450 # define IV_MIN PERL_INT_MIN
03451 #endif
03452
03453 #ifndef IV_MAX
03454 # define IV_MAX PERL_INT_MAX
03455 #endif
03456
03457 #ifndef UV_MIN
03458 # define UV_MIN PERL_UINT_MIN
03459 #endif
03460
03461 #ifndef UV_MAX
03462 # define UV_MAX PERL_UINT_MAX
03463 #endif
03464
03465 # ifdef INTSIZE
03466 #ifndef IVSIZE
03467 # define IVSIZE INTSIZE
03468 #endif
03469
03470 # endif
03471 # else
03472 # if defined(convex) || defined(uts)
03473 #ifndef IVTYPE
03474 # define IVTYPE long long
03475 #endif
03476
03477 #ifndef IV_MIN
03478 # define IV_MIN PERL_QUAD_MIN
03479 #endif
03480
03481 #ifndef IV_MAX
03482 # define IV_MAX PERL_QUAD_MAX
03483 #endif
03484
03485 #ifndef UV_MIN
03486 # define UV_MIN PERL_UQUAD_MIN
03487 #endif
03488
03489 #ifndef UV_MAX
03490 # define UV_MAX PERL_UQUAD_MAX
03491 #endif
03492
03493 # ifdef LONGLONGSIZE
03494 #ifndef IVSIZE
03495 # define IVSIZE LONGLONGSIZE
03496 #endif
03497
03498 # endif
03499 # else
03500 #ifndef IVTYPE
03501 # define IVTYPE long
03502 #endif
03503
03504 #ifndef IV_MIN
03505 # define IV_MIN PERL_LONG_MIN
03506 #endif
03507
03508 #ifndef IV_MAX
03509 # define IV_MAX PERL_LONG_MAX
03510 #endif
03511
03512 #ifndef UV_MIN
03513 # define UV_MIN PERL_ULONG_MIN
03514 #endif
03515
03516 #ifndef UV_MAX
03517 # define UV_MAX PERL_ULONG_MAX
03518 #endif
03519
03520 # ifdef LONGSIZE
03521 #ifndef IVSIZE
03522 # define IVSIZE LONGSIZE
03523 #endif
03524
03525 # endif
03526 # endif
03527 # endif
03528 #ifndef IVSIZE
03529 # define IVSIZE 8
03530 #endif
03531
03532 #ifndef PERL_QUAD_MIN
03533 # define PERL_QUAD_MIN IV_MIN
03534 #endif
03535
03536 #ifndef PERL_QUAD_MAX
03537 # define PERL_QUAD_MAX IV_MAX
03538 #endif
03539
03540 #ifndef PERL_UQUAD_MIN
03541 # define PERL_UQUAD_MIN UV_MIN
03542 #endif
03543
03544 #ifndef PERL_UQUAD_MAX
03545 # define PERL_UQUAD_MAX UV_MAX
03546 #endif
03547
03548 #else
03549 #ifndef IVTYPE
03550 # define IVTYPE long
03551 #endif
03552
03553 #ifndef IV_MIN
03554 # define IV_MIN PERL_LONG_MIN
03555 #endif
03556
03557 #ifndef IV_MAX
03558 # define IV_MAX PERL_LONG_MAX
03559 #endif
03560
03561 #ifndef UV_MIN
03562 # define UV_MIN PERL_ULONG_MIN
03563 #endif
03564
03565 #ifndef UV_MAX
03566 # define UV_MAX PERL_ULONG_MAX
03567 #endif
03568
03569 #endif
03570
03571 #ifndef IVSIZE
03572 # ifdef LONGSIZE
03573 # define IVSIZE LONGSIZE
03574 # else
03575 # define IVSIZE 4
03576 # endif
03577 #endif
03578 #ifndef UVTYPE
03579 # define UVTYPE unsigned IVTYPE
03580 #endif
03581
03582 #ifndef UVSIZE
03583 # define UVSIZE IVSIZE
03584 #endif
03585 #ifndef sv_setuv
03586 # define sv_setuv(sv, uv) \
03587 STMT_START { \
03588 UV TeMpUv = uv; \
03589 if (TeMpUv <= IV_MAX) \
03590 sv_setiv(sv, TeMpUv); \
03591 else \
03592 sv_setnv(sv, (double)TeMpUv); \
03593 } STMT_END
03594 #endif
03595 #ifndef newSVuv
03596 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
03597 #endif
03598 #ifndef sv_2uv
03599 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
03600 #endif
03601
03602 #ifndef SvUVX
03603 # define SvUVX(sv) ((UV)SvIVX(sv))
03604 #endif
03605
03606 #ifndef SvUVXx
03607 # define SvUVXx(sv) SvUVX(sv)
03608 #endif
03609
03610 #ifndef SvUV
03611 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
03612 #endif
03613
03614 #ifndef SvUVx
03615 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
03616 #endif
03617
03618
03619
03620
03621 #ifndef sv_uv
03622 # define sv_uv(sv) SvUVx(sv)
03623 #endif
03624
03625 #if !defined(SvUOK) && defined(SvIOK_UV)
03626 # define SvUOK(sv) SvIOK_UV(sv)
03627 #endif
03628 #ifndef XST_mUV
03629 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
03630 #endif
03631
03632 #ifndef XSRETURN_UV
03633 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
03634 #endif
03635 #ifndef PUSHu
03636 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
03637 #endif
03638
03639 #ifndef XPUSHu
03640 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
03641 #endif
03642
03643 #ifdef HAS_MEMCMP
03644 #ifndef memNE
03645 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
03646 #endif
03647
03648 #ifndef memEQ
03649 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
03650 #endif
03651
03652 #else
03653 #ifndef memNE
03654 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
03655 #endif
03656
03657 #ifndef memEQ
03658 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
03659 #endif
03660
03661 #endif
03662 #ifndef MoveD
03663 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
03664 #endif
03665
03666 #ifndef CopyD
03667 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
03668 #endif
03669
03670 #ifdef HAS_MEMSET
03671 #ifndef ZeroD
03672 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
03673 #endif
03674
03675 #else
03676 #ifndef ZeroD
03677 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
03678 #endif
03679
03680 #endif
03681 #ifndef PoisonWith
03682 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
03683 #endif
03684
03685 #ifndef PoisonNew
03686 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
03687 #endif
03688
03689 #ifndef PoisonFree
03690 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
03691 #endif
03692
03693 #ifndef Poison
03694 # define Poison(d,n,t) PoisonFree(d,n,t)
03695 #endif
03696 #ifndef Newx
03697 # define Newx(v,n,t) New(0,v,n,t)
03698 #endif
03699
03700 #ifndef Newxc
03701 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
03702 #endif
03703
03704 #ifndef Newxz
03705 # define Newxz(v,n,t) Newz(0,v,n,t)
03706 #endif
03707
03708 #ifndef PERL_UNUSED_DECL
03709 # ifdef HASATTRIBUTE
03710 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
03711 # define PERL_UNUSED_DECL
03712 # else
03713 # define PERL_UNUSED_DECL __attribute__((unused))
03714 # endif
03715 # else
03716 # define PERL_UNUSED_DECL
03717 # endif
03718 #endif
03719
03720 #ifndef PERL_UNUSED_ARG
03721 # if defined(lint) && defined(S_SPLINT_S)
03722 # include <note.h>
03723 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
03724 # else
03725 # define PERL_UNUSED_ARG(x) ((void)x)
03726 # endif
03727 #endif
03728
03729 #ifndef PERL_UNUSED_VAR
03730 # define PERL_UNUSED_VAR(x) ((void)x)
03731 #endif
03732
03733 #ifndef PERL_UNUSED_CONTEXT
03734 # ifdef USE_ITHREADS
03735 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
03736 # else
03737 # define PERL_UNUSED_CONTEXT
03738 # endif
03739 #endif
03740 #ifndef NOOP
03741 # define NOOP (void)0
03742 #endif
03743
03744 #ifndef dNOOP
03745 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
03746 #endif
03747
03748 #ifndef NVTYPE
03749 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
03750 # define NVTYPE long double
03751 # else
03752 # define NVTYPE double
03753 # endif
03754 typedef NVTYPE NV;
03755 #endif
03756
03757 #ifndef INT2PTR
03758 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
03759 # define PTRV UV
03760 # define INT2PTR(any,d) (any)(d)
03761 # else
03762 # if PTRSIZE == LONGSIZE
03763 # define PTRV unsigned long
03764 # else
03765 # define PTRV unsigned
03766 # endif
03767 # define INT2PTR(any,d) (any)(PTRV)(d)
03768 # endif
03769 #endif
03770
03771 #ifndef PTR2ul
03772 # if PTRSIZE == LONGSIZE
03773 # define PTR2ul(p) (unsigned long)(p)
03774 # else
03775 # define PTR2ul(p) INT2PTR(unsigned long,p)
03776 # endif
03777 #endif
03778 #ifndef PTR2nat
03779 # define PTR2nat(p) (PTRV)(p)
03780 #endif
03781
03782 #ifndef NUM2PTR
03783 # define NUM2PTR(any,d) (any)PTR2nat(d)
03784 #endif
03785
03786 #ifndef PTR2IV
03787 # define PTR2IV(p) INT2PTR(IV,p)
03788 #endif
03789
03790 #ifndef PTR2UV
03791 # define PTR2UV(p) INT2PTR(UV,p)
03792 #endif
03793
03794 #ifndef PTR2NV
03795 # define PTR2NV(p) NUM2PTR(NV,p)
03796 #endif
03797
03798 #undef START_EXTERN_C
03799 #undef END_EXTERN_C
03800 #undef EXTERN_C
03801 #ifdef __cplusplus
03802 # define START_EXTERN_C extern "C" {
03803 # define END_EXTERN_C }
03804 # define EXTERN_C extern "C"
03805 #else
03806 # define START_EXTERN_C
03807 # define END_EXTERN_C
03808 # define EXTERN_C extern
03809 #endif
03810
03811 #if defined(PERL_GCC_PEDANTIC)
03812 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
03813 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
03814 # endif
03815 #endif
03816
03817 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
03818 # ifndef PERL_USE_GCC_BRACE_GROUPS
03819 # define PERL_USE_GCC_BRACE_GROUPS
03820 # endif
03821 #endif
03822
03823 #undef STMT_START
03824 #undef STMT_END
03825 #ifdef PERL_USE_GCC_BRACE_GROUPS
03826 # define STMT_START (void)(
03827 # define STMT_END )
03828 #else
03829 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
03830 # define STMT_START if (1)
03831 # define STMT_END else (void)0
03832 # else
03833 # define STMT_START do
03834 # define STMT_END while (0)
03835 # endif
03836 #endif
03837 #ifndef boolSV
03838 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
03839 #endif
03840
03841
03842 #ifndef DEFSV
03843 # define DEFSV GvSV(PL_defgv)
03844 #endif
03845
03846 #ifndef SAVE_DEFSV
03847 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
03848 #endif
03849
03850 #ifndef DEFSV_set
03851 # define DEFSV_set(sv) (DEFSV = (sv))
03852 #endif
03853
03854
03855 #ifndef AvFILLp
03856 # define AvFILLp AvFILL
03857 #endif
03858 #ifndef ERRSV
03859 # define ERRSV get_sv("@",FALSE)
03860 #endif
03861
03862
03863
03864
03865
03866
03867
03868 #ifndef gv_stashpvn
03869 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
03870 #endif
03871
03872
03873 #ifndef get_cv
03874 # define get_cv perl_get_cv
03875 #endif
03876
03877 #ifndef get_sv
03878 # define get_sv perl_get_sv
03879 #endif
03880
03881 #ifndef get_av
03882 # define get_av perl_get_av
03883 #endif
03884
03885 #ifndef get_hv
03886 # define get_hv perl_get_hv
03887 #endif
03888
03889
03890 #ifndef dUNDERBAR
03891 # define dUNDERBAR dNOOP
03892 #endif
03893
03894 #ifndef UNDERBAR
03895 # define UNDERBAR DEFSV
03896 #endif
03897 #ifndef dAX
03898 # define dAX I32 ax = MARK - PL_stack_base + 1
03899 #endif
03900
03901 #ifndef dITEMS
03902 # define dITEMS I32 items = SP - MARK
03903 #endif
03904 #ifndef dXSTARG
03905 # define dXSTARG SV * targ = sv_newmortal()
03906 #endif
03907 #ifndef dAXMARK
03908 # define dAXMARK I32 ax = POPMARK; \
03909 register SV ** const mark = PL_stack_base + ax++
03910 #endif
03911 #ifndef XSprePUSH
03912 # define XSprePUSH (sp = PL_stack_base + ax - 1)
03913 #endif
03914
03915 #if (PERL_BCDVERSION < 0x5005000)
03916 # undef XSRETURN
03917 # define XSRETURN(off) \
03918 STMT_START { \
03919 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
03920 return; \
03921 } STMT_END
03922 #endif
03923 #ifndef XSPROTO
03924 # define XSPROTO(name) void name(pTHX_ CV* cv)
03925 #endif
03926
03927 #ifndef SVfARG
03928 # define SVfARG(p) ((void*)(p))
03929 #endif
03930 #ifndef PERL_ABS
03931 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
03932 #endif
03933 #ifndef dVAR
03934 # define dVAR dNOOP
03935 #endif
03936 #ifndef SVf
03937 # define SVf "_"
03938 #endif
03939 #ifndef UTF8_MAXBYTES
03940 # define UTF8_MAXBYTES UTF8_MAXLEN
03941 #endif
03942 #ifndef CPERLscope
03943 # define CPERLscope(x) x
03944 #endif
03945 #ifndef PERL_HASH
03946 # define PERL_HASH(hash,str,len) \
03947 STMT_START { \
03948 const char *s_PeRlHaSh = str; \
03949 I32 i_PeRlHaSh = len; \
03950 U32 hash_PeRlHaSh = 0; \
03951 while (i_PeRlHaSh--) \
03952 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
03953 (hash) = hash_PeRlHaSh; \
03954 } STMT_END
03955 #endif
03956
03957 #ifndef PERLIO_FUNCS_DECL
03958 # ifdef PERLIO_FUNCS_CONST
03959 # define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
03960 # define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
03961 # else
03962 # define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
03963 # define PERLIO_FUNCS_CAST(funcs) (funcs)
03964 # endif
03965 #endif
03966
03967
03968 #if (PERL_BCDVERSION < 0x5009003)
03969
03970 # ifdef ARGSproto
03971 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
03972 # else
03973 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
03974 # endif
03975
03976 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
03977
03978 #endif
03979 #ifndef isPSXSPC
03980 # define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
03981 #endif
03982
03983 #ifndef isBLANK
03984 # define isBLANK(c) ((c) == ' ' || (c) == '\t')
03985 #endif
03986
03987 #ifdef EBCDIC
03988 #ifndef isALNUMC
03989 # define isALNUMC(c) isalnum(c)
03990 #endif
03991
03992 #ifndef isASCII
03993 # define isASCII(c) isascii(c)
03994 #endif
03995
03996 #ifndef isCNTRL
03997 # define isCNTRL(c) iscntrl(c)
03998 #endif
03999
04000 #ifndef isGRAPH
04001 # define isGRAPH(c) isgraph(c)
04002 #endif
04003
04004 #ifndef isPRINT
04005 # define isPRINT(c) isprint(c)
04006 #endif
04007
04008 #ifndef isPUNCT
04009 # define isPUNCT(c) ispunct(c)
04010 #endif
04011
04012 #ifndef isXDIGIT
04013 # define isXDIGIT(c) isxdigit(c)
04014 #endif
04015
04016 #else
04017 # if (PERL_BCDVERSION < 0x5010000)
04018
04019
04020
04021
04022
04023 # undef isPRINT
04024 # endif
04025 #ifndef isALNUMC
04026 # define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
04027 #endif
04028
04029 #ifndef isASCII
04030 # define isASCII(c) ((c) <= 127)
04031 #endif
04032
04033 #ifndef isCNTRL
04034 # define isCNTRL(c) ((c) < ' ' || (c) == 127)
04035 #endif
04036
04037 #ifndef isGRAPH
04038 # define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
04039 #endif
04040
04041 #ifndef isPRINT
04042 # define isPRINT(c) (((c) >= 32 && (c) < 127))
04043 #endif
04044
04045 #ifndef isPUNCT
04046 # define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
04047 #endif
04048
04049 #ifndef isXDIGIT
04050 # define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
04051 #endif
04052
04053 #endif
04054
04055 #ifndef PERL_SIGNALS_UNSAFE_FLAG
04056
04057 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
04058
04059 #if (PERL_BCDVERSION < 0x5008000)
04060 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
04061 #else
04062 # define D_PPP_PERL_SIGNALS_INIT 0
04063 #endif
04064
04065 #if defined(NEED_PL_signals)
04066 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
04067 #elif defined(NEED_PL_signals_GLOBAL)
04068 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
04069 #else
04070 extern U32 DPPP_(my_PL_signals);
04071 #endif
04072 #define PL_signals DPPP_(my_PL_signals)
04073
04074 #endif
04075
04076
04077
04078
04079
04080
04081
04082
04083 #if (PERL_BCDVERSION <= 0x5005005)
04084
04085 # define PL_ppaddr ppaddr
04086 # define PL_no_modify no_modify
04087
04088 #endif
04089
04090 #if (PERL_BCDVERSION <= 0x5004005)
04091
04092 # define PL_DBsignal DBsignal
04093 # define PL_DBsingle DBsingle
04094 # define PL_DBsub DBsub
04095 # define PL_DBtrace DBtrace
04096 # define PL_Sv Sv
04097 # define PL_bufend bufend
04098 # define PL_bufptr bufptr
04099 # define PL_compiling compiling
04100 # define PL_copline copline
04101 # define PL_curcop curcop
04102 # define PL_curstash curstash
04103 # define PL_debstash debstash
04104 # define PL_defgv defgv
04105 # define PL_diehook diehook
04106 # define PL_dirty dirty
04107 # define PL_dowarn dowarn
04108 # define PL_errgv errgv
04109 # define PL_error_count error_count
04110 # define PL_expect expect
04111 # define PL_hexdigit hexdigit
04112 # define PL_hints hints
04113 # define PL_in_my in_my
04114 # define PL_laststatval laststatval
04115 # define PL_lex_state lex_state
04116 # define PL_lex_stuff lex_stuff
04117 # define PL_linestr linestr
04118 # define PL_na na
04119 # define PL_perl_destruct_level perl_destruct_level
04120 # define PL_perldb perldb
04121 # define PL_rsfp_filters rsfp_filters
04122 # define PL_rsfp rsfp
04123 # define PL_stack_base stack_base
04124 # define PL_stack_sp stack_sp
04125 # define PL_statcache statcache
04126 # define PL_stdingv stdingv
04127 # define PL_sv_arenaroot sv_arenaroot
04128 # define PL_sv_no sv_no
04129 # define PL_sv_undef sv_undef
04130 # define PL_sv_yes sv_yes
04131 # define PL_tainted tainted
04132 # define PL_tainting tainting
04133 # define PL_tokenbuf tokenbuf
04134
04135 #endif
04136
04137
04138
04139
04140
04141
04142
04143
04144
04145
04146
04147 #if (PERL_BCDVERSION >= 0x5009005)
04148 # ifdef DPPP_PL_parser_NO_DUMMY
04149 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
04150 (croak("panic: PL_parser == NULL in %s:%d", \
04151 __FILE__, __LINE__), (yy_parser *) NULL))->var)
04152 # else
04153 # ifdef DPPP_PL_parser_NO_DUMMY_WARNING
04154 # define D_PPP_parser_dummy_warning(var)
04155 # else
04156 # define D_PPP_parser_dummy_warning(var) \
04157 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
04158 # endif
04159 # define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
04160 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
04161 #if defined(NEED_PL_parser)
04162 static yy_parser DPPP_(dummy_PL_parser);
04163 #elif defined(NEED_PL_parser_GLOBAL)
04164 yy_parser DPPP_(dummy_PL_parser);
04165 #else
04166 extern yy_parser DPPP_(dummy_PL_parser);
04167 #endif
04168
04169 # endif
04170
04171
04172
04173
04174
04175
04176
04177
04178
04179
04180
04181
04182
04183
04184
04185
04186 # define PL_expect D_PPP_my_PL_parser_var(expect)
04187 # define PL_copline D_PPP_my_PL_parser_var(copline)
04188 # define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
04189 # define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
04190 # define PL_linestr D_PPP_my_PL_parser_var(linestr)
04191 # define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
04192 # define PL_bufend D_PPP_my_PL_parser_var(bufend)
04193 # define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
04194 # define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
04195 # define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
04196 # define PL_in_my D_PPP_my_PL_parser_var(in_my)
04197 # define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
04198 # define PL_error_count D_PPP_my_PL_parser_var(error_count)
04199
04200
04201 #else
04202
04203
04204 # define PL_parser ((void *) 1)
04205
04206 #endif
04207 #ifndef mPUSHs
04208 # define mPUSHs(s) PUSHs(sv_2mortal(s))
04209 #endif
04210
04211 #ifndef PUSHmortal
04212 # define PUSHmortal PUSHs(sv_newmortal())
04213 #endif
04214
04215 #ifndef mPUSHp
04216 # define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
04217 #endif
04218
04219 #ifndef mPUSHn
04220 # define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
04221 #endif
04222
04223 #ifndef mPUSHi
04224 # define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
04225 #endif
04226
04227 #ifndef mPUSHu
04228 # define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
04229 #endif
04230 #ifndef mXPUSHs
04231 # define mXPUSHs(s) XPUSHs(sv_2mortal(s))
04232 #endif
04233
04234 #ifndef XPUSHmortal
04235 # define XPUSHmortal XPUSHs(sv_newmortal())
04236 #endif
04237
04238 #ifndef mXPUSHp
04239 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
04240 #endif
04241
04242 #ifndef mXPUSHn
04243 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
04244 #endif
04245
04246 #ifndef mXPUSHi
04247 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
04248 #endif
04249
04250 #ifndef mXPUSHu
04251 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
04252 #endif
04253
04254
04255 #ifndef call_sv
04256 # define call_sv perl_call_sv
04257 #endif
04258
04259 #ifndef call_pv
04260 # define call_pv perl_call_pv
04261 #endif
04262
04263 #ifndef call_argv
04264 # define call_argv perl_call_argv
04265 #endif
04266
04267 #ifndef call_method
04268 # define call_method perl_call_method
04269 #endif
04270 #ifndef eval_sv
04271 # define eval_sv perl_eval_sv
04272 #endif
04273
04274
04275 #ifndef PERL_LOADMOD_DENY
04276 # define PERL_LOADMOD_DENY 0x1
04277 #endif
04278
04279 #ifndef PERL_LOADMOD_NOIMPORT
04280 # define PERL_LOADMOD_NOIMPORT 0x2
04281 #endif
04282
04283 #ifndef PERL_LOADMOD_IMPORT_OPS
04284 # define PERL_LOADMOD_IMPORT_OPS 0x4
04285 #endif
04286
04287 #ifndef G_METHOD
04288 # define G_METHOD 64
04289 # ifdef call_sv
04290 # undef call_sv
04291 # endif
04292 # if (PERL_BCDVERSION < 0x5006000)
04293 # define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
04294 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
04295 # else
04296 # define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
04297 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
04298 # endif
04299 #endif
04300
04301
04302
04303 #ifndef eval_pv
04304 #if defined(NEED_eval_pv)
04305 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
04306 static
04307 #else
04308 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
04309 #endif
04310
04311 #ifdef eval_pv
04312 # undef eval_pv
04313 #endif
04314 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
04315 #define Perl_eval_pv DPPP_(my_eval_pv)
04316
04317 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
04318
04319 SV*
04320 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
04321 {
04322 dSP;
04323 SV* sv = newSVpv(p, 0);
04324
04325 PUSHMARK(sp);
04326 eval_sv(sv, G_SCALAR);
04327 SvREFCNT_dec(sv);
04328
04329 SPAGAIN;
04330 sv = POPs;
04331 PUTBACK;
04332
04333 if (croak_on_error && SvTRUE(GvSV(errgv)))
04334 croak(SvPVx(GvSV(errgv), na));
04335
04336 return sv;
04337 }
04338
04339 #endif
04340 #endif
04341
04342 #ifndef vload_module
04343 #if defined(NEED_vload_module)
04344 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
04345 static
04346 #else
04347 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
04348 #endif
04349
04350 #ifdef vload_module
04351 # undef vload_module
04352 #endif
04353 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
04354 #define Perl_vload_module DPPP_(my_vload_module)
04355
04356 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
04357
04358 void
04359 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
04360 {
04361 dTHR;
04362 dVAR;
04363 OP *veop, *imop;
04364
04365 OP * const modname = newSVOP(OP_CONST, 0, name);
04366
04367
04368
04369
04370
04371 SvREADONLY_off(((SVOP*)modname)->op_sv);
04372 modname->op_private |= OPpCONST_BARE;
04373 if (ver) {
04374 veop = newSVOP(OP_CONST, 0, ver);
04375 }
04376 else
04377 veop = NULL;
04378 if (flags & PERL_LOADMOD_NOIMPORT) {
04379 imop = sawparens(newNULLLIST());
04380 }
04381 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
04382 imop = va_arg(*args, OP*);
04383 }
04384 else {
04385 SV *sv;
04386 imop = NULL;
04387 sv = va_arg(*args, SV*);
04388 while (sv) {
04389 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
04390 sv = va_arg(*args, SV*);
04391 }
04392 }
04393 {
04394 const line_t ocopline = PL_copline;
04395 COP * const ocurcop = PL_curcop;
04396 const int oexpect = PL_expect;
04397
04398 #if (PERL_BCDVERSION >= 0x5004000)
04399 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
04400 veop, modname, imop);
04401 #else
04402 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
04403 modname, imop);
04404 #endif
04405 PL_expect = oexpect;
04406 PL_copline = ocopline;
04407 PL_curcop = ocurcop;
04408 }
04409 }
04410
04411 #endif
04412 #endif
04413
04414 #ifndef load_module
04415 #if defined(NEED_load_module)
04416 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
04417 static
04418 #else
04419 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
04420 #endif
04421
04422 #ifdef load_module
04423 # undef load_module
04424 #endif
04425 #define load_module DPPP_(my_load_module)
04426 #define Perl_load_module DPPP_(my_load_module)
04427
04428 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
04429
04430 void
04431 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
04432 {
04433 va_list args;
04434 va_start(args, ver);
04435 vload_module(flags, name, ver, &args);
04436 va_end(args);
04437 }
04438
04439 #endif
04440 #endif
04441 #ifndef newRV_inc
04442 # define newRV_inc(sv) newRV(sv)
04443 #endif
04444
04445 #ifndef newRV_noinc
04446 #if defined(NEED_newRV_noinc)
04447 static SV * DPPP_(my_newRV_noinc)(SV *sv);
04448 static
04449 #else
04450 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
04451 #endif
04452
04453 #ifdef newRV_noinc
04454 # undef newRV_noinc
04455 #endif
04456 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
04457 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
04458
04459 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
04460 SV *
04461 DPPP_(my_newRV_noinc)(SV *sv)
04462 {
04463 SV *rv = (SV *)newRV(sv);
04464 SvREFCNT_dec(sv);
04465 return rv;
04466 }
04467 #endif
04468 #endif
04469
04470
04471
04472
04473
04474
04475
04476 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
04477 #if defined(NEED_newCONSTSUB)
04478 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
04479 static
04480 #else
04481 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
04482 #endif
04483
04484 #ifdef newCONSTSUB
04485 # undef newCONSTSUB
04486 #endif
04487 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
04488 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
04489
04490 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
04491
04492
04493
04494 #define D_PPP_PL_copline PL_copline
04495
04496 void
04497 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
04498 {
04499 U32 oldhints = PL_hints;
04500 HV *old_cop_stash = PL_curcop->cop_stash;
04501 HV *old_curstash = PL_curstash;
04502 line_t oldline = PL_curcop->cop_line;
04503 PL_curcop->cop_line = D_PPP_PL_copline;
04504
04505 PL_hints &= ~HINT_BLOCK_SCOPE;
04506 if (stash)
04507 PL_curstash = PL_curcop->cop_stash = stash;
04508
04509 newSUB(
04510
04511 #if (PERL_BCDVERSION < 0x5003022)
04512 start_subparse(),
04513 #elif (PERL_BCDVERSION == 0x5003022)
04514 start_subparse(0),
04515 #else
04516 start_subparse(FALSE, 0),
04517 #endif
04518
04519 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
04520 newSVOP(OP_CONST, 0, &PL_sv_no),
04521 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
04522 );
04523
04524 PL_hints = oldhints;
04525 PL_curcop->cop_stash = old_cop_stash;
04526 PL_curstash = old_curstash;
04527 PL_curcop->cop_line = oldline;
04528 }
04529 #endif
04530 #endif
04531
04532
04533
04534
04535
04536
04537
04538
04539
04540
04541
04542
04543
04544
04545
04546
04547
04548
04549
04550
04551 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
04552 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
04553
04554 #ifndef START_MY_CXT
04555
04556
04557
04558
04559 #define START_MY_CXT
04560
04561 #if (PERL_BCDVERSION < 0x5004068)
04562
04563 #define dMY_CXT_SV \
04564 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
04565 #else
04566 #define dMY_CXT_SV \
04567 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
04568 sizeof(MY_CXT_KEY)-1, TRUE)
04569 #endif
04570
04571
04572
04573 #define dMY_CXT \
04574 dMY_CXT_SV; \
04575 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
04576
04577
04578
04579
04580 #define MY_CXT_INIT \
04581 dMY_CXT_SV; \
04582 \
04583 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
04584 Zero(my_cxtp, 1, my_cxt_t); \
04585 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
04586
04587
04588
04589 #define MY_CXT (*my_cxtp)
04590
04591
04592
04593 #define pMY_CXT my_cxt_t *my_cxtp
04594 #define pMY_CXT_ pMY_CXT,
04595 #define _pMY_CXT ,pMY_CXT
04596 #define aMY_CXT my_cxtp
04597 #define aMY_CXT_ aMY_CXT,
04598 #define _aMY_CXT ,aMY_CXT
04599
04600 #endif
04601
04602 #ifndef MY_CXT_CLONE
04603
04604 #define MY_CXT_CLONE \
04605 dMY_CXT_SV; \
04606 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
04607 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
04608 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
04609 #endif
04610
04611 #else
04612
04613 #ifndef START_MY_CXT
04614
04615 #define START_MY_CXT static my_cxt_t my_cxt;
04616 #define dMY_CXT_SV dNOOP
04617 #define dMY_CXT dNOOP
04618 #define MY_CXT_INIT NOOP
04619 #define MY_CXT my_cxt
04620
04621 #define pMY_CXT void
04622 #define pMY_CXT_
04623 #define _pMY_CXT
04624 #define aMY_CXT
04625 #define aMY_CXT_
04626 #define _aMY_CXT
04627
04628 #endif
04629
04630 #ifndef MY_CXT_CLONE
04631 #define MY_CXT_CLONE NOOP
04632 #endif
04633
04634 #endif
04635
04636 #ifndef IVdf
04637 # if IVSIZE == LONGSIZE
04638 # define IVdf "ld"
04639 # define UVuf "lu"
04640 # define UVof "lo"
04641 # define UVxf "lx"
04642 # define UVXf "lX"
04643 # else
04644 # if IVSIZE == INTSIZE
04645 # define IVdf "d"
04646 # define UVuf "u"
04647 # define UVof "o"
04648 # define UVxf "x"
04649 # define UVXf "X"
04650 # endif
04651 # endif
04652 #endif
04653
04654 #ifndef NVef
04655 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
04656 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
04657
04658 # define NVef PERL_PRIeldbl
04659 # define NVff PERL_PRIfldbl
04660 # define NVgf PERL_PRIgldbl
04661 # else
04662 # define NVef "e"
04663 # define NVff "f"
04664 # define NVgf "g"
04665 # endif
04666 #endif
04667
04668 #ifndef SvREFCNT_inc
04669 # ifdef PERL_USE_GCC_BRACE_GROUPS
04670 # define SvREFCNT_inc(sv) \
04671 ({ \
04672 SV * const _sv = (SV*)(sv); \
04673 if (_sv) \
04674 (SvREFCNT(_sv))++; \
04675 _sv; \
04676 })
04677 # else
04678 # define SvREFCNT_inc(sv) \
04679 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
04680 # endif
04681 #endif
04682
04683 #ifndef SvREFCNT_inc_simple
04684 # ifdef PERL_USE_GCC_BRACE_GROUPS
04685 # define SvREFCNT_inc_simple(sv) \
04686 ({ \
04687 if (sv) \
04688 (SvREFCNT(sv))++; \
04689 (SV *)(sv); \
04690 })
04691 # else
04692 # define SvREFCNT_inc_simple(sv) \
04693 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
04694 # endif
04695 #endif
04696
04697 #ifndef SvREFCNT_inc_NN
04698 # ifdef PERL_USE_GCC_BRACE_GROUPS
04699 # define SvREFCNT_inc_NN(sv) \
04700 ({ \
04701 SV * const _sv = (SV*)(sv); \
04702 SvREFCNT(_sv)++; \
04703 _sv; \
04704 })
04705 # else
04706 # define SvREFCNT_inc_NN(sv) \
04707 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
04708 # endif
04709 #endif
04710
04711 #ifndef SvREFCNT_inc_void
04712 # ifdef PERL_USE_GCC_BRACE_GROUPS
04713 # define SvREFCNT_inc_void(sv) \
04714 ({ \
04715 SV * const _sv = (SV*)(sv); \
04716 if (_sv) \
04717 (void)(SvREFCNT(_sv)++); \
04718 })
04719 # else
04720 # define SvREFCNT_inc_void(sv) \
04721 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
04722 # endif
04723 #endif
04724 #ifndef SvREFCNT_inc_simple_void
04725 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
04726 #endif
04727
04728 #ifndef SvREFCNT_inc_simple_NN
04729 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
04730 #endif
04731
04732 #ifndef SvREFCNT_inc_void_NN
04733 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
04734 #endif
04735
04736 #ifndef SvREFCNT_inc_simple_void_NN
04737 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
04738 #endif
04739
04740 #ifndef newSV_type
04741
04742 #if defined(NEED_newSV_type)
04743 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
04744 static
04745 #else
04746 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
04747 #endif
04748
04749 #ifdef newSV_type
04750 # undef newSV_type
04751 #endif
04752 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
04753 #define Perl_newSV_type DPPP_(my_newSV_type)
04754
04755 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
04756
04757 SV*
04758 DPPP_(my_newSV_type)(pTHX_ svtype const t)
04759 {
04760 SV* const sv = newSV(0);
04761 sv_upgrade(sv, t);
04762 return sv;
04763 }
04764
04765 #endif
04766
04767 #endif
04768
04769 #if (PERL_BCDVERSION < 0x5006000)
04770 # define D_PPP_CONSTPV_ARG(x) ((char *) (x))
04771 #else
04772 # define D_PPP_CONSTPV_ARG(x) (x)
04773 #endif
04774 #ifndef newSVpvn
04775 # define newSVpvn(data,len) ((data) \
04776 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
04777 : newSV(0))
04778 #endif
04779 #ifndef newSVpvn_utf8
04780 # define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
04781 #endif
04782 #ifndef SVf_UTF8
04783 # define SVf_UTF8 0
04784 #endif
04785
04786 #ifndef newSVpvn_flags
04787
04788 #if defined(NEED_newSVpvn_flags)
04789 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
04790 static
04791 #else
04792 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
04793 #endif
04794
04795 #ifdef newSVpvn_flags
04796 # undef newSVpvn_flags
04797 #endif
04798 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
04799 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
04800
04801 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
04802
04803 SV *
04804 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
04805 {
04806 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
04807 SvFLAGS(sv) |= (flags & SVf_UTF8);
04808 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
04809 }
04810
04811 #endif
04812
04813 #endif
04814
04815
04816 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
04817 # define NEED_sv_2pv_flags
04818 #endif
04819 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
04820 # define NEED_sv_2pv_flags_GLOBAL
04821 #endif
04822
04823
04824
04825
04826 #ifndef sv_2pv_nolen
04827 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
04828 #endif
04829
04830 #ifdef SvPVbyte
04831
04832
04833
04834
04835
04836
04837 #if (PERL_BCDVERSION < 0x5007000)
04838
04839 #if defined(NEED_sv_2pvbyte)
04840 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
04841 static
04842 #else
04843 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
04844 #endif
04845
04846 #ifdef sv_2pvbyte
04847 # undef sv_2pvbyte
04848 #endif
04849 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
04850 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
04851
04852 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
04853
04854 char *
04855 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
04856 {
04857 sv_utf8_downgrade(sv,0);
04858 return SvPV(sv,*lp);
04859 }
04860
04861 #endif
04862
04863
04864
04865
04866
04867 #undef SvPVbyte
04868
04869 #define SvPVbyte(sv, lp) \
04870 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
04871 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
04872
04873 #endif
04874
04875 #else
04876
04877 # define SvPVbyte SvPV
04878 # define sv_2pvbyte sv_2pv
04879
04880 #endif
04881 #ifndef sv_2pvbyte_nolen
04882 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
04883 #endif
04884
04885
04886
04887
04888
04889
04890
04891
04892
04893
04894 #ifndef SV_IMMEDIATE_UNREF
04895 # define SV_IMMEDIATE_UNREF 0
04896 #endif
04897
04898 #ifndef SV_GMAGIC
04899 # define SV_GMAGIC 0
04900 #endif
04901
04902 #ifndef SV_COW_DROP_PV
04903 # define SV_COW_DROP_PV 0
04904 #endif
04905
04906 #ifndef SV_UTF8_NO_ENCODING
04907 # define SV_UTF8_NO_ENCODING 0
04908 #endif
04909
04910 #ifndef SV_NOSTEAL
04911 # define SV_NOSTEAL 0
04912 #endif
04913
04914 #ifndef SV_CONST_RETURN
04915 # define SV_CONST_RETURN 0
04916 #endif
04917
04918 #ifndef SV_MUTABLE_RETURN
04919 # define SV_MUTABLE_RETURN 0
04920 #endif
04921
04922 #ifndef SV_SMAGIC
04923 # define SV_SMAGIC 0
04924 #endif
04925
04926 #ifndef SV_HAS_TRAILING_NUL
04927 # define SV_HAS_TRAILING_NUL 0
04928 #endif
04929
04930 #ifndef SV_COW_SHARED_HASH_KEYS
04931 # define SV_COW_SHARED_HASH_KEYS 0
04932 #endif
04933
04934 #if (PERL_BCDVERSION < 0x5007002)
04935
04936 #if defined(NEED_sv_2pv_flags)
04937 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04938 static
04939 #else
04940 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04941 #endif
04942
04943 #ifdef sv_2pv_flags
04944 # undef sv_2pv_flags
04945 #endif
04946 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
04947 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
04948
04949 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
04950
04951 char *
04952 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
04953 {
04954 STRLEN n_a = (STRLEN) flags;
04955 return sv_2pv(sv, lp ? lp : &n_a);
04956 }
04957
04958 #endif
04959
04960 #if defined(NEED_sv_pvn_force_flags)
04961 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04962 static
04963 #else
04964 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
04965 #endif
04966
04967 #ifdef sv_pvn_force_flags
04968 # undef sv_pvn_force_flags
04969 #endif
04970 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
04971 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
04972
04973 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
04974
04975 char *
04976 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
04977 {
04978 STRLEN n_a = (STRLEN) flags;
04979 return sv_pvn_force(sv, lp ? lp : &n_a);
04980 }
04981
04982 #endif
04983
04984 #endif
04985
04986 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
04987 # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
04988 #else
04989 # define DPPP_SVPV_NOLEN_LP_ARG 0
04990 #endif
04991 #ifndef SvPV_const
04992 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
04993 #endif
04994
04995 #ifndef SvPV_mutable
04996 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
04997 #endif
04998 #ifndef SvPV_flags
04999 # define SvPV_flags(sv, lp, flags) \
05000 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05001 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
05002 #endif
05003 #ifndef SvPV_flags_const
05004 # define SvPV_flags_const(sv, lp, flags) \
05005 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05006 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
05007 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
05008 #endif
05009 #ifndef SvPV_flags_const_nolen
05010 # define SvPV_flags_const_nolen(sv, flags) \
05011 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05012 ? SvPVX_const(sv) : \
05013 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
05014 #endif
05015 #ifndef SvPV_flags_mutable
05016 # define SvPV_flags_mutable(sv, lp, flags) \
05017 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05018 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
05019 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
05020 #endif
05021 #ifndef SvPV_force
05022 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
05023 #endif
05024
05025 #ifndef SvPV_force_nolen
05026 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
05027 #endif
05028
05029 #ifndef SvPV_force_mutable
05030 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
05031 #endif
05032
05033 #ifndef SvPV_force_nomg
05034 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
05035 #endif
05036
05037 #ifndef SvPV_force_nomg_nolen
05038 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
05039 #endif
05040 #ifndef SvPV_force_flags
05041 # define SvPV_force_flags(sv, lp, flags) \
05042 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
05043 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
05044 #endif
05045 #ifndef SvPV_force_flags_nolen
05046 # define SvPV_force_flags_nolen(sv, flags) \
05047 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
05048 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
05049 #endif
05050 #ifndef SvPV_force_flags_mutable
05051 # define SvPV_force_flags_mutable(sv, lp, flags) \
05052 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
05053 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
05054 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
05055 #endif
05056 #ifndef SvPV_nolen
05057 # define SvPV_nolen(sv) \
05058 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05059 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
05060 #endif
05061 #ifndef SvPV_nolen_const
05062 # define SvPV_nolen_const(sv) \
05063 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
05064 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
05065 #endif
05066 #ifndef SvPV_nomg
05067 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
05068 #endif
05069
05070 #ifndef SvPV_nomg_const
05071 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
05072 #endif
05073
05074 #ifndef SvPV_nomg_const_nolen
05075 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
05076 #endif
05077 #ifndef SvPV_renew
05078 # define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
05079 SvPV_set((sv), (char *) saferealloc( \
05080 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
05081 } STMT_END
05082 #endif
05083 #ifndef SvMAGIC_set
05084 # define SvMAGIC_set(sv, val) \
05085 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
05086 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
05087 #endif
05088
05089 #if (PERL_BCDVERSION < 0x5009003)
05090 #ifndef SvPVX_const
05091 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
05092 #endif
05093
05094 #ifndef SvPVX_mutable
05095 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
05096 #endif
05097 #ifndef SvRV_set
05098 # define SvRV_set(sv, val) \
05099 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
05100 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
05101 #endif
05102
05103 #else
05104 #ifndef SvPVX_const
05105 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
05106 #endif
05107
05108 #ifndef SvPVX_mutable
05109 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
05110 #endif
05111 #ifndef SvRV_set
05112 # define SvRV_set(sv, val) \
05113 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
05114 ((sv)->sv_u.svu_rv = (val)); } STMT_END
05115 #endif
05116
05117 #endif
05118 #ifndef SvSTASH_set
05119 # define SvSTASH_set(sv, val) \
05120 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
05121 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
05122 #endif
05123
05124 #if (PERL_BCDVERSION < 0x5004000)
05125 #ifndef SvUV_set
05126 # define SvUV_set(sv, val) \
05127 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
05128 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
05129 #endif
05130
05131 #else
05132 #ifndef SvUV_set
05133 # define SvUV_set(sv, val) \
05134 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
05135 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
05136 #endif
05137
05138 #endif
05139
05140 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
05141 #if defined(NEED_vnewSVpvf)
05142 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
05143 static
05144 #else
05145 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
05146 #endif
05147
05148 #ifdef vnewSVpvf
05149 # undef vnewSVpvf
05150 #endif
05151 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
05152 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
05153
05154 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
05155
05156 SV *
05157 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
05158 {
05159 register SV *sv = newSV(0);
05160 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
05161 return sv;
05162 }
05163
05164 #endif
05165 #endif
05166
05167 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
05168 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
05169 #endif
05170
05171 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
05172 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
05173 #endif
05174
05175 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
05176 #if defined(NEED_sv_catpvf_mg)
05177 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05178 static
05179 #else
05180 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05181 #endif
05182
05183 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
05184
05185 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
05186
05187 void
05188 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
05189 {
05190 va_list args;
05191 va_start(args, pat);
05192 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05193 SvSETMAGIC(sv);
05194 va_end(args);
05195 }
05196
05197 #endif
05198 #endif
05199
05200 #ifdef PERL_IMPLICIT_CONTEXT
05201 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
05202 #if defined(NEED_sv_catpvf_mg_nocontext)
05203 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05204 static
05205 #else
05206 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05207 #endif
05208
05209 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
05210 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
05211
05212 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
05213
05214 void
05215 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
05216 {
05217 dTHX;
05218 va_list args;
05219 va_start(args, pat);
05220 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05221 SvSETMAGIC(sv);
05222 va_end(args);
05223 }
05224
05225 #endif
05226 #endif
05227 #endif
05228
05229
05230 #ifndef sv_catpvf_mg
05231 # ifdef PERL_IMPLICIT_CONTEXT
05232 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
05233 # else
05234 # define sv_catpvf_mg Perl_sv_catpvf_mg
05235 # endif
05236 #endif
05237
05238 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
05239 # define sv_vcatpvf_mg(sv, pat, args) \
05240 STMT_START { \
05241 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
05242 SvSETMAGIC(sv); \
05243 } STMT_END
05244 #endif
05245
05246 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
05247 #if defined(NEED_sv_setpvf_mg)
05248 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05249 static
05250 #else
05251 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
05252 #endif
05253
05254 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
05255
05256 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
05257
05258 void
05259 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
05260 {
05261 va_list args;
05262 va_start(args, pat);
05263 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05264 SvSETMAGIC(sv);
05265 va_end(args);
05266 }
05267
05268 #endif
05269 #endif
05270
05271 #ifdef PERL_IMPLICIT_CONTEXT
05272 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
05273 #if defined(NEED_sv_setpvf_mg_nocontext)
05274 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05275 static
05276 #else
05277 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
05278 #endif
05279
05280 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
05281 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
05282
05283 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
05284
05285 void
05286 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
05287 {
05288 dTHX;
05289 va_list args;
05290 va_start(args, pat);
05291 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
05292 SvSETMAGIC(sv);
05293 va_end(args);
05294 }
05295
05296 #endif
05297 #endif
05298 #endif
05299
05300
05301 #ifndef sv_setpvf_mg
05302 # ifdef PERL_IMPLICIT_CONTEXT
05303 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
05304 # else
05305 # define sv_setpvf_mg Perl_sv_setpvf_mg
05306 # endif
05307 #endif
05308
05309 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
05310 # define sv_vsetpvf_mg(sv, pat, args) \
05311 STMT_START { \
05312 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
05313 SvSETMAGIC(sv); \
05314 } STMT_END
05315 #endif
05316
05317 #ifndef newSVpvn_share
05318
05319 #if defined(NEED_newSVpvn_share)
05320 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
05321 static
05322 #else
05323 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
05324 #endif
05325
05326 #ifdef newSVpvn_share
05327 # undef newSVpvn_share
05328 #endif
05329 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
05330 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
05331
05332 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
05333
05334 SV *
05335 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
05336 {
05337 SV *sv;
05338 if (len < 0)
05339 len = -len;
05340 if (!hash)
05341 PERL_HASH(hash, (char*) src, len);
05342 sv = newSVpvn((char *) src, len);
05343 sv_upgrade(sv, SVt_PVIV);
05344 SvIVX(sv) = hash;
05345 SvREADONLY_on(sv);
05346 SvPOK_on(sv);
05347 return sv;
05348 }
05349
05350 #endif
05351
05352 #endif
05353 #ifndef SvSHARED_HASH
05354 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
05355 #endif
05356 #ifndef HvNAME_get
05357 # define HvNAME_get(hv) HvNAME(hv)
05358 #endif
05359 #ifndef HvNAMELEN_get
05360 # define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
05361 #endif
05362 #ifndef GvSVn
05363 # define GvSVn(gv) GvSV(gv)
05364 #endif
05365
05366 #ifndef isGV_with_GP
05367 # define isGV_with_GP(gv) isGV(gv)
05368 #endif
05369 #ifndef WARN_ALL
05370 # define WARN_ALL 0
05371 #endif
05372
05373 #ifndef WARN_CLOSURE
05374 # define WARN_CLOSURE 1
05375 #endif
05376
05377 #ifndef WARN_DEPRECATED
05378 # define WARN_DEPRECATED 2
05379 #endif
05380
05381 #ifndef WARN_EXITING
05382 # define WARN_EXITING 3
05383 #endif
05384
05385 #ifndef WARN_GLOB
05386 # define WARN_GLOB 4
05387 #endif
05388
05389 #ifndef WARN_IO
05390 # define WARN_IO 5
05391 #endif
05392
05393 #ifndef WARN_CLOSED
05394 # define WARN_CLOSED 6
05395 #endif
05396
05397 #ifndef WARN_EXEC
05398 # define WARN_EXEC 7
05399 #endif
05400
05401 #ifndef WARN_LAYER
05402 # define WARN_LAYER 8
05403 #endif
05404
05405 #ifndef WARN_NEWLINE
05406 # define WARN_NEWLINE 9
05407 #endif
05408
05409 #ifndef WARN_PIPE
05410 # define WARN_PIPE 10
05411 #endif
05412
05413 #ifndef WARN_UNOPENED
05414 # define WARN_UNOPENED 11
05415 #endif
05416
05417 #ifndef WARN_MISC
05418 # define WARN_MISC 12
05419 #endif
05420
05421 #ifndef WARN_NUMERIC
05422 # define WARN_NUMERIC 13
05423 #endif
05424
05425 #ifndef WARN_ONCE
05426 # define WARN_ONCE 14
05427 #endif
05428
05429 #ifndef WARN_OVERFLOW
05430 # define WARN_OVERFLOW 15
05431 #endif
05432
05433 #ifndef WARN_PACK
05434 # define WARN_PACK 16
05435 #endif
05436
05437 #ifndef WARN_PORTABLE
05438 # define WARN_PORTABLE 17
05439 #endif
05440
05441 #ifndef WARN_RECURSION
05442 # define WARN_RECURSION 18
05443 #endif
05444
05445 #ifndef WARN_REDEFINE
05446 # define WARN_REDEFINE 19
05447 #endif
05448
05449 #ifndef WARN_REGEXP
05450 # define WARN_REGEXP 20
05451 #endif
05452
05453 #ifndef WARN_SEVERE
05454 # define WARN_SEVERE 21
05455 #endif
05456
05457 #ifndef WARN_DEBUGGING
05458 # define WARN_DEBUGGING 22
05459 #endif
05460
05461 #ifndef WARN_INPLACE
05462 # define WARN_INPLACE 23
05463 #endif
05464
05465 #ifndef WARN_INTERNAL
05466 # define WARN_INTERNAL 24
05467 #endif
05468
05469 #ifndef WARN_MALLOC
05470 # define WARN_MALLOC 25
05471 #endif
05472
05473 #ifndef WARN_SIGNAL
05474 # define WARN_SIGNAL 26
05475 #endif
05476
05477 #ifndef WARN_SUBSTR
05478 # define WARN_SUBSTR 27
05479 #endif
05480
05481 #ifndef WARN_SYNTAX
05482 # define WARN_SYNTAX 28
05483 #endif
05484
05485 #ifndef WARN_AMBIGUOUS
05486 # define WARN_AMBIGUOUS 29
05487 #endif
05488
05489 #ifndef WARN_BAREWORD
05490 # define WARN_BAREWORD 30
05491 #endif
05492
05493 #ifndef WARN_DIGIT
05494 # define WARN_DIGIT 31
05495 #endif
05496
05497 #ifndef WARN_PARENTHESIS
05498 # define WARN_PARENTHESIS 32
05499 #endif
05500
05501 #ifndef WARN_PRECEDENCE
05502 # define WARN_PRECEDENCE 33
05503 #endif
05504
05505 #ifndef WARN_PRINTF
05506 # define WARN_PRINTF 34
05507 #endif
05508
05509 #ifndef WARN_PROTOTYPE
05510 # define WARN_PROTOTYPE 35
05511 #endif
05512
05513 #ifndef WARN_QW
05514 # define WARN_QW 36
05515 #endif
05516
05517 #ifndef WARN_RESERVED
05518 # define WARN_RESERVED 37
05519 #endif
05520
05521 #ifndef WARN_SEMICOLON
05522 # define WARN_SEMICOLON 38
05523 #endif
05524
05525 #ifndef WARN_TAINT
05526 # define WARN_TAINT 39
05527 #endif
05528
05529 #ifndef WARN_THREADS
05530 # define WARN_THREADS 40
05531 #endif
05532
05533 #ifndef WARN_UNINITIALIZED
05534 # define WARN_UNINITIALIZED 41
05535 #endif
05536
05537 #ifndef WARN_UNPACK
05538 # define WARN_UNPACK 42
05539 #endif
05540
05541 #ifndef WARN_UNTIE
05542 # define WARN_UNTIE 43
05543 #endif
05544
05545 #ifndef WARN_UTF8
05546 # define WARN_UTF8 44
05547 #endif
05548
05549 #ifndef WARN_VOID
05550 # define WARN_VOID 45
05551 #endif
05552
05553 #ifndef WARN_ASSERTIONS
05554 # define WARN_ASSERTIONS 46
05555 #endif
05556 #ifndef packWARN
05557 # define packWARN(a) (a)
05558 #endif
05559
05560 #ifndef ckWARN
05561 # ifdef G_WARN_ON
05562 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
05563 # else
05564 # define ckWARN(a) PL_dowarn
05565 # endif
05566 #endif
05567
05568 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
05569 #if defined(NEED_warner)
05570 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
05571 static
05572 #else
05573 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
05574 #endif
05575
05576 #define Perl_warner DPPP_(my_warner)
05577
05578 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
05579
05580 void
05581 DPPP_(my_warner)(U32 err, const char *pat, ...)
05582 {
05583 SV *sv;
05584 va_list args;
05585
05586 PERL_UNUSED_ARG(err);
05587
05588 va_start(args, pat);
05589 sv = vnewSVpvf(pat, &args);
05590 va_end(args);
05591 sv_2mortal(sv);
05592 warn("%s", SvPV_nolen(sv));
05593 }
05594
05595 #define warner Perl_warner
05596
05597 #define Perl_warner_nocontext Perl_warner
05598
05599 #endif
05600 #endif
05601
05602
05603
05604
05605
05606 #ifndef STR_WITH_LEN
05607 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
05608 #endif
05609 #ifndef newSVpvs
05610 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
05611 #endif
05612
05613 #ifndef newSVpvs_flags
05614 # define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
05615 #endif
05616
05617 #ifndef sv_catpvs
05618 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
05619 #endif
05620
05621 #ifndef sv_setpvs
05622 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
05623 #endif
05624
05625 #ifndef hv_fetchs
05626 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
05627 #endif
05628
05629 #ifndef hv_stores
05630 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
05631 #endif
05632 #ifndef gv_fetchpvn_flags
05633 # define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
05634 #endif
05635
05636 #ifndef gv_fetchpvs
05637 # define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
05638 #endif
05639
05640 #ifndef gv_stashpvs
05641 # define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
05642 #endif
05643 #ifndef SvGETMAGIC
05644 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
05645 #endif
05646 #ifndef PERL_MAGIC_sv
05647 # define PERL_MAGIC_sv '\0'
05648 #endif
05649
05650 #ifndef PERL_MAGIC_overload
05651 # define PERL_MAGIC_overload 'A'
05652 #endif
05653
05654 #ifndef PERL_MAGIC_overload_elem
05655 # define PERL_MAGIC_overload_elem 'a'
05656 #endif
05657
05658 #ifndef PERL_MAGIC_overload_table
05659 # define PERL_MAGIC_overload_table 'c'
05660 #endif
05661
05662 #ifndef PERL_MAGIC_bm
05663 # define PERL_MAGIC_bm 'B'
05664 #endif
05665
05666 #ifndef PERL_MAGIC_regdata
05667 # define PERL_MAGIC_regdata 'D'
05668 #endif
05669
05670 #ifndef PERL_MAGIC_regdatum
05671 # define PERL_MAGIC_regdatum 'd'
05672 #endif
05673
05674 #ifndef PERL_MAGIC_env
05675 # define PERL_MAGIC_env 'E'
05676 #endif
05677
05678 #ifndef PERL_MAGIC_envelem
05679 # define PERL_MAGIC_envelem 'e'
05680 #endif
05681
05682 #ifndef PERL_MAGIC_fm
05683 # define PERL_MAGIC_fm 'f'
05684 #endif
05685
05686 #ifndef PERL_MAGIC_regex_global
05687 # define PERL_MAGIC_regex_global 'g'
05688 #endif
05689
05690 #ifndef PERL_MAGIC_isa
05691 # define PERL_MAGIC_isa 'I'
05692 #endif
05693
05694 #ifndef PERL_MAGIC_isaelem
05695 # define PERL_MAGIC_isaelem 'i'
05696 #endif
05697
05698 #ifndef PERL_MAGIC_nkeys
05699 # define PERL_MAGIC_nkeys 'k'
05700 #endif
05701
05702 #ifndef PERL_MAGIC_dbfile
05703 # define PERL_MAGIC_dbfile 'L'
05704 #endif
05705
05706 #ifndef PERL_MAGIC_dbline
05707 # define PERL_MAGIC_dbline 'l'
05708 #endif
05709
05710 #ifndef PERL_MAGIC_mutex
05711 # define PERL_MAGIC_mutex 'm'
05712 #endif
05713
05714 #ifndef PERL_MAGIC_shared
05715 # define PERL_MAGIC_shared 'N'
05716 #endif
05717
05718 #ifndef PERL_MAGIC_shared_scalar
05719 # define PERL_MAGIC_shared_scalar 'n'
05720 #endif
05721
05722 #ifndef PERL_MAGIC_collxfrm
05723 # define PERL_MAGIC_collxfrm 'o'
05724 #endif
05725
05726 #ifndef PERL_MAGIC_tied
05727 # define PERL_MAGIC_tied 'P'
05728 #endif
05729
05730 #ifndef PERL_MAGIC_tiedelem
05731 # define PERL_MAGIC_tiedelem 'p'
05732 #endif
05733
05734 #ifndef PERL_MAGIC_tiedscalar
05735 # define PERL_MAGIC_tiedscalar 'q'
05736 #endif
05737
05738 #ifndef PERL_MAGIC_qr
05739 # define PERL_MAGIC_qr 'r'
05740 #endif
05741
05742 #ifndef PERL_MAGIC_sig
05743 # define PERL_MAGIC_sig 'S'
05744 #endif
05745
05746 #ifndef PERL_MAGIC_sigelem
05747 # define PERL_MAGIC_sigelem 's'
05748 #endif
05749
05750 #ifndef PERL_MAGIC_taint
05751 # define PERL_MAGIC_taint 't'
05752 #endif
05753
05754 #ifndef PERL_MAGIC_uvar
05755 # define PERL_MAGIC_uvar 'U'
05756 #endif
05757
05758 #ifndef PERL_MAGIC_uvar_elem
05759 # define PERL_MAGIC_uvar_elem 'u'
05760 #endif
05761
05762 #ifndef PERL_MAGIC_vstring
05763 # define PERL_MAGIC_vstring 'V'
05764 #endif
05765
05766 #ifndef PERL_MAGIC_vec
05767 # define PERL_MAGIC_vec 'v'
05768 #endif
05769
05770 #ifndef PERL_MAGIC_utf8
05771 # define PERL_MAGIC_utf8 'w'
05772 #endif
05773
05774 #ifndef PERL_MAGIC_substr
05775 # define PERL_MAGIC_substr 'x'
05776 #endif
05777
05778 #ifndef PERL_MAGIC_defelem
05779 # define PERL_MAGIC_defelem 'y'
05780 #endif
05781
05782 #ifndef PERL_MAGIC_glob
05783 # define PERL_MAGIC_glob '*'
05784 #endif
05785
05786 #ifndef PERL_MAGIC_arylen
05787 # define PERL_MAGIC_arylen '#'
05788 #endif
05789
05790 #ifndef PERL_MAGIC_pos
05791 # define PERL_MAGIC_pos '.'
05792 #endif
05793
05794 #ifndef PERL_MAGIC_backref
05795 # define PERL_MAGIC_backref '<'
05796 #endif
05797
05798 #ifndef PERL_MAGIC_ext
05799 # define PERL_MAGIC_ext '~'
05800 #endif
05801
05802
05803 #ifndef sv_catpvn_nomg
05804 # define sv_catpvn_nomg sv_catpvn
05805 #endif
05806
05807 #ifndef sv_catsv_nomg
05808 # define sv_catsv_nomg sv_catsv
05809 #endif
05810
05811 #ifndef sv_setsv_nomg
05812 # define sv_setsv_nomg sv_setsv
05813 #endif
05814
05815 #ifndef sv_pvn_nomg
05816 # define sv_pvn_nomg sv_pvn
05817 #endif
05818
05819 #ifndef SvIV_nomg
05820 # define SvIV_nomg SvIV
05821 #endif
05822
05823 #ifndef SvUV_nomg
05824 # define SvUV_nomg SvUV
05825 #endif
05826
05827 #ifndef sv_catpv_mg
05828 # define sv_catpv_mg(sv, ptr) \
05829 STMT_START { \
05830 SV *TeMpSv = sv; \
05831 sv_catpv(TeMpSv,ptr); \
05832 SvSETMAGIC(TeMpSv); \
05833 } STMT_END
05834 #endif
05835
05836 #ifndef sv_catpvn_mg
05837 # define sv_catpvn_mg(sv, ptr, len) \
05838 STMT_START { \
05839 SV *TeMpSv = sv; \
05840 sv_catpvn(TeMpSv,ptr,len); \
05841 SvSETMAGIC(TeMpSv); \
05842 } STMT_END
05843 #endif
05844
05845 #ifndef sv_catsv_mg
05846 # define sv_catsv_mg(dsv, ssv) \
05847 STMT_START { \
05848 SV *TeMpSv = dsv; \
05849 sv_catsv(TeMpSv,ssv); \
05850 SvSETMAGIC(TeMpSv); \
05851 } STMT_END
05852 #endif
05853
05854 #ifndef sv_setiv_mg
05855 # define sv_setiv_mg(sv, i) \
05856 STMT_START { \
05857 SV *TeMpSv = sv; \
05858 sv_setiv(TeMpSv,i); \
05859 SvSETMAGIC(TeMpSv); \
05860 } STMT_END
05861 #endif
05862
05863 #ifndef sv_setnv_mg
05864 # define sv_setnv_mg(sv, num) \
05865 STMT_START { \
05866 SV *TeMpSv = sv; \
05867 sv_setnv(TeMpSv,num); \
05868 SvSETMAGIC(TeMpSv); \
05869 } STMT_END
05870 #endif
05871
05872 #ifndef sv_setpv_mg
05873 # define sv_setpv_mg(sv, ptr) \
05874 STMT_START { \
05875 SV *TeMpSv = sv; \
05876 sv_setpv(TeMpSv,ptr); \
05877 SvSETMAGIC(TeMpSv); \
05878 } STMT_END
05879 #endif
05880
05881 #ifndef sv_setpvn_mg
05882 # define sv_setpvn_mg(sv, ptr, len) \
05883 STMT_START { \
05884 SV *TeMpSv = sv; \
05885 sv_setpvn(TeMpSv,ptr,len); \
05886 SvSETMAGIC(TeMpSv); \
05887 } STMT_END
05888 #endif
05889
05890 #ifndef sv_setsv_mg
05891 # define sv_setsv_mg(dsv, ssv) \
05892 STMT_START { \
05893 SV *TeMpSv = dsv; \
05894 sv_setsv(TeMpSv,ssv); \
05895 SvSETMAGIC(TeMpSv); \
05896 } STMT_END
05897 #endif
05898
05899 #ifndef sv_setuv_mg
05900 # define sv_setuv_mg(sv, i) \
05901 STMT_START { \
05902 SV *TeMpSv = sv; \
05903 sv_setuv(TeMpSv,i); \
05904 SvSETMAGIC(TeMpSv); \
05905 } STMT_END
05906 #endif
05907
05908 #ifndef sv_usepvn_mg
05909 # define sv_usepvn_mg(sv, ptr, len) \
05910 STMT_START { \
05911 SV *TeMpSv = sv; \
05912 sv_usepvn(TeMpSv,ptr,len); \
05913 SvSETMAGIC(TeMpSv); \
05914 } STMT_END
05915 #endif
05916 #ifndef SvVSTRING_mg
05917 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
05918 #endif
05919
05920
05921
05922
05923
05924
05925
05926
05927
05928
05929
05930 #if (PERL_BCDVERSION < 0x5004000)
05931
05932
05933
05934 #elif (PERL_BCDVERSION < 0x5008000)
05935
05936 # define sv_magic_portable(sv, obj, how, name, namlen) \
05937 STMT_START { \
05938 SV *SvMp_sv = (sv); \
05939 char *SvMp_name = (char *) (name); \
05940 I32 SvMp_namlen = (namlen); \
05941 if (SvMp_name && SvMp_namlen == 0) \
05942 { \
05943 MAGIC *mg; \
05944 sv_magic(SvMp_sv, obj, how, 0, 0); \
05945 mg = SvMAGIC(SvMp_sv); \
05946 mg->mg_len = -42; \
05947 mg->mg_ptr = SvMp_name; \
05948 } \
05949 else \
05950 { \
05951 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
05952 } \
05953 } STMT_END
05954
05955 #else
05956
05957 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
05958
05959 #endif
05960
05961 #ifdef USE_ITHREADS
05962 #ifndef CopFILE
05963 # define CopFILE(c) ((c)->cop_file)
05964 #endif
05965
05966 #ifndef CopFILEGV
05967 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
05968 #endif
05969
05970 #ifndef CopFILE_set
05971 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
05972 #endif
05973
05974 #ifndef CopFILESV
05975 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
05976 #endif
05977
05978 #ifndef CopFILEAV
05979 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
05980 #endif
05981
05982 #ifndef CopSTASHPV
05983 # define CopSTASHPV(c) ((c)->cop_stashpv)
05984 #endif
05985
05986 #ifndef CopSTASHPV_set
05987 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
05988 #endif
05989
05990 #ifndef CopSTASH
05991 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
05992 #endif
05993
05994 #ifndef CopSTASH_set
05995 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
05996 #endif
05997
05998 #ifndef CopSTASH_eq
05999 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
06000 || (CopSTASHPV(c) && HvNAME(hv) \
06001 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
06002 #endif
06003
06004 #else
06005 #ifndef CopFILEGV
06006 # define CopFILEGV(c) ((c)->cop_filegv)
06007 #endif
06008
06009 #ifndef CopFILEGV_set
06010 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
06011 #endif
06012
06013 #ifndef CopFILE_set
06014 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
06015 #endif
06016
06017 #ifndef CopFILESV
06018 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
06019 #endif
06020
06021 #ifndef CopFILEAV
06022 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
06023 #endif
06024
06025 #ifndef CopFILE
06026 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
06027 #endif
06028
06029 #ifndef CopSTASH
06030 # define CopSTASH(c) ((c)->cop_stash)
06031 #endif
06032
06033 #ifndef CopSTASH_set
06034 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
06035 #endif
06036
06037 #ifndef CopSTASHPV
06038 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
06039 #endif
06040
06041 #ifndef CopSTASHPV_set
06042 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
06043 #endif
06044
06045 #ifndef CopSTASH_eq
06046 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
06047 #endif
06048
06049 #endif
06050 #ifndef IN_PERL_COMPILETIME
06051 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
06052 #endif
06053
06054 #ifndef IN_LOCALE_RUNTIME
06055 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
06056 #endif
06057
06058 #ifndef IN_LOCALE_COMPILETIME
06059 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
06060 #endif
06061
06062 #ifndef IN_LOCALE
06063 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
06064 #endif
06065 #ifndef IS_NUMBER_IN_UV
06066 # define IS_NUMBER_IN_UV 0x01
06067 #endif
06068
06069 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
06070 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
06071 #endif
06072
06073 #ifndef IS_NUMBER_NOT_INT
06074 # define IS_NUMBER_NOT_INT 0x04
06075 #endif
06076
06077 #ifndef IS_NUMBER_NEG
06078 # define IS_NUMBER_NEG 0x08
06079 #endif
06080
06081 #ifndef IS_NUMBER_INFINITY
06082 # define IS_NUMBER_INFINITY 0x10
06083 #endif
06084
06085 #ifndef IS_NUMBER_NAN
06086 # define IS_NUMBER_NAN 0x20
06087 #endif
06088 #ifndef GROK_NUMERIC_RADIX
06089 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
06090 #endif
06091 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
06092 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
06093 #endif
06094
06095 #ifndef PERL_SCAN_SILENT_ILLDIGIT
06096 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
06097 #endif
06098
06099 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
06100 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
06101 #endif
06102
06103 #ifndef PERL_SCAN_DISALLOW_PREFIX
06104 # define PERL_SCAN_DISALLOW_PREFIX 0x02
06105 #endif
06106
06107 #ifndef grok_numeric_radix
06108 #if defined(NEED_grok_numeric_radix)
06109 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
06110 static
06111 #else
06112 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
06113 #endif
06114
06115 #ifdef grok_numeric_radix
06116 # undef grok_numeric_radix
06117 #endif
06118 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
06119 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
06120
06121 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
06122 bool
06123 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
06124 {
06125 #ifdef USE_LOCALE_NUMERIC
06126 #ifdef PL_numeric_radix_sv
06127 if (PL_numeric_radix_sv && IN_LOCALE) {
06128 STRLEN len;
06129 char* radix = SvPV(PL_numeric_radix_sv, len);
06130 if (*sp + len <= send && memEQ(*sp, radix, len)) {
06131 *sp += len;
06132 return TRUE;
06133 }
06134 }
06135 #else
06136
06137
06138
06139 #include <locale.h>
06140 dTHR;
06141 struct lconv *lc = localeconv();
06142 char *radix = lc->decimal_point;
06143 if (radix && IN_LOCALE) {
06144 STRLEN len = strlen(radix);
06145 if (*sp + len <= send && memEQ(*sp, radix, len)) {
06146 *sp += len;
06147 return TRUE;
06148 }
06149 }
06150 #endif
06151 #endif
06152
06153
06154 if (*sp < send && **sp == '.') {
06155 ++*sp;
06156 return TRUE;
06157 }
06158 return FALSE;
06159 }
06160 #endif
06161 #endif
06162
06163 #ifndef grok_number
06164 #if defined(NEED_grok_number)
06165 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
06166 static
06167 #else
06168 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
06169 #endif
06170
06171 #ifdef grok_number
06172 # undef grok_number
06173 #endif
06174 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
06175 #define Perl_grok_number DPPP_(my_grok_number)
06176
06177 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
06178 int
06179 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
06180 {
06181 const char *s = pv;
06182 const char *send = pv + len;
06183 const UV max_div_10 = UV_MAX / 10;
06184 const char max_mod_10 = UV_MAX % 10;
06185 int numtype = 0;
06186 int sawinf = 0;
06187 int sawnan = 0;
06188
06189 while (s < send && isSPACE(*s))
06190 s++;
06191 if (s == send) {
06192 return 0;
06193 } else if (*s == '-') {
06194 s++;
06195 numtype = IS_NUMBER_NEG;
06196 }
06197 else if (*s == '+')
06198 s++;
06199
06200 if (s == send)
06201 return 0;
06202
06203
06204 if (isDIGIT(*s)) {
06205
06206
06207 UV value = *s - '0';
06208
06209
06210
06211
06212
06213 if (++s < send) {
06214 int digit = *s - '0';
06215 if (digit >= 0 && digit <= 9) {
06216 value = value * 10 + digit;
06217 if (++s < send) {
06218 digit = *s - '0';
06219 if (digit >= 0 && digit <= 9) {
06220 value = value * 10 + digit;
06221 if (++s < send) {
06222 digit = *s - '0';
06223 if (digit >= 0 && digit <= 9) {
06224 value = value * 10 + digit;
06225 if (++s < send) {
06226 digit = *s - '0';
06227 if (digit >= 0 && digit <= 9) {
06228 value = value * 10 + digit;
06229 if (++s < send) {
06230 digit = *s - '0';
06231 if (digit >= 0 && digit <= 9) {
06232 value = value * 10 + digit;
06233 if (++s < send) {
06234 digit = *s - '0';
06235 if (digit >= 0 && digit <= 9) {
06236 value = value * 10 + digit;
06237 if (++s < send) {
06238 digit = *s - '0';
06239 if (digit >= 0 && digit <= 9) {
06240 value = value * 10 + digit;
06241 if (++s < send) {
06242 digit = *s - '0';
06243 if (digit >= 0 && digit <= 9) {
06244 value = value * 10 + digit;
06245 if (++s < send) {
06246
06247
06248 digit = *s - '0';
06249 while (digit >= 0 && digit <= 9
06250 && (value < max_div_10
06251 || (value == max_div_10
06252 && digit <= max_mod_10))) {
06253 value = value * 10 + digit;
06254 if (++s < send)
06255 digit = *s - '0';
06256 else
06257 break;
06258 }
06259 if (digit >= 0 && digit <= 9
06260 && (s < send)) {
06261
06262
06263
06264 do {
06265 s++;
06266 } while (s < send && isDIGIT(*s));
06267 numtype |=
06268 IS_NUMBER_GREATER_THAN_UV_MAX;
06269 goto skip_value;
06270 }
06271 }
06272 }
06273 }
06274 }
06275 }
06276 }
06277 }
06278 }
06279 }
06280 }
06281 }
06282 }
06283 }
06284 }
06285 }
06286 }
06287 }
06288 numtype |= IS_NUMBER_IN_UV;
06289 if (valuep)
06290 *valuep = value;
06291
06292 skip_value:
06293 if (GROK_NUMERIC_RADIX(&s, send)) {
06294 numtype |= IS_NUMBER_NOT_INT;
06295 while (s < send && isDIGIT(*s))
06296 s++;
06297 }
06298 }
06299 else if (GROK_NUMERIC_RADIX(&s, send)) {
06300 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV;
06301
06302 if (s < send && isDIGIT(*s)) {
06303 do {
06304 s++;
06305 } while (s < send && isDIGIT(*s));
06306 if (valuep) {
06307
06308 *valuep = 0;
06309 }
06310 }
06311 else
06312 return 0;
06313 } else if (*s == 'I' || *s == 'i') {
06314 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06315 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
06316 s++; if (s < send && (*s == 'I' || *s == 'i')) {
06317 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06318 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
06319 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
06320 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
06321 s++;
06322 }
06323 sawinf = 1;
06324 } else if (*s == 'N' || *s == 'n') {
06325
06326 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
06327 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
06328 s++;
06329 sawnan = 1;
06330 } else
06331 return 0;
06332
06333 if (sawinf) {
06334 numtype &= IS_NUMBER_NEG;
06335 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
06336 } else if (sawnan) {
06337 numtype &= IS_NUMBER_NEG;
06338 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
06339 } else if (s < send) {
06340
06341 if (*s == 'e' || *s == 'E') {
06342
06343 numtype &= IS_NUMBER_NEG;
06344 numtype |= IS_NUMBER_NOT_INT;
06345 s++;
06346 if (s < send && (*s == '-' || *s == '+'))
06347 s++;
06348 if (s < send && isDIGIT(*s)) {
06349 do {
06350 s++;
06351 } while (s < send && isDIGIT(*s));
06352 }
06353 else
06354 return 0;
06355 }
06356 }
06357 while (s < send && isSPACE(*s))
06358 s++;
06359 if (s >= send)
06360 return numtype;
06361 if (len == 10 && memEQ(pv, "0 but true", 10)) {
06362 if (valuep)
06363 *valuep = 0;
06364 return IS_NUMBER_IN_UV;
06365 }
06366 return 0;
06367 }
06368 #endif
06369 #endif
06370
06371
06372
06373
06374
06375
06376
06377 #ifndef grok_bin
06378 #if defined(NEED_grok_bin)
06379 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06380 static
06381 #else
06382 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06383 #endif
06384
06385 #ifdef grok_bin
06386 # undef grok_bin
06387 #endif
06388 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
06389 #define Perl_grok_bin DPPP_(my_grok_bin)
06390
06391 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
06392 UV
06393 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06394 {
06395 const char *s = start;
06396 STRLEN len = *len_p;
06397 UV value = 0;
06398 NV value_nv = 0;
06399
06400 const UV max_div_2 = UV_MAX / 2;
06401 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06402 bool overflowed = FALSE;
06403
06404 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
06405
06406
06407
06408 if (len >= 1) {
06409 if (s[0] == 'b') {
06410 s++;
06411 len--;
06412 }
06413 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
06414 s+=2;
06415 len-=2;
06416 }
06417 }
06418 }
06419
06420 for (; len-- && *s; s++) {
06421 char bit = *s;
06422 if (bit == '0' || bit == '1') {
06423
06424
06425
06426 redo:
06427 if (!overflowed) {
06428 if (value <= max_div_2) {
06429 value = (value << 1) | (bit - '0');
06430 continue;
06431 }
06432
06433 warn("Integer overflow in binary number");
06434 overflowed = TRUE;
06435 value_nv = (NV) value;
06436 }
06437 value_nv *= 2.0;
06438
06439
06440
06441
06442
06443
06444 value_nv += (NV)(bit - '0');
06445 continue;
06446 }
06447 if (bit == '_' && len && allow_underscores && (bit = s[1])
06448 && (bit == '0' || bit == '1'))
06449 {
06450 --len;
06451 ++s;
06452 goto redo;
06453 }
06454 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06455 warn("Illegal binary digit '%c' ignored", *s);
06456 break;
06457 }
06458
06459 if ( ( overflowed && value_nv > 4294967295.0)
06460 #if UVSIZE > 4
06461 || (!overflowed && value > 0xffffffff )
06462 #endif
06463 ) {
06464 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
06465 }
06466 *len_p = s - start;
06467 if (!overflowed) {
06468 *flags = 0;
06469 return value;
06470 }
06471 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06472 if (result)
06473 *result = value_nv;
06474 return UV_MAX;
06475 }
06476 #endif
06477 #endif
06478
06479 #ifndef grok_hex
06480 #if defined(NEED_grok_hex)
06481 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06482 static
06483 #else
06484 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06485 #endif
06486
06487 #ifdef grok_hex
06488 # undef grok_hex
06489 #endif
06490 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
06491 #define Perl_grok_hex DPPP_(my_grok_hex)
06492
06493 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
06494 UV
06495 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06496 {
06497 const char *s = start;
06498 STRLEN len = *len_p;
06499 UV value = 0;
06500 NV value_nv = 0;
06501
06502 const UV max_div_16 = UV_MAX / 16;
06503 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06504 bool overflowed = FALSE;
06505 const char *xdigit;
06506
06507 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
06508
06509
06510
06511 if (len >= 1) {
06512 if (s[0] == 'x') {
06513 s++;
06514 len--;
06515 }
06516 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
06517 s+=2;
06518 len-=2;
06519 }
06520 }
06521 }
06522
06523 for (; len-- && *s; s++) {
06524 xdigit = strchr((char *) PL_hexdigit, *s);
06525 if (xdigit) {
06526
06527
06528
06529 redo:
06530 if (!overflowed) {
06531 if (value <= max_div_16) {
06532 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
06533 continue;
06534 }
06535 warn("Integer overflow in hexadecimal number");
06536 overflowed = TRUE;
06537 value_nv = (NV) value;
06538 }
06539 value_nv *= 16.0;
06540
06541
06542
06543
06544
06545
06546 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
06547 continue;
06548 }
06549 if (*s == '_' && len && allow_underscores && s[1]
06550 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
06551 {
06552 --len;
06553 ++s;
06554 goto redo;
06555 }
06556 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06557 warn("Illegal hexadecimal digit '%c' ignored", *s);
06558 break;
06559 }
06560
06561 if ( ( overflowed && value_nv > 4294967295.0)
06562 #if UVSIZE > 4
06563 || (!overflowed && value > 0xffffffff )
06564 #endif
06565 ) {
06566 warn("Hexadecimal number > 0xffffffff non-portable");
06567 }
06568 *len_p = s - start;
06569 if (!overflowed) {
06570 *flags = 0;
06571 return value;
06572 }
06573 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06574 if (result)
06575 *result = value_nv;
06576 return UV_MAX;
06577 }
06578 #endif
06579 #endif
06580
06581 #ifndef grok_oct
06582 #if defined(NEED_grok_oct)
06583 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06584 static
06585 #else
06586 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
06587 #endif
06588
06589 #ifdef grok_oct
06590 # undef grok_oct
06591 #endif
06592 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
06593 #define Perl_grok_oct DPPP_(my_grok_oct)
06594
06595 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
06596 UV
06597 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
06598 {
06599 const char *s = start;
06600 STRLEN len = *len_p;
06601 UV value = 0;
06602 NV value_nv = 0;
06603
06604 const UV max_div_8 = UV_MAX / 8;
06605 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
06606 bool overflowed = FALSE;
06607
06608 for (; len-- && *s; s++) {
06609
06610
06611 int digit = *s - '0';
06612 if (digit >= 0 && digit <= 7) {
06613
06614
06615
06616 redo:
06617 if (!overflowed) {
06618 if (value <= max_div_8) {
06619 value = (value << 3) | digit;
06620 continue;
06621 }
06622
06623 warn("Integer overflow in octal number");
06624 overflowed = TRUE;
06625 value_nv = (NV) value;
06626 }
06627 value_nv *= 8.0;
06628
06629
06630
06631
06632
06633
06634 value_nv += (NV)digit;
06635 continue;
06636 }
06637 if (digit == ('_' - '0') && len && allow_underscores
06638 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
06639 {
06640 --len;
06641 ++s;
06642 goto redo;
06643 }
06644
06645
06646
06647 if (digit == 8 || digit == 9) {
06648 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
06649 warn("Illegal octal digit '%c' ignored", *s);
06650 }
06651 break;
06652 }
06653
06654 if ( ( overflowed && value_nv > 4294967295.0)
06655 #if UVSIZE > 4
06656 || (!overflowed && value > 0xffffffff )
06657 #endif
06658 ) {
06659 warn("Octal number > 037777777777 non-portable");
06660 }
06661 *len_p = s - start;
06662 if (!overflowed) {
06663 *flags = 0;
06664 return value;
06665 }
06666 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
06667 if (result)
06668 *result = value_nv;
06669 return UV_MAX;
06670 }
06671 #endif
06672 #endif
06673
06674 #if !defined(my_snprintf)
06675 #if defined(NEED_my_snprintf)
06676 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
06677 static
06678 #else
06679 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
06680 #endif
06681
06682 #define my_snprintf DPPP_(my_my_snprintf)
06683 #define Perl_my_snprintf DPPP_(my_my_snprintf)
06684
06685 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
06686
06687 int
06688 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
06689 {
06690 dTHX;
06691 int retval;
06692 va_list ap;
06693 va_start(ap, format);
06694 #ifdef HAS_VSNPRINTF
06695 retval = vsnprintf(buffer, len, format, ap);
06696 #else
06697 retval = vsprintf(buffer, format, ap);
06698 #endif
06699 va_end(ap);
06700 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
06701 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
06702 return retval;
06703 }
06704
06705 #endif
06706 #endif
06707
06708 #if !defined(my_sprintf)
06709 #if defined(NEED_my_sprintf)
06710 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
06711 static
06712 #else
06713 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
06714 #endif
06715
06716 #define my_sprintf DPPP_(my_my_sprintf)
06717 #define Perl_my_sprintf DPPP_(my_my_sprintf)
06718
06719 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
06720
06721 int
06722 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
06723 {
06724 va_list args;
06725 va_start(args, pat);
06726 vsprintf(buffer, pat, args);
06727 va_end(args);
06728 return strlen(buffer);
06729 }
06730
06731 #endif
06732 #endif
06733
06734 #ifdef NO_XSLOCKS
06735 # ifdef dJMPENV
06736 # define dXCPT dJMPENV; int rEtV = 0
06737 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
06738 # define XCPT_TRY_END JMPENV_POP;
06739 # define XCPT_CATCH if (rEtV != 0)
06740 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
06741 # else
06742 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
06743 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
06744 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
06745 # define XCPT_CATCH if (rEtV != 0)
06746 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
06747 # endif
06748 #endif
06749
06750 #if !defined(my_strlcat)
06751 #if defined(NEED_my_strlcat)
06752 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
06753 static
06754 #else
06755 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
06756 #endif
06757
06758 #define my_strlcat DPPP_(my_my_strlcat)
06759 #define Perl_my_strlcat DPPP_(my_my_strlcat)
06760
06761 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
06762
06763 Size_t
06764 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
06765 {
06766 Size_t used, length, copy;
06767
06768 used = strlen(dst);
06769 length = strlen(src);
06770 if (size > 0 && used < size - 1) {
06771 copy = (length >= size - used) ? size - used - 1 : length;
06772 memcpy(dst + used, src, copy);
06773 dst[used + copy] = '\0';
06774 }
06775 return used + length;
06776 }
06777 #endif
06778 #endif
06779
06780 #if !defined(my_strlcpy)
06781 #if defined(NEED_my_strlcpy)
06782 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
06783 static
06784 #else
06785 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
06786 #endif
06787
06788 #define my_strlcpy DPPP_(my_my_strlcpy)
06789 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
06790
06791 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
06792
06793 Size_t
06794 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
06795 {
06796 Size_t length, copy;
06797
06798 length = strlen(src);
06799 if (size > 0) {
06800 copy = (length >= size) ? size - 1 : length;
06801 memcpy(dst, src, copy);
06802 dst[copy] = '\0';
06803 }
06804 return length;
06805 }
06806
06807 #endif
06808 #endif
06809 #ifndef PERL_PV_ESCAPE_QUOTE
06810 # define PERL_PV_ESCAPE_QUOTE 0x0001
06811 #endif
06812
06813 #ifndef PERL_PV_PRETTY_QUOTE
06814 # define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
06815 #endif
06816
06817 #ifndef PERL_PV_PRETTY_ELLIPSES
06818 # define PERL_PV_PRETTY_ELLIPSES 0x0002
06819 #endif
06820
06821 #ifndef PERL_PV_PRETTY_LTGT
06822 # define PERL_PV_PRETTY_LTGT 0x0004
06823 #endif
06824
06825 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
06826 # define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
06827 #endif
06828
06829 #ifndef PERL_PV_ESCAPE_UNI
06830 # define PERL_PV_ESCAPE_UNI 0x0100
06831 #endif
06832
06833 #ifndef PERL_PV_ESCAPE_UNI_DETECT
06834 # define PERL_PV_ESCAPE_UNI_DETECT 0x0200
06835 #endif
06836
06837 #ifndef PERL_PV_ESCAPE_ALL
06838 # define PERL_PV_ESCAPE_ALL 0x1000
06839 #endif
06840
06841 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
06842 # define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
06843 #endif
06844
06845 #ifndef PERL_PV_ESCAPE_NOCLEAR
06846 # define PERL_PV_ESCAPE_NOCLEAR 0x4000
06847 #endif
06848
06849 #ifndef PERL_PV_ESCAPE_RE
06850 # define PERL_PV_ESCAPE_RE 0x8000
06851 #endif
06852
06853 #ifndef PERL_PV_PRETTY_NOCLEAR
06854 # define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
06855 #endif
06856 #ifndef PERL_PV_PRETTY_DUMP
06857 # define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
06858 #endif
06859
06860 #ifndef PERL_PV_PRETTY_REGPROP
06861 # define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
06862 #endif
06863
06864
06865
06866
06867
06868
06869
06870 #ifndef pv_escape
06871 #if defined(NEED_pv_escape)
06872 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);
06873 static
06874 #else
06875 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);
06876 #endif
06877
06878 #ifdef pv_escape
06879 # undef pv_escape
06880 #endif
06881 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
06882 #define Perl_pv_escape DPPP_(my_pv_escape)
06883
06884 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
06885
06886 char *
06887 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
06888 const STRLEN count, const STRLEN max,
06889 STRLEN * const escaped, const U32 flags)
06890 {
06891 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
06892 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
06893 char octbuf[32] = "%123456789ABCDF";
06894 STRLEN wrote = 0;
06895 STRLEN chsize = 0;
06896 STRLEN readsize = 1;
06897 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06898 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
06899 #endif
06900 const char *pv = str;
06901 const char * const end = pv + count;
06902 octbuf[0] = esc;
06903
06904 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
06905 sv_setpvs(dsv, "");
06906
06907 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06908 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
06909 isuni = 1;
06910 #endif
06911
06912 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
06913 const UV u =
06914 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
06915 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
06916 #endif
06917 (U8)*pv;
06918 const U8 c = (U8)u & 0xFF;
06919
06920 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
06921 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
06922 chsize = my_snprintf(octbuf, sizeof octbuf,
06923 "%"UVxf, u);
06924 else
06925 chsize = my_snprintf(octbuf, sizeof octbuf,
06926 "%cx{%"UVxf"}", esc, u);
06927 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
06928 chsize = 1;
06929 } else {
06930 if (c == dq || c == esc || !isPRINT(c)) {
06931 chsize = 2;
06932 switch (c) {
06933 case '\\' :
06934 case '%' : if (c == esc)
06935 octbuf[1] = esc;
06936 else
06937 chsize = 1;
06938 break;
06939 case '\v' : octbuf[1] = 'v'; break;
06940 case '\t' : octbuf[1] = 't'; break;
06941 case '\r' : octbuf[1] = 'r'; break;
06942 case '\n' : octbuf[1] = 'n'; break;
06943 case '\f' : octbuf[1] = 'f'; break;
06944 case '"' : if (dq == '"')
06945 octbuf[1] = '"';
06946 else
06947 chsize = 1;
06948 break;
06949 default: chsize = my_snprintf(octbuf, sizeof octbuf,
06950 pv < end && isDIGIT((U8)*(pv+readsize))
06951 ? "%c%03o" : "%c%o", esc, c);
06952 }
06953 } else {
06954 chsize = 1;
06955 }
06956 }
06957 if (max && wrote + chsize > max) {
06958 break;
06959 } else if (chsize > 1) {
06960 sv_catpvn(dsv, octbuf, chsize);
06961 wrote += chsize;
06962 } else {
06963 char tmp[2];
06964 my_snprintf(tmp, sizeof tmp, "%c", c);
06965 sv_catpvn(dsv, tmp, 1);
06966 wrote++;
06967 }
06968 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
06969 break;
06970 }
06971 if (escaped != NULL)
06972 *escaped= pv - str;
06973 return SvPVX(dsv);
06974 }
06975
06976 #endif
06977 #endif
06978
06979 #ifndef pv_pretty
06980 #if defined(NEED_pv_pretty)
06981 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);
06982 static
06983 #else
06984 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);
06985 #endif
06986
06987 #ifdef pv_pretty
06988 # undef pv_pretty
06989 #endif
06990 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
06991 #define Perl_pv_pretty DPPP_(my_pv_pretty)
06992
06993 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
06994
06995 char *
06996 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
06997 const STRLEN max, char const * const start_color, char const * const end_color,
06998 const U32 flags)
06999 {
07000 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
07001 STRLEN escaped;
07002
07003 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
07004 sv_setpvs(dsv, "");
07005
07006 if (dq == '"')
07007 sv_catpvs(dsv, "\"");
07008 else if (flags & PERL_PV_PRETTY_LTGT)
07009 sv_catpvs(dsv, "<");
07010
07011 if (start_color != NULL)
07012 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
07013
07014 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
07015
07016 if (end_color != NULL)
07017 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
07018
07019 if (dq == '"')
07020 sv_catpvs(dsv, "\"");
07021 else if (flags & PERL_PV_PRETTY_LTGT)
07022 sv_catpvs(dsv, ">");
07023
07024 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
07025 sv_catpvs(dsv, "...");
07026
07027 return SvPVX(dsv);
07028 }
07029
07030 #endif
07031 #endif
07032
07033 #ifndef pv_display
07034 #if defined(NEED_pv_display)
07035 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
07036 static
07037 #else
07038 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
07039 #endif
07040
07041 #ifdef pv_display
07042 # undef pv_display
07043 #endif
07044 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
07045 #define Perl_pv_display DPPP_(my_pv_display)
07046
07047 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
07048
07049 char *
07050 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
07051 {
07052 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
07053 if (len > cur && pv[cur] == '\0')
07054 sv_catpvs(dsv, "\\0");
07055 return SvPVX(dsv);
07056 }
07057
07058 #endif
07059 #endif
07060
07061 #endif
07062
07063