anc@camcon.uucp (Adrian Cockcroft) (02/23/88)
I had several requests for this source so I am posting it together
with an example program that generates a mandelbrot diagram and writes
the result to file. I hope it is useful...
#!/bin/sh
# Archived: Tue Feb 23 10:18:38 GMT 1988
#
# Contents:
# STDIO.DOC
# stdio.occ
# doprnt.occ
# atov.occ
# harness.occ
# main.occ
# mandcalc.occ
#
echo x - STDIO.DOC
sed 's/^X//' >STDIO.DOC <<'*-*-END-of-STDIO.DOC-*-*'
X
X The Standalone Occam Stdio Library
X ==================================
X
XWritten by Adrian Cockcroft January/February 1988. This code is in the
Xpublic domain. It was written at home using a 68010 based Micro
XConcepts Image-10 computer running Tripos with a Concurrent Technology
XTM2 Transputer module attached.
X
XFiles are:
X STDIO.DOC -- this documentation
X stdio.occ -- to be #INCLUDE'd by the users program
X doprnt.occ -- to be compiled as a library, #USE'd by stdio.occ
X atov.occ -- to be compiled as a library, #USE'd by stdio.occ
X
Xalso as an example:
X harness.occ -- harness of mandelbrot program
X main.occ -- main program of mandelbrot
X mandcalc.occ -- mandelbrot calculator process
X
XOccam Compatibility
X-------------------
XThis code can be used with the standalone occam 2 compiler sold by Inmos
Xand Microway. This compiler uses the same alien file server as the C,
XFortran and Pascal languages supplied by Inmos and can only generate
Xcode for a single Transputer. In particular the interface to the Inmos
XTransputer Development System (TDS) which includes a folding editor and
Xa stream based i/o library is not supported by this code. Only programs
Xthat run using the alien file server (afserver) will work. A new version
Xof this compiler which targets to multiple transputers has just been
Xreleased by Inmos, it hasn't been tried with this library.
X
XThe routines are all PROCs since the version of occam 2 which supports
XFUNCTIONs is only just becoming available. This means that there are
Xsome extra parameters compared to the C functions of the same names.
X
XAfserver Compatibility
X----------------------
XThe afserver used is based on afserver version 1.3 as shipped with the C
Xversion 1.3 and Fortran version 1.1 compilers. It has not been tested
Xwith earlier versions of the afserver although no problems should occur.
X
XWhat the Afserver Does
X----------------------
XThe afserver is a C program that runs on the host computer (usually an
XIBM PC but I have ported it to a 68010 based computer running Tripos)
Xand talks to a Transputer via a link adaptor and some control lines.
XPrograms are booted into the Transputer by copying them down the link.
XThe program usually includes a library of routines that communicate with
Xthe afserver and can request the host computer to open files, read and
Xwrite data etc. There are about 35 commands that can be invoked from the
XTransputer and the afserver reads a command tag then switches to some
Xcode to read in parameters and perform the operation.
X
XLibraries Provided With Occam
X-----------------------------
XThe harness provides channels to and from the afserver which must be passed
Xto every routine that wants to do any i/o. The library provided
X(flibs.occ) gives basic access to the afserver but is rather clumsy and
Xinelegant with lots of parameters required even for simple operations. A
Xfurther set of libraries (ioconv.occ and extrio.occ) provide basic
Xconversion routines from various types to strings and vice versa.
X
XThe stdio.occ Library
X---------------------
XThe aim of this library is to repackage the existing libraries in a way
Xthat will be familiar to a C programmer. It is #INCLUDE'd as source code
Xin the user's program in scope of the channels to and from the afserver
Xwhich must be declared as CHAN OF ANY from.filer, to.filer. Because it
Xis in scope and is in source form these channels never need to be passed
Xas parameters to the i/o routines.
X
XConstants
X---------
XA large number of constants are defined in stdio.occ which give symbolic
Xnames to error codes, file access modes etc. These are taken from the
Xsource of ascreen.occ which is distributed with occam but not normally used.
X
XVariables
X---------
XThe file stdio.occ also declares some variables which are in scope for
Xthe rest of the users program. These are:
X
X[256]BYTE argv: -- which contains the command line given to afserver
XINT argc: -- which is the length of the cmd line in argv
XINT stdin, stdout, stderr: -- which are preopened i/o streams
XINT errno: -- which holds the last error that occurred
X
XInitialisation - stdopen() and stdclose()
X--------------
XBefore any of these variables can be used the standard i/o library must
Xbe initialised by calling stdopen(), at the end of the program
Xstdclose() will close stdin, stdout and stderror for a tidy exit then
Xsend a terminate command to the afserver which will exit.
X
X
XStandard I/O
X------------
XInput and output using stdin and stdout are provided by:
X
XPROC puts(VAL []BYTE string) and
XPROC gets([]BYTE string, INT bytes.read)
X
XFiles - open() and close()
X-----
XTo open a file call:
X
XPROC open(INT file, VAL []BYTE name, VAL INT mode)
X
XWhere mode can be Read.Mode, Write.Mode or Update.Mode. The file can be
Xclosed by calling:
X
XPROC close(VAL INT file)
X
XFile I/O
X--------
XThis is performed using:
X
XPROC fputs(VAL []BYTE string, VAL INT file, INT bytes.written)
XPROC fgets([]BYTE string, VAL INT maxlen, file, INT bytes.read)
X
XIf the extra information on the number of bytes read or written is
Xrequired for stdin, stderr or stdout then these routines can be used in
Xplace of puts and gets.
X
X
XFormatted I/O - atov and doprnt
X-------------
XThese routines are not included as source in stdio.occ but are
Xreferenced as library routines via #USE "atov.obj" and #USE
X"doprnt.obj". If they are used by the users program then the linker will
Xinclude the code, otherwise no extra code is included. All the standard
Xoccam maths libraries are also #USE'd by stdio.occ for use in these routines.
X
XAtov
X----
XThe atov library includes
X
XPROC atoi(INT value, INT n, VAL BYTE string) -- decimal ascii to int
XPROC axtoi(INT value, INT n, VAL BYTE string) -- hex ascii to int
XPROC atof(REAL32 value, INT n, VAL BYTE string) -- ascii to float
XPROC atod(REAL64 value, INT n, VAL BYTE string) -- ascii to double
X
XIn these "n" is the point to start looking in the string, white space is
Xskipped and a conversion is performed using the ioconv.occ library
Xroutine. "n" is left pointing at the next unused character. These
Xroutines are useful for reading numbers off the argv command line string
Xin particular.
X
XPrintf
X------
XThe doprnt library is used to manufacture a tailored printf
Xvariant. The idea is to satisfy the type rules but get the hard work
Xdone for you by library routines and be like the C printf.
XThe format specifier is like C printf e.g.
X
X%s, %12s, %-12s string, string in width 12 right, left justified
X%c, %12c, %-12c char, char in width 12 right, left justified
X%b, %12b, %-12b bool, bool in width 12 right, left justified
X%d, %12d, %-12d, %012d decimal half int or long, 0 for zero pad
X%x, %12x, %-12x, %012x hexadecimal half int or long, 0 for zero pad
X%f, %5.6f, %.8e, %-7.8e floating real32 or real64, integer.fraction
X f for 123.456, e for 1.23456E+02
X
XThe code given below is an example of how to use doprnt to generate a
Xprintf routine that matches the type checking syntax of occam. You need
Xto generate a separate printf for each set of parameters that you wish
Xto pass to it but this isn't much code. The hard work is done in
Xdoprnt. The extended printf name is a useful convention to remember the
Xtypes by.
X
XPROC printf.scbhilfd(VAL []BYTE format, VAL []BYTE string, VAL BYTE char,
X VAL BOOL bool, VAL INT16 half, VAL INT32 int, VAL INT64 long,
X VAL REAL32 float, VAL REAL64 double)
X [256]BYTE result: -- set this to cope with the biggest string to print
X INT flen: -- flen is how much of format has been used
X INT rlen: -- rlen is how much has been put into result
X SEQ
X flen := 0 -- these are updated by each doprnt
X rlen := 0
X doprnt.s(format,flen,result,rlen,string) -- provided
X doprnt.c(format,flen,result,rlen,char) -- base on s
X doprnt.b(format,flen,result,rlen,bool) -- base on s
X doprnt.h(format,flen,result,rlen,half) -- base on i
X doprnt.i(format,flen,result,rlen,int) -- provided
X doprnt.l(format,flen,result,rlen,long) -- base on i
X doprnt.f(format,flen,result,rlen,float) -- base on d
X doprnt.d(format,flen,result,rlen,double) -- provided
X IF
X rlen > 0
X puts([result FROM 0 FOR rlen]) -- note that fprintf can use fputs
X TRUE
X SKIP -- 0 length slice causes error
X:
X
XThe file doprnt.occ provides definitions of doprnt.s for strings ([]BYTE),
Xdoprnt.i for integers (INT or INT32) and doprnt.d for doubles (REAL64).
XThe other variants can be generated very easily, based on the code for a
Xsimilar type. I haven't yet needed the other types and much of the code
Xis duplicated so there isn't much point in distributing it.
X
XNote that e.g. if you always want to print integers but between 1 and 5
Xof them then you can define prinf.5i then only give the required number
Xof %d's in the format string and pad the unused parameters with zeros.
XThe last few calls to doprnt.i will see that the end of the format
Xstring has been reached early and will have no effect.
X
*-*-END-of-STDIO.DOC-*-*
echo x - stdio.occ
sed 's/^X//' >stdio.occ <<'*-*-END-of-stdio.occ-*-*'
X-- stdio.occ - standard i/o package a bit like C for afserver
X-- to be #INCLUDE'd in scope of CHAN OF ANY from.filer, to.filer
X#USE "flibs.obj" -- grotty library provided with compiler
X
X-- parameterised constants
XVAL BinaryByteStream.Access IS 0:
XVAL TextByteStream.Access IS 1:
XVAL SeqRecord.Access IS 2:
XVAL Direct.Access IS 3:
XVAL Read.Mode IS 0:
XVAL Write.Mode IS 1:
XVAL Update.Mode IS 2:
XVAL Old.File IS 0:
XVAL New.File IS 1:
XVAL Screen.Use IS 0:
XVAL Keyboard.Use IS 1:
XVAL File.Use IS 2:
XVAL Temp.Use IS 3:
XVAL Parameter.Use IS 4:
XVAL Close.Option IS 0:
XVAL CloseDel.Option IS 1:
X
XVAL InvalidStream IS -1:
X
XVAL OperationOk IS 0:
XVAL EndOfFile IS 1:
XVAL FileNameTooLong.Err IS 2:
XVAL InvalidAccessMethod.Err IS 3:
XVAL InvalidOpenMode.Err IS 4:
XVAL InvalidExistMode.Err IS 5:
XVAL InvalidRecordLength.Err IS 6:
XVAL InvalidStdStream.Err IS 7:
XVAL InvalidStreamId.Err IS 8:
XVAL InvalidCloseOption.Err IS 9:
XVAL NoSeekPossible.Err IS 10:
XVAL InvalidRecordNumber.Err IS 11:
XVAL OperationFailed.Err IS 99: --General failure
XVAL NoFreeChannel.Err IS 100:
XVAL NoSuchFile.Err IS 101:
XVAL FileAlreadyOpen.Err IS 102:
XVAL ReadOpenFail.Err IS 103:
X
X[256]BYTE argv:
XINT errno, stdin, stdout, stderr, argc:
X
X-- errno is used to hold the last error code
X-- for each operation it is set to OperationOk then result is passed to this
X-- routine. If part of a proc fails then errno is set but if a later part
X-- works OK then errno is not lost. The last error set by the proc is saved.
XPROC update.errno(VAL INT result)
X IF
X result <> OperationOk
X errno := result
X TRUE
X SKIP
X:
X
XPROC open(INT stream, VAL []BYTE name, VAL INT mode)
X INT result:
X SEQ
X errno := OperationOk
X IF
X (mode = Read.Mode) OR (mode = Update.Mode)
X open.file(from.filer, to.filer, name, BinaryByteStream.Access, mode,
X Old.File, 0, stream, result)
X mode = Write.Mode
X open.file(from.filer, to.filer, name, BinaryByteStream.Access, mode,
X New.File, 0, stream, result)
X TRUE
X result := InvalidOpenMode.Err
X IF
X result = OperationOk
X SKIP
X TRUE
X stream := InvalidStream -- failed to open
X update.errno(result)
X:
X
XPROC close(VAL INT stream)
X INT result:
X SEQ
X errno := OperationOk
X close.stream(from.filer, to.filer, stream, Close.Option, result)
X update.errno(result)
X:
X
X-- call this before doing anything
X-- opens keyboard and screen streams, reads parameter string into argv
X-- returns size of string in argc and initialises errno
XPROC stdopen()
X INT result, param:
X SEQ
X errno := OperationOk
X open.output.stream(from.filer, to.filer, 0, stdout, result)
X update.errno(result)
X open.input.stream(from.filer, to.filer, 0, stdin, result)
X update.errno(result)
X open.output.stream(from.filer, to.filer, 1, stderr, result)
X update.errno(result)
X open.input.stream(from.filer, to.filer, 1, param, result)
X update.errno(result)
X read.block(from.filer, to.filer, param, (SIZE argv), argv, argc, result)
X update.errno(result)
X close(param)
X:
X
X-- call this before finishing
XPROC stdclose()
X INT result:
X SEQ
X errno := OperationOk
X close.stream(from.filer, to.filer, stdin, Close.Option, result)
X update.errno(result)
X close.stream(from.filer, to.filer, stdout, Close.Option, result)
X update.errno(result)
X close.stream(from.filer, to.filer, stderr, Close.Option, result)
X update.errno(result)
X terminate.filer(from.filer, to.filer, result)
X update.errno(result)
X:
X
XPROC fgets([]BYTE str, VAL INT maxlen, file, INT bytes.read)
X INT result:
X SEQ
X read.block(from.filer, to.filer, file, maxlen, str, bytes.read, result)
X errno := result
X:
X
XPROC gets([]BYTE str, INT bytes.read)
X fgets(str, (SIZE str), stdin, bytes.read)
X:
X
XPROC fputs(VAL []BYTE str, VAL INT file, INT bytes.written)
X INT result:
X IF
X (SIZE str) > 0
X SEQ
X write.block(from.filer, to.filer, file, str, bytes.written, result)
X errno := result
X TRUE
X errno := InvalidRecordLength.Err
X:
X
XPROC puts(VAL []BYTE str)
X INT len:
X fputs(str, stdout, len)
X:
X
X-- The following is an example of how to construct a tailored printf
X-- variant. The idea is to satisfy the type rules but get the hard work
X-- done for you by library routines and be like the C printf
X-- The example is commented out because it would pull in all the doprnt variants
X-- from the library. The name is a useful convention to remember the types by.
X-- Format specifier is like C printf
X-- %s, %12s, %-12s string, string in width 12 right, left justified
X-- %c, %12c, %-12c char, char in width 12 right, left justified
X-- %b, %12b, %-12b bool, bool in width 12 right, left justified
X-- %d, %12d, %-12d, %012d decimal half int or long, 0 for zero pad
X-- %x, %12x, %-12x, %012x hexadecimal half int or long, 0 for zero pad
X-- %f, %5.6f, %.8e, %-7.8e floating real32 or real64, integer.decimal
X-- f for 123.456, e for 1.23456E+02
X#USE "doprnt.obj" -- source is in doprnt.occ
X#USE "atov.obj" -- ascii to value from atov.occ
X#USE "ioconv.obj" -- used by doprnt
X#USE "extrio.obj"
X-- PROC printf.scbhilfd(VAL []BYTE format, VAL []BYTE string, VAL BYTE char,
X-- VAL BOOL bool, VAL INT16 half, VAL INT32 int, VAL INT64 long,
X-- VAL REAL32 float, VAL REAL64 double)
X-- [256]BYTE result:
X-- INT flen: -- flen is how much of format has been used
X-- INT rlen: -- rlen is how much has been put into result
X-- SEQ
X-- flen := 0
X-- rlen := 0
X-- doprnt.s(format,flen,result,rlen,string)
X-- doprnt.c(format,flen,result,rlen,char)
X-- doprnt.b(format,flen,result,rlen,bool)
X-- doprnt.h(format,flen,result,rlen,half)
X-- doprnt.i(format,flen,result,rlen,int)
X-- doprnt.l(format,flen,result,rlen,long)
X-- doprnt.f(format,flen,result,rlen,float)
X-- doprnt.d(format,flen,result,rlen,double)
X-- IF
X-- rlen > 0
X-- puts([result FROM 0 FOR rlen]) -- note that fprintf can use fputs
X-- TRUE
X-- SKIP -- 0 length slice causes error
X-- :
X
X
X
X
*-*-END-of-stdio.occ-*-*
echo x - doprnt.occ
sed 's/^X//' >doprnt.occ <<'*-*-END-of-doprnt.occ-*-*'
X#USE "ioconv.obj"
X#USE "extrio.obj"
X-- routines used to build up versions of printf for stdio.occ
X-- this routine formats an int into result according to the format
XPROC doprnt.i(VAL []BYTE format, INT flen, []BYTE result, INT rlen,
X VAL INT value)
X INT width:
X BOOL left, done:
X BYTE pad:
X SEQ
X pad := ' ' -- default pad character
X left := FALSE -- don't left justify
X done := FALSE -- set true after int has been done and another % found
X width := 0
X WHILE (NOT done) AND ((flen < (SIZE format)) AND ((rlen+1) < (SIZE result)))
X SEQ
X IF
X format[flen] = '%'
X WHILE (NOT done) AND ( ((flen+1) < (SIZE format)) AND
X ((rlen+1) < (SIZE result)) )
X SEQ
X flen := flen + 1
X IF
X -- "%12" field width specifier or "%0" zero pad
X ((format[flen] >= '0') AND (format[flen] <= '9'))
X IF
X -- "%0" pad with zeroes
X (format[flen] = '0') AND (format[flen-1] = '%')
X pad := '0'
X TRUE
X width := (width * 10) + ((INT format[flen]) - (INT '0'))
X -- "%-" left justify
X format[flen] = '-'
X left := TRUE
X -- "%%" insert %
X format[flen] = '%'
X SEQ
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 1
X -- "%d" "%12d" "%012d" "%-12d" "%-012d" decimal options
X -- "%x" "%12x" "%012x" "%-12x" "%-012x" hexadecimal options
X (format[flen] = 'd') OR (format[flen] = 'x')
X [12]BYTE buf: -- big enough for any 32bit int
X INT l:
X SEQ
X IF
X format[flen] = 'd'
X INTTOSTRING(l,buf,value)
X format[flen] = 'x'
X HEXTOSTRING(l,buf,value)
X IF
X (rlen + l) > (SIZE result) -- doesn't fit
X SKIP
X width <= l -- width may be too small so grow a bit
X SEQ
X [result FROM rlen FOR l] := [buf FROM 0 FOR l]
X rlen := rlen + l
X left
X SEQ
X [result FROM rlen FOR l] := [buf FROM 0 FOR l]
X rlen := rlen + l
X WHILE l < width
X SEQ
X result[rlen] := ' '
X rlen := rlen + 1
X width := width - 1
X NOT left
X SEQ
X WHILE l < width
X SEQ
X result[rlen] := pad
X rlen := rlen + 1
X width := width - 1
X [result FROM rlen FOR l] := [buf FROM 0 FOR l]
X rlen := rlen + l
X TRUE
X SKIP
X flen := flen + 1 -- skip over d or x
X -- skip over format until another %? is seen or end
X WHILE (NOT done) AND ( (flen < (SIZE format)) AND
X (rlen < (SIZE result)) )
X IF
X format[flen] = '%'
X IF
X (flen+1) >= (SIZE format)
X SEQ -- % was the last thing in format
X result[rlen] := format[flen]
X rlen := rlen + 1
X done := TRUE
X format[flen+1] = '%'
X SEQ -- allow %% for % in string
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 2
X TRUE -- %? seen so quit with format[flen] = '%'
X done := TRUE
X TRUE
X SEQ -- anything else is copied
X result[rlen] := format[flen]
X rlen := rlen + 1
X flen := flen + 1
X TRUE -- "%<something else>" so quit
X SEQ
X flen := flen - 1 -- wind back so % is next char
X done := TRUE -- for another call to doprnt.?
X TRUE -- an initial "%" has not been seen
X SEQ
X result[rlen] := format[flen]
X flen := flen + 1
X rlen := rlen + 1
X:
X
X-- this routine formats a string into result according to the format
XPROC doprnt.s(VAL []BYTE format, INT flen, []BYTE result, INT rlen,
X VAL []BYTE value)
X INT width:
X BOOL left, done:
X SEQ
X left := FALSE -- don't left justify
X done := FALSE -- set true after int has been done and another % found
X width := 0
X WHILE (NOT done) AND ((flen < (SIZE format)) AND ((rlen+1) < (SIZE result)))
X SEQ
X IF
X format[flen] = '%'
X WHILE (NOT done) AND ( ((flen+1) < (SIZE format)) AND
X ((rlen+1) < (SIZE result)) )
X SEQ
X flen := flen + 1
X IF
X -- "%12" field width specifier
X ((format[flen] >= '0') AND (format[flen] <= '9'))
X width := (width * 10) + ((INT format[flen]) - (INT '0'))
X -- "%-" left justify
X format[flen] = '-'
X left := TRUE
X -- "%%" insert %
X format[flen] = '%'
X SEQ
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 1
X -- "%s" "%12s" "%-12" string options
X format[flen] = 's'
X INT l:
X SEQ
X l := SIZE value
X IF
X (rlen + l) > (SIZE result) -- doesn't fit
X SKIP
X width <= l -- width may be too small so grow a bit
X SEQ
X [result FROM rlen FOR l] := value
X rlen := rlen + l
X left
X SEQ
X [result FROM rlen FOR l] := value
X rlen := rlen + l
X WHILE l < width
X SEQ
X result[rlen] := ' '
X rlen := rlen + 1
X width := width - 1
X NOT left
X SEQ
X WHILE l < width
X SEQ
X result[rlen] := ' '
X rlen := rlen + 1
X width := width - 1
X [result FROM rlen FOR l] := value
X rlen := rlen + l
X TRUE
X SKIP
X flen := flen + 1 -- skip over s
X -- skip over format until another %? is seen or end
X WHILE (NOT done) AND ( (flen < (SIZE format)) AND
X ((rlen+1) < (SIZE result)) )
X IF
X format[flen] = '%'
X IF
X (flen+1) >= (SIZE format)
X SEQ -- % was the last thing in format
X result[rlen] := format[flen]
X rlen := rlen + 1
X done := TRUE
X format[flen+1] = '%'
X SEQ -- allow %% for % in string
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 2
X TRUE -- %? seen so quit
X done := TRUE
X TRUE
X SEQ -- anything else is copied
X result[rlen] := format[flen]
X rlen := rlen + 1
X flen := flen + 1
X TRUE -- "%<something else>" so quit
X SEQ
X flen := flen - 1 -- wind back so % is next char
X done := TRUE -- for another call to doprnt.?
X TRUE -- an initial "%" has not been seen
X SEQ
X result[rlen] := format[flen]
X flen := flen + 1
X rlen := rlen + 1
X:
X
X-- this routine formats a REAL64 into result according to the format
X-- sometimes %f will print with E+000, or %e will miss out E+000
X-- this is due to the conversion routine seeing a silly width/value
XPROC doprnt.d(VAL []BYTE format, INT flen, []BYTE result, INT rlen,
X VAL REAL64 value)
X INT widthi,widthf: -- width of integer and fractional parts
X BOOL left, done, dot:
X BYTE pad:
X SEQ
X pad := ' ' -- default pad character
X left := FALSE -- don't left justify
X dot := FALSE -- haven't seen dot yet
X done := FALSE -- set true after one has been done and another % found
X widthi := 0
X widthf := 0
X WHILE (NOT done) AND ((flen < (SIZE format)) AND ((rlen+1) < (SIZE result)))
X SEQ
X IF
X format[flen] = '%'
X WHILE (NOT done) AND ( ((flen+1) < (SIZE format)) AND
X ((rlen+1) < (SIZE result)) )
X SEQ
X flen := flen + 1
X IF
X -- "%12" field width specifier or "%0" zero pad
X ((format[flen] >= '0') AND (format[flen] <= '9'))
X IF
X NOT dot -- integer part
X widthi := (widthi*10) + ((INT format[flen]) - (INT '0'))
X dot -- fract part
X widthf := (widthf*10) + ((INT format[flen]) - (INT '0'))
X -- "%4.3f" look for the "."
X format[flen] = '.'
X dot := TRUE
X -- "%-" left justify
X format[flen] = '-'
X left := TRUE
X -- "%%" insert %
X format[flen] = '%'
X SEQ
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 1
X -- "%f" "%12f" "%.4f" "%3.4f" "%-3.4f" 123.456 options
X -- "%e" "%12e" "%.4e" "%3.4e" "%-3.4e" 1.23456E+002 options
X (format[flen] = 'f') OR (format[flen] = 'e') -- floating point
X [30]BYTE buf: -- big enough for any 64bit real
X INT l,wi,wf,width:
X SEQ
X IF
X widthi > 13
X wi := 13
X TRUE
X wi := widthi
X IF
X widthf > 17
X wf := 17
X (format[flen] = 'e') AND (widthf = 0)
X wf := 17 -- otherwise we dont get E+000
X TRUE
X wf := widthf
X IF
X format[flen] = 'f'
X SEQ
X REAL64TOSTRING(l,buf,value,wi,wf)
X width := (widthi+widthf)+2 -- "-."
X format[flen] = 'e'
X SEQ
X REAL64TOSTRING(l,buf,value,0,wf)
X width := (widthi+widthf)+7 -- "-.E+000"
X IF
X (rlen + l) > (SIZE result) -- doesn't fit
X SKIP
X left
X SEQ
X [result FROM rlen FOR l] := [buf FROM 0 FOR l]
X rlen := rlen + l
X WHILE l < width
X SEQ
X result[rlen] := ' '
X rlen := rlen + 1
X width := width - 1
X NOT left
X SEQ
X WHILE l < width
X SEQ
X result[rlen] := pad
X rlen := rlen + 1
X width := width - 1
X [result FROM rlen FOR l] := [buf FROM 0 FOR l]
X rlen := rlen + l
X TRUE
X SKIP
X flen := flen + 1 -- skip over f or e
X -- skip over format until another %? is seen or end
X WHILE (NOT done) AND ( (flen < (SIZE format)) AND
X (rlen < (SIZE result)) )
X IF
X format[flen] = '%'
X IF
X (flen+1) >= (SIZE format)
X SEQ -- % was the last thing in format
X result[rlen] := format[flen]
X rlen := rlen + 1
X done := TRUE
X format[flen+1] = '%'
X SEQ -- allow %% for % in string
X result[rlen] := '%'
X rlen := rlen + 1
X flen := flen + 2
X TRUE -- %? seen so quit with format[flen] = '%'
X done := TRUE
X TRUE
X SEQ -- anything else is copied
X result[rlen] := format[flen]
X rlen := rlen + 1
X flen := flen + 1
X TRUE -- "%<something else>" so quit
X SEQ
X flen := flen - 1 -- wind back so % is next char
X done := TRUE -- for another call to doprnt.?
X TRUE -- an initial "%" has not been seen
X SEQ
X result[rlen] := format[flen]
X flen := flen + 1
X rlen := rlen + 1
X:
X
*-*-END-of-doprnt.occ-*-*
echo x - atov.occ
sed 's/^X//' >atov.occ <<'*-*-END-of-atov.occ-*-*'
X#USE "ioconv.obj"
X#USE "extrio.obj"
X-- ascii to value routines called up via stdio.occ
X-- atod for REAL64
X-- atof for REAL32
X-- atoi for decimal ascii to INT
X-- axtoi for hex ascii to INT
X-- useful for reading values off the argv string
X-- floating point input MUST have a point in the string with a digit each side
X
X-- this reads the string starting at string[n] stopping at the next space
X-- or the end of the string. If a value is successfully converted then
X-- value is updated, otherwise it is left alone. Leading spaces are skipped.
XPROC atod(REAL64 value, INT n, VAL []BYTE string)
X INT len:
X BOOL skipping, done, error:
X REAL64 result:
X SEQ
X len := 0
X done := FALSE
X skipping := TRUE
X WHILE (NOT done) AND ((n + len) < (SIZE string))
X IF
X string[n+len] = ' '
X IF
X skipping
X len := len + 1
X NOT skipping
X done := TRUE
X TRUE
X SEQ
X skipping := FALSE
X len := len + 1
X IF
X (len = 0) OR skipping
X SKIP
X TRUE
X SEQ
X STRINGTOREAL64(error, result, [string FROM n FOR len])
X n := n + len
X IF
X NOT error
X value := result
X TRUE
X SKIP
X:
X
XPROC atoi(INT value, INT n, VAL []BYTE string)
X INT len:
X BOOL skipping, done, error:
X INT result:
X SEQ
X len := 0
X done := FALSE
X skipping := TRUE
X WHILE (NOT done) AND ((n + len) < (SIZE string))
X IF
X string[n+len] = ' '
X IF
X skipping
X len := len + 1
X NOT skipping
X done := TRUE
X TRUE
X SEQ
X skipping := FALSE
X len := len + 1
X IF
X (len = 0) OR skipping
X SKIP
X TRUE
X SEQ
X STRINGTOINT(error, result, [string FROM n FOR len])
X n := n + len
X IF
X NOT error
X value := result
X TRUE
X SKIP
X:
X
XPROC atof(REAL32 value, INT n, VAL []BYTE string)
X INT len:
X BOOL skipping, done, error:
X REAL32 result:
X SEQ
X len := 0
X done := FALSE
X skipping := TRUE
X WHILE (NOT done) AND ((n + len) < (SIZE string))
X IF
X string[n+len] = ' '
X IF
X skipping
X len := len + 1
X NOT skipping
X done := TRUE
X TRUE
X SEQ
X skipping := FALSE
X len := len + 1
X IF
X (len = 0) OR skipping
X SKIP
X TRUE
X SEQ
X STRINGTOREAL32(error, result, [string FROM n FOR len])
X n := n + len
X IF
X NOT error
X value := result
X TRUE
X SKIP
X:
X
XPROC axtoi(INT value, INT n, VAL []BYTE string)
X INT len:
X BOOL skipping, done, error:
X INT result:
X SEQ
X len := 0
X done := FALSE
X skipping := TRUE
X WHILE (NOT done) AND ((n + len) < (SIZE string))
X IF
X string[n+len] = ' '
X IF
X skipping
X len := len + 1
X NOT skipping
X done := TRUE
X TRUE
X SEQ
X skipping := FALSE
X len := len + 1
X IF
X (len = 0) OR skipping
X SKIP
X TRUE
X SEQ
X STRINGTOHEX(error, result, [string FROM n FOR len])
X n := n + len
X IF
X NOT error
X value := result
X TRUE
X SKIP
X:
X
*-*-END-of-atov.occ-*-*
echo x - harness.occ
sed 's/^X//' >harness.occ <<'*-*-END-of-harness.occ-*-*'
XPROC INMOS.ENTRY.POINT (CHAN OF ANY from.link, to.link,
X []INT program.buffer)
X-- DO NOT CHANGE PROCEDURE NAME, IT IS IMPORTANT.
X #SC "filter.occ" Filer server interface provided with compiler
X #SC "main.occ" User program procedure
X -- Change the above filename to that which
X -- contains the source of your program
X
X INT parity.control:
X PLACE parity.control AT #20000002:
X SEQ
X parity.control := 0 -- disable
X INT pc.dummy:
X pc.dummy := parity.control -- dummy read to clear latch
X parity.control := 1 -- enable
X CHAN OF ANY from.filer, to.filer:
X -- Channels to talk to filer server interface
X PAR
X link.filter(to.filer, from.filer, from.link, to.link)
X WHILE TRUE
X main(from.filer, to.filer)
X -- call of user program procedure
X -- change as required
X:
*-*-END-of-harness.occ-*-*
echo x - main.occ
sed 's/^X//' >main.occ <<'*-*-END-of-main.occ-*-*'
X-- Double precision floating point mandelbrot generator
X-- ANC 26/1/88 for single processor, up to 4 could be used
X
X-- main program calculates and communicates results
XPROC main(CHAN OF ANY from.filer, to.filer)
X #SC "mandcalc.occ"
X CHAN OF ANY ToCalc0, FromCalc0:
X PAR
X #INCLUDE "stdio.occ"
X PROC printf.4d4i(VAL []BYTE format, VAL REAL64 d1, d2, d3, d4,
X VAL INT i1, i2, i3, i4)
X [200]BYTE result:
X INT flen, rlen:
X SEQ
X flen := 0
X rlen := 0
X doprnt.d(format, flen, result, rlen, d1)
X doprnt.d(format, flen, result, rlen, d2)
X doprnt.d(format, flen, result, rlen, d3)
X doprnt.d(format, flen, result, rlen, d4)
X doprnt.i(format, flen, result, rlen, i1)
X doprnt.i(format, flen, result, rlen, i2)
X doprnt.i(format, flen, result, rlen, i3)
X doprnt.i(format, flen, result, rlen, i4)
X puts([result FROM 0 FOR rlen])
X :
X [1024]BYTE pixbuf:
X BOOL running:
X INT pixel, pixptr, written:
X REAL64 xMin, xMax, yMin, yMax:
X INT xSize, ySize:
X INT inter, cutOff, n, outfile:
X SEQ
X stdopen()
X -- Get parameters
X IF
X argc = 0
X puts("*Noutfile [xMin xMax yMin yMax xSize ySize interval cutoff]*N")
X TRUE
X SEQ
X n := 0
X outfile := 0
X WHILE (n < argc) AND (argv[n] <> ' ')
X n := n + 1
X open(outfile, [argv FROM 0 FOR n], Write.Mode)
X xMin := -2.25(REAL64) -- default value
X atod(xMin, n, [argv FROM 0 FOR argc])
X xMax := 0.75(REAL64)
X atod(xMax, n, [argv FROM 0 FOR argc])
X yMin := -1.50(REAL64)
X atod(yMin, n, [argv FROM 0 FOR argc])
X yMax := 1.50(REAL64)
X atod(yMax, n, [argv FROM 0 FOR argc])
X xSize := 320
X atoi(xSize, n, [argv FROM 0 FOR argc])
X IF
X xSize > 1024
X xSize := 1024
X TRUE
X SKIP
X ySize := 240
X atoi(ySize, n, [argv FROM 0 FOR argc])
X inter := 10
X atoi(inter, n, [argv FROM 0 FOR argc])
X cutOff := 240
X atoi(cutOff, n, [argv FROM 0 FOR argc])
X ToCalc0 ! xMin; xMax; yMin; yMax;
X xSize; ySize; inter; cutOff; 1; 0
X printf.4d4i("Calculating with the following parameters*N"
X "xMin %f*NxMax %f*NyMin %f*NyMax %f*N"
X "xSize %d*NySize %d*Ninter %d*Ncutoff %d*N",
X xMin,xMax,yMin,yMax,xSize,ySize,inter,cutOff)
X pixptr := 0
X running := TRUE
X WHILE running
X SEQ
X FromCalc0 ? pixel
X IF
X pixel = (-2)
X SEQ -- end of picture
X running := FALSE
X fputs([pixbuf FROM 0 FOR xSize], outfile, written)
X pixel = (-1)
X SEQ -- end of scan line
X fputs([pixbuf FROM 0 FOR xSize], outfile, written)
X pixptr := 0
X pixptr < xSize
X SEQ -- add pixel to scan line
X pixbuf[pixptr] := (BYTE pixel)
X pixptr := pixptr + 1
X TRUE
X SKIP
X close(outfile)
X stdclose()
X -- second component of PAR construct
X REAL64 xMin, xMax, yMin, yMax:
X INT xSize, ySize :
X INT inter, cutOff, NumCalcs, ThisCalc:
X SEQ
X ToCalc0 ? xMin; xMax; yMin; yMax;
X xSize; ySize; inter; cutOff; NumCalcs; ThisCalc
X MandelCalc (xMin, xMax, yMin, yMax, xSize, ySize,
X inter, cutOff, NumCalcs, ThisCalc, FromCalc0)
X:
X
*-*-END-of-main.occ-*-*
echo x - mandcalc.occ
sed 's/^X//' >mandcalc.occ <<'*-*-END-of-mandcalc.occ-*-*'
X#USE "realt8.obj"
X#USE "realpdt8.obj"
XPROC MandelCalc(VAL REAL64 xMin, xMax, yMin, yMax, VAL INT xSize, ySize,
X inter, cutOff, Ncalcs, ThisCalc, CHAN OF INT output)
X REAL64 xStep, yStep, xOff, nxMin:
X SEQ
X -- Set up initial values and constants
X xStep := (xMax - xMin) / (REAL64 ROUND xSize)
X yStep := (yMax - yMin) / (REAL64 ROUND ySize) -- pixel step
X xOff := xStep * (REAL64 ROUND ThisCalc) -- offset
X xStep := xStep * (REAL64 ROUND Ncalcs) -- bigger step
X nxMin := xMin + xOff -- offset start
X -- Iteration loop
X SEQ yP = 0 FOR ySize
X SEQ
X SEQ xP = 0 FOR xSize/Ncalcs
X REAL64 xPos, yPos, xVal, yVal:
X INT iVal:
X BOOL going:
X SEQ
X -- Initialise loop
X xPos := nxMin + (xStep * (REAL64 ROUND xP))
X yPos := yMin + (yStep * (REAL64 ROUND yP))
X xVal := 0.0(REAL64)
X yVal := 0.0(REAL64)
X iVal := 0
X going := TRUE
X WHILE going AND (iVal < cutOff)
X REAL64 xSq, ySq, rad:
X SEQ
X -- Iteration loop code
X xSq := xVal * xVal
X ySq := yVal * yVal
X rad := xSq + ySq
X yVal := ((xVal * yVal) * 2.0(REAL64)) + yPos
X xVal := (xSq - ySq) + xPos
X iVal := iVal + inter
X IF
X rad >= 100.0(REAL64)
X going := FALSE
X TRUE
X SKIP
X IF -- see if we stopped due to rad or cutOff
X going
X output ! 0 -- cutOff before rad limit
X NOT going
X output ! iVal -- report iters to rad limit
X output ! -1 -- end of line
X output ! -2 -- end of picture
X:
X
*-*-END-of-mandcalc.occ-*-*
echo End of Archive
exit
--
| Adrian Cockcroft anc@camcon.uucp ..!seismo!mcvax!ukc!camcon!anc
-[T]- Cambridge Consultants Ltd, Science Park, Cambridge CB4 4DW,
| England, UK (0223) 358855
(You are in a maze of twisty little C004's, all alike...)