TP3/shell/CompilerIO.mod

IMPLEMENTATION MODULE CompilerIO ;

(* Standard-procedure dispatch: WRITE/WRITELN/READ, CRT, files, strings,
   sets, reals, heap and DOS calls.  The parser hands IoCall the builtin's
   symbol index; each argument is parsed and loaded here so the runtime gets
   a value, never a descriptor. *)

FROM SYSTEM IMPORT BYTE ;

FROM CompilerShared IMPORT AposC, ArrRec, BI_Abs, BI_Arctan, BI_Assign,
                          BI_BlockRead, BI_BlockWrite, BI_Chr, BI_Close,
                          BI_ClrEol, BI_ClrScr, BI_Concat, BI_Copy, BI_Cos,
                          BI_Delay, BI_Delete, BI_Dispose, BI_Eof, BI_Erase,
                          BI_Exp, BI_FilePos, BI_FileSize, BI_FillChar,
                          BI_GetDir, BI_GotoXY, BI_Halt, BI_Insert, BI_Int,
                          BI_Intr, BI_IoResult, BI_KeyPressed, BI_Length,
                          BI_Ln, BI_LowVideo, BI_Move, BI_Msdos, BI_New,
                          BI_NormVideo, BI_Ofs, BI_Ord, BI_Pos, BI_Pred,
                          BI_Random, BI_Randomize, BI_Read, BI_ReadLn,
                          BI_Rename, BI_Reset, BI_Rewrite, BI_Round, BI_Seek,
                          BI_Seg, BI_Sin, BI_SizeOf, BI_Sqr, BI_Sqrt, BI_Str,
                          BI_Succ, BI_Trunc, BI_UpCase, BI_Val, BI_Write,
                          BI_WriteLn, CodeMax, CrtCaret, CrtClr, CrtDelay,
                          CrtDh, CrtDl, CrtEol, CrtKey, CrtLow, CrtNorm,
                          DataStart, DirRec, ECompOvf, EConstRange, EFileNF,
                          EInclNest, EIoHere, EMemOvf, ENoLib, ENoSemi,
                          EPointExp, ERes, ESimpType, ETypeErr, EUnknown,
                          EntSize, Err, FileVarSize, FldRec, KBuiltin,
                          KConst, KFunc, KLabel, KProc, KType, KVar, MaxArrs,
                          MaxCode, MaxFields, MaxLine, MaxName, MaxPatch,
                          MaxPend, OK, OpAdd, OpDiv, OpMul, OpShl, OpShr,
                          OpSub, PatchRec, PendRec, TArray, TBool, TChar,
                          TEnum, TFile, TNone, TPtr, TReal, TRecord, TScalar,
                          TSet, TString, TText, TU_BlockRead, TU_BlockWrite,
                          TU_CmpStr, TU_Erase, TU_FileAssign, TU_FileClose,
                          TU_FileEof, TU_FilePos, TU_FileRdln, TU_FileRdtok,
                          TU_FileReadln, TU_FileReset, TU_FileRewrite,
                          TU_FileSize, TU_FillChar, TU_GetDir, TU_Halt,
                          TU_HeapNew, TU_InitMem, TU_IntFmt, TU_IntFmtW,
                          TU_IoResult, TU_IoStore, TU_MemCopy, TU_Move,
                          TU_Msdos, TU_ProgEnd, TU_Random, TU_Randomize,
                          TU_RdBool, TU_RdByte, TU_RdChar, TU_RdInt, TU_RdLn,
                          TU_RdStr, TU_RealAbs, TU_RealAdd, TU_RealArctan,
                          TU_RealCmp, TU_RealCos, TU_RealDiv, TU_RealExp,
                          TU_RealFmt, TU_RealFromInt, TU_RealIntFunc,
                          TU_RealLn, TU_RealMul, TU_RealSin, TU_RealSqrt,
                          TU_RealSub, TU_RealToInt, TU_RealVal, TU_RealWrite,
                          TU_Rename, TU_RunErr, TU_Seek, TU_SetCmp,
                          TU_SetCopy, TU_SetOp, TU_SetSingle, TU_StackChk,
                          TU_StrCat, TU_StrCopy, TU_StrDelete, TU_StrFmtW,
                          TU_StrIndex, TU_StrInsert, TU_StrPos, TU_StrStore,
                          TU_ValInt, TU_ValReal, TU_WrBool, TU_WrBoolW,
                          TU_WrChar, TU_WrCharW, TU_WrInl, TU_WrInt,
                          TU_WrIntW, TU_WrLn, TU_WrReal, TU_WrStr, TU_WrStrW,
                          TUntyp, TkAbsolute, TkAnd, TkArray, TkBegin,
                          TkCase, TkConst, TkDiv, TkDo, TkDownto, TkElse,
                          TkEnd, TkExit, TkExternal, TkFile, TkFor,
                          TkForward, TkFunction, TkGoto, TkIf, TkIn, TkLabel,
                          TkMod, TkNil, TkNone, TkNot, TkOf, TkOr, TkOverlay,
                          TkPacked, TkProcedure, TkProgram, TkRecord,
                          TkRepeat, TkSet, TkString, TkText, TkThen, TkTo,
                          TkType, TkUntil, TkVar, TkWhile, TkWith, abortFac,
                          arrTop, arrs, brkN, brkSave, callScratch, caseJmp,
                          caseN, cbuf, codeSz, constBlob, crtAttrOff,
                          curIsFunc, curProc, curStaticOff, dataBase, dataSz,
                          dc, dirs, entRel, enumHi, enumLo, errNum, exitCnt,
                          exitPatch, fields, fldTop, hdrCS, hdrDS, hdrFlag,
                          hdrHeap, hdrMax, imgReady, lblHi, lblJmp, lblLo,
                          locBytes, locFree, loopTy, nPatch, nPend,
                          newArrIdx, parmOff, patches, pc, pend, prologAt,
                          recFldFirst, recFldLast, resultIsReal,
                          resultPtrOff, resultVar, rtSz, srcPos, tmpA, tmpB,
                          txerrPos, varspc, withBoff, withFF, withFL,
                          withIdx, withIsDI, withN, withSlot ;
FROM CompilerEmit IMPORT AddPatch, Ebyte, EmAddAxCx, EmAndAxCx, EmBpDisp,
                          EmBxDisp, EmCall, EmCmpAxCx, EmCmpAxi, EmDecAx,
                          EmIDivAxCx, EmIncAx, EmJcc, EmJmpNear, EmLdBxBx,
                          EmLeaDiBx, EmLoadVarBx, EmMovAh0, EmMovAxCx,
                          EmMovAxDx, EmMovAxSp, EmMovAxi, EmMovBpSp,
                          EmMovBxBp, EmMovChAl, EmMovChImm, EmMovCxSp,
                          EmMovCxi, EmMovDxAx, EmMovDxBp, EmMovDxBx,
                          EmMulAxCx, EmNegAx, EmNotAx, EmOrAxAx, EmOrAxCx,
                          EmPopAx, EmPopBx, EmPopCx, EmPopDx, EmPopSi,
                          EmPushAx, EmPushBx, EmPushCx, EmPushDx, EmRelSetcc,
                          EmSetcc, EmStoreVarBx, EmSubAxCx, EmXchgAxCx,
                          EmXorAl01, EmXorAxAx, Eword, JccShort, JccShortInv,
                          PatchWord, ResolvePatches, SetPatTgt ;
