v23i057: Line oriented macro processor, Part07/09
Rich Salz
rsalz at bbn.com
Fri Nov 30 04:44:15 AEST 1990
Submitted-by: Darren New <new at ee.udel.edu>
Posting-number: Volume 23, Issue 57
Archive-name: lome/part07
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 6 (of 9)."
# Contents: LOME/LOME.scm LOME/SCMTestP.scm PPL/PPL.doc TFS/TFSUnix.c
# Wrapped by new at estelle.ee.udel.edu on Tue Aug 14 16:10:01 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'LOME/LOME.scm' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/LOME.scm'\"
else
echo shar: Extracting \"'LOME/LOME.scm'\" \(9447 characters\)
sed "s/^X//" >'LOME/LOME.scm' <<'END_OF_FILE'
XFILE: LOME.scm
XThis is the SCM source file for the LOME program.
X THIS IS NOT COMPLETE AND PROBABLY WON'T BE FOR SOME TIME!
X I'LL PROBABLY FINISH THIS ONLY WHEN I FIND A MACHINE WHERE I NEED LOME
X WHICH DOESN'T HAVE A REASONABLE C COMPILER. AND PROBABLY NOT THEN
X EITHER.
X
XBEGIN PROGRAM
XBEGIN MAIN ROUTINE
X
X. The following parameters may be changed to allow larger or smaller progs.
X
XNUMDATA 01 0 00 30. Allow up to thirty pushes on the user stack.
XNUMDATA 02 0 00 15. Allow up to fifteen nested macros.
XNUMDATA 10 0 03 00. Start output on stream 3.
X
X. The data near the bottom of the cell-space is organised thus:
X. PTR[01] = number of pushes to user stack
X. PTR[02] = number of nested macros
X. PTR[05] = bottom of user-managed stack
X. PTR[06] = first address past user-managed stack
X. = bottom of macro call stack.
X. PTR[07] = first address past macro call stack
X. = address of first macro.
X. PTR[08] = first address past last macro
X. = beginning of dynamically allocated memory
X. PTR[10] = root of dictionary tree.
X. VAL[10] = current output stream
X. VAL[11] = macro input stream
X. PTR[11] = head of free space chain
X. PTR[12] = head of input stream stack (stream #'s in VAL's)
X. VAL[20] to VAL[49] = parameter line.
X
X
X
X
X. Here we read the initial macro definition file until we get a
X. blank line or an EOF
X
XLABEL 01. Read next line of MDef file
XVAL A = 1 + 0.
XGET BUFF A.
XTO 03 IF FLG A EQ 0.
XLABEL 02. Many places go to here to issue error
XPTR B = 6 + 0. really 10
XGET B = MEM B. get current output stream
XMESSAGE UEOF TO B.
XSTOP A.
XLABEL 03. See if empty line
XVAL A = INPUT.
XTO 01 IF VAL A NE 0.
X
X. Here we have found the first blank line. Read the next line and
X. store its contents in the val fields at offsets 20 thru 49
X
XVAL A = 1 + 0.
XGET BUFF A.
XTO 02 IF FLG A NE 0.
XPTR B = 3 * 6. We expect 30 characters.
XVAL B = PTR B. We need PTR B below.
XPTR A = 2 * 6. Which is really 20.
XPTR B = 8 + 0. Which is mem[0].
XMOV PTR B BY A. Which is mem[20].
XLABEL 04. read next char of parameter line
XVAL A = INPUT.
XTO 05 IF VAL A EQ 0.
XPTR A = 0 + 0.
XFLG A = 0.
XPUT MEM B = A.
XMOV PTR B BY 1.
XVAL B = B - 1.
XTO 04.
XLABEL 05. found end of parameter line
XTO 02 IF VAL B NE 0. Issue UEOF for parameter line wrong length
XFLG B = 0.
XPTR A = 8 + 0. Which is mem[0]
XMOV PTR A BY 5. See start of code
XMOV PTR A BY 2. Pointing at mem[7]
XPUT MEM A = B. Store pointer to start of macros
X
X
X
X. At this point, we are ready to start reading macro bodies.
X. The macros are stored in contiguous memory locations.
X. At this point in the code, PTR B points to the place to start
X. storing the macro definitions.
X. The first cell of each macro contains:
X. VAL = number of chars in the header minus placeholders and EOL
X. = minimum length of line which will match this header.
X. PTR = address of this cell in the next macro.
X. ??? FLG = 0 if more macros after this, 1 if not (PTR not valid).
X. This is followed by the text of the header line, processed.
X. The escape characters have been removed and any BEOL and comment have
X. been removed. Each FLG field is one of
X. FLG = 0 for a normal or escaped character,
X. FLG = 1 for a placeholder character, or
X. FLG = 2 for end-of-line (BEOL or real EOL).
X. PTR = ??????????????
X. The header line is followed by the macro body lines.
X. FLG = 0 if the VAL should be inserted into the constructed line
X. FLG = 1 if the VAL contains 0 - 9 as a function number and PTR
X. contains 0 - 11 (0-9,C,F).
X. FLG = 2 if the VAL contains 0 for EOL.
X. FLG = 3 if the FLG=2 cell immediately before this was the last line
X. of this macro body.
X. PTR = ??????????????
X
XPTR A = 2 * 6.
XPTR C = 8 + 0.
XMOV PTR C BY A. Point to parameter line
XGET E = MEM C. VAL E = escape character
XMOV PTR C BY 1.
XGET F = MEM C. VAL F = placeholder character
XMOV PTR C BY 1.
XGET G = MEM C. VAL G = HEOL character
XMOV PTR C BY 3.
XGET H = MEM C. VAL H = digit zero
XMOV PTR C BY 6. C points to param[16]
XMOV PTR C BY 4. C points to param[20]
XGET I = MEM C. VAL I = space character
XMOV PTR C BY 2.
XGET J = MEM C.
XVAL J = J - H. VAL J = 0 discard blank lines, = 1 keep blank lines
XMOV PTR C BY 1.
XGET K = MEM C.
XVAL K = K - H. VAL K = 0 discard leading space, = 1 keep leading space
X
XPTR A = 2 * 6.
XPTR C = 8 + 0.
XMOV PTR C BY A. Point to parameter line
XMOV PTR C BY 3.
XGET L = MEM C. VAL L = substitution character
XMOV PTR C BY 1.
XGET M = MEM C. VAL M = BEOL character
XMOV PTR C BY 5.
XGET N = MEM C. VAL N = file operation character
XMOV PTR C BY 1.
XGET O = MEM C. VAL O = control operation character
X
X. Here we use
X. PTR B to point to the start of the macro header,
X. VAL B to hold the min length of matching line,
X. VAL C to hold number of chars added to line so far,
X. PTR C to point to the current location,
X. VAL A to hold input character,
X. REG D to hold built cell to be stored,
X
XLABEL 06. Read next macro header line
XDEBUG.
XPTR C = B + 0.
XVAL B = 0 + 0.
XVAL C = 0 + 0.
XVAL A = 1 + 0.
XGET BUFF A.
XTO 22 IF FLG A NE 0. @$@$ CHANGE THIS TO READ SOURCES
XVAL D = 0 + 0.
XFLG D = 0.
XPTR D = 0 + 0.
XPUT MEM C = D.
XMOV PTR C BY 1.
XTO 98 IF PTR C EQ 9. full memory?
X
XLABEL 07. process next char of macro header
XVAL A = INPUT.
XTO 08 IF VAL K NE 0. if leading space not being discarded
XTO 08 IF VAL A NE I. if char read was not space
XTO 08 IF VAL C NE 0. if other characters are on the line
XTO 07. skip this character
XLABEL 08. not a leading space to be discarded
XTO 10 IF VAL A NE E. if input not an escape character
XVAL A = INPUT. it was an escape, so read next char
XTO 11 IF VAL A EQ 0. but at end of line, so ignore it
XLABEL 09. go here to add a regular character
XVAL D = A + 0. set up cell to match normal character
XFLG D = 0. normal char
XPTR D = B + 0. point back to beginning of header
XPUT MEM C = D. store it
XMOV PTR C BY 1. bump pointer
XTO 98 IF PTR C EQ 9. full memory?
XVAL B = B + 1. need to match it
XVAL C = C + 1. stored it.
XTO 07.
XLABEL 10. input not an escape char
XTO 11 IF VAL A EQ G. if HEOL found
XTO 11 IF VAL A EQ 0. if EOL found
XTO 09 IF VAL A NE F. jump if not placeholder char
XVAL D = A + 0.
XFLG D = 1. placeholder character
XPTR D = B + 0. point back to header
XPUT MEM C = D. store it
XMOV PTR C BY 1. bump pointer
XTO 98 IF PTR C EQ 9. full memory?
XVAL C = C + 1. stored it.
XTO 07.
XLABEL 11. end of macro header line found.
XVAL D = 0 + 0.
XFLG D = 2.
XPTR D = B + 0.
XPUT MEM C = D.
XMOV PTR C BY 1.
XTO 98 IF PTR C EQ 9. full memory?
X
X. Now we must read in the macro body, stoping when we get two BEOLs at
X. the start of a line.
X
XLABEL 12. to here to read macro body line.
X. PTR B still header, PTR C still next free
XVAL A = 1 + 0.
XGET BUFF A.
XTO 02 IF FLG A NE 0.
XVAL C = 0 + 0. to count chars on line
XLABEL 13. to here for each char of macro body line
XVAL A = INPUT.
XFLG D = 0. assume normal char until known otherwise
XVAL D = A + 0.
XPTR D = 0 + 0.
XTO 20 IF VAL A EQ 0. if end of line
XTO 19 IF VAL A EQ M. if BEOL
XTO 15 IF VAL A NE E. if not escape
XVAL A = INPUT.
XVAL D = A + 0.
XTO 20 IF VAL A EQ 0. escape, then EOL
XLABEL 14. insert D into macro body line
XPUT MEM C = D.
XMOV PTR C BY 1.
XTO 98 IF PTR C EQ 9. full memory?
XVAL C = C + 1.
XTO 13.
XLABEL 15. not escape or EOL or BEOL
XTO 14 IF VAL A NE L. if not substitution char, insert it
XVAL A = INPUT. get next char
XTO 16 IF VAL A NE O. if not control operation character
XVAL D = 9 + 2. 11 means control operation
XTO 18.
XLABEL 16. substitution, but not control op
XTO 17 IF VAL A NE N. if not file operation character
XVAL D = 9 + 1. 10 means file operation
XTO 18.
XLABEL 17. substitution, but not control op or file op
XVAL D = A - H. D = 0..9 (H is '0')
XLABEL 18. finish building substitution cell
XPTR D = VAL D. so we can do LT comparisons
XTO 97 IF PTR D LT 0. issue SUBS error if too small
XPTR A = 6 + 1. set PTR A to 11
XTO 97 IF PTR A LT D. issue SUBS error if too big
XVAL A = INPUT. read individual code
XVAL D = A - H. convert individual code to 0..9
XFLG D = 1. substitution flag
XTO 14. go insert it
XLABEL 19. found an unescaped BEOL
XTO 20 IF VAL C NE 0. not at start of line, so treat as normal EOL
XVAL A = INPUT. see if followed by another BEOL
XTO 20 IF VAL A NE M. nope, handle as normal EOL
XFLG D = 3. mark end of macro (for skip -1)
XPUT MEM C = D.
XMOV PTR C BY 1.
XTO 98 IF PTR C EQ 9. full memory?
XFLG D = 0.
XVAL D = 0 + 0.
XPTR D = C + 0.
XPUT MEM B = D. store forward pointer
XPTR B = C + 0. and skip forward
XPTR C = 8 + 0. point C at mem[7].
XMOV PTR C BY 5.
XMOV PTR C BY 2.
XVAL B = 0 + 0.
XFLG B = 0.
XPUT MEM C = B. point end-of-macro pointer here.
XTO 06. read next macro header
X
XLABEL 20. insert end-of-line marker if appropriate
XTO 21 IF VAL C NE 0. if anything on line,
XTO 21 IF VAL J EQ 1. or we want to keep blank lines
XTO 12. otherwise forget it.
XLABEL 21. insert end-of-line marker
XFLG D = 2. insert EOL character
XVAL D = 0 + 0.
XPTR D = 0 + 0.
XPUT MEM C = D.
XMOV PTR C BY 1.
XVAL C = C + 1. keep track of chars on line
XTO 98 IF PTR C EQ 9. full memory?
XTO 12. read next line
X
XLABEL 22. go here to read and translate source file.
XDEBUG. dump memory for inspection
XTO 99.
X
XLABEL 97. output a SUBS message to current output stream
XPTR A = 6 + 0.
XGET A = MEM A.
XMESSAGE SUBS TO A.
XSTOP A.
X
XLABEL 98. output a FULL message to current output stream
XPTR A = 6 + 0. really 10
XGET A = MEM A. get current output stream
XMESSAGE FULL TO A.
XSTOP A.
X
XLABEL 99.
X
XEND MAIN ROUTINE
XEND PROGRAM
X
X
END_OF_FILE
if test 9447 -ne `wc -c <'LOME/LOME.scm'`; then
echo shar: \"'LOME/LOME.scm'\" unpacked with wrong size!
fi
# end of 'LOME/LOME.scm'
fi
if test -f 'LOME/SCMTestP.scm' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'LOME/SCMTestP.scm'\"
else
echo shar: Extracting \"'LOME/SCMTestP.scm'\" \(9624 characters\)
sed "s/^X//" >'LOME/SCMTestP.scm' <<'END_OF_FILE'
XThis is a test program to make sure that your SCM macros are correct. It
Xshould be compiled and executed. Execute it with SCMTestD on stream one.
XOutput to stream two will consist of error messages and explainations. It
Xuses a brute-force approach to testing the macros: it reads a line from the
Xinput file that contains an error message, it checks that an operation had
Xan intended effect, and if it does, it skips past code that outputs the
Xline that was read. You should make sure that the I/O routines work first.
XAlso, check manually that BEGIN PROGRAM, BEGIN MAIN ROUTINE, END PROGRAM,
Xand END MAIN ROUTINE do what you want. Also, BEGIN SUBROUTINE and END
XSUBROUTINE should be checked manually.
X
XBEGIN PROGRAM.
X
XBEGIN SUBROUTINE F.
XVAL B = 1 + 0.
XGET BUFF B. 4
XVAL W = 2 + 0.
XPUT BUFF W.
XEND SUBROUTINE F.
X
XBEGIN SUBROUTINE S.
X
XVAL B = 1 + 0.
XGET BUFF B. X 002
XTO 03 IF FLG 1 EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 03.
X
XVAL B = 1 + 0.
XGET BUFF B. X 003
XTO 05 IF FLG 1 EQ 2.
XTO 04.
XLABEL 05.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 04.
X
XVAL B = 1 + 0.
XGET BUFF B. X 004
XTO 06 IF FLG 1 NE 1.
XTO 07.
XLABEL 06.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 07.
X
XVAL B = 1 + 0.
XGET BUFF B. X 005
XTO 08 IF FLG 1 NE 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 08.
X
XVAL B = 1 + 0.
XGET BUFF B. X 006
XTO 09 IF VAL 1 EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 09.
X
XVAL B = 1 + 0.
XGET BUFF B. X 007
XTO 10 IF VAL 1 EQ 2.
XTO 11.
XLABEL 10.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 11.
X
XVAL B = 1 + 0.
XGET BUFF B. X 008
XTO 12 IF VAL 1 NE 1.
XTO 13.
XLABEL 12.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 13.
X
XVAL B = 1 + 0.
XGET BUFF B. X 009
XTO 14 IF VAL 1 NE 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 14.
X
XVAL B = 1 + 0.
XGET BUFF B. X 010
XTO 15 IF PTR 1 EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 15.
X
XVAL B = 1 + 0.
XGET BUFF B. X 011
XTO 16 IF PTR 1 EQ 2.
XTO 17.
XLABEL 16.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 17.
X
XVAL B = 1 + 0.
XGET BUFF B. X 012
XTO 18 IF PTR 1 NE 1.
XTO 19.
XLABEL 18.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 19.
X
XVAL B = 1 + 0.
XGET BUFF B. X 013
XTO 20 IF PTR 1 NE 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 20.
X
XVAL B = 1 + 0.
XGET BUFF B. X 014
XTO 21 IF PTR 1 LT 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 21.
X
XVAL B = 1 + 0.
XGET BUFF B. X 015
XTO 22 IF PTR 2 LT 1.
XTO 23.
XLABEL 22.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 23.
X
XVAL B = 1 + 0.
XGET BUFF B. X 016
XTO 24 IF PTR 1 LT 1.
XTO 25.
XLABEL 24.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 25.
X
XVAL B = 1 + 0.
XGET BUFF B. X 017
XFLG A = 1.
XTO 26 IF FLG A EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 26.
X
XVAL B = 1 + 0.
XGET BUFF B. X 018
XVAL A = PTR 3.
XTO 27 IF VAL A EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 27.
X
XVAL B = 1 + 0.
XGET BUFF B. X 019
XPTR A = VAL 2.
XTO 28 IF PTR A EQ 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 28.
X
XVAL B = 1 + 0.
XGET BUFF B. X 020
XFLG A = 1.
XVAL A = 2 + 0.
XPTR A = VAL 3.
XTO 29 IF FLG A EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 29.
X
XVAL B = 1 + 0.
XGET BUFF B. X 021
XTO 30 IF VAL A EQ 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 30.
X
XVAL B = 1 + 0.
XGET BUFF B. X 022
XFLG A = 1.
XPTR A = 2 + 0.
XVAL A = PTR 3.
XTO 31 IF FLG A EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 31.
X
XVAL B = 1 + 0.
XGET BUFF B. X 023
XTO 32 IF PTR A EQ 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 32.
X
XVAL B = 1 + 0.
XGET BUFF B. X 024
XFLG A = 1.
XPTR A = 3 + 0.
XVAL A = 2 + 0.
XFLG A = 0.
XTO 33 IF VAL A EQ 2.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 33.
X
XVAL B = 1 + 0.
XGET BUFF B. X 025
XTO 34 IF PTR A EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 34.
X
XVAL B = 1 + 0.
XGET BUFF B. X 026
XFLG E = 0.
XPTR E = VAL 0.
XVAL E = 1 + 3.
XTO 35 IF VAL E EQ 4.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 35.
X
XVAL B = 1 + 0.
XGET BUFF B. X 027
XTO 36 IF PTR E EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 36.
X
XVAL B = 1 + 0.
XGET BUFF B. X 028
XTO 37 IF FLG E EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 37.
X
XEND SUBROUTINE S.
X
XBEGIN SUBROUTINE Q.
XVAL B = 1 + 0.
XGET BUFF B. X 032
XFLG A = 0.
XVAL A = 0 + 0.
XPTR A = 1 + 2.
XTO 41 IF FLG A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 41.
X
XVAL B = 1 + 0.
XGET BUFF B. X 033
XTO 42 IF VAL A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 42.
X
XVAL B = 1 + 0.
XGET BUFF B. X 034
XTO 43 IF PTR A EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 43.
X
XVAL B = 1 + 0.
XGET BUFF B. X 035
XVAL A = 0 + 0.
XFLG A = 0.
XPTR A = 1 - 3.
XTO 44 IF FLG A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 44.
X
XVAL B = 1 + 0.
XGET BUFF B. X 036
XTO 45 IF VAL A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 45.
X
XVAL B = 1 + 0.
XGET BUFF B. X 037
XPTR A = A + 3.
XTO 46 IF PTR A EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 46.
X
XVAL B = 1 + 0.
XGET BUFF B. X 038
XPTR A = 0 + 0.
XFLG A = 0.
XVAL A = 1 - 3.
XTO 47 IF FLG A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 47.
X
XVAL B = 1 + 0.
XGET BUFF B. X 039
XTO 48 IF PTR A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 48.
X
XVAL B = 1 + 0.
XGET BUFF B. X 040
XVAL A = A + 3.
XTO 49 IF VAL A EQ 1.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 49.
X
XVAL B = 1 + 0.
XGET BUFF B. X 041
XVAL A = 0 + 0.
XFLG A = 0.
XPTR A = 3 * 3.
XPTR D = VAL 9.
XTO 50 IF PTR A EQ D.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 50.
X
XVAL B = 1 + 0.
XGET BUFF B. X 042
XTO 51 IF VAL A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 51.
X
XVAL B = 1 + 0.
XGET BUFF B. X 043
XTO 52 IF FLG A EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 52.
X
XVAL B = 1 + 0.
XGET BUFF B. X 044
XVAL C = 0 + 0.
XFLG C = 0.
XPTR A = VAL 6.
XPTR C = A / 2.
XTO 53 IF PTR C EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 53.
X
XEND SUBROUTINE Q.
X
XBEGIN SUBROUTINE R.
X
XCALL Q. make sure nested calls work
X
XVAL B = 1 + 0.
XGET BUFF B. X 045
XTO 54 IF VAL C EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 54.
X
XVAL B = 1 + 0.
XGET BUFF B. X 046
XTO 55 IF VAL C EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 55.
X
XVAL B = 1 + 0.
XGET BUFF B. X 047
XPTR A = VAL 7.
XPTR C = A / 2.
XTO 56 IF PTR C EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 56.
X
XVAL B = 1 + 0.
XGET BUFF B. X 048
XPTR A = VAL 7.
XPTR A = 0 - A.
XPTR C = A / 2.
XPTR C = 0 - C.
XTO 57 IF PTR C EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 57.
X
XVAL B = 1 + 0.
XGET BUFF B. X 049
XPTR A = VAL 7.
XPTR D = 0 - 2.
XPTR C = A / D.
XPTR C = 0 - C.
XTO 58 IF PTR C EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 58.
X
XVAL B = 1 + 0.
XGET BUFF B. X 050
XPTR A = VAL 7.
XPTR A = 0 - A.
XPTR D = 0 - 2.
XPTR C = A / D.
XTO 59 IF PTR C EQ 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 59.
X
XVAL B = 1 + 0.
XGET BUFF B. X 051
XPTR D = VAL 4.
XPTR A = 0 - 2.
XPTR C = 2 * A.
XPTR C = 0 - C.
XTO 60 IF PTR C EQ D.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 60.
X
XVAL B = 1 + 0.
XGET BUFF B. X 052
XPTR D = VAL 4.
XPTR A = 0 - 2.
XPTR C = A * 2.
XPTR C = 0 - C.
XTO 61 IF PTR C EQ D.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 61.
X
XVAL B = 1 + 0.
XGET BUFF B. X 053
XPTR D = VAL 4.
XPTR A = 0 - 2.
XPTR C = A * A.
XTO 62 IF PTR C EQ D.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 62.
X
XVAL B = 1 + 0.
XGET BUFF B. X 054
XVAL C = 0 - 6.
XTO 63 IF VAL C EQ 6.
XTO 64.
XLABEL 63.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 64.
X
XVAL B = 1 + 0.
XGET BUFF B. X 055
XTO 65 IF VAL C NE 6.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 65.
X
XVAL B = 1 + 0.
XGET BUFF B. X 056
XPTR C = 0 - 3.
XTO 66 IF PTR C EQ 3.
XTO 67.
XLABEL 66.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 67.
X
XVAL B = 1 + 0.
XGET BUFF B. X 057
XTO 68 IF PTR C NE 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 68.
X
XVAL B = 1 + 0.
XGET BUFF B. X 058
XTO 69 IF PTR C LT 3.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 69.
X
XVAL B = 1 + 0.
XGET BUFF B. X 059
XTO 70 IF PTR 3 LT C.
XTO 71.
XLABEL 70.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 71.
X
XEND SUBROUTINE R.
X
X
XBEGIN MAIN ROUTINE.
XVAL B = 1 + 0.
XGET BUFF B. 1
XVAL W = 2 + 0.
XPUT BUFF W.
XVAL B = 1 + 0.
XGET BUFF B. 2
XVAL W = 2 + 0.
XPUT BUFF W.
XVAL B = 1 + 0.
XGET BUFF B. 3
XVAL W = 2 + 0.
XPUT BUFF W.
X
XCALL F.
X
XVAL B = 1 + 0.
XGET BUFF B. X 001
XTO 02.
XLABEL 01.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 02.
X
XCALL S.
X
XVAL B = 1 + 0.
XGET BUFF B. 5
XVAL W = 2 + 0.
XPUT BUFF W.
X
XVAL B = 1 + 0.
XGET BUFF B. 6
XVAL D = INPUT. '6'
XVAL E = INPUT. '.'
XVAL F = INPUT. ' '
XVAL G = INPUT. 'D'
XVAL H = INPUT. 'O'
XVAL I = INPUT. 'G'
XVAL J = INPUT. eol
XVAL B = 1 + 0.
XGET BUFF B. X 029
XTO 38 IF VAL J EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 38.
X
XOUTPUT = VAL D. '6'
XOUTPUT = VAL E. '.'
XOUTPUT = VAL F. ' '
XOUTPUT = VAL I. 'G'
XOUTPUT = VAL H. 'O'
XOUTPUT = VAL H. 'O'
XOUTPUT = VAL G. 'D'
XOUTPUT = VAL J. eol
XVAL W = 2 + 0.
XPUT BUFF W.
X
XVAL B = 1 + 0.
XGET BUFF B. 7
XVAL W = 2 + 0.
XPUT BUFF W.
X
XVAL B = 1 + 0.
XGET BUFF B. 8
XVAL D = INPUT. '7'
XVAL E = INPUT. '.'
XVAL F = INPUT. ' '
XVAL G = INPUT. '0'
XVAL H = INPUT. eol
XVAL B = 1 + 0.
XGET BUFF B. X 030
XTO 39 IF VAL H EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 39.
X
XOUTPUT = VAL D. '7'
XOUTPUT = VAL E. '.'
XOUTPUT = VAL F. ' '
XVAL J = G + 0.
XOUTPUT = VAL J. '0'
XOUTPUT = VAL F. ' '
XVAL J = G + 1.
XOUTPUT = VAL J. '1'
XOUTPUT = VAL F.
XVAL J = G + 2.
XOUTPUT = VAL J. '2'
XOUTPUT = VAL F.
XVAL J = G + 3.
XOUTPUT = VAL J. '3'
XOUTPUT = VAL F.
XVAL J = G + 4.
XOUTPUT = VAL J. '4'
XOUTPUT = VAL F.
XVAL J = G + 5.
XOUTPUT = VAL J. '5'
XOUTPUT = VAL F.
XVAL J = G + 6.
XOUTPUT = VAL J. '6'
XOUTPUT = VAL F.
XVAL J = G + 7.
XOUTPUT = VAL J. '7'
XOUTPUT = VAL F.
XVAL J = G + 8.
XOUTPUT = VAL J. '8'
XOUTPUT = VAL F.
XVAL J = G + 9.
XOUTPUT = VAL J. '9'
XOUTPUT = VAL F.
XOUTPUT = VAL H.
XVAL W = 2 + 0.
XPUT BUFF W.
X
XVAL B = 1 + 0.
XGET BUFF B. 9
XVAL W = 2 + 0.
XPUT BUFF W.
X
XVAL B = 1 + 0.
XGET BUFF B. 10
XVAL D = INPUT. '1'
XVAL G = INPUT. '0'
XVAL E = INPUT. '.'
XVAL F = INPUT. ' '
XVAL G = INPUT. '0'
XVAL H = INPUT. eol
XVAL B = 1 + 0.
XGET BUFF B. X 031
XTO 40 IF VAL H EQ 0.
XVAL W = 2 + 0.
XPUT BUFF W.
XLABEL 40.
X
XOUTPUT = VAL D. '1'
XOUTPUT = VAL G. '0'
XOUTPUT = VAL E. '.'
XOUTPUT = VAL F. ' '
XVAL I = PTR 0.
XVAL J = G + I.
XOUTPUT = VAL J. '0'
XOUTPUT = VAL F. ' '
XVAL I = PTR 1.
XVAL J = G + I.
XOUTPUT = VAL J. '1'
XOUTPUT = VAL F.
XVAL I = PTR 2.
XVAL J = G + I
XOUTPUT = VAL J. '2'
XOUTPUT = VAL F.
XVAL I = PTR 3.
XVAL J = G + I
XOUTPUT = VAL J. '3'
XOUTPUT = VAL H.
XVAL W = 2 + 0.
XPUT BUFF W.
X
XCALL R.
X
XVAL B = 1 + 0.
XGET BUFF B. 99
XVAL W = 2 + 0.
XPUT BUFF W.
X
XEND MAIN ROUTINE.
XEND PROGRAM.
X
END_OF_FILE
if test 9624 -ne `wc -c <'LOME/SCMTestP.scm'`; then
echo shar: \"'LOME/SCMTestP.scm'\" unpacked with wrong size!
fi
# end of 'LOME/SCMTestP.scm'
fi
if test -f 'PPL/PPL.doc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'PPL/PPL.doc'\"
else
echo shar: Extracting \"'PPL/PPL.doc'\" \(13126 characters\)
sed "s/^X//" >'PPL/PPL.doc' <<'END_OF_FILE'
X.rm 75
X.rm 70
X.po 2
X.he 'PPL.Doc'Portability Library Specs'Darren New'
X.fo ' Page #' 'Printed % '
X.pl 63
X.nj
X.ce 4
XThis documentation and all accompanying files
XCopyright 1986, 1990 Darren New.
XAll Rights Reserved.
XSee README for distribution permissions.
X
XThis file documents the proposed "Portable Programmer's Library",
Xhereinafter referred to as "PPL" or "PL".
X
XThe Portable Programmer's Library is a set of functions written in portable
XC intended to allow programmers to port their utilities and applications
Xbetween different machines with no changes to their source. The PPL
Xacheives this goal by relying on a small number of programmer-supplied
Xfunctions that must be rewritten for each type of "host" computer. At the
Xlowest level, these functions handle such tasks as memory allocation, error
Xrecovery, I/O to "standard input" and "standard output", and command-line
Xargument parsing. At the next higher level, these functions provide such
Xservices as screen updates and file and directory access. All other
Xfunctions are built on top of these low-level routines. Many of the more
Xsophisticated routines (e.g., file requesters, menus) have equivalent
Xroutines in the PPL implemented in terms of lower-level routines. These can
Xbe overwridden by the host implementation to allow conformance with
Xalready-existant host capabilities.
X
XThe PPL includes several subsystems which are sorted according to
Xfunctionality. Each subsystem has its own header file, named after the
Xsubsystem, which includes all of the other header files for that subsystem.
XSince the syntax for subdirectories may vary, these header files are
Xassumed to be somewhere accessable without subdirectories, and the
Xindividual header files lie in subdirectories; thus, the programmer need
Xonly edit one header file for each subsystem. The subsystems, which are
Xdocumented in more detail in their own documentation file, include the
Xfollowing:
X
X.nf
XHOST - The lowest level routines. These change between machines. These
Xare actually several of these, one for each subsystem and one for all
Xsubsystems combined. The basic routines are stored in a subdirectory called
XPPL.
X
XUTIL - The Utility Subsystem. These parse command-line templates and
Xdo other utility-oriented processing. These also handle date and time
Xarithmetic, list processing, sorting, and regular expression matching.
X
XUIS - The User Interface Subsystem. This includes windowing, menus,
Xand special key handling.
X
XTFS - The Text File Subsystem. This includes routines to handle
Xopening, closing, creating, destroying, reading, and writing of ASCII
Xformat files. Files created by the TFS of one host should be readable by
Xthe TFS of other hosts.
X
XBFS - The Binary File Subsystem. This includes routines to handle
Xopening, closing, creating, destroying, reading, and writing of binary
X(non_ASCII) files. These files are byte-addressable and dynamically sized
X(esentially like UNIX files).
X
XKFS - The Keyed File Subsystem. This includes routines to handle
Xopening, closing, creating, destroying, reading, and writing of
XKey/Sequential files. These files can have records inserted, deleted, and
Xsorted on several keys, and can also be accessed sequentially. Most of what
Xyou need for the file interface to a simple database is here.
X
XFNS - File Name Subsystem. This includes routines for HOST-specific
Xfilenames, directory access, protection changing, and so on. Use of
Xthis library will not make your program non-portable if care is used, but
Xthe user of you application will be aware of the syntax of host file names
Xand so on.
X
XHIS - Host Interface Subsystem. This includes routines for date and
Xtime handling, host-syntax "system" calls, and other miscellaneous routines
Xthat may need to be changed from machine to machine. Check the header file
Xto determine which routines are portable and which are not.
X
XPNS - Portable Name Subsystem. This includes routines for allowing
Xportable filenames and "system" functions such as starting other commands
Xand changing access permissions on files. It includes essentially
Xeverything that the FNS and HIS do; however, it is more difficult for the
Xprogrammer to use. It is designed to prevent the user from needing to learn
Xabout the host filename syntax, how to copy or rename files on the host,
Xand so on. It essentially gives the functionality of a small shell by using
Xmenu-driven utilities. It also includes routines for translating host-style
Xfilenames to portable filenames and back again, as well as routines for
Xgiving the user a choice of filenames and returning which filename the user
Xchose.
X
XTLS - Threaded Language Subsystem. This implements the threaded
Xlanguage called "2OL", which stands for "Second Order Language".
X
XMXS - The Mutual Exclusion Subsystem. This includes routines for
Xcommunicating between concurrent tasks, especially locking other concurrent
Xtasks out of critical sections. This also contains simple routines for
Xasynchronous user-generated interrupt handling.
X
XACS - The Application Configuration Subsystem. This includes routines
Xfor creating and saving configuration information in a portable and
Xextendable way.
X
XTIS - The Telecommunication Interface Subsystem. This includes
Xroutines for portable access to computers other than the one the program is
Xrunning on. Note this Subsystem works best if the computer being contacted
Xis also running an application based on the TIS.
X
X.fi
X.ce
X***************************************************************
X
XNote that only shorts and longs are actually used by PortLib routines.
XShorts are pretty much assumed to be at least 16 bits long. Chars are
Xpretty much assumed to be 8 bits long, and longs are pretty much assumed to
Xbe long enough to reference anything in the system. Where parameters are
Xdeclared int, it is assumed that only arguments that could fit in a short
Xare passed. These parameters are declared int instead of short simply to
Xease the burden of the caller by allowing uncast integers to be passed. In
Xmost cases (I hope all), parameters are declared as short and only shorts
Xare passed.
X
XAlso, the naming conventions for external data are as follows: constant
Xvalues such as NULL, TRUE, and so on are all caps. Constant values that are
Xused as flags to individual routines are all small letters prefixed by the
Xinitials of the subsystem in which they appear (e.g., PLsev_normal,
XUIScolor_notice). Routine names (functions or macros that look like
Xfunctions) are mixed upper/lower case and are prefixed by their subsystem
Xinitials in all caps (e.g., PLClrErr, UISMakeWindow). General typedefs
X(like bool, str, etc.) are all lower case. Specific typedefs (UISwindow)
Xshould be lower case with the subsystem initials prepended in upper case.
XFor compatibility, assert(), fault(), and bomb() are all lower case.
X
X.fi
X.ce
X***************************************************************
X
XThe HOST Subsystem includes routines to allow easy implementation of each
Xof the above subsystems. There are, however, a set of HOST routines that
Xwould be required for every application using the PPL. The organization of
Xthis subsystem is described here. The functionality required is divided as
Xfollows:
X
XMachine Parameters - In PPL.h is a set of parameters that should be
Xset to match the host computer before the first compilation of the rest of
Xthe PPL. These parameters include such things as the maximum amount of
Xmemory that can be allocated contiguously (for segmented machines), the
Xmaximum size a single I/O, the most efficient declaration for array
Xindicies, and so on.
X
XMemory Functions - Functions to allocate and deallocate dynamic
Xmemory, similarly to malloc() and free().
X
XStandard I/O Functions - Functions to read and write "standard I/O"
Xstreams for utilities; these are normally not found in user-level
Xapplications, but rather only in programs which a programmer would be
Xusing. Interfacing to the user is the task of the UIS.
X
XError Functions - Functions to diagnose and correct errors detected by
Xother HOST subsystems. This allows for portable error handling.
X
XCommand Argument Functions - These access command-line arguments in a
Xportable way. Note that in order to implement this, the HOST subsystem
Xactually contains the main() function, which must eventually call DoIt();
XDoIt() is the "main program" of all PPL-based programs.
X
XDebug Functions - These allow for portable debugging statements, not
Xnecessarily for portable debugging. In the worst case (the host implements
Xnone of these), all these statements are designed to be macro'ed out.
X
XStatus Functions - These allow the programmer to post status messages
Xfor debugging purposes or for keeping the user awake. These also include
Xfunctions for delaying and for beeping or flashing.
X
XFor more explicit documentation of these routines, please see the
XHOST subsystem header files.
X
X
X.fi
X.ce
X***************************************************************
X.ce
XINSTALLATION ON YOUR COMMODORE AMIGA COMPUTER
X
XThe organization of the development system is as follows. The root for
Xall directories is "PPLDIR:" on the Amiga. Upon installation on your
Xparticular machine, you should make the directory that is to be the
Xroot and then add to your Startup-Sequence a command to assign this
Xdirectory to PPLDIR:. You should also assign "INCLUDE:" to be the
Xdirectory where you want compressed header files to go and "CH:" to be
Xthe directory where you want uncompressed header files to go. You
Xshould then unpack the zoo files using the `x//' parameter to cause
Xthe files to go into the correct directories. Edit the MakeHead.Amiga
Xfiles to set the first couple of lines correctly for your machine.
XExecute the FixMake.Amiga script in each subdirectory in order to
Xrebuild the Makefile.Amiga and Makefile.Unix files. Note that you may
Xneed to change ld.Amiga to set the correct flags or whatever. On my
XAmiga, I have renamed `lmk' to be `make' and have written the
Xfollowing script and put it in s:lmk:
X
X.nf
X .key name
X .bra {
X .ket }
X if exists Makefile
X make {name}
X else
X if exists FixMake.Amiga
X execute FixMake.Amiga
X make -f Makefile.Amiga {name}
X endif
X endif
X
X.fi
X
XBy doing this, the command `lmk' will recreate the Makefile and then
Xmake the program. In each subsystem, the default target will build the
Xsubsystem. The target `clean' will remove most of the leftovers, while
X`zap' will remove everything about the subsystem except the source.
XThe target `test' (if available) will run regression tests on the
Xsubsystem. If the regression tests fail, check the output: you may
Xjust have a different encoding of characters or a byte-order
Xdifference or something like that.
X
X.nf
XThe correct order for making these programs is as follows:
X 1) PPL
X 2) BFS, TFS
X 3) VMS, LOME, UIS
X
X.fi
X.ce
X***************************************************************
X.ce
XINSTALLATION ON YOUR UNIX-BASED COMPUTER
X
XThe organization of the development system is as follows. The root for
Xall directories is "$PPLDIR" under Unix. The current sources assume
Xthe use of GCC under SunOS 4.x. Upon installation on your particular
Xmachine, you should make the directory that is to be the root and then
Xadd to your .cshrc file a command to setenv PPLDIR to the full path of
Xthat directory. You should then unpack the zoo files using the `x//'
Xparameter to cause the files to go into the correct directories. You
Xshould also create directories called "$PPLDIR/CH" and
X"$PPLDIR/Headers" to hold header files. Edit the MakeHead.Unix file to
Xset the first couple of lines correctly for your machine. Execute the
XFixMake.Unix script in each subdirectory in order to rebuild the
XMakefile.Amiga and Makefile.Unix files. Note that you may need to
Xchange ld.Unix to set the correct flags or whatever.
X
XUnder Unix, I have the following lines in my .cshrc:
X
X.nf
Xsetenv PPLDIR ~/PPLstuff
Xalias lmk 'source FixMake.Unix && make -f Makefile.Unix \!* |& \
X tee make.err'
X
X.fi
X
XBy doing this, the command `lmk' will recreate the Makefile and then
Xmake the program. In each subsystem, the default target will build the
Xsubsystem. The target `clean' will remove most of the leftovers, while
X`zap' will remove everything about the subsystem except the source.
XThe target `test' (if available) will run regression tests on the
Xsubsystem. If the regression tests fail, check the output: you may
Xjust have a different encoding of characters or a byte-order
Xdifference or something like that.
X
X.nf
XThe correct order for making these programs is as follows:
X 1) PPL
X 2) BFS, TFS
X 3) VMS, LOME, UIS
X
X.fi
X.ce
X***************************************************************
X.ce
XINSTALLATION ON A CURRENTLY-UNSUPPORTED PLATFORM
X
XUnpack as above. If you don't have `make,' go buy it. Otherwise, you
Xwill have to build everything by hand, which is not impossible but is
Xinconvenient. Look at all the files that have `Amiga' or `Unix' in
Xtheir name and modify them to work under your machine and OS. Package
Xup the changes and send them to me. Thank you!
X
X
END_OF_FILE
if test 13126 -ne `wc -c <'PPL/PPL.doc'`; then
echo shar: \"'PPL/PPL.doc'\" unpacked with wrong size!
fi
# end of 'PPL/PPL.doc'
fi
if test -f 'TFS/TFSUnix.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'TFS/TFSUnix.c'\"
else
echo shar: Extracting \"'TFS/TFSUnix.c'\" \(10504 characters\)
sed "s/^X//" >'TFS/TFSUnix.c' <<'END_OF_FILE'
X/* :ts=4:
X * TFSUnix.c
X * Portable Programmer's Library Text File Subsystem Code File
X * Copyright 1988 Darren New. All Rights Reserved.
X *
X * Started: 26-Feb-88 DHN
X * LastMod: 13-Jul-90 DHN
X *
X * Version One for Unix -- Simple, just to get running
X * This uses access() because it's simple and there, even
X * tho I know this is wrong under SUID programs.
X *
X */
X
X#include "PPL.h"
X#include "TFS.h"
X
X#include "stdio.h"
X#include "fcntl.h"
X
X/* Why this isn't in stdio.h I'll never understand */
Xextern int fclose(FILE *);
Xextern long tell(int);
Xextern long ftell(FILE *);
Xextern long fseek(FILE *, long, int);
Xextern int fgetc(FILE *);
Xextern int fwrite(char *, int, int, FILE *);
X
X#define MAXTFS 15 /* max # TFSfiles open at once */
X
XHIDDEN struct { /* one open file */
X str name;
X FILE * fhand;
X str modes;
X } ftab[MAXTFS];
X
XHIDDEN bool TFShbi = FALSE; /* has been init */
XHIDDEN short TFSfree; /* number of free ftab entries */
X
X
X#define HND (handle - 1) /* for convenience */
X
X
Xvoid TFSInit()
X{
X inx i;
X assert(TFShbi == FALSE);
X TFShbi = TRUE;
X for (i = 0; i < MAXTFS; i++)
X ftab[i].name = ftab[i].modes = NULL;
X TFSfree = MAXTFS;
X PLErrClr();
X }
X
Xbool TFSHasBeenInit()
X{
X return TFShbi;
X }
X
Xvoid TFSTerm()
X{
X int i;
X assert(TFShbi);
X for (i = 0; i < MAXTFS; i++) {
X if (ftab[i].modes != NULL) {
X fclose(ftab[i].fhand);
X PLFreeMem(ftab[i].modes);
X PLFreeMem(ftab[i].name);
X }
X }
X TFSfree = 0;
X TFShbi = FALSE;
X PLErrClr();
X }
X
X
XTFSfile TFSOpen(fname, mode)
X str fname;
X str mode;
X{
X
X /**** NOTE THIS MUST BE CHANGED TO REMEMBER NAMES IN FULL LENGTH
X OR RELATIVE TO A LOCK OR DIRECTORY! ****/
X
X /**** Also note that this takes advantage of some of the restrictions
X on mode combinations; e.g., R excludes W, W excludes P, ... ****/
X
X long flock, fhand;
X bool mL, mC, mT, mA, mR, mW, mP, mD;
X long t; /* temp value */
X inx i;
X
X#define setup(a,b) {a = (NULL != strchr(mode, b));}
X
X assert(TFShbi);
X#if CHKARGS
X if (fname == NULL || mode == NULL || *fname == EOS || *mode == EOS ||
X BIGFNAME <= strlen(fname) ) {
X PLErrSet(PLerr_badarg);
X return 0;
X }
X#endif
X
X setup(mL, 'L'); setup(mC, 'C'); setup(mT, 'T');
X setup(mA, 'A'); setup(mR, 'R'); setup(mW, 'W');
X setup(mP, 'P'); setup(mD, 'D');
X
X#if CHKARGS
X if ( (mR && mW) || (mP && !mR && !mC) || (mW && !mA && !mT) ||
X (mA && mT) || (mA && !mW) || (mT && !mW) ) {
X PLErrSet(PLerr_badarg);
X return 0;
X }
X#endif
X
X if (TFSfree == 0 && ! mL) {
X PLErrSet(PLerr_oores);
X return 0;
X }
X
X if (mL) { /* just check for access */
X if (!mC) { /* not creating */
X flock = access(fname, F_OK);
X if (flock == -1) { /* directories inaccessible */
X OSerr = errno;
X if (OSerr == EACCES || OSerr == EISDIR || OSerr == ENOTDIR ||
X OSerr == EPERM || OSerr == ETXTBSY)
X PLErrSet(PLerr_permit);
X else
X PLErrSet(PLerr_exist);
X return 0;
X }
X flock = access(fname, F_OK + mR ? R_OK : W_OK);
X if (flock == -1) { /* file inaccessible */
X OSerr = errno;
X if (OSerr == EACCES || OSerr == EISDIR || OSerr == ENOTDIR ||
X OSerr == EPERM || OSerr == ETXTBSY)
X PLErrSet(PLerr_permit);
X else
X PLErrSet(PLerr_exist);
X return 0;
X }
X }
X else { /* creating */
X char * dirname;
X char * slash;
X /* check simple case first */
X if (-1 != access(fname, F_OK + W_OK))
X return 1;
X /* Difficult case: build name of parent dir */
X dirname = PLStrDup(fname);
X slash = dirname + 1;
X if (NULL == strchr(dirname, '/'))
X strcpy(dirname, ".");
X else {
X while (NULL != strchr(slash, '/'))
X slash = strchr(slash, '/');
X *(slash+1) = '\0';
X }
X flock = access(dirname, F_OK);
X if (flock == -1) { /* see if dest dir exists */
X OSerr = errno;
X PLErrSet(PLerr_exist);
X PLFreeMem(dirname);
X return 0;
X }
X flock = access(dirname, F_OK + W_OK);
X if (flock == -1) { /* see if dest dir is writable */
X OSerr = errno;
X PLErrSet(PLerr_permit);
X PLFreeMem(dirname);
X return 0;
X }
X flock = access(fname, F_OK + W_OK);
X if (flock == -1 && errno != ENOENT) {
X /* see if dest file exists and writable */
X OSerr = errno;
X PLErrSet(PLerr_permit);
X PLFreeMem(dirname);
X return 0;
X }
X else {
X /* otherwise, must be good */
X errno = 0;
X PLFreeMem(dirname);
X return 1;
X }
X }
X }
X
X /* Here, we are not just looking. In this case, it is easiest to
X simply try to do the operation and see if it fails. */
X
X t = mR ? O_RDONLY : O_WRONLY;
X t += mC ? O_CREAT : 0;
X t += mT ? O_TRUNC : 0;
X t += mA ? O_APPEND : 0;
X
X fhand = open(fname, t, 0666);
X if (fhand < 0) {
X OSerr = errno;
X switch (errno) {
X default:
X PLErrSet(PLerr_opsysF); break;
X case EACCES:
X case EEXIST:
X case EISDIR:
X case ENOTDIR:
X case EROFS:
X PLErrSet(PLerr_permit); break;
X case EDQUOT:
X case EMFILE:
X case ENFILE:
X case ENOSPC:
X case ENOSR:
X PLErrSet(PLerr_oores); break;
X case EFAULT:
X case ENAMETOOLONG:
X PLErrSet(PLerr_param); break;
X case EOPNOTSUPP:
X PLErrSet(PLerr_unsup); break;
X case ENOENT:
X PLErrSet(PLerr_exist); break;
X }
X return 0;
X }
X if (mP && tell(fhand) < 0) {
X close(fhand);
X PLErrSet(PLerr_unsup);
X return 0;
X }
X for (i = 0; i < MAXTFS && ftab[i].modes; i++)
X ;
X ftab[i].fhand = fdopen(fhand, mR ? "rt" : (mA ? "at" : "wt"));
X if (ftab[i].fhand == NULL) {
X close(fhand);
X PLErrSet(PLerr_oores);
X return 0;
X }
X ftab[i].modes = PLStrDup(mode);
X ftab[i].name = PLStrDup(fname);
X
X return (TFSfile) (i + 1);
X }
X
Xbool TFSClose(handle)
X TFSfile handle;
X{
X int err;
X assert(TFShbi);
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X#endif
X assert(ftab[HND].fhand != NULL);
X assert(ftab[HND].name != NULL);
X assert(ftab[HND].modes != NULL);
X
X err = fclose(ftab[HND].fhand);
X PLFreeMem((ptr) ftab[HND].modes);
X PLFreeMem((ptr) ftab[HND].name);
X ftab[HND].name = ftab[HND].modes = NULL;
X if (err == 0) {
X PLErrClr();
X return TRUE;
X }
X else {
X PLErrSet(PLerr_opsysF);
X return FALSE;
X }
X }
X
Xbool TFSDestroy(handle)
X TFSfile handle;
X{
X char fn[BIGFNAME];
X bool flag;
X int err;
X
X assert(TFShbi);
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X#endif
X strcpy(fn, ftab[HND].name);
X flag = (NULL != strchr(ftab[HND].modes, 'D'));
X
X fclose(ftab[HND].fhand);
X PLFreeMem(ftab[HND].name);
X PLFreeMem(ftab[HND].modes);
X ftab[HND].modes = NULL;
X
X if (flag) {
X err = unlink(fn); /* permission checked during open */
X if (err == -1) {
X OSerr = errno;
X PLErrSet(PLerr_permit);
X return FALSE;
X }
X else {
X PLErrClr();
X return TRUE;
X }
X }
X else {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X }
X
X/* @$@$
XTFSInfo() - Determine file parameters. This may return various
Xparameters about the given file. The description of the information
Xreturned is given in the TFS.h file.
X*/
X
X
Xshort TFSRead(handle, buf)
X TFSfile handle;
X str buf;
X{
X inx i; /* index into buffer */
X int c; /* read character */
X long l; /* length of record read */
X
X assert(TFShbi);
X assert(buf != NULL);
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return S -1;
X }
X if (NULL == strchr(ftab[HND].modes, 'R')) {
X PLErrSet(PLerr_badarg);
X return S -1;
X }
X#endif
X i = 0;
X do {
X errno = 0;
X c = fgetc(ftab[HND].fhand);
X l = (c == EOF) ? (ferror(ftab[HND].fhand) ? -1 : 0) : 1;
X /* l is what read() would have returned */
X if (0 < l)
X buf[i++] = c;
X } while (0 < l && i < BIGLINE && c != '\n');
X
X /* printf("l=%d, i=%d, c=%d, buf[0]=%c\n", l, i, c, buf[0]); */
X if (l == -1) {
X OSerr = errno;
X PLErrSet(PLerr_opsysF);
X buf[0] = EOS;
X return S -1;
X }
X if (i == BIGLINE && c != '\n') { /* line overflow */
X buf[--i] = EOS;
X while (0 < i && isspace(buf[i-1]))
X buf[--i] = EOS;
X while (EOF != (c = fgetc(ftab[HND].fhand)) && c != '\n')
X /* flush rest of line */;
X PLErrSet(PLerr_overflow);
X assert(strlen(buf) < BIGLINE);
X return S -1;
X }
X if (l == 0) { /* end of file */
X if (i == 0) {
X buf[0] = EOS;
X PLErrSet(PLerr_eod);
X return S -1;
X }
X else {
X buf[i++] = c = '\n';
X /* and fall thru */
X }
X }
X if (c == '\n') { /* end of line */
X if (i == BIGLINE)
X i -= 1;
X buf[i] = EOS;
X while (0 < i && isspace(buf[i-1]))
X buf[--i] = EOS;
X PLErrClr();
X assert(strlen(buf) < BIGLINE);
X return S i;
X }
X
X assert(0); /* you can't get here */
X return 0;
X }
X
X
Xbool TFSWrite(handle, buf)
X TFSfile handle;
X str buf;
X{
X int i; /* must be able to handle negative numbers */
X
X assert(buf != NULL);
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X if (NULL == strchr(ftab[HND].modes, 'W')) {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X if (BIGIO <= strlen(buf)) {
X PLErrSet(PLerr_badarg);
X return FALSE;
X }
X#endif
X
X clearerr(ftab[HND].fhand);
X i = strlen(buf);
X while (0 < i && isspace(buf[i - 1]))
X i -= 1;
X if ( ( (0 < i) && (i != fwrite(buf, 1, i, ftab[HND].fhand)) ) ||
X 1 != fwrite("\n", 1, 1, ftab[HND].fhand)) {
X OSerr = errno;
X PLErrSet(PLerr_opsysF);
X return FALSE;
X }
X PLErrClr();
X return TRUE;
X }
X
Xlong TFSNote(handle)
X TFSfile handle;
X{
X long retval;
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return -1L;
X }
X if (NULL == strchr(ftab[HND].modes, 'P') ||
X NULL == strchr(ftab[HND].modes, 'R')) {
X PLErrSet(PLerr_badarg);
X return -1L;
X }
X#endif
X
X retval = ftell(ftab[HND].fhand);
X if (retval == -1) {
X OSerr = errno;
X PLErrSet(PLerr_opsysF);
X return 0L;
X }
X else {
X PLErrClr();
X return retval + 1L;
X }
X }
X
Xbool TFSPoint(handle, pos)
X TFSfile handle;
X TFSnote pos;
X{
X long newpos;
X#if CHKARGS
X if (HND < 0 || MAXTFS <= HND || ftab[HND].modes == NULL) {
X PLErrSet(PLerr_badarg);
X return -1L;
X }
X if (pos <= 0L || NULL == strchr(ftab[HND].modes, 'P') ||
X NULL == strchr(ftab[HND].modes, 'R')) {
X PLErrSet(PLerr_badarg);
X return -1L;
X }
X#endif
X
X newpos = fseek(ftab[HND].fhand, pos - 1L, 0);
X if (newpos == -1L) {
X OSerr = errno;
X PLErrSet(PLerr_opsysF);
X return FALSE;
X }
X else {
X PLErrClr();
X return TRUE;
X }
X }
X
X
END_OF_FILE
if test 10504 -ne `wc -c <'TFS/TFSUnix.c'`; then
echo shar: \"'TFS/TFSUnix.c'\" unpacked with wrong size!
fi
# end of 'TFS/TFSUnix.c'
fi
echo shar: End of archive 6 \(of 9\).
cp /dev/null ark6isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 9 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
--- Darren New --- Grad Student --- CIS --- Univ. of Delaware ---
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list