/usr/share/perl5/Language/INTERCAL/SymbolTable.pm is in clc-intercal 1:1.0~4pre1.-94.-2-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | package Language::INTERCAL::SymbolTable;
# Symbol table; it is separate from the parser because we have one symbol
# table per object, which can have many parsers.
# This file is part of CLC-INTERCAL
# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.
use strict;
use vars qw($VERSION $PERVERSION);
($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/SymbolTable.pm 1.-94.-2") =~ /\s(\S+)$/;
use Carp;
use Language::INTERCAL::Exporter '1.-94.-2';
sub new {
@_ == 1 or croak "Usage: new Language::INTERCAL::SymbolTable";
my ($class) = @_;
bless {
symbols => [''],
symbolindex => {},
}, $class;
}
sub find {
@_ == 2 || @_ == 3
or croak "Usage: SYMBOLTABLE->find(STRING[, SKIP_CREATION])";
my ($table, $symbol, $skip) = @_;
$symbol = uc $symbol;
if (! exists $table->{symbolindex}{$symbol}) {
return 0 if $skip;
$table->{symbolindex}{$symbol} = @{$table->{symbols}};
push @{$table->{symbols}}, $symbol;
}
$table->{symbolindex}{$symbol};
}
sub symbol {
@_ == 2 or croak "Usage: SYMBOLTABLE->symbol(NUMBER)";
my ($table, $symbol) = @_;
return '' if $symbol !~ /^\d+$/ || $symbol >= @{$table->{symbols}};
$table->{symbols}[$symbol];
}
sub max {
@_ == 1 or croak "Usage: SYMBOLTABLE->max";
my ($table) = @_;
scalar @{$table->{symbols}} - 1;
}
sub read {
@_ == 2 or croak "Usage: SYMBOLTABLE->read(FILEHANDLE)";
my ($table, $fh) = @_;
my $slist = $table->{symbols};
$fh->read_binary(pack('v', scalar @$slist));
for (my $symbol = 1; $symbol < @$slist; $symbol++) {
my $sym = $slist->[$symbol];
$fh->read_binary(pack('v/a*', $sym));
}
$table;
}
sub write {
@_ == 2 or croak "Usage: write Language::INTERCAL::SymbolTable(FILEHANDLE)";
my ($class, $fh) = @_;
my $nsymbols = unpack('v', $fh->write_binary(2)) || 0;
my @symbols = ('');
my %symbolindex = ();
for (my $symbol = 1; $symbol < $nsymbols; $symbol++) {
my $nlen = unpack('v', $fh->write_binary(2));
my $name = $fh->write_binary($nlen);
$symbolindex{$name} = @symbols;
push @symbols, $name;
}
bless {
symbols => \@symbols,
symbolindex => \%symbolindex,
}, $class;
}
1;
|