seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-24 08:54:17 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
master
Digital-Research-Source-Code/CONTRIBUTIONS/tex-rev/tex.plm
Sepp J Morris 31738079c4 Upload 
Digital Research
2020-11-06 18:50:37 +01:00

1624 lines
30 KiB
Plaintext
Raw Permalink Blame History

TEX: DO;
$SET(PATCH=0)
DECLARE /* CPM */
F$REBOOT LITERALLY '0',
F$RDCON LITERALLY '1',
F$WRCON LITERALLY '2',
F$RDRDR LITERALLY '3',
F$WRPUN LITERALLY '4',
F$WRLST LITERALLY '5',
F$CONIO LITERALLY '6',
F$GETIO LITERALLY '7',
F$SETIO LITERALLY '8',
F$WRSTR LITERALLY '9',
F$RDBUF LITERALLY '10',
F$RDSTAT LITERALLY '11',
F$VERS LITERALLY '12',
F$RESET LITERALLY '13',
F$SELECT LITERALLY '14',
F$OPEN LITERALLY '15',
F$CLOSE LITERALLY '16',
F$SEARCHF LITERALLY '17',
F$SEARCHN LITERALLY '18',
F$DELETE LITERALLY '19',
F$RDSEQ LITERALLY '20',
F$WRSEQ LITERALLY '21',
F$MAKE LITERALLY '22',
F$RENAME LITERALLY '23',
F$LOGVEC LITERALLY '24',
F$CURDSK LITERALLY '25',
F$SETDMA LITERALLY '26',
F$ALLVEC LITERALLY '27',
F$WPDISK LITERALLY '28',
F$ROVEC LITERALLY '29',
F$FILATT LITERALLY '30';
DECLARE /* enum OUTMODE */
SUPPRESS LITERALLY '0',
LIST LITERALLY '1',
CONSOLE LITERALLY '2';
DECLARE /* STATES */
SINITIAL LITERALLY '0',
INWORD LITERALLY '1',
INSPACE LITERALLY '2',
PUNCTUATED LITERALLY '3',
SKIPBLANKLINE LITERALLY '4';
/* JUMP to start code */
DECLARE
EDJMP BYTE DATA(0C3H),
EDADR ADDRESS DATA(.TEXSTART-3);
DECLARE copyright(*) BYTE DATA(' COPYRIGHT (C) 1978 DIGITAL RESEARCH ');
DECLARE BASECCP ADDRESS AT(6);
DECLARE CMDLINE(128) BYTE AT(80H);
DECLARE FCB1(33) BYTE AT(5CH);
DECLARE FCB2(33) BYTE AT(6CH);
DECLARE PAD(*) BYTE INITIAL(6, 5, 4, 3, 2, 1);
DECLARE TABSTOPS(*) BYTE INITIAL(8, 16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104,
112, 120, 128, 136, 144, 152, 255);
DECLARE PATCHES(128) BYTE;
DECLARE OUT$COL BYTE;
DECLARE OUTFCB(33) BYTE;
DECLARE (TLINE, WLINE, byte$1DE7, ELINE, SLINE, NLINE) BYTE;
DECLARE LINEOUT$BUF(256) BYTE;
DECLARE INPUT$BUF ADDRESS;
DECLARE INPUT$BUF$SIZE ADDRESS;
DECLARE INPUT$CHR$OFFSET ADDRESS;
DECLARE OUTPUT$BUF ADDRESS;
DECLARE OUTPUT$CHR$OFFSET ADDRESS;
DECLARE CUR$LINENO ADDRESS;
DECLARE PAGE$NUM ADDRESS;
DECLARE LINE$LEN BYTE;
DECLARE PAGE$OFFSET BYTE;
DECLARE CUR$INDENT BYTE;
DECLARE PP$INDENT BYTE;
DECLARE PAGE$WIDTH BYTE;
DECLARE PAGE$LEN BYTE;
DECLARE PRINT$LEN BYTE;
DECLARE TOP$MARGIN BYTE;
DECLARE TOP$SPACES BYTE;
DECLARE HEADING$MARGIN BYTE;
DECLARE BOTTOM$MARGIN BYTE;
DECLARE LINE$SPACING BYTE;
DECLARE IS$INDENTED BYTE;
DECLARE IS$JUSTIFIED BYTE;
DECLARE HAS$TMP$INDENT BYTE;
DECLARE LL$INCREASED BYTE;
DECLARE SAV$LL BYTE;
DECLARE unk$1F0A BYTE;
DECLARE LOWER$CASE BYTE;
DECLARE FORM$FEED BYTE;
DECLARE PAGE$MODE BYTE;
DECLARE ERR$PRINT BYTE;
DECLARE IO$REDIRECT BYTE;
DECLARE PO$CHANGED BYTE;
DECLARE SAV$LINELENGTH BYTE;
DECLARE DO$PAGENUM BYTE;
DECLARE outMode BYTE;
DECLARE STATE BYTE;
DECLARE unk$1F15 BYTE;
DECLARE SLACK BYTE;
DECLARE heading(133) BYTE;
DECLARE LINE$BUF(256) BYTE;
DECLARE CHARS$IN$LINE$BUF BYTE;
DECLARE LINE$POS BYTE;
DECLARE signPrefix BYTE;
DECLARE havePeeked BYTE;
DECLARE peekedChar BYTE;
DECLARE pad1 ADDRESS;
DECLARE cpmRetVal BYTE;
DECLARE MAXLEN BYTE;
MON1: PROCEDURE(F,A) EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON1;
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON2;
reboot: PROCEDURE;
DECLARE VEC ADDRESS;
VEC = 0;
CALL VEC;
END reboot;
rdcon: PROCEDURE BYTE;
RETURN MON2(F$RDCON, 0);
END rdcon;
wrcon: PROCEDURE(CH);
DECLARE CH BYTE;
CALL MON1(F$WRCON, CH);
END wrcon;
wrconCRLF: PROCEDURE;
CALL wrcon(0DH);
CALL wrcon(0AH);
END wrconCRLF;
wrlst: PROCEDURE(CH);
DECLARE CH BYTE;
CALL MON1(F$WRLST, CH);
END wrlst;
wrstr: PROCEDURE(STR);
DECLARE STR ADDRESS;
CALL wrconCRLF;
CALL MON1(F$WRSTR, STR);
END wrstr;
rdbuf: PROCEDURE(BUF);
DECLARE BUF ADDRESS;
CALL MON1(F$RDBUF, BUF);
END rdbuf;
rdstat: PROCEDURE BYTE;
RETURN MON2(F$RDSTAT, 0);
end rdstat;
reset: PROCEDURE;
CALL MON1(F$RESET, 0);
end reset;
open: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
cpmRetVal = MON2(F$OPEN, FCB);
end open;
close: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
cpmRetVal = MON2(F$CLOSE, FCB);
end close;
searchf: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
cpmRetVal = MON2(F$SEARCHF, FCB);
end searchf;
delete: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(F$DELETE, FCB);
end delete;
rdseq: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
return MON2(F$RDSEQ, FCB);
end rdseq;
wrseq: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
return MON2(F$WRSEQ, FCB);
end wrseq;
make: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
cpmRetVal = MON2(F$MAKE, FCB);
end make;
setdma: PROCEDURE(BUF$P);
DECLARE BUF$P ADDRESS;
CALL MON1(F$SETDMA, BUF$P);
end setdma;
unused1: PROCEDURE;
MAXLEN = 128;
CALL RDBUF(.MAXLEN);
end unused1;
unused2: PROCEDURE;
CALL MON1(F$RDSTAT, 0);
end unused2;
outnewline: PROCEDURE;
IF ERR$PRINT THEN
DO;
call wrlst(0DH);
call wrlst(0AH);
END;
ELSE
call wrConCRLF;
end outnewline;
outchar: PROCEDURE(CH);
DECLARE CH BYTE;
if ERR$PRINT THEN
call wrlst(CH);
else
call wrcon(CH);
end outchar;
outstr: PROCEDURE(STR);
DECLARE STR ADDRESS;
DECLARE c BYTE, i BYTE;
DECLARE CH BASED STR(1) BYTE;
i = 0ffh;
if ERR$PRINT then
DO;
call wrlst(0DH);
call wrlst(0AH);
DO WHILE (c := CH(i := i + 1)) <> '$';
call wrlst(c);
END;
END;
else
call wrstr(STR);
end outstr;
wrapup: PROCEDURE;
IF NOT IO$REDIRECT THEN
DO;
CALL SETDMA(80H);
CALL CLOSE(.OUTFCB);
END;
CALL wrconCRLF;
CALL wrstr(.('TEX FINISHED$'));
CALL wrconCRLF;
CALL reboot;
END wrapup;
error: PROCEDURE(ERR);
DECLARE ERR ADDRESS;
DECLARE n BYTE;
call outstr(.('ERROR DURING $'));
call outstr(ERR);
call outnewline;
if CHARS$IN$LINE$BUF > 0 then
do;
call outstr(.('INPUT CONTEXT:$'));
call outnewline;
n = LINE$POS - CHARS$IN$LINE$BUF; /* start offset of context chars */
do while (n := n + 1) <> LINE$POS + 1;
call outchar(LINE$BUF(n));
end;
call outnewline;
end;
end error;
fatalError: PROCEDURE(ERR);
DECLARE ERR ADDRESS;
call error(ERR);
call outstr(.('THIS ERROR TERMINATES TEX$'));
call wrapup;
end fatalError;
FILL: PROCEDURE(BUF$P, CH, CNT);
DECLARE BUF$P ADDRESS, (CH, CNT) BYTE;
DECLARE BCH BASED BUF$P BYTE;
do while (CNT := CNT - 1) <> 0ffh;
BCH = CH;
BUF$P = BUF$P + 1;
end;
end FILL;
memcpy: PROCEDURE(SRC$P, DST$P, LEN);
DECLARE (SRC$P, DST$P) ADDRESS, LEN BYTE;
DECLARE SRC BASED SRC$P BYTE;
DECLARE DST BASED DST$P BYTE;
do while (LEN := LEN - 1) <> 0ffh;
DST = SRC;
SRC$P = SRC$P + 1;
DST$P = DST$P + 1;
end;
end memcpy;
READ$CHUNK: PROCEDURE;
DECLARE r BYTE;
DECLARE p ADDRESS;
DECLARE CH BASED p BYTE;
DECLARE readexit LABEL;
p = INPUT$BUF;
do while p < INPUT$BUF + INPUT$BUF$SIZE;
call setdma(p);
if (r := rdseq(.FCB1)) <> 0 then
do;
if r > 1 then
call fatalError(.('FILE READ$'));
else
do;
CH = 1AH;
goto readexit;
end;
end;
else
do;
INPUT$CHR$OFFSET = INPUT$CHR$OFFSET + 128;
p = p + 128;
end;
end;
readexit:
INPUT$CHR$OFFSET = 0;
end READ$CHUNK;
GETCH: PROCEDURE BYTE;
DECLARE c BYTE;
DECLARE INB BASED INPUT$BUF(1) BYTE;
if havePeeked then
do;
havePeeked = 0;
return peekedChar;
end;
if INPUT$CHR$OFFSET >= INPUT$BUF$SIZE then
call READ$CHUNK;
c = INB(INPUT$CHR$OFFSET);
INPUT$CHR$OFFSET = INPUT$CHR$OFFSET + 1;
if CHARS$IN$LINE$BUF < 255 then
CHARS$IN$LINE$BUF = CHARS$IN$LINE$BUF + 1;
LINE$BUF(LINE$POS := LINE$POS + 1) = c;
return c;
end GETCH;
peekChar: PROCEDURE;
IF NOT havePeeked THEN
DO;
peekedChar = GETCH;
havePeeked = 0ffh;
END;
end peekChar;
getnonEOFchar: PROCEDURE BYTE;
DECLARE CH BYTE;
if (CH := GETCH) = 1AH THEN
call fatalError(.('READING EOF$'));
else
return CH;
end getnonEOFchar;
FLUSH$OUTPUT: PROCEDURE;
DECLARE p ADDRESS;
p = OUTPUT$BUF;
do while p < OUTPUT$BUF + OUTPUT$CHR$OFFSET;
call setdma(p);
if wrseq(.OUTFCB) <> 0 then
call fatalError(.('DISK WRITE$'));
else
p = p + 128;
end;
OUTPUT$CHR$OFFSET = 0;
end FLUSH$OUTPUT;
PUTDEST: PROCEDURE(CH);
DECLARE CH BYTE;
DECLARE (i, tab) BYTE;
PUTCHAR: PROCEDURE(CH);
DECLARE CH BYTE;
DECLARE OUTB BASED OUTPUT$BUF(1) BYTE;
OUT$COL = OUT$COL + 1;
if IO$REDIRECT then
do;
if outMode = LIST then
call wrlst(CH);
else if outMode = CONSOLE then
call wrcon(CH);
else
;
if rdstat then
if rdcon = 0DH then
call reboot;
end;
else
do;
OUTB(OUTPUT$CHR$OFFSET) = CH;
if (OUTPUT$CHR$OFFSET := OUTPUT$CHR$OFFSET + 1) >= INPUT$BUF$SIZE then
call FLUSH$OUTPUT;
end;
end PUTCHAR;
if CH = 0AH then
do;
call PUTCHAR(CH);
OUT$COL = 1;
end;
else if CH = 9 then
do;
i = 0;
do while (tab := TABSTOPS(i)) <= OUT$COL;
i = i + 1;
end;
if tab = 255 then
return;
do while tab > OUT$COL;
call PUTCHAR(' ');
end;
end;
else
call PUTCHAR(CH);
end PUTDEST;
emitPAGEOFFSET: PROCEDURE;
DECLARE i BYTE;
i = PAGE$OFFSET;
do while (i := i - 1) <> 0ffh;
call PUTDEST(' ');
end;
OUT$COL = 1;
end emitPAGEOFFSET;
emitLineText: PROCEDURE;
DECLARE i BYTE;
call emitPAGEOFFSET;
if not HAS$TMP$INDENT then
do;
i = CUR$INDENT;
do while (i := i - 1) <> 0ffh;
call PUTDEST(' ');
end;
end;
i = SLINE;
do while i <> NLINE;
call PUTDEST(LINEOUT$BUF(i));
i = i + 1;
end;
call PUTDEST(0DH);
call PUTDEST(0AH);
CUR$LINENO = CUR$LINENO + 1;
end emitLineText;
CENTRE: PROCEDURE;
DECLARE cspc BYTE;
cspc = SHR(LINE$LEN - (NLINE - SLINE), 1);
do while (cspc := cspc - 1) <> 0ffh;
LINEOUT$BUF(SLINE := SLINE - 1) = ' ';
end;
call emitLineText;
SLINE = NLINE;
end CENTRE;
NEWLINE: PROCEDURE;
CALL PUTDEST(0DH);
CALL PUTDEST(0AH);
CUR$LINENO = CUR$LINENO + 1;
END NEWLINE;
emitHeading: PROCEDURE;
DECLARE (i, c) BYTE;
call emitPAGEOFFSET;
i = 0FFh;
do while (i := i + 1) < SAV$LINELENGTH AND (c := heading(i)) <> 0;
call PUTDEST(c);
end;
call NEWLINE;
end emitHeading;
EOP: PROCEDURE;
DECLARE num ADDRESS;
DECLARE (rem, ascLen) BYTE, ascStr(5) BYTE;
DECLARE (spcCnt, i) BYTE;
do while CUR$LINENO < (PRINT$LEN + TOP$MARGIN);
call NEWLINE;
end;
if BOTTOM$MARGIN > 0 then
do;
spcCnt = SHR(BOTTOM$MARGIN, 1);
do i = 1 to spcCnt;
call NEWLINE;
end;
if DO$PAGENUM then
do;
num = PAGE$NUM;
ascLen = 0FFH;
do while num <> 0;
rem = num - (num / 10) * 10;
ascStr(ascLen := ascLen + 1) = rem + '0';
num = num / 10;
end;
spcCnt = SHR(SAV$LINELENGTH - ascLen, 1) + PAGE$OFFSET;
do i = 1 to spcCnt;
call PUTDEST(' ');
end;
ascLen = ascLen + 1;
do while (ascLen := ascLen - 1) <> 0FFH;
call PUTDEST(ascStr(ascLen));
end;
call NEWLINE;
end;
PAGE$NUM = PAGE$NUM + 1;
do while CUR$LINENO < PAGE$LEN;
call NEWLINE;
end;
end;
CUR$LINENO = 0;
if FORM$FEED then
call PUTDEST(0CH);
if PAGE$MODE then
do;
if outMODE <> CONSOLE then
call wrstr(.('INSERT NEW PAGE; THEN TYPE RETURN$'));
do while rdcon <> 0DH;
end;
end;
end EOP;
procLine0: PROCEDURE;
DECLARE i BYTE;
if PO$CHANGED then
do;
SAV$LINELENGTH = LINE$LEN;
/* patch 2 follows */
$IF PATCH
if FORM$FEED then /* uses ral .. cc in asm patch !! */
call PUTDEST(0CH);
/* end patch 2 */
$ENDIF
PO$CHANGED = 0;
end;
if TOP$MARGIN <> 0 then
do;
if heading(0) = 0 then
do i = 1 to TOP$MARGIN;
call NEWLINE;
end;
else
do;
do i = 1 to TOP$SPACES;
call NEWLINE;
end;
call emitHeading;
do i = 1 to HEADING$MARGIN;
call NEWLINE;
end;
end;
end;
end procLine0;
SPACING: PROCEDURE(CNT);
DECLARE CNT BYTE;
if CUR$LINENO = 0 then
call procLine0;
if CUR$LINENO + CNT < PRINT$LEN + TOP$MARGIN then
do while (CNT := CNT - 1) <> 0FFH;
call NEWLINE;
end;
else
call EOP;
end SPACING;
emitLine: PROCEDURE;
DECLARE i BYTE;
if CUR$LINENO = 0 then
call procLine0;
call emitLineText;
if PRINT$LEN + TOP$MARGIN <= CUR$LINENO then
call EOP;
i = 0;
do while (i := i + 1) < LINE$SPACING AND CUR$LINENO > 0;
call NEWLINE;
if PRINT$LEN + TOP$MARGIN <= CUR$LINENO then
call EOP;
end;
end emitLine;
break: PROCEDURE;
if NLINE <> SLINE THEN
call emitLine;
SLINE, ELINE, WLINE = NLINE;
end break;
GET$CURLINE$LEN: PROCEDURE BYTE;
DECLARE i BYTE;
i = LINE$LEN;
if LL$INCREASED then
i = SAV$LL;
if HAS$TMP$INDENT then
i = i + CUR$INDENT;
return i;
end GET$CURLINE$LEN;
JUSTIFY: PROCEDURE;
DECLARE (CH, FLG) BYTE;
DECLARE (LEAD$SPACECNT, NON$SPACE$CNT, POST$PUNCT$SPACE$CNT) BYTE;
DECLARE loc$BD7 LABEL;
DECLARE loc$D6F LABEL;
DECLARE loc$BE8 LABEL;
TLINE = NLINE;
if WLINE = SLINE or ELINE = SLINE then
do;
WLINE = NLINE;
call error(.('FITTING A WORD$'));
return;
end;
else if WLINE - ELINE > 127 then
do;
TLINE, WLINE = NLINE;
NLINE = ELINE;
return;
end;
else
NLINE = ELINE;
SLACK = GET$CURLINE$LEN - (NLINE - SLINE);
LEAD$SPACE$CNT = 0;
NON$SPACE$CNT = 0;
POST$PUNCT$SPACE$CNT = 0;
do while LINEOUT$BUF(SLINE) = ' ';
LEAD$SPACE$CNT = LEAD$SPACE$CNT + 1;
if (SLINE := SLINE + 1) = NLINE then
return;
end;
if unk$1F0A then
do;
unk$1F0A = 0;
do while LINEOUT$BUF(SLINE) <> ' ';
POST$PUNCT$SPACE$CNT = POST$PUNCT$SPACE$CNT + 1;
if (SLINE := SLINE + 1) = NLINE then
goto loc$BD7;
end;
if LINEOUT$BUF(SLINE-1) >= 'A' then
goto loc$BD7;
do while LINEOUT$BUF(SLINE) = ' ';
NON$SPACE$CNT = NON$SPACE$CNT + 1;
if (SLINE := SLINE + 1) = NLINE then
goto loc$BD7;
end;
end;
goto loc$BE8;
loc$BD7: do;
SLINE = SLINE - POST$PUNCT$SPACE$CNT - NON$SPACE$CNT;
NON$SPACE$CNT = 0;
POST$PUNCT$SPACE$CNT = 0;
end;
loc$BE8:
ELINE = TLINE - 1;
do while ELINE <> WLINE;
LINEOUT$BUF(ELINE + SLACK) = LINEOUT$BUF(ELINE);
ELINE = ELINE - 1;
end;
LINEOUT$BUF(ELINE + SLACK) = LINEOUT$BUF(ELINE);
TLINE = TLINE + SLACK;
WLINE = WLINE + SLACK;
do while 1;
FLG = 0ffh;
if unk$1F15 then
do;
ELINE = NLINE + SLACK;
byte$1DE7 = NLINE;
NLINE = ELINE;
do while byte$1DE7 <> SLINE;
CH, LINEOUT$BUF(ELINE := ELINE - 1) = LINEOUT$BUF(byte$1DE7 := byte$1DE7 - 1);
if CH = ' ' AND SLACK <> 0 then
do;
FLG = 0;
LINEOUT$BUF(ELINE := ELINE - 1) = ' ';
SLACK = SLACK - 1;
end;
end;
unk$1F15 = 0;
SLINE = ELINE;
if SLACK = 0 then
goto loc$D6F;
end;
else
do;
byte$1DE7 = SLINE - 1;
SLINE = SLINE - SLACK;
ELINE = SLINE - 1;
do while NLINE - 1 <> byte$1DE7;
CH, LINEOUT$BUF(ELINE := ELINE + 1) = LINEOUT$BUF(byte$1DE7 := byte$1DE7 + 1);
if CH = ' ' AND SLACK <> 0 then
do;
FLG = 0;
LINEOUT$BUF(ELINE := ELINE + 1) = ' ';
SLACK = SLACK - 1;
end;
end;
unk$1F15 = 0FFH;
NLINE = ELINE + 1;
if SLACK = 0 or FLG then
goto loc$D6F;
end;
end;
loc$D6F: SLINE = SLINE - POST$PUNCT$SPACE$CNT - NON$SPACE$CNT;
do while (LEAD$SPACE$CNT := LEAD$SPACE$CNT - 1) <> 0ffH;
LINEOUT$BUF(SLINE := SLINE - 1) = ' ';
end;
end JUSTIFY;
processLine: PROCEDURE;
if IS$JUSTIFIED then
call JUSTIFY;
else
DO;
TLINE = NLINE; /* Patch1 follows */
$IF PATCH
if WLINE - ELINE > 127 then /* signed compare !! */
WLINE = NLINE;
$ENDIF
NLINE = ELINE;
END;
call emitLine;
SLINE, ELINE = WLINE;
NLINE = TLINE; /* next line offset in circular buffer */
end processLine;
ADD$CHAR: PROCEDURE(CH);
DECLARE CH BYTE;
DECLARE I BYTE;
if LL$INCREASED then
if NLINE = SLINE then
LL$INCREASED = 0;
LINEOUT$BUF(NLINE) = CH;
if (NLINE := NLINE + 1) - SLINE > GET$CURLINE$LEN then
do;
call processLine;
HAS$TMP$INDENT = 0;
LL$INCREASED = 0;
i = 0;
TLINE = NLINE;
do while LINEOUT$BUF(TLINE := TLINE - 1) = ' ' and TLINE >= SLINE;
i = i + 1;
end;
if NLINE - SLINE = i then
NLINE = SLINE;
end;
end ADD$CHAR;
/* put character unless leading space
at start of indented line */
PUT$TEXT$CHAR: PROCEDURE(CH);
DECLARE CH BYTE;
if NLINE = SLINE AND IS$INDENTED THEN
if CH = ' ' THEN
return;
call ADD$CHAR(CH);
end PUT$TEXT$CHAR;
CENTRELINES: PROCEDURE(CNT);
DECLARE CNT BYTE;
DECLARE CH BYTE;
do while (CNT := CNT - 1) <> 0FFH;
if PRINT$LEN + TOP$MARGIN <= CUR$LINENO then
call EOP;
if CUR$LINENO = 0 then
call procLine0;
do while (CH := getnonEOFchar) <> 0DH;
call ADD$CHAR(CH);
end;
do while (CH := getnonEOFchar) <> 0AH;
end;
call CENTRE;
end;
end CENTRELINES;
breakPage: PROCEDURE;
call break;
if CUR$LINENO <> 0 then
call EOP;
end breakPage;
sub$EEF: PROCEDURE;
call breakPage;
call PUTDEST(1AH);
if NOT IO$REDIRECT AND OUTPUT$CHR$OFFSET <> 0 then
call FLUSH$OUTPUT;
call wrapup;
end sub$EEF;
fatalCmdError: PROCEDURE;
call error(.('COMMAND VERIFY$'));
call sub$EEF;
end fatalCmdError;
DECLARE PAD$20F9 BYTE;
DECLARE INPUT$CHAR BYTE;
checkCRLF: PROCEDURE;
if INPUT$CHAR <> 0DH then
call fatalCmdError;
do while GETCH <> 0AH;
end;
end checkCRLF;
GET$NUMBER: PROCEDURE ADDRESS;
DECLARE val ADDRESS;
getc: PROCEDURE;
INPUT$CHAR = GETCH;
end getc;
isdigit: PROCEDURE BYTE;
return (INPUT$CHAR - '0') < 10;
end isdigit;
signPrefix = 0;
val = 0;
do while INPUT$CHAR = ' ';
call getc;
end;
if INPUT$CHAR = 0DH then
return 0;
if INPUT$CHAR = '+' then
do;
signPrefix = 1;
call getc;
end;
else if INPUT$CHAR = '-' then
do;
signPrefix = 0ffh;
call getc;
end;
if NOT isdigit then
call fatalCmdError;
do while isdigit;
val = val * 10 + (INPUT$CHAR - '0');
call getc;
end;
return val;
end GET$NUMBER;
GET16$NEW$VALUE: PROCEDURE(REF) ADDRESS;
DECLARE REF ADDRESS;
DECLARE val ADDRESS;
INPUT$CHAR = ' ';
val = GET$NUMBER;
if signPrefix = 0 then
REF = val;
if signPrefix = 1 then
REF = REF + val;
if signPrefix = 0ffh then
REF = REF - val;
if ROL(HIGH(REF), 1) then /* check < 32k */
REF = 0;
call checkCRLF;
return REF;
end GET16$NEW$VALUE;
GET8$NEW$VALUE: PROCEDURE(REF) BYTE;
DECLARE REF BYTE;
DECLARE val ADDRESS;
if HIGH(val := GET16$NEW$VALUE(DOUBLE(REF))) <> 0 then
call fatalCmdError;
return val;
end GET8$NEW$VALUE;
GET8$ABS$NUMBER: PROCEDURE BYTE;
DECLARE val BYTE;
val = GET8$NEW$VALUE(0);
if signPrefix <> 0 then
call fatalCmdError;
return val;
end GET8$ABS$NUMBER;
GET$TEXT$CHAR: PROCEDURE BYTE;
DECLARE CH BYTE;
if (CH := GETCH) = 0DH then
do while (CH := GETCH) = 0AH;
end;
return CH;
end GET$TEXT$CHAR;
IGNORE: PROCEDURE;
DECLARE c BYTE;
if (c := GET$TEXT$CHAR) = '.' or c = 1AH then
return;
do while 1;
do while (c := getnonEOFchar) <> 0AH;
end;
if (c := GETCH) = '.' or c = 1AH then
return;
end;
end IGNORE;
LITERAL: PROCEDURE;
DECLARE (CH, PAD) BYTE;
call break;
if (CH := GET$TEXT$CHAR) = '.' or CH = 1AH then
return;
do while 1;
if CUR$LINENO = 0 then
call procLine0;
call emitPAGEOFFSET;
call PUTDEST(CH);
do while (cH := getnonEOFchar) <> 0AH;
call PUTDEST(CH);
end;
call PUTDEST(CH);
CUR$LINENO = CUR$LINENO + 1;
if PRINT$LEN + TOP$MARGIN <= CUR$LINENO then
call EOP;
if (CH := GETCH) = '.' or CH = 1AH then
return;
end;
end LITERAL;
getCmdChar: PROCEDURE BYTE;
DECLARE CH BYTE;
if (CH := GETCH) < 'A' then
call fatalCmdError;
else if CH >= 'a' then
CH = CH - ' ';
if CH > 'U' then
call fatalCmdError;
return CH;
end getCmdChar;
procDotCmd: PROCEDURE;
DECLARE (cmdChr1, cmdChr2) BYTE;
DECLARE (i, j, k) BYTE;
DECLARE n ADDRESS;
procLoop:
cmdChr1 = getCmdChar;
cmdChr2 = getCmdChar;
cmdChr1 = cmdChr1 - 'A';
do case cmdChr1;
DO; /* DOTA */
if cmdChr2 = 'D' THEN
do;
call break;
IS$INDENTED = 0ffh;
IS$JUSTIFIED = 0ffh;
end;
else
call fatalCmdError;
END;
DO; /* DOTB */
if cmdChr2 = 'L' then
do;
call break;
if (i := GET8$ABS$NUMBER) = 0 then
i = 1;
call SPACING(i * LINE$SPACING);
end;
else if cmdChr2 = 'P' then
do;
call breakPage;
if (n := GET16$NEW$VALUE(PAGE$NUM - 1)) <> 0 then
do;
PAGE$NUM = n;
DO$PAGENUM = 0ffh;
end;
end;
else if cmdChr2 = 'R' then
call break;
else
call fatalCmdError;
END;
DO; /* DOTC */
if cmdChr2 = 'E' then
do;
call break;
if (i := GET8$ABS$NUMBER) = 0 then
i = 1;
call CENTRELINES(i);
end;
else if cmdChr2 = 'P' then
do;
if CUR$LINENO + GET8$ABS$NUMBER * LINE$SPACING >= PRINT$LEN + TOP$MARGIN then
call breakPage;
end;
else
call fatalCmdError;
END;
DO; /* DOTD */
if cmdChr2 = 'S' then
do;
call break;
LINE$SPACING = 2;
end;
else
call fatalCmdError;
END;
call fatalCmdError; /* DOTE */
DO; /* DOTF */
if cmdChr2 = 'L' then
call break;
else
call fatalCmdError;
END;
call fatalCmdError; /* DOTG */
DO; /* DOTH */
if cmdChr2 = 'E' then
do;
i = 0ffh;
call FILL(.heading, ' ', 160);
if (j := getnonEOFchar) <> ' ' then
do;
if j = 0DH then
goto L131D;
heading(0) = j; /* allow for missing space */
i = 0;
end;
do while (i := i + 1) < 160;
if (j := getnonEOFchar) = 0DH then
goto L131D;
heading(i) = j;
end;
return;
L131D: if (j := getnonEOFchar) <> 0AH then
call error(.('INVALID CRLF SEQUENCE$'));
heading(i) = 0;
end;
else if cmdChr2 = 'M' then
do;
HEADING$MARGIN = GET8$NEW$VALUE(HEADING$MARGIN);
if HEADING$MARGIN >= TOP$MARGIN then
do;
call error(.('HM COMMAND$'));
if TOP$MARGIN < 2 then
HEADING$MARGIN = 0;
else
HEADING$MARGIN = TOP$MARGIN - 1;
end;
if TOP$MARGIN = 0 then
TOP$SPACES = 0;
else
TOP$SPACES = TOP$MARGIN - HEADING$MARGIN - 1;
end;
else
call fatalCmdError;
END;
DO; /* DOTI */
if cmdChr2 = 'G' then
do;
call IGNORE;
goto procLoop;
end;
else if cmdChr2 = 'N' then
do;
call break;
IS$INDENTED = 0FFH;
CUR$INDENT = GET8$NEW$VALUE(CUR$INDENT);
if PAGE$OFFSET + CUR$INDENT > 160 then
CUR$INDENT = 0;
LINE$LEN = PAGE$WIDTH - PAGE$OFFSET - CUR$INDENT;
end;
else
call fatalCmdError;
end;
call fatalCmdError; /* DOTJ */
call fatalCmdError; /* DOTK */
do; /* DOTL */
if cmdChr2 = 'C' then
LOWER$CASE = 0FFH;
else if cmdChr2 = 'I' then
do;
CALL LITERAL;
goto procLoop;
end;
else if cmdChr2 = 'L' then
do;
i = GET8$NEW$VALUE(LINE$LEN);
if i < LINE$LEN then
do;
LL$INCREASED = 0FFH;
SAV$LL = LINE$LEN;
end;
if i > 160 then
LINE$LEN = 70;
else
LINE$LEN = i;
PAGE$WIDTH = PAGE$OFFSET + CUR$INDENT + LINE$LEN;
end;
else if cmdChr2 = 'S' then
do;
call break;
LINE$SPACING = GET8$NEW$VALUE(LINE$SPACING);
end;
else
call fatalCmdError;
end;
DO; /* DOTM */
if cmdChr2 = 'B' then
do;
BOTTOM$MARGIN = GET8$NEW$VALUE(BOTTOM$MARGIN);
if PAGE$LEN - TOP$MARGIN <= BOTTOM$MARGIN then
do;
call error(.('MB COMMAND$'));
BOTTOM$MARGIN = 1;
end;
PRINT$LEN = PAGE$LEN - (TOP$MARGIN + BOTTOM$MARGIN);
end;
else if cmdChr2 = 'T' then
do;
TOP$MARGIN = GET8$NEW$VALUE(TOP$MARGIN);
if PAGE$LEN - BOTTOM$MARGIN <= TOP$MARGIN then
do;
call error(.('MT TOO LARGE$'));
TOP$MARGIN = 1;
end;
PRINT$LEN = PAGE$LEN - (TOP$MARGIN + BOTTOM$MARGIN);
if HEADING$MARGIN < TOP$MARGIN then
TOP$SPACES = TOP$MARGIN - HEADING$MARGIN - 1;
else
do;
TOP$SPACES = 0;
if TOP$MARGIN < 2 then
HEADING$MARGIN = 0;
else
HEADING$MARGIN = TOP$MARGIN - 1;
end;
end;
else
call fatalCmdError;
end;
DO; /* DOTN */
if cmdChr2 = 'A' then
do;
call break;
IS$JUSTIFIED = 0;
end;
else if cmdChr2 = 'E' then
do;
if CUR$LINENO + LINE$SPACING * GET8$ABS$NUMBER >= PRINT$LEN + TOP$MARGIN then
call breakPage;
end;
else
call fatalCmdError;
END;
DO; /* DOTO */
if cmdChr2 = 'P' then
DO$PAGENUM = 0;
else
call fatalCmdError;
END;
DO; /* DOTP */
if cmdChr2 = 'A' then
do;
call break;
if (i := GET8$ABS$NUMBER) = 0 then
i = 1;
if CUR$LINENO = 0 then
i = i - 1;
do j = 1 to i;
call EOP;
end;
end;
else if cmdChr2 = 'L' then
do;
PAGE$LEN = GET8$NEW$VALUE(PAGE$LEN);
if PAGE$LEN > 128 or PAGE$LEN = 0 then
PAGE$LEN = 66;
PRINT$LEN = PAGE$LEN - (BOTTOM$MARGIN + TOP$MARGIN);
end;
else if cmdChr2 = 'N' then
do;
if (PAGE$NUM := GET16$NEW$VALUE(PAGE$NUM)) = 0 then
PAGE$NUM = 1;
DO$PAGENUM = 0FFH;
end;
else if cmdChr2 = 'O' then
do;
call break;
PO$CHANGED = 0FFH;
PAGE$OFFSET = GET8$NEW$VALUE(PAGE$OFFSET);
PAGE$WIDTH = PAGE$OFFSET + CUR$INDENT + LINE$LEN;
if PAGE$WIDTH > 160 then
do;
LINE$LEN = 160;
PAGE$WIDTH = 160 + PAGE$OFFSET + CUR$INDENT;
end;
end;
else if cmdChr2 = 'P' then
do;
call break;
if CUR$LINENO = 0 then
call procLine0;
else
call SPACING(LINE$SPACING);
IS$INDENTED = 0FFH;
if (i := GET8$ABS$NUMBER) <> 0 then
do;
if i < LINE$LEN then
PP$INDENT = i;
else
call error(.('PP COMMAND $'));
end;
do j = 1 to PP$INDENT;
call ADD$CHAR(' ');
end;
end;
else
call fatalCmdError;
END;
DO; /* DOTQ */
if cmdChr2 = 'I' then
do;
call break;
CUR$INDENT = 0;
LINE$LEN = PAGE$WIDTH - PAGE$OFFSET;
end;
else
call fatalCmdError;
END;
call fatalCmdError; /* DOTR */
DO; /* DOTS */
if cmdChr2 = 'P' then
do;
call break;
if (i := GET8$ABS$NUMBER) = 0 then
i = 1;
call SPACING(i * LINE$SPACING);
end;
else if cmdChr2 = 'S' then
do;
call break;
LINE$SPACING = 1;
end;
else
call fatalCmdError;
END;
DO; /* DOTT */
if cmdChr2 = 'B' then
do;
INPUT$CHAR = ' ';
j = 0;
do i = 0 to 18;
if (k := (TABSTOPS(i) := GET$NUMBER)) = 0 then
do;
TABSTOPS(i) = 0FFH;
i = 18;
end;
else if k > j then
j = k;
else
call fatalCmdError;
end;
call checkCRLF;
end;
else if cmdChr2 = 'I' then
do;
call break;
HAS$TMP$INDENT = 0FFH;
IS$INDENTED = 0FFH;
i = GET8$NEW$VALUE(CUR$INDENT);
do while (i := i - 1) <> 0FFH;
call ADD$CHAR(' ');
end;
end;
else
call fatalCmdError;
END;
DO; /* DOTU */
if cmdChr2 = 'C' then
LOWER$CASE = 0;
else
call fatalCmdError;
END;
end;
end procDotCmd;
DECLARE (chr, AT$BOL) BYTE;
sub$184C: PROCEDURE;
sub$1981: PROCEDURE;
if AT$BOL then
do;
ELINE = NLINE;
call PUT$TEXT$CHAR(' ');
if STATE = PUNCTUATED then
call PUT$TEXT$CHAR(' ');
WLINE = NLINE;
STATE = INSPACE;
end;
end sub$1981;
CHECK$PUNCTUATION: PROCEDURE BYTE;
if chr = '.' or chr = '?' or chr = '!' or chr = ':' then
do;
call peekChar;
if peekedChar = 0DH or peekedChar = 1AH or peekedChar = ' ' then
return 0FFH;
end;
return 0;
end CHECK$PUNCTUATION;
AT$BOL = 0;
STATE = SINITIAL;
ELINE, WLINE = NLINE;
do while (chr := GETCH) <> 1AH;
if chr = 0DH then
do;
AT$BOL = 0FFH;
do while (chr := GETCH) = 0AH;
end;
if chr = 1AH then
return;
end;
else
AT$BOL = 0;
GCR: if chr = 0DH then
do;
if STATE <> SKIPBLANKLINE then
call break;
do while (chr := GETCH) = 0AH;
end;
call emitLine;
STATE = SKIPBLANKLINE;
if chr = 1AH then
return;
else
goto GCR;
end;
else if chr = ' ' then
do;
if STATE <> INSPACE then
ELINE = NLINE;
call PUT$TEXT$CHAR(chr);
STATE = INSPACE;
end;
else if CHECK$PUNCTUATION then
do;
if STATE <> INWORD then
WLINE = NLINE;
call PUT$TEXT$CHAR(chr);
WLINE, ELINE = NLINE;
STATE = PUNCTUATED;
end;
else if chr = '.' and (STATE = 0 or AT$BOL or STATE = 4) then
do;
call sub$1981;
call procDotCmd;
unk$1F15 = 0FFH;
unk$1F0A = 0FFH;
STATE = 0;
end;
else
do;
call sub$1981;
if STATE <> INWORD then
WLINE = NLINE;
call PUT$TEXT$CHAR(chr);
STATE = INWORD;
end;
end;
end sub$184C;
PARAM$SCAN: PROCEDURE;
DECLARE (c, i, dollar) BYTE;
dollar = 0;
i = 0;
do while (c := CMDLINE(i := i+1)) <> 0;
if dollar then
do;
if c = 'C' then
do;
IO$REDIRECT = 0FFH;
outMode = CONSOLE;
end;
else if c = 'L' then
do;
IO$REDIRECT = 0FFH;
outMode = LIST;
end;
else if c = 'S' then
do;
IO$REDIRECT = 0FFH;
outMode = SUPPRESS;
end;
else if c = 'E' then
ERR$PRINT = 0FFH;
else if c = 'F' then
FORM$FEED = 0FFH;
else if c = 'P' then
do;
PAGE$MODE = 0FFH;
IO$REDIRECT = 0FFH;
outMode = LISt;
end;
else if c <> ' ' and c <> '$' then
call fatalError(.('PARAMETER SCAN$'));
end;
else if c = '$' then
dollar = 0FFH;
end;
end PARAM$SCAN;
prepFiles: PROCEDURE;
if FCB1(1) = ' ' then
call fatalError(.('OPENING SOURCE$'));
if FCB1(9) = ' ' then
call memcpy(.('TEX'), .FCB1(9), 3);
if FCB2(1) = ' ' or FCB2(1) = '$' then
do;
call memcpy(.FCB1, .OUTFCB, 16);
OUTFCB(0) = FCB2(0);
call memcpy(.('PRN'), .OUTFCB(9), 3);
end;
else
do;
call memcpy(.FCB2, .OUTFCB, 16);
if OUTFCB(9) = ' ' then
call memcpy(.('PRN'), .OUTFCB(9), 3);
end;
FCB1(32) = 0;
OUTFCB(32) = 0;
call PARAM$SCAN;
call open(.FCB1);
if cpmRetVal = 0FFH then
call fatalError(.('OPENING SOURCE$'));
if not IO$REDIRECT then
do;
call delete(.OUTFCB);
call make(.OUTFCB);
if cpmRetVal = 0FFH then
call fatalError(.('OPENING DESTINATION$'));
end;
end prepFiles;
signOn: PROCEDURE;
if outMode <> CONSOLE then
CALL wrstr(.('TEX VERSION 1.0$'));
else if FORM$FEED then
DO;
call wrstr(.('TEX VERSION 1.0$'));
call PUTDEST(0CH);
END;
end signOn;
INITIALISE: PROCEDURE;
DECLARE INB BASED INPUT$BUF(1) BYTE;
INPUT$CHR$OFFSET = INPUT$BUF$SIZE;
INB(1) = 0;
NLINE = 0;
SLINE = 0;
OUTPUT$CHR$OFFSET = 0;
outMode = 0;
CUR$LINENO = 0;
PAGE$NUM = 1;
CHARS$IN$LINE$BUF = 0;
OUT$COL = 1;
heading(0) = 0;
heading(160) = 0;
LINE$LEN = 70;
PAGE$OFFSET = 8;
CUR$INDENT = 0;
PP$INDENT = 6;
PAGE$WIDTH = 78;
PAGE$LEN = 66;
PRINT$LEN = 55;
TOP$MARGIN = 6;
TOP$SPACES = 3;
HEADING$MARGIN = 2;
BOTTOM$MARGIN = 5;
LINE$SPACING = 1;
IS$INDENTED = 0FFH;
IS$JUSTIFIED = 0FFH;
HAS$TMP$INDENT = 0;
LL$INCREASED = 0;
unk$1F0A = 0;
LOWER$CASE = 0;
FORM$FEED = 0;
PAGE$MODE = 0;
ERR$PRINT = 0;
IO$REDIRECT = 0;
PO$CHANGED = 0FFH;
DO$PAGENUM = 0FFH;
unk$1F15 = 0FFH;
havePeeked = 0;
end INITIALISE;
TEXSTART:
INPUT$BUF$SIZE = SHR((BASECCP - .MEMORY) AND 0FF00H,1);
INPUT$BUF = .MEMORY;
OUTPUT$BUF = INPUT$BUF + INPUT$BUF$SIZE;
call INITIALISE;
call prepFiles;
call signON;
call wrconCRLF;
call sub$184C;
call sub$EEF;
end;
Reference in New Issue View Git Blame Copy Permalink