/******************************************************** * module name: text11.sim * * public procedures: gnd, getline, finalwork, start* ********************************************************/ getnext: do; $nolist $include (:f1:datax.sim) $list $include (:f1:file.sim) print: procedure(a,b) external; declare (a,b) address; end print; delete: procedure(file,status) external; declare (file, status) address; end delete; openmessage: procedure(status) external; declare status address; end openmessage; /*********************************************************** * gnd - gets the next character from the input buffer * * (inbuf), set eofset true if end of file is * * encountered. If inbuf empty, fills it from * * source file. * ***********************************************************/ gnd: procedure byte public; /* checkeof - check end of file */ checkeof: procedure byte; declare c byte; if (c := inbuf(ibp)) = eofile then eofset = true; return c; end checkeof; if eofset then return eofile; if (ibp := ibp+1) <= last(inbuf) then return checkeof; ibp = 0; call read(aft$in, .inbuf, buflen, .actualcount, .status); if actualcount < buflen then inbuf(actualcount) = eofile; return checkeof; end gnd; declare linenumber address external; /******************************************************** * getline - gets a line from the input buffer and * * put it in a line buffer lbuff. * ********************************************************/ getline: procedure public; declare char byte; putchar: procedure (c); declare c byte; if (lbp := lbp+1) > last(lbuff) then do; call write(0,.('line overflow'),13,.status); call exit; end; lbuff(lbp)=c; end putchar; lbp= -1; if (char := gnd) <> eofile then do; do while char <> lf and char <> eofile; call putchar(char); char = gnd; end; lbuff(lbp)=eos; lblen=lbp+1; end; wordp=0; linenumber=linenumber+1; end getline; /******************************************************** * finalwork - writes the text left in the text buffer * * into the output file, and closes the * * files, and then exit. * ********************************************************/ finalwork: procedure public; if tbp > 0 then do; output$count = tbp; call write(aft$out, .textbuf, output$count, .status); end; call close(aft$in, .status); call close(aft$out, .status); call exit; end finalwork; /******************************************************** * start - reads the input file, if exists, open it, * * reads the output file, or creat one if does * * not specified. Then fill the inbuf from * * the source file, and get the first line. * ********************************************************/ start: procedure public; declare i byte; do i = 0 to 127; inbuf(i) = 0; end; i = 0; call read(1, .inbuf, 128, .input$count, .status); /* check blank argument */ do while inbuf(i) = blank; i = i + 1; end; if inbuf(i) = cr then do; call print(.('NO SUCH FILE'),12); call print(.('EXECUTION TERMINATED'),20); call exit; return; end; call open(.aft$in,.inbuf,1,0,.status); if status <> 0 then do; call print(.('FILE NOT EXIST, TRY AGAIN'),25); call exit; return; end; i = 0; do while inbuf(i) = blank; i = i + 1; end; do while inbuf(i) > blank and i < inputcount; /* skip first argument */ i = i + 1; end; do while inbuf(i) = ' '; /* skip blank */ i = i + 1; end; if inbuf(i) > blank and i < inputcount then do; call delete(.inbuf(i),.status); /* delete output file */ call open(.aft$out,.inbuf(i),2,0,.status); call openmessage(status); end; else do; i = 0; /* open default output file */ /* skip leading blank and tab */ do while inbuf(i) = blank or inbuf(i) = tab ; i = i + 1; end; do while inbuf(i) <> '.' and inbuf(i) > blank and i < inputcount; i = i + 1; end; inbuf(i) = '.'; inbuf(i+1) = 'o'; inbuf(i+2) = 'u'; inbuf(i+3) = 't'; call delete(.inbuf, .status); call open(.aft$out, .inbuf, 2, 0, .status); call open$message(status); /* check validity of open */ end; ibp = buflen; call getline; actual$count = lblen-1; end start; END GETNEXT; EOF