SECTION "opoc"

GET "b.CGheader"

STATIC $(
   opString = 0; extraOp = 0; opArgs = 0; opIsLast = 0;
   oldWrCh = 0; position = 0;
   argIsString = FALSE; extraOp2 = 0 $)

MANIFEST $(
   s.eof = -1 $);

MANIFEST $(
   outputMargin = 75 $);

LET start() BE
$( LET argv = VEC 40;
   LET in = Input() AND out = Output();
   LET oc, list = 0, 0;
   LET op = 0;
   rdargs("from/A,to/K", argv, 40);
   IF argv!1~=0 THEN
   $( List := FindOutput(argv!1)
      SelectOutput(list) $);
   IF argv!0~=0 THEN
   $( oc := FindInput(argv!0);
      SelectInput(oc) $);
   oldWrCh := WrCh;
   WrCh := WrChCheck;
   position := 0;
   $( argIsString := FALSE;
      op := ReadN();
      IF op=s.eof THEN BREAK;
      Classify(op);
      WrCh(position+opString%0+1>=outputMargin -> '*n', ' ');
      WriteS(opString);
      IF extraOp>=0 THEN
	 $( WrCh(' '); WriteN(extraOp) $);
      IF extraOp2>=0 THEN
	 $( WrCh(' '); WriteN(extraOp2) $);
      TEST ~argIsString THEN
	 FOR i = 1 TO opArgs DO $(
	    WrCh(' ');
	    WriteN(ReadN()) $)
      ELSE $(
	 WriteS(position+opArgs+3>=outputMargin -> "*n[", " [");
	 FOR i = 1 TO opArgs DO $(
	    LET c = ReadN();
	    TEST c='*n' THEN
	       WriteS("**n")
	    ELSE TEST c='*c' THEN
	       WriteS("**c")
	    ELSE TEST c='**' THEN
	       WriteS("****")
	    ELSE
	       WrCh(c) $);
	 WrCh(']') $)
   $) REPEATUNTIL opIsLast;
   NewLine();
   EndRead();
   SelectInput(in);
   IF List~=0 THEN
   $( EndWrite();
      SelectOutput(out) $)
$)

AND ReadN() = VALOF
$( LET n = 0;
   LET ch = rdch();
   LET neg = FALSE;
   WHILE ch=' ' | ch='*n' | ch='*t' DO ch := rdch();
   IF ch='-' THEN $( neg := TRUE; ch := Rdch() $);
   WHILE '0'<=ch<='9' DO $( n := n*10+ch-'0'; ch := rdch() $)
   IF ch=endstreamch THEN RESULTIS s.eof;
   UnRdch();
   RESULTIS neg -> -n, n
$)

AND WrChCheck(ch) BE
   TEST ch='*n' | (ch='*s' & position>=outputMargin)
      THEN $( position := 0; oldWrCh('*n') $)
      ELSE $( position := position+1; oldWrCh(ch) $)

AND Classify(op) BE
$( extraOp, extraOp2 := -1, -1;
   opArgs := 0;
   opIsLast := FALSE;
   SWITCHON op INTO
   $( CASE s.true: opString := "true"; ENDCASE
      CASE s.false:opString := "false"; ENDCASE
      CASE s.rv:   opString := "rv"; ENDCASE
      CASE s.fnap: opString := "fnap"; opArgs := 1; ENDCASE
      CASE s.mult: opString := "mult"; ENDCASE
      CASE s.div:  opString := "div"; ENDCASE
      CASE s.rem:  opString := "rem"; ENDCASE
      CASE s.plus: opString := "plus"; ENDCASE
      CASE s.minus: opString := "minus"; ENDCASE
      CASE s.fmult: opString := "#mult"; ENDCASE
      CASE s.fdiv:  opString := "#div"; ENDCASE
      CASE s.fplus: opString := "#plus"; ENDCASE
      CASE s.fminus:opString := "#minus"; ENDCASE
      CASE s.query: opString := "query"; ENDCASE
      CASE s.neg: opString := "neg"; ENDCASE
      CASE s.abs: opString := "abs"; ENDCASE
      CASE s.eq:  opString := "eq"; ENDCASE
      CASE s.ne:  opString := "ne"; ENDCASE
      CASE s.ls:  opString := "ls"; ENDCASE
      CASE s.gr:  opString := "gr"; ENDCASE
      CASE s.le:  opString := "le"; ENDCASE
      CASE s.ge:  opString := "ge"; ENDCASE
      CASE s.fneg: opString := "#neg"; ENDCASE
      CASE s.fabs: opString := "#abs"; ENDCASE
      CASE s.fix:  opString := "fix"; ENDCASE
      CASE s.float:opString := "float"; ENDCASE
      CASE s.feq: opString := "#eq"; ENDCASE
      CASE s.fne: opString := "#ne"; ENDCASE
      CASE s.fls: opString := "#ls"; ENDCASE
      CASE s.fgr: opString := "#gr"; ENDCASE
      CASE s.fle: opString := "#le"; ENDCASE
      CASE s.fge: opString := "#ge"; ENDCASE
      CASE s.lls: opString := "lls"; ENDCASE
      CASE s.lgr: opString := "lgr"; ENDCASE
      CASE s.lle: opString := "lle"; ENDCASE
      CASE s.lge: opString := "lge"; ENDCASE

      CASE s.not:    opString := "not"; ENDCASE
      CASE s.lshift: opString := "lshift"; ENDCASE
      CASE s.rshift: opString := "rshift"; ENDCASE
      CASE s.logand: opString := "logand"; ENDCASE
      CASE s.logor: opString := "logor"; ENDCASE
      CASE s.eqv:   opString := "eqv"; ENDCASE
      CASE s.neqv:  opString := "neqv"; ENDCASE
      CASE s.needs: opString := "needs"; GOTO JustString
      CASE s.section: opString := "section"; GOTO JustString
      CASE s.rtap: opArgs := 1; opString := "rtap"; ENDCASE
      CASE s.goto: opString := "goto"; ENDCASE
      CASE s.return:  opString := "return"; ENDCASE
      CASE s.finish:  opString := "finish"; ENDCASE
      CASE s.switchon:extraOp := ReadN(); opArgs := 2*extraOp+1;
		      opString := "switchon"; ENDCASE
      CASE s.global: extraOp := ReadN(); opArgs := 2*extraOp;
		     opIsLast := TRUE;
		     opString := "global"; ENDCASE

      CASE s.lp: opArgs := 1; opString := "lp"; ENDCASE
      CASE s.lg: opArgs := 1; opString := "lg"; ENDCASE
      CASE s.ln: opArgs := 1; opString := "ln"; ENDCASE
      CASE s.fconst: opArgs := 2; opString := "fconst"; ENDCASE
      CASE s.dstr: opString := "dstr"
    LabPlusString: extraOp := ReadN(); extraOp2 := ReadN();
		   opArgs := extraOp2; argIsString := TRUE;
		   ENDCASE
      CASE s.lstr: opString := "lstr";
    JustString:    extraOp := ReadN(); opArgs := extraOp;
		   argIsString := TRUE; ENDCASE
      CASE s.defext: opString := "defext"; GOTO LabPlusString
      CASE s.refext: opString := "refext"; GOTO LabPlusString
      CASE s.ll:  opArgs := 1; opString := "ll"; ENDCASE
      CASE s.llp: opArgs := 1; opString := "llp"; ENDCASE
      CASE s.llg: opArgs := 1; opString := "llg"; ENDCASE
      CASE s.lll: opArgs := 1; opString := "lll"; ENDCASE
      CASE s.sp: opArgs := 1; opString := "sp"; ENDCASE
      CASE s.sg: opArgs := 1; opString := "sg"; ENDCASE
      CASE s.sl: opArgs := 1; opString := "sl"; ENDCASE
      CASE s.stind:opString := "stind"; ENDCASE
      CASE s.jump: opArgs := 1; opString := "jump"; ENDCASE
      CASE s.jt: opArgs := 1; opString := "jt"; ENDCASE
      CASE s.jf: opArgs := 1; opString := "jf"; ENDCASE
      CASE s.endfor: opArgs := 1; opString := "endfor"; ENDCASE
      CASE s.lab: opArgs := 1; opString := "lab"; ENDCASE
      CASE s.stack: opArgs := 1; opString := "stack"; ENDCASE
      CASE s.store: opString := "store"; ENDCASE
      CASE s.rstack: opArgs := 1; opString := "rstack"; ENDCASE
      CASE s.entry: WrCh('*n');
		    extraOp := ReadN(); opArgs := extraOp;
		    extraOp2 := ReadN(); argIsString := TRUE;
		    opString := "entry"; ENDCASE
      CASE s.save: opArgs := 1; opString := "save"; ENDCASE
      CASE s.fnrn: opString := "fnrn"; ENDCASE
      CASE s.rtrn: opString := "rtrn"; ENDCASE
      CASE s.res: opArgs := 1; opString := "res"; ENDCASE
      CASE s.datalab: opArgs := 1; opString := "datalab"; ENDCASE
      CASE s.iteml: opArgs := 1; opString := "iteml"; ENDCASE
      CASE s.itemn: opArgs := 1; opString := "itemn"; ENDCASE
      CASE s.endproc: opArgs := 1; opString := "endproc"; ENDCASE

//	CASE s.endblock

      CASE s.nil: opString := "nil"; ENDCASE
      CASE s.stnil: opString := "stnil"; ENDCASE

      CASE s.slctap: opString := "slctap"; opArgs := 3; ENDCASE
      CASE s.slctst: opString := "slctst"; opArgs := 3; ENDCASE

      CASE s.car: opString := "car"; ENDCASE
      CASE s.cdr: opString := "cdr"; ENDCASE
      CASE s.vcar: opString := "vcar"; ENDCASE
      CASE s.vcdr: opString := "vcdr"; ENDCASE

      CASE s.stcar: opString := "stcar"; ENDCASE
      CASE s.stcdr: opString := "stcdr"; ENDCASE
      CASE s.stvcar: opString := "stvcar"; ENDCASE
      CASE s.stvcdr: opString := "stvcdr"; ENDCASE

      CASE s.linecount: opArgs := 1; opString := "linecount"; ENDCASE

      CASE s.mod: opString := "mod"; ENDCASE

      CASE s.getbyte: opString := "getbyte"; ENDCASE
      CASE s.putbyte: opString := "putbyte"; ENDCASE

      CASE s.debug: opString := "debug"; ENDCASE
      CASE s.dtab:  opArgs := 2; opString := "dtab"; ENDCASE
   $)
$)
