Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/quotes.bli
There are no other files named quotes.bli in the archive.
module quotes ( ! Enquote and dequote a string.
ident = '1',
%if
%bliss(bliss32)
%then
language(bliss32),
addressing_mode(external=long_relative,
nonexternal=long_relative)
%else
language(bliss36)
%fi
) =
begin
!
! COPYRIGHT (C) 1982 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! Facility: CMS Library Processor
!
! Abstract:
!
! This module contains routines for processing quoted strings.
!
! Environment: Transportable
!
! Author: Earl Van Horn Creation Date: May, 1980
!
!--
!
! Table of Contents:
!
forward routine
dequot : novalue, ! Remove quotes.
enquot, ! Enclose in quotes.
tstquot; ! Test if valid quoted string
!
! Include Files:
!
library 'XPORT:' ;
%if %bliss(bliss32) %then
LIBRARY 'sys$library:starlet';
%else
REQUIRE 'jsys:';
%fi
require 'BLISSX:' ;
!
! Macros:
!
!
! Equated Symbols:
!
!
! Own Storage:
!
!
! External References:
!
external routine
bug : novalue, ! Report a bug.
maksad ; ! Allocate a string and descriptor.
global routine dequot(a_quoted_string) : novalue =
!++
! Functional Description:
!
! This routine removes the leading and trailing quotation marks
! from a quoted string, and reduces each embedded pair of quotation marks
! to one quotation mark. The descriptor is changed, but the buffer
! is not, unless there are embedded quotation pairs. In that case, the
! characters after each pair are shifted left to reduce the pair to
! a single quotation mark.
!
! Formal Parameters:
!
! a_quoted_string:Address of the descriptor of the quoted string. The
! pointer will be incremented by one character, and
! the length will be reduced by one for the leading
! quote, by one for the trailing quote if any, and by
! one for each embedded quotation pair. Portions of the
! string denoted by the descriptor will be shifted
! left to reduce quotation pairs to one quotation.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! None
!
!--
begin ! DEQUOT
bind
quoted_string = .a_quoted_string : desc_block ;
local
p_this ; ! Pointer to current character.
! Validate the string.
if .quoted_string[desc_len] lss 2
then
bug(lit('DEQUOT was given less than two characters')) ;
if ch$rchar(.quoted_string[desc_ptr]) neq %c'"'
then
bug(cat('DEQUOT needs leading quotation in: ', quoted_string)) ;
if ch$rchar(ch$plus(.quoted_string[desc_ptr], .quoted_string[desc_len] -1))
neq %c'"'
then
bug(cat('DEQUOT needs trailing quotation in: ', quoted_string)) ;
! Strip the leading and trailing quotes.
quoted_string[desc_ptr] = ch$plus(.quoted_string[desc_ptr], 1) ;
quoted_string[desc_len] = .quoted_string[desc_len] - 2 ;
! Redure all quote pairs to one quote.
p_this = .quoted_string[desc_ptr] ;
do
begin ! Find and reduce one pair.
p_this = ch$find_sub(.quoted_string[desc_len]
- ch$diff(.p_this, .quoted_string[desc_ptr]),
.p_this, 2, ch$ptr(uplit('""'))) ;
if not ch$fail(.p_this)
then
begin ! Eliminate the second quote.
local
p_dest, ! Pointer to next byte to be changed.
p_source ; ! Pointer to next char. to be moved.
p_dest = ch$plus(.p_this, 1) ; ! To second quote.
p_source = ch$plus(.p_dest, 1) ;
p_this = .p_dest ; ! Resume search at next new character.
while ch$diff(.p_source, .quoted_string[desc_ptr])
lss .quoted_string[desc_len]
do
ch$wchar_a(ch$rchar_a(p_source), p_dest) ;
quoted_string[desc_len] = .quoted_string[desc_len] - 1 ;
end ; ! Eliminate the second quote.
end ! Find and reduce one pair.
until
ch$fail(.p_this) ;
end ; ! DEQUOT
global routine enquot(a_text) =
!++
! Functional Description:
!
! This routine makes a copy of an arbitrary string, enclosing the
! string in quotation marks, and doubling each quotation mark within
! the string.
!
! The copy is allocated in dynamic memory, and may be freed by calling
! FRESAD.
!
! Formal Parameters:
!
! a_text: Address of a descriptor of the string to be enquoted.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! The address of a descriptor of the enquoted string. The descriptor
! and the string are dynamically allocated, and may be freed by
! passing the address of the descriptor to FRESAD.
!
! Side Effects:
!
! Dynamic storage is allocated by calling ZALLOC.
!
!--
begin ! ENQUOT
bind
text = .a_text : desc_block ;
local
char, ! Character being copied.
embedded_quotes, ! The number of quotation marks in TEXT.
p_dest, ! Pointer to destination byte.
p_source, ! Pointer to character being copied.
r_quoted : ref desc_block ; ! Address of quoted string being formed.
! Check if string is already quoted
if TstQuot(text)
then
begin ! string is already quoted
r_quoted = maksad(.text[desc_len]); ! allocate for copy of original
ch$move(len_comma_ptr(text),
.r_quoted[desc_ptr]);
return .r_quoted;
end;
! Count the number of embedded quotation marks.
embedded_quotes = 0 ;
p_source = .text[desc_ptr] ;
incr i from 0 to .text[desc_len] - 1 do
if ch$rchar_a(p_source) eql %c'"'
then
embedded_quotes = .embedded_quotes + 1 ;
! Obtain the storage for the quoted string.
r_quoted = maksad(.text[desc_len] + 2 + .embedded_quotes) ;
! Put in the first quotation mark.
p_dest = .r_quoted[desc_ptr] ;
ch$wchar_a(%c'"', p_dest) ;
! Fill in the guts of the quoted string.
p_source = .text[desc_ptr] ;
incr i from 0 to .text[desc_len] - 1 do
begin ! Fill the guts.
char = ch$rchar_a(p_source) ;
ch$wchar_a(.char, p_dest) ;
if .char eql %c'"'
then
ch$wchar_a(%c'"', p_dest) ;
end ; ! Fill the guts.
! Put in the last quotation mark.
ch$wchar(%c'"', .p_dest) ;
.r_quoted
end ; ! ENQUOT
GLOBAL ROUTINE TstQuot (a_d_Text) =
!++
! Functional Description:
!
! This routine scans a string and determines if it is a valid
! quoted string, i.e. starts and ends with a quote, and all
! quotes inbetween are paired. Note that the starting and
! ending quotes can not be the same character.
!
! Formal Parameters:
!
! a_d_text: Address of a descriptor of the string to be tested.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! true - valid quoted string
! false - not a valid quoted string
!
! Side Effects:
!
! None
!
!--
begin
bind
d_text = .a_d_text : desc_block;
local
char, ! hold current character during scan
cs_ptr, ! temp pointer used to scan string
quote_count; ! count of consecutive quotes
! To be a valid quoted string, its length must be >= 2
if .d_text[desc_len] lss 2
then
return false;
! Check if first character is a quote
if ch$rchar(.d_text[desc_ptr]) neq %c'"'
then
return false;
! Check if last character is a quote
if ch$rchar(ch$plus(.d_text[desc_ptr],.d_text[desc_len]-1)) neq %c'"'
then
return false;
!+
! The string begins with and ends with a quote mark. Now scan
! the part of string that is between the quotes. If an odd number
! of consecutive quotes are found, the string is not valid.
!-
cs_ptr = .d_text[desc_ptr]; ! get pointer to first quote
ch$rchar_a(cs_ptr); ! advance pointer to next char
quote_count = 0;
incr I from 0 to .d_text[desc_len]-3 do
begin
char = ch$rchar_a(cs_ptr);
if .char eql %c'"'
then
quote_count = .quote_count+1
else
begin
if .quote_count
then
return false;
quote_count = 0;
end;
end;
return true; ! all test have past
end; !(of routine TstQuot)
end ! Module QUOTES
eludom