1implement TclLib; 2 3include "sys.m"; 4 sys: Sys; 5include "draw.m"; 6include "bufio.m"; 7 bufmod : Bufio; 8Iobuf : import bufmod; 9 10include "string.m"; 11 str : String; 12 13include "tk.m"; 14 15include "tcl.m"; 16 17include "tcllib.m"; 18 19error : int; 20started : int; 21tclmod : ref Tcl_Core->TclData; 22 23name2fid : array of (ref Iobuf,string,int); 24 25valid_commands := array[] of { 26 "close", 27 "eof" , 28 "file", 29 "flush", 30 "gets" , 31 "open", 32 "puts", 33 "read" , 34 "seek" , 35 "tell" 36}; 37 38init() : string { 39 started=1; 40 str = load String String->PATH; 41 sys = load Sys Sys->PATH; 42 bufmod = load Bufio Bufio->PATH; 43 if (str==nil || bufmod==nil) 44 return "Can't initialise IO package."; 45 name2fid = array[100] of (ref Iobuf,string,int); 46 stdout := bufmod->fopen(sys->fildes(1),bufmod->OWRITE); 47 if (stdout==nil) 48 return "cannot open stdout for writing.\n"; 49 name2fid[0]=(nil,"stdin",0); 50 name2fid[1]=(stdout,"stdout",0); 51 return nil; 52} 53 54about() : array of string{ 55 return valid_commands; 56} 57 58exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) { 59 tclmod=tcl; 60 msg :string; 61 if (!started) init(); 62 error=0; 63 case argv[0] { 64 "close" => 65 msg = do_close(argv); 66 return (error,msg); 67 "eof" => 68 msg = do_eof(argv); 69 return (error,msg); 70 "file" => 71 msg = do_nothing(argv); 72 return (error,msg); 73 "flush" => 74 msg = do_nothing(argv); 75 return (error,msg); 76 "gets" => 77 msg = do_gets(argv); 78 return (error,msg); 79 "open" => 80 msg = do_open(argv); 81 return (error,msg); 82 "puts" => 83 msg = do_puts(argv); 84 return (error,msg); 85 "read" => 86 msg = do_read(argv); 87 return (error,msg); 88 "seek" => 89 msg = do_seek(argv); 90 return (error,msg); 91 "tell" => 92 msg = do_nothing(argv); 93 return (error,msg); 94 } 95 return (1,nil); 96} 97 98do_nothing(argv : array of string) : string { 99 if (len argv==0); 100 return nil; 101} 102 103do_close(argv : array of string) : string { 104 iob : ref Iobuf; 105 name : string; 106 j : int; 107 iob=nil; 108 if (len argv!=2) 109 return notify(1,"close fileId"); 110 for(i:=0;i<len name2fid;i++){ 111 (iob,name,j)=name2fid[i]; 112 if (name==argv[1]) 113 break; 114 } 115 if (iob==nil) 116 return notify(0,sys->sprint("bad file identifier \"%s\"", 117 argv[1])); 118 iob.flush(); 119 iob.close(); 120 iob=nil; 121 name2fid[i]=(nil,"",0); 122 return nil; 123} 124 125do_eof(argv : array of string) : string { 126 name : string; 127 j : int; 128 iob : ref Iobuf; 129 if (len argv!=2) 130 return notify(1,"eof fileId"); 131 for(i:=0;i<len name2fid;i++){ 132 (iob,name,j)=name2fid[i]; 133 if (name==argv[1]) 134 return string j; 135 } 136 return notify(0,sys->sprint("bad file identifier \"%s\"",argv[1])); 137} 138 139 140do_gets(argv : array of string) : string { 141 iob : ref Iobuf; 142 line : string; 143 if (len argv==1 || len argv > 3) 144 return notify(1,"gets fileId ?varName?"); 145 if (argv[1]=="stdin") 146 line = <- tclmod.lines; 147 else{ 148 iob=lookup_iob(argv[1]); 149 if (iob==nil) 150 return notify(0,sys->sprint( 151 "bad file identifier \"%s\"",argv[1])); 152 line=iob.gets('\n'); 153 } 154 if (line==nil){ 155 set_eof(iob); 156 return nil; 157 } 158 return line[0:len line -1]; 159} 160 161do_seek(argv : array of string) : string { 162 iob : ref Iobuf; 163 if (len argv < 3 || len argv > 4) 164 return notify(1,"seek fileId offset ?origin?"); 165 iob=lookup_iob(argv[1]); 166 if (iob==nil) 167 return notify(0,sys->sprint( 168 "bad file identifier \"%s\"",argv[1])); 169 flag := Sys->SEEKSTART; 170 if (len argv == 4) { 171 case argv[3] { 172 "SEEKSTART" => 173 flag = Sys->SEEKSTART; 174 "SEEKRELA" => 175 flag = Sys->SEEKRELA; 176 "SEEKEND" => 177 flag = Sys->SEEKEND; 178 * => 179 return notify(0,sys->sprint( 180 "illegal access mode \"%s\"", 181 argv[3])); 182 } 183 } 184 iob.seek(big argv[2],flag); 185 return nil; 186} 187 188do_open(argv : array of string) : string { 189 flag : int; 190 if (len argv==1 || len argv > 3) 191 return notify(1, 192 "open filename ?access? ?permissions?"); 193 name:=argv[1]; 194 if (len argv == 2) 195 flag = bufmod->OREAD; 196 else { 197 case argv[2] { 198 "OREAD" => 199 flag = bufmod->OREAD; 200 "OWRITE" => 201 flag = bufmod->OWRITE; 202 "ORDWR" => 203 flag = bufmod->ORDWR; 204 * => 205 return notify(0,sys->sprint( 206 "illegal access mode \"%s\"", 207 argv[2])); 208 } 209 } 210 iob := bufmod->open(name,flag); 211 if (iob==nil) 212 return notify(0, 213 sys->sprint("couldn't open \"%s\": No" + 214 " such file or directory.",name)); 215 for (i:=0;i<len name2fid;i++){ 216 (iob2,name2,j):=name2fid[i]; 217 if (iob2==nil){ 218 name2fid[i]=(iob,"file"+string i,0); 219 return "file"+string i; 220 } 221 } 222 return notify(0,"File table full!"); 223} 224 225do_puts(argv : array of string) : string { 226 iob : ref Iobuf; 227 if (len argv==1 || len argv >4) 228 return notify(1, 229 "puts ?-nonewline? ?fileId? string"); 230 if (argv[1]=="-nonewline"){ 231 if (len argv==2) 232 return notify(1, 233 "puts ?-nonewline? ?fileId? string"); 234 if (len argv==3) 235 sys->print("%s",argv[2]); 236 else{ 237 iob=lookup_iob(argv[2]); 238 if (iob==nil) 239 return notify(0,sys->sprint( 240 "bad file identifier \"%s\"", 241 argv[2])); 242 iob.puts(argv[3]); 243 iob.flush(); 244 } 245 } else { 246 if (len argv==2) 247 sys->print("%s\n",argv[1]); 248 if (len argv==3){ 249 iob=lookup_iob(argv[1]); 250 if (iob==nil) 251 return notify(0,sys->sprint( 252 "bad file identifier \"%s\"", 253 argv[1])); 254 iob.puts(argv[2]+"\n"); 255 iob.flush(); 256 257 } 258 if (len argv==4) 259 return notify(0,sys->sprint( 260 "bad argument \"%s\": should be"+ 261 " \"nonewline\"",argv[3])); 262 } 263 return nil; 264} 265 266do_read(argv : array of string) : string { 267 iob : ref Iobuf; 268 line :string; 269 if (len argv<2 || len argv>3) 270 return notify(1, 271 "read fileId ?numBytes?\" or \"read ?-nonewline? fileId"); 272 if (argv[1]!="-nonewline"){ 273 iob=lookup_iob(argv[1]); 274 if (iob==nil) 275 return notify(0,sys->sprint( 276 "bad file identifier \"%s\"", argv[1])); 277 if (len argv == 3){ 278 buf := array[int argv[2]] of byte; 279 n:=iob.read(buf,len buf); 280 if (n==0){ 281 set_eof(iob); 282 return nil; 283 } 284 return string buf[0:n]; 285 } 286 line=iob.gets('\n'); 287 if (line==nil) 288 set_eof(iob); 289 else 290 line[len line]='\n'; 291 return line; 292 }else{ 293 iob=lookup_iob(argv[2]); 294 if (iob==nil) 295 return notify(0,sys->sprint( 296 "bad file identifier \"%s\"", argv[2])); 297 line=iob.gets('\n'); 298 if (line==nil) 299 set_eof(iob); 300 return line; 301 } 302} 303 304 305 306 307 308 309 310 311notify(num : int,s : string) : string { 312 error=1; 313 case num{ 314 1 => 315 return sys->sprint( 316 "wrong # args: should be \"%s\"",s); 317 * => 318 return s; 319 } 320} 321 322 323lookup_iob(s:string) : ref Iobuf{ 324 iob : ref Iobuf; 325 name : string; 326 j : int; 327 for(i:=0;i<len name2fid;i++){ 328 (iob,name,j)=name2fid[i]; 329 if (name==s) 330 break; 331 } 332 if (i==len name2fid) 333 return nil; 334 return iob; 335} 336 337set_eof(iob : ref Iobuf) { 338 iob2 : ref Iobuf; 339 name : string; 340 j : int; 341 for(i:=0;i<len name2fid;i++){ 342 (iob2,name,j)=name2fid[i]; 343 if (iob==iob2) 344 break; 345 } 346 if (i!=len name2fid) 347 name2fid[i]=(iob,name,1); 348 return; 349} 350 351