FROM CompilerSource IMPORT CurCh, ExpandIncludes, GetCh, PeekAhead,
                          SetSourcePath, Upper, inclActive, inclEnd, srcLen ;
FROM CompilerUtil IMPORT Alpha, AlphaNum, BitAnd, BitNot, BitOr, CopyStr,
                          Digit, DropB, DropC, DropCh, IsHexCh, NameEq,
                          NumToName, W16 ;
FROM CompilerSymbols IMPORT CopyWord, DupTest, HideLocals, MaxSym, NewSym,
                          SaveWord, Search, SymEntry, lexnest, symTop,
                          symtab, wrd ;
FROM CompilerLex IMPORT DeclaresProc, ExpectDelim, GetWord, HexVal, InitKeys,
                          IsBlank, KwAhead, MatchAssign, MatchDelim,
                          MatchKey, MatchRange, PeekKw, RdConst, RdIntConst,
                          Skip, StrNew, StrPut, WddTok, rdStrX, strCnt,
                          strLen, strOff, strPool, strTop ;
FROM CompilerExpr IMPORT AddPend, AllocSetScratch, BinOpEmit, ConstAdd,
                          ConstCmp, ConstMul, ConstSub, EmAsciiZLiteral,
                          EmCallMost, EmCopyRealTo, EmPushRealAddr,
                          EmPushRealSlot, EmPushSetAddr, EmPushStrAddr,
                          EmPushStrOperand, EmPushStrSlot, EmSetBlob,
                          EmStrBlob, EmXchgAxDx, EmitBoundsCheck, FoldSetIn,
                          IntToMbf, IsCharArray, LoadAtom, LoadPair,
                          MaterializeDyn, NewScratchReal,
                          NewScratchRealBlock, NewScratchStr, NewScratchWord,
                          ParmIsVar, ParmSlot, ParseAdd, ParseAtom,
                          ParseCall, ParseCallArgs, ParseCmp, ParseExpr,
                          ParseMul, ParseNeg, ParseSub, ParseVar, RdSetBase,
                          RdSetLiteral, RealBin, RealOperand, RealUnary,
                          SaveLeft, SetBinEmit, SetPairSize, SetRangeBits,
                          StrConcat, StrOperand, VarSize, WithLookup ;
FROM Compiler IMPORT Assignment, BoundsOf, CodeByteAt, CodeBytes, Compile,
                          Compound, DataBase, DataBytes, DefBuiltins,
                          DefConst, DefLabelPart, DefPart, DefType, DefVar,
                          EmAddBxAx, EmAddDiAx, EmAddDiImm, EmAddSp,
                          EmAndAlDl, EmAndAlImm, EmAndClImm, EmCmpAlImm,
                          EmCrtSeq, EmFileIo, EmIncDi, EmIncSi, EmInlineCh,
                          EmInlineCrLf, EmLdAlBx, EmLdAlDi, EmLdAlDiOff,
                          EmLdAlSi, EmLdAxDi, EmLdDiGlob, EmLeaBx, EmLeaDi,
                          EmLeave, EmLoadVar, EmLoadVarInd, EmLoadVarIndSym,
                          EmMovAxDi, EmMovAxDs, EmMovBxAx, EmMovBxDi,
                          EmMovBxi, EmMovClAl, EmMovDiAx, EmMovDlImm,
                          EmPopDi, EmPushBp, EmPushDi, EmPushSi,
                          EmPushSymAddr, EmPushVarAddr, EmRet, EmShlAxCl,
                          EmShlDlCl, EmShrAx1, EmShrAxCl, EmStDiAl,
                          EmStDiAlOff, EmStDiGlob, EmStDiImm, EmStoreInd,
                          EmStoreVar, EmStoreVarIndPrep, EmSubAlImm, EmSubSp,
                          EmXorByteGlob, EmitFrameBase, EmitStaticLink,
                          HeadWord, IfMatchSemi, ImageByteAt, ImageBytes,
                          Inittur, IsOuterLocal, LabelColonAhead,
                          LeaDiSym, LoadSymVar, ParamSlotBytes,
                          ParseLabelStmt, ParseType, ProcFunc, SetSource,
                          SlotSize, Statmnt, StoreSymVar, StoreVarIndPrepSym,
                          SymEpi ;

PROCEDURE IoCall (idx : CARDINAL) ;
(* WRITE / WRITELN / READ / READLN / HALT.

   TP3 (TPSRC8 pwriteln, pwrloop, prdtyped) does not pass a descriptor to
   the runtime: it looks at each argument's class and emits a *different*
   call per type, so the formatting is fixed at compile time.  Mirrored
   here - one call per argument, then a final call for the line break.

   WRITE/WRITELN push the value; READ/READLN push the address, so the
   runtime can store.  As everywhere else in this compiler the caller
   cleans the argument off the stack. *)
VAR arg : ERes ;
    nArgs, ent, which, acls : CARDINAL ;
    argBytes : CARDINAL ;       (* bytes pushed for this argument: 2, or 4 with
                                   a field width *)
    reading : BOOLEAN ;
    pushed : BOOLEAN ;
    skipArg, handled : BOOLEAN ;
    k, n, p, scratch, cap : CARDINAL ;
    dummy, errV : ERes ;
