This is a cross-referenced version of open.plan, to download the unmodified
source try open.plan.
#PROGRAM /GFOPEN(15AM,22AM,DBM,EBM)
#PAGE
#INCLUDE IOHEAD(/DEFS)
#INCLUDE STACK(/DEFS)
#PERMANENT GFOPENCI [ consolidator not seeing #CUE
#PERMANENT GFWRITEINT
#PERMANENT GFWRITE6
# Open a file
# integer procedure open (name, namelen, mode, type);
# value namelen, mode, type;
# integer name, namelen, mode, type;
#
# fd = open(name, namelen, mode, type)
#
# name is the filename, in ICL 6 bit code.
# namelen is the length in characters of the name.
# mode is:
# 0 read buffered
# 1 read
# 2 read/write
# 3 write (empty file)
# 4 append
# type is:
# 0 don't care (implies AMORPHOUS for create)
# 1 GRAPHIC
# 2 NORMAL
# 3 ALLCHAR
# We implement this using the *FR, *FW and *FH devices,
# with appropriate qualifiers on the open.
# Here is what the manual says:
# A file handler (*FH) can be assigned to any terminal
# serial file. Valid qualifiers and their effects are
# described below.
# If READ or APPEND is specified the file handler will
# only be allowed to read from (modes #0, #2, #7, #12,
# #22) or append to (modes #1, #12, #21) the file.
# If WRITE is specified all operations will be allowed.
# If none of the qualifiers READ, APPEND and WRITE is
# specified, READ is assumed.
# If it is required to overwrite a file, APPEND and EMPTY
# must be specified and a WRITE trap will be required.
# The qualifiers MULTIPLE, COMMUNE, and GDR have the same
# effect as with basic peripherals; however, it should be
# noted that they impose certain restrictions on the modes
# of PERI that are permitted (see Chapter 14).
# The LIMIT qualifier has the same effect as with magnetic
# tape, and limits the number of PERIs that may be issued
# provided the file is open for WRITEing or APPENDing.
# The file type qualifiers GRAPHIC, NORMAL and ALLCHAR may
# be specified provided APPEND or WRITE is also
# specified. If a file is to be emptied or created then
# these qualifiers give the new type of the file, and if
# none is specified the file will be amorphous. Otherwise
# the file will be opened only if the file type is the
# same as that given by the qualifier.
# It is the user’s responsibility to ensure that all
# records written to the file have the correct format for
# the type of file set up. If the file is a basic file
# this includes the second word of the record header.
# Although it is recommended that *FH be used instead of
# *FR and *FW, support for the latter will continue in the
# current mark. Apart from the type number,
# *FR is equivalent to *FH with a READ qualifier
# *FW with the APPEND qualifier is equivalent to *FH with
# the APPEND qualifier
# *FW without the APPEND qualifier is equivalent to *FH
# with both the APPEND and EMPTY qualifiers.
# PURE upper area, holds only constant data:
#PUPPER
# Mode
# 0 read buffered
# 1 read
# 2 read/write
# 3 write (empty file)
# 4 append
#DEFINE MDDEV=0
#DEFINE MDREAD=1
#DEFINE MDWRITE=2
#DEFINE MDQUAL=3
MODE0 DEVFR [ mode 0 = readbuf
#22 [ *FR, read buffered
-1
4HREAD
MODE1 DEVFR [ mode 1 = read
#2 [ *FR, readline
-1
4HREAD
MODE2 DEVFH [ mode 2 = read/write
#2 [ *FH, readline
#1
4HWRIT [ (WRITE)
MODE3 DEVFW [ mode 3 = write
-1
#1 [ *FW, append
4HWRIT
MODE4 DEVFW [ mode 4 = append
-1
#1 [ *FW,append
4HAPPE [ (APPEND)
#DEFINE MAXMODE=5
# Type
# 0 don't care (implies AMORPHOUS for create)
# 1 GRAPHIC
# 2 NORMAL
# 3 ALLCHAR
TYPE0 0
TYPE1 4HGRAP
TYPE2 4HNORM
TYPE3 4HALLC
#DEFINE MAXTYPE=4
# Commands
ASFR 8HAS *FR
ASFW 8HAS *FW
ASFH 8HAS *FH
# in a clearer manner
# Define offsets into pure #UPPER
#DEFINE UPPER=MODE0 [ first thing in #UPPER
#DEFINE OMODE=MODE0-UPPER
#DEFINE OTYPE=TYPE0-UPPER
#DEFINE OASSIGN=ASFR-UPPER
#LOWER
OURCI -1 [ private command issuer
# Arguments
# fd = open(name, namelen, mode, type)
#SET ARGS=0
#DEFINE ARGNAME=ARGS
#SET ARGS=ARGS+1
#DEFINE ARGNAMELEN=ARGS
#SET ARGS=ARGS+1
#DEFINE ARGMODE=ARGS
#SET ARGS=ARGS+1
#DEFINE ARGTYPE=ARGS
#SET ARGS=ARGS+1
# Define stack frame
#SET STFRAME=SXFRAME
# First, arguments:
#DEFINE STNAME=SXPAR1 [ file name
#SET STFRAME=STFRAME+1
#DEFINE STNAMELEN=SXPAR2 [ name length
#SET STFRAME=STFRAME+1
#DEFINE STMODE=SXPAR3 [ open mode
#SET STFRAME=STFRAME+1
#DEFINE STTYPE=SXPAR4 [ file type
#SET STFRAME=STFRAME+1
# Next, local variables:
#DEFINE STUNIT=STFRAME [ *FHn
#SET STFRAME=STFRAME+1
#DEFINE STBUF=STFRAME [ used by WRCH
#SET STFRAME=STFRAME+1
#DEFINE STRET=STFRAME [ used by WRCH,WRSTR
#SET STFRAME=STFRAME+1
#DEFINE STSEP=STFRAME [ used by WRSEP
#SET STFRAME=STFRAME+1
#DEFINE STSLEN=STFRAME [ used by WRSEP
#SET STFRAME=STFRAME+1
#DEFINE STSRET=STFRAME [ used by WRSEP
#SET STFRAME=STFRAME+1
#DEFINE STSSTR=STFRAME [ used by WRSEP
#SET STFRAME=STFRAME+1
#PROGRAM
# Fortran callable entry point, copy the args:
# first pick up args passed by value
STACK 2
OBEY ARGNAMELEN(1) [ get filename len
LDX 3 0(3)
STO 3 STNAMELEN(2)
OBEY ARGMODE(1) [ get I/O mode
LDX 3 0(3)
STO 3 STMODE(2)
OBEY ARGTYPE(1) [ get required type
LDX 3 0(3)
STO 3 STTYPE(2)
# Pick up args passed by name (filename)
OBEY ARGNAME(1) [ get addr of filename buf
ARRAY 3
STACK 2 [ restore SP
STO 3 STNAME(2) [ and save
# Pascal callable entry point
#CUE GPOPEN
BEGIN 2 3,1,STFRAME
# We need a *CI channel to issue commands.
LDXC 0 OURCI [ #LOWER, sad
BCC CHEK
STOZ SXPAR1(3) [ unanticipated
CALL 1 GPOPENCI [ allocate *CI
BNG 6 BYE
STO 6 OURCI
# Check the args a bit
CHEK LDXC 3 STTYPE(2)
BCS INVAL [ must be +ve
LDN 4 MAXTYPE
BXGE 3 4,INVAL [ and less than maxtype
LDXC 1 STMODE(2)
BCS INVAL [ must be +ve
LDN 4 MAXMODE
BXGE 1 4,INVAL [ and less than maxmode
# Decide on which device to use.
LDX 3 '/UPPER' [ get pointer to #UPPER
SLL 1 2 [ X1 = mode * 4
ADX 1 3 [ pointer to mode info
STO 1 STMODE(2)
# Get a unit # in range 2..63
# we avoid *FH0, *FH1 to to avoid conflicts
# with stdin/stdout.
# Would be smarter to look in our table before
# asking George/EXEC
LDX 1 MDDEV(1) [ get preferred device type
LDN 6 2 [ first unit to check
LDN 5 63 [ last one available
FIND ALLOT 6 256(1) [ is device available?
LDXC 4 9 [ word 9 -ve if it is
BCS FOUND
BXGE 6 5, MFILE [ jump if no files available
ADN 6 1 [ try next unit
BRN FIND
FOUND STO 6 STUNIT(2)
# Write "AS *Fx"
LDX 1 STMODE(2) [ get I/O mode info
LDX 4 MDDEV(1) [ get device type
SBN 4 DEVFR [ fr=0, fw=1, fh=2
SLL 4 1 [ * 2,
ADN 4 OASSIGN(3) [ point to AS *Fx
LDN 5 6 [ write 6 chars
CALL 1 WRSTR
# Write unit#
STACK 3
LDX 0 OURCI [ get our *CI channel
STO 0 SXPAR1(3)
LDX 0 STUNIT(2) [ get unit#
STO 0 SXPAR2(3)
STOZ SXPAR3(3) [ zero field length
CALL 1 GPWRITEINT
# Write ","
LDN 5 #34
CALL 1 WRCH
# Write user supplied filename
LDX 4 STNAME(2)
LDX 5 STNAMELEN(2)
CALL 1 WRSTR
LDN 5 #30 [ initial sep is "("
STO 5 STSEP(2) [ save current seperator
# Write the access mode
LDX 3 STMODE(2)
LDN 3 MDQUAL(3)
LDX 4 0(3)
BZE 3 TYPE [ if zero just write type
LDX 4 3
LDN 5 4 [ mode is 4 chars long
CALL 1 WRSEP
# Write the file type, if specified
TYPE LDX 3 '/UPPER'
ADN 3 OTYPE
ADX 3 STTYPE(2)
LDX 4 0(3)
BZE 4 FCMD
LDX 4 3
LDN 5 4 [ type is 4 chars
CALL 1 WRSEP
FCMD LDX 5 STSEP(2) [ get back sep
SBN 5 #30
BZE 5 ISSUE [ do nothing if "("
LDN 5 #31 [ close parens
CALL 1 WRCH
ISSUE STACK 3
LDX 4 OURCI
STO 4 SXPAR1(3)
CALL 1 GPWRITEBUF [ issue command
BNG 6 BYE [ jif open failed
STACK 3
NGN 0 1
STO 0 SXPAR1(3) [ don't care about FD
LDX 0 STUNIT(2) [ unit we want
STO 0 SXPAR2(3)
LDX 1 STMODE(2) [ get mode/device info
LDX 0 MDDEV(1) [ get device type
STO 0 SXPAR3(3)
LDX 0 MDREAD(1) [ get I/O mode
STO 0 SXPAR4(3)
LDX 0 MDWRITE(1) [ get I/O mode
STO 0 SXPAR5(3)
CALL 1 GPFHALLOC
BYE END 2 1,0 [ all done.
MFILE NGN 6 EMFILE [ too many files open
BRN BYE
INVAL NGN 6 EINVAL [ bad args
BRN BYE
# Internal routine to write string preceeded by
# seperator char.
WRSEP STO 4 STSSTR(2)
STO 5 STSLEN(2)
STO 1 STSRET(2)
LDX 5 STSEP(2)
CALL 1 WRCH
LDN 4 #34 [ seperators after 1st
STO 4 STSEP(2) [ are all commas
LDX 4 STSSTR(2)
LDX 5 STSLEN(2)
LDX 1 STSRET(2)
BRN WRSTR
# Internal routine to write one char
WRCH DCH 5 STBUF(2) [ save char to write
LDN 4 STBUF(2) [ get address of buf
LDN 5 1 [ write 1 char
# Internal routine to write string
# Enter with X4 = buff, X5 = len
WRSTR STO 1 STRET(2)
STACK 3
LDX 0 OURCI
STO 0 SXPAR1(3) [ *CI fd
STO 4 SXPAR2(3) [ buff
STOZ SXPAR3(3) [ no offset
STO 5 SXPAR4(3) [ len
CALL 1 GPWRITE6
LDX 1 STRET(2)
EXIT 1 0
#END
#FINISH