NB. mapped files
NB. built from project: ~Source\api\mapped\mapped
NB. jmf init
NB.
NB. HANDLEs in dll calls are treated as cd type x rather than *

script_z_ '~system\main\dll.ijs'
script_z_ '~system\main\libpath.ijs'

coclass 'jmf'


jsystemdefs 'hostdefs'

coinsert 'jdefs'

NB. =========================================================
NB. conditional definitions
3 : 0''
if. IFUNIX do.
  lib=. find_dll 'c'
  lib=. lib, (>: (<UNAME) e. ;:'SunOS NetBSD') {. ' _'
  api=. 1 : ('(''',lib,''',x.) & cd')
  c_isatty=: ' isatty i i' api
  c_open=: 'open i *c i i' api
  c_close=: 'close i i' api
  c_read=: 'read i i * i' api
  c_write=: 'write i i * i' api
  if. UNAME -: 'Darwin' do.
    c_lseek=: (0 1 3 4&{)@:('lseek i i i i i' api)@:(0&{ , (<0)"_ , 1&{ , 2&{)
    c_mmap=: }:@:('mmap * * i i i i i i' api)@:(}: , (<0)"_ , {:)
  else.
    c_lseek=: 'lseek i i i i' api
    c_mmap=: 'mmap * * i i i i i' api
  end.
  c_munmap=: 'munmap i * i' api
else.
  CREATE_ALWAYS=: 2
  CREATE_NEW=: 1
  FALSE=: 0
  FILE_BEGIN=: 0
  FILE_END=: 2
  FILE_MAP_READ=: 4
  FILE_MAP_WRITE=: 2
  FILE_SHARE_READ=: 1
  FILE_SHARE_WRITE=: 2
  GENERIC_READ=: _2147483648
  GENERIC_WRITE=: 1073741824
  OPEN_ALWAYS=: 4
  OPEN_EXISTING=: 3
  PAGE_READONLY=: 2
  PAGE_READWRITE=: 4
  TRUNCATE_EXISTING=: 5
  
  j=. (GENERIC_READ+GENERIC_WRITE),PAGE_READWRITE,FILE_MAP_WRITE
  RW=: j,:GENERIC_READ,PAGE_READONLY,FILE_MAP_READ
  
  CloseHandleR=: >@{.@('kernel32 CloseHandle i x'&(15!:0))
  CreateFileMappingR=: >@{.@('kernel32 CreateFileMappingA x x * i i i *c'&(15!:0))
  CreateFileR=: >@{.@('kernel32 CreateFileA x *c i i * i i x'&(15!:0))
  FlushViewOfFileR=: >@{.@('kernel32 FlushViewOfFile i * x'&(15!:0))
  GetFileSizeR=: >@{.@('kernel32 GetFileSize i x *i'&(15!:0))
  MapViewOfFileR=: >@{.@('kernel32 MapViewOfFile * x i i i x'&(15!:0))
  OpenFileMappingR=: >@{.@('kernel32 OpenFileMappingA x i i *c'&(15!:0))
  SetEndOfFile=: >@{.@('kernel32 SetEndOfFile i x'&(15!:0))
  SetFilePointerR=: >@{.@('kernel32 SetFilePointer i x i *i i'&(15!:0))
  UnmapViewOfFileR=: >@{.@('kernel32 UnmapViewOfFile i *'&(15!:0))
  WriteFile=: 'kernel32 WriteFile i x * i *i *'&(15!:0)
end.

if. _1 = 4!:0<'mappings' do.
  mappings=: i.0 8
end.
empty''
)

NB. jmf util

symget=: 15!:6 NB. get address of locale entry for name
symset=: 15!:7 NB. set name to address header
allochdr=: 15!:8 NB. allocate header
freehdr=: 15!:9 NB. free header

NB. =========================================================
msize=: 3 : 'memr y.,HADM,1,JINT'
refcount=: 3 : 'memr y.,HADC,1,JINT'


NB. =========================================================
NB. findkey
NB. Syntax: {row}=. {search string} FindKey {n x m table where column 0 = key}
NB.   - Returns a vector of row numbers whose column 0 value matches the search string
NB. Example:
NB.   Table=.('One';'Two';'Three';'Four'),.('uno';'dos';'tres';'quatro'),.('un';'deux';'trois';'quatre')
NB.   'Four' findkey Table					NB. Returns row 3
findkey=: 4 : 'I. (<x.) = {."1 y.'

NB. =========================================================
free=: 3 : 0
'fh mh fad'=. y.
if. IFUNIX do.
  if. fad do. c_munmap (<fad);mh end.
  if. fh~:_1 do. c_close fh end.
else.
  if. fad do. UnmapViewOfFileR <<fad end.
  if. mh do. CloseHandleR mh end.
  if. fh~:_1 do. CloseHandleR fh end.
end.
)

NB. =========================================================
fullname=: 3 : 0
y=. y.-.' '
y,('_'~:{:y)#'_base_'
)

NB. =========================================================
mbxcheck=: 3 : 0
x=. 15!:12 y.                 NB. 3 col integer matrix
b=. 0={:"1 x                  NB. selects code 0
'a s c'=. |: (-.b)#x          NB. address (sorted), size, code
'u n z'=. ,b#x                NB. address 0, length, junk
z=. *./ c e. 1 2              NB. code must be 1 or 2
z=. z, (-:<.) 2^.s            NB. sizes are powers of 2
z=. z, (}.a)-:}:a+s           NB. blocks are contiguous
z=. z, u = {.a                NB. first block begins at address 0
z=. z, ({:a+s) <: u+n         NB. last block is within bounds
z=. z, (-: <.) 64 %~ +/s      NB. total block sizes is multiple of 64
z=. z, (+/s) = <.&.(%&64) n   NB. total block sizes matches rounded total size
z=. z, *./ 0 = 8|a            NB. addresses are doubleword aligned
)

NB. =========================================================
NB. set shape of mapped noun
settypeshape=: 3 : 0
'name type shape'=: y.
rank=. #shape
sad=. symget <fullname name
'bad name' assert sad
had=. 1{s=. memr sad,0 4,JINT
'flag msize'=. memr had,HADFLAG,2,JINT
'not mapped and writeable' assert 2=flag
size=. (JTYPES i.type){JSIZES
ts=. size**/shape
'msize too small' assert ts<:msize
type memw had,HADT,1,JINT
((*/shape),rank,shape) memw had,HADN,(2+rank),JINT
i.0 0
)

NB. =========================================================
NB. 1 if jmf header is: big enough, offset=HS, msize=ts-HS, valid JTYPE
validate=: 3 : 0
'ts had'=. y.
if. ts>:HS do.
  d=. memr had,0 4,JINT
  *./((HS,ts-HS)=0 2{d),1 2 4 8 16 32 e.~ 3{d
else. 0 end.
)


NB. jmf api

SZI=: IF64{4 8     NB. sizeof integer - 4 for 32 bit and 8 for 64 bit
NB. J array header byte offsets
NB. offset flag msize type refcnt elementcnt rank shap
'HADK HADFLAG HADM HADT HADC HADN HADR HADS'=: SZI*i.8

HS=: SZI*7+64      NB. header size
AFRO=: 1           NB. header flag - readonly
AFNJA=: 2          NB. header flag - non-J allocation
NULLPTR=: <0


NB. jmf - main definitions
NB.
NB.  additem
NB.  createjmf
NB.  map
NB.  share
NB.  showle
NB.  unmap
NB.  unmapall

NB. =========================================================
NB.*additem v add item to mapped noun
additem=: 3 : 0
sad=. symget <fullname y.
'bad name' assert sad
had=. 1{s=. memr sad,0 4,JINT
'flag msize type rank'=. 1 2 3 6{memr had,0 28,JINT
'not mapped and writeable' assert 2=flag
'scalar' assert 0~:rank
'not supported for boxed data' assert 32~:type
shape=. memr had,HADS,rank,JINT
shape=. shape+1,0#~rank-1
size=. (JTYPES i.type){JSIZES
ts=. size**/shape
'msize too small' assert ts<:msize
((*/shape),rank,shape) memw had,HADN,(2+rank),JINT
i.0 0
)

NB. =========================================================
NB.*createjmf v create mapped file
NB. createjmf fn;msize
createjmf=: 3 : 0
'fn msize'=. y.
ts=: HS+msize     NB. total file size
if. IFUNIX do.
  fh=. 0 pick c_open fn; (OR/ O_RDWR, O_CREAT, O_TRUNC); 8b666
  c_lseek fh;(<:ts);SEEK_SET
  c_write fh; (,0{a.); 0+1   NB. place a single byte at the end
  c_lseek fh;0 ;SEEK_SET
  d=. HS,AFNJA,msize,JINT,0,0,1,0 NB. integer empty list
  c_write fh;d;(SZI*#d)
  c_close fh
else.
  fh=. CreateFileR fn;(GENERIC_READ+GENERIC_WRITE);0;NULLPTR;CREATE_ALWAYS;0;0
  SetFilePointerR fh;ts;NULLPTR;FILE_BEGIN
  SetEndOfFile fh
  SetFilePointerR fh;0;NULLPTR;FILE_BEGIN
  d=. HS,AFNJA,msize,JINT,0,0,1,0 NB. integer empty list
  WriteFile_jmf_ fh;d;(SZI*#d);(,0);<NULLPTR_jmf_
  CloseHandleR fh
end.
i.0 0
)

NB. =========================================================
NB.*map v map a file
NB. [type [,trailing_shape]] map name;filename [;sharename;ro]
map=: 3 : 0
0 map y.
:
if. 0=L.x. do. x=. <&> x. else. x=. x. end.
'type tshape hsize'=. 3 {. x, a:

'trailing shape may not be zero' assert -. 0 e. tshape

'name fn sn ro'=. 4{.y.,(#y.)}.'';'';'';0
sn=. '/' (('\'=sn)#i.#sn)} sn NB. / not allowed in win sharename
name=. fullname name
c=. #mappings

'name already mapped'assert c=({."1 mappings)i.<name
'filename already mapped'assert c=(1{"1 mappings)i.<fn
'sharename already mapped'assert (''-:sn)+.c=(2{"1 mappings)i.<sn
4!:55 <name
'bad noun name'assert ('_'={:name)*._1=nc<name

ro=. 0~:ro
aa=. AFNJA+AFRO*ro     NB. readwrite/readonly array access

if. IFUNIX do.
  'Unix sharename must be same as filename' assert (sn-:'')+.sn-:fn
  ts=. 1!:4 <fn
  fh=. >0 { c_open fn;O_RDWR;0
  'bad file name/access' assert fh~:_1
NB.  unix doesn't use a mapping handle;
NB.  however, we need to keep the length in the mapping list.
  mh=. ts
NB.  hard wire some values : protection flags (3) == read & write
NB.     mapping flags (2) == private;  (1) == shared
  fad=. >0{ c_mmap (<0);ts;(OR/ ro}. PROT_WRITE, PROT_READ);MAP_SHARED;fh;0
else.
  'fa ma va'=. ro{RW     NB. readwrite/readonly for file, map, view access
  fh=. CreateFileR (fn,{.a.);fa;(FILE_SHARE_READ+FILE_SHARE_WRITE);NULLPTR;OPEN_EXISTING;0;0
  'bad file name/access'assert fh~:_1
  ts=. GetFileSizeR fh;<NULLPTR
  mh=: CreateFileMappingR fh;NULLPTR;ma;0;0;(0=#sn){(sn,{.a.);<NULLPTR
  if. mh=0 do. 'bad mapping'assert 0[free fh,0,0 end.
  fad=. MapViewOfFileR mh;va;0;0;0
end.

if. fad=0 do. 'bad view'assert 0[free fh,mh,0 end.

if. ro*.0=type do. NB. readonly jmf file
  had=. allochdr 127
  (memr fad,0,HS)memw had,0,HS    NB. copy readonly jmf header to memory
  (aa,~HS+fad-had) memw had,0,2,JINT
  (,0+1) memw had,HADC,1,JINT    NB. ref count is 1
elseif. 0=type do.
  had=. fad
  if. 0=validate ts,had do. 'bad jmf header' assert 0[free fh,mh,fad end.
  aa memw had,HADFLAG,1,JINT
  if. sn-:'' do.
    t=. 0
  else.
    t=. 10000+ memr had,HADC,1,JINT NB. shared ref count is bumped and is not valid
  end.
  (,t+1) memw had,HADC,1,JINT    NB. ref count is 1 (except for shared, which is bumped)
elseif. 1 do.
  had=. allochdr 127                   NB. allocate header
  bx=. JBOXED=type
  hs=. (+/hsize)*asize=. JSIZES {~ JTYPES i. type
  lshape=. bx}.<.(ts-hs)%(*/tshape)*asize
  d=. hs+fad-had
  t=. IF64{2^31 63
  if. d<-t do. d=. <.d+t
  elseif. d>:t do. d=. <.t-d
  end.
  h=. d,aa,ts,type,1,(*/lshape,tshape),((-.bx)+#tshape),lshape,tshape
  h memw had,0,(#h),JINT  NB. set header
end.

mappings=: mappings,name;fn;sn;fh;mh;fad;had
(name)=: symset had  NB. set name to address header
i.0 0
)

NB. =========================================================
NB.*share v share a mapped file
share=: 3 : 0
'name sn ro'=. 3{.y.,<0
sn=. '/' (('\'=sn)#i.#sn)} sn NB. / not allowed in win sharename
if. IFUNIX do.
  map name;sn;sn;ro
else.
  name=. fullname name
  c=. #mappings
  assert c=({."1 mappings)i.<name['noun already mapped'
  4!:55 <name
  'bad noun name'assert ('_'={:name)*._1=nc<name
  fh=. _1
  fn=. ''
  mh=. OpenFileMappingR (ro{FILE_MAP_WRITE,FILE_MAP_READ);0;sn,{.a.
  if. mh=0 do. assert 0[CloseHandleR fh['bad mapping' end.
  fad=. MapViewOfFileR mh;FILE_MAP_WRITE;0;0;0
  if. fad=0 do. assert 0[CloseHandleR mh[CloseHandleR fh['bad view' end.
  had=. fad
  hs=: 0
  ts=. memr had,HADM,1,JINT
  mappings=: mappings,name;fn;sn;fh;mh;fad;had;ts
  (name)=: symset had  NB. set name to address header
  i.0 0
end.
)

NB. =========================================================
showle=: 3 : 0
le=. memr (symget <fullname y.),0 4,JINT
had=. 1{le
h=. memr had,0 7,JINT
s=. memr had,HADS,(6{h),JINT
le;h;s
)

NB. =========================================================
NB.*showmap v show all mappings
showmap=: 3 : 0
h=. 'name';'fn';'sn';'fh';'mh';'address';'header';'ts';'msize';'refs'
hads=. 6{"1 mappings
h,mappings,.(msize each hads),.refcount each hads
)

NB. =========================================================
NB.*unmap v unmap a mapped file
NB. [force] unmap name [;newsize] - 0 ok, 1 not mapped, 2 refs
unmap=: 3 : 0
0 unmap y.
:
'y. newsize'=. 2{.(boxopen y.),<_1
n=. <fullname y.
row=. ({."1 mappings)i.n NB. row in mappings
if. row=#mappings do. 1 return. end.  NB. not mapped
m=. row{mappings
4!:55 n NB. erase name
'sn fh mh fad had'=. 5{.2}.m

if. *./(-.x.),(0=#sn),1~:memr had,HADC,1,JINT do. 2 return. end.

if. fad~:had do. freehdr had end.
if. _1=newsize do.
  free fh,mh,fad
else.
  free _1,mh,fad
  SetFilePointerR fh;newsize;NULLPTR;FILE_BEGIN
  SetEndOfFile fh
  
NB. ?? needed:
  SetFilePointerR fh;0;NULLPTR;FILE_BEGIN
  
  CloseHandleR fh
end.
mappings=: (row~:i.#mappings)#mappings

0
)


NB. =========================================================
NB.*unmapall v unmap all mapped files
NB. [force] unmapall dummy  - unmap all
unmapall=: 3 : '>unmap each 0{"1 mappings'


NB. jmf mainx

NB. =========================================================
NB.*memshare v share memory with a process
NB.
NB. Form: {mapping-address} =: memshare {'share-name'}
NB.
NB. this permits sharing memory with a non-J process
NB.
NB. memshare and memshareclose contributed by Tony Zackin
memshare=: 3 : 0
bNo_Inherit_Handle=. FALSE
lpShareName=. y.,{.a.
mh=. OpenFileMappingR (FILE_MAP_READ+FILE_MAP_WRITE); bNo_Inherit_Handle; lpShareName
('Unable to map ',y.) assert mh~:0

addr=. MapViewOfFileR mh; (FILE_MAP_READ+FILE_MAP_WRITE); 0; 0; 0
if. addr=0 do. 'MapViewOfFile failed' assert 0[CloseHandleR mh end.

NB. Add share-name to col. 1, mapping handle to col. 2, and mapping address to
NB. column 3 of mapTable:
".(_1=4!:0<'mapTable')#'mapTable=:i.0,3' 	NB. Create table if it doesn't already exist
mapTable=: mapTable, y.; mh; addr			NB. y. is share-name, mh is mapping handle
addr
)

NB. =========================================================
NB.*memshareclose v close memory shared with memshare
NB.
NB. Form: memshareclose {'share-name'}
memshareclose=: 3 : 0
NB. Get row containing map handle and address and assign to mh and addr respectively:
NB. Syntax: {row}=. {search string} FindKey {n x m table where column 0 = key}
r=. y. findkey mapTable						NB. Get the matching row(s) for the share-name
'Unknown share name' assert 0~:$r			NB. y. not in column 0 of mapTable
'mh addr'=. {:(<r; 1 2){mapTable				NB. Get columns 1 & 2 values for the last matching row
('Unable to close share: ', y.) assert $mh > 0
UnmapViewOfFileR <<addr						NB. Unmap the file view
if. CloseHandleR mh	do. 					NB. If successful close then delete map table entry
  mapTable=: (<((i.#mapTable)-.r); i.{:$mapTable){mapTable 	NB. This supports the removal of one or more row(s)
end.NB. which match the share-name
)
