// File BCPL1_MAINSRC // Version: E7.7 (also alter MANIFESTs below) // BCPL compiler - phase 1 - system interface // Copyright (C) R.D. Eager University of Kent MCMLXXXVI // History: // E1.0 - Initial EMAS version (compiled on VME/K) // - Correction to code for EXTERNAL calls; 'ssp' now increased // by 9 on a PRCL, instead of 8. // E1.1 - Converted for compilation on EMAS; SECTION directive // inserted, GET statements altered. // E1.2 - Calls of 'changecontext' added before entry to // cross-reference program or codegenerator. // E1.3 - Modification to initialise 'param_pos' before reading // 'flag' string; necessary if BCPL1 is to be loaded on base // GLA and is to be serially reusable. // - Addition of code to save the entry points to 'synreport' // and 'transreport' on first entry, and reinitialise on // second and subsequent entries, to guard against 'window' // when a temporary routine is in use, ensuring that compiler // remains serially reusable. // E1.4 - Addition of code to run cross-reference program if // PARM(XREF) is set. // - I/O errors now passed back to steering program for // interpretation. // E1.5 - Modification to set 'comreg(9)' to zero before entering // codegenerator, to indicate direct compiler call. // E1.6 - Parameter error messages now handled by steering program. // E1.7 - Correction to code of 'performget', so that GET files are // not sought under library username if a username has already // been quoted. // E2.0 - Addition of code to drive VAX-11 (UNIX) codegenerator, as // an option. // - Username for library GET files removed to separate file. // - Shortened code paths in certain critical routines; 'rch', // 'read_tag', 'newvec', 'rexp', 'cellwithname', 'out2p', // 'out3p', 'outl'. // E3.0 - Addition of code to drive Z80 codegenerator, as an option. // - Addition of code to generate 'ENDPROC' OCODE, with argument // of zero for the time being. // - 'target_bitsperword', 'backstack_', 'minselectoroffset' and // 'maxselectoroffset' made variables whose values depend on // the codegenerator selected. // - Addition of code to limit space allocated for tree, thus // avoiding stack overflow if a ridiculous value is given. // - Addition of code to produce 's.endfor' OCODE (instead of // 's.le' and 's.jt') at the end of FOR loops. // - Addition of code to support the byte selection operator // (%). // E3.1 - Addition of handcoded version of critical routine // 'cellwithname'. // E4.0 - Removal of underline as an alternative assignment operator. // - Underline now allowed in identifiers, in addition to dot. // - Addition of ABS operator. // - Addition of '{' and '}' as alternatives to '$(' and '$)'. // E4.1 - Relational and conditional operators now accepted in // constant expressions. // - ABS operator now used in 'evalconst' and constant folder. // E5.0 - EXTERNAL declarations extended to allow an optional second // name (as a BCPL string) so that different 'internal' and // 'external' names may be used. // - Calls to 'getbyte' and 'putbyte' replaced by use of the '%' // operator. // E5.1 - More efficient method used for initialising symbol table. // E5.2 - Correction to alter the precedence of the ABS operator; new // precedence is the same as that of unary minus. // E5.3 - Values for 'precallsize' and 'savespacesize' set during // selection of codegenerator. // E5.4 - Addition of option for system jump table address when // compiling for Zilog Z80. // E5.5 - Correction to code for CASE labels, to handle CASE vector // overflow correctly. // - Correction to 'addname', to handle name vector overflow // correctly. // - Correction to 'declstat', to handle global name vector // overflow correctly. // E5.6 - Correction to constant folder; function 'type.manifest' had // a missing '!' causing MANIFEST constants not to be // recognised. // - Addition to constant folder, to ensure that non-commutative // operations involving MANIFEST operands are folded. // Previously, they were not. // - Corrections to constant folder and 'evalconst', to detect // division by zero at compile time. // E5.7 - Correction to 'synreport', to ensure that 'sysout' is // selected before a message is output. This is necessary // because 'synreport' can be called during output of OCODE // (by the tree folder). // E5.8 - Name of 'seek' altered to 'seek.item' to avoid clash with // new library routine 'seek'. // E5.9 - Further correction to 'synreport' to insert missing // correction intended in E5.7. // E5.10 - Addition of code to drive M68000 code generator, as an // option. // E5.11 - Minor modifications to assignment of 'savespacesize' and // 'charcode'. // E6.0 - 'charcode' reset to 'host_code' while reading GET strings. // - Removal of GOTOs from 'nextsymb'. // - Improved code in 'nextsymb' for reading based numbers after // '#'. // - Correction to string reading code in 'nextsymb', to use // 'charcode' function for translation. // - Removal of '<>' construction (binding semicolon); not part // of BCPL standard. // - Modification to 'trans', to generate BLAB OCODE for a BCPL // label; this aids some code generators. New supporting // routine 'compblab' also added. // - Layout of 'trans' cleaned up considerably; GOTOs removed // and RETURNs altered to BREAKs. // - 'transdyndefs' and 'transstatdefs' modified to reduce // recursion and thereby reduce usage of stack space and time. // - 'evalconst' substantially altered to reduce its size. // - 'compentry' altered to use 'charcode' for procedure names // put into output OCODE. // - Improved code in 'nextsymb' for handling strings and // character constants, including *Xnn and *Onnn // constructions. // - Revised code in 'nextsymb' for reading comments. // E7.0 - Compilation option flag 'F' withdrawn; this is now the // default anyway. // - Source code generally tidied up to make it more readable. // - Manifest constants now used for size of items stacked on a // GET, and for size of the circular input trace buffer. // - Error messages renumbered to make them a dense, low // numbered set. // - Some error messages made more meaningful. // - 'performget' renamed to 'pushget'; code in 'nextsymb' which // handles end of file in GET files removed to new routine // 'popget'. // - 'nextsymb' modified to handle comments of the form |*...*|. // - Addition of routine 'rnexp' to replace many calls on // 'nextsymb' and 'rexp'. // - 'rexp' extensively modified to correct treatment of n-way // relationals, and to remove GOTOs. // - DEFAULT labels inside inner blocks now faulted in the same // way as CASE labels. // - Correction to error reporting of CASE and DEFAULT labels // which are not inside SWITCHONS; previously, the same error // was given twice. // - Most recursion removed from 'declnames', 'rdblockbody', // 'decldyn', 'nolabels' and 'scanlabels'. // - 'statdefs' routine replaced by a single 'statdefs_' flag. // - 'transfor' modified to eliminate redundant forward jump if // the loop is guaranteed to execute at least once. // - 'compblab' renamed to 'complabx'; 's.blab' renamed to // 's.labx'. 's.labx' now compiled for CASE and DEFAULT // labels in addition to proper labels. // - Addition of 'complabr' routine and 's.labr' OCODE. This is // compiled for all jumps that may be backwards or forwards // (apart from 's.labx' labels). All other labels are always // referenced forward, so codegenerators may use this // information to aid optimisation. // - Code for IF, UNLESS and TEST improved when the controlled // statement is a single LOOP, BREAK or ENDCASE. // (this code commented out pending improvement to OCODE). // - 'checkdistinct' now called at the end of GLOBAL, EXTERNAL, // STATIC and MANIFEST declarations; previously, no proper // check was made for multiple declarations. // - 'decllabels' renamed to 'transblock', and 'trans' call // incorporated into it. // - 's.mark' OCODE introduced; generated instead of 's.stack' // when reserving save space before loading parameters for a // procedure call. // - Addition of 'makelist' function to build variable size tree // nodes, in order to save space; modification of many other // routines to handle this. // - Addition of code to drive VAX-11 (VMS) codegenerator, as an // option. // - Addition of 'multichar' routine, to simplify lexical // analysis of multi-character symbols. // - Addition of preset tree nodes 'zeronode' and 'querynode', // to save some unnecessary duplication of these heavily used // values. // - Change in treatment of 'small' numbers, so that they are // represented by themselves in the tree, instead of by a // pointer to an 's.number' node. The meaning of 'small' is // machine dependent. // - 's.segend' and 's.setgl' OCODEs now emitted for some // codegenerators, instead of 's.global'. // - 'Tree size ...' message now includes amount of remaining // space. // - 'plist' now uses a vector instead of a table to record the // output state. // - Addition of 'report' routine (and other changes and // rearrangements), to make main code more machine // independent. // - Undeclared names now declared as global 0 to reduce // unwanted error messages. // E7.1 - Addition of code to drive 2900 (VME) codegenerator, as an // option. // - Minor correction to 'rbexp', to cater for small negative // constants correctly. // - Minor correction to 'trans', to handle small constants in // MANIFEST declarations correctly when checking for // selectors. // E7.2 - 'charcode' now set to 'host_code' for 2900 (VME) // compilations. // E7.3 - Correction to constant folder in 'recast_subtree'. // E7.4 - Correction to forbid CASE labels in enclosed FOR loops as // well as in enclosed blocks. // E7.5 - Correction to 'formtree' and 'rdextdefs' in handling of // different host character codes. // E7.6 - Removal of Subsystem error codes from SYNHDR (now in // SYSHDR). // E7.7 - Correction to PP debugging code. SECTION "ICL9CEZBCPL1" MANIFEST $( // Alter these if changes are made version = 7 // Major version number edit = 7 // Edit number within major version $) /* Stop codes:- 0 - Successful compilation 1-999 - Corresponding Subsystem error 1000 - Compiler error 1001 - Compilation failed 1002 - Compiler error */ GET "BCPL1_SYNHDR" // Bits in COMREG(27) MANIFEST $( cr.nolist = #X00000002 // Disable listing cr.xref = #X00000800 // Enable cross-reference $) // Parameter decoder error codes MANIFEST $( par.ok = 0 // No errors par.err = -320 // Format error par.amb = -321 // Ambiguous keyword par.unk = -322 // Unknown keyword par.xs = -323 // Too many parameters par.dup = -324 // Duplicated parameter par.mis = -325 // Missing keyword $) EXTERNAL $( icl9cezbcpl2 // Entry point of 2900 (EMAS) code generator icl9cezbcplv // Entry point of VAX-11 (UNIX) code generator icl9cezbcplz // Entry point of Z80 code generator icl9cezbcplw // Entry point of M68000 code generator icl9cezbcplr // Entry point of VAX-11 (VMS) code generator icl9cezbcplq // Entry point of 2900 (VME) code generator icl9cezbcplx // Entry point of cross-reference program changecontext // System call to lose pages from working set $) STATIC $( options= ?; parptr = ?; parleng = ?; param_pos = ? $) MANIFEST $( keymax = 7 $) LET start() BE $( LET keys = VEC keymax AND defaults = VEC keymax AND opt = VEC maxstrlength/bytesperword + 2*keymax AND comreg27 = comreg!27 AND treesize = ? AND deleteocode_ = TRUE AND null = "" AND res = ? AND jtstring = VEC 6/bytesperword // Set default options xref_ := (comreg27 & cr.xref) NE 0 inhibitgen_, domapstore_ := FALSE, FALSE ppdebug_, pptrace_ := FALSE, FALSE prsource_ := (comreg27 & cr.nolist) = 0 treelist_, enablecode_, noget_, fold_const_ := FALSE, FALSE, FALSE, TRUE treesize, dvect, globdeclt, caset := 8000, 2400, 100, 150 reportmax, total_reports, syntax_errors_ := maxreports, 0, FALSE codegen := cg.emas2900 jtstring%0 := 0 // Set to null string GET "BCPL1_LIBUSER" // Define default username for library GET files options := opt errorstream_ := comreg!40 GE 0 comreg!47 := 0 // Initialise number of statements/faults keys!0 := keymax keys!1 := "FLAGS" ; defaults!1 := null keys!2 := "OCODE" ; defaults!2 := 0 keys!3 := "LOCODE" ; defaults!3 := null keys!4 := "GLOBSIZE" ; defaults!4 := null keys!5 := "WORKSIZE" ; defaults!5 := null keys!6 := "XSIZE" ; defaults!6 := null keys!7 := "XALL" ; defaults!7 := "NO" writef("*N*N*N University of Kent BCPL compiler - version E%N.%N*N*N*N*N", version, edit) param := comreg!9 >> 2 // Pick up auxiliary parameters IF param%0 = 1 & param%1 = '?' THEN $( selectoutput(journal) writes("Parameters are:-*N") FOR i = 1 TO keymax DO $( writes(keys!i) IF defaults!i NE 0 THEN writef("=%S", defaults!i) UNLESS i = keymax DO wrch(',') $) newline() stop(0) $) paramdecode(keys, options) FOR i = 1 TO keymax DO IF options!i = 0 THEN options!i := defaults!i IF options!0 < 0 THEN stop(ABS(options!0)) real_rdch := rdch param_pos := 1 $( rdch := s_rdch // Takes input from FLAGS string $( ch := rdch() sw:SWITCHON ch INTO $( CASE endstreamch: BREAK CASE'*S': CASE'*N': ENDCASE CASE 'P': ppdebug_ := TRUE; ENDCASE CASE 'T': treelist_ := TRUE; ENDCASE CASE 'M': domapstore_ := TRUE; ENDCASE CASE 'N': noget_ := TRUE; ENDCASE CASE 'C': enablecode_ := TRUE; ENDCASE CASE 'E': pptrace_ := TRUE; ENDCASE CASE 'L': treesize := readn() IF treesize > maxtreesize THEN $( selectoutput(journal) writef("Warning - L flag has invalid value - %N assumed*N", maxtreesize) selectoutput(sysout) treesize := maxtreesize $) ch := terminator GOTO sw CASE 'A': reportmax := readn() ch := terminator GOTO sw CASE 'U': fold_const_ := FALSE; ENDCASE CASE 'O': inhibitgen_ := TRUE; ENDCASE CASE 'V': codegen := cg.vaxunix; ENDCASE CASE 'I': codegen := cg.emas2900; ENDCASE CASE 'W': codegen := cg.m68k; ENDCASE CASE 'R': codegen := cg.vaxvms; ENDCASE CASE 'Q': codegen := cg.vme2900; ENDCASE CASE 'Z': codegen := cg.z80 ch := rdch() IF ch = ':' THEN $( FOR i = 3 TO 6 DO jtstring%i := rdch() jtstring%0 := 6 // Always 6 bytes jtstring%1 := '#' jtstring%2 := 'X' FOR i = 3 TO 6 DO $( LET c = jtstring%i UNLESS '0' LE c LE '9' \/ 'A' LE c LE 'F' DO $( selectoutput(journal) writef("Warning - invalid value for *'Z*' flag*N") selectoutput(sysout) BREAK $) $) ch := rdch() options!3 := jtstring $) GOTO sw CASE 'D': dvect := readn() ch := terminator GOTO sw CASE 'G': globdeclt := readn() ch := terminator GOTO sw CASE 'K': caset := readn() ch := terminator GOTO sw DEFAULT : selectoutput(journal) writef("Warning - flag *'%C*' not recognised*N", ch) selectoutput(sysout) $) $) REPEAT rdch := real_rdch // Restore 'rdch' $) TEST comreg!46 NE 0 THEN // Connect address of source file $( sourceconad := comreg!46 >> 2 rdch := con_rdch source_ptr := sourceconad!1 // Length of header sourcestream := -1 // Dummy value $) OR $( sourceconad := 0 sourcestream := sysin prompt("BCPL: ") $) // Set up OCODE file TEST options!2 = 0 THEN // No file specified options!2 := "T#OCODE" // Use temporary file OR deleteocode_ := FALSE ocode := findoutput(options!2) IF ocode < 0 THEN ioerror(ocode, options!2) set_target_options(codegen) aptovec(comp, treesize) IF domapstore_ THEN mapstore() advise("Phase 1 complete*N") IF total_reports NE 0 THEN writef("*NProgram contains %N fault%S*N", total_reports, total_reports = 1 -> "", "s") selectoutput(ocode) endwrite() comreg!47 := total_reports close() // Close all files, since run-time system is shared IF xref_ THEN TEST syntax_errors_ THEN writes("*NCross-reference abandoned due to syntax errors*N") OR $( LET m = VEC maxstrlength/bytesperword + 1 encode(".COMPILER,,,%S,%S", m, options!6, options!7) changecontext() // Throw out compiler pages res := icl9cezbcplx(#X18000100, m << 2) // Call cross-reference program IF 0 NE res < 1000 THEN $( selectoutput(sysout) writef("Cross-reference fails - %S*N", ssmessage(res, 0)) $) $) TEST (total_reports NE 0) \/ inhibitgen_ THEN res := total_reports = 0 -> 0, 1001 OR $( LET m = VEC maxstrlength/bytesperword + 1 encode("%S,%S,%S,%S", m, options!2, options!3, options!4, options!5) changecontext() // Throw out compiler pages comreg!9 := 0 // Indicate compiler call to codegenerator m := m << 2 TEST codegen = cg.emas2900 THEN res := icl9cezbcpl2(#X18000100, m) // Call 2900 codegenerator OR TEST codegen = cg.vaxunix THEN res := icl9cezbcplv(#X18000100, m) // Call VAX-11 (UNIX) codegenerator OR TEST codegen = cg.z80 THEN res := icl9cezbcplz(#X18000100, m) // Call Z80 codegenerator OR TEST codegen = cg.m68k THEN res := icl9cezbcplw(#X18000100, m) // Call M68000 codegenerator OR TEST codegen = cg.vaxvms THEN res := icl9cezbcplr(#X18000100, m) // Call VAX-11 (VMS) codegenerator OR res := icl9cezbcplq(#X18000100, m) // Call 2900 (VME) codegenerator $) IF deleteocode_ THEN deletefile(options!2) stop(res) $) AND set_target_options(codegen) BE $( SWITCHON codegen INTO $( CASE cg.emas2900: target_bitsperword := 32 minselectoroffset := -262144 maxselectoroffset := 262143 backstack_ := FALSE precallsize := 9 savespacesize := 2 charcode := host_code globlist_ := TRUE ENDCASE CASE cg.vme2900: target_bitsperword := 32 minselectoroffset := -262144 maxselectoroffset := 262143 backstack_ := FALSE precallsize := 9 savespacesize := 2 charcode := host_code globlist_ := TRUE ENDCASE CASE cg.vaxunix: target_bitsperword := 32 minselectoroffset := -262144 maxselectoroffset := 262143 backstack_ := TRUE precallsize := 9 savespacesize := 2 charcode := host_code globlist_ := TRUE ENDCASE CASE cg.vaxvms: target_bitsperword := 32 minselectoroffset := -262144 maxselectoroffset := 262143 backstack_ := FALSE precallsize := 9 savespacesize := 2 charcode := host_code globlist_ := FALSE ENDCASE CASE cg.z80: target_bitsperword := 16 minselectoroffset := -32768 maxselectoroffset := 32767 backstack_ := FALSE precallsize := 9 savespacesize := 2 charcode := host_code globlist_ := TRUE ENDCASE CASE cg.m68k: target_bitsperword := 32 minselectoroffset := -262144 maxselectoroffset := 262143 backstack_ := FALSE precallsize := 9 savespacesize := 3 charcode := host_code globlist_ := TRUE ENDCASE $) $) AND s_rdch() = VALOF // Read from FLAGS string $( IF param_pos > (options!1)%0 RESULTIS endstreamch param_pos := param_pos + 1 RESULTIS (options!1)%(param_pos - 1) $) AND con_rdch() = VALOF // Special routine to read from clean source file $( IF source_ptr GE !sourceconad RESULTIS endstreamch $( LET c = sourceconad%source_ptr source_ptr := source_ptr + 1 RESULTIS c $) $) AND iocp(ep, n) BE $( EXTERNAL $( s.iocp $) s.iocp(ep, n) $) AND e_wrch(c) = VALOF // Write to error stream $( LET o = comreg!23 // Current output channel iocp(9, comreg!40) // SELECT OUTPUT(errors) iocp(5, c) // PRINTCH(C) iocp(9, o) // SELECT OUTPUT(O) RESULTIS 0 $) AND ioerror(ecode, file) BE $( EXTERNAL $( s.setfname $) LET mes = VEC maxstrlength/bytesperword + 1 FOR i = 0 TO file%0 DO mes%i := file%i s.setfname(#X18000100, mes << 2) stop(ABS(ecode)) $) AND advise(m, a, b, c) BE writef(m, a, b, c) AND host_code(ch) = ch AND ebcdic_code(ch) = astoeb%ch AND report(mes, a, line, info, infopar) BE $( LET o = output() AND o_wrch = wrch reportcount := reportcount + 1 selectoutput(sysout) FOR i = 0 TO 1 DO $( writes("*N** ") writef(mes, a) writef(" near line %N*N", line) info(infopar) IF reportcount GE reportmax THEN writes("Abort*N") UNLESS errorstream_ BREAK wrch := e_wrch $) wrch := o_wrch selectoutput(o) IF reportcount GE reportmax THEN longjump(abort_p, abort_l) $) AND encode(format, dest, a,b,c,d,e,f,g,h,i,j,k) BE $( STATIC $( dvec = ?; dpt = ? $) LET ewrch(ch) = VALOF $( dpt := dpt + 1 dvec%dpt := ch RESULTIS 0 $) AND oldwrch = wrch wrch := ewrch dvec, dpt := dest, 0 writef(format, a,b,c,d,e,f,g,h,i,j,k) dvec%0 := dpt wrch := oldwrch $) AND paramdecode(keys, pars) BE $( LET pmax, pnum = keys!0, 1 LET wksp, pn = pars + pmax + 1, ? FOR i = 0 TO pmax DO pars!i := 0 parptr := 0 parleng := param%0 $( LET c = getpar(wksp) pn := (c NE '=') -> pnum, VALOF $( LET n = findkey(keys, wksp) c := getpar(wksp) RESULTIS n $) pars!0 := VALOF $( LET l = wksp%0 IF c = '=' RESULTIS par.err IF pn = -1 RESULTIS par.amb IF pn = -2 RESULTIS par.mis IF pn = 0 RESULTIS par.unk IF pn > pmax RESULTIS par.xs IF l = 0 RESULTIS par.ok IF pars!pn NE 0 RESULTIS par.dup pars!pn := wksp wksp := wksp + l/bytesperword + 1 RESULTIS par.ok $) UNLESS pars!0 = par.ok RETURN IF c = endstreamch RETURN pnum := pnum + 1 $) REPEAT $) AND getpar(wksp) = VALOF $( LET c, spcnt = ?, 0 AND inpr, length = FALSE, 0 $( c := getch(param) SWITCHON c INTO $( CASE endstreamch: CASE ',': CASE '=': wksp%0 := length RESULTIS c CASE '*S': spcnt := spcnt + 1 ENDCASE DEFAULT: TEST inpr THEN FOR i = 1 TO spcnt DO $( length := length + 1 wksp%length := '*S' $) OR inpr := TRUE spcnt := 0 length := length + 1 wksp%length := c $) $) REPEAT $) AND findkey(keys, wksp) = VALOF $( LET f = 0 IF wksp%0 = 0 RESULTIS -2 // Missing keyword FOR i = 1 TO keys!0 DO $( IF matchstrings(wksp, keys!i) DO $( UNLESS f = 0 RESULTIS -1 f := i $) $) RESULTIS f $) AND matchstrings(a, b) = VALOF $( LET l = a%0 IF b%0 < l RESULTIS FALSE FOR i = 1 TO l DO UNLESS a%i = b%i RESULTIS FALSE RESULTIS TRUE $) AND getch(str) = VALOF $( parptr := parptr + 1 RESULTIS parptr > parleng -> endstreamch, str%parptr $) . GET "BCPL1_SYNHDR" LET pushget() BE $( LET user_quoted_ = ? AND savecharcode = charcode charcode := host_code nextsymb() charcode := savecharcode UNLESS symb = s.string DO synreport(5) IF noget_ RETURN IF getp GE gett THEN $( LET o_wrch = wrch FOR i = 0 TO 1 DO $( writef("*NGET file *'%S*' nested too deep*N", wordv) UNLESS errorstream_ BREAK wrch := e_wrch $) wrch := o_wrch // Restore previous output stop(1001) $) getv!getp := sourcestream getv!(getp + 1) := linecount getv!(getp + 2) := source_ptr getv!(getp + 3) := sourceconad getv!(getp + 4) := ch getp := getp + getitemsize linecount := 1 sourcestream := findinput(wordv) user_quoted_ := VALOF $( FOR i = 1 TO wordv%0 DO IF wordv%i = '.' RESULTIS TRUE RESULTIS FALSE $) IF sourcestream = -e.fnf THEN UNLESS user_quoted_ DO // File not found - try in library if no username given $( LET ulen = libuser%0 AND v = VEC maxstrlength/bytesperword + 1 FOR i = 1 TO ulen DO v%i := libuser%i FOR i = 1 TO wordv%0 DO v%(ulen + i) := wordv%i v%0 := ulen + wordv%0 sourcestream := findinput(v) $) IF sourcestream < 0 THEN ioerror(sourcestream, wordv) selectinput(sourcestream) rdch := con_rdch // In case primary input is not a file sourceconad := getconad(sourcestream) IF sourceconad LE 0 \/ sourceconad!3 NE 3 THEN // Not a character file ioerror(e.ift, wordv) source_ptr := sourceconad!1 // Length of header rch() $) AND popget() BE $( endread() getp := getp - getitemsize sourcestream := getv!getp selectinput(sourcestream) linecount := getv!(getp+1) source_ptr := getv!(getp+2) sourceconad := getv!(getp+3) ch := getv!(getp+4) IF sourceconad = 0 THEN rdch := real_rdch // Primary input is not a file $) AND smallnumber(n) = 0 < n <= 255 // End of file BCPL1_MAINSRC