91300 #include "rundecs.h"
91310     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
91320 (**)
91330 (*+05() PROCEDURE FLSBUF(P: PCFILE; CH: CHAR); EXTERN; ()+05*)
91340 (*+02()
91350 PROCEDURE STOPEN (VAR PF: FYL; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH(COV:OBJECTP;L:LFNTYPE) ); EXTERN;
91360 ()+02*)
91370 (**)
91380 (**)
91390 (**)
91400 (*******STAND OUT PRIMITIVES*******)
91410 PROCEDURE SONEWLINE(COV:OBJECTP; VAR FYLE :FYL);
91420 (*+05()
91430   PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
91440 ()+05*)
91450     BEGIN WITH COV^ DO
91460       BEGIN LOFCPOS:=LOFCPOS+1;
91470       COFCPOS:=1;
91480 (*+05()
91490       WITH BOOK^ DO
91500         IF (*ISTTY*) (XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
91510           FLSBUF(XFILE, CHR(10))
91520         ELSE WRC(XFILE, CHR(10));
91530 ()+05*)
91540 (*-05() WRITELN(FYLE); ()-05*)
91550       IF LOFCPOS>LINEBOUND THEN STATUS:=STATUS+[PAGEOVERFLOW,LINEOVERFLOW]
91560       ELSE BEGIN STATUS:=STATUS-[LINEOVERFLOW];
91570         IF CARRIAGE IN STATUS THEN WRITE(FYLE, ' ')
91580         END
91590       END
91600     END;
91610 (**)
91620 (**)
91630 PROCEDURE SONEWPAGE(COV:OBJECTP; VAR FYLE :FYL);
91640   VAR I: INTEGER;
91650     BEGIN WITH COV^ DO
91660       BEGIN
91670       IF COFCPOS<>1 THEN SONEWLINE(COV, FYLE);
91680 (*+05()
91690       IF (*ISTTY*) (BOOK^.XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
91700         FOR I := LOFCPOS TO LINEBOUND DO SONEWLINE(COV, FYLE)
91710       ELSE
91720 ()+05*)
91730 (*-50() PAGE(FYLE);   ()-50*)
91740 (*+50() PUTSEG(FYLE); ()+50*)
91750       COFCPOS:=1; LOFCPOS:=1; POFCPOS:=POFCPOS+1;
91760       STATUS:=STATUS-[PAGEOVERFLOW,LINEOVERFLOW];
91770       IF POFCPOS>PAGEBOUND THEN
91780         STATUS:=STATUS+[PFE,PAGEOVERFLOW,LINEOVERFLOW]
91790       ELSE IF CARRIAGE IN STATUS THEN WRITE(FYLE, '1')
91800       END
91810     END;
91820 (**)
91830 (**)
91840 PROCEDURE SORESET(COV: OBJECTP; VAR FYLE: FYL);
91850 (*OPENED,MOODOK*)
91860     BEGIN WITH COV^ DO
91870       BEGIN
91880       IF RESETPOSS IN POSSIBLES THEN
91890         BEGIN (*+01()(*-52()BOOK^.STATUS := 15B; (*TO FIX A BUG IN PASCAL MK 2*) ()-52*)()+01*)
91900         REWRITE(FYLE)
91910         END;
91920       IF CARRIAGE IN STATUS THEN
91930         WRITE(FYLE, '1');
91940       STATUS := STATUS-[NOTRESET]
91950       END
91960     END;
91970 (**)
91980 (**)
91990 (*+01() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; VAR FYLE: FYL); ()+01*)
92000 (*+02() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+02*)
92010 (*+05() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+05*)
92020   (*POSN OF NEXT WIDTH CHARS ENSURED*)
92030   VAR I, WIDTH, J, WORD: INTEGER;
92040       PTR: UNDRESSP;
92050 (*+01()
92060   (*$X0*)
92070   PROCEDURE WRS(VAR FYLE: FYL; ADDR: UNDRESSP; FLDLGTH, STRLGTH: INTEGER); EXTERN;
92080   PROCEDURE WRSN(VAR FYLE: FYL; SHORTSTR: INTEGER; FLDLGTH, STRLGTH: INTEGER); EXTERN;
92090   (*$X4*)
92100 ()+01*)
92110 (*+02()
92120       CPTR: IPOINT;
92130   PROCEDURE WRC(CH :CHAR; FIL :FETROOMP); EXTERN;
92140   PROCEDURE WRS(LEN :INTEGER; CP :IPOINT; FIL :FETROOMP); EXTERN;
92150 ()+02*)
92160 (*+05()
92170       CPTR: CHARPOINT ;
92180   PROCEDURE WRS(P: PCFILE; CP: CHARPOINT; LEN: INTEGER ); EXTERN;
92190   PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
92200 ()+05*)
92210     BEGIN
92220 (*+01()
92230     WIDTH := 1;
92240     IF LB<0 THEN WRITE(FYLE,CHR(UB))
92250     ELSE BEGIN
92260       LB := LB-1;
92270       PTR := INCPTR(STRNG, STRINGCONST + LB DIV CHARPERWORD);
92280       WIDTH := UB-LB;
92290       IF LB MOD CHARPERWORD <> 0 THEN
92300         BEGIN
92310         IF WIDTH <= CHARPERWORD - LB MOD CHARPERWORD THEN I := WIDTH ELSE I := CHARPERWORD - LB MOD CHARPERWORD;
92320         WORD := PTR^.FIRSTWORD;
92330         FOR J := 1 TO LB MOD CHARPERWORD DO WORD := WORD * CHARSPACE ;
92340         WRSN(FYLE, WORD, I, I);
92350         PTR := INCPTR(PTR, SZWORD);
92360         END
92370       ELSE I := 0;
92380       WRS(FYLE, PTR, WIDTH-I, WIDTH-I)
92390       END;
92400 ()+01*)
92410 (*+02()
92420     IF LB<0 THEN (*CHAR*)
92430       BEGIN
92440       WIDTH := 1;
92450       WRC(CHR(UB),EFET);
92460       END
92470     ELSE (*STRING*)
92480       BEGIN
92490       WIDTH:=UB-LB+1;
92500       CPTR:= ORD(STRNG) + STRINGCONST + (LB *(SZWORD DIV CHARPERWORD)-1);
92510       WRS(WIDTH,CPTR,EFET);
92520       END;
92530 ()+02*)
92540 (*+05()
92550     IF LB<0 THEN
92560       BEGIN
92570       WIDTH := 1;
92580       WRC(EFET^.XFILE, CHR(UB))
92590       END
92600     ELSE BEGIN
92610       WIDTH := UB - LB + 1;
92620       CPTR := ASPTR(( ORD( STRNG ) + STRINGCONST )*2 + LB - 1) ;
92630       WRS( EFET^.XFILE , CPTR ,  WIDTH ) ;
92640       END;
92650 ()+05*)
92660     WITH COV^ DO
92670       BEGIN COFCPOS:=COFCPOS+WIDTH;
92680       IF COFCPOS>CHARBOUND THEN
92690         STATUS:=STATUS+[LINEOVERFLOW];
92700       END;
92710     END;
92720 (**)
92730 (**)
92740 (*-02()
92750 BEGIN (*OF A68*)
92760 END; (*OF A68*)
92770 ()-02*)
92780 (*+01()
92790 BEGIN (*OF MAIN PROGRAM*)
92800 END  (*OF EVERYTHING*).
92810 ()+01*)