BEGIN
   which := symtab [idx].cls ;               (* BI_* *)
   IF which = BI_Halt THEN
      IF MatchDelim ('(') THEN               (* halt(0) - code ignored *)
         ParseExpr (dummy) ;
         ExpectDelim (')', ENoSemi)
      END ;
      DropC (EmCall (TU_Halt)) ;
      RETURN
   END ;
   IF which = BI_New THEN
      (* New(P): allocate sizeof(P^) bytes and store the address in P.  The
         pointer symbol's `elem' is the pointee TYPE symbol; its size is the
         allocation. *)
      IF MatchDelim ('(') THEN
         ParseExpr (arg) ;
         IF OK () AND ((arg.kind = 1) OR (arg.kind = 5)) AND
            (arg.cls = TPtr) THEN
            p := arg.ptrElem ;
            IF p = 0 THEN
               p := symtab [arg.idx].elem
            END ;
            EmMovAxi (symtab [p].size) ;
            EmPushAx () ;                    (* size -> [BP+6] *)
            IF arg.kind = 5 THEN
               EmPushDi ()                   (* element pointer slot *)
            ELSE
               EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
            END ;
            DropC (EmCall (TU_HeapNew)) ;
            EmAddSp (4)
         ELSIF OK () THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF which = BI_Dispose THEN
      (* Dispose(P): consume the argument.  The allocator is a bump pointer
         with no free list; CALC allocates once at the start of Help and
         disposes only after the help display is finished, so not reclaiming
         the block has no observable effect.  A future allocation after a
         Dispose would need a real free list. *)
      IF MatchDelim ('(') THEN
         ParseExpr (arg) ;
         IF OK () AND NOT (((arg.kind = 1) OR (arg.kind = 5))
                          AND (arg.cls = TPtr)) THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF which = BI_ClrScr THEN
      EmCrtSeq (CrtClr) ;
      RETURN
   END ;
   IF which = BI_ClrEol THEN
      (* clear from the cursor to the end of the line - a real INT 10h call,
         not a no-op: AH=03 reads the cursor, CX := it, DL := 79, AH=06 blanks
         that window. *)
      EmCrtSeq (CrtEol) ;
      RETURN
   END ;
   IF which = BI_GotoXY THEN
      (* GotoXY (x, y): 1-based; evaluate x first and park it, then y, so the
         code for y cannot clobber DL. *)
      IF MatchDelim ('(') THEN
         ParseExpr (dummy) ;
         IF OK () THEN
            LoadAtom (dummy) ;
            EmPushAx ()
         END ;
         ExpectDelim (',', ENoSemi) ;
         ParseExpr (dummy) ;
         IF OK () THEN
            LoadAtom (dummy) ;
            EmCrtSeq (CrtDh)
         END ;
         ExpectDelim (')', ENoSemi) ;
         EmPopAx () ;
         EmCrtSeq (CrtDl) ;
         EmCrtSeq (CrtCaret)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF which = BI_LowVideo THEN
      (* set the attribute the CLEAR operations use to 7; see EmCrtSeq *)
      EmCrtSeq (CrtLow) ;
      RETURN
   END ;
   IF which = BI_NormVideo THEN
      EmCrtSeq (CrtNorm) ;
      RETURN
   END ;
   IF which = BI_Delay THEN
      (* Delay(ms): a real busy loop (EmCrtSeq's CrtDelay), no INT, so it is
         identical under qemu and Exec86. *)
      IF MatchDelim ('(') THEN
         ParseExpr (dummy) ;
         IF OK () THEN
            LoadAtom (dummy) ;
            EmCrtSeq (CrtDelay)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF which = BI_Insert THEN
      (* Insert(Source, Dest, Index).  A CHAR source is materialised as a
         one-character counted string in a scratch; Dest must be a modifiable
         string variable/field.  Stack order is source, dest, index, max, so
         the runtime sees max at [BP+4] and source at [BP+10]. *)
      IF NOT MatchDelim ('(') THEN
         Err (ENoSemi) ;
         RETURN
      END ;
      ParseExpr (arg) ;
      IF OK () AND (arg.cls = TString) AND
         ((arg.kind = 1) OR (arg.kind = 3) OR (arg.kind = 5)) THEN
         EmPushStrAddr (arg)
      ELSIF OK () AND ((arg.cls = TChar) OR
                       ((arg.cls = TScalar) AND arg.chr)) THEN
         scratch := NewScratchStr () ;
         LoadAtom (arg) ;
         EmStoreVar (FALSE, (symtab [scratch].off + 1) MOD 10000H, 1) ;
         EmMovAxi (1) ;
         EmStoreVar (FALSE, symtab [scratch].off, 1) ;
         EmPushVarAddr (FALSE, symtab [scratch].off)
      ELSIF OK () THEN
         Err (ETypeErr) ;
         RETURN
      END ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF OK () AND (dummy.cls = TString) AND
         ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
         EmPushStrAddr (dummy) ;
         cap := VarSize (dummy) - 1 ;
         ExpectDelim (',', ENoSemi) ;
         ParseExpr (errV) ;
         IF OK () AND ((errV.cls = TScalar) OR (errV.cls = TChar)) THEN
            LoadAtom (errV) ; EmPushAx () ;
            EmMovAxi (cap) ; EmPushAx () ;
            DropC (EmCall (TU_StrInsert)) ;
            EmAddSp (8)
         ELSIF OK () THEN
            Err (ETypeErr)
         END
      ELSIF OK () THEN
         Err (ETypeErr)
      END ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Delete THEN
      (* Delete(S, pos, len): S must be a variable (or a DI-addressed field);
         the runtime mutates it in place.  S's address is parked while the
         two integer expressions are parsed. *)
      IF NOT MatchDelim ('(') THEN
         Err (ENoSemi) ;
         RETURN
      END ;
      ParseExpr (arg) ;
      IF OK () AND (arg.cls = TString) AND
         ((arg.kind = 1) OR (arg.kind = 5)) THEN
         EmPushStrAddr (arg) ;
         ExpectDelim (',', ENoSemi) ;
         ParseExpr (dummy) ;
         IF OK () AND ((dummy.cls = TScalar) OR (dummy.cls = TChar)) THEN
            LoadAtom (dummy) ; EmPushAx () ;
            ExpectDelim (',', ENoSemi) ;
            ParseExpr (errV) ;
            IF OK () AND ((errV.cls = TScalar) OR (errV.cls = TChar)) THEN
               LoadAtom (errV) ; EmPushAx () ;
               EmPopAx () ;                (* len *)
               EmPopBx () ;                (* pos *)
               EmPopCx () ;                (* source *)
               EmPushAx () ; EmPushBx () ; EmPushCx () ;
               DropC (EmCall (TU_StrDelete)) ;
               EmAddSp (6)
            ELSIF OK () THEN
               Err (ETypeErr)
            END
         ELSIF OK () THEN
            Err (ETypeErr)
         END
      ELSIF OK () THEN
         Err (ETypeErr)
      END ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Val THEN
      (* Val(S, V, E): integer conversion.  E receives 0 on success or the
         1-based position of the first invalid character; V is left unchanged
         on error. *)
      IF NOT MatchDelim ('(') THEN
         Err (ENoSemi) ;
         RETURN
      END ;
      ParseExpr (arg) ;
      IF OK () AND (arg.cls = TString) AND
         ((arg.kind = 1) OR (arg.kind = 3) OR (arg.kind = 5)) THEN
         ExpectDelim (',', ENoSemi) ;
         ParseExpr (dummy) ;
         ExpectDelim (',', ENoSemi) ;
         ParseExpr (errV) ;
         IF OK () AND (dummy.kind = 1) AND (dummy.cls = TScalar)
            AND (VarSize (dummy) = 2) AND (errV.kind = 1)
            AND (errV.cls = TScalar) AND (VarSize (errV) = 2) THEN
            EmPushSymAddr (errV.idx, (symtab [errV.idx].off + errV.boff) MOD 10000H) ;
            EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
            EmPushStrAddr (arg) ;
            DropC (EmCall (TU_ValInt)) ;
            EmAddSp (6)
         ELSIF OK () AND (dummy.cls = TReal) AND
            ((dummy.kind = 1) OR (dummy.kind = 5)) AND
            (errV.kind = 1) AND (errV.cls = TScalar) AND (VarSize (errV) = 2)
         THEN
            EmPushSymAddr (errV.idx, (symtab [errV.idx].off + errV.boff) MOD 10000H) ;
            EmPushRealAddr (dummy) ;
            EmPushStrAddr (arg) ;
            DropC (EmCall (TU_ValReal)) ;
            EmAddSp (6)
         ELSIF OK () THEN
            Err (ETypeErr)
         END
      ELSIF OK () THEN
         Err (ETypeErr)
      END ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Str THEN
      (* Str(Value[:FW[:DEC]], S): format a REAL into a string variable.
         The source address is pushed first and parked on the stack while the
         width/decimals expressions and the destination are parsed; the two
         stack words are then swapped to real_fmt's order (source at [BP+4],
         destination at [BP+6]).  CX carries (decimals << 8) | width; it is
         parked in tmpA across the destination parse, which may clobber CX.
         Defaults match TPSRC8 pstdef1/pstdef3: width 18, decimals FFFFh. *)
      IF NOT MatchDelim ('(') THEN
         Err (ENoSemi) ;
         RETURN
      END ;
      ParseExpr (arg) ;
      IF OK () AND (arg.cls = TScalar) THEN
         IF MatchDelim (':') THEN
            ParseExpr (errV) ;
            IF NOT OK () THEN
               RETURN
            END ;
            LoadAtom (arg) ; EmPushAx () ;
            LoadAtom (errV) ; EmPushAx () ;
            IF NOT MatchDelim (',') THEN
               Err (ENoSemi) ;
               RETURN
            END ;
            ParseExpr (dummy) ;
            IF OK () AND (dummy.cls = TString) AND
               ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
               EmPushStrAddr (dummy) ;
               DropC (EmCall (TU_IntFmtW)) ;
               EmAddSp (6)
            ELSIF OK () THEN
               Err (ETypeErr)
            END ;
            ExpectDelim (')', ENoSemi) ;
            RETURN
         END ;
         LoadAtom (arg) ;
         EmPushAx () ;                    (* value at [BP+6] *)
         IF NOT MatchDelim (',') THEN
            Err (ENoSemi) ;
            RETURN
         END ;
         ParseExpr (dummy) ;
         IF OK () AND (dummy.cls = TString) AND
            ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
            EmPushStrAddr (dummy) ;        (* destination at [BP+4] *)
            DropC (EmCall (TU_IntFmt)) ;
            EmAddSp (4)
         ELSIF OK () THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi) ;
         RETURN
      END ;
      IF OK () AND (arg.cls = TReal) AND
         ((arg.kind = 1) OR (arg.kind = 5)) THEN
         IF arg.kind = 5 THEN
            EmPushDi ()
         ELSE
            EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
         END ;
         IF MatchDelim (':') THEN
            ParseExpr (dummy) ;
            IF OK () THEN
               LoadAtom (dummy)
            END ;
            IF MatchDelim (':') THEN
               EmPushAx () ;
               ParseExpr (dummy) ;
               IF OK () THEN
                  LoadAtom (dummy) ;
                  EmMovChAl () ;
                  EmPopAx () ;
                  EmMovClAl ()
               END
            ELSIF OK () THEN
               EmMovClAl () ;
               EmMovChImm (0FFH)
            END
         ELSE
            EmMovCxi (0FF12H)       (* width 18, decimals FFFFh *)
         END ;
         IF NOT OK () THEN
            RETURN
         END ;
         EmMovAxCx () ;
         EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
         IF NOT MatchDelim (',') THEN
            Err (ENoSemi) ;
            RETURN
         END ;
         ParseExpr (dummy) ;
         IF OK () AND (dummy.cls = TString) AND
            ((dummy.kind = 1) OR (dummy.kind = 5)) THEN
            EmPushStrAddr (dummy) ;
            EmPopAx () ;                     (* destination *)
            EmPopBx () ;                     (* source *)
            EmPushAx () ;                    (* destination at [BP+6] *)
            EmPushBx () ;                    (* source at [BP+4] *)
            EmLoadVar (FALSE, symtab [tmpA].off, 2) ;
            EmXchgAxCx () ;                  (* CX := packed width/decimals *)
            DropC (EmCall (TU_RealFmt)) ;
            EmAddSp (4)
         ELSIF OK () THEN
            Err (ETypeErr)
         END
      ELSIF OK () THEN
         Err (ETypeErr)
      END ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Randomize THEN
      DropC (EmCall (TU_Randomize)) ;
      RETURN
   END ;
   IF which = BI_FillChar THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR ((arg.kind # 1) AND (arg.kind # 5)) THEN
         Err (ETypeErr) ; RETURN
      END ;
      IF arg.kind = 5 THEN EmPushDi () ELSE
         EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
      END ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () THEN RETURN END ;
      LoadAtom (dummy) ; EmPushAx () ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () THEN RETURN END ;
      LoadAtom (dummy) ; EmPushAx () ;
      EmPopAx () ; EmPopBx () ; EmPopCx () ;
      EmPushAx () ; EmPushBx () ; EmPushCx () ;
      DropC (EmCall (TU_FillChar)) ; EmAddSp (6) ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Move THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR ((arg.kind # 1) AND (arg.kind # 5)) THEN Err (ETypeErr) ; RETURN END ;
      IF arg.kind = 5 THEN EmPushDi () ELSE EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) END ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () OR ((dummy.kind # 1) AND (dummy.kind # 5)) THEN Err (ETypeErr) ; RETURN END ;
      IF dummy.kind = 5 THEN EmPushDi () ELSE EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) END ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () THEN RETURN END ;
      LoadAtom (dummy) ; EmPushAx () ;
      EmPopAx () ; EmPopBx () ; EmPopCx () ;
      EmPushAx () ; EmPushBx () ; EmPushCx () ;
      DropC (EmCall (TU_Move)) ; EmAddSp (6) ;
      ExpectDelim (')', ENoSemi) ;
      RETURN
   END ;
   IF which = BI_Seek THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR (arg.kind # 1) OR ((arg.cls # TFile) AND (arg.cls # TText) AND (arg.cls # TUntyp)) THEN
         Err (ETypeErr) ; RETURN
      END ;
      p := symtab [arg.idx].elem ; IF p = 0 THEN p := 1 END ;
      EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () THEN RETURN END ;
      LoadAtom (dummy) ; EmPushAx () ;
      EmPopAx () ; EmPopBx () ;
      EmMovCxi (p) ; EmPushCx () ; EmPushAx () ; EmPushBx () ;
      DropC (EmCall (TU_Seek)) ; EmAddSp (6) ;
      ExpectDelim (')', ENoSemi) ; RETURN
   END ;
   IF which = BI_Erase THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR (arg.kind # 1) OR ((arg.cls # TFile) AND (arg.cls # TText) AND (arg.cls # TUntyp)) THEN
         Err (ETypeErr) ; RETURN
      END ;
      EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
      DropC (EmCall (TU_Erase)) ; EmAddSp (2) ;
      ExpectDelim (')', ENoSemi) ; RETURN
   END ;
   IF which = BI_Rename THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR (arg.kind # 1) OR ((arg.cls # TFile) AND (arg.cls # TText) AND (arg.cls # TUntyp)) THEN
         Err (ETypeErr) ; RETURN
      END ;
      EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () OR (dummy.cls # TString) THEN Err (ETypeErr) ; RETURN END ;
      EmPushStrAddr (dummy) ;
      EmPopAx () ; EmPopBx () ; EmPushAx () ; EmPushBx () ;
      DropC (EmCall (TU_Rename)) ; EmAddSp (4) ;
      ExpectDelim (')', ENoSemi) ; RETURN
   END ;
   IF (which = BI_BlockRead) OR (which = BI_BlockWrite) THEN
      IF NOT MatchDelim ('(') THEN Err (ENoSemi) ; RETURN END ;
      ParseExpr (arg) ;
      IF NOT OK () OR (arg.kind # 1) OR ((arg.cls # TFile) AND (arg.cls # TText) AND (arg.cls # TUntyp)) THEN
         Err (ETypeErr) ; RETURN
      END ;
      p := symtab [arg.idx].elem ; IF p = 0 THEN p := 1 END ;
      EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () OR ((dummy.kind # 1) AND (dummy.kind # 5)) THEN Err (ETypeErr) ; RETURN END ;
      IF dummy.kind = 5 THEN EmPushDi () ELSE EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) END ;
      ExpectDelim (',', ENoSemi) ;
      ParseExpr (dummy) ;
      IF NOT OK () THEN RETURN END ;
      LoadAtom (dummy) ; EmPushAx () ;
      IF MatchDelim (',') THEN
         ParseExpr (dummy) ;
         IF NOT OK () OR ((dummy.kind # 1) AND (dummy.kind # 5)) THEN Err (ETypeErr) ; RETURN END ;
         IF dummy.kind = 5 THEN EmPushDi () ELSE
            EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H)
         END
      ELSE
         EmMovAxi (0) ; EmPushAx ()
      END ;
      EmPopDx () ; EmPopAx () ; EmPopBx () ; EmPopCx () ;
      EmStoreVar (FALSE, symtab [tmpB].off, 2) ;
      EmPushDx () ; EmMovAxi (p) ; EmPushAx () ;
      EmLoadVar (FALSE, symtab [tmpB].off, 2) ; EmPushAx () ;
      EmPushBx () ; EmPushCx () ;
      IF which = BI_BlockRead THEN DropC (EmCall (TU_BlockRead)) ELSE DropC (EmCall (TU_BlockWrite)) END ;
      EmAddSp (10) ;
      ExpectDelim (')', ENoSemi) ; RETURN
   END ;
   IF which = BI_GetDir THEN
      IF MatchDelim ('(') THEN
         ParseExpr (arg) ;
         IF OK () AND ((arg.cls = TScalar) OR (arg.cls = TChar)) THEN
            LoadAtom (arg) ;
            EmPushAx () ;                  (* drive *)
            ExpectDelim (',', ENoSemi) ;
            ParseExpr (dummy) ;
            IF OK () AND (dummy.cls = TString) AND (dummy.kind = 1) THEN
               EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
               DropC (EmCall (TU_GetDir)) ;
               EmAddSp (4)
            ELSIF OK () THEN
               Err (ETypeErr)
            END
         ELSIF OK () THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF (which = BI_Msdos) OR (which = BI_Intr) THEN
      IF MatchDelim ('(') THEN
         IF which = BI_Intr THEN
            ParseExpr (dummy) ;
            IF OK () AND NOT ((dummy.kind = 0) AND (W16 (dummy.imm) = 21H)) THEN
               Err (ENoLib) ;
               RETURN
            END ;
            ExpectDelim (',', ENoSemi)
         END ;
         ParseExpr (arg) ;
         IF OK () AND (arg.kind = 1) AND (arg.cls = TRecord) THEN
            EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
            DropC (EmCall (TU_Msdos)) ;
            EmAddSp (2)
         ELSIF OK () THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF which = BI_Assign THEN
      (* Assign(F, Name): the file variable's address and the counted
         string's address.  The runtime copies the characters into the file
         control block and marks it closed; Reset/Rewrite do the DOS open.
         Name is pushed first, so the runtime sees F at [BP+4] and Name at
         [BP+6]. *)
      IF MatchDelim ('(') THEN
         ParseExpr (arg) ;
         IF OK () AND (arg.kind = 1) AND
            ((arg.cls = TFile) OR (arg.cls = TText) OR (arg.cls = TUntyp)) THEN
            ExpectDelim (',', ENoSemi) ;
            ParseExpr (dummy) ;
            IF OK () THEN
               IF dummy.cls = TString THEN
                  EmPushStrAddr (dummy) ;
                  EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                  DropC (EmCall (TU_FileAssign)) ;
                  EmAddSp (4)
               ELSE
                  Err (ETypeErr)
               END
            END
         ELSIF OK () THEN
            Err (ETypeErr)
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   IF (which = BI_Reset) OR (which = BI_Rewrite) OR (which = BI_Close) THEN
      IF MatchDelim ('(') THEN
         ParseExpr (arg) ;
         IF OK () THEN
            IF (arg.kind = 1) AND
               ((arg.cls = TFile) OR (arg.cls = TText) OR (arg.cls = TUntyp)) THEN
               EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
               IF which = BI_Reset THEN
                  DropC (EmCall (TU_FileReset))
               ELSIF which = BI_Rewrite THEN
                  DropC (EmCall (TU_FileRewrite))
               ELSE
                  DropC (EmCall (TU_FileClose))
               END ;
               EmAddSp (2)
            ELSE
               Err (ETypeErr)
            END
         END ;
         ExpectDelim (')', ENoSemi)
      ELSE
         Err (ENoSemi)
      END ;
      RETURN
   END ;
   reading := (which = BI_Read) OR (which = BI_ReadLn) ;
   nArgs := 0 ;
   IF MatchDelim ('(') THEN
      IF CurCh () # ')' THEN
         LOOP
            IF nArgs >= 16 THEN
               Err (ECompOvf) ;
               EXIT
            END ;
            ParseExpr (arg) ;
            IF NOT OK () THEN
               (* An argument that did not type-check has no value and arg.idx
                  is not a symbol.  The string arm below dereferences
                  symtab[arg.idx] for ANY value whose class is TString - unlike
                  the string assign in Assignment, which can tell a failed
                  concat from a real one by its kind - so a `writeln' of a
                  rejected expression read symtab with whatever idx held
                  before and dereferenced it.  That is exactly how
                  `writeln('a' + 'b')' - two CHARs, a type error since
                  v-TP3-STRCAT - segfaulted the compiler instead of reporting
                  the error.  ParseSub guards its subscript the same way (see
                  `IF OK () THEN' before symtab[r.idx] there), and the
                  statement loop stops at the next iteration, so leaving the
                  rest of this WRITELN unparsed is harmless. *)
               RETURN
            END ;
            (* One argument at a time: parse it, give it its own push or its
               own runtime call, and only then read the next one.  TPSRC8
               pwrloop does exactly this, and it has to - a computed argument
               exists only in AX, so parsing the argument after it, and the
               call made for THIS one, are both free to destroy it.  Reading
               the whole list first and emitting afterwards printed the first
               argument as the last argument's value, and pushed an argument
               that an earlier inline string's call had already overwritten. *)
            skipArg := FALSE ;
            handled := FALSE ;
            IF (nArgs = 0) AND (arg.cls = TText) THEN
               (* A leading TEXT file argument.  KBD is the console keyboard
                  and this runtime's read entries already read the console, so
                  the file is dropped and the rest of the argument list is read
                  exactly as without it. *)
               IF reading AND (arg.kind = 1) AND symtab [arg.idx].isKbd THEN
                  IF NOT MatchDelim (',') THEN
                     Err (ENoSemi) ;
                     RETURN
                  END ;
                  skipArg := TRUE
               ELSIF reading THEN
                  (* Text-file reads.  A number is read as a whitespace-
                     delimited token and handed to ValInt/ValReal; a string
                     still uses the line reader.  Readln consumes the rest
                     of the line after all numeric arguments. *)
                  IF NOT MatchDelim (',') THEN
                     Err (ENoSemi) ;
                     RETURN
                  END ;
                  LOOP
                     ParseExpr (dummy) ;
                     IF NOT OK () THEN
                        RETURN
                     END ;
                     IF dummy.cls = TString THEN
                        IF (dummy.kind = 1) OR (dummy.kind = 5) THEN
                           EmMovAxi ((VarSize (dummy) - 1) MOD 10000H) ;
                           EmPushAx () ;
                           EmPushStrAddr (dummy) ;
                           EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                           DropC (EmCall (TU_FileReadln)) ;
                           EmAddSp (6)
                        ELSE
                           Err (ETypeErr) ;
                           RETURN
                        END
                     ELSIF IsCharArray (dummy) AND (dummy.kind = 1) THEN
                        scratch := NewScratchStr () ;
                        k := 1 ;
                        WHILE k <= VarSize (dummy) DO
                           EmMovAxi (ORD (' ')) ;
                           EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
                           INC (k)
                        END ;
                        EmMovAxi (VarSize (dummy)) ;
                        EmPushAx () ;
                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
                        EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                        DropC (EmCall (TU_FileReadln)) ;
                        EmAddSp (6) ;
                        EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
                        EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
                        EmMovCxi (VarSize (dummy)) ;
                        DropC (EmCall (TU_MemCopy)) ;
                        EmAddSp (4)
                     ELSIF (dummy.kind = 1) AND
                        ((dummy.cls = TScalar) OR (dummy.cls = TReal)) THEN
                        scratch := NewScratchStr () ;
                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
                        EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                        DropC (EmCall (TU_FileRdtok)) ;
                        EmAddSp (4) ;
                        EmPushVarAddr (FALSE, symtab [tmpA].off) ;
                        EmPushSymAddr (dummy.idx, (symtab [dummy.idx].off + dummy.boff) MOD 10000H) ;
                        EmPushVarAddr (FALSE, symtab [scratch].off) ;
                        IF dummy.cls = TReal THEN
                           DropC (EmCall (TU_ValReal))
                        ELSE
                           DropC (EmCall (TU_ValInt))
                        END ;
                        EmAddSp (6)
                     ELSE
                        Err (ETypeErr) ;
                        RETURN
                     END ;
                     IF NOT MatchDelim (',') THEN
                        EXIT
                     END
                  END ;
                  IF which = BI_ReadLn THEN
                     EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                     DropC (EmCall (TU_FileRdln)) ;
                     EmAddSp (2)
                  END ;
                  ExpectDelim (')', ENoSemi) ;
                  RETURN
               ELSE
                  (* Text-file output: Writeln(File) is CRLF, Write(File, C)
                     is one CHAR, and writeln(File, S) is S followed by CRLF.
                     Write each byte range with DOS AH=40h; a string argument
                     carries its own length byte, a one-CHAR literal becomes a
                     tiny code-resident <1><char>. *)
                  IF (arg.kind # 1) OR (symtab [arg.idx].cls # TText) THEN
                     Err (ETypeErr) ;
                     RETURN
                  END ;
                  IF MatchDelim (',') THEN
                     LOOP
                        ParseExpr (dummy) ;
                        IF NOT OK () THEN
                           RETURN
                        END ;
                        IF dummy.cls = TString THEN
                           IF MatchDelim (':') THEN
                              ParseExpr (errV) ;
                              IF NOT OK () THEN
                                 RETURN
                              END ;
                              LoadAtom (errV) ;
                              EmPushAx () ;          (* width *)
                              EmPushStrAddr (dummy) ; (* source *)
                              scratch := NewScratchStr () ;
                              EmPushVarAddr (FALSE, symtab [scratch].off) ;
                              DropC (EmCall (TU_StrFmtW)) ;
                              EmAddSp (6) ;
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 1, FALSE,
                                        symtab [scratch].off, 0, TRUE)
                           ELSIF dummy.kind = 1 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 1,
                                        symtab [dummy.idx].local,
                                        (symtab [dummy.idx].off + dummy.boff)
                                           MOD 10000H,
                                        0, TRUE)
                           ELSIF dummy.kind = 5 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 5, FALSE,
                                        0, 0, TRUE)
                           ELSIF dummy.kind = 3 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 4, FALSE,
                                        EmStrBlob (dummy), 0, TRUE)
                           ELSE
                              Err (ENoLib) ;
                              RETURN
                           END
                        ELSIF (dummy.cls = TChar) OR
                           ((dummy.cls = TScalar) AND dummy.chr) THEN
                           IF dummy.kind = 1 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 1,
                                        symtab [dummy.idx].local,
                                        (symtab [dummy.idx].off + dummy.boff)
                                           MOD 10000H,
                                        1, FALSE)
                           ELSIF dummy.kind = 5 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 5, FALSE,
                                        0, 1, FALSE)
                           ELSIF dummy.kind = 2 THEN
                              EmStoreVar (FALSE, symtab [tmpA].off, 1) ;
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 1, FALSE,
                                        symtab [tmpA].off, 1, FALSE)
                           ELSIF dummy.kind = 0 THEN
                              EmFileIo (FALSE, symtab [arg.idx].local,
                                        symtab [arg.idx].off, 4, FALSE,
                                        EmInlineCh (VAL (CARDINAL, dummy.imm)),
                                        0, TRUE)
                           ELSE
                              Err (ENoLib) ;
                              RETURN
                           END
                        ELSIF dummy.cls = TReal THEN
                           EmPushRealAddr (dummy) ;
                           IF MatchDelim (':') THEN
                              ParseExpr (errV) ;
                              IF OK () THEN LoadAtom (errV) END ;
                              IF MatchDelim (':') THEN
                                 EmPushAx () ;
                                 ParseExpr (errV) ;
                                 IF OK () THEN
                                    LoadAtom (errV) ;
                                    EmMovChAl () ;
                                    EmPopAx () ;
                                    EmMovClAl ()
                                 END
                              ELSIF OK () THEN
                                 EmMovClAl () ;
                                 EmMovChImm (0FFH)
                              END
                           ELSE
                              EmMovCxi (0FF12H)
                           END ;
                           EmMovAxCx () ;
                           EmStoreVar (FALSE, symtab [tmpA].off, 2) ;
                           scratch := NewScratchStr () ;
                           EmPushVarAddr (FALSE, symtab [scratch].off) ;
                           EmPopAx () ;
                           EmPopBx () ;
                           EmPushAx () ;
                           EmPushBx () ;
                           EmLoadVar (FALSE, symtab [tmpA].off, 2) ;
                           EmXchgAxCx () ;
                           DropC (EmCall (TU_RealFmt)) ;
                           EmAddSp (4) ;
                           EmFileIo (FALSE, symtab [arg.idx].local,
                                     symtab [arg.idx].off, 1, FALSE,
                                     symtab [scratch].off, 0, TRUE)
                        ELSIF dummy.cls = TScalar THEN
                           (* integer with the optional TP3 `:width' *)
                           LoadAtom (dummy) ;
                           EmPushAx () ;
                           IF MatchDelim (':') THEN
                              ParseExpr (errV) ;
                              IF NOT OK () THEN
                                 RETURN
                              END ;
                              LoadAtom (errV) ;
                              EmPushAx ()
                           ELSE
                              EmMovAxi (0) ;
                              EmPushAx ()
                           END ;
                           scratch := NewScratchStr () ;
                           EmPushVarAddr (FALSE, symtab [scratch].off) ;
                           DropC (EmCall (TU_IntFmtW)) ;
                           EmAddSp (6) ;
                           EmFileIo (FALSE, symtab [arg.idx].local,
                                     symtab [arg.idx].off, 1, FALSE,
                                     symtab [scratch].off, 0, TRUE)
                        ELSE
                           Err (ENoLib) ;
                           RETURN
                        END ;
                        IF NOT MatchDelim (',') THEN
                           EXIT
                        END
                     END
                  END ;
                  IF which = BI_WriteLn THEN
                     EmFileIo (FALSE, symtab [arg.idx].local,
                               symtab [arg.idx].off, 4, FALSE,
                               EmInlineCrLf (), 0, TRUE)
                  END ;
                  ExpectDelim (')', ENoSemi) ;
                  RETURN
               END
            ELSIF (nArgs = 0) AND (arg.cls = TFile) THEN
               (* Typed-file block I/O: `write(MCfile, Sheet[I,J])' and the
                  symmetric `read(MCfile, Sheet[FX,FY])'.  TP3 moves exactly
                  one element per call, so consume the single data argument
                  here and emit the DOS block call.  The element size comes
                  from the data expression and must agree with the file's
                  declared element size; a mismatch is a type error, not a
                  reason to write the wrong number of bytes. *)
               IF (arg.kind # 1) OR NOT MatchDelim (',') THEN
                  Err (ETypeErr) ;
                  RETURN
               END ;
               ParseExpr (dummy) ;
               IF NOT OK () THEN
                  RETURN
               END ;
               IF ((dummy.kind # 1) AND (dummy.kind # 5))
                  OR (VarSize (dummy) # symtab [arg.idx].elem) THEN
                  Err (ETypeErr) ;
                  RETURN
               END ;
               IF dummy.kind = 5 THEN
                  EmFileIo (reading, symtab [arg.idx].local,
                            symtab [arg.idx].off, 5, FALSE, 0, VarSize (dummy),
                            FALSE)
               ELSE
                  EmFileIo (reading, symtab [arg.idx].local,
                            symtab [arg.idx].off, 1, symtab [dummy.idx].local,
                            (symtab [dummy.idx].off + dummy.boff) MOD 10000H,
                            VarSize (dummy), FALSE)
               END ;
               ExpectDelim (')', ENoSemi) ;
               RETURN
            END ;
            IF NOT skipArg AND IsCharArray (arg) AND (arg.kind = 1) THEN
               IF reading THEN
                  (* Readln(Place): read through a temporary counted string,
                     then copy its fixed-width bytes over the char array.
                     The temporary is pre-filled with spaces so a short line
                     leaves the array padded, and rdstr leaves the newline
                     pending for the Readln wrapper. *)
                  scratch := NewScratchStr () ;
                  k := 1 ;
                  WHILE k <= VarSize (arg) DO
                     EmMovAxi (ORD (' ')) ;
                     EmStoreVar (FALSE, (symtab [scratch].off + k) MOD 10000H, 1) ;
                     INC (k)
                  END ;
                  EmPushVarAddr (FALSE, symtab [scratch].off) ;
                  EmMovCxi (VarSize (arg)) ;
                  DropC (EmCall (TU_RdStr)) ;
                  EmAddSp (2) ;
                  EmPushVarAddr (FALSE, (symtab [scratch].off + 1) MOD 10000H) ;
                  EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H) ;
                  EmMovCxi (VarSize (arg)) ;
                  DropC (EmCall (TU_MemCopy)) ;
                  EmAddSp (4)
               ELSE
                  (* Write a fixed char array one byte at a time. *)
                  k := 0 ;
                  WHILE k < VarSize (arg) DO
                     LoadSymVar (arg.idx, (symtab [arg.idx].off + arg.boff + k) MOD 10000H, 1) ;
                     EmMovAh0 () ;
                     EmPushAx () ;
                     DropC (EmCall (TU_WrChar)) ;
                     EmAddSp (2) ;
                     INC (k)
                  END
               END ;
               handled := TRUE
            END ;
            IF NOT skipArg AND NOT handled THEN
            pushed := TRUE ;      (* default: value is on the stack -> call + pop *)
            argBytes := 2 ;
            IF reading THEN
               IF (arg.kind # 1) AND (arg.kind # 5) THEN
                  Err (ETypeErr) ;                  (* READ needs a variable *)
                  RETURN
               END ;
               IF arg.kind = 5 THEN
                  (* A DI-addressed element: its TYPE is on the expression
                     (WithLookup/ParseSub set it), because the symbol is the
                     containing array/record.  s[i] is TChar; a WITH string
                     field is TString. *)
                  acls := arg.cls
               ELSE
                  acls := symtab [arg.idx].cls ;
                  (* s[i] is a CHAR variable, so read(s[i]) must read one byte
                     at off+boff, not the whole string at off.  arg.cls is
                     TChar (set by ParseSub) while the symbol's own class is
                     still TString, which is exactly how the element is told
                     from the whole string; the address push has to carry boff.
                     For a plain variable arg.boff is 0, so nothing changes. *)
                  IF (acls = TString) AND (arg.cls = TChar) THEN
                     acls := TChar
                  END
               END ;
               IF arg.kind = 5 THEN
                  (* A variable index: ParseSub computed the element's address
                     into DI, and nothing has been emitted since, so that is
                     the address READ wants.  A constant index folds into boff
                     and takes the LEA path below. *)
                  EmPushDi ()
               ELSIF symtab [arg.idx].isVar THEN
                  (* A VAR parameter: its slot holds the address READ must
                     store through, not the address of the slot. *)
                  IF arg.boff # 0 THEN
                     Err (ENoLib) ;
                     RETURN
                  END ;
                  LoadSymVar (arg.idx, symtab [arg.idx].off, 2) ;
                  EmPushAx ()
               ELSE
                  EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
               END ;
               IF acls = TString THEN
                  (* readln(s)/read(s) of a string variable: TPSRC8 prdstr
                     pushes the address, emits MOV CL,max_len and CALL
                     xrdstr.  Here the limit is a full MOV CX,imm16 (this
                     runtime has no byte-register CH/CL setup), and rdstr
                     leaves the terminator pending so the readln wrapper can
                     consume the newline. *)
                  EmMovCxi ((VarSize (arg) - 1) MOD 10000H) ;
                  ent := TU_RdStr
               ELSIF acls = TReal THEN
                  ent := TU_RdInt                   (* real reads: not yet *)
               ELSIF acls = TBool THEN
                  (* TP3 refuses boolean I/O: TPSRC8 prderrtp is error 66,
                     "I/O not allowed here", and the runtime has no xrdbool
                     at all.  rdbool stores a WORD, so one byte of an
                     accepted read would land on the variable AFTER b - the
                     exact overflow t37_readbyte pins for a byte.  TP3's
                     answer to the whole class is the error; so is ours. *)
                  Err (EIoHere) ;
                  RETURN
               ELSIF acls = TChar THEN
                  ent := TU_RdChar                  (* one byte, not a word *)
               ELSIF acls = TScalar THEN
                  (* Dispatch on the SIZE, as TPSRC8 prdnum does:
                     `CMP varsize,#$01 / JA prdemit' keeps xrdint for
                     anything wider and falls through to `MOV AX,#xrdbyte'
                     for a one-byte variable.  A BYTE is still TScalar (it
                     is *written* as an integer, as in TP3), but reading one
                     through rdint stored a word - and the second byte of
                     that word is the byte that FOLLOWS the variable. *)
                  IF VarSize (arg) = 1 THEN
                     ent := TU_RdByte
                  ELSE
                     ent := TU_RdInt
                  END
               ELSE
                  Err (ETypeErr) ;
                  RETURN
               END
            ELSE
               acls := arg.cls ;
               IF (acls = TString) AND (arg.kind = 3) THEN
                  (* An inline string literal.  TP3 TPSRC8 pwrinlin special-cases a
                     literal that is followed directly by ',' or ')' - i.e. an
                     argument, not an expression - and emits
                        CALL wrtinl  <length byte> <characters...>
                     with no stack argument at all; wrtinl reads the length from the
                     return address and returns to just past the last character.
                     A following `:width' needs the ordinary address form, so
                     wrstrw can pad it; the no-width path keeps the compact
                     inline byte stream. *)
                  IF strLen [arg.strx] > 255 THEN
                     (* The length is one byte, so a literal of 256 characters or
                        more would wrap: 300 characters emitted behind a length of
                        44, and the runtime would print 44 of them and silently drop
                        the rest.  TP3 strings are at most 255 characters, so refuse
                        rather than truncate. *)
                     Err (EConstRange) ;
                     RETURN
                  END ;
                  IF MatchDelim (':') THEN
                     (* A string literal with a field width: make its bytes an
                        ordinary code-resident address, then pad before it. *)
                     EmPushStrAddr (arg) ;
                     ParseExpr (dummy) ;
                     IF NOT OK () THEN
                        RETURN
                     END ;
                     LoadAtom (dummy) ;
                     EmPushAx () ;
                     ent := TU_WrStrW ;
                     argBytes := 4
                  ELSE
                     DropC (EmCall (TU_WrInl)) ;
                     Ebyte (VAL (BYTE, strLen [arg.strx])) ;
                     n := 0 ;
                     WHILE n < strLen [arg.strx] DO
                        Ebyte (VAL (BYTE, ORD (strPool [strOff [arg.strx] + n]))) ;
                        INC (n)
                     END ;
                     pushed := FALSE             (* nothing was pushed for this one *)
                  END
               ELSE
                  IF acls = TString THEN
                     (* A string *variable*.  Its value IS its address, so it is
                        passed exactly the way READ passes an address: push it
                        and call the owner of the layout - wrstr - which reads
                        the length byte and prints that many characters.  TPSRC8
                        pwrstr/pwrchk route a string argument to xwrtstr, and
                        xwrtstr reaches its argument through BP just like WrChar
                        does.  The only difference from the inline-literal arm
                        above is where the bytes live: a literal's are in the
                        code stream (wrtinl) and a variable's are in the data
                        segment or the frame (wrstr). *)
                     (* off + boff: a string FIELD of a record/array has a
                        non-zero boff, and the address is the field's, not the
                        containing variable's.  `writeln (g[2,3].S)' printed
                        the empty first element before this.
                        A DI-addressed field (`with Sheet[I,J] do
                        Write(Contents)') already HAS its address in DI. *)
                     IF arg.kind = 5 THEN
                        EmPushDi ()
                     ELSIF symtab [arg.idx].isVar THEN
                        (* VAR string: the slot holds the address of the
                           caller's characters; push that, not the slot. *)
                        LoadSymVar (arg.idx, symtab [arg.idx].off, 2) ;
                        EmPushAx ()
                     ELSE
                        EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
                     END ;
                     ent := TU_WrStr ;
                     IF MatchDelim (':') THEN
                        ParseExpr (dummy) ;
                        IF NOT OK () THEN
                           RETURN
                        END ;
                        LoadAtom (dummy) ;
                        EmPushAx () ;
                        ent := TU_WrStrW ;
                        argBytes := 4
                     END
                  ELSE
                     IF acls = TReal THEN
                        (* A REAL is six bytes, so the writer takes its
                           ADDRESS, not its value: push the address first,
                           then the width, then the decimals.  The entry is
                           real_write, with [BP+4]=decimals, [BP+6]=width and
                           [BP+8]=real.  TP3's defaults are width 18 and
                           decimals FFFFh (its scientific mode); a width with
                           no second colon keeps that default, which is
                           exactly what TPSRC8 pwrdef/pwrdef3 push. *)
                        IF arg.kind = 5 THEN
                           EmPushDi ()
                        ELSE
                           EmPushSymAddr (arg.idx, (symtab [arg.idx].off + arg.boff) MOD 10000H)
                        END ;
                        IF MatchDelim (':') THEN
                           ParseExpr (dummy) ;
                           IF NOT OK () THEN
                              RETURN
                           END ;
                           LoadAtom (dummy) ;
                           EmPushAx () ;
                           IF MatchDelim (':') THEN
                              ParseExpr (dummy) ;
                              IF NOT OK () THEN
                                 RETURN
                              END ;
                              LoadAtom (dummy) ;
                              EmPushAx ()
                           ELSE
                              EmMovAxi (0FFFFH) ;
                              EmPushAx ()
                           END
                        ELSE
                           EmMovAxi (18) ;
                           EmPushAx () ;
                           EmMovAxi (0FFFFH) ;
                           EmPushAx ()
                        END ;
                        ent := TU_RealWrite ;
                        argBytes := 6
                     ELSE
                        LoadAtom (arg) ;
                        EmPushAx () ;
                        IF arg.chr THEN
                           ent := TU_WrChar             (* 'a' - one char, not 97 *)
                        ELSIF acls = TBool THEN
                           ent := TU_WrBool
                        ELSIF acls = TChar THEN
                           ent := TU_WrChar             (* c : char - one char *)
                        ELSIF acls = TScalar THEN
                           ent := TU_WrInt
                        ELSE
                           Err (ETypeErr) ;
                           RETURN
                        END ;
                        IF MatchDelim (':') THEN
                           (* Field width: `writeln(I:2)'.  TP3 evaluates the
                              width (CALC passes `FW', a variable), so it is
                              parsed and pushed AFTER the value: width at BP+4,
                              value at BP+6.  Char, BOOLEAN and integer each
                              have their own width entry; a second colon is
                              only legal for REAL, handled above. *)
                           ParseExpr (dummy) ;
                           IF NOT OK () THEN
                              RETURN
                           END ;
                           LoadAtom (dummy) ;
                           EmPushAx () ;
                           IF MatchDelim (':') THEN
                              Err (ENoLib) ;
                              RETURN
                           END ;
                           IF arg.chr OR (acls = TChar) THEN
                              ent := TU_WrCharW
                           ELSIF acls = TBool THEN
                              ent := TU_WrBoolW
                           ELSE
                              ent := TU_WrIntW
                           END ;
                           argBytes := 4
                        END
                     END
                  END
               END
            END ;
            IF pushed THEN
               DropC (EmCall (ent)) ;
               EmAddSp (argBytes)                  (* 2, or 4 with a width *)
            END ;
               INC (nArgs)
            END ;
            IF NOT skipArg THEN
               IF NOT MatchDelim (',') THEN
                  EXIT
               END
            END
         END ;
         IF NOT MatchDelim (')') THEN
            Err (ENoSemi) ;
            RETURN
         END
      ELSE
         DropCh (GetCh ())
      END
   END ;
   IF reading AND (nArgs = 0) THEN
      (* readln with no variable: just skip to the next line *)
      DropC (EmCall (TU_RdLn)) ;
      RETURN
   END ;
   IF which = BI_WriteLn THEN
      DropC (EmCall (TU_WrLn))
   ELSIF which = BI_ReadLn THEN
      DropC (EmCall (TU_RdLn))
   END
END IoCall ;

END CompilerIO.