home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 1 / ARM_CLUB_CD.iso / contents / apps / languages / progs / bcpl / b / root < prev    next >
Encoding:
Text File  |  1988-01-20  |  16.3 KB  |  663 lines
  1. SECTION "BCPL"
  2.  
  3. GET "b.Header"
  4.  
  5. STATIC {
  6. // Version of 28 Feb 86 11:51:01
  7.    dummy = VersionMark
  8.    version = 1*256+2 };
  9.  
  10. LET Start() BE {
  11.    LET oldOutput = Output()
  12.    LET mark.syntrn = VEC mk.size-1
  13.  
  14.    streams := 0
  15.    workVectors := 0
  16.    verStream := oldoutput
  17.    ocodeStream := 0
  18.  
  19.    // Initialise the world and decode arguments: this routine sets up
  20.    // the 'primal.mark' used in opening streams.
  21.  
  22.    cg := bcpl.args(mark.syntrn)
  23.  
  24.    TEST sourceStream~=0 THEN {
  25.       LET keeptags = tagChain
  26.  
  27.       {  LET mark = VEC mk.size-1
  28.      LET a      = ?
  29.      MarkHeap(mark)
  30.  
  31.      // The 'ocode.mark' is used when store for OCODE buffers is
  32.      // allocated: these are held AFTER the mark on the chain, and so
  33.      // will not be released until the heap is reset to the mark made
  34.      // above, after the CG phase.    The heap is reset to 'ocode.mark'
  35.      // after the SYN and TRN phases, thus freeing the tree and
  36.      // declaration space.
  37.  
  38.      ocode.mark := GetBlk(mk.size)
  39.      MarkHeap(ocode.mark)
  40.  
  41.      SelectOutput(verStream)
  42.  
  43.      a := bcpl.syn()
  44.      IF a=0 | rc>=20 THEN BREAK
  45.  
  46.      WriteF("Tree size %N*N", space.used-mk.used!mark)
  47.  
  48.      IF printTree THEN bcpl.ptree(a)
  49.  
  50.      IF bcpl.trn(a)=0 THEN rc := 20
  51.  
  52.      tagChain := keeptags
  53.      ResetHeap(ocode.mark)
  54.  
  55.      IF (moduleStream~=0 | listStream~=0) & rc<=5 THEN bcpl.cg()
  56.  
  57.      ResetHeap(mark)
  58.       } REPEATUNTIL ch=endStreamch | rc>=20
  59.  
  60.       Close(sourceStream)
  61.       IF ocodeStream~=0 THEN Close(ocodeStream)
  62.  
  63.       SelectOutput(verStream) }
  64.  
  65.    ELSE IF ocodeFile~=0 THEN {
  66.       LET i = Input();
  67.       LET op = ?;
  68.       ocodeStream := Open(ocodeFile, TRUE, FALSE);
  69.       SelectInput(ocodeStream);
  70.       retainOcode := TRUE;
  71.  
  72.       {  ocode.mark := GetBlk(mk.size)
  73.      MarkHeap(ocode.mark)
  74.      ocodeBuf := GetWithMark(oc.size, mark.syntrn)
  75.      ocodeBufs := ocodeBuf
  76.      oc.lastbyte!ocodeBuf := oc.firstbyte
  77.      oc.next!ocodeBuf := 0;
  78.  
  79.      {  LET n = 0;
  80.         op := ReadN();
  81.         IF result2~=0 THEN BREAK;
  82.         Out1(op);
  83.         SWITCHON op INTO {
  84.            DEFAULT:
  85.           ENDCASE
  86.            CASE s.fnap:CASE s.rtap:
  87.            CASE s.lp: CASE s.lg: CASE s.ln: CASE s.ll:
  88.            CASE s.llp:CASE s.llg:CASE s.lll:
  89.            CASE s.sp: CASE s.sg: CASE s.sl:
  90.            CASE s.jump:CASE s.jt:CASE s.jf:CASE s.endfor:
  91.            CASE s.lab: CASE s.res:
  92.            CASE s.stack:CASE s.rstack:CASE s.save:
  93.            CASE s.datalab:CASE s.iteml:CASE s.itemn:
  94.            CASE s.endproc:
  95.            CASE s.linecount: CASE s.argno:
  96.           n := 1; ENDCASE
  97.            CASE s.fconst:
  98.            CASE s.dtab:
  99.           n := 2; ENDCASE
  100.            CASE s.slctap: CASE s.slctst:
  101.           n := 3; ENDCASE
  102.            CASE s.needs:
  103.            CASE s.section:
  104.            CASE s.lstr:
  105.           n := ReadN(); Out1(n); ENDCASE
  106.            CASE s.entry:
  107.           n := ReadN(); Out1(n); n := n+1; ENDCASE
  108.            CASE s.switchon:
  109.           n := ReadN(); Out1(n); n := 2*n+1; ENDCASE
  110.            CASE s.global:
  111.           n := ReadN(); Out1(n); n := 2*n; ENDCASE };
  112.         WHILE n>0 DO { Out1(ReadN()); n := n-1 }
  113.      } REPEATWHILE op~=s.global;
  114.  
  115.      IF oc.lastbyte!ocodeBufs=oc.firstbyte THEN BREAK;
  116.      bcpl.cg();
  117.      ResetHeap(mark.syntrn)
  118.       } REPEAT;
  119.       SelectInput(i);
  120.       Close(ocodeStream) }
  121.  
  122.    ResetHeap(mark.syntrn)
  123.  
  124.    IF moduleStream~=0 THEN Close(moduleStream);
  125.    IF listStream~=0 THEN Close(listStream);
  126.  
  127.    SelectOutput(verStream)
  128.  
  129.    IF rc<=5 THEN
  130.       WriteF("Program size = %N bytes*N", programSize)
  131.  
  132. fail:
  133.    IF (CGDebugMode耀)~=0 THEN MapStore();
  134.    Exit(rc) }
  135.  
  136. AND SmallNumber(x) =  0<x<256 -> TRUE, FALSE
  137.  
  138. AND Exit(rc) BE {
  139.    WHILE streams~=0 DO Close(st.stream!streams)
  140.    WHILE workVectors~=0 DO FreeVector(workVectors+1)
  141.    Stop(rc) }
  142.  
  143. AND Complain(message, a, b, c) BE
  144.   Abandon(0, message, a, b, c)
  145.  
  146. AND Abandon(rc, message, a, b, c) BE {
  147.    SelectOutput(verStream)
  148.    WriteF(message, a, b, c)
  149.    result2 := rc
  150.    NewLine()
  151.    Exit(20) }
  152.  
  153. AND GetVector(size) = VALOF {
  154. // Gets a vector of size (NOT upb) 'size'.
  155.    LET v = GetVec(size)
  156.  
  157.    IF v=0 THEN Complain("ERROR: insufficient free store")
  158.    IF (-1)!v>=0 THEN Complain("GetVec bug")
  159.    !v := workVectors
  160.    workVectors := v
  161.    RESULTIS v+1 }
  162.  
  163. AND GetWithMark(size, mark) = VALOF {
  164. // Allocates a new vector, and adds it to the chain AFTER the given mark.
  165.    LET v  = GetVector(size)-1
  166.    LET vm = mk.vector!mark
  167.  
  168.    workVectors := !v
  169.    !v := !vm
  170.    !vm := v
  171.    RESULTIS v+1 }
  172.  
  173. AND FreeVector(v) BE {
  174.    LET lv.c = @workVectors
  175.    v := v-1
  176.  
  177.    WHILE !lv.c~=0 DO {
  178.       LET v1 = !lv.c
  179.       IF v1=v THEN {
  180.      !lv.c := !v1
  181.      FreeVec(v)
  182.      RETURN }
  183.       lv.c := v1 }
  184.    Complain("BUG: invalid freevector call") }
  185.  
  186. AND GetBlk(size) = VALOF {
  187.    LET p = ?
  188.    IF 2<=size<=free.max THEN {
  189.       p := freeLists!size;
  190.       IF p~=0 THEN {
  191.      freeLists!size := !p;
  192.      RESULTIS p } };
  193.  
  194.    IF heapptr+size>heap.block.size THEN {
  195.    // Allocate 'large' vectors separately, to reduce fragmentation.
  196.       IF size>heap.block.size/4 THEN RESULTIS GetVector(size)
  197.       heap.block := GetVector(heap.block.size)
  198.       heapptr := 0 }
  199.  
  200.    p := heapptr+heap.block
  201.    heapptr := heapptr+size
  202.    space.used := space.used+size
  203.    RESULTIS p }
  204.  
  205. AND MarkHeap(mark) BE {
  206.    mk.vector!mark := workVectors
  207.    mk.block!mark := heap.block
  208.    mk.ptr!mark := heapptr
  209.    mk.used!mark := space.used }
  210.  
  211. AND ResetHeap(mark) BE {
  212.    LET v = mk.vector!mark
  213.  
  214.    WHILE workVectors~=v DO
  215.       FreeVector(workVectors+1);
  216.  
  217.    FOR i = 2 TO free.max DO freeLists!i := 0;
  218.  
  219.    heap.block := mk.block!mark
  220.    heapptr := mk.ptr!mark
  221.    space.used := mk.used!mark }
  222.  
  223. AND FreeBlk(p, size) = VALOF {
  224.    LET res = !p;
  225.    TEST 2<=size<=free.max THEN {
  226.       !p := freeLists!size;
  227.       freeLists!size := p }
  228.    ELSE
  229.       Complain("Bad call to FreeBlk: size = %n", size);
  230.    RESULTIS res }
  231.  
  232. AND FillBlk(n, a, b, c, d, e, f, g, h, i, j, k) = VALOF {
  233.    LET p = GetBlk(n);
  234.    FOR i = 1 TO n DO
  235.       (i-1)!p := i!@n;
  236.    RESULTIS p }
  237.  
  238. AND Open(file, input, binary) = VALOF {
  239.   // The store for the stream object is obtained by using
  240.   // 'getwithmark', quoting the 'primal.mark'.    This is
  241.   // important because the OCODE stream may be opened in the
  242.   // TRN phase, AFTER the tree has been built.    If the
  243.   // normal 'getvector' routine was used, the store for this
  244.   // stream would be freed after the translation was
  245.   // complete.
  246.    LET s = input -> FindInput(file), FindOutput(file)
  247.    IF s~=0 THEN {
  248.       LET str = GetWithMark(st.size, primal.mark)
  249.       LET name = GetWithMark((file%0)/BytesPerWord+1, primal.mark);
  250.       FOR i = 0 TO file%0 DO name%i := file%i;
  251.       st.stream!str := s;
  252.       st.input!str := input;
  253.       st.link!str := streams;
  254.       st.file!str := name;
  255.       streams := str }
  256.    RESULTIS s }
  257.  
  258. AND Close(stream) BE {
  259.    LET lv.str = @streams
  260.    LET str = streams
  261.  
  262.    WHILE str~=0 & stream~=st.stream!str DO {
  263.       lv.str := st.link+str
  264.       str := !lv.str }
  265.  
  266.    IF str=0 THEN Complain("BUG: bad close argument")
  267.    !lv.str := st.link!str
  268.  
  269.    TEST st.input!str THEN {
  270.       LET i = Input()
  271.       SelectInput(stream)
  272.       EndRead()
  273.       IF i~=stream THEN SelectInput(i) }
  274.    ELSE {
  275.       LET o = Output();
  276.       SelectOutput(stream);
  277.       EndWrite();
  278.       IF stampFiles THEN Stamp(st.file!str);
  279.       IF o~=stream THEN SelectOutput(o) }
  280.    FreeVector(st.file!str);
  281.    FreeVector(str) }
  282.  
  283. AND Stamp(name) BE {
  284.    LET params = VEC 3;
  285.    LET dt = VEC 1;
  286.    BinaryTime(dt);
  287.    params!0 := #xffffff00 | (dt!1)
  288.    OSFile(2, name, params);
  289.    params!1 := dt!0;
  290.    OSFile(3, name, params) }
  291.  
  292. AND LookUpTag(string) = VALOF {
  293. // Looks up the tag with the name given by the string,
  294. // creating a new tag object (with value FALSE) if it is
  295. // not found.  The tag object is returned as the result.
  296.    LET t = tagChain
  297.    LET len = string%0
  298.  
  299.    WHILE t~=0 DO {
  300.       IF CompString(string, tag.name+t)=0 THEN RESULTIS t
  301.       t := tag.link!t }
  302.  
  303.    t := GetBlk(tag.name+len/BytesPerWord+1)
  304.    tag.link!t := tagChain
  305.    tagChain := t
  306.    tag.value!t := FALSE
  307.  
  308.    FOR j = 0 TO len DO
  309.       (tag.name+t)%j := string%j
  310.    RESULTIS t }
  311.  
  312. .
  313.  
  314. SECTION "Args"
  315.  
  316. GET "b.Header"
  317.  
  318. MANIFEST {
  319.    argv.upb = 300;
  320.  
  321. // "FROM,TO=OBJ,OCODE/K,OPT/K,VER/K,LIST/K,HDR/K,CHARCODE/K"
  322.  
  323.    a.from =  0
  324.    a.to =  1
  325.    a.ocode =  2
  326.    a.opt =  3
  327.    a.ver =  4
  328.    a.list = 5;
  329.    a.hdr =  6
  330.    a.charcode =  7 }
  331.  
  332. LET bcpl.args(mark) = VALOF {
  333. // Called to initialise the world and decode the arguments
  334. // of the BCPL compiler.  The parameter is a heap mark
  335. // vector which is used before allocating the store that
  336. // is not required after the SYN and TRN phases.
  337. //
  338. // The order of allocation of store is important, and is
  339. // as follows:
  340. //
  341. //     VER stream
  342. //     OCODE file name vector
  343. //     Output code stream
  344. //              ------------- heap marked
  345. //     Others streams and vectors
  346. //     Tag name blocks from option string
  347. //
  348.    LET sssset = FALSE
  349.    LET cg = 0
  350.    LET log = 0
  351.    LET bits = ?
  352.    LET argv = VEC argv.upb
  353.    LET s.front.end = "front end"
  354.    AND s.code.gen = "code generator"
  355.    AND s.not.recog = "not recognised"
  356.    AND s.not.preceded = "not preceded by + or -"
  357.  
  358.    // Initialise storage and stream data: some of the
  359.    // initialisation has been done in the 'main' program.
  360.  
  361.    heapptr := heap.block.size
  362.    space.used := 0
  363.  
  364.    freeLists := GetVector(free.max)-1;
  365.    FOR i = 2 TO free.max DO freeLists!i := 0;
  366.  
  367.    primal.mark := GetBlk(mk.size)
  368.    MarkHeap(primal.mark)
  369.  
  370.    rc := 0
  371.    transchars := FALSE
  372.    lispExtensions := TRUE;
  373.    charCode := 0
  374.    headers := 0
  375.    sourceStream, listStream, moduleStream := 0, 0, 0;
  376.  
  377.    programSize := 0
  378.  
  379.    tagChain := 0
  380.  
  381.    backwardVecs := FALSE;
  382.    printTree := FALSE;
  383.    procNames, naming := TRUE, FALSE;
  384.    callCounting, counting := FALSE, FALSE;
  385.    compactCode, AOFout := TRUE, FALSE;
  386.    rbInCalls := TRUE;
  387.    lispExtensions := TRUE;
  388.    stampFiles := TRUE;
  389.    CGDebugMode, CGOptMode := 0, 1;
  390.  
  391.    restrictedLanguage := FALSE
  392.    extension.level := default.extension.level
  393.    equateCases := TRUE
  394.    retainOcode := TRUE
  395.  
  396.    stkchking := FALSE
  397.  
  398.    // Compute the machine dependent parameters for field
  399.    // selectors.  'bitswidth' is the number of bits in a
  400.    // BCPL cell on the target machine.
  401.  
  402.    bitswidth := 32
  403.    bits := bitswidth-1
  404.    WHILE bits~=0 DO { log := log+1; bits := bits>>1 }
  405.  
  406.    slct.size.shift := bitsperword-log
  407.    slct.shift.shift := slct.size.shift-log
  408.    slct.mask := (1<<log)-1
  409.    slct.max.offset := (1<<slct.shift.shift)-1
  410.  
  411.    IF rdargs("FROM,TO=OBJ,OCODE/K,OPT/K,VER/K,LIST/K,HDR/K,CHARCODE/K",
  412.          argv, argv.upb)=0
  413.       THEN Complain("Bad args")
  414.  
  415.    IF argv!a.ver~=0 THEN {
  416.       verStream := OpenStream(argv!a.ver, FALSE, FALSE)
  417.       SelectOutput(verStream) }
  418.  
  419.    IF argv!a.list~=0 THEN
  420.       listStream := OpenStream(argv!a.list, FALSE, FALSE);
  421.  
  422.    WriteF("ARM BCPL Version %n.%n*N", majorVersion, minorVersion)
  423.  
  424.    IF argv!a.to~=0 THEN
  425.       moduleStream := OpenStream(argv!a.to, FALSE, TRUE)
  426.  
  427.    ocodeFile := argv!a.ocode
  428.    IF ocodeFile~=0 THEN ocodeFile := NewString(ocodeFile)
  429.  
  430.    // The store allocated above will be required for all
  431.    // phases of the compiler; that which is allocted next
  432.    // can be released after all the SYN and TRN phases.
  433.    // Thus the heap is marked now.
  434.  
  435.    MarkHeap(mark)
  436.  
  437.    tag.value ! LookupTag("ARM") := TRUE;
  438.  
  439.    IF argv!a.charcode~=0 THEN {
  440.       LET stream = OpenStream(argv!a.charcode, TRUE, FALSE)
  441.  
  442.       charCode := GetVector(128)
  443.       transchars := TRUE
  444.  
  445.       SelectInput(stream)
  446.  
  447.       FOR i = 0 TO 127 DO charCode!i := ReadCode()
  448.       Close(stream)
  449.       IF rc>0 THEN Complain("Error in CHARCODE table") }
  450.  
  451.    IF argv!a.from~=0 THEN {
  452.       fromfile := NewString(argv!a.from)
  453.       sourceStream := OpenStream(fromfile, TRUE, FALSE) }
  454.  
  455.    IF sourceStream=0 & ocodeFile=0 THEN
  456.       Complain("Nothing to compile")
  457.  
  458.    // OPT parameter
  459.    //
  460.    // Compiler options:
  461.    //
  462.    //    T     print parse tree
  463.    //    R     'restricted' language
  464.    //    C     equate cases
  465.    //    Sn    set savespace size
  466.    //    B     stack grows from high to low addresses -
  467.    //          point vecs at the end, not beginning
  468.    //    Xn    set extension level to n
  469.    //    $tag  set tag to TRUE
  470.    //    $tag' set tag to FALSE
  471.    //    Dn    - ignored -
  472.    //    Ln    - ignored -
  473.    //
  474.    // Code generator options:
  475.    //
  476.    //    C     stack checking
  477.    //    N     procedure names in code
  478.    //    P     profile and call counting
  479.    //    K     call counting
  480.    //    Wn    - ignored -
  481.    //    X-Z   machine dependent
  482.    //
  483.    // To allow for the $ (tag setting) option, options
  484.    // may now be separated by commas.
  485.  
  486.    IF argv!a.opt~=0 THEN {
  487.       STATIC { optp = 0; opts = 0 };
  488.       LET found = FALSE
  489.       LET value = ?
  490.  
  491.       LET rdn(optc, type) = VALOF {
  492.      LET n = 0
  493.      LET ok = FALSE;
  494.      WHILE optp<opts%0 DO {
  495.         LET ch = opts%(optp+1);
  496.         UNLESS '0'<=ch<='9' THEN BREAK;
  497.         optp := optp+1;
  498.         n := n*10 + ch-'0';
  499.         ok := TRUE };
  500.  
  501.      IF ~ok THEN BadOpt(optc, type, "bad numeric argument")
  502.  
  503.      RESULTIS n }
  504.  
  505.       AND GetTag() BE {
  506.       // Called after $ has been found in the front end options.
  507.      LET l = 0
  508.      LET c = ?
  509.      LET v = VEC 255/BytesPerWord
  510.  
  511.      WHILE optp<opts%0 DO {
  512.         c := CapitalCh(opts%(optp+1))
  513.         IF ~['A'<=c<='Z' | '0'<=c<='9'] THEN BREAK
  514.         l := l+1
  515.         optp := optp+1
  516.         v%l := c }
  517.  
  518.      v%0 := l
  519.      TEST l=0 THEN
  520.         WriteS("Bad tag setting option*N")
  521.      ELSE {
  522.         LET t = LookUpTag(v)
  523.         TEST c='*'' THEN {
  524.            tag.value!t := FALSE
  525.            optp := optp+1 }
  526.         ELSE
  527.            tag.value!t := TRUE } }
  528.  
  529.       AND BadOpt(ch, stage, message) BE
  530.      WriteF("Bad %S option *'%C*' - %S*N",
  531.          stage, ch, message)
  532.  
  533.       opts := argv!a.opt;
  534.       optp := 1;
  535.       WHILE optp<=opts%0 DO {
  536.      LET lvOpt = 0
  537.      LET ch = opts%optp
  538.  
  539.      SWITCHON CapitalCh(ch) INTO {
  540.         DEFAULT:  BadOpt(ch, s.front.end, s.not.recog); ENDCASE
  541.         CASE ',': ENDCASE
  542.         CASE '+': value, found := TRUE, TRUE; ENDCASE
  543.         CASE '-': value, found := FALSE, TRUE; ENDCASE
  544.  
  545.         CASE 'B': lvOpt := @backwardVecs; ENDCASE
  546.         CASE 'C': lvOpt := @equateCases; ENDCASE
  547.         CASE 'D': rdn(ch, s.front.end); ENDCASE
  548.         CASE 'H': lvOpt := @naming; ENDCASE
  549.         CASE 'L': lvopt := @lispExtensions; ENDCASE
  550.         CASE 'R': lvOpt := @restrictedLanguage; ENDCASE
  551.         CASE 'S': sssset := TRUE;
  552.               savespacesize := rdn(ch, s.front.end); ENDCASE
  553.         CASE 'T': lvOpt := @printtree; ENDCASE
  554.         CASE 'X': extension.level := rdn(ch, s.front.end); ENDCASE
  555.  
  556.         CASE '$': GetTag(); ENDCASE
  557.         CASE '/': optp := optp+1; BREAK }
  558.  
  559.      optp := optp+1;
  560.      IF lvOpt=0 THEN LOOP
  561.  
  562.      TEST found
  563.         THEN !lvOpt := value
  564.         ELSE BadOpt(ch, s.front.end, s.not.preceded)
  565.  
  566.      lvOpt := 0 }
  567.  
  568.       // Check for code generator options
  569.  
  570.       found := FALSE
  571.  
  572.       WHILE optp<=opts%0 DO {
  573.      LET lvOpt = 0
  574.      LET ch = opts%optp
  575.  
  576.      SWITCHON CapitalCh(ch) INTO {
  577.         DEFAULT:  BadOpt(ch, s.code.gen, s.not.recog); ENDCASE
  578.         CASE ',': ENDCASE
  579.         CASE '+': value, found := TRUE, TRUE; ENDCASE
  580.         CASE '-': value, found := FALSE, TRUE; ENDCASE
  581.  
  582.         CASE 'A': lvOpt := @AOFout; ENDCASE
  583.         CASE 'B': lvopt := @rbInCalls; ENDCASE
  584.         CASE 'C': lvOpt := @stkchking; ENDCASE
  585.         CASE 'D': CGDebugMode := rdn(ch, s.code.gen); ENDCASE
  586.         CASE 'K': lvOpt := @callcounting; ENDCASE
  587.         CASE 'N': lvOpt := @procNames; ENDCASE
  588.         CASE 'O': CGOptMode := RdN(ch, s.code.gen); ENDCASE
  589.         CASE 'P': lvOpt := @counting; ENDCASE
  590.         CASE 'S': lvOpt := @compactCode; ENDCASE
  591.         CASE 'W': rdn(ch, s.code.gen); ENDCASE;
  592.         CASE 'Z': lvOpt := @stampFiles; ENDCASE };
  593.  
  594.      optp := optp+1
  595.      IF lvOpt=0 THEN LOOP
  596.  
  597.      TEST found THEN
  598.         !lvOpt := value
  599.      ELSE
  600.         BadOpt(ch, s.code.gen, s.not.preceded)
  601.      lvOpt := 0 } };
  602.  
  603.    IF ocodeFile~=0 THEN retainOcode := FALSE;
  604.  
  605.    // HDR parameter (if read with /L, the length is given in the first word).
  606.  
  607.    IF argv!a.hdr~=0 THEN
  608.       headers := NewString(argv!a.hdr)
  609.  
  610.    IF sourceStream~=0 THEN {
  611.       SelectInput(sourceStream)
  612.       linecount := 1
  613.       trnlinecount := 1 }
  614.  
  615.    IF ~sssset THEN savespacesize := 4
  616.  
  617.    RESULTIS cg }
  618.  
  619. AND OpenStream(file, input, binary) = VALOF {
  620.    LET s = Open(file, input, binary)
  621.  
  622.    IF s=0 THEN
  623.      Abandon(result2, "Can't open %S for %Sput",
  624.          file, (input -> "in", "out"))
  625.  
  626.    RESULTIS s }
  627.  
  628. AND NewString(s) = s=0 -> 0, VALOF {
  629.    LET l = s%0
  630.    LET v = GetBlk(l / BytesPerWord+1)
  631.    FOR c = 0 TO l DO v%c := s%c
  632.    RESULTIS v }
  633.  
  634. AND ReadCode() = VALOF {
  635.   // Used to read code value for CHARCODE parameter.
  636.   //
  637.   // Value may be:    ooo     octal
  638.   //              :xx     hex
  639.    LET n = 0
  640.    LET ch = ' '
  641.    LET rx = 8
  642.    LET dc = 3
  643.  
  644.    WHILE ch='*S' | ch='*T' | ch='*N' DO ch := rdch()
  645.  
  646.    IF ch=':' THEN {
  647.       rx := 16; dc :=  2; ch := rdch() }
  648.  
  649.    FOR i = 1 TO dc DO {
  650.       LET c = CapitalCh(ch)
  651.       LET d = '0'<=c<='9' -> c-'0',
  652.           'A'<=c<='F' -> c-'A'+10, -1
  653.  
  654.       TEST 0<=d<rx THEN
  655.      n := n*rx+d
  656.       ELSE {
  657.      rc := 10; BREAK }
  658.       ch := rdch() }
  659.  
  660.    IF ~[ch='*S' | ch='*T' | ch='*N'] THEN rc := 10
  661.    unrdch()
  662.    RESULTIS n }
  663.