Files
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/09/tex.plm
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

1679 lines
46 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* TEX
COPYRIGHT (C) 1978, 1979
DIGITAL RESEARCH
BOX 579
PACIFIC GROVE, CA 93950
FT command added, MP/M 1.0 modifications - 7/24/79
*/
TEX:
DO;
DECLARE
TEXJMP BYTE DATA(0C3H),
TEXADR ADDRESS DATA(.TEXCOMMAND-3);
DECLARE COPYRIGHT (*) BYTE DATA
(' COPYRIGHT (C) 1978, 1979 DIGITAL RESEARCH ');
DECLARE VERDATE LITERALLY '''7/24/79''';
DECLARE
MAXB ADDRESS EXTERNAL,
FCB (33) BYTE EXTERNAL,
BUFF(128) BYTE EXTERNAL;
DECLARE LIT LITERALLY 'LITERALLY',
DCL LIT 'DECLARE',
ADDR LIT 'ADDRESS',
PROC LIT 'PROCEDURE',
TRUE LIT '0FFH',
FALSE LIT '0',
FOREVER LIT 'WHILE TRUE';
DCL CR LIT '0DH', /* CARRIAGE RETURN */
LF LIT '0AH', /* LINE FEED */
FF LIT '0CH', /* FORMS FEED */
TAB LIT '09H', /* TAB */
QM LIT '3FH', /* ? */
EXCL LIT '21H', /* ! */
ENDFILE LIT '1AH'; /* CP/M END OF FILE */
/* DEFAULT VALUES */
DCL DEFPL LIT '66', /* PAGE LENGTH */
DEFTL LIT '55', /* TEXT LENGTH */
DEFMT LIT '6', /* TOP MARGIN */
DEFMB LIT '5'; /* BOTTOM MARGIN */
DCL DEFLS LIT '1'; /* LINE SPACING */
DCL DEFLL LIT '70', /* LINE LENGTH */
DEFLM LIT '8', /* LEFT MARGIN */
DEFIM LIT '0', /* INDENT MARGIN */
DEFPP LIT '6', /* PARAGRAPH INDENT */
DEFPW LIT '78'; /* PAGE WIDTH */
dcl maxcolumn lit '132'; /* max column -1 */
DCL MAXLINE LIT '160'; /* MAX LINE LENGTH */
DCL TABSIZE LIT '20', /* SIZE OF TAB ARRAY */
TABEND LIT '19', /* END OF TAB ARRAY */
TABLAST LIT '18'; /* LAST POSSIBLE TAB */
DCL SERIAL (6) BYTE INITIAL (6,5,4,3,2,1);
DCL TABARRAY(TABSIZE) BYTE INITIAL(8,16,24,32,40,48,56,64,72,80,
88,96,104,112,120,128,136,144,152,255);
DCL PATCH (128) BYTE;
DCL COLUMN BYTE;
DCL BDOSLOC LIT 'MAXB'; /* BDOS LOCATION */
DCL TEX$BUFF LIT 'BUFF'; /* INITIAL INPUT LINE */
DCL SFCB LIT 'FCB';
DCL DFCB (33) BYTE;
DCL NBUFF LIT '32';
DCL RECORD LIT '128';
DCL TLINE BYTE; /* INTERMEDIATE LINE POINTER */
DCL WLINE BYTE; /* BEGINNING OF PARTIAL WORD */
DCL DLINE BYTE; /* 'FROM' POINTER IN LINE EXPANSION */
DCL ELINE BYTE; /* END OF LAST COMPLETE WORD */
DCL FLINE BYTE; /* FIRST CHAR IN PRINT LINE */
DCL NLINE BYTE; /* NEXT CHAR IN PRINT LINE */
DCL LINE(256) BYTE; /* CIRCULAR BUFFER FOR PRINT LINE */
DCL SBUFFA ADDR; /* ADDRESS - SOURCE BUFFER */
DCL SBUFFL ADDR; /* LENGTH - SOURCE BUFFER */
DCL SBUFF BASED SBUFFA(128) BYTE;
DCL NSOURCE ADDR; /* COUNTER FOR SOURCE BUFFER */
DCL DBUFFA ADDR; /* ADDRESS - DESTINATION BUFFER */
DCL DBUFFL LIT 'SBUFFL'; /* LENGTH - DSTNATN BUFFER */
DCL DBUFF BASED DBUFFA(128) BYTE;
DCL NDEST ADDR; /* COUNTER FOR DESTINATION BUFFER */
DCL LINECOUNT ADDRESS;
DCL PAGECOUNT ADDRESS;
/* HORIZONTAL SPACING PARAMETERS */
DCL LINELENGTH BYTE;
DCL LEFT$MARGIN BYTE;
DCL INDENT$MARGIN BYTE;
DCL NINDENT BYTE; /* PARAGRAPH INDENT VALUE */
DCL PAGEWIDTH BYTE; /* INDENT$MARGIN+LINELENGTH */
/* VERTICAL SPACING PARAMETERS */
DCL PAGELENGTH BYTE; /* PAGELENGTH=TOP$MARGIN+TEXTLENGTH+BOT$MARGIN*/
DCL TEXTLENGTH BYTE;
DCL TOP$MARGIN BYTE;
DCL MT1 BYTE; /* TOP MARGIN ABOVE HEADING */
DCL MT2 BYTE; /* TOP MARGIN BETWEEN HEADING AND TEXT */
DCL BOT$MARGIN BYTE;
DCL LSPACING BYTE;
DCL TOOLONG LIT 'LINECOUNT>=TEXTLENGTH+TOP$MARGIN'; /*LAST TEXT LINE*/
/* SWITCHES */
DCL LEFT$FLUSH BYTE;
DCL RIGHT$FLUSH BYTE;
DCL FLUSH LIT 'LEFT$FLUSH OR RIGHT$FLUSH';
DCL TEMP$INDENT BYTE; /*SET BY .TI COMMAND*/
DCL LINELENGTH$CHG BYTE, /*SET BY .LL COMMAND*/
LONG$LINELENGTH BYTE;
DCL HEADER$SCAN BYTE; /*SET BY EVERY COMMAND*/
DCL LCASE BYTE;
DCL FORMS$FEED BYTE; /*SET BY $F PARAMETER*/
DCL PAGE$MODE BYTE; /*SET BY $P PARAMETER*/
DCL LSTERR BYTE; /*SET BY $E PARAMETER*/
DCL LSTOUT BYTE; /*SET BY $L $C PARAMS*/
DCL FIRSTPAGE BYTE, /*SET BY FIRST TEXT LINE*/
SAV$LINELENGTH BYTE;
DCL NUMBER$PAGES BYTE;
DCL OUT$DEVCE BYTE;
DCL START$STATE LIT '0',
WORDS$STATE LIT '1',
BLANKS$STATE LIT '2',
ENDSENT$STATE LIT '3',
SKIP$STATE LIT '4';
DCL SCAN$STATE BYTE;
DCL R$TO$L BYTE; /* SCAN DIRECTION FOR STUFFING BLANKS */
DCL STUFF BYTE; /* NUMBER OF BYTES TO STUFF */
dcl footbuf(133) byte; /* contains foot */
DCL HEADBUF(133) BYTE; /* CONTAINS PAGE HEADING */
DCL ERRBUF(256) BYTE, /* CONTAINS LATEST 256 BYTES OF SOURCE */
ERRCNT BYTE,
ERRPTR BYTE; /* NEXT TO FILL */
DCL NSIGN BYTE; /* COMMAND ARGUMENT MAY BE INCREMENTAL - (255),
ABSOLUTE (0), OR INCREMENTAL + (1) */
DCL LOOKED BYTE, /* TRUE IF LOOKED AHEAD */
LOOKCHR BYTE; /* LOOKAHEAD CHAR */
/* GLOBAL DEFAULTS FOR LOCAL VARIABLES */
DCL C BYTE; /* CHARACTER */
DCL I BYTE; /* INDEX */
/* * * * * * * * * LIBRARY FOR CP/M INTERFACE * * * * * * * * */
DCL DCNT BYTE,
MAXLEN BYTE;
MON1: PROCEDURE(F,A) EXTERNAL;
DCL F BYTE,
A ADDRESS;
END MON1;
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
DCL F BYTE,
A ADDRESS;
END MON2;
BOOT: PROCEDURE EXTERNAL;
END BOOT;
DECLARE REBOOT LITERALLY 'BOOT';
READCHAR: PROC BYTE;
RETURN MON2(1,0);
END READCHAR;
PRINTCHAR: PROC(CHAR); /* PRINT TO CON: DEVICE */
DCL CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;
CRLF: PROC;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;
WRITELST: PROC(CHAR); /* WRITE TO LST: DEVICE */
DCL CHAR BYTE;
CALL MON1(5,CHAR);
END WRITELST;
PRINT: PROC(A);
DCL A ADDR;
CALL CRLF;
CALL MON1(9,A);
END PRINT;
READ: PROC(A);
DCL A ADDR;
CALL MON1(10,A);
END READ;
CONSTAT: PROC BYTE;
RETURN MON2(11,0);
END CONSTAT;
INITIALIZE: PROC;
CALL MON1(13,0);
END INITIALIZE;
OPEN: PROC(FCB);
DCL FCB ADDR;
DCNT=MON2(15,FCB);
END OPEN;
CLOSE: PROC(FCB);
DCL FCB ADDR;
DCNT=MON2(16,FCB);
END CLOSE;
SEARCH: PROC(FCB);
DCL FCB ADDR;
DCNT=MON2(17,FCB);
END SEARCH;
DELETE: PROC(FCB);
DCL FCB ADDR;
CALL MON1(19,FCB);
END DELETE;
DISKREAD: PROC(FCB) BYTE;
DCL FCB ADDR;
RETURN MON2(20,FCB);
END DISKREAD;
DISKWRITE: PROC(FCB) BYTE;
DCL FCB ADDR;
RETURN MON2(21,FCB);
END DISKWRITE;
MAKE: PROC(FCB);
DCL FCB ADDR;
DCNT=MON2(22,FCB);
END MAKE;
SETDMA: PROC(BUF);
DCL BUF ADDR;
CALL MON1(26,BUF);
END SETDMA;
READCOM: PROC;
MAXLEN=128;
CALL READ(.MAXLEN);
END READCOM;
BREAK$KEY: PROC BYTE;
RETURN MON2(11,0);
END BREAK$KEY;
/* * * * * * * * * END OF CP/M INTERFACE LIBRARY * * * * * * * * */
CRLF$ERR: PROC;
IF LSTERR THEN
DO;
CALL WRITELST(CR);
CALL WRITELST(LF);
END;
ELSE CALL CRLF;
END CRLF$ERR;
PRINTCHAR$ERR: PROC (C);
DCL C BYTE;
IF LSTERR
THEN CALL WRITELST(C);
ELSE CALL PRINTCHAR(C);
END PRINTCHAR$ERR;
PRINT$ERR: PROC(A);
DCL A ADDR;
DCL (C,I) BYTE;
DCL CHAR BASED A (80) BYTE;
I=255;
IF LSTERR THEN
DO;
CALL WRITELST(CR);
CALL WRITELST(LF);
DO WHILE (C:=CHAR(I:=I+1))<>'$';
CALL WRITELST(C);
END;
END;
ELSE CALL PRINT(A);
END PRINT$ERR;
LAST: PROC; /* SIGN OFF */
IF NOT LSTOUT THEN
DO;
CALL SETDMA(.BUFF);
CALL CLOSE(.DFCB);
END;
CALL CRLF;
CALL PRINT (.('TEX FINISHED$'));
CALL CRLF;
CALL REBOOT;
END LAST;
ERROR: PROC(STRING);
DCL I BYTE;
DCL STRING ADDRESS;
CALL PRINT$ERR (.('ERROR DURING $'));
CALL PRINT$ERR (STRING);
CALL CRLF$ERR;
IF ERRCNT>0 THEN
DO;
CALL PRINT$ERR (.('INPUT CONTEXT:$'));
CALL CRLF$ERR;
I = ERRPTR - ERRCNT;
DO WHILE (I:=I+1) <> (ERRPTR+1);
CALL PRINTCHAR$ERR (ERRBUF(I));
END;
CALL CRLF$ERR;
END;
END ERROR;
FERROR: PROC(STRING); /* FATAL ERROR */
DCL STRING ADDR;
CALL ERROR (STRING);
CALL PRINT$ERR (.('THIS ERROR TERMINATES TEX$'));
CALL LAST;
END FERROR;
FILL: PROC(S,F,C); /* FILL STRING S FOR C BYTES WITH F */
DCL S ADDR,
(F,C) BYTE,
A BASED S BYTE;
DO WHILE (C:=C-1)<>255;
A = F;
S = S+1;
END;
END FILL;
COPY: PROC(S,D,C); /* COPY C BYTES FROM S TO D */
DCL (S,D) ADDR, C BYTE;
DCL A BASED S BYTE, B BASED D BYTE;
DO WHILE (C:=C-1)<>255;
B=A; S=S+1; D=D+1;
END;
END COPY;
FILLSOURCE: PROC; /* INPUT IS ON DISK FILE */
DCL ERRCODE BYTE;
DCL BUFFADD ADDR;
DCL BYT BASED BUFFADD BYTE;
BUFFADD=.SBUFF;
DO WHILE BUFFADD<.SBUFF(SBUFFL);
CALL SETDMA(BUFFADD);
IF (ERRCODE:=DISKREAD(.SFCB)) <> 0 THEN
DO;
IF ERRCODE>1 THEN CALL FERROR(.('FILE READ$'));
ELSE DO;
BYT=ENDFILE;
GO TO XIT;
END;
END;
ELSE DO;
NSOURCE=NSOURCE+RECORD;
BUFFADD=BUFFADD+RECORD;
END;
END;
XIT: NSOURCE=0;
END FILLSOURCE;
GETSOURCE: PROC BYTE;
DCL B BYTE;
IF LOOKED THEN /* USE LOOKAHEAD CHARACTER */
DO; LOOKED = FALSE; RETURN LOOKCHR;
END;
IF NSOURCE>=SBUFFL THEN CALL FILLSOURCE;
B=SBUFF(NSOURCE);
NSOURCE=NSOURCE+1;
IF ERRCNT < 255 THEN
ERRCNT = ERRCNT + 1;
ERRBUF(ERRPTR:=ERRPTR+1) = B;
RETURN B;
END GETSOURCE;
LOOKAHEAD: PROCEDURE;
/* FILL THE LOOKCHR WITH LOOKAHEAD CHARACTER, IF NOT READY */
IF NOT LOOKED THEN
DO; LOOKCHR = GETSOURCE; LOOKED = TRUE;
END;
END LOOKAHEAD;
GETMORE: PROC BYTE; /* GETSOURCE SHOULD NOT RETURN END OF FILE */
DCL C BYTE;
IF (C:=GETSOURCE) = ENDFILE
THEN CALL FERROR(.('READING EOF$'));
ELSE RETURN C;
END GETMORE;
WRITEDEST: PROC; /* WRITE TO DISK FROM DBUFF THROUGH (NDEST) */
DCL BUFFADD ADDR;
BUFFADD=.DBUFF;
DO WHILE BUFFADD<.DBUFF(NDEST);
CALL SETDMA(BUFFADD);
IF DISKWRITE(.DFCB)<>0 THEN CALL FERROR(.('DISK WRITE$'));
ELSE BUFFADD=BUFFADD+RECORD;
END;
NDEST=0;
END WRITEDEST;
PUTDEST: PROC(C);
DCL C BYTE;
DCL (I,TABCOL) BYTE;
PUTTHECHAR: PROCEDURE(C);
DECLARE C BYTE;
COLUMN=COLUMN+1;
IF LSTOUT THEN
DO;
IF OUT$DEVCE=1 /* LST: */
THEN CALL WRITELST(C);
ELSE IF OUT$DEVCE=2 /* CON: */
THEN CALL PRINTCHAR(C);
ELSE; /* SUPPRESS OUTPUT */
IF CONSTAT
THEN IF READCHAR=CR
THEN CALL REBOOT; /* ABORT LSTOUT WITH CR */
END;
ELSE DO; /* DISK OUTPUT */
DBUFF(NDEST)=C;
NDEST=NDEST+1;
IF NDEST>=DBUFFL THEN
CALL WRITEDEST;
END;
END PUTTHECHAR;
IF C = LF THEN
DO;
CALL PUTTHECHAR(C);
COLUMN=1;
END;
ELSE
IF C = TAB THEN
DO;
I = 0;
DO WHILE (TABCOL:=TABARRAY(I)) <= COLUMN;
I = I + 1;
END;
IF TABCOL=255 THEN RETURN;
DO WHILE TABCOL > COLUMN;
CALL PUTTHECHAR(' ');
END;
END;
ELSE CALL PUTTHECHAR(C);
END PUTDEST;
PUT$LEFT$MARGIN: PROCEDURE;
DCL I BYTE;
I=LEFT$MARGIN;
DO WHILE (I:=I-1)<>255;
CALL PUTDEST(' ');
END;
COLUMN=1;
END PUT$LEFT$MARGIN;
OUTLINE: PROC; /* SEND TO DEST FROM LINE(FLINE) TO LINE(NLINE) */
DCL I BYTE;
/* PUT SPACES FOR LEFT MARGIN (SET BY .PO) */
CALL PUT$LEFT$MARGIN;
IF NOT TEMP$INDENT THEN /* SET BY .TI COMMAND */
DO; /* PUT SPACES FOR INDENT MARGIN (SET BY .IN) */
I=INDENT$MARGIN;
DO WHILE (I:=I-1) <> 255;
CALL PUTDEST(' ');
END;
END;
I=FLINE;
DO WHILE I<>NLINE;
CALL PUTDEST(LINE(I));
I=I+1;
END;
CALL PUTDEST(CR);
CALL PUTDEST(LF);
LINECOUNT=LINECOUNT+1;
END OUTLINE;
CENTSTUB: PROC; /* PREFIX BLANKS TO PRINT FLINE THROUGH */
DCL CNTR BYTE; /* NLINE CENTERED. COUNTS AND STUFFS BACK IN LINE */
/* NOT USABLE BY ENDPAGE */
CNTR=SHR(LINELENGTH-(NLINE-FLINE),1);
DO WHILE (CNTR:=CNTR-1)<>255;
LINE(FLINE:=FLINE-1)=' ';
END;
CALL OUTLINE; /* PRINT IF NONEMPTY */
FLINE=NLINE;
END CENTSTUB;
WRITEBLANK: PROC; /* PRINT AND COUNT A BLANK LINE */
CALL PUTDEST(CR); CALL PUTDEST(LF);
LINECOUNT=LINECOUNT+1;
END WRITEBLANK;
WRITEHEAD: PROC; /* WRITE HEADING TITLE IN TOP MARGIN */
DCL (I,J) BYTE;
/* WRITE LEFT MARGIN */
CALL PUT$LEFT$MARGIN;
/* WRITE CONTENTS OF HEADBUF */
I=255;
DO WHILE (I:=I+1)<SAV$LINELENGTH
AND (J:=HEADBUF(I))<>0; /*HEADBUF(132)=0*/
CALL PUTDEST (J);
END;
CALL WRITEBLANK;
END WRITEHEAD;
ENDPAGE: PROC; /* SPACE OUT THE CURRENT PAGE INCLUDING TRAILER BOT$MARGIN */
/*
FOR NOW, NEXT PARTIAL LINE MAY BE FLINE TO NLINE
OR WLINE TO TLINE. STANDARDIZE THAT, AND NEWPAGE
CAN THEN USE CENTSTUB FOR FORMATION OF LINE NUMBERS
*/
DCL TEMP ADDR;
dcl tmp byte at (.temp);
DCL NUM BYTE;
DCL PFOOT BYTE;
DCL FOOT(5) BYTE;
DCL (B,I) BYTE;
/* SKIP TO BOTTOM OF PAGE */
DO WHILE LINECOUNT < TEXTLENGTH+TOP$MARGIN;
CALL WRITEBLANK;
END;
/* WRITE BOTTOM MARGIN */
IF BOT$MARGIN>0 THEN
DO;
B = SHR(BOT$MARGIN,1);
if b > 2 then
do;
do while b <> 2;
b = b - 1;
call writeblank;
end;
call put$left$margin;
i = -1;
do while (tmp:=footbuf(i:=i+1)) <> 0;
call putdest (tmp);
end;
end;
DO I=1 TO B;
CALL WRITEBLANK;
END;
/* PRINT PAGE NUMBER */
IF NUMBER$PAGES THEN
DO;
TEMP=PAGECOUNT;
PFOOT=255;
DO WHILE TEMP<>0;
NUM=TEMP-TEMP/10*10; /* LSD FIRST */
FOOT(PFOOT:=PFOOT+1)=NUM+'0';
TEMP=TEMP/10;
END;
/* CENTER THE NUMBER */
B = LEFT$MARGIN+SHR(SAV$LINELENGTH-PFOOT,1);
DO I=1 TO B;
CALL PUTDEST(' ');
END;
PFOOT=PFOOT+1;
DO WHILE (PFOOT:=PFOOT-1)<>255;
CALL PUTDEST(FOOT(PFOOT));
END;
CALL WRITEBLANK;
END;
PAGECOUNT=PAGECOUNT+1;
DO WHILE LINECOUNT < PAGELENGTH;
CALL WRITEBLANK;
END;
END;
LINECOUNT=0;
/* FORMS FEED TO BOTTOM OF PHYSICAL PAGE? */
IF FORMS$FEED THEN CALL PUTDEST (FF);
/* STOP PRINTING TO CHANGE PAPER? */
IF PAGE$MODE THEN
DO;
IF OUT$DEVCE<>2 THEN /*CON:*/
CALL PRINT (.('INSERT NEW PAGE; THEN TYPE RETURN$'));
DO WHILE READCHAR<>CR; END; /* WAIT FOR CONSOLE CR */
END;
END ENDPAGE;
HEADER: PROC;
DCL I BYTE;
/* TO ASSURE PAGE# POSITION DOES NOT CHANGE
WITH INDENTING, SAVE ORIGINAL LINELENGTH
AND LEFTMARGIN.
(.PO OR .PN COMMAND CAN RESET VALUES.) */
IF FIRSTPAGE THEN
DO;
SAV$LINELENGTH = LINELENGTH;
FIRSTPAGE = FALSE;
END;
/* PUT TOP MARGIN */
IF TOP$MARGIN<>0 THEN
DO;
IF HEADBUF(0)=0 THEN /* NO HEADING TITLE */
DO I=1 TO TOP$MARGIN;
CALL WRITEBLANK;
END;
/* PRINT HEADING TITLE WITH MARGIN (MT1) */
ELSE DO; /* ABOVE AND HEADING MARGIN (MT2) BELOW */
DO I =1 TO MT1;
CALL WRITEBLANK;
END;
CALL WRITEHEAD;
DO I=1 TO MT2;
CALL WRITEBLANK;
END;
END;
END;
END HEADER;
SKIPLINES: PROC(COUNT);
/* SKIP 'COUNT' LINES OF TEXT, NOT TO PASS PAGE BOUNDARY */
/* NOTE: THIS PROC CAN INSERT BLANK LINES AT TOP OF PAGE */
DCL COUNT BYTE;
IF LINECOUNT=0 THEN CALL HEADER;
IF LINECOUNT+COUNT < TEXTLENGTH+TOP$MARGIN THEN
DO WHILE (COUNT:=COUNT-1) <> 255;
CALL WRITEBLANK; /* INCREMENTS LINECOUNT */
END;
ELSE CALL ENDPAGE;
END SKIPLINES;
DUMPLINE: PROC; /* PRINT FLINE TO NLINE */
/* WLINE TO TLINE MAY BE RECLAIMABLE */
DCL I BYTE;
IF LINECOUNT=0 THEN CALL HEADER;
CALL OUTLINE;
IF TOOLONG THEN CALL ENDPAGE;
I=0;
DO WHILE (I:=I+1)<LSPACING AND LINECOUNT>0;
CALL WRITEBLANK;
IF TOOLONG THEN CALL ENDPAGE;
END;
END DUMPLINE;
FLUSHLINE: PROC; /* DELIMIT AND FORCE A SHORT LINE IF NONEMPTY */
IF NLINE<>FLINE THEN CALL DUMPLINE;
FLINE,ELINE,WLINE=NLINE;
END FLUSHLINE;
SET$LENGTH: PROCEDURE BYTE;
DECLARE LL BYTE;
LL = LINELENGTH;
IF LINELENGTH$CHG THEN
LL = LONG$LINELENGTH;
IF TEMP$INDENT THEN
LL = LL + INDENT$MARGIN;
RETURN LL;
END SET$LENGTH;
FORMAT: PROC;
DCL C BYTE;
DCL NO$BL BYTE;
DCL BLCNT1 BYTE,
BLCNT2 BYTE,
WDCNT BYTE;
/* IN LINE, PRINT STRING IS FLINE THROUGH ELINE */
/* ELINE IS START OF LAST BLANKS STRING */
/* WLINE IS START OF LAST WORD */
/* NLINE IS NEXT POSITION */
TLINE=NLINE;
IF WLINE=FLINE OR ELINE=FLINE THEN /* WORD IS TOO BIG */
DO;
WLINE=NLINE; /* PRINT PRESENT PARTIAL WORD */
CALL ERROR (.('FITTING A WORD$'));
RETURN;
END;
ELSE IF WLINE-ELINE>127 THEN /* ENDED WITH A BLANK STRING */
DO;
TLINE,WLINE=NLINE;
NLINE=ELINE;
RETURN;
END;
ELSE NLINE=ELINE; /* PRINT TO END OF LAST COMPLETE WORD */
/* PRINT IMAGE IS IN FLINE TO NLINE */
/* GARBAGE FROM NLINE TO WLINE */
/* OVERFLOW IS IN WLINE TO TLINE */
/* MOVE OVERFLOW TO RIGHT, MAKING ROOM TO STUFF BLANKS */
STUFF = (SET$LENGTH) - (NLINE-FLINE);
/* PRESCAN TO LEAVE ANY LEFT-HAND PREFIX OF BLANKS
(AS FROM .PP COMMAND) OUTSIDE THE SCOPE OF THE
BLANK-EXPANDING ALGORITHM */
BLCNT1,BLCNT2,WDCNT = 0;
/* BLCNT1 COUNTS THE PREFIXING BLANKS (NOT PADDED OUT),
WDCNT COUNTS THE LENGTH OF THE FIRST WORD WHEN AT BEGINNING
OF A PARAGRAPH (OFTEN A SECTION HEADING), AND
BLCNT2 COUNTS THE BLANKS FOLLOWING THE FIRST WORD */
DO WHILE LINE(FLINE) = ' ';
/* COUNT PRECEDING BLANKS ON THE LINE */
BLCNT1 = BLCNT1 + 1;
IF (FLINE := FLINE + 1) = NLINE THEN RETURN;
END;
IF HEADER$SCAN THEN
DO; /* SCAN PAST FIRST WORD FOLLOWING A COMMAND */
HEADER$SCAN = FALSE;
DO WHILE LINE(FLINE) <> ' ';
WDCNT = WDCNT + 1;
IF (FLINE := FLINE + 1) = NLINE THEN GO TO SHORTLINE;
END;
IF LINE(FLINE-1) >= 'A' THEN GO TO SHORTLINE; /*SPECIAL CHAR?*/
/* WDCNT IS THE FIRST WORD LENGTH */
DO WHILE LINE(FLINE) = ' ';
BLCNT2 = BLCNT2 + 1;
IF (FLINE := FLINE + 1) = NLINE THEN GO TO SHORTLINE;
END;
/* BLCNT2 COUNTS REMAINING BLANKS */
END;
GO TO LONGLINE;
SHORTLINE:
/* IN SCANNING HEADER, LINE WAS TOO SHORT OR NONSPECIAL CHARACTER, SO FORGET IT */
FLINE = FLINE-WDCNT-BLCNT2;
BLCNT2,WDCNT = 0;
LONGLINE:
ELINE = TLINE - 1;
DO WHILE ELINE <> WLINE;
LINE(ELINE+STUFF) = LINE(ELINE);
ELINE = ELINE - 1;
END;
LINE(ELINE+STUFF)=LINE(ELINE);
TLINE=TLINE+STUFF;
WLINE=WLINE+STUFF;
DO FOREVER;
NO$BL=TRUE;
IF R$TO$L THEN
DO;
ELINE=NLINE+STUFF; /* 'TO' POINTER */
DLINE=NLINE; /* 'FROM POINTER */
NLINE=ELINE;
DO WHILE DLINE<>FLINE; /* GO TO END OF LINE */
C , LINE(ELINE:=ELINE-1) = LINE(DLINE:=DLINE-1);
IF C=' ' AND STUFF<>0 THEN
DO;
NO$BL=FALSE;
LINE(ELINE:=ELINE-1)=' ';
STUFF=STUFF-1;
END;
END;
R$TO$L=FALSE;
FLINE=ELINE;
IF STUFF=0 THEN GO TO UNPATCH;;
END; /* OF RIGHT TO LEFT SCAN */
ELSE DO;
DLINE=FLINE-1; /* 'FROM' POINTER */
FLINE=FLINE-STUFF;
ELINE=FLINE-1; /* 'TO' POINTER */
DO WHILE DLINE<>NLINE-1; /* SCAN THE WHOLE LINE */
C , LINE(ELINE:=ELINE+1) = LINE(DLINE:=DLINE+1);
IF C=' ' AND STUFF<>0 THEN
DO;
NO$BL=FALSE;
LINE(ELINE:=ELINE+1)=' ';
STUFF=STUFF-1;
END;
END; /* OF LINE */
R$TO$L=TRUE;
NLINE=ELINE+1;
IF NO$BL OR STUFF=0 THEN GO TO UNPATCH; /* IF ONE WORD, RETURN LEFT JUSTIFIED */
END;
END; /* OF FOREVER */
UNPATCH: /* RESTORE ANY PREFIX OF BLANKS & WORDS
EXCLUDED FROM STUFF ALGORITHM */
FLINE = FLINE - WDCNT - BLCNT2 ;/* RESTORE PREFIX ON LINE */
/* RESTORE BLANKS ON LEFT */
DO WHILE (BLCNT1:=BLCNT1-1) <> 255;
LINE(FLINE:=FLINE-1) = ' ';
END;
END FORMAT;
WRITELINE: PROC; /* PRINT FLINE TO WLINE */
IF RIGHT$FLUSH THEN CALL FORMAT; /* MARGIN ADJUST, IF YOU MUST */
ELSE DO;
TLINE=NLINE;
NLINE=ELINE;
END;
CALL DUMPLINE;
FLINE,ELINE=WLINE; /* RECOVER WLINE TO NLINE */
NLINE=TLINE;
END WRITELINE;
PUTCHAR: PROC(C);
DCL C BYTE,
BLCNT BYTE;
/* DETERMINE LINELENGTH FOR CURRENT OUTPUT LINE */
IF LINELENGTH$CHG THEN
IF NLINE = FLINE THEN
LINELENGTH$CHG = FALSE;
LINE(NLINE)=C;
IF ( (NLINE:=NLINE+1) - FLINE ) > SET$LENGTH THEN
DO;
CALL WRITELINE;
/* RESET FLAGS AFTER WRITING LINE */
TEMP$INDENT=FALSE;
LINELENGTH$CHG=FALSE;
/* ARE THERE LEADING BLANKS IN PRINT LINE? */
BLCNT = 0;
TLINE = NLINE;
DO WHILE LINE(TLINE := TLINE - 1) = ' ' AND TLINE >= FLINE;
BLCNT = BLCNT + 1;
END;
IF BLCNT = NLINE - FLINE THEN
NLINE = FLINE; /* RESET NLINE TO BEG. OF PRINT LINE */
END;
END PUTCHAR;
PUTLINE: PROC(CHAR); /* NO BLANKS IN FRONT OF LINE */
DCL CHAR BYTE;
IF NLINE=FLINE AND LEFT$FLUSH THEN
DO;
IF CHAR=' ' THEN RETURN;
END;
CALL PUTCHAR(CHAR);
END PUTLINE;
CENTER: PROC(COUNT); /* PRINT THE FOLLOWING 'COUNT' SOURCE LINES */
/* CENTERED WITHIN LINELENGTH */
DCL COUNT BYTE;
DCL (CHAR,LS) BYTE;
DO WHILE (COUNT:=COUNT-1) <> 255;
IF TOOLONG THEN CALL ENDPAGE;
IF LINECOUNT=0 THEN CALL HEADER;
DO WHILE (CHAR:=GETMORE)<>CR;
CALL PUTCHAR(CHAR); /* WILL PRINT IF LINE TOO LONG */
END;
DO WHILE (CHAR:=GETMORE)<>LF;
END;
CALL CENTSTUB; /* PRINT FLINE THROUGH NLINE CENTERED */
END;
END CENTER;
PAGE: PROC; /* SKIP TO BOTTOM OF PAGE */
CALL FLUSHLINE;
IF LINECOUNT<>0 THEN
CALL ENDPAGE;
END PAGE;
FINISH: PROC; /* NORMAL END, WRITE AND BOOT */
CALL PAGE;
CALL PUTDEST(ENDFILE);
IF NOT LSTOUT AND NDEST<>0 THEN CALL WRITEDEST;
CALL LAST;
END FINISH;
CMDERR: PROC;
CALL ERROR (.('COMMAND VERIFY$'));
CALL FINISH;
END CMDERR;
DCL DIGIT BYTE; /* LAST DIGIT OR CHAR READ IN GETNUM */
CLEAR$CRLF: PROC;
IF DIGIT <> CR THEN CALL CMDERR;
DO WHILE GETSOURCE <> LF;
END;
END CLEAR$CRLF;
GETNUM: PROC ADDRESS;
/* READ NEXT NUMBER ON COMMAND LINE */
DCL NUM ADDR;
GETNEXT: PROC;
DIGIT = GETSOURCE;
END GETNEXT;
NUMERIC: PROCEDURE BYTE;
RETURN (DIGIT-'0') < 10;
END NUMERIC;
NSIGN, NUM = 0;
DO WHILE DIGIT = ' ';
CALL GETNEXT;
END;
IF DIGIT = CR THEN RETURN 0;
/* INPUT IS DEBLANKED */
IF DIGIT = '+' THEN
DO; NSIGN = 1; CALL GETNEXT;
END; ELSE
IF DIGIT = '-' THEN
DO; NSIGN = 255; CALL GETNEXT;
END;
IF NOT NUMERIC THEN CALL CMDERR;
DO WHILE NUMERIC;
NUM = NUM * 10 + (DIGIT-'0');
CALL GETNEXT;
END;
RETURN NUM;
END GETNUM;
GETAN: PROC(A) ADDRESS;
DCL (A, INC) ADDR;
DIGIT=' ';
INC=GETNUM; /* READ A NUMBER */
IF NSIGN=0 THEN A=INC;
IF NSIGN=1 THEN A=A+INC;
IF NSIGN=255 THEN A=A-INC;
IF ROL(HIGH(A),1) THEN A = 0;
CALL CLEAR$CRLF;
RETURN A;
END GETAN;
GETBN: PROC(B) BYTE; /* GET INCREMENTAL BYTE VALUE */
DCL B BYTE;
DCL A ADDRESS;
IF HIGH(A:=GETAN(DOUBLE(B))) <> 0 THEN CALL CMDERR;
RETURN LOW(A);
END GETBN;
GETN: PROC BYTE;
DCL B BYTE;
B = GETBN(0);
IF NSIGN <> 0 THEN CALL CMDERR;
RETURN B;
END GETN;
NEXT$CHAR: PROC BYTE;
DCL CHAR BYTE;
/* READ PAST 'CRLF' OF COMMAND LINE */
IF (CHAR:=GETSOURCE)=CR THEN
DO WHILE (CHAR:=GETSOURCE)=LF;
END;
/* RETURN LAST CHAR OBTAINED (MAY BE ENDFILE) */
RETURN CHAR;
END NEXT$CHAR;
IGNORE: PROC; /* SKIP TO NEXT COMMAND */
DCL CHAR BYTE;
IF (CHAR:=NEXT$CHAR)='.' OR CHAR=ENDFILE THEN RETURN;
DO FOREVER;
DO WHILE (CHAR:=GETMORE)<>LF;
END;
IF (CHAR:=GETSOURCE)='.' OR CHAR=ENDFILE THEN RETURN;
END;
END IGNORE;
THRUPUT: PROC; /* LITERAL COPY TO NEXT COMMAND */
DCL CHAR BYTE;
DCL I BYTE;
CALL FLUSHLINE;
IF (CHAR:=NEXT$CHAR)='.' OR CHAR=ENDFILE THEN RETURN;
DO FOREVER;
IF LINECOUNT=0 THEN CALL HEADER;
CALL PUT$LEFT$MARGIN;
CALL PUTDEST(CHAR);
DO WHILE (CHAR:=GETMORE) <> LF;
CALL PUTDEST(CHAR);
END;
CALL PUTDEST(CHAR); /* CHAR=LF */
LINECOUNT = LINECOUNT+1;
IF TOOLONG THEN CALL ENDPAGE;
IF (CHAR:=GETSOURCE)='.' OR CHAR=ENDFILE THEN RETURN;
END;
END THRUPUT;
TRANSLATE: PROC BYTE;
DCL C BYTE;
IF (C:=GETSOURCE)<'A' THEN CALL CMDERR;
ELSE IF C>=61H THEN C=C-20H;
IF C>'U' THEN CALL CMDERR;
RETURN C;
END TRANSLATE;
DCL DUMMY LIT 'CALL CMDERR';
COMMAND: PROC;
DCL (CMD1,CMD2,CNT1,CNT2,CNT3) BYTE;
DCL ACNT ADDR;
CONTINUE:
CMD1=TRANSLATE;
CMD2=TRANSLATE;
DO CASE (CMD1:=CMD1-'A');
DO; /* A */
IF CMD2='D' THEN /* ADJUST MARGINS */
DO;
CALL FLUSHLINE;
LEFT$FLUSH,RIGHT$FLUSH=TRUE;
END; ELSE
CALL CMDERR;
END;
DO; /* B */
IF CMD2='L' THEN
DO; CALL FLUSHLINE;
IF (CNT1:=GETN)=0 THEN CNT1=1;
CALL SKIPLINES(CNT1*LSPACING);
END; ELSE
IF CMD2='P' THEN /* NEW PAGE; SET PAGE NUMBER */
DO;
CALL PAGE;
IF (ACNT:=GETAN(PAGECOUNT-1))<>0 THEN
DO;
PAGECOUNT=ACNT;
NUMBER$PAGES=TRUE;
END;
END; ELSE
IF CMD2='R' THEN /* BREAK */
CALL FLUSHLINE;
ELSE
CALL CMDERR;
END;
DO; /* C */
IF CMD2='E' THEN /*CENTER COMMAND*/
DO; CALL FLUSHLINE;
IF (CNT1:=GETN)=0 THEN CNT1=1;
CALL CENTER(CNT1);
END; ELSE
IF CMD2='P' THEN /* CONDITIONAL PAGE (=.NE) */
DO;
IF (LINECOUNT+(GETN*LSPACING)) >= TEXTLENGTH+TOP$MARGIN
THEN CALL PAGE;
END;
ELSE
CALL CMDERR;
END;
DO; /* D */
IF CMD2='S' THEN
DO;
CALL FLUSHLINE;
LSPACING=2;
END; ELSE
CALL CMDERR;
END;
DUMMY; /* E */
DO; /* F */
IF CMD2='L' THEN /* FLUSH (SAME AS .BR) */
CALL FLUSHLINE;
ELSE
IF CMD2='T' THEN /* foot TITLE */
DO;
if shr (bot$margin,1) < 3 then
do;
call error (.('No room for FOOT$'));
end;
CNT1=255;
CALL FILL(.footBUF,' ',length(footbuf));
IF (CNT2:=GETMORE)<>' ' THEN
IF CNT2=CR THEN GO TO footXIT;
ELSE /* CNT2= FIRST CHAR OF foot */
DO;
footBUF(0)=CNT2;
CNT1=0;
END;
DO WHILE (CNT1:=CNT1+1)<length(footbuf);
IF (CNT2:=GETMORE)=CR THEN GO TO footXIT;
footBUF(CNT1) = CNT2;
END;
RETURN;
footXIT: IF (CNT2:=GETMORE)<>LF THEN
CALL ERROR(.('INVALID CRLF SEQUENCE$'));
footBUF(CNT1)=0;
END; ELSE
CALL CMDERR;
END;
DUMMY; /* G */
DO; /* H */
IF CMD2='E' THEN /* HEADING TITLE */
DO;
CNT1=255;
CALL FILL(.HEADBUF,' ',length(headbuf));
IF (CNT2:=GETMORE)<>' ' THEN
IF CNT2=CR THEN GO TO XIT;
ELSE /* CNT2= FIRST CHAR OF HEADING */
DO;
HEADBUF(0)=CNT2;
CNT1=0;
END;
DO WHILE (CNT1:=CNT1+1)<length(headbuf);
IF (CNT2:=GETMORE)=CR THEN GO TO XIT;
HEADBUF(CNT1) = CNT2;
END;
RETURN;
XIT: IF (CNT2:=GETMORE)<>LF THEN
CALL ERROR(.('INVALID CRLF SEQUENCE$'));
HEADBUF(CNT1)=0;
END; ELSE
IF CMD2='M' THEN /* HEADING MARGIN */
DO; /* SPACE BETWEEN HEADING AND TEXT */
MT2 = GETBN(MT2);
IF MT2>=TOP$MARGIN THEN
DO;
CALL ERROR (.('HM COMMAND$'));
IF TOP$MARGIN < 2
THEN MT2=0;
ELSE MT2=TOP$MARGIN-1;
END;
IF TOP$MARGIN=0 /* IF TOP$MARGIN<>0 THEN TOP$MARGIN>MT2 */
THEN MT1=0;
ELSE MT1=TOP$MARGIN-MT2-1;
END; ELSE
CALL CMDERR;
END;
DO; /* I */
IF CMD2='G' THEN
DO;
CALL IGNORE;
GO TO CONTINUE;
END; ELSE
IF CMD2='N' THEN
DO;
CALL FLUSHLINE;
LEFT$FLUSH=TRUE;
INDENT$MARGIN=GETBN(INDENT$MARGIN);
IF LEFT$MARGIN+INDENT$MARGIN>MAXLINE THEN
INDENT$MARGIN=DEFIM;
LINELENGTH=PAGEWIDTH-LEFT$MARGIN-INDENT$MARGIN;
END; ELSE
CALL CMDERR;
END;
DUMMY; /* J */
DUMMY; /* K */
DO; /* L */
IF CMD2='C' THEN LCASE=TRUE; ELSE
IF CMD2='I' THEN
DO; CALL THRUPUT;
GO TO CONTINUE;
END; ELSE
IF CMD2='L' THEN
DO; CNT1=GETBN(LINELENGTH); /* CNT1=NEW LINELENGTH */
IF CNT1<LINELENGTH THEN
DO;
LINELENGTH$CHG=TRUE;
LONG$LINELENGTH=LINELENGTH;
END;
IF CNT1>MAXLINE
THEN LINELENGTH=DEFLL;
ELSE LINELENGTH=CNT1;
PAGEWIDTH=LEFT$MARGIN+INDENT$MARGIN+LINELENGTH;
END; ELSE
IF CMD2='S' THEN
DO;
CALL FLUSHLINE;
LSPACING=GETBN(LSPACING);
END; ELSE
CALL CMDERR;
END;
DO; /* M */
IF CMD2='B' THEN /*BOTTOM MARGIN*/
DO; BOT$MARGIN=GETBN(BOT$MARGIN);
IF BOT$MARGIN>=PAGELENGTH-TOP$MARGIN THEN
DO;
CALL ERROR (.('MB COMMAND$'));
BOT$MARGIN=1;
END;
TEXTLENGTH=PAGELENGTH-(TOP$MARGIN+BOT$MARGIN);
END; ELSE
IF CMD2='T' THEN /*TOP MARGIN*/
DO; TOP$MARGIN=GETBN(TOP$MARGIN);
IF TOP$MARGIN>=PAGELENGTH-BOT$MARGIN THEN
DO;
CALL ERROR (.('MT TOO LARGE$'));
TOP$MARGIN=1;
END;
TEXTLENGTH=PAGELENGTH-(TOP$MARGIN+BOT$MARGIN);
/* RESET HEADING MARGINS (MT1 MT2) IF NECESSARY */
IF TOP$MARGIN>MT2 THEN
MT1 = TOP$MARGIN-MT2-1;
ELSE DO;
MT1=0;
IF TOP$MARGIN<2 THEN
MT2=0;
ELSE MT2=TOP$MARGIN-1;
END;
END; ELSE
CALL CMDERR;
END;
DO; /* N */
IF CMD2='A' THEN /* JUSTIFY DISABLE */
DO;
CALL FLUSHLINE;
RIGHT$FLUSH=FALSE;
END; ELSE
IF CMD2='E' THEN
DO;
IF (LINECOUNT+(GETN*LSPACING))>=TEXTLENGTH+TOP$MARGIN
THEN CALL PAGE;
END;
ELSE CALL CMDERR;
END;
DO; /* O */
IF CMD2='P' THEN /* OMIT PAGE NUMBERS */
NUMBER$PAGES=FALSE; ELSE
CALL CMDERR;
END;
DO; /* P */
IF CMD2='A' THEN /* PAGE ADVANCE 1 OR N */
DO; CALL FLUSHLINE;
IF (CNT1:=GETN)=0 THEN CNT1=1;
IF LINECOUNT=0 THEN CNT1=CNT1-1;
DO CNT2=1 TO CNT1;
CALL ENDPAGE;
END;
END; ELSE
IF CMD2='L' THEN /*PAGE LENGTH*/
DO; PAGELENGTH=GETBN(PAGELENGTH);
IF PAGELENGTH>128 OR PAGELENGTH=0 THEN PAGELENGTH=DEFPL;
TEXTLENGTH=PAGELENGTH-(BOT$MARGIN+TOP$MARGIN);
END; ELSE
IF CMD2='N' THEN /*NUMBER PAGES BEGINNING WITH N*/
DO;
IF (PAGECOUNT:=GETAN(PAGECOUNT))=0 THEN PAGECOUNT=1;
NUMBER$PAGES=TRUE;
END; ELSE
IF CMD2='O' THEN /* LEFT MARGIN = PAGE OFFSET */
DO;
CALL FLUSHLINE;
FIRSTPAGE=TRUE;
LEFT$MARGIN=GETBN(LEFT$MARGIN);
PAGEWIDTH=LEFT$MARGIN+INDENT$MARGIN+LINELENGTH;
IF PAGEWIDTH>MAXLINE THEN
DO;
LINELENGTH=MAXLINE;
PAGEWIDTH=MAXLINE+LEFT$MARGIN+INDENT$MARGIN;
END;
END; ELSE
IF CMD2='P' THEN /*PARAGRAPH*/
DO;
CALL FLUSHLINE;
IF LINECOUNT=0
THEN CALL HEADER;
ELSE CALL SKIPLINES(LSPACING);
LEFT$FLUSH=TRUE;
IF (CNT1:=GETN) <> 0 THEN
DO;
IF CNT1<LINELENGTH
THEN NINDENT=CNT1;
ELSE CALL ERROR (.('PP COMMAND $'));
END;
DO CNT2=1 TO NINDENT;
CALL PUTCHAR(' ');
END;
END; ELSE
CALL CMDERR;
END;
DO; /* Q */
IF CMD2='I' THEN
DO;
CALL FLUSHLINE;
INDENT$MARGIN=0;
LINELENGTH=PAGEWIDTH-LEFT$MARGIN;
END; ELSE
CALL CMDERR;
END;
DUMMY; /* R */
DO; /* S */
IF CMD2='P' THEN /* SPACE DOWN N LINES OF TEXT:
DOES NOT SPACE PAST PAGE BOUNDARY */
DO;
CALL FLUSHLINE;
IF (CNT1:=GETN)=0 THEN CNT1=1;
CALL SKIPLINES(CNT1*LSPACING);
END; ELSE
IF CMD2='S' THEN
DO;
CALL FLUSHLINE;
LSPACING=1;
END; ELSE
CALL CMDERR;
END;
DO; /* T */
IF CMD2 = 'B' THEN /* TAB SET */
DO; DIGIT = ' '; CNT2 = 0;
DO CNT1 = 0 TO TABLAST;
IF (CNT3:=(TABARRAY(CNT1):=GETNUM)) = 0 THEN
DO; TABARRAY(CNT1) = 255; /* END OF TABS */
CNT1 = TABLAST;
END; ELSE
IF CNT3>CNT2 THEN CNT2=CNT3; ELSE CALL CMDERR;
END;
CALL CLEAR$CRLF;
END; ELSE
IF CMD2='I' THEN /* TEMPORARY INDENT */
DO;
CALL FLUSHLINE;
TEMP$INDENT,LEFT$FLUSH=TRUE;
CNT1=GETBN(INDENT$MARGIN);
DO WHILE (CNT1:=CNT1-1) <> 255;
CALL PUTCHAR(' ');
END;
END; ELSE
CALL CMDERR;
END;
DO; /* U */
IF CMD2='C' THEN LCASE=FALSE; ELSE
CALL CMDERR;
END;
END; /* OF COMMAND CASES */
END COMMAND;
SCAN: PROC;
DCL CHAR BYTE,
EOL$FLAG BYTE;
LINE$END: PROCEDURE;
IF EOL$FLAG THEN
DO;
ELINE = NLINE;
CALL PUTLINE(' ');
IF SCAN$STATE = ENDSENT$STATE THEN
CALL PUTLINE(' ');
WLINE = NLINE;
SCAN$STATE = BLANKS$STATE;
END;
END LINE$END;
SENTENCE$END: PROCEDURE BYTE;
/* RETURNS TRUE IF END OF SENTENCE ENCOUNTERED */
IF CHAR = '.'
OR CHAR = QM
OR CHAR = EXCL
OR CHAR = ':' THEN
DO; /* CANDIDATE FOR END OF LINE */
CALL LOOKAHEAD; /* TO ENSURE NEXT CHAR IS READY */
IF LOOKCHR = CR OR LOOKCHR = ENDFILE OR LOOKCHR = ' ' THEN
RETURN TRUE;
END;
RETURN FALSE;
END SENTENCE$END;
EOL$FLAG=FALSE;
SCAN$STATE=START$STATE;
ELINE,WLINE=NLINE;
/* ELINE MARKS END+1 OF LAST COMPLETE WORD. */
/* WLINE MARKS START OF NEXT WORD */
DO WHILE (CHAR:=GETSOURCE)<>ENDFILE;
IF CHAR=CR THEN
DO;
EOL$FLAG=TRUE;
DO WHILE (CHAR:=GETSOURCE)=LF; END;
IF CHAR=ENDFILE THEN RETURN;
END;
ELSE EOL$FLAG = FALSE;
RESCAN: /* KEEP CHAR AND CONTINUE ANALYSIS */
IF CHAR=CR THEN /* MULTIPLE END OF LINES */
DO;
IF SCAN$STATE<>SKIP$STATE THEN CALL FLUSHLINE;
DO WHILE (CHAR:=GETSOURCE) = LF; END;
CALL DUMPLINE; /* PRINT EMPTY LINE */
SCAN$STATE=SKIP$STATE;
IF CHAR=ENDFILE THEN RETURN;
GO TO RESCAN;
END;
ELSE IF CHAR = ' ' THEN
DO;
IF SCAN$STATE<>BLANKS$STATE THEN ELINE=NLINE;
/* MARK END OF COMPLETE WORD */
CALL PUTLINE(CHAR);
SCAN$STATE=BLANKS$STATE;
END;
ELSE IF SENTENCE$END THEN /* DELIMITER FOLLOWED BY CR OR BLANK */
DO; /* CHECK FOR DELIM AT WORD END */
IF SCAN$STATE <> WORDS$STATE THEN WLINE = NLINE;
CALL PUTLINE(CHAR);
WLINE, ELINE = NLINE;
SCAN$STATE=ENDSENT$STATE;
END;
ELSE IF CHAR = '.' AND
(EOL$FLAG OR (SCAN$STATE=START$STATE) OR (SCAN$STATE=SKIP$STATE))
THEN DO;
CALL LINE$END;
CALL COMMAND;
R$TO$L , HEADER$SCAN = TRUE;
SCAN$STATE = START$STATE;
END;
ELSE DO; /* NON-SPECIAL CHARACTER */
CALL LINE$END;
IF SCAN$STATE<>WORDS$STATE THEN WLINE=NLINE;
CALL PUTLINE (CHAR);
SCAN$STATE=WORDS$STATE;
END;
END; /* OF DO WHILE */
END SCAN;
PARMSCAN: PROC; /* ANALYZE PARAMETERS IN TEX INPUT LINE */
DCL (C,I,DOLLAR) BYTE;
DOLLAR,I=0;
DO WHILE (C:=TEX$BUFF(I:=I+1))<>0;
IF DOLLAR THEN /* PARAMETERS EXIST */
DO;
IF C='C' THEN /* OUTPUT TO CON: DEVICE ONLY */
DO;
LSTOUT=TRUE;
OUT$DEVCE=2;
END;
ELSE
IF C='L' THEN /* OUTPUT TO LST: DEVICE ONLY */
DO;
LSTOUT=TRUE;
OUT$DEVCE=1;
END;
ELSE
IF C='S' THEN /* OUTPUT SUPPRESSION */
DO;
LSTOUT=TRUE;
OUT$DEVCE=0;
END;
ELSE
IF C='E' THEN /* ERROR MESSAGES ON LST: DEVICE */
LSTERR=TRUE;
ELSE
IF C='F' THEN /* FOR PAGING, USE FORMSFEED CHAR */
FORMS$FEED=TRUE;
ELSE
IF C='P' THEN /*INSERT NEW PAGE */
DO;
PAGE$MODE=TRUE;
LSTOUT=TRUE;
OUT$DEVCE=1;
END;
ELSE
IF C<>' ' AND C<>'$' THEN
CALL FERROR (.('PARAMETER SCAN$'));
END; /* IF DOLLAR */
ELSE
IF C='$' THEN DOLLAR=TRUE;
END; /* DO WHILE */
END PARMSCAN;
SETFILES: PROC; /* OPEN SOURCE AND DESTINATION */
/* FILE ARGUMENTS A:M.X AND B:N.Y ARE LEFT */
/* BY CCP AT TFCB AND TFCB+16 */
/* TFCB(0):A TFCB(1):M TFCB(9):X */
/* TFCB(16):B TFCB(17):N TFCB(25):Y */
/* COPY FORMAT: COPY(S,D,N) */
IF SFCB(1)=' ' THEN /* SOURCE FILE ARGUMENT MISSING? */
CALL FERROR (.('OPENING SOURCE$'));
/* SET DEFAULT FILETYPE FOR FIRST ARG? */
IF SFCB(9)=' ' THEN CALL COPY (.('TEX'),.SFCB+9,3);
/* DEST FILE ARGUMENT MISSING? */
IF SFCB(17)=' ' OR SFCB(17)='$' THEN
DO;
CALL COPY (.SFCB,.DFCB,16);
DFCB(0) = SFCB(16);
CALL COPY (.('PRN'),.DFCB+9,3);
END;
ELSE /* COPY DEST FILENAME TO DEST BUFFER */
DO;
CALL COPY(.SFCB+16,.DFCB,16);
IF DFCB(9)=' ' THEN CALL COPY(.('PRN'),.DFCB+9,3);
END;
SFCB(32),DFCB(32)=0; /* START AT THE FRONT */
CALL PARMSCAN;
CALL OPEN(.SFCB); /* OPEN SOURCE */
IF DCNT=255 THEN CALL FERROR(.('OPENING SOURCE$'));
IF NOT LSTOUT THEN /* OPEN DESTINATION */
DO;
CALL DELETE(.DFCB); /* DELETE OLD DEST FILES */
CALL MAKE(.DFCB); /* MAKE NEW DESTINATION FILE */
IF DCNT=255 THEN CALL FERROR(.('OPENING DESTINATION$'));
END;
END SETFILES;
PRINTVER: PROC;
/* IF OUTPUT IS PRINTING TO CONSOLE
THEN IF FORMS$FEED PARAMETER IS GIVEN
THEN PRINT TEX-VERSION MSG AND SKIP A PAGE;
OTHERWISE OMIT TEX-VERSION MESSAGE.
*/
IF OUT$DEVCE <> 2 THEN
CALL PRINT (.('TEX VERSION 1.1$'));
ELSE
DO;
IF FORMS$FEED THEN
DO;
CALL PRINT (.('TEX VERSION 1.1$'));
CALL PUTDEST (FF);
END;
END;
END PRINTVER;
SETPARS: PROC;
NSOURCE=SBUFFL; /* SET TO FORCE INITIAL READ */
SBUFF(1)=0;
FLINE=(NLINE:=0);
NDEST=0; /* OUTPUT BUFFER IS EMPTY */
OUT$DEVCE=0;
LINECOUNT=0;
PAGECOUNT=1;
ERRCNT = 0;
COLUMN=1;
/* SET TOP MARGIN DEFAULT VALUES */
HEADBUF(0)=0; /* TO TEST IF .HE CONDITION ON */
HEADBUF(maxcolumn)=0; /* TO DELIMIT HEADING IN BUFFER */
footBUF(0)=0; /* TO TEST IF .ft CONDITION ON */
footBUF(maxcolumn)=0; /* TO DELIMIT foot IN BUFFER */
/* SET DEFAULTS OF OTHER KEY VALUES */
LINELENGTH =DEFLL;
LEFT$MARGIN =DEFLM;
INDENT$MARGIN=DEFIM;
NINDENT =DEFPP;
PAGEWIDTH =DEFPW;
PAGELENGTH =DEFPL;
TEXTLENGTH =DEFTL;
TOP$MARGIN =DEFMT;
MT1 = 3;
MT2 = 2;
BOT$MARGIN =DEFMB;
LSPACING =DEFLS;
/* SET SWITCH VALUES */
LEFT$FLUSH,
RIGHT$FLUSH =TRUE;
TEMP$INDENT,
LINELENGTH$CHG,
HEADER$SCAN,
LCASE,
FORMS$FEED,
PAGE$MODE,
LSTERR,
LSTOUT =FALSE;
FIRSTPAGE,
NUMBER$PAGES,
R$TO$L =TRUE;
LOOKED =FALSE;
END SETPARS;
/* TEX MAIN PROGRAM BEGINS HERE */
declare last$dseg$byte byte
initial (0);
TEXCOMMAND:
/* SIZE MEMORY FOR SOURCE AND OUTPUT BUFFERS */
SBUFFL=SHR((BDOSLOC-.MEMORY) AND 0FF00H,1);
SBUFFA=.MEMORY;
DBUFFA=SBUFFA+SBUFFL;
CALL SETPARS;
CALL SETFILES;
CALL PRINTVER;
CALL CRLF;
CALL SCAN; /* UNTIL END OF FILE */
CALL FINISH;
END TEX;