-- file Translit.mesa
-- last modified by Satterthwaite, 9-Mar-82 14:20:14
DIRECTORY
Ascii: TYPE USING [CR, SP, TAB],
DCSFileTypes: TYPE USING [tLeaderPage],
Directory: TYPE USING [CreateFile, Error, Lookup, UpdateDates, ignore],
Exec: TYPE USING [AddCommand, commandLine, w],
File: TYPE USING [Capability, Permissions, delete, grow, read, shrink, write],
FileStream: TYPE USING [Create, EndOf],
Stream: TYPE USING [Handle, Delete, GetChar, PutChar],
TTY: TYPE USING [Handle, GetLine, LineOverflow, PutChar, Rubout];
Translit: PROGRAM
IMPORTS Directory, Exec, FileStream, Stream, TTY = {
-- characters and strings
MAXCHAR: NAT = LAST[CHARACTER] - 0c;
MAXSTR: NAT = 100;
character: TYPE = [-1..MAXCHAR];
string: TYPE = PACKED ARRAY [1..MAXSTR] OF character;
ENDFILE: character = -1;
ENDSTR: character = 0;
BACKSPACE: character = 9;
TAB: character = 9;
NEWLINE: character = 13;
BLANK: character = 32;
ESCAPE: character = ord['@];
-- file descriptors and io-related stuff
MAXOPEN: NAT = 10;
filedesc: TYPE = [0..MAXOPEN];
IOERROR: filedesc = 0;
STDIN: filedesc = 1;
STDOUT: filedesc = 2;
STDERR: filedesc = 3;
IOREAD: INTEGER = 1;
IOWRITE: INTEGER = 2;
IOBOTH: INTEGER = 3;
-- standard (Pascal) procedures
ord: PROC [c: CHARACTER] RETURNS [character] = INLINE {RETURN [c - 0c]};
chr: PROC [c: character] RETURNS [CHARACTER] = INLINE {RETURN [c + 0c]};
-- file primitives
tty: TTY.Handle;
kbdline: STRING ← [MAXSTR];
kbdx: CARDINAL;
kbdend: BOOLEAN;
readkbd: PROC = {
IF (kbdend) THEN
kbdline.length ← 0
ELSE {
ENABLE {
TTY.LineOverflow => {
putcf[NEWLINE, STDERR];
message["*** line too long"L];
putcf[NEWLINE, STDERR];
RETRY};
TTY.Rubout => {
IF (kbdline.length) > 0 THEN
RESUME
ELSE {
kbdend ← TRUE;
CONTINUE}}};
IF (kbdline.length > 0)
AND (kbdline[kbdline.length-1] = Ascii.CR) THEN
kbdline.length ← kbdline.length - 1; -- for ESC
tty.GetLine[kbdline];
IF kbdline.length >= kbdline.maxlength THEN
[] ← ERROR TTY.LineOverflow[kbdline];
kbdline[kbdline.length] ← Ascii.CR;
kbdline.length ← kbdline.length + 1};
kbdx ← 0};
filerec: TYPE = RECORD [
type: {none, stream, tty} ← none,
handle: Stream.Handle ← NIL];
filetab: ARRAY filedesc OF filerec;
accessmap: PROC [mode: INTEGER] RETURNS [File.Permissions] = {
RETURN [SELECT mode FROM
IOREAD => File.read,
IOWRITE => File.write + File.grow + File.shrink + File.delete,
IOBOTH => File.read + File.write + File.grow + File.shrink + File.delete,
ENDCASE => File.read]};
fdalloc: PROC RETURNS [fd: filedesc] = {
-- find a free slot in filetab
FOR fd IN (STDERR .. MAXOPEN] DO
IF (filetab[fd].type = none) THEN EXIT
REPEAT
FINISHED => fd ← IOERROR;
ENDLOOP;
RETURN};
fileerror: ERROR = CODE;
findfile: PROC [name: STRING, access: File.Permissions]
RETURNS [File.Capability] = {
cap: File.Capability;
old: BOOLEAN ← (access = File.read);
IF ~old THEN {
cap ← Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
! Directory.Error => {
IF type = fileAlreadyExists THEN GOTO fileExists
ELSE GO TO fileProblem}];
EXITS
fileExists => old ← TRUE};
IF old THEN
cap ← Directory.Lookup[fileName: name, permissions: Directory.ignore
! Directory.Error => {GO TO fileProblem}];
RETURN [Directory.UpdateDates[cap, access]]
EXITS
fileProblem => ERROR fileerror};
makestream: PROC [name: POINTER TO string, mode: INTEGER, fd: filedesc] = {
i: INTEGER ← 0;
intname: STRING ← [MAXSTR];
WHILE (name[i+1] # ENDSTR) DO
intname[i] ← chr[name[i+1]];
i ← i + 1;
ENDLOOP;
intname.length ← i;
filetab[fd] ← [
type: stream,
handle: FileStream.Create[findfile[intname, accessmap[mode]]]]};
open: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [fd: filedesc] = {
fd ← fdalloc[];
IF fd # IOERROR THEN {
makestream[name, mode, fd ! fileerror => {GOTO fail}];
EXITS fail => {filetab[fd] ← [type: none]; fd ← IOERROR}};
RETURN};
create: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [filedesc] = open;
-- check positioning of files opened for output
close: PROC [fd: filedesc] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
Stream.Delete[h]};
tty => NULL;
ENDCASE => NULL;
filetab[fd] ← [type: none]};
remove: PROC [s: POINTER TO string] = {
-- this version just prints a message
message["If we had remove, we would be deleting "L];
putcf[TAB, STDERR];
putstr[s, STDERR];
putcf[NEWLINE, STDERR]};
getc: PROC [c: POINTER TO character] RETURNS [character] = INLINE {
RETURN [getcf[c, STDIN]]};
getcf: PROC [c: POINTER TO character, fd: filedesc] RETURNS [character] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
c↑ ← IF FileStream.EndOf[h] THEN ENDFILE ELSE ord[h.GetChar[]]};
tty =>
IF (kbdx < kbdline.length) THEN {
c↑ ← ord[kbdline[kbdx]];
kbdx ← kbdx + 1}
ELSE {
readkbd[];
IF (kbdline.length = 0) THEN -- iff kbdend
c↑ ← ENDFILE
ELSE {
c↑ ← ord[kbdline[kbdx]];
kbdx ← kbdx + 1}};
ENDCASE => error["bad file descriptor"L];
RETURN [c↑]};
getline: PROC [s: POINTER TO string, fd: filedesc, maxsize: INTEGER ← MAXSTR]
RETURNS [BOOLEAN] = {
i: INTEGER ← 1;
c: character;
DO
s[i] ← getcf[@c, fd];
i ← i + 1;
IF (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize) THEN EXIT
ENDLOOP;
IF (c = ENDFILE) THEN -- went one too far
i ← i - 1;
s[i] ← ENDSTR;
RETURN [c # ENDFILE]};
putc: PROC [c: character] = INLINE {putcf[c, STDOUT]};
putcf: PROC [c: character, fd: filedesc] = {
SELECT filetab[fd].type FROM
stream => {
h: Stream.Handle = filetab[fd].handle;
h.PutChar[chr[c]]};
tty => tty.PutChar[chr[c]];
ENDCASE => error["bad file descriptor"L]};
putstr: PROC [s: POINTER TO string, fd: filedesc] = {
i: INTEGER ← 1;
WHILE (s[i] # ENDSTR) DO
putcf[s[i], fd];
i ← i + 1
ENDLOOP};
-- errors and messages
message: PROC [msg: STRING] = {
FOR i: CARDINAL IN [0 .. msg.length) DO
putcf[ord[msg[i]], STDERR] ENDLOOP};
exit: ERROR = CODE;
error: PROC [msg: STRING] = {
message[msg]; ERROR exit};
-- command arg primitives
MAXCMD: NAT = 20;
cmdargs: [0 .. MAXCMD];
cmd: ARRAY [1 .. MAXCMD] OF RECORD [idx, len: CARDINAL];
getarg: PROC [n: INTEGER, str: POINTER TO string, maxsize: INTEGER]
RETURNS [BOOLEAN] = {
b: BOOLEAN ← ((n > 0) AND (n <= cmdargs));
IF (b) THEN
commandstr[cmd[n].idx, cmd[n].len, str, 1, maxsize];
RETURN [b]};
nargs: PROC RETURNS [INTEGER] = {RETURN [cmdargs]};
commandstr: PROC [i, n: INTEGER,
dest: POINTER TO string, j: INTEGER, maxsize: INTEGER] = {
WHILE (n > 0) AND (j < maxsize) DO
dest[j] ← ord[Exec.commandLine.s[i]];
i ← i + 1;
j ← j + 1;
n ← n - 1;
ENDLOOP;
dest[j] ← ENDSTR};
-- utilities
-- esc: map s[i↑] into escaped character, increment i↑
esc: PROC [s: POINTER TO string, i: POINTER TO INTEGER] RETURNS [c: character] = {
IF (s[i↑] = ESCAPE) THEN
c ← s[i↑]
ELSE IF (s[i↑+1] = ENDSTR) THEN -- @ not special at end
c ← ESCAPE
ELSE {
i↑ ← i↑ + 1;
IF (s[i↑] = ord['n]) THEN
c ← NEWLINE
ELSE IF (s[i↑] = ord['t]) THEN
c ← TAB
ELSE
c ← s[i↑]};
RETURN};
-- index: find position of character c in string s
index: PROC [s: POINTER TO string, c: character] RETURNS [INTEGER] = {
i: INTEGER ← 1;
WHILE (s[i] # c) AND (s[i] # ENDSTR) DO
i ← i + 1 ENDLOOP;
RETURN [IF (s[i] = ENDSTR) THEN 0 ELSE i]};
-- isalphanum: true if c is a letter or digit
isalphanum: PROC [c: character] RETURNS [BOOLEAN] = {
RETURN [
(c IN [ord['a] .. ord['z]])
OR (c IN [ord['A] .. ord['Z]])
OR (c IN [ord['0] .. ord['9]])]};
-- length: compute length of string
length: PROC [s: POINTER TO string] RETURNS [INTEGER] = {
n: INTEGER ← 1;
WHILE (s[n] # ENDSTR) DO
n ← n + 1 ENDLOOP;
RETURN [n - 1]};
-- insert main proc here
-- translit: map characters
translit: PROC = {
NEGATE: character = ord['↑];
arg, fromset, toset: string;
c: character;
i, lastto: [0..MAXSTR];
allbut, squash: BOOLEAN;
makeset: PROC [inset: POINTER TO string, k: INTEGER,
outset: POINTER TO string, maxset: INTEGER] RETURNS [BOOLEAN] = {
-- makeset: make set from inset[k] in outset
addstr: PROC [c: character, outset: POINTER TO string,
j: POINTER TO INTEGER, maxset: INTEGER] RETURNS [added: BOOLEAN] = {
-- addstr: put c in outset[j] if it fits, increment j
IF (j↑ > maxset) THEN
added ← FALSE
ELSE {
outset[j↑] ← c;
j↑ ← j↑ + 1;
added ← TRUE};
RETURN};
dodash: PROC [delim: character, src: POINTER TO string,
i: POINTER TO INTEGER, dest: POINTER TO string,
j: POINTER TO INTEGER, maxset: INTEGER] = {
-- dodash: expand set at src[i↑] into dest[j↑], stop at delim
DASH: character = ord['-];
WHILE (src[i↑] # delim) AND (src[i↑] # ENDSTR) DO
IF (src[i↑] = ESCAPE) THEN
[] ← addstr[esc[src, i], dest, j, maxset]
ELSE IF (src[i↑] # DASH) THEN
[] ← addstr[src[i↑], dest, j, maxset]
ELSE IF (j↑ <= 1) OR (src[i↑+1] = ENDSTR) THEN
[] ← addstr[DASH, dest, j, maxset] -- literal -
ELSE IF (isalphanum[src[i↑-1]])
AND (isalphanum[src[i↑+1]])
AND (src[i↑-1] <= src[i↑+1]) THEN {
FOR k: character IN (src[i↑-1] .. src[i↑+1]] DO
[] ← addstr[k, dest, j, maxset] ENDLOOP;
i↑ ← i↑ + 1}
ELSE
[] ← addstr[DASH, dest, j, maxset];
i↑ ← i↑ + 1
ENDLOOP};
j: INTEGER ← 1;
dodash[ENDSTR, inset, @k, outset, @j, maxset];
RETURN [addstr[ENDSTR, outset, @j, maxset]]};
xindex: PROC [inset: POINTER TO string, c: character,
allbut: BOOLEAN, lastto: INTEGER] RETURNS [INTEGER] = {
-- xindex: conditionally invert value from index
RETURN [
IF (c = ENDFILE) THEN 0
ELSE IF (~allbut) THEN index[inset, c]
ELSE IF (index[inset, c] > 0) THEN 0
ELSE lastto + 1]};
IF (~getarg[1, @arg, MAXSTR]) THEN
error["usage: translit from to"L];
allbut ← (arg[1] = NEGATE);
i ← IF (allbut) THEN 2 ELSE 1;
IF (~makeset[@arg, i, @fromset, MAXSTR]) THEN
error["translit: ""from"" set too large"L];
IF (~getarg[2, @arg, MAXSTR]) THEN
toset[1] ← ENDSTR
ELSE IF (~makeset[@arg, 1, @toset, MAXSTR]) THEN
error["translit: ""to"" set too large"L]
ELSE IF (length[@fromset] < length[@toset]) THEN
error["translit: ""from"" shorter than ""to"""L];
lastto ← length[@toset];
squash ← (length[@fromset] > lastto) OR (allbut);
DO
i ← xindex[@fromset, getc[@c], allbut, lastto];
IF (squash) AND (i>=lastto) AND (lastto>0) THEN {
putc[toset[lastto]];
DO
i ← xindex[@fromset, getc[@c], allbut, lastto];
IF (i < lastto) THEN EXIT;
ENDLOOP};
IF (c = ENDFILE) THEN EXIT;
IF (i > 0) AND (lastto > 0) THEN -- translate
putc[toset[i]]
ELSE IF (i = 0) THEN -- copy
putc[c]
-- ELSE delete --
ENDLOOP};
-- here begins the shell
initcmd: PROC = {
idx: CARDINAL ← Exec.commandLine.i;
limx: CARDINAL =
IF Exec.commandLine.s = NIL THEN 0 ELSE Exec.commandLine.s.length-1;
tty ← Exec.w;
kbdx ← kbdline.length ← 0;
kbdend ← FALSE;
filetab[STDIN].type ← filetab[STDOUT].type ← filetab[STDERR].type ← tty;
cmdargs ← 0;
WHILE (idx < limx) DO
WHILE (Exec.commandLine.s[idx] = Ascii.SP) AND (idx < limx) DO
idx ← idx + 1 ENDLOOP;
IF (idx < limx) THEN {
startidx: CARDINAL = idx;
WHILE (idx < limx)
AND (Exec.commandLine.s[idx] # Ascii.SP)
AND (Exec.commandLine.s[idx] # Ascii.TAB) DO
idx ← idx + 1 ENDLOOP;
SELECT Exec.commandLine.s[startidx] FROM
'< => {
name: string;
commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
close[STDIN];
makestream[@name, IOREAD, STDIN]};
'> => {
name: string;
commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
close[STDOUT];
makestream[@name, IOWRITE, STDOUT]};
ENDCASE => {
cmdargs ← cmdargs + 1;
IF cmdargs > MAXCMD THEN {
putcf[NEWLINE, STDERR];
message["*** too many arguments"L];
putcf[NEWLINE, STDERR]}
ELSE
cmd[cmdargs] ← [idx: startidx, len: idx - startidx]}};
ENDLOOP;
putcf[NEWLINE, STDERR]};
endcmd: PROC = {
FOR fd: filedesc IN (IOERROR .. MAXOPEN] DO
close[fd] ENDLOOP;
IF Exec.commandLine.s # NIL THEN
Exec.commandLine.i ← Exec.commandLine.s.length};
main: PROC = {
initcmd[];
translit[ ! exit => {CONTINUE}];
endcmd[]};
Exec.AddCommand["translit.~"L, main];
}.