// Micro Input Routines // last edited March 12, 1981 10:36 AM // Copyright Xerox Corporation 1979, 1981 get "micdecl.d" get "streams.d" get "altofilesys.d" external // O.S. [ OpenFile Gets; Puts; Closes GetCompleteFa; JumpToFa FilePos; SetFilePos DoubleAdd MoveBlock; SetBlock; Zero Noop ] // Input stack structure structure IR: [ chain word lbsym word lblct word lincnt word cfa @CFA name word 0 ] manifest lIR = size IR/16 manifest [ minpt = #41 // lowest printing character maxpt = #176 // highest printing character ecEndOfFile = 1302 eofchar = -2 // dummy character for eof trailerchar = #32 // Bravo trailer character bssize = 30 // Bracket/paren stack size ] // Static Storage // Input stack static [ @instk = 0 // input stack for INSERT @stcct = 0 // backup char. count for current statement ] let initin() be // Initialize input variables [ instk = 0 lbsym = 0 lblct = 0 lincnt = 1 stbuf = alloctemp(stbl+1)+1 stbend = stbuf+stbl stbuf!-1 = endc ] and inpush(filenm, fp; numargs na) = valof // Push down the input stack and open the indicated file // Return false if bad file. [ let filename = vec filenamelength copyfile(filename, filenm) if na ls 2 then [ fp = 0; filext(filename, filenm, "MC") ] // called from INSERT if instk ne 0 then [ GetCompleteFa(inchan, lv instk>>IR.cfa) Closes(inchan) ] inchan = OpenFile(filename, ksTypeReadOnly, charItem, verLatest, fp, inerr) if inchan eq 0 then [ if instk ne 0 then injump(instk) resultis false ] // Push an entry on the stack let nw = (length(filename)+2) rshift 1 let rp = alloc(lIR+nw) rp>>IR.chain = instk MoveBlock(lv rp>>IR.name, filename, nw) rp>>IR.lbsym = lbsym rp>>IR.lblct = lblct rp>>IR.lincnt = lincnt instk = rp lbsym = 0 lblct = 0 lincnt = 1 llstr("** FILE ") lstr(filename) lcrlf() resultis true ] and inpop() = valof // Pop input stack. Return true if stack empty. [ let rp = instk if rp ne 0 then [ Closes(inchan) instk = rp>>IR.chain ] if instk eq 0 then // nothing stacked [ if rp ne 0 then dalloc(rp) resultis true ] injump(instk) lbsym = rp>>IR.lbsym lblct = rp>>IR.lblct lincnt = rp>>IR.lincnt llstr("** RETURN TO ") lstr(lv instk>>IR.name) lcrlf() dalloc(rp) resultis false ] and injump(rp) be // Reopen an input file and jump to a place in it [ inchan = OpenFile(0, ksTypeReadOnly, charItem, 0, lv rp>>IR.cfa.fp, inerr) if inchan eq 0 then error("CAN'T REOPEN FILE") JumpToFa(inchan, lv rp>>IR.cfa.fa) ] and inerr(st, ec) = valof test ec eq ecEndOfFile ifso resultis eofchar ifnot error("ERROR READING INPUT FILE") and readstat() = valof // Read a statement, return false on eof [ let fchar = nil // define first for assembly code static [ @rswitch = 0; @rsloop; @bstk; @bstop ] // See initreadstat below stbot = stbuf sttop = stbuf stlct, stcct = lincnt, 0 let bsptr = bstk let lastsym = stbot [ goto rsloop //rsloop: fchar = Gets(inchan) // stcct = stcct+1 // goto rswitch!fchar let initreadstat(ucf) be // Initialize readstat character dispatch [ if rswitch eq 0 then [ rswitch = alloctemp(#400-eofchar)-eofchar // eofchar is negative rsloop = table[ 0 // LDA 0 inchan #6407 // JSR @Gets 1 // 1 #41004 // STA 0 fchar,2 0 // ISZ stcct 0 // LDA 3 rswitch #117000 // ADD 0 3 #3400 // JMP @0,3 0 // Gets: ] rsloop!0 = #20000+lv inchan rsloop!4 = #10000+lv stcct rsloop!5 = #34000+lv rswitch rsloop!8 = Gets SetBlock(rswitch, rschar, #400) SetBlock(rswitch, rsskip, minpt) SetBlock(rswitch+(maxpt+1), rsskip, #400-(maxpt+1)) rswitch!eofchar = rseof rswitch!trailerchar = rstrailer rswitch!$*N = rsnl rswitch!$% = rspercent rswitch!$( = rslpar rswitch!$) = rsrpar rswitch!$** = rsstar rswitch!$: = rsdelim rswitch!$; = rssemi rswitch!$[ = rslbr rswitch!$] = rsrbr rswitch!$, = rsdelim rswitch!$# = rsnosym rswitch!$_ = rsnosym bstk = alloctemp(bssize+1) @bstk = eofchar bstop = bstk+bssize ] SetBlock(rswitch+$a, (ucf? rsraise, rschar), $z-$a+1) ] rstrailer: // Bravo trailer character flush($*N, $*S) rsnl: // *N lincnt = lincnt+1 if sttop eq stbot then stlct, stcct = lincnt, 0 goto rsloop rseof: // End of file if sttop ne stbot then [ errx("File ends with incomplete statement") sttop = stbot ] if inpop() then resultis false // end of top-level file stlct, stcct = lincnt, 0 goto rsloop rspercent: // % flush($%, -1) if sttop eq stbot then stlct, stcct = lincnt, 0 goto rsloop rsstar: // * fchar = Gets(inchan) test fchar eq eofchar ifso [ ceoferr() ] ifnot test fchar ne cmtchar ifso [ flush($*N, fchar) ] ifnot // Look for sequence *cmtchar [ flush($**, fchar) fchar = Gets(inchan) if fchar eq eofchar then [ ceoferr() break ] if fchar eq cmtchar then [ flush($*N, -1) break ] ] repeat if sttop eq stbot then stlct, stcct = lincnt, 0 goto rsloop rslpar: // ( rslbr: // [ if bsptr eq bstop then [ bserr("Too much nesting of () and []") break ] bsptr = bsptr+1 @bsptr = fchar goto rsdelim rsrpar: // ) if @bsptr ne $( then [ bserr("Unmatched )") break ] bsptr = bsptr-1 goto rsdelim rsrbr: // ] if @bsptr ne $[ then [ bserr("Unmatched ]") break ] bsptr = bsptr-1 goto rsdelim rsdelim: // Symbol delimiter [ let nc = sttop-lastsym test (nc ge 2) & (@lastsym ge $A) ifso [ let ep = lookup(lastsym, nc) if ep ne 0 then [ @lastsym, lastsym!1 = ep-fstop, symc sttop = lastsym+2 ] ] ifnot if (@lastsym le $7) & (nc ne 0) & (@lastsym ge (nc eq 1? $0, $1)) & (nc le 6) then [ let val = @lastsym-$0 for p = lastsym+1 to sttop-1 do [ if (@p gr $7) % (@p ls $0) goto rnon if (val & 160000b) ne 0 goto rnon // would overflow val = val lshift 3 + @p-$0 ] @lastsym, lastsym!1 = val, numc sttop = lastsym+2 rnon: ] lastsym = sttop+1 goto rschar ] rsnosym: // Suppress symbol lookup lastsym = stbend goto rschar rsraise: // Raise lower-case letter fchar = fchar+($A-$a) rschar: // Normal character test sttop gr stbend ifso [ errx("INPUT STATEMENT TOO LONG") break ] ifnot [ @sttop = fchar sttop = sttop+1 ] rsskip: // Non-printing character goto rsloop rssemi: // ; if @bsptr ne eofchar then bserr("Unmatched ( or [") break ] repeat tlbot = stbend tltop = stbend resultis true ] and flush(marker, fchar) = valof // Flush input stream until marker is detected. // Increment stcct for each character skipped. [ if fchar ls minpt then [ if fchar eq trailerchar then [ flush($*N, $*S) fchar = $*N ] if fchar eq $*N then lincnt = lincnt+1 if fchar eq eofchar then [ ceoferr() break ] ] if fchar eq marker break fchar = Gets(inchan) stcct = stcct+1 ] repeat and ceoferr() be errx("END OF FILE INSIDE COMMENT") and bserr(str) be [ errx(str) flush($;, -1) sttop = stbot ] and printstat(outs) be // Print the last statement read, by backing up inchan by stcct characters // Remove Bravo trailers [ let pos = vec 1 FilePos(inchan, pos) let lastchar = -1 if stcct ne 0 then [ let n0, n1 = -1, -stcct DoubleAdd(pos, lv n0) SetFilePos(inchan, pos) let puts = Puts for i = 1 to stcct do [ lastchar = Gets(inchan) switchon lastchar into [ case trailerchar: puts = Noop; endcase case $*N: puts = Puts; endcase ] puts(outs, lastchar) ] ] if lastchar ne $*N then Puts(outs, $*N) ]