perm filename PASS2.SAI[PUB,TES] blob
sn#215394 filedate 1976-05-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "PUB2"
C00013 00003 SIMPLE PROCEDURE WARN(STRING MESSG)
C00021 00004 ONE ← 1 COMMENT TO FORCE ARRAY TO BE DYNAMIC
C00033 00005 BEGIN "INNER BLOCK"
C00038 00006 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR)
C00043 00007 SIMPLE PROCEDURE SLIDERROR
C00046 00008 IF PAGEHIGH THEN GO TO CONTINUE comment, re-entered
C00050 00009 WHILE (TOPLINE ← INNUM) > -10 DO
C00053 00010 CASE CHARTBL[PAGEBRC] OF
C00056 00011 4 ... CR -- Justify it
C00062 00012 ELSE BEGIN CHAR ← 0 MAX APPD(S)
C00070 00013 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
C00073 00014 5 ... LF BEGIN END
C00077 00015 IFC PARCVER THENC PARCDOC ENDC
C00078 00016 BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT K!OUT END COMMENT ** ** ** ** **
C00083 ENDMK
C⊗;
BEGIN "PUB2"
COMMENT NOTE THAT THE PARCVER USES MEMORY PAGES 700-712 AS A BUFFER ;
REQUIRE "[]<>" DELIMITERS ;
REQUIRE "SITE" SOURCE!FILE;
REQUIRE 6500 STRING!SPACE ;
DEFINE
PASSONE = [FALSE],
PASSTWO = [TRUE],
BEGOF(NAME) = [ ],
ENDOF(NAME) = [ ],
PROCEDURES = [ ],
FINISHED = [ ],
PUBLIC = [ ],
PRIVATE = [ ],
$ = ["],
# = [],
IFK = [IFC],
THENK = [THENC],
IFSITE = [IFK],
SITE(DUMMY) = [ ],
TERNAL = [] ;
REQUIRE "COMMON" SOURCE!FILE ;
COMMENT The Document Compiler -- Pass Two ;
COMMENT Pass One and Two share certain declarations, but in
one case, the meaning of a variable is different:
In Pass 1, XCRIBL is true for either
an XGP -or- PARC's MIC.
In Pass 2, XCRIBL is only true for an
XGP. MICRO is true for PARC's MIC
and RASTER is true for both. ;
COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
Height Width MillLeftMargin MillRightMargin
For each area:
UpperLine NumCols NumLines
For each column:
LeftChar
For each non-null line:
Line Number
How far short of justification
Excess mill leading
Index of Intermediate Ascii File line
0
-10
PASS 2 reads the output file name and the intermediate page file names from
PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
each page from each page file, processes each line in each of
its areas, and writes out a line printer image on the output file.
Each line is subject to three operations, in this order:
(1) Substitute label values at each vertical tab.
(2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
(3) Generate underlining and super/sub-scripting as indicated by rubouts.
;
IFC CMUVER THENC REQUIRE "PUBTMP.SAI" SOURCE!FILE;
REQUIRE "CMUPUB.SAI" SOURCE!FILE;
ENDC COMMENT RKJ: 26-SEP-74 and 6-Feb-75;
DEFINE THRU = [STEP 1 UNTIL], DOWN = [STEP -1 UNTIL],
LH(X) = [(X LSH -18)], RH(X) = [(X LAND '777777)],
AWHILE = [WHILE TRUE],
INNUM = [WORDIN(ICHAN)],
SCN(BRKTBL)= [(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))],
SCNUM = [CVD(SCN(TO!ALTMODE!SKIP))],
LPT = [1], TTY = [2], MIC = [3], XGP = [4],
HORIZ= ['40], VERTI= ['41], CSIZE= ['42], ULINE= ['43], RSPCS= ['44],
LSPCS= ['45], UDOTS= ['46], RDOTS= ['47], comment FR80 escape codes ;
FULSTR(X) = [LENGTH(X)], NULSTR(X) = [(LENGTH(X)=0)],
CR = ['15], LF = ['12], VT = ['13], FF = ['14], SP = ['40],
RUBOUT = ['177], TB = ['11],
ALTMODE = IFC TENEX THENC ['33] ELSEC
IFC SAILVER THENC ['175] ELSEC ['176] ENDC
ENDC,
TO!ALTMODE!SKIP = [1], TO!LF!APPD = [2],
ONE!CHAR = [3], BREAKER = [4], TO!RUB!ALT!SKIP = [5],
LOCAL!TABLE = [6],
FIML = [256],
ANS(A) = [(S = "A" OR S = "A" + '40)];
DEFINE COMMENT FOR XGP;
USEA= [('177&'14)], USEB= [('177&'15)], VSB= [('177&'20)],
XTAB= [('177&'30)],
XGPNUM(N)= [(((N) LSH -7) & (N))]; RKJ: 6-Feb-75 needed more ();
DEFINE ESCAPE1= [('177&'1)], ESCAPE2= [('177&'2)];
DEFINE CTLK = [11], CTLF= [6], CTLE= [5], CTLT= ['24], CTLQ= ['21];
IFC SAILVER THENC DEFINE RPGEXT = [".RPG"] ; ENDC
IFC CMUVER THENC
STRING PUIEXT; RKJ: 6-FEB-75;
ELSEC
PJ 5/28/74 ; DEFINE
PUIEXT = IFC ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
OCTEXT = IFC ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
TXTEXT = IFC ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;
ENDC
TES 1/7/74 ; DEFINE CTLC= [3], CTLH= ['10], CTLR= ['22], CTLU= ['25], CTLS= ['23] ;
EXTERNAL INTEGER !SKIP! ;
INTEGER BRC, EOF ; COMMENT FOR FONTS TES 10/22/74 ;
INTEGER IML, IMC, comment, no. of lines and chars per page image ;
DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
LFTMAR, comment RASTER left margin (for tabs) ;
RGTMAR, comment RASTER right margin ;
INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
MILLVERTI, RASTVERTI, COMMENT TES 11/2/74 "NORMAL" INTERLINE FOR THIS DOC ;
LISTCHAN, comment output file ;
BAR, TES underlining character (or 0 if OFF) 10/22/73;
PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
I, J, K, L, M, N, DUMMY, comment general-purpose ;
LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
TOPLINE, NCOLS, NLINES, comment Area info ;
COL, LEFTCH, comment Column info ;
SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
NEEDCR, comment, assures CR before every LF for Stanford LPT ;
LINENO, MLEAD, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
ONE, comment, 1 ;
BOTMAR, TOPMAR, RASTPHIGH, RASTPWIDE, RASTLHIGH, comment raster units ;
LINEY, CURRENTX, CURRENTY, DLBP, DLBP1, FSTFONT,
TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
INTEGER SCRIPT, comment baseline adjustment ;
THISFONT, comment PARC font number for scripts;
SCRLVL; comment baseline level ;
INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
BOOLEAN MICRO, RASTER ; TES 8/23/74 RASTER = XCRIBL OR MICRO ;
IFC CMUVER THENC BOOLEAN FIRST!OUTPUT ; ENDC RKJ: 10-SEP-74 ;
BOOLEAN NEEDFONTS ; TES 10/17/74 FOR PARC MIC ;
BOOLEAN NEEDVERTI ; TES 11/4/74 ;
INTEGER FSIZE; comment kludge for sliding foward references ;
EXTERNAL INTEGER RPGSW ;
STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S, SR,
OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
STRING SPSSTR ; COMMENT A STRING OF 200 SPACES (TES 8/28/74) ;
TES 1/7/74 ; STRING CMDFILE ;
TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;
REAL RATIO ;
INTEGER ARRAY CHARTBL[0:127], OFSIZE,DIVISOR,XINFSTRL,SLIDESG,RB,LBD[1:5] ;
INTEGER ARRAY FNTSIZE,FNTCHAN[0:35] ;
STRING ARRAY LBF[1:5] ;
PRELOAD!WITH "", " ", " ", " ", " ", " ", " ",
" ", " ", " ", " " ;
THAFE STRING ARRAY SPSARR[0:10] ;
TES ADDED ALL PARC MIC STUFF ABOUT 8/28/74 : ;
IFCR PARCVER THENC
PARCODES
PARCARRAYS
ENDC
RKJ: 6-Feb-75 localize CMU code in separate file ;
IFCR CMUVER THENC
CMUCODES
ENDC
SIMPLE PROCEDURE WARN(STRING MESSG) ;
USERERR(0,1,MESSG) ;
INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
BEGIN "READIN"
INTEGER CH, FLAG ;
CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
LOOKUP(CH, FILENAME, FLAG) ;
IF FLAG THEN WARN("Pass one said to read this file: " &
FILENAME & " but it does not exist") ;
RETURN(CH) ;
END "READIN" ;
INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
IFC TENEX THENC
OPENFILE(FILENAME, "WC") ;
ELSEC
BEGIN "WRITEON"
INTEGER CH ;
CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
AWHILE DO RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
BEGIN
ENTER(CH, FILENAME, DUMMY←0);
IF NOT DUMMY THEN DONE;
OUTSTR("Cannot ENTER """ & FILENAME & """ Write file: ");
FILENAME←INCHWL;
END;
RETURN(CH);
END "WRITEON" ;
ENDC
IFC TENEX THENC
INTEGER SIMPLE PROCEDURE WRITE16(STRING FILENAME) ;
BEGIN "WRITE16"
INTEGER CH ;
CH ← GTJFN(FILENAME, 1) ;
IF CH<0 THEN WARN("Error in GTJFN of Document file " & FILENAME) ;
OPENF(CH, '200000100000) ;
IF !SKIP! THEN
BEGIN
ERSTR(!SKIP!,0) ;
WARN("Error opening Document file " & FILENAME) ;
END ;
RETURN(CH) ;
END "WRITE16" ;
ENDC
STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
RETURN('177 & OP & (IF OP LEQ '42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
IFC SAILVER THENC comment RHT 4/22/76;
RECURSIVE STRING PROCEDURE VARBSPACE(INTEGER N);
BEGIN "VARBSPACE"
IFC SAILXGP THENC
IF N LEQ 0 THEN RETURN(NULL) ELSE
IF N GEQ 65 THEN RETURN(ESCAPE2 & '100 & VARBSPACE(N-64)) ELSE
RETURN(ESCAPE2&((-N) LAND '177));
ELSEC
REQUIRE "VARBSPACE ONLY DEFINED AT STANFORD" MESSAGE;
ENDC
END "VARBSPACE";
ENDC
RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
BEGIN "VARBLANK"
IFC CMUXGP THENC
IF N LEQ 0 THEN RETURN(NULL) ELSE
IF N GEQ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
RETURN(VSB&N)
ELSEC IFC SAILXGP THENC
IF N LEQ 0 THEN RETURN(NULL) ELSE
IF N GEQ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
RETURN(ESCAPE2&N)
ELSEC IFC PARCVER THENC
RETURN(CTLE&CVS(N)&".")
ENDC ENDC ENDC;
END "VARBLANK";
INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ;
IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
ELSE RETURN(SPSSTR[1 TO N]) ;
IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
BEGIN
INTEGER DUMMY ;
SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
END ;
ENDC
IFC PARCVER THENC PARCOUT ENDC
STRING SIMPLE PROCEDURE SPARAM ;
BEGIN "SPARAM"
STRING S ;
S ← NULL ;
DO S ← S & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC = ALTMODE OR SEQEOF ;
RETURN(S) ;
END "SPARAM" ;
INTEGER SIMPLE PROCEDURE IPARAM ; RETURN(CVD(SPARAM)) ;
IFC CMUXGP THENC RKJ: 29-AUG-74;
INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
comment returns the location of the first occurance of
the string B in A, 0 if none;
BEGIN "INDEX2"
INTEGER LA, LB;
IF (LB←LENGTH(B))=0 THEN RETURN(1);
IF (LA←LENGTH(A)-LB+1) LEQ 0 THEN RETURN(0);
START!CODE
LABEL L1, L2, OUTT, NEXT;
MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
JUMPE 1,OUTT;
MOVE 4,2; MOVE 5,B; MOVE 6,LB;
L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
ADD 1,LA; AOJ 1,0;
OUTT:
END;
END "INDEX2";
SIMPLE STRING PROCEDURE FIXUP(STRING S);
BEGIN "FIXUP"
INTEGER ALOC,BLOC;
IF NOT XCRIBL THEN RETURN(S) ; RKJ: 28-SEP-74 ;
IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
IF ALOC=0 THEN ALOC←BLOC;
IF BLOC=0 THEN BLOC←ALOC;
ALOC←ALOC MIN BLOC;
RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
END "FIXUP";
ELSEC
DEFINE FIXUP(X)="X";
ENDC
IFC TENEX THENC
SIMPLE PROCEDURE SFBSZ(INTEGER CHAN, SIZE) ;
BEGIN "SFBSZ"
INTEGER K ;
DEFINE JSYS=['104000000000], SFBSZ=[JSYS '46];
K ← CVJFN(CHAN) ;
START!CODE "BYTE16"
MOVE 1,K; MOVE 2,SIZE; SFBSZ ;
END "BYTE16" ;
END "SFBSZ" ;
ENDC
ONE ← 1 ; COMMENT TO FORCE ARRAY TO BE DYNAMIC ;
BEGIN "VARIABLE BOUND ARRAY BLOCK"
THAFE INTEGER ARRAY CW[0:ONE] ;
REQUIRE "DATUM" SOURCE!FILE ;
REQUIRE "FONTS" SOURCE!FILE ;
BOOLEAN SIMPLE PROCEDURE READFONT(INTEGER WHICH) ;
BEGIN
INTEGER CHAN ;
FNTCHAN[WHICH] ← CHAN ←
IFC PARCVER THENC OPENFILE(FNTNAME[WHICH], "RO")
ELSEC READIN(FNTNAME[WHICH], TRUE, BRC, EOF) ENDC ;
IF CHAN<0 THEN WARN("Can not open font file " &
FNTNAME[WHICH] & " in pass two. This is a bug") ; TES 10/18/74 ;
BRC ← FNTFIL[WHICH] ← CREATE(0,127) ; MAKEBE(BRC, CW) ;
FNTSIZE[WHICH] ← PERUSEFONT(WHICH, CHAN) ;
IFC PARCVER THENC RETURN(FNTNUMBER[WHICH]<0) TES 10/17/74 ;
ELSEC RELEASE(CHAN) ENDC ;
END "READFONT" ;
RKJ: 6-FEB-75 MOVED UNMASH TO OUTER BLOCK;
SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
STRING S ; S ← NULL ;
WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
RETURN(S) ;
END ;
COMMENT I N I T I A L I Z E ;
WCW ← WHATIS(CW) ;
IFC PARCVER THENC
SR ← NULL ;
DUMMY←CVSIX("PUB2 ");
START!CODE
MOVE 1,DUMMY;
'104000000210;
END;
ARRCLR(NILS, 1) ;
ENDC
SPSSTR ← SP ;
FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR & SP ; TES 8/28/74 ;
SCRIPT ← 10;COMMENT RHT 5/8/76 IF YOU CHANGE THIS, ALSO CHANGE SCRIPTSTRENGTH IN GLOBE;
IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;
IFC CMUVER THENC JOBNO ← ("0" & CVS(CALL(0,"PJOB")))[INF-1 FOR 2] ; ENDC RKJ: 6-FEB-75 ;
IFC PARCVER THENC IML←65; IMC←72; ENDC
IFC SAILVER THENC IML←53; IMC←69; ENDC
IFC ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
IFC CMUVER THENC IML←55; IMC←69; ENDC
IFC ISIVER THENC IML←55; IMC←69; ENDC
PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
IFC TENEX THENC
IF RPGSW THEN
BEGIN
IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
RELEASE(IFICHAN) ; TES 6/11/74 ;
END
ELSE BEGIN TES 6/11/74 REVISED ;
OUTSTR("MANUSCRIPT: ") ;
WHILE -1 = (J ←
GTJFNL(NULL, '162000000000, '100000101,
NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
OUTSTR(" ?" & CRLF & "MANUSCRIPT: ") ;
IFILENAME ← JFNS(J, '1000000000) ;
RLJFN(J) ;
END ;
ENDC
IFC CMUVER THENC
OPEN(SEQCHAN←GETCHAN,"DSK",'17,0,0,0,0,0);
AWHILE DO
BEGIN
LOOKUP(SEQCHAN,"PUPSEQ"&(PUIEXT←"."&JOBNO&"I"),DUMMY);
IF NOT DUMMY THEN DONE;
OUTSTR("cannot find intermediate files."&CRLF&
"under what job number did you run Pass 1? ");
JOBNO←("0" & INCHWL)[INF-1 FOR 2];
END;
RELEASE(SEQCHAN);
ENDC RKJ: 6-FEB-75 ;
OUTSTR("PASS TWO ") ;
SEQCHAN ← READIN(
IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
FALSE, SEQBRC, SEQEOF) ;
TMPFILE ← SPARAM ;
LISTFILE ← SPARAM ;
DEBUG ← IPARAM ;
DEVICE ← IPARAM ;
XCRIBL ← DEVICE=XGP ;
IFC PARCVER THENC
MICRO ← DEVICE=MIC ;
PDIX ← OUTCOUNT ← 0 ;
IF MICRO THEN
BEGIN
DLBP1 ← '041000677777 ; COMMENT BYTE POINTER ;
END ;
ELSEC MICRO ← FALSE ; ENDC ;
RASTER ← MICRO OR XCRIBL ;
DELINT ← SPARAM ;
LOFONT ← IPARAM ; HIFONT ← IPARAM ;
NEEDFONTS ← FALSE ; TES 10/17/74 ;
FOR J ← LOFONT THRU HIFONT DO
IF FULSTR(FNTNAME[J] ← SPARAM) THEN
IF READFONT(J) THEN NEEDFONTS ← TRUE ;
IFC PARCVER THENC
IF MICRO AND NEEDFONTS THEN
BEGIN TES 10/17/74 ;
K ← -1 ;
FOR J ← LOFONT THRU HIFONT DO IF FULSTR(FNTNAME[J]) THEN
FNTNUMBER[J] ← K ← K + 1 ;
END ;
ENDC
CMDFILE ← SPARAM ;
BAR ← SPARAM[1 FOR 1] ;
IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
CHARW ← IPARAM;
NEEDVERTI ← FALSE ;
IF (MILLVERTI←IPARAM) LEQ 0 THEN
BEGIN
INTRA ← IFC NOT SAILXGP THENC 0 ; ENDC
MILLVERTI ← ABS(MILLVERTI) ;
NEEDVERTI ← RASTER ;
END
ELSE INTRA ← MILLVERTI ;
BASELINE ← IPARAM; BASELINE←BASELINE+(BASELINE DIV 4);
DOPASS3 ← IPARAM; RKJ: 1-4-74;
IFC CMUVER THENC FIRST!OUTPUT ← NOT DOPASS3 ; ENDC RKJ: 28-SEP-74 ;
VBPI ← IPARAM ;
HBPI ← IPARAM ;
MINLFTMAR ← IPARAM ;
TOPMAR ← (IPARAM*VBPI + 500) DIV 1000 ; TES 1/26/74 ;
BOTMAR ← (IPARAM*VBPI + 500) DIV 1000 ; TES 1/26/74 ;
INTRA ← (INTRA*VBPI + 500) DIV 1000 ; TES 11/2/74 ;
RASTVERTI ← (MILLVERTI*VBPI + 500) DIV 1000 ; TES 11/2/74 ;
IF NOT RPGSW AND NOT RASTER THEN COMMENT STARTED BY ".R PUB2" ;
DO BEGIN
OUTSTR("OUTPUT DEVICE (LPT or TTY): ") ;
S ← INCHWL ;
DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE 0 ;
END
UNTIL DEVICE ;
IF NOT RPGSW AND DEBUG THEN
IF DEVICE = MIC THEN DEBUG ← 0
ELSE DO BEGIN
OUTSTR("Debug info in right margin? (Y or N) = ") ;
S ← INCHWL ;
DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
END
UNTIL DEBUG < 100 ;
ENDLINE ← LF ; ENDPAGE ← FF ;
IFC PARCVER THENC IF MICRO THEN ENDLINE ← MEOL ; ENDC
RESTARTLINE ←
IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
ELSEC CR ENDC ; TES 11/1/73 ;
IFC SAILVER THENC
CASE DEVICE-1 OF
BEGIN "DEV"
comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
IF DEBUG THEN BEGIN OUTSTR(CRLF&"Won't put Debug info on Microfilm"&CRLF) ;
DEBUG ← FALSE ; END END ;
COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
END "DEV" ;
ELSEC
IFC PARCVER THENC
IF MICRO THEN LISTCHAN ← WRITE16(LISTFILE) ELSE
ENDC
LISTCHAN ← WRITEON(LISTFILE) ;
ENDC
IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC
OUTSTR(LISTFILE) ;
J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
LABCHAN ← READIN(
IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
FALSE, LABBRC, LABEOF) ;
NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;
LASL ← 1000 ; comment, last physical line occupied on the page ;
S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;
TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
IFC PARCVER THENC
IF XCRIBL THEN OUT(LISTCHAN,
(RUBOUT&CTLC) & CMDFILE &
("K EFHJKLMQRSTU" & CR & "I " & CVS(INTRA) &
CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
COMMENT
CTLC Initiallize switches (used as RUBOUT CTLC)
CTLE Variable blank
CTLF Font change
CTLH Overstrike
CTLJ=LF Line Feed
CTLK Vertical Spacing
CTLL=FF Form Feed
CTLM=CR Carriage Return
CTLQ Quote control character
CTLR Return to baseline from ript
CTLS Subscript
CTLT Tab
CTLU Superscript
RUBOUT Treat as control character (inverse CTLQ)
;
ENDC
IFC SAILVER THENC
IF XCRIBL THEN
OUT(LISTCHAN,"/LMAR="&CVS(LFTMAR)&"/XLINE="&CVS(INTRA)&CMDFILE&CRLF&FF) ;
ENDC
IFC ITSVER THENC PJ 8/24/74 ;
IF XCRIBL THEN
BEGIN
OUT(LISTCHAN,";LFTMAR "&CVS(LFTMAR)&CRLF&
";VSP "&CVS(INTRA)&CRLF&
";SKIP 1"&CRLF);
SETBREAK(LOCAL!TABLE,CR,NULL,"IA") ;
DO OUT(LISTCHAN, SCAN(CMDFILE, LOCAL!TABLE, BRC)&LF ) UNTIL BRC NEQ CR ;
OUT(LISTCHAN, FF);
SETBREAK(LOCAL!TABLE,NULL,NULL,"IS");
END;
ENDC
IFC CMUVER THENC
IF XCRIBL THEN OUT(LISTCHAN,UNMASH(CMDFILE)&
CMU!FMT(1)&
(IF NEEDVERTI THEN CMU!VS(INTRA) ELSE NULL));
ENDC
BEGIN "INNER BLOCK"
STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
AWHILE DO
BEGIN "LABEL"
TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
INPUT(LABCHAN, TO!ALTMODE!SKIP) &
(IF RASTER THEN
(ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
ELSE NULL);
END "LABEL" ;
RELEASE(LABCHAN);
COMMENT G O ! ;
IF MICRO THEN IML ← 1 ; COMMENT SAVE STORAGE ;
DO comment, This loop is re-entered only if page image grows ;
BEGIN "SIZE"
THAFE STRING ARRAY IMG[1:IML+IML], SEG[0:8*IMC], SRCREF[1:IML] ;
THAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML], LEADING,SNUCK[1:IML+1] ; RKJ: 6-FEB-75 SNUCK ;
LABEL CONTINUE ;
COMMENT * * * * A P P D * * * * ;
INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
IFC PARCVER THENC PARCAPPD ENDC
BEGIN "APPD"
INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
L ← LINE ; EXTRA ← LENGTH(S) ;
IF XCRIBL THEN
BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
IF CHAR < (HAD ← LASC[L]) THEN
BEGIN
FAKE[L] ← FAKE[L] + HAD - CHAR ;
HAD ← LASC[L] ← CHAR ;
END
END
ELSE
WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN
WARN("Too much for one page: " & S)
ELSE L ← AVAIL ;
SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
T ← IMG[L] ;
IF LENGTH(T) < HAD+SPACES+EXTRA THEN
BEGIN comment no room -- must use concatenate ;
SS ← SPS(SPACES) ;
IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞]
END
ELSE BEGIN comment there's room in old string -- IDPB into it.;
SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
END "APPEND" ;
END ;
RETURN(LASC[L] ← CHAR + EXTRA) ;
END "APPD" ;
COMMENT * * * * C T R L * * * * ;
SIMPLE PROCEDURE CTRL(STRING S) ;
BEGIN "CTRL"
CHAR ← 0 MAX APPD(S) - LENGTH(S) ;
LASC[L] ← CHAR ;
FAKE[L] ← FAKE[L] + LENGTH(S) ;
END "CTRL" ;
SIMPLE PROCEDURE MCTRL(INTEGER C) ;
BEGIN "MCTRL"
QUICK!CODE "MCTRLAPPEND"
LABEL RBYTE ;
DEFINE WD=['13] ;
MOVE WD, C ;
CAIG WD,'377 ;
JRST RBYTE ;
ROT WD, -8 ;
IDPB WD, DLBP ;
ROT WD, 8 ;
RBYTE:
IDPB WD, DLBP ;
END "MCTRLAPPEND" ;
END "MCTRL" ;
RKJ: 8-Nov-74 following code;
IFC CMUVER THENC
SIMPLE PROCEDURE CMUSCRIPT(INTEGER LEVEL; STRING S);
BEGIN "CMUSCRIPT" RKJ: modified 6-Feb-75 ;
STRING SCRIPT;
IF LEVEL>0 THEN SCRIPT←CMU!SUP(LEVEL,0) ELSE SCRIPT←CMU!SUB(-LEVEL,0);
WHILE FULSTR(S) DO
BEGIN CTRL(SCRIPT); CHAR←APPD(LOP(S)) END;
END "CMUSCRIPT";
ENDC
SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
BEGIN "UNDERSCORE"
INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
NUMCHARS ← RIGHTCHAR - UNDERLINE ;
IF NUMCHARS > 0 THEN
BEGIN
SAVEHORIZ ← CHORIZ ;
DESCEND ← CCSIZE DIV 4 ;
CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
UNDERLINE ← RIGHTCHAR ;
END ;
END "UNDERSCORE" ;
SIMPLE PROCEDURE CHANGESPACING ;
IF (N←CHRS-CHAR-1)>0 AND (K←(J←N*CHORIZ+SHORTM)/N MIN 511) NEQ CHORIZ THEN
BEGIN "CHANGESPACING"
IF UNDERLINE GEQ 0 THEN UNDERSCORE(CHAR) ;
SHORTM ← J - K*N ;
IF NOTFST AND (UNDERLINE<0 OR SHORTM<0) THEN
BEGIN CTRL(DORDOTS(SHORTM)) ; SHORTM ← 0 END ; TES CTRL 8/28/74;
CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
END "CHANGESPACING" ;
SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
BEGIN "FONTSELECT"
IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
THISFONT ← WHICH ; TES 10/17/74 ;
IFC CMUXGP THENC
WHICH←WHICH MOD 9; COMMENT MAKE 1,A 2,B EQUIVALENT;
IF WHICH=1 THEN CTRL(USEA) ELSE
IF WHICH=2 THEN CTRL(USEB) ELSE
WARN("Font " & CVS(WHICH) & " ignored")
ELSEC IFC SAILXGP THENC
IF WHICH>16 THEN WARN("Font " & CVS(WHICH) & " ignored") ELSE
BEGIN
CTRL(ESCAPE1&(WHICH-1));
IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
END;
ELSEC IFC PARCVER THENC
PARCFONT
ENDC ENDC ENDC;
END "FONTSELECT";
STRING SIMPLE PROCEDURE XTABSTR(INTEGER N); RKJ: NEW 1-4-74;
BEGIN "XTABSTR"
IFC CMUXGP THENC RETURN(XTAB&XGPNUM(N)) ENDC
IFC SAILXGP THENC
RETURN(ESCAPE1&'40&XGPNUM(N))
ENDC
IFC PARCVER THENC
RETURN(CTLT&CVS(N)&".")
ENDC;
END "XTABSTR";
SIMPLE PROCEDURE XGPTAB(INTEGER N); RKJ: NEW 1-4-74;
CTRL(XTABSTR(N+TLFTMAR));
STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
BEGIN
INTEGER I ; STRING S ;
S ← NULL ;
FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
RETURN(S) ;
END ;
SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN) ;
RETURN(
((RH(BPNOW)-RH(BPTHEN)) LSH 2) + ((28-((BPNOW ROT 6) LAND '77)) LSH -3) - 3
) ;
IFC PARCVER THENC PARCLINE ENDC
SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ;
BEGIN "IMPOSSIBLE"
IF SG > -1 THEN
BEGIN
OUTSTR(CRLF & HOW & " Error."&CRLF&
"This is an encoding of text line " & CVS(LINE) & ":" & CRLF) ;
FOR I ← 1 THRU SG DO OUTSTR(SEG[I]) ;
END ;
WARN("A supposedly impossible condition has been encountered."&CRLF&
"This is most likely a PUB bug. However, you may have an error"&CRLF&
"which produced unanticipated line lengths or other strange effects."&
(IF DEBUG THEN CRLF&"Line/Page: "&SRCREF[LINE] ELSE NULL)) ;
END "IMPOSSIBLE" ;
SIMPLE PROCEDURE SLIDERROR ;
BEGIN
IMPOSSIBLE(CVS(SLIDETOP)&" Horizontal Positioning") ;
SLIDETOP ← 1 ;
END ;
SIMPLE PROCEDURE RIGHTBOUND ;
BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
PLK: procedure reworked on 6-FEB-75;
integer DEST, CURRENT, NFSIZE, TEMP; string FILLER, OLBF;
NFSIZE←FSIZE-OFSIZE[SLIDETOP];
DEST←(RB[SLIDETOP]-NFSIZE) div DIVISOR[SLIDETOP];
CURRENT←LBD[SLIDETOP]+OFSIZE[SLIDETOP];
OLBF←LBF[SLIDETOP];
FILLER←null;
if RASTER then
begin "RASTER"
if fulstr(OLBF) then
begin "XGP INFINITY"
TEMP←(DEST-CURRENT) div XINFSTRL[SLIDETOP]; PLK: this is how many we can get in ;
while TEMP>0 do
begin TEMP←TEMP-1; FILLER←FILLER&OLBF; end;
SEG[TEMP←SLIDESG[SLIDETOP]] ← FILLER;
SEG[TEMP+1]←RUBOUT & "=" & cvs(DEST);
end "XGP INFINITY"
else SEG[SLIDESG[SLIDETOP]] ← RUBOUT & "=" & cvs(DEST);
end "RASTER"
else
begin "NON RASTER"
if fulstr(OLBF) then
begin "INFINITY"
TEMP←DEST-CURRENT;
while length(FILLER)<TEMP do
FILLER←FILLER&OLBF;
if length(FILLER)>TEMP then
FILLER←FILLER[1 to TEMP];
SEG[SLIDESG[SLIDETOP]]←FILLER;
end "INFINITY"
else SEG[SLIDESG[SLIDETOP]]←RUBOUT & "=" & cvs(DEST);
end "NON RASTER";
CHRS←DEST;
BRKS←0; FSTCHRS←CHRS; FSTBRK←SG; comment nojust to left;
FSIZE←(IF DIVISOR[SLIDETOP]=2 THEN (NFSIZE DIV 2) ELSE 0);
SLIDETOP←SLIDETOP-1;
END "RIGHTBOUND";
SIMPLE INTEGER PROCEDURE STEP!SG ;
IF SG<8*IMC THEN RETURN(SG←SG+1)
ELSE BEGIN
IMPOSSIBLE("Line complexity") ;
RETURN(SG←0) ;
END ;
IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
AWHILE DO
BEGIN "FILE"
PAGEFILE ← SPARAM ; IF SEQEOF THEN DONE ;
IFC TENEX THENC
IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
ELSEC
IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
ENDC
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
AWHILE DO
BEGIN "PAGE"
PAGEHIGH ← INNUM ; IF PAGEEOF OR PAGEHIGH LEQ 0 THEN DONE ; PAGEWIDE ← INNUM ;
LFTMAR ← 0 MAX (INNUM*HBPI + 500) DIV 1000 - MINLFTMAR ; TES 6/11/74 ADDED ;
RGTMAR ← 0 MAX ((8500-INNUM)*HBPI + 500) DIV 1000 - MINLFTMAR ; TES 8/29/74 ADDED ;
COMMENT HBPI HORIZ BITS PER INCH, MINLFTMAR BIT MIN MARGIN;
IF NOT MICRO AND (PAGEHIGH > IML OR PAGEWIDE > IMC) THEN
BEGIN "EXPAND"
IFC SAILVER THENC
IF DEVICE=MIC THEN
BEGIN "FRAME SIZE"
IF LASL NEQ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
END "FRAME SIZE"
ELSE IF DEVICE = LPT THEN
BEGIN
IF (LASL-1) MOD 66 + 1 LEQ 6 AND (PAGEHIGH-1) MOD 66 < 60 THEN
OUT(LISTCHAN, ENDPAGE) ;
ENDLINE ← IF PAGEHIGH GEQ 54 THEN RUBOUT & '21 ELSE LF ;
END ;
ENDC;
IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
END "EXPAND" ;
CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
RASTPHIGH ← 11*VBPI - (TOPMAR+BOTMAR) ; COMMENT *** TEMP *** ;
RASTPWIDE ← (17*HBPI)/2 - (LFTMAR+RGTMAR) ; COMMENT *** TEMP *** ;
RASTLHIGH ← RASTPHIGH/PAGEHIGH ;
IFC SAILVER THENC
IF PAGECT > 1 THEN
IF DEVICE = LPT THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
ELSE OUT(LISTCHAN, ENDPAGE) ;
ENDC
IFC CMUXGP THENC
IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
ENDC
IFC PARCVER THENC
IF MICRO THEN
BEGIN
FSTFONT ← -1 ;
DLBP ← DLBP1 ;
TLIX ← 0 ;
END ;
ENDC
WHILE (TOPLINE ← INNUM) > -10 DO
BEGIN "AREA"
NCOLS ← INNUM ; NLINES ← INNUM ;
FOR COL ← 1 THRU NCOLS DO
BEGIN "COLUMN"
LEFTCH ← INNUM ;
TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
WHILE (LINENO ← INNUM) DO
BEGIN "LINE"
SH ← SHORTM ← INNUM ;
MLEAD ← INNUM ; TES 11/2/74 ;
SG ← FSTBRK ← -1 ;
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
LINE ← TOPLINE - 1 + LINENO ;
IF LINE<1 OR LINE>PAGEHIGH THEN
BEGIN
WARN("Area outside page. If Pass one didn't tell you too, then there is a bug in PUB");
LINE←LINE MAX 1 MIN PAGEHIGH ;
END ;
L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
ELSE BEGIN FROMFILE ← TRUE ;
WHILE L NEQ (M←CVD(INPUT(SCHAN, TO!ALTMODE!SKIP))) DO
BEGIN S ← NULL ;
RKJ: 4-26-74, added EOF stuff on next two lines ;
DO S ← S & INPUT(SCHAN, TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One (a PUB bug), I give up.");
OWLS[M MOD FIML] ← S ;
END ;
END ;
IF NOT DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
ELSE BEGIN
SR ← IF MICRO THEN NULL ELSE SRCREF[LINE] ;
SR ← SR & " " & SCN(TO!RUB!ALT!SKIP) ;
WHILE PAGEBRC NEQ ALTMODE DO
BEGIN "ERROR MESSG"
S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
IF DEVICE=TTY OR (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SR)+M LEQ 119 THEN
SR ← SR & "..." & S ;
END "ERROR MESSG" ;
IF NOT MICRO THEN SRCREF[LINE] ← SR ;
END ;
DO BEGIN "PIECE"
S ← SCN(BREAKER) ; TES 11/6/74 ;
WHILE NOT PAGEEOF AND NOT PAGEBRC DO
S ← S & SCN(BREAKER) ; TES 11/6/74 ;
CHRS ← CHRS + LENGTH(SEG[STEP!SG] ← S) ;
CASE CHARTBL[PAGEBRC] OF
BEGIN comment by BRC ;
comment 0 ... ; IMPOSSIBLE("0"&CVOS(PAGEBRC)&" Break Character") ;
comment 1 ... RUBOUT -- Font change ; BEGIN
SEG[STEP!SG] ← RUBOUT & (F←SCN(ONE!CHAR)) &
(S ← IF F="-" OR F="+" OR F="=" THEN SCN(TO!ALTMODE!SKIP)
ELSE IF F = "F" THEN SCN(ONE!CHAR)
ELSE IF F="π" THEN SCNBYCOUNT(SCNUM) TES 1/11/75 SCNUM ;
ELSE NULL) ;
IF F = "π" THEN CHRS ← CHRS + 1
ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
ELSE IF F = "→" THEN
BEGIN COMMENT ∞ ;
IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN SLIDERROR ;
SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
LBD[SLIDETOP] ← SCNUM ;
DIVISOR[SLIDETOP] ← SCNUM ;
IF RASTER THEN
PLK; XINFSTRL[SLIDETOP]← SCNUM ;
LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
IF RASTER AND FULSTR(LBF[SLIDETOP]) THEN STEP!SG ; RKJ: 1-9-74;
OFSIZE[SLIDETOP]←FSIZE;
END
ELSE IF F = "←" THEN
RIGHTBOUND
ELSE IF F = "=" THEN BEGIN
comment 8/9/73 RKJ IF RASTER THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
END ; COMMENT NOJUST LEFT OF TAB ;
comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[STEP!SG] ← ALTMODE END ;
comment 3 ... VT -- label reference ;
BEGIN "LABEL REF"
STRING S;
S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
L ← LENGTH(SEG[STEP!SG] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
J ← CVD(S) ;
SHORTM ← SHORTM - (IF RASTER THEN J ELSE L) ; CHRS ← CHRS + L ;
FSIZE←FSIZE+(IF RASTER THEN J ELSE L);
END "LABEL REF" ;
comment 4 ... CR -- Justify it ;
BEGIN "JUSTIFY"
WHILE SLIDETOP DO BEGIN SLIDERROR ; RIGHTBOUND END ;
IF SHORTM < 0 THEN SHORTM ← 0 ;
IFC SAILVER THENC IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ ELSE ENDC
BEGIN "DISTRIBUTE SPACES"
COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
END "DISTRIBUTE SPACES" ;
UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN PAGEHIGH ; CHAR ← 0 MAX LEFTCH-1 MAX 0 ;
IFC CMUVER THENC IF XCRIBL THEN CHAR←LASC[LINE]; ENDC RKJ: 7-Nov-74, needed for multi column;
NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
TVR: Initial column select for XGP ;
IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ;
IFC PARCVER THENC IF MICRO THEN OPENLINE(0, -1) ; ENDC
IF XCRIBL THEN LEADING[LINE] ← TES 11/4/74; RKJ: 7-Nov-74;
IF MLEAD = 0 THEN 0
ELSE IF MLEAD > 0 THEN (MLEAD*VBPI + 500) DIV 1000
ELSE -((-MLEAD*VBPI + 500) DIV 1000) ;
IFC SAILVER THENC
IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
ENDC
FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
BEGIN comment three cases ;
comment 0 ... text ;
BEGIN "TEXT SEG"
IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN
RKJ: modified 8-Nov-74;
BEGIN
IFC CMUVER THENC
IF SCRLVL NEQ 0 THEN CMUSCRIPT(SCRLVL,S) ELSE CHAR←APPD(S);
ELSEC
CHAR ← 0 MAX APPD(S);
ENDC
END ELSE
COMMENT *** UNDERLINING *** ;
IF DEVICE = MIC THEN
IFC SAILVER THENC
BEGIN K ← LENGTH(S) ;
WHILE K DO
BEGIN COMMENT DON'T UNDERLINE BLANKS ;
N ← LOP(S) ;
IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
K ← K - 1 ;
END ;
END
ENDC
IFC PARCVER THENC PARCBAR ENDC
ELSE IF XCRIBL THEN
BEGIN
IFC CMUXGP THENC
RKJ: New code for new XGP system at CMU 8-Nov-74 and 6-Feb-75;
CTRL(CMU!UND(BAR));
CHAR←0 MAX APPD(S);
CTRL(CMU!UND(0));
ENDC
IFC ISIVER THENC
K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
START!CODE "XGPUNDER"
DEFINE LEN= [2],SRC= [3],DEST= [4],RUB= [5],ESC= [6],R= [7],CNT= ['10],UBAR= ['11];
LABEL LOOP,ELOOP,SPACE,OUTT;
SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
LOOP: ILDB R,SRC;
CAIE R,BAR; CAIN R,SP; JRST SPACE;
IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
ELOOP: SOJG LEN,LOOP;
MOVEM CNT,N; JRST OUTT;
SPACE: IDPB R,DEST;
AOJA CNT,ELOOP;
OUTT:
END "XGPUNDER";
CHAR ← 0 MAX APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
ENDC
IFC SAILXGP THENC CHAR ← 0 MAX APPD(S); ENDC
IFC PARCVER THENC
K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
START!CODE "XGPUNDER"
DEFINE LEN= [2],SRC= [3],DEST= [4],BS= [5],UBAR= [6],CNT= [7],R= ['10];
LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
SETZ CNT,0;
MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
LOOP: SOJL LEN,OUTT;
ILDB R,SRC;
CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
IDPB UBAR,DEST; IDPB BS,DEST;
NOBAR: IDPB R,DEST;
JUMPA LOOP;
OUTT: MOVEM CNT,N;
END "XGPUNDER";
CHAR ← 0 MAX APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
ENDC
END
ELSE BEGIN CHAR ← 0 MAX APPD(S);
K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR ← 0 MAX CHAR-K ;
IFC NOT CMUXGP THENC RKJ: 1-7-74;
START!CODE "UNDER" LABEL LOOP ;
MOVE 2, K ; MOVE 3, SS ;
LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
END "UNDER" ; CHAR ← 0 MAX APPD(SS[1 TO LENGTH(S)]) ;
ELSEC CHAR ← 0 MAX APPD(S); ENDC RKJ: 1-7-74;
END ;
END "TEXT SEG" ;
comment 1 ... RUBOUT -- Font Change ;
IF (F←S[2 FOR 1])="↑" THEN
IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE ENDC
IFC PARCVER THENC
IF MICRO THEN PARCSUPER ELSE
IF XCRIBL THEN
IF (SCRLVL←SCRLVL+SCRIPT) LEQ 0 THEN CTRL("R"-'100) ELSE
BEGIN LABEL L1;
CTRL("U"-'100);
L1:
IF G<SG THEN
BEGIN
SS←SEG[G+1];
IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
BEGIN
G←G+1;
CTRL(SS[3 FOR 1]);
END ELSE CTRL(THISFONT+"0");
END ELSE CTRL(THISFONT+"0")
END
ELSE ENDC
IFC CMUVER THENC
IF XCRIBL THEN SCRLVL←SCRLVL+SCRIPT ELSE
ENDC RKJ: 22-OCT-74;
IFC SAILXGP THENC
IF XCRIBL THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
ELSE ENDC LINE←LINE-1 MAX 1
ELSE IF F = "↓" THEN
IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE ENDC
IFC PARCVER THENC
IF MICRO THEN PARCSUB ELSE
IF XCRIBL THEN
IF (SCRLVL←SCRLVL-SCRIPT) GEQ 0 THEN CTRL("R"-'100) ELSE
BEGIN LABEL L2;
CTRL("S"-'100);
L2:
IF G<SG THEN
BEGIN
SS←SEG[G+1];
IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
BEGIN
G←G+1;
CTRL(SS[3 FOR 1]);
END ELSE CTRL(THISFONT+"0");
END ELSE CTRL(THISFONT+"0")
END
ELSE ENDC
IFC CMUVER THENC
IF XCRIBL THEN SCRLVL←SCRLVL-SCRIPT ELSE
ENDC RKJ: 22-OCT-74;
IFC SAILXGP THENC
IF XCRIBL THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
ELSE IF F = "_" THEN
BEGIN
UNDERLINE ← CHAR;
IFC SAILVER THENC
IF XCRIBL THEN CTRL(ESCAPE1&'46);
ENDC
IFC ITSVER PJ 8/23/74 ; THENC
IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
ENDC
END
ELSE IF F = "≡" THEN
BEGIN "END UNDERLINED TEXT"
IFC SAILVER THENC
IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
ENDC
UNDERLINE ← -1 ;
IFC SAILVER THENC
IF XCRIBL AND BAR TES 10/22/73; THEN
CTRL(ESCAPE1&'51&2&3); TES AND REG 11/19/73 ; BH 12/3/74;
ENDC
IFC ITSVER THENC PJ 8/23/74 ;
IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
ENDC
END "END UNDERLINED TEXT"
ELSE IF F="-" THEN
BEGIN
F ← CVD(S[3 TO ∞]) ;
IF DEVICE=MIC THEN
IFC SAILVER THENC
CTRL(DOLSPCS(F))
ENDC
IFC PARCVER THENC
PARCLEFT
ENDC
IFC SAILVER THENC comment RHT 4/22/76;
ELSE IF XCRIBL THEN CTRL(VARBSPACE(F))
ENDC
ELSE CHAR←CHAR-F MAX 0
END
ELSE IF F="*" THEN CHAR ← 0 MAX LASC[LINE] comment not always correct! ;
ELSE IF F="+" THEN
BEGIN F ← CVD(S[3 TO ∞]) ;
IFC SAILVER THENC
IF DEVICE=MIC THEN CTRL(DORSPCS(F)) ELSE
ENDC
IFC PARCVER THENC
PARCRIGHT
ENDC
IF XCRIBL THEN CTRL(VARBLANK(F))
ELSE CHAR←CHAR+F MIN IMC
END
ELSE IF F="=" THEN
BEGIN "TAB"
F ← CVD(S[3 TO ∞]) ;
IF NOT RASTER THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
IF XCRIBL THEN XGPTAB(F)
ELSE IF DEVICE NEQ MIC THEN CHAR ← F
IFC SAILVER THENC
ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
ENDC
IFC PARCVER THENC PARCTAB ENDC
END "TAB"
ELSE IF F = "π" THEN
BEGIN TES 11/29/73 REWROTE ; TES 11/4/74 ADDED SPECIAL ;
BOOLEAN SPECIAL ;
IFC CMUXGP THENC
IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
ENDC TES 12/13/73 ;
SPECIAL ← S[3 FOR 1] = 63 ;
SS ← UNMASH(S[(IF SPECIAL THEN 4 ELSE 3) TO ∞]) ;
IFC PARCVER THENC
IF XCRIBL THEN
IF SS="." THEN F←LOP(SS) tes 12/10/74 ;
ELSE SS ← CTLQ & SS ;
IF MICRO THEN PARCPICHAR
ELSE
ENDC
BEGIN
IFC CMUVER THENC
IF XCRIBL AND SCRLVL THEN
IF SCRLVL>0 THEN CTRL(CMU!SUP(SCRLVL,0)) ELSE CTRL(CMU!SUB(SCRLVL,0));
ENDC RKJ: 6-Feb-75 ;
F ← LENGTH(SS)-1 ; CHAR ← 0 MAX APPD(SS)-F ;
LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
IF UNDERLINE GEQ 0 AND BAR AND DEVICE NEQ MIC
IFC SAILXGP THENC AND NOT XCRIBL ENDC
THEN CTRL(IFC PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
END ;
END
ELSE IF F = "←" THEN BEGIN END
ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
BEGIN "OVERSTRIKE"
IFC CMUXGP THENC
INTEGER Q;
Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
LASC[L]←LASC[L]-1; CHAR ← 0 MAX CHAR-1;
CTRL(RUBOUT&'35); CHAR ← 0 MAX APPD(Q);
ENDC
IFC SAILXGP THENC WARN("Overstrike unimplemented") ENDC
IFC PARCVER THENC
PARCOVLY
ENDC
END
ELSE IF F="S" THEN SNUCK[LINE]←TRUE RKJ: 6-FEB-75 ;
ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
BEGIN
CHAR ← 0 MAX APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
END
ELSE IMPOSSIBLE("0"&CVOS(F)&" Control Character") ;
comment 2 ... ALTMODE -- word break ;
IF SHORTM AND G > FSTBRK THEN
IFC SAILVER THENC IF DEVICE = MIC THEN CHANGESPACING ELSE ENDC
BEGIN "SPREAD"
TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
IF RASTER THEN
BEGIN "DOVSB"
F ← ((TERMX-TERM) MIN SHORTM) ;
IFC PARCVER THENC IF MICRO THEN PARCJUST ELSE ENDC
CTRL(VARBLANK(F)) ;
SHORTM← SHORTM-F
END "DOVSB"
ELSE CHAR ← 0 MAX CHAR + TERMX - TERM MIN IMC ;
TERM ← TERMX ;
END "SPREAD"
ELSE IF RASTER THEN
BEGIN
CHAR ← 0 MAX APPD(SP);
END;
comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
END ; COMMENT three cases ;
IFC SAILVER THENC IF CHORIZ NEQ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ; ENDC
IFC SAILXGP THENC
IF XCRIBL AND UNDERLINE GEQ 0 THEN
CTRL(ESCAPE1&'47&BASELINE);
ENDC
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
IFC PARCVER THENC PARCLOSE ENDC
END "JUSTIFY" ;
comment 5 ... LF ; BEGIN END ;
END ; comment, by BRC ;
END "PIECE"
UNTIL PAGEBRC = LF ;
END "LINE" ;
END "COLUMN" ;
END "AREA" ;
IFC PARCVER THENC PARCPAGE ENDC
BEGIN "FINPAGE"
FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
F ← 120 - (IMC MAX 78) ;
FOR N ← 1 THRU LASL DO
BEGIN "LIST LINE"
L ← N ;
IF DEBUG AND LENGTH(S←SRCREF[L])>F AND DEVICE=LPT THEN
S←S[1 TO F] ;
NEEDCR ← FALSE ;
DO BEGIN "PART LINE"
IF CHAR ← LASC[L] THEN
BEGIN "NONBLANK"
IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE)
ELSE NEEDCR ← TRUE ; TES 11/1/73;
OUT(LISTCHAN, FIXUP(IMG[L][1 TO CHAR+FAKE[L]])) ;
IFC CMUVER THENC RKJ: 26-SEP-74 - KLUDGE;
IF XCRIBL AND FIRST!OUTPUT THEN
BEGIN
FIRST!OUTPUT←FALSE;
DUMMY←CHNCDB(LISTCHAN);
START!CODE
MOVE 1,DUMMY; HLRZ 1,2(1); MOVE 2,1(1);
MOVEI 3,1; MOVEM 3,1(2);
END;
END;
ENDC
IF DEBUG AND L=N AND FULSTR(S) THEN OUT(LISTCHAN,
(IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1)
ELSE SPS((IMC MAX 80)-CHAR)) RKJ: 1-4-74;
& S);
END "NONBLANK" ;
CHAR ← 0 MAX L ; L ← LINK[CHAR] ;
LINK[CHAR] ← LASC[CHAR] ← FAKE[CHAR] ← 0 ;
END "PART LINE" UNTIL L=0 ;
RKJ: 6-FEB-75 JUGGLED FOLLOWING CODE FOR SNUCK ;
IF NOT SNUCK[N] THEN
BEGIN "NOT SNUCK"
OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
L ← N ; DO L←L+1 UNTIL NOT SNUCK[L] ; COMMENT FIND NEXT REAL LINE ;
IF NEEDVERTI AND
((L ← LEADING[L]+RASTVERTI) IFC SAILXGP THENC NEQ ELSEC > ENDC INTRA) THEN
IFC PARCVER THENC
BEGIN
OUT(LISTCHAN, ENDLINE) ;
OUT(LISTCHAN, CTLK&CVS(L-INTRA)&".") ;
END
ENDC
IFC CMUVER THENC OUT(LISTCHAN, ENDLINE & CMU!ISL(L-INTRA)) ENDC
IFC ISIVER THENC OUT(LISTCHAN, ENDLINE) ENDC comment *** ;
IFC SAILXGP THENC OUT(LISTCHAN, ESCAPE1&'42&L) ENDC BH 11/19/74 *** ;
COMMENT changed "(L+1)" to "L" DRB 2/26/76 ***;
ELSE
OUT(LISTCHAN, ENDLINE) ;
END "NOT SNUCK";
SNUCK[N] ← FALSE ; RKJ: 6-FEB-75 ;
LEADING[N] ← 0 ; TES 11/4/74 ;
IF DEBUG THEN SRCREF[N] ← NULL ;
END "LIST LINE" ;
FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;
IFC ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
IFC PARCVER THENC
OUT(LISTCHAN, ENDPAGE) ;
ENDC
END "FINPAGE" ;
END "PAGE" ;
IF NOT (PAGEEOF OR PAGEHIGH LEQ 0) THEN DONE ; comment expand IMG ;
RELEASE(ICHAN) ; RELEASE(SCHAN) ;
END "FILE" ;
END "SIZE" UNTIL SEQEOF ;
IFC PARCVER THENC PARCDOC ENDC
IFC SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
END "INNER BLOCK" ;
BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;
OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
IF DELINT="A" OR DELINT="a" THEN
BEGIN
OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
DELINT ← INCHWL ;
END ;
IF DELINT="Y" OR DELINT="y" THEN
BEGIN "DELETE INTERMEDIATE FILES"
IFC TENEX THENC
SIMPLE PROCEDURE DELVER(STRING FINAME) ;
BEGIN INTEGER CHN ;
CHN ← OPENFILE(FINAME&";*", "RO*") ;
DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
RELEASE(CHN) ;
END ;
DELVER(JOBNO & ".PASS2") ;
ENDC
SEQCHAN ← READIN(
IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
FALSE, SEQBRC, SEQEOF) ;
DO INPUT(SEQCHAN, TO!LF!APPD) UNTIL SEQBRC=LF;
IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
RENAME(LABCHAN, NULL, 0, I) ;
RELEASE(LABCHAN);
ENDC
AWHILE DO
BEGIN
PAGEFILE ← SPARAM ;
IF SEQEOF THEN DONE ;
IFC TENEX THENC
DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
ELSEC
IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
RELEASE(ICHAN); RELEASE(SCHAN);
ENDC
END ;
IFC NOT TENEX THENC RENAME(SEQCHAN, NULL, 0, I) ENDC ;
RELEASE(SEQCHAN) ;
IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ENDC
END "DELETE INTERMEDIATE FILES"
ELSE IF DELINT NEQ "N" AND DELINT NEQ "n" THEN
OUTSTR(CRLF&DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;
IFC SAILVER THENC
IF DEVICE = MIC THEN
BEGIN "PASS 3"
INTEGER FCHAN ;
INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START!CODE MOVE 1, A ; END ;
INTEGER ARRAY PASSTHREE[0:4] ;
FCHAN ← WRITEON("$PUB$"&RPGEXT) ;
OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
RELEASE(FCHAN) ;
PASSTHREE[0] ← CVSIX("DSK") ;
PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
CALL(CORELOC(PASSTHREE), "SWAP") ;
END "PASS 3" ;
IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
ENDC
IFC CMUVER THENC
RKJ: 26-SEP-74 ALL NEW CODE;
IF XCRIBL AND DOPASS3 THEN
BEGIN "PASS 3"
WTMPFILE("PB3",LISTFILE&CR&LF,TRUE);
RUNPROG("DSK:PUB3[A700PU00]",1);
START!CODE CALLI 0,'12 END;
END "PASS 3";
RKJ: NOW CHECK FOR MORE COMMANDS IN THE TMP FILE;
IF RTMPFILE("PUB",S,FALSE,TRUE) THEN
BEGIN "RERUN"
RUNPROG("PUB",1);
START!CODE CALLI 0,'12 END;
END "RERUN";
ENDC
IFC ISIVER THENC
TES 8-OCT-74 APPROXIMATION TO WHAT ISI NEEDS;
IF XCRIBL AND DOPASS3 THEN
BEGIN "PASS 3"
INTEGER J, JOBNO ;
JOBNO ← CVS(GJINF(J, I, J)) ;
J ← OPENFILE(JOBNO & ".PASS3", "WT") ;
OUT(J, LISTFILE & CRLF) ;
RELEASE(J) ;
RUNPRG("<SUBSYS>PUB3.SAV", 1, 0) ;
CALL(0,"EXIT") ;
END "PASS 3" ;
ENDC
IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT"); ELSEC
START!CODE IFC NOT ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
ENDC
MAKEBE(WCW, CW) ;
END "VARIABLE BOUND ARRAY BLOCK" ;
END "PUB2" ;