:Namespace ⍙⍙ Version←1.01 (⎕IO ⎕ML ⎕CT)←1 2 1E¯13 C←⎕av[⎕io+3] APLsCovered←'APL2PC APLX APLC' 'APL2MF' 'DYALOG' 'APLPLUS' 'VSAPL' 'STSCMF' _←⍬ _,←⊂'This workspace is used for transferring simple objects to/from ATF files. ' _,←⊂'Version 1.05. ' _,←⊂'' _,←⊂'To use it do ' _,←⊂' ⍙⍙.ATFIN ''filepath[.atf] -fliplu -APL=aaa'' ' _,←⊂'' _,←⊂'where APL can be any of the strings found in ⍙⍙.APLsCovered. ' _,←⊂'If -fliplu is supplied the lowercase and underscored alphabets are ' _,←⊂'reversed. ' _,←⊂'' _,←⊂'The global variable ⍙⍙.PROBLEMS is used to capture objects that cannot ' _,←⊂'be handled. ' _,←⊂'' _,←⊂'The global char vector ⍙⍙.Translate contains the maps from the source ' _,←⊂'⎕AV to DYALOG?''s ⎕AV. ⎕AV[N] in the source APL becomes ⍙⍙.Translate[a;N] ' _,←⊂'in DYALOG where ''a'' is the index of the APL to map from. ' _,←⊂'If no -APL is supplied the program will attempt to guess the source ' _,←⊂'APL but there is no guaranty this will work. ' _,←⊂'' _,←⊂'To send a ws to file use' _,←⊂' ⍙⍙.ATFOUT ''filepath[.atf] -objects=...''' _,←⊂'' _,←⊂'If you have any problems with the workspace, then please ' _,←⊂'direct your enquiries to whoever supplied your copy of Dyalog APL.' DESCRIBE←{⎕ml←0⋄↑⍵}_ _←⍬ _,←⊂⎕av[⎕io],' ?? ɫa',⎕av[⎕io+1 18 2 19 20 3],'efghijklmnopqrstuv !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]∧_?ÁÂÃÇÈÊËÌÍÎÏÐÒÓÔÕÙÚÛÝþãìðòõ{∣}~wxyz??⍬?¤¥??ý·?ÀÄ⎕⍞⌹ÅÆ⍨ÉÑ⊤ÖØÜ£⊥ß⌶àáâäåæçèé⌈êë∪í⍕⍎îïñ│┤⍟∆∇→|⍪≢ó←⌊┐└┴┬├─┼↑↓ôöø?ùúû≡^ü?⌷¶⍷?⊣⋄┘┌¿¡¢??⍺§⊂⊃⍝⍲⍴⍱⌽⊖○∨⍳⍉∊∩⌿⍀≥≤≠×÷⍙∘⍵⍫⍋⍒¯¨⍣' _,←⊂'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷',⎕av[⎕io+2 3],'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷',⎕av[⎕io+1],'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷ ÁÂÃÇÈÊËÌÍ¢.<(+|&ÎÏÐÒÓÔÕÙÚ!$*);⌷-/ÛÝþãìðòõ∣,%_>?⋄∧¨⌷⌷⍷⌷⊣∨?:#@''="~abcdefghi↑↓≤⌈⌊→⎕jklmnopqr⊃⊂⌷○⌷←¯~stuvwxyz∩∪⊥[≥∘⍺∊⍳⍴⍵⌷×\÷⌷∇∆⊤]≠|{ABCDEFGHI⍲⍱⌷⌽⌷⍉}JKLMNOPQR⌶!⍒⍋⍞⍝\≡STUVWXYZ⌿⍀⌷⊖⌹⍕0123456789⌷⍫⍙⍟⍎⌷' _,←⊂⎕av ⍝ Dyalog ⍝ APL+ _,←⊂⎕av[⎕io],'?⊢⍷⋄¨←',⎕av[⎕io+7 1 9 2 186 127 3],'⊃⍟⌷⌷⌷⍫⌷⌶⍬⍵↑↓→⌷⊣?⍋⍒ !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]∧_?abcdefghijklmnopqrstuvwxyz{|}~⌷Çüéâäà≠çêëèïî⌈Ä⌊É∆×ôö⎕û⍞⌹ÖÜ¢£¥⍪⍨áíóúñÑ⍝⍀¿⌷õøý¡<>⌷⌷⌷│┤┤┤┐┐┤│┐┘┘┘┐└┴┬├─┼├├└┌┴┬├─┼┴┴┬┬└└┌┌┼┼┘┌ÛÜÝ│⍣⍺ß⍳öÖ⍱⊥⊤⌽⊖⍲⌿∇⍉∊∩≡⍙≥≤⍕⍎÷,∘○∨⍴∪¯|⌷' _,←⊂'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷',⎕av[⎕io+2 3],'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷',⎕av[⎕io+1],'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷ ÁÂÃÇÈÊËÌÍ¢.<(+|&ÎÏÐÒÓÔÕÙÚ!$*);⌷-/ÛÝþãìðòõ∣,%_>?⌷∧¨⌷⌷⌷⌷⌷∨?:£@''="~abcdefghi↑↓≤⌈⌊→⎕jklmnopqr⊃⊂⌷○⌷←¯~stuvwxyz∩∪⊥[≥∘⍺∊⍳⍴⍵⌷×\÷⌷∇∆⊤]≠|{ABCDEFGHI⍲⍱⌷⌽⌷⍉}JKLMNOPQR⌶!⍒⍋⍞⍝\≡STUVWXYZ⌿⍀⌷⊖⌹⍕0123456789⌷⍫⍙⍟⍎⌷' _,←⊂'⌷⌷⌷⌷⌷⌷⌷⌷⌷&%"+_⌷£⌷⌷⌷⍬⌷⌷¢⌷{}⌷⌷⌷⌷⌷⌷⌷⌷⌷@⌷≤abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ∆ÁÂÃÇÈÊËÌÍÎÏÐÒÓÔÕÙÚÛÝþãìðòõ⍙0123456789¯.⌷⌷_¨∇⍫⍺⍵∩∪⊂⊃⌶+-×÷*○⍟⌈⌊|∧∨⍲⍱<≤=≥>≠~!⍴⍳∊⊥⊤⌽⍉⊖/⌿\⍀⌹⍋⍒,?↑↓→←⎕⍞⍎⍕∘[]();:''⍝',⎕av[⎕io+1 2 3],'⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷≡⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⌷⋄⌷⌷?⌷⊣⌷' Translate←{⎕ml←0⋄↑⍵}_ _←⊂ 0 1 2 209 216 254 189 7 8 9 10 226 12 13 227 181 213 212 208 250 151 159 22 249 _,←⊂ 198 199 184 27 215 214 251 252 32 33 34 35 36 37 38 39 40 41 42 43 44 45 _,←⊂ 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 _,←⊂ 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 _,←⊂ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 _,←⊂ 115 116 117 118 119 120 121 122 123 5 125 126 127 128 129 130 131 132 133 _,←⊂ 244 135 136 137 138 139 140 169 142 190 149 182 245 147 148 144 150 145 _,←⊂ 146 153 154 155 156 30 158 21 160 161 162 163 164 165 228 241 168 211 170 _,←⊂ 171 31 173 134 23 176 177 178 179 180 15 20 11 26 185 186 187 188 6 143 _,←⊂ 191 192 193 194 195 196 197 24 25 200 201 202 203 204 205 206 19 18 3 210 _,←⊂ 141 17 16 29 28 4 217 218 219 220 221 222 223 224 225 236 14 166 231 157 _,←⊂ 152 232 233 229 240 183 237 238 239 207 247 242 243 174 175 246 167 248 234 235 230 172 253 124 255 OUTTR←_ ⎕ex¨ 'C' '_' ∇ ATFIN arg;Filename;POS;TXT;NM;DUFF;Filenum;Block;SCRIPT;⎕ML;more;TR;Target;t;Pa;sc ⍝ Transfer in from an ATF file produced by e.g. )OUT on IBM ⍝ All system variables are saved at the end. ⍝ All system variable changes saved in QuadThings ⍝ Anything that won't fix is saved in PROBLEMS ⍝ ⎕IO←1 ⋄ ⎕ML←1 ⍝ DO NOT CHANGE OR LOCALISE ⎕IO! t←1↓t,ToLower t←∊' ',¨APLsCovered Pa←(⎕NEW ⎕SE.Parser,⊂('-fliplu -apl=',t)'upper').Parse arg Filename←(1⊃Pa.Arguments){⍺,(~'.'∊⍺)/⍵}'.atf'⍝ append extension if none there '... Processing file ',Filename ⍝ We try to determine the width of the 'records' - should be a multiple of 80 to 84 :If 0∊⍴t←{(0=s|⍵)/s←79+⍳5}⎕NSIZE Filenum←OPEN Filename 'Unable to determine block size'⎕SIGNAL 11 :Else :If 1≠⍴t ⋄ ⎕←'Ambiguous block size; picking',t←¯1↑t ⋄ :EndIf Block←(0,t)⍴'' :EndIf TR←Pa SetTR Filenum,1↓⍴Block ⍝ Set up translation SCRIPT←0 72⍴PROBLEMS←QuadThings←'' Target←'#.' ⍝ where do we have to define these objects 'Cannot define objects in this namespace'⎕SIGNAL 11 if Target≡⎕THIS ⎕WSID←{((0∊b)×-1+⊥⍨b←'.'≠⍵)↓⍵}Filename ⍝ change ws here to avoid overwriting the original more←1 :While more :If (POS←SCRIPT[;1]⍳'X')≤⊃⍴SCRIPT ⍝ Got some to be getting on with TXT←,0 1↓SCRIPT[⍳POS;] ⍝ Extract block of text (drop X column) SCRIPT←(POS,0)↓SCRIPT ⍝ And throw away from script :Select ⍬⍴TXT ⍝ What are we dealing with? :CaseList 'ACN' ⍝ Variable :If '⎕'=TXT[2] ⍝ If it is a system object QuadThings,←⊂TXT ⍝ then save it until later :Else CHARFN TXT :EndIf :Case 'F' ⍝ Function ⎕←'Function : ',NM←1↓(t←TXT⍳' ')↑TXT ⍝ What's its name? t←¯1+TXT⍳'⎕' ⍝ where does ⎕FX start TXT←t↓TXT ⍝ Throw away any left arg of ⎕FX :Trap 0 {}÷∨/0 2∊10|⎕DR⍎Target,TXT ⍝ Execute it - check for error :Else '*** Cannot fix : ',NM ⍝ Tell user about the problem PROBLEMS,←⊂TXT ⍝ and save copy of text :EndTrap :Else ∘⎕←'Invalid TYPE' :EndSelect :Else ⍝ We don't have a block. Try to get next block from file. If sucessful continue ⍝ processing, otherwise stop as we have reached end of file. Ignore * lines. more←~0∊⍴SCRIPT⍪←{(⍵[;1]≠'*')⌿⍵}(GETNEXTBLOCK 500)[;⍳72] :EndIf :EndWhile ⍝ Repeat for next block ⎕NUNTIE Filenum CHARFN¨QuadThings '... Finished' :If ~sc←'#.⍙⍙'≢⎕CS'' ⎕←' ↑⍙⍙.QuadThings ⍝ to see the systems variables modified' ⎕←'To remove the ws'' transfer objects, execute the following line' ⎕←' ⎕EX ''⍙⍙'' ⍝ and do' :EndIf ⎕←' )save ',Filename →(0∊⍴PROBLEMS)↑0 ⎕←'*** ⍙⍙',sc↓'.PROBLEMS contains unfixed objects' ⍎sc/'#.⍙⍙PROBLEMS←PROBLEMS' ∇ ∇ CHARFN TXT;⎕TRAP;RANK;SHAPE;DATA;i;n;TYPE;NM ⍝ TXT is the transfer file string that represents one variable. ⍝ This function creates the variable in the workspace. →0 if' '∧.=TXT ⍝ cover null case :Trap 0 i←{⎕IO←1 ⋄ ⍺⍳⍵} ⍝ because we can't trust ⎕IO to be 1 'Variable : ',NM←1↓¯1↓((TXT∊'← ')i 1)↑TXT ⍝ Whats its name? :If 'A'=TYPE←1↑TXT ⍎Target,1↓TXT :Else DATA←(TXT i' ')↓TXT SHAPE←⍴RANK←⍎(DATA⍳' ')↑DATA DATA←(DATA i' ')↓DATA :If 01↑⍴Block ⍝ has Block enough lines to meet request? BL←{⍵+256×⍵<0}⎕NREAD Filenum,83,LINES×colw ⍝ Read as nums BL←((⌊(⍴BL)÷colw),colw)⍴BL ⍝ and reshape to lines of 80 to 83 Block⍪←TR[BL] ⍝ Now convert to Dyalog APL /ASCII :EndIf ⍝ Return what is asked for if possible BLOCK←((LCOUNT←LINES⌊1↑⍴Block),colw)↑Block Block←(LCOUNT,0)↓Block ∇ ∇ Filenum←OPEN File;⎕TRAP;EM 'File <',File,'> has length ',⍕⎕NSIZE Filenum←File ⎕NTIE 0 ∇ ∇ tr←la SetTR(fn bs);apl;i;⎕IO;n ⍝ Find translation to apply from looking at the file if no APL specified. ⎕IO←0 :If 0≡la.APL ⍝ Find signature: read 1st few 100 bytes {}⎕NREAD fn 83 0 0 ⍝ ensure at start n←⍴i←⎕NREAD fn 83,2↑1+bs×21 :Select {(>/⍵)⌽⍵}∪i[bs×⍳⌈n÷bs]~42 92 180 ⍝ remove *s :CaseList (⊂i),,¨i←32 88 ⋄ apl←'APL2PC' :CaseList (⊂i),,¨i←¯25 64 ⋄ apl←'APL2MF' :CaseList (⊂i),,¨i←4 88 ⋄ apl←'DYALOG' :Else ⋄ 'unknown APL'⎕SIGNAL 11 :EndSelect ⍝ Reset file read pointer to beginning {}⎕NREAD fn 83 0 0 :Else ⍝ ensure uppercase apl←ToUpper la.APL :EndIf tr←Translate[1⍳⍨1∊¨(' ',apl,' ')∘⍷¨' ',¨APLsCovered,¨' ';] ⍝ Reverse underscored letters and lowercase letters? :If la.FLIPLU≠apl≡'APL2PC' ⍝ 'flip' reversed for this APL i←tr⍳'abcdefghijklmnopqrstuvwxyzÁÂÃÇÈÊËÌÍÎÏÐÒÓÔÕÙÚÛÝþãìðòõ' :If ~256∊i ⋄ tr[i]←26⌽tr[i] ⋄ :EndIf :EndIf ∇ LC←'abcdefghijklmnopqrstuvwxyz' ToLower←{⎕IO←0 ⋄ b←26>i←⎕A⍳s←,⍵ ⋄ (b/s)←LC[b/i] ⋄ s} ToUpper←{⎕IO←0 ⋄ b←26>i←LC⍳s←,⍵ ⋄ (b/s)←⎕A[b/i] ⋄ s} if←/⍨ ⍝ ===================== OUT code ===================== ∇ ATFOUT arg;OBJS;obj;fn;class;state;⎕IO;⎕ML;val;n;X;Pa;source ⍝ arg is a string of filename possibly followed by -objects=... ⍝ If omitted, all objects are re-constituted. ⍝ ⎕ML←⎕IO←1 Pa←(⎕NEW ⎕SE.Parser,⊂'-objects=' 'upper').Parse arg fn←OUTINIT 1⊃Pa.Arguments ⍝ If no names explicitly chosen, transfer everything in WS ⍝ We need to find where the objects are to start with. We cannot assume this ns was copied in a ws and used ⍝ from there, it could be called from Spice way down the stack in some unknown ns. source←⍎(⍴⎕NSI)⊃⎕NSI :If 0≡OBJS←Pa.OBJECTS OBJS←'⎕CT' '⎕DIV' '⎕IO' '⎕LX' '⎕PP' '⎕PW' '⎕RL' '⎕RTL' '⎕TRAP',source.⎕NL-2 3 4 ⍝ no namespaces transferred to other systems :Else OBJS←{(1↓¨(⍵∊' ')⊂⍵)~⊂''}' ',OBJS 'Invalid object (vars & fns only)'⎕SIGNAL 11 if~∧/(source.⎕NC OBJS)∊2 3 4 :EndIf :For obj class :InEach OBJS(source.⎕NC¨OBJS) ⍝ Find the basic representation to recreate a variable :If class=¯1 ⍝ ⎕var :If 1∊1⊃state←⎕STATE obj ⍝ shadowed? val←⊃⌽4⊃state :Else val←⍎obj :EndIf val←'A',obj,'←',⎕SE.Dyalog.Utils.repObj val :ElseIf class=2 ⍝ var val←'A',obj,'←',⎕SE.Dyalog.Utils.repObj source⍎obj :Else ⍝ must be a fn/op val←'F',obj,' ⎕fx ',⎕SE.Dyalog.Utils.repObj source.⎕NR obj :EndIf ⍝ Append representation in antiquated 80 column card format a la IBM X←'X'↑⍨-n←⌈(⍬⍴⍴val)÷71 ⋄ val←(X,n 79↑n 71⍴(n×71)↑val),n 2⍴⎕AV[3 2] OUTTR[⎕AV⍳val]⎕NAPPEND fn,82 :EndFor ⎕←'Job completed. File size=',⍕⎕NSIZE fn ⎕NUNTIE fn ∇ ∇ num←OUTINIT Filename ⍝ Create/rewrite file ⍝ Filename←Filename{⍺,(⍵≢(-⍴⍵)↑⍺)/⍵}'.atf' :Trap 22 num←Filename ⎕NCREATE 0 :Else :Trap 0 Filename ⎕NERASE Filename ⎕NTIE 0 num←Filename ⎕NCREATE 0 :Else 'Cannot create file ',Filename,' :',⎕EM ⎕EN → :EndTrap :EndTrap (-⎕IO-⍳256)⎕NXLATE num ⍝ raw translate ∇ :EndNamespace