C
C	BBC Microcomputer emulation package
C	BBCMOS_FILES - File system functions
C
C	Copyright Peter Coghlan 1998
C
D	Implicit None
D
D	Include 'Bbc_Files.Inc'
D
D	Integer *4 Bbc_Load_File, Status
D
D	Record /BbcFcbDef/ Test_Fcb
D
D	Test_Fcb.Exec = 0
D
D	Status = Bbc_Load_File(Test_Fcb, 'BBCFILE')
D
D	Call Exit(Status)
D
D	End
D
D	Integer *1 Function Y6502_Read_Memory()
D	Y6502_Write_Memory = 0
D	Return
D	End
D	
D	Subroutine Y6502_Write_Memory()
D	Return
D	End
D
C
C	Osfile routines
C
C	Implemented so far:
C
C		A = 0	- Save file. Returns A=1 or VMS error signalled.
C		A = 5   - Get file info. Returns A=0, A=1 or VMS error signalled
C		A = 6   - Delete file. Returns A=0, A=1 or VMS error signalled.
C		A = 255 - Load file. Returns A=1, err 214 or VMS error signalled
C
	Subroutine Bbc_Osfile(A, X, Y)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*4 Bbc_Open_File, Bbc_Load_File, Bbc_Save_File

	Integer	*4 Lib$Delete_File, Sys$Close, Status

	Integer	FilenameAddress

	Integer	*1 A, X, Y

	Integer	*1 Y6502_Read_Memory

	Character *127 Filename

	Record /FourBytes/ Block, Address

	Record /BbcFcbDef/ Osfile_Fcb

	External Rms$_Fnf

C	First find the address of the Osfile control block

	Block.Byte0 = X
	Block.Byte1 = Y
	Block.Byte2 = 0
	Block.Byte3 = 0

C	Next extract all the information provided in the control block.

	Address.Byte0 = Y6502_Read_Memory(Block.All + 0)
	Address.Byte1 = Y6502_Read_Memory(Block.All + 1)
	Address.Byte2 = 0
	Address.Byte3 = 0

	FilenameAddress = Address.All

	Address.Byte0 = Y6502_Read_Memory(Block.All + 2)
	Address.Byte1 = Y6502_Read_Memory(Block.All + 3)
	Address.Byte2 = Y6502_Read_Memory(Block.All + 4)
	Address.Byte3 = Y6502_Read_Memory(Block.All + 5)

	Osfile_Fcb.Load = Address.All

	Address.Byte0 = Y6502_Read_Memory(Block.All + 6)
	Address.Byte1 = Y6502_Read_Memory(Block.All + 7)
	Address.Byte2 = Y6502_Read_Memory(Block.All + 8)
	Address.Byte3 = Y6502_Read_Memory(Block.All + 9)

	Osfile_Fcb.Exec = Address.All

	Address.Byte0 = Y6502_Read_Memory(Block.All + 10)
	Address.Byte1 = Y6502_Read_Memory(Block.All + 11)
	Address.Byte2 = Y6502_Read_Memory(Block.All + 12)
	Address.Byte3 = Y6502_Read_Memory(Block.All + 13)

	Osfile_Fcb.Size = Address.All

	Address.Byte0 = Y6502_Read_Memory(Block.All + 14)
	Address.Byte1 = Y6502_Read_Memory(Block.All + 15)
	Address.Byte2 = Y6502_Read_Memory(Block.All + 16)
	Address.Byte3 = Y6502_Read_Memory(Block.All + 17)

	Osfile_Fcb.Attrs = Address.All

C	In BBC memory, the filename is a raw string terminated by a carriage
C	return. We need to copy this to a regular descriptor defined character
C	string. Also drop any quotes and interpret any | escape sequences.

	Call Bbc_GetString(Filename, FilenameAddress)

	If (A .Eq. 0) Then

C	  Save file.

	  Status = Bbc_Save_File(Osfile_Fcb, Filename)

	  If ((Status .And. 7) .Ne. 1) Then

	    Call Lib$Signal(%Val(Status))

	  Endif

	  A = 1

	Else If (A .Eq. 5) Then

C	  Retrieve file information.

	  Status = Bbc_Open_File(Osfile_Fcb, Filename, Bbc_M_Read)

	  If ((Status .And. 7) .Eq. 1) Then

	    Status = Sys$Close(Osfile_Fcb.Fab)

	    Address.All = Osfile_Fcb.Load

	    Call Y6502_Write_Memory(Block.All + 2, Address.Byte0)
	    Call Y6502_Write_Memory(Block.All + 3, Address.Byte1)
	    Call Y6502_Write_Memory(Block.All + 4, Address.Byte2)
	    Call Y6502_Write_Memory(Block.All + 5, Address.Byte3)

	    Address.All = Osfile_Fcb.Exec

	    Call Y6502_Write_Memory(Block.All + 6, Address.Byte0)
	    Call Y6502_Write_Memory(Block.All + 7, Address.Byte1)
	    Call Y6502_Write_Memory(Block.All + 8, Address.Byte2)
	    Call Y6502_Write_Memory(Block.All + 9, Address.Byte3)

	    Address.All = Osfile_Fcb.Size

	    Call Y6502_Write_Memory(Block.All + 10, Address.Byte0)
	    Call Y6502_Write_Memory(Block.All + 11, Address.Byte1)
	    Call Y6502_Write_Memory(Block.All + 12, Address.Byte2)
	    Call Y6502_Write_Memory(Block.All + 13, Address.Byte3)

	    Address.All = Osfile_Fcb.Attrs

	    Call Y6502_Write_Memory(Block.All + 14, Address.Byte0)
	    Call Y6502_Write_Memory(Block.All + 15, Address.Byte1)
	    Call Y6502_Write_Memory(Block.All + 16, Address.Byte2)
	    Call Y6502_Write_Memory(Block.All + 17, Address.Byte3)

	    A = 1

	  Else If (Status .Eq. %Loc(Rms$_Fnf)) Then

	    A = 0

	  Else

	    Call Lib$Signal(%Val(Status))
	    A = 0

	  Endif

	Else If (A .Eq. 6) Then

C	  Delete file.

	  Status = Lib$Delete_File(Filename, , , , , , , , )

	  If ((Status .And. 7) .Eq. 1) Then

	    A = 1

	  Else If (Status .Eq. %Loc(Rms$_Fnf)) Then

	    A = 0

	  Else

	    Call Lib$Signal(%Val(Status))
	    A = 0

	  Endif

	  Return

	Else If (A .Eq. -1) Then

C	  Load file.

	  Status = Bbc_Load_File(Osfile_Fcb, Filename)

	  If ((Status .And. 7) .Eq. 1) Then

	    A = 1

	  Else If (Status .Eq. %Loc(Rms$_Fnf)) Then

	    Call Brk(214, 'File not found|')

	  Else

	    Call Lib$Signal(%Val(Status))
	    A = 0

	  Endif

	Endif

	Return
	End
C
C	Osfind
C
	Subroutine Bbc_Osfind(A, X, Y)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 A, X, Y

	Call Bbc_Files(Bbc_Find, A, X, Y, )

	Return
	End
C
C	OsBget
C
	Subroutine Bbc_OsBget(A, Y, P)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 A, Y, P

	Call Bbc_Files(Bbc_Bget, A, , Y, P)

	Return
	End
C
C	OsBput
C
	Subroutine Bbc_OsBput(A, Y)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 A, Y

	Call Bbc_Files(Bbc_Bput, A, , Y, )

	Return
	End
C
C	OsArgs
C
	Subroutine Bbc_OsArgs(A, X, Y)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 A, X, Y

	Call Bbc_Files(Bbc_Args, A, X, Y, )

	Return
	End
C
C	OsGbPb
C
	Subroutine Bbc_OsGbPb(A, X, Y, P)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 A, X, Y, P

	Call Bbc_Files(Bbc_GbPb, A, X, Y, P)

	Return
	End
C
C	Check EOF for A=1 call to OSFSC and OSBYTE 127
C
	Subroutine Bbc_Ceof(Channel)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer	*1 Channel

	Call Bbc_Files(Bbc_Eof, , , Channel, )

	Return
	End
C
C	Load a file into BBC memory
C
C	Arguments:
C
C		Bbc_Load_Fcb	File attributes.
C		Filename	Descriptor pointing at name of file to load.
C
C	Returns:
C		Any error from Bbc_Open_File
C		Any error from Sys$Connect, Sys$Read, Sys$Disconnect, Sys$Close
C
	Function Bbc_Load_File(Bbc_Load_Fcb, Filename)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer *4 Sys$Connect, Sys$Disconnect, Sys$Read, Sys$Close

	Integer *4 Bbc_Load_File, Bbc_Open_File

	Integer *4 LoadAddress

	Integer I, J

D	Integer TempCount
D
	Logical UseFilesAddress

	Character *(*) Filename
	Character *512 Bbc_Load_Buffer

	Record /BbcFcbDef/ Bbc_Load_Fcb

C	Save the load address given before we overwrite it with the files one

	LoadAddress = Bbc_Load_Fcb.Load

C	Should we use the load address given with the file or in the block?

	UseFilesAddress = (Bbc_Load_Fcb.Exec .And. 255) .Ne. 0

	Bbc_Load_File = Bbc_Open_File(Bbc_Load_Fcb, Filename, Bbc_M_Read)

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

D	Write (*, *)
D	Write (*, '('' File size         :     '', Z8)') Bbc_Load_Fcb.Size
D	Write (*, '('' Load address      :     '', Z8)') Bbc_Load_Fcb.Load
D	Write (*, '('' Execution address :     '', Z8)') Bbc_Load_Fcb.Exec
D
D	If ((Bbc_Load_Fcb.Flags .And. Bbc_M_Block) .Ne. 0) Then
D
D	  Write (*, *)
D	  Write (*, *) 'Block access available'
D
D	Endif
D
D	If ((Bbc_Load_Fcb.Flags .And. Bbc_M_Acl) .Ne. 0) Then
D
D	  Write (*, *)
D	  Write (*, *) 'BBC file attributes available'
D
D	Endif

C	Connect a record stream to the file.

	Bbc_Load_File = Sys$Connect(Bbc_Load_Fcb.Rab)

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	Bbc_Load_File = Bbc_Load_Fcb.Rab.Rab$L_Sts

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

C	Set up RAB for Sys$Read

	Bbc_Load_Fcb.Rab.Rab$L_Bkt = 0				! Get next block
	Bbc_Load_Fcb.Rab.Rab$L_Rop = 0				! No options
	Bbc_Load_Fcb.Rab.Rab$L_Ubf = Loc(Bbc_Load_Buffer)	! Record buffer
	Bbc_Load_Fcb.Rab.Rab$W_Usz = Len(Bbc_Load_Buffer)	! Buffer length

D	TempCount = 0
D
C	Set the address to start loading at.

	If (UseFilesAddress) LoadAddress = Bbc_Load_Fcb.Load

	Do I = 1, (Bbc_Load_Fcb.Size + Len(Bbc_Load_Buffer) - 1) /
     +							Len(Bbc_Load_Buffer)

	  Bbc_Load_File = Sys$Read(Bbc_Load_Fcb.Rab)

D	  TempCount = TempCount + Bbc_Load_Fcb.Rab.Rab$W_Rsz
D
D	  Write (*, '('' Bytes transferred : '', Z6)') TempCount
D
	  If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	  Bbc_Load_File = Bbc_Load_Fcb.Rab.Rab$L_Sts

	  If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	  Do J = 0, Bbc_Load_Fcb.Rab.Rab$W_Rsz - 1

	    Call Y6502_Write_Memory(LoadAddress + J,
     +			Ichar(Bbc_Load_Buffer(J + 1 : J + 1)))

	  End Do

	  LoadAddress = LoadAddress + Len(Bbc_Load_Buffer)

	End Do

	Bbc_Load_File = Sys$Disconnect(Bbc_Load_Fcb.Rab)

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	Bbc_Load_File = Bbc_Load_Fcb.Rab.Rab$L_Sts

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	Bbc_Load_File = Sys$Close(Bbc_Load_Fcb.Fab)

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	Bbc_Load_File = Bbc_Load_Fcb.Fab.Fab$L_Sts

	If ((Bbc_Load_File .And. 7) .Ne. 1) Return

	Return

	End
C
C	Save a block of BBC memory into a file.
C
C	Arguments:
C
C		Bbc_Save_Fcb	File attributes of file to save.
C		Filename	Descriptor pointing at name to give file.
C
C	Returns:
C		Any error from Bbc_Open_File
C		Any error from Sys$Connect, Sys$Write, Sys$Disconnect, Sys$Close
C
	Function Bbc_Save_File(Bbc_Save_Fcb, Filename)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer *4 Sys$Connect, Sys$Disconnect, Sys$Write, Sys$Close

	Integer *4 Bbc_Save_File, Bbc_Open_File

	Integer *4 Address, StartAddress, EndAddress

	Integer *1 Y6502_Read_Memory

	Integer I, J

D	Integer TempCount
D
	Character *(*) Filename
	Character *512 Bbc_Save_Buffer

	Record /BbcFcbDef/ Bbc_Save_Fcb

C	Create new file and open in write mode.

	Bbc_Save_File = Bbc_Open_File(Bbc_Save_Fcb, Filename,
     +							Bbc_M_New + Bbc_M_Write)

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

C	Connect a record stream to the file.

	Bbc_Save_File = Sys$Connect(Bbc_Save_Fcb.Rab)

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	Bbc_Save_File = Bbc_Save_Fcb.Rab.Rab$L_Sts

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

C	Set up RAB for Sys$Write

	Bbc_Save_Fcb.Rab.Rab$L_Bkt = 0			! Get next block
	Bbc_Save_Fcb.Rab.Rab$L_Rop = 0			! No options
	Bbc_Save_Fcb.Rab.Rab$L_Ubf = 0			! Record buffer
	Bbc_Save_Fcb.Rab.Rab$W_Usz = 0			! Buffer length

	Bbc_Save_Fcb.Rab.Rab$L_Rbf = Loc(Bbc_Save_Buffer)

	StartAddress = Bbc_Save_Fcb.Size
	EndAddress = Bbc_Save_Fcb.Attrs

	Address = StartAddress

D	TempCount = 0
D
	Do I = 1, (EndAddress - StartAddress + Len(Bbc_Save_Buffer) - 1)
     +							/ Len(Bbc_Save_Buffer)

	  If (EndAddress - Address .Lt. Len(Bbc_Save_Buffer)) Then

	    Bbc_Save_Fcb.Rab.Rab$W_Rsz = EndAddress - Address

	  Else

	    Bbc_Save_Fcb.Rab.Rab$W_Rsz = Len(Bbc_Save_Buffer)

	  Endif

	  Do J = 0, Bbc_Save_Fcb.Rab.Rab$W_Rsz - 1

	    Bbc_Save_Buffer(J + 1 : J + 1) =
     +			Char(Y6502_Read_Memory(Address + J))

	  End Do

	  Bbc_Save_File = Sys$Write(Bbc_Save_Fcb.Rab)

D	  TempCount = TempCount + Bbc_Save_Fcb.Rab.Rab$W_Rsz
D
D	  Write (*, '('' Bytes transferred : '', Z6)') TempCount
D
	  If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	  Bbc_Save_File = Bbc_Save_Fcb.Rab.Rab$L_Sts

	  If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	  Address = Address + Len(Bbc_Save_Buffer)

	End Do

	Bbc_Save_File = Sys$Disconnect(Bbc_Save_Fcb.Rab)

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	Bbc_Save_File = Bbc_Save_Fcb.Rab.Rab$L_Sts

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	Bbc_Save_File = Sys$Close(Bbc_Save_Fcb.Fab)

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	Bbc_Save_File = Bbc_Save_Fcb.Fab.Fab$L_Sts

	If ((Bbc_Save_File .And. 7) .Ne. 1) Return

	Return
	End
C
C	Open a file. If the file already exists, extract necessary file
C	attributes including Organisation, Record format, Record size,
C	Application ACL containing BBC Load and Execution addresses, File size.
C	Use the information obtained to figure out how to process the file. If
C	an error occurs other than a purely ACL error, the file is closed
C	before returning. In the event of an ACL error, it may still be
C	possible to do i/o to the file etc if we can assume the file size from
C	its organisation and attributes. If a new file is to be created,
C	attributes suitable for typical BBC files are chosen.
C
C	Arguments:
C		Bbc_Open_Fcb	Structure returning file attributes to caller.
C			.Flags	Bbc_M_Block - Can use block mode to access file.
C				Bbc_M_Acl   - BBC attributes decoded from ACL.
C			.Size	BBC file size (or assumed size if no BBC ACE).
C			.Load	BBC file load address (unaltered if no BBC ACE).
C			.Exec	BBC file execution address (ditto).
C			.Attrs	BBC file attributes implied from RMS attrs.
C			.Fab	RMS FAB workspace used to reference file.
C			.Rab	RMS RAB workspace used to reference file.
C		Filename	Descriptor pointing at name of file to open.
C		Options		Options used when opening the file.
C			Bbc_M_Read  - Allow read access to file (default none).
C			Bbc_M_Write - Allow write access to file (default none).
C			Bbc_M_New   - Create new file (default is open existing)
C
C	Returns:
C		Any error from Sys$Open, Sys$Display, Lib$Get_Vm.
C		Ss$_BadAcl - Dodgy BBC ACL found
C
	Function Bbc_Open_File(Bbc_Open_Fcb, Filename, Options)

	Implicit None

	Include '($Xabdef)'
	Include '($XabFhcdef)'
	Include '($XabProdef)'
	Include '($AceDef)'

	Include 'Bbc_Files.Inc'

	Structure /Xab/

	  Union

	    Map
	      Record /Xabdef/ Xab
	    End Map

	    Map
	      Record /XabFhcdef/ XabFhc
	    End Map

	    Map
	      Record /XabProdef1/ XabPro
	    End Map

	  End Union

	End Structure

	Structure /BbcAceDef/

	  Union

	    Map
	      Record /AceDef/ Application
	    End Map

C	    Can't think of a way to avoid the following hardcoded 8 right now...

	    Map
	      Byte %Fill (8)
	      Integer *4 FileSize
	      Integer *4 LoadAddress
	      Integer *4 ExecAddress
            End Map

          End Union

	End Structure

	Character *(*) Filename

	Integer Options

	Integer *4 Sys$Create, Sys$Open, Sys$Display, Sys$Close
	Integer *4 Lib$Get_Vm, Lib$Free_Vm, Status

	Integer *4 Bbc_Open_File, Bbc_Parse_Ace

D	Integer Org, Mrs, Rfm, Rat, Ebk, Ffb, Lrl
D
	Integer I, Bbc_Ace_Length, Bbc_Acl_Length

	Record /Xab/	Bbc_Open_XabFhc
	Record /Xab/	Bbc_Open_XabPro

	Record /BbcFcbDef/ Bbc_Open_Fcb

	Record /BbcAceDef/ Bbc_Ace

	External Ss$_BadAcl

C	Set up Fab. Initialise all fields suitable for creating a new
C	BBC style file. If it turns out we are opening an existing file,
C	the attributes will be overwritten by the files existing attributes.

C	First tell the FAB its a FAB and initialise the unused fields.

	Bbc_Open_Fcb.Fab.Fab$B_Bln = Fab$C_Bln
	Bbc_Open_Fcb.Fab.Fab$B_Bid = Fab$C_Bid
	Bbc_Open_Fcb.Fab.Fab$B_Acmodes = 0
	Bbc_Open_Fcb.Fab.Fab$W_Deq = 0
	Bbc_Open_Fcb.Fab.Fab$L_Dna = 0
	Bbc_Open_Fcb.Fab.Fab$B_Dns = 0
	Bbc_Open_Fcb.Fab.Fab$B_Fsz = 0
	Bbc_Open_Fcb.Fab.Fab$W_Gbc = 0
	Bbc_Open_Fcb.Fab.Fab$W_Ifi = 0
	Bbc_Open_Fcb.Fab.Fab$L_Nam = 0
	Bbc_Open_Fcb.Fab.Fab$B_Rtv = 0

C	Some attributes common to all operations

	Bbc_Open_Fcb.Fab.Fab$B_Fac = Fab$M_Bro		! Block or record modes
	Bbc_Open_Fcb.Fab.Fab$B_Shr = Fab$M_Upi		! Only option with BRO
	Bbc_Open_Fcb.Fab.Fab$L_Fop = Fab$M_Sqo		! Sequential access only

C	Point at the filename

	Bbc_Open_Fcb.Fab.Fab$L_Fna = Loc(Filename)
	Bbc_Open_Fcb.Fab.Fab$B_Fns = Len(Filename)

C	Point at the File Header Characteristics XAB

	Bbc_Open_Fcb.Fab.Fab$L_Xab = Loc(Bbc_Open_XabFhc)

C	Tell this XAB its an XABFHC

	Bbc_Open_XabFhc.Xab.Xab$B_Bln = Xab$C_FhcLen
	Bbc_Open_XabFhc.Xab.Xab$B_Cod = Xab$C_Fhc

	Bbc_Open_XabFhc.XabFhc.Xab$W_Lrl = 0		! Longest record length

C	Point at the Protection XAB

	Bbc_Open_XabFhc.Xab.Xab$L_Nxt = Loc(Bbc_Open_XabPro)

C	Tell this XAB its an XABPRO

	Bbc_Open_XabPro.Xab.Xab$B_Bln = Xab$C_ProLen
	Bbc_Open_XabPro.Xab.Xab$B_Cod = Xab$C_Pro

C	Indicate that there are no further XABs

	Bbc_Open_XabPro.Xab.Xab$L_Nxt = 0

C	Suitable attributes for new files

	Bbc_Open_Fcb.Fab.Fab$B_Org = Fab$C_Seq		! Sequential file
	Bbc_Open_Fcb.Fab.Fab$B_Rfm = Fab$C_Stm		! Stream record format
	Bbc_Open_Fcb.Fab.Fab$B_Rat = Fab$M_Cr		! Cr carriage control
	Bbc_Open_Fcb.Fab.Fab$W_Mrs = 0			! Maximum record size

C	Now do the operation specific parts

	If ((Options .And. Bbc_M_Read) .Ne. 0) Then

	  Bbc_Open_Fcb.Fab.Fab$B_Fac =
     +		Bbc_Open_Fcb.Fab.Fab$B_Fac .Or. Fab$M_Get

	Endif

	If ((Options .And. Bbc_M_Write) .Ne. 0) Then

	  Bbc_Open_Fcb.Fab.Fab$B_Fac =
     +		Bbc_Open_Fcb.Fab.Fab$B_Fac .Or. Fab$M_Put

	Endif

	If ((Options .And. Bbc_M_New) .Ne. 0) Then

C	  Fill in the BBC file attributes ACE

C	  Bbc_Ace.Application.Ace$B_Size = SizeOf(Bbc_Ace) = 50!
	  Bbc_Ace.Application.Ace$B_Size = 20
	  Bbc_Ace.Application.Ace$B_Type = Ace$C_Application

	  Bbc_Ace.Loadaddress = Bbc_Open_Fcb.Load
	  Bbc_Ace.ExecAddress = Bbc_Open_Fcb.Exec
	  Bbc_Ace.FileSize = Bbc_Open_Fcb.Attrs - Bbc_Open_Fcb.Size

C	  Point at attributes ACE

	  Bbc_Open_XabPro.XabPro.Xab$L_Aclbuf = Loc(Bbc_Ace)
	  Bbc_Open_XabPro.XabPro.Xab$W_Aclsiz = SizeOf(Bbc_Ace)		!?

C	  Specify default protection

	  Bbc_Open_XabPro.XabPro.Xab$W_Pro = -1
	  Bbc_Open_XabPro.XabPro.Xab$L_Uic = 0

C	  Just in case...

	  Bbc_Open_XabPro.XabPro.Xab$B_Mtacc = Ichar(' ')

C	  Attempt the create

	  Bbc_Open_File = Sys$Create(Bbc_Open_Fcb.Fab)

	Else

C	  No ACL buffer until we find the size required later

	  Bbc_Open_XabPro.XabPro.Xab$L_Aclbuf = 0
	  Bbc_Open_XabPro.XabPro.Xab$W_Aclsiz = 0

C	  Attempt the open

	  Bbc_Open_File = Sys$Open(Bbc_Open_Fcb.Fab)

	Endif

C	See if we got a really basic error

	If ((Bbc_Open_File .And. 7) .Ne. 1) Return

C	Or a more substantial one

	Bbc_Open_File = Bbc_Open_Fcb.Fab.Fab$L_Sts

	If ((Bbc_Open_File .And. 7) .Ne. 1) Return

C	Initialise the common bits of a RAB in case we want to connect later.

	Bbc_Open_Fcb.Rab.Rab$B_Bln = Rab$C_Bln
	Bbc_Open_Fcb.Rab.Rab$B_Bid = Rab$C_Bid
	Bbc_Open_Fcb.Rab.Rab$W_Isi = 0
	Bbc_Open_Fcb.Rab.Rab$B_Krf = 0
	Bbc_Open_Fcb.Rab.Rab$B_Mbc = 0
	Bbc_Open_Fcb.Rab.Rab$B_Mbf = 0

C	Only block operations required

	Bbc_Open_Fcb.Rab.Rab$L_Rop = Rab$M_Bio

C	Tell it which FAB we're talking about

	Bbc_Open_Fcb.Rab.Rab$L_Fab = Loc(Bbc_Open_Fcb.Fab)

	If ((Options .And. Bbc_M_New) .Eq. 0) Then

C	  If we sucessfully opened an existing file, go on to check for an ACL
C	  containing a BBC file attributes ACE.
C
C	  First, See if we can make assumptions about the file size and do 
C	  block i/o. We can do this if the file organisation is sequential
C	  and the record format is anything other than variable.

	  Bbc_Open_Fcb.Flags = 0

	  If (Bbc_Open_Fcb.Fab.Fab$B_Org .Eq. Fab$C_Seq		.And.
     +	       (Bbc_Open_Fcb.Fab.Fab$B_Rfm .Eq. Fab$C_Udf	.Or.
     +		Bbc_Open_Fcb.Fab.Fab$B_Rfm .Eq. Fab$C_Fix	.Or.
     +		Bbc_Open_Fcb.Fab.Fab$B_Rfm .Eq. Fab$C_StmLf	.Or.
     +		Bbc_Open_Fcb.Fab.Fab$B_Rfm .Eq. Fab$C_StmCr	.Or.
     +		Bbc_Open_Fcb.Fab.Fab$B_Rfm .Eq. Fab$C_Stm))	Then

	    Bbc_Open_Fcb.Flags = Bbc_Open_Fcb.Flags .Or. Bbc_M_Block

	    Bbc_Open_Fcb.Size = (Bbc_Open_XabFhc.XabFhc.Xab$L_Ebk - 1) * 512 +
     +				Bbc_Open_XabFhc.XabFhc.Xab$W_Ffb

	  Endif

D	  Org = Bbc_Open_Fcb.Fab.Fab$B_Org
D	  Rfm = Bbc_Open_Fcb.Fab.Fab$B_Rfm
D	  Rat = Bbc_Open_Fcb.Fab.Fab$B_Rat
D	  Mrs = Bbc_Open_Fcb.Fab.Fab$W_Mrs
D	  Ebk = Bbc_Open_XabFhc.XabFhc.Xab$L_Ebk
D	  Ffb = Bbc_Open_XabFhc.XabFhc.Xab$W_Ffb
D	  Lrl = Bbc_Open_XabFhc.XabFhc.Xab$W_Lrl
D
D	  If (Org .Eq. Fab$C_Seq)  Write (*, *) 'File Organisation : Sequential'
D	  If (Org .Eq. Fab$C_Rel)  Write (*, *) 'File Organisation : Relative'
D	  If (Org .Eq. Fab$C_Idx)  Write (*, *) 'File Organisation : Indexed'
D
D	  Write (*, *)
D
D	  If (Rfm .Eq. Fab$C_Udf)   Write (*, *) 'Record Format     : Undefined'
D	  If (Rfm .Eq. Fab$C_Fix)   Write (*, *) 'Record Format     : Fixed'
D	  If (Rfm .Eq. Fab$C_Var)   Write (*, *) 'Record Format     : Variable'
D	  If (Rfm .Eq. Fab$C_Vfc)   Write (*, *) 'Record Format     : Vfc'
D	  If (Rfm .Eq. Fab$C_Stm)   Write (*, *) 'Record Format     : Stream'
D	  If (Rfm .Eq. Fab$C_StmLf) Write (*, *) 'Record Format     : StreamLf'
D	  If (Rfm .Eq. Fab$C_StmCr) Write (*, *) 'Record Format     : StreamCr'
D
D	  Write (*, *)
D
D	  If ((Rat .And. Fab$M_Ftn) .Ne. 0) Write (*, *)
D    +		'Record Attributes : Fortran carriage control'
D	  If ((Rat .And. Fab$M_Cr) .Ne. 0)  Write (*, *)
D    +		'Record Attributes : Carriage return carriage control'
D	  If ((Rat .And. Fab$M_Prn) .Ne. 0) Write (*, *)
D    +		'Record Attributes : Print file carriage control'
D	  If ((Rat .And. Fab$M_Blk) .Ne. 0) Write (*, *)
D    +		'Record Attributes : Non block-spanned'
D
D	  Write (*, *)
D
D	  Write (*, *) 'Max Record Size   : ', Mrs
D	  Write (*, *) 'Eof Block         : ', Ebk
D	  Write (*, *) 'First Free Byte   : ', Ffb
D	  Write (*, *) 'Longest Record    : ', Lrl
D
C	  Extend the ACL length to a longword for Lib$Get_Vm

	  Bbc_Acl_Length = Bbc_Open_XabPro.XabPro.Xab$W_AclLen

C	  See if there actually is an ACL

	  If (Bbc_Acl_Length .Ne. 0) Then

C	    Ensure there was no error processing the ACL

	    Bbc_Open_File = Bbc_Open_XabPro.XabPro.Xab$L_AclSts

	    If ((Bbc_Open_File .And. 7) .Ne. 1) Return

C	    Allocate enough memory to receive the ACL

	    Bbc_Open_File = Lib$Get_Vm(Bbc_Acl_Length,
     +					Bbc_Open_XabPro.XabPro.Xab$L_AclBuf, )

	    If ((Bbc_Open_File .And. 7) .Ne. 1) Return

C	    Tell RMS we want the whole ACL

	    Bbc_Open_XabPro.XabPro.Xab$W_AclSiz = Bbc_Acl_Length

C	    Initialise the ACL context - just in case

	    Bbc_Open_XabPro.XabPro.Xab$L_AclCtx = 0

C	    Get the ACL

	    Bbc_Open_File = Sys$Display(Bbc_Open_Fcb.Fab)

C	    Hope we didn't get an error this time

	    If ((Bbc_Open_File .And. 7) .Ne. 1) Then

	      Status = Sys$Close(Bbc_Open_Fcb.Fab)

	      Return

	    Endif

C	    Make sure...

	    Bbc_Open_File = Bbc_Open_Fcb.Fab.Fab$L_Sts

	    If ((Bbc_Open_File .And. 7) .Ne. 1) Then

	      Status = Sys$Close(Bbc_Open_Fcb.Fab)

	      Return

	    Endif

C	    Make really sure...

	    Bbc_Open_File = Bbc_Open_XabPro.XabPro.Xab$L_AclSts

C	    If there is only an ACL error, don't close the
C	    file - i/o might still work

	    If ((Bbc_Open_File .And. 7) .Ne. 1) Return

C	    Go rummaging for our ACE

	    I = 0

	    Status = .False.

	    Do While (.Not. Status .And. I .Lt. Bbc_Acl_Length)

	      Status = Bbc_Parse_Ace(
     +		Bbc_Ace_Length, Bbc_Open_Fcb.Size,
     +		Bbc_Open_Fcb.Load, Bbc_Open_Fcb.Exec,
     +		%Val(Bbc_Open_XabPro.XabPro.Xab$L_AclBuf + I))

C	      Ensure we don't end up in an infinite loop in the remote event
C	      of an internal RMS problem not resulting in an error return.

	      If (Bbc_Ace_Length .Eq. 0) Then

	        Bbc_Open_File = %Loc(Ss$_BadAcl)
	        Return

	      Endif

	      If (Status) Bbc_Open_Fcb.Flags =
     +			Bbc_Open_Fcb.Flags .Or. Bbc_M_Acl

	      I = I + Bbc_Ace_Length

	    End Do

	    Status = Lib$Free_Vm(Bbc_Acl_Length,
     +					Bbc_Open_XabPro.XabPro.Xab$L_AclBuf, )

	  Endif

	Endif

	Return
	End
C
C	Bbc_Files - perform various random access file functions.
C
	Subroutine Bbc_Files(Function, A, X, Y, P)

	Implicit None

	Integer Function

	Integer	*1 A, X, Y, P

	Include 'Bbc_Files.Inc'

	Integer Bbc_Open_File, Sys$Connect, Sys$Read, Sys$Disconnect, Sys$Close

	Integer I, Flags, Status, Block, Offset

	Record /FourBytes/ Temp

	Character *127 Filename

	Integer	*1 Y6502_Read_Memory

	Record /BbcFcbDef/ Fcb(Max_Files)

	Record /RaFileDef/ File(Max_Files)

	Record /TwoBytes/ FilenameAddress

	External Rms$_Fnf
C
C	Check for valid channel in Y with the following exceptions:
C	  - Opening a file
C	  - Closing all files
C	  - Calling OSARGS with Y = 0
C	(The channel is actually in X for checking EOF - sleight of hand)
C
	If (((Function .Ne. Bbc_Find) .Or.
     +		(((A .And. -64) .Eq. 0) .And. (Y .Ne. 0))) .And.
     +		(((Function .Ne. Bbc_Args) .Or. (Y .Ne. 0)))) Then

	  Status = .True.

	  If ((Y .Eq. 0) .Or. (Y .Gt. Max_Files)) Then

	    Status = .False.

	  Else If ((File(Y).Flags .And. Bbc_M_Inuse) .Eq. 0) Then

	    Status = .False.

	  Endif

	  If (.Not. Status) Then

	    Call Brk(222, 'Channel|')
	    Return

	  Endif

	Endif

C	See what we have to do

	If (Function .Eq. Bbc_Find) Then

	  If ((A .And. -64) .Eq. 0) Then		! Close function

	    If (Y .Eq. 0) Then				! Close all files

	      Do I = 1, Max_Files

	        If ((File(I).Flags .And. Bbc_M_InUse) .Ne. 0) Then
C
C	          Check if we need to write out segment first...
C
	          Call Bbc_Media_Update(File(I), Fcb(I))
C
C	          Disconnect and close
C
	          Status = Sys$Disconnect(Fcb(I).Rab)
	          Status = Sys$Close(Fcb(I).Fab)
C
C	          Clear in-use and other flags
C
	          File(I).Flags = 0

	        Endif

	      End Do

	    Else					! Close one file
C
C	      Check if we need to write out segment first.
C
	      Call Bbc_Media_Update(File(Y), Fcb(Y))
C
C	      Disconnect and close
C
	      Status = Sys$Disconnect(Fcb(Y).Rab)
	      Status = Sys$Close(Fcb(Y).Fab)
C
C	      Clear in-use and other flags
C
	      File(Y).Flags = 0

	    Endif

	  Else					! Open functions

	    Flags = Bbc_M_Read

C	    If ((A .And. 64) .Ne. 0) Flags = Flags .Or. Bbc_M_Read
	    If ((A .And. -128) .Ne. 0) Flags = Flags .Or. Bbc_M_Write
	    If ((A .And. -64) .Eq. -128) Flags = Flags .Or. Bbc_M_New
C
C	    Find a free channel.
C
	    A = 0

	    Do I = 1, Max_Files

	      If ((File(I).Flags .And. Bbc_M_InUse) .Eq. 0) A = I

	    End Do

	    If (A .Eq. 0) Then

	      Call Brk(192, 'Too many files open|')
	      Return

	    Endif

	    FilenameAddress.Byte0 = X
	    FIlenameAddress.Byte1 = Y

	    Call Bbc_Getstring(Filename, FileNameAddress)

	    Status = Bbc_Open_File(Fcb(A), Filename, Flags)

	    If ((Status .And. 7) .Ne. 1) Then

	      A = 0

	    Else

	      File(A).Flags = Bbc_M_InUse .Or. Flags
C
C	      Set fixed parts of RAB
C
	      Fcb(A).Rab.Rab$L_Rop = 0				! No options

	      Fcb(A).Rab.Rab$L_Ubf = Loc(File(A).Buffer)	! Read buffer
	      Fcb(A).Rab.Rab$W_Usz = Len(File(A).Buffer)	! Buffer length

	      Fcb(A).Rab.Rab$L_Rbf = Loc(File(A).Buffer)	! Write buffer
	      Fcb(A).Rab.Rab$W_Rsz = Len(File(A).Buffer)	! Buffer length

C	      Connect a record stream to the file.

	      Status = Sys$Connect(Fcb(A).Rab)

	      If ((Status .And. 7) .Ne. 1) Call Lib$Signal(%Val(Status))

	      Status = Fcb(A).Rab.Rab$L_Sts

	      If ((Status .And. 7) .Ne. 1) Call Lib$Signal(%Val(Status))

	      File(A).Ptr = 0

	    Endif

	  Endif

	Else If (Function .Eq. Bbc_Bget) Then

	  If ((File(Y).Flags .And. Bbc_M_Read) .Eq. 0) Then

	    Call Brk(195, 'Read not allowed|')
	    Return

	  Endif
C
C	  Check if we are past EOF or have already signalled EOF by
C	  returning from OSBGET with carry set. If so, this is an
C	  error condition. Not sure if PTR will have been allowed
C	  to be set higher than EXT if file is opened only for read.
C
	  If ((File(Y).Ptr .Gt. Fcb(Y).Size) .Or.
     +	     ((File(Y).Ptr .Eq. Fcb(Y).Size) .And.
     +	     ((File(Y).Flags .And. Bbc_M_Eof) .Ne. 0))) Then

	    Call Brk(223, 'EOF|')
	    Return

	  Endif
C
C	  Check if we are at EOF but have not yet signalled it.
C
	  If (File(Y).Ptr .Eq. Fcb(Y).Size) Then

	    File(Y).Flags = File(Y).Flags .Or. Bbc_M_Eof
	    A = 254
	    P = P .Or. 1
	    Return

	  Else

	    P = P .And. .Not. 1

	  Endif
C
C	  Check if the byte we want is in the buffer or needs to be read in.
C
	  Offset = File(Y).Ptr .And. 511
	  Block  = File(Y).Ptr .And. -512

	  If ((Block .Ne. File(Y).Block) .Or.
     +		((File(Y).Flags .And. Bbc_M_InMem) .Eq. 0)) Then
C
C	    If we have to read a new segment, see if we need to write
C	    the segment out to disk first.
C
	    Call Bbc_Media_Update(File(Y), Fcb(Y))
C
C	    Read in the file segment required.
C
	    Fcb(Y).Rab.Rab$L_Bkt = (Block / 512) + 1

	    Status = Sys$Read(Fcb(Y).Rab)

	    If (.Not. Status) Call Lib$Signal(%Val(Status))

	    If (.Not. Fcb(Y).Rab.Rab$L_Sts) 
     +			Call Lib$Signal(%Val(Fcb(Y).Rab.Rab$L_Sts))

	    File(Y).Block = Block

	    File(Y).Flags = File(Y).Flags .Or. Bbc_M_InMem

	  Endif

	  Temp.All = IChar(File(Y).Buffer(Offset + 1 : Offset + 1))
	  A = Temp.Byte0
C
C	  Increment the file pointer
C
	  File(Y).Ptr = File(Y).Ptr + 1
C
C	  Note that we no longer have the correct segment loaded
C	  if we stray past the end of the segment.
C
	  If ((File(Y).Ptr .And. 511) .Eq. 0) 
     +	    File(Y).Flags = File(Y).Flags .And. .Not. Bbc_M_InMem

	Else If (Function .Eq. Bbc_Bput) Then

	  If ((File(Y).Flags .And. Bbc_M_Write) .Eq. 0) Then

	    Call Brk(193, 'Write not allowed|')
	    Return

	  Endif
C
C	  Check if we are past EOF. Come back to this later.
C
	  If (File(Y).Ptr .Ge. Fcb(Y).Size) Then

	    Call Brk(223, 'EOF|')
	    Return

	  Endif
C
C	  Check if the segment we want to update is in the buffer or needs to be
C	  read in.
C
	  Offset = File(Y).Ptr .And. 511
	  Block  = File(Y).Ptr .And. -512

	  If ((Block .Ne. File(Y).Block) .Or.
     +		((File(Y).Flags .And. Bbc_M_InMem) .Eq. 0)) Then
C
C	    If we have to read a new segment, see if we need to write
C	    the segment out to disk first.
C
	    Call Bbc_Media_Update(File(Y), Fcb(Y))
C
C	    Read in the file segment required.
C
	    Fcb(Y).Rab.Rab$L_Bkt = (Block / 512) + 1

	    Status = Sys$Read(Fcb(Y).Rab)

	    If (.Not. Status) Call Lib$Signal(%Val(Status))

	    If (.Not. Fcb(Y).Rab.Rab$L_Sts) 
     +			Call Lib$Signal(%Val(Fcb(Y).Rab.Rab$L_Sts))

	    File(Y).Block = Block

	    File(Y).Flags = File(Y).Flags .Or. Bbc_M_InMem

	  Endif
C
C	  Update our byte
C
	  File(Y).Buffer(Offset + 1 : Offset + 1) = Char(A)
C
C	  Mark the buffer as modified
C
	  File(Y).Flags = File(Y).Flags .Or. Bbc_M_Mod
C
C	  Increment the file pointer
C
	  File(Y).Ptr = File(Y).Ptr + 1
C
C	  Note that we no longer have the correct segment loaded
C	  if we stray past the end of the segment.
C
	  If ((File(Y).Ptr .And. 511) .Eq. 0) 
     +	    File(Y).Flags = File(Y).Flags .And. .Not. Bbc_M_InMem

	Else If (Function .Eq. Bbc_Args) Then

	  If (Y .Eq. 0) Then

	    If (A .Eq. 0) Then

	      A = 4

	    Else If (A. Eq. 1) Then

	    Else If (A. Eq. -1) Then

	      Do I = 1, Max_Files

	        Call Bbc_Media_Update(File(I), Fcb(I))

	      End Do

	    Endif

	  Else

	    If (A .Eq. 0) Then

	      Temp.All = File(Y).Ptr

	      Call Y6502_Write_Memory((X + 0) .And. 255, Temp.Byte0)
	      Call Y6502_Write_Memory((X + 1) .And. 255, Temp.Byte1)
	      Call Y6502_Write_Memory((X + 2) .And. 255, Temp.Byte2)
	      Call Y6502_Write_Memory((X + 3) .And. 255, Temp.Byte3)

	    Else If (A .Eq. 1) Then

	      Temp.Byte0 = Y6502_Read_Memory((X + 0) .And. 255)
	      Temp.Byte1 = Y6502_Read_Memory((X + 1) .And. 255)
	      Temp.Byte2 = Y6502_Read_Memory((X + 2) .And. 255)
	      Temp.Byte3 = Y6502_Read_Memory((X + 3) .And. 255)

	      File(Y).Ptr = Temp.All

	      If ((File(Y).Ptr .And. -512) .Ne. File(Y).Block)
     +		File(Y).Flags = File(Y).Flags .And. .Not. Bbc_M_InMem

	    Else If (A .Eq. 2) Then

	      Temp.All = Fcb(Y).Size

	      Call Y6502_Write_Memory((X + 0) .And. 255, Temp.Byte0)
	      Call Y6502_Write_Memory((X + 1) .And. 255, Temp.Byte1)
	      Call Y6502_Write_Memory((X + 2) .And. 255, Temp.Byte2)
	      Call Y6502_Write_Memory((X + 3) .And. 255, Temp.Byte3)

	    Else If (A .Eq. -1) Then

	      Call Bbc_Media_Update(File(Y), Fcb(Y))

	    Endif

	  Endif

	Else If (Function .Eq. Bbc_Eof) Then

	  If (File(Y).Ptr .Ge. Fcb(Y).Size) Then

	    Y = 255

	  Else

	    Y = 0

	  Endif

	Endif

	Return
	End
C
C	Ensure buffer is written out to disk when:
C
C	    - reading in another segment and previous segment was modified
C	    - closing a file
C	    - when explicitly requested by a call to OSARGS with A = &FF
C
	Subroutine Bbc_Media_Update(File, Fcb)

	Implicit None

	Include 'Bbc_Files.Inc'

	Integer Status, Sys$Write

	Record /RaFileDef/ File

	Record /BbcFcbDef/ Fcb
C
C	Check if the file requires to be updated
C
	If ((File.Flags .And. Bbc_M_Mod) .Ne. 0) Then

	  Fcb.Rab.Rab$L_Bkt = (File.Block / 512) + 1

	  Status = Sys$Write(Fcb.Rab)

	  If (.Not. Status) Call Lib$Signal(%Val(Status))

	  If (.Not. Fcb.Rab.Rab$L_Sts) 
     +		Call Lib$Signal(%Val(Fcb.Rab.Rab$L_Sts))
C
C	  Mark the file as no longer requiring update
C
	  File.Flags = File.Flags .And. .Not. Bbc_M_Mod

	Endif

	Return
	End
C
C	Check an ACE to see if it is a BBC file attributes ACE. If so, decode it
C	Return the length of the ACE in any case so that it we know where the
C	next one starts.
C
C	Arguments:
C		Length		Length of this ACE returned to caller.
C		FileSize	BBC filesize returned to caller.
C		LoadAddress	BBC load address returned to caller.
C		ExecAddress	BBC execution address returned to caller.
C		Ace		The ACE to be parsed.
C
C	Returns:
C		.True.		BBC ACE successfully found and parsed.
C		.False.		This ACE is not a BBC ACE.
C
	Function Bbc_Parse_Ace(Length, FileSize, LoadAddress, ExecAddress, Ace)

	Implicit None

	Include '($AceDef)'

	Integer *4 Bbc_Parse_Ace

	Integer *4 FileSize, LoadAddress, ExecAddress

	Integer Length

	Structure /BbcAceDef/

	  Union

	    Map
	      Record /AceDef/ Application
	    End Map

C	    Can't think of a way to avoid the following hardcoded 8 right now...

	    Map
	      Byte %Fill (8)
	      Integer *4 FileSize
	      Integer *4 LoadAddress
	      Integer *4 ExecAddress
            End Map

          End Union

	End Structure

	Record /BbcAceDef/ Ace

	Bbc_Parse_Ace = .False.

	Length = Ace.Application.Ace$B_Size

	If (Ace.Application.Ace$B_Size .Eq. 0) Return

	If ((Ace.Application.Ace$B_Size .Eq. 20) .And.
     +		(Ace.Application.Ace$B_Type .Eq. Ace$C_Application)) Then

	  Bbc_Parse_Ace = .True.

	  FileSize    = Ace.FileSize
	  LoadAddress = Ace.Loadaddress
	  ExecAddress = Ace.ExecAddress

	Endif

	Return
	End
C
C	Perform GSINIT/GSREAD type processing on a string
C
	Subroutine Bbc_GetString(String, Address)

	Implicit None

	Character *(*) String
	Integer Address

	Integer Counter

	Integer	*1 Character

	Integer	*1 Y6502_Read_Memory

	Logical StartOfString, EndOfString
	Logical DoubleQuoted, BarQuoted, PlingQuoted

	StartOfString = .False.

	Counter = 0

	Do While (.Not. StartOfString .And. Counter .Lt. 256)

	  Character = Y6502_Read_Memory(Address)

	  If (Character .Eq. Ichar(' ')) Then

	    Address = Address + 1
	    Counter = Counter + 1

	  Else

	    StartOfString = .True.

          Endif

	End Do

	String = ' '

	If (Character .Eq. 13) Return

	EndOfString = .False.

	If (Character .Eq. Ichar('"')) Then

	  DoubleQuoted = .True.
	  Address = Address + 1

	Else

	  DoubleQuoted = .False.	

	Endif

	Counter = 0

	BarQuoted = .False.
	PlingQuoted = .False.

	Do While (.Not. EndOfString .And. Counter .Lt. Len(String))

	  Character = Y6502_Read_Memory(Address)

	  If (Character .Eq. Ichar('|') .And. .Not. BarQuoted) Then

	    BarQuoted = .True.

	  Else If (Character .Eq. Ichar('!') .And. BarQuoted) Then

	    PlingQuoted = .True.
	    BarQuoted = .False.

	  Else If (Character .Eq. 13 .Or. (Character .Eq. Ichar('"') .And.
     +		DoubleQuoted .And. .Not. (BarQuoted .Or. PlingQuoted)) .Or.
     +		(Character .Eq. Ichar(' ') .And. .Not. DoubleQuoted)) Then

	    EndOfString = .True.
	    If (Character .Ne. 13) Address = Address + 1

	  Else

	    If (BarQuoted) Then

	      If (Character .Eq. Ichar('?')) Then

	        Character = 127

	      Else If (Character .Ne. Ichar('|')) Then

	        If (Character .Ge. 64) Character = Character - 64

	      Endif

	      BarQuoted = .False.

	    Endif

	    If (PlingQuoted) Then

	      If (Character .Lt. 128) Character = Character + 128
	      PlingQuoted = .False.

	    Endif

	    String(Counter + 1 : Counter + 1) = Char(Character)
	    Address = Address + 1
	    Counter = Counter + 1

	  Endif

	End Do

	Return
	End