perm filename PUB2.SAI[2,TES]5 blob
sn#072555 filedate 1973-11-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "PUB2"
C00010 00003 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
C00014 00004 COMMENT I N I T I A L I Z E
C00019 00005 BEGIN "INNER BLOCK"
C00023 00006 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR)
C00026 00007 SIMPLE PROCEDURE RIGHTBOUND
C00029 00008 IF PAGEHIGH THEN GO TO CONTINUE comment, re-entered
C00032 00009 WHILE (TOPLINE ← INNUM) > -10 DO
C00034 00010 CASE CHARTBL[PAGEBRC] OF
C00037 00011 comment 4 ... CR -- Justify it
C00041 00012 ELSE BEGIN CHAR ← APPD(S)
C00047 00013 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
C00050 00014 comment 5 ... LF BEGIN END
C00052 00015 BEGIN EXTERNAL SIMPLE PROCEDURE K_OUT K_OUT END COMMENT ** ** ** ** **
C00056 ENDMK
C⊗;
BEGIN "PUB2"
REQUIRE "VERSION.SAI" SOURCE_FILE;
REQUIRE 6500 STRING_SPACE ;
COMMENT The Document Compiler -- Pass Two ;
COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
Height Width
For each area:
UpperLine NumCols NumLines
For each column:
LeftChar
For each non-null line: LineNo SHORTM Index of PUInS.PUI 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.
;
DEFINE THRU = "STEP 1 UNTIL", DOWN = "STEP -1 UNTIL",
TES = "COMMENT", RKJ = "COMMENT", TVR = "COMMENT",
ie = "COMMENT", AWHILE = "WHILE TRUE",
INP(BRKTBL) = "INPUT(SCHAN, BRKTBL)", 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 VERSION=SAILVER THENC "'175" ELSEC "'176" ENDC,
TO_ALTMODE_SKIP = "1", TO_LF_APPD = "2",
ONE_CHAR = "3", BREAKER = "4", TO_RUB_ALT_SKIP = "5",
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)";
DEFINE ESCAPE1="('177&'1)", ESCAPE2="('177&'2)";
DEFINE CTLF="6", CTLE="5", CTLT="'24";
INTEGER IML, IMC, comment, no. of lines and chars per page image ;
DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
LFTMAR, comment Stanford XGP left margin (for tabs) ;
TES LFTMAR used at PARC too but always 0 now;
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 ;
CHARW, LINENO, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
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 ;
BASELINE ; comment useful? for underscore at stanford ;
INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
EXTERNAL INTEGER RPGSW ;
IFC VERSION=PARCVER THENC
SIMPLE PROCEDURE FOOBAZ;
START!CODE "FOOBAZ"
LABEL EVEC,GO,STRT,REEN;
EVEC: JRST STRT;
JRST REEN;
HRRZ 1,'120;
JRST 1(1);
STRT: HRRZ 1,'120;
JRST (1);
REEN: HRRZ 1,'124;
JRST (1);
GO: MOVEI 1,'400000;
MOVEI 2,EVEC;
HRLI 2,3;
'104000000204;
'104000000170;
END "FOOBAZ";
ENDC
STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
REAL RATIO ;
INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
STRING ARRAY LBF[1:5] ;
INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
BEGIN "READIN"
INTEGER CH ;
CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
LOOKUP(CH, FILENAME & JOBNO, 0) ; RETURN(CH) ;
END "READIN" ;
INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
BEGIN "WRITEON"
INTEGER CH ;
CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
ENTER(CH, FILENAME, 0) ; RETURN(CH) ;
END "WRITEON" ;
SIMPLE PROCEDURE WARN(STRING MESSG) ; OUTSTR(MESSG&CR&LF) ;
SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ; WARN("Impossible case index for "&HOW) ;
STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
RETURN('177 & OP & (IF OP≤'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)) ;
RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
BEGIN "VARBLANK"
IFC VERSION=CMUVER THENC
IF N ≤ 0 THEN RETURN(NULL) ELSE
IF N ≥ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
RETURN(VSB&N)
ELSEC IFC VERSION=SAILVER THENC
IF N ≤ 0 THEN RETURN(NULL) ELSE
IF N ≥ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
RETURN(ESCAPE2&N)
ELSEC IFC VERSION=PARCVER THENC
RETURN(CTLE&CVS(N)&".")
ENDC ENDC ENDC;
END "VARBLANK";
PRELOAD_WITH "", " ", " ", " ", " ", " ", " ",
" ", " ", " ", " " ;
SAFE STRING ARRAY SPSARR[0:10] ;
INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ; IF N≤10 THEN RETURN(SPSARR[N MAX 0])
ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
ELSE BEGIN
STRING S ; INTEGER I ;
S ← SPSARR[10] ;
FOR I ← 11 THRU N DO S ← S & SP ;
RETURN(S) ;
END ;
COMMENT I N I T I A L I Z E ;
IFC VERSION=PARCVER THENC
DUMMY←CVSIX("PUB2 ");
START!CODE
MOVE 1,DUMMY;
'104000000210;
END;
ENDC
SCRIPT ← 10;
IFC TENEX THENC JOBNO ← GJINF(DUMMY, DUMMY, DUMMY) ; ENDC TES 10/25/73 ;
OUTSTR("PASS TWO: ") ;
IFC VERSION=PARCVER THENC IML←65; IMC←72; ENDC
IFC VERSION=SAILVER THENC IML←53; IMC←69; ENDC
IFC VERSION=CMUVER 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") ;
SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
TMPFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
LISTFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
DEBUG ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
DEVICE ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
DELINT ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
BAR ← INPUT(SEQCHAN, TO_ALTMODE_SKIP)[1 FOR 1] ;
IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
CHARW ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP));
IFC VERSION=SAILVER THENC LFTMAR←CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP));
BASELINE←CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)); BASELINE←BASELINE+(BASELINE DIV 4); ENDC
IF ¬RPGSW AND DEVICE ≠ XGP THEN COMMENT STARTED BY ".R PUB2" ;
DO BEGIN
OUTSTR("OUTPUT DEVICE (LPT, TTY or MIC): ") ;
S ← INCHWL ;
DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE
IF ANS(M) THEN MIC ELSE IF ANS(X) THEN XGP ELSE 0;
END
UNTIL DEVICE ;
IF ¬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 ;
OUTSTR(LISTFILE & " ") ;
ENDLINE ← LF ; ENDPAGE ← FF ;
RESTARTLINE ←
IFC PARCVER THENC IF DEVICE=XGP THEN CTLT&"0." ELSE CR
ELSEC CR ENDC ; TES 11/1/73 ;
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 WARN("Won't put Debug info on Microfilm") ;
DEBUG ← FALSE ; END END ;
COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
END "DEV" ;
J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
LABCHAN ← READIN("PULABL.PUI", 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 ;
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 DEVICE = XGP THEN
(ALTMODE & INPUT(LABCHAN, TO_ALTMODE_SKIP))
ELSE NULL);
END "LABEL" ;
RELEASE(LABCHAN);
COMMENT G O ! ;
DO comment, This loop is re-entered only if page image grows ;
BEGIN "SIZE"
SAFE STRING ARRAY IMG[1:IML+IML], SEG[0:IMC+IMC], SRCREF[1:IML] ;
SAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML] ;
LABEL CONTINUE ;
INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
BEGIN "APPD"
INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
L ← LINE ; EXTRA ← LENGTH(S) ;
IFC VERSION NEQ CMUVER THENC
IF DEVICE=XGP 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
ENDC
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 1 PAGE: " & S)
ELSE L ← AVAIL ;
T ← IMG[L] ; SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[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" ;
SIMPLE PROCEDURE CTRL(STRING S) ;
BEGIN "CTRL"
CHAR ← APPD(S) - LENGTH(S) ;
LASC[L] ← CHAR ;
FAKE[L] ← FAKE[L] + LENGTH(S) ;
END "CTRL" ;
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 ∧ (K←(J←N*CHORIZ+SHORTM)/N MIN 511)≠CHORIZ THEN
BEGIN "CHANGESPACING"
IF UNDERLINE≥0 THEN UNDERSCORE(CHAR) ;
SHORTM ← J - K*N ;
IF NOTFST ∧ (UNDERLINE<0 ∨ SHORTM<0) THEN
BEGIN DORDOTS(SHORTM) ; SHORTM ← 0 END ;
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);
IFC VERSION=CMUVER THENC
IF WHICH=10 THEN CTRL(USEA) ELSE
IF WHICH=11 THEN CTRL(USEB) ELSE
WARN("Font ignored")
ELSEC IFC VERSION=SAILVER THENC
IF WHICH>16 THEN WARN("Font ignored") ELSE
BEGIN
CTRL(ESCAPE1&(WHICH-1));
IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
END;
ELSEC IFC VERSION=PARCVER THENC
IF WHICH>9 THEN WARN("Font ignored") ELSE
CTRL(6&(THISFONT←WHICH+"0"))
ENDC ENDC ENDC;
END "FONTSELECT";
SIMPLE PROCEDURE XGPTAB(INTEGER N);
BEGIN "XGPTAB"
IFC VERSION NEQ CMUVER THENC
N ← N + TLFTMAR ; TVR: used to be LFTMAR; ENDC
IFC VERSION=CMUVER THENC CTRL(XTAB&XGPNUM(N)) ENDC
IFC VERSION=SAILVER THENC
CTRL(ESCAPE1&'40&XGPNUM(N))
ENDC
IFC VERSION=PARCVER THEN
CTRL(CTLT&CVS(N)&".")
ENDC;
END "XGPTAB";
SIMPLE PROCEDURE RIGHTBOUND ;
BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
INTEGER DEST, FILLIN, I ; STRING FILLER, OLBF ;
INTEGER XF;
IF SLIDETOP < 1 THEN BEGIN IMPOSSIBLE("SLIDETOP1") ; SLIDETOP ← 1 END ;
IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
BEGIN
IF DEVICE = XGP THEN XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
FILLIN←RB[SLIDETOP]-CHRS;
END
ELSE COMMENT CENTER ;
BEGIN
IF DEVICE = XGP THEN
XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
FILLIN ← (((RB[SLIDETOP]-CHRS) - LBD[SLIDETOP]) DIV 2) MAX 0;
END;
DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
IF FULSTR(OLBF) THEN
IF DEVICE=XGP THEN
BEGIN "XGPINFINITY"
FILLER ← NULL ;
FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
SEG[I + 1] ← RUBOUT & "=" & CVS(XF) ;
END "XGPINFINITY"
ELSE
BEGIN "NON-BLANKS"
FILLER ← NULL ;
WHILE CHRS < DEST DO
BEGIN
FILLER ← FILLER & OLBF ;
CHRS ← CHRS + LENGTH(OLBF) ;
END ;
IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
SEG[SLIDESG[SLIDETOP]] ← FILLER ;
END "NON-BLANKS"
ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
(IF DEVICE = XGP THEN ("="&CVS(XF))
ELSE ("+"&CVS(FILLIN)) );
CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
FLUSHING ← FALSE ; FSIZE ← 0 ;
END "RIGHTBOUND";
IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
AWHILE DO
BEGIN "FILE"
PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ; IF SEQEOF THEN DONE ;
IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
AWHILE DO
BEGIN "PAGE"
PAGEHIGH ← INNUM ; IF PAGEEOF ∨ PAGEHIGH≤0 THEN DONE ; PAGEWIDE ← INNUM ;
IF PAGEHIGH > IML ∨ PAGEWIDE > IMC THEN
BEGIN "EXPAND"
IF DEVICE=MIC THEN
BEGIN "FRAME SIZE"
IF LASL ≠ 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"
IFC VERSION=SAILVER THENC
ELSE IF DEVICE = LPT THEN
BEGIN
IF (LASL-1) MOD 66 + 1 ≤ 6 ∧ (PAGEHIGH-1) MOD 66 < 60 THEN
OUT(LISTCHAN, ENDPAGE) ;
ENDLINE ← IF PAGEHIGH≥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(CVS(PAGECT ← PAGECT + 1) & SP) ; AVAIL ← IML ;
IFC VERSION=SAILVER THENC
IF DEVICE = LPT AND PAGECT ≠ 1 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 ;
ENDC
WHILE (TOPLINE ← INNUM) > -10 DO
BEGIN "AREA"
NCOLS ← INNUM ; NLINES ← INNUM ;
FOR COL ← 1 THRU NCOLS DO
BEGIN "COLUMN"
LEFTCH ← INNUM ;
IFC VERSION NEQ CMUVER THENC
TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ;
ENDC TVR: Initiallize left margin for this column ;
WHILE (LINENO ← INNUM) DO
BEGIN "LINE"
SH ← SHORTM ← INNUM ; SG ← FSTBRK ← -1 ; BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
LINE ← TOPLINE - 1 + LINENO ;
IF LINE<1∨LINE>IML THEN BEGIN WARN("Area outside page"); LINE←LINE MAX 1 MIN IML 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 ≠ (M←CVD(INP(TO_ALTMODE_SKIP))) DO
BEGIN S ← NULL ;
DO S ← S & INP(TO_LF_APPD) UNTIL PAGEBRC = LF ;
OWLS[M MOD FIML] ← S ;
END ;
END ;
IF ¬DEBUG THEN S ← SCN(TO_ALTMODE_SKIP)
ELSE BEGIN
SRCREF[LINE] ← SRCREF[LINE] & " " & SCN(TO_RUB_ALT_SKIP) ;
WHILE PAGEBRC ≠ ALTMODE DO
BEGIN "ERROR MESSG"
S ← SCN(TO_RUB_ALT_SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
IF DEVICE=TTY ∨ (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SRCREF[L])+M ≤ 119 THEN
SRCREF[L] ← SRCREF[L] & "..." & S ;
END "ERROR MESSG" ;
END ;
DO BEGIN "PIECE"
CHRS ← CHRS + LENGTH(SEG[SG ← SG + 1] ← SCN(BREAKER)) ;
CASE CHARTBL[PAGEBRC] OF
BEGIN comment by BRC ;
comment 0 ... ; IMPOSSIBLE("BREAKER") ;
comment 1 ... RUBOUT -- Font change ; BEGIN
SEG[SG←SG+1] ← RUBOUT & (F←SCN(ONE_CHAR)) &
(S ← IF F="-" ∨ F="+" ∨ F="=" THEN SCN(TO_ALTMODE_SKIP)
ELSE IF F = "π" OR F = "F" THEN SCN(ONE_CHAR) 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 IMPOSSIBLE("SLIDETOP") ;
SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
LBD[SLIDETOP] ← SCNUM ;
IF DEVICE = XGP THEN
BEGIN
RKJ; XFILL[SLIDETOP] ← SCNUM ;
TES ; XINF[SLIDETOP] ← SCNUM ;
END ;
LBF[SLIDETOP] ← SCN(TO_ALTMODE_SKIP) ;
FLUSHING ← TRUE;
END
ELSE IF F = "←" THEN
RIGHTBOUND
ELSE IF F = "=" THEN BEGIN
comment 8/9/73 RKJ IF DEVICE=XGP 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[SG←SG+1] ← ALTMODE END ;
comment 3 ... VT -- label reference ;
BEGIN "LABEL REF"
STRING S;
S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
L ← LENGTH(SEG[SG←SG+1] ← SCAN(S, TO_ALTMODE_SKIP, DUMMY)) ;
J ← CVD(S) ;
SHORTM ← SHORTM - (IF DEVICE=XGP THEN J ELSE L) ; CHRS ← CHRS + L ;
IF FLUSHING AND DEVICE=XGP THEN FSIZE←FSIZE+J ;
END "LABEL REF" ;
comment 4 ... CR -- Justify it ;
BEGIN "JUSTIFY"
WHILE SLIDETOP DO BEGIN IMPOSSIBLE("SLIDE TOP") ; RIGHTBOUND END ;
IF SHORTM < 0 THEN SHORTM ← 0 ;
IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ
ELSE BEGIN "DISTRIBUTE SPACES"
COMMENT β(α,K) = [α(K+1)] - [αK],
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 IML ; CHAR←LEFTCH-1 MAX 0 ;
NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
TVR: Initial column select for XGP ;
IFC VERSION NEQ CMUVER THENC IF DEVICE=XGP AND LEFTCH NEQ 1 THEN XGPTAB(0) ELSE ENDC
IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
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 CHAR←APPD(S) ELSE
IF DEVICE = MIC THEN
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
ELSE IF DEVICE = XGP THEN
BEGIN
IFC VERSION=CMUVER 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←APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
ENDC
IFC VERSION=SAILVER THENC CHAR←APPD(S); ENDC
IFC VERSION=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;
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;
IDPB R,DEST;
CAIE R,BAR; CAIN R,SP; AOJA CNT,LOOP;
IDPB BS,DEST; IDPB UBAR,DEST;
JUMPA LOOP;
OUTT: MOVEM CNT,N;
END "XGPUNDER";
CHAR←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 ← APPD(S);
K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR←CHAR-K ;
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 ← APPD(SS[1 TO LENGTH(S)]) ;
END ;
END "TEXT SEG" ;
comment 1 ... RUBOUT -- Font Change ;
IF (F←S[2 FOR 1])="↑" THEN
IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE
IFC VERSION=PARCVER THENC
IF DEVICE=XGP THEN
IF (SCRLVL←SCRLVL+SCRIPT)≤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);
END ELSE CTRL(THISFONT)
END
ELSE ENDC
IFC VERSION=SAILVER THENC
IF DEVICE=XGP THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
ELSE ENDC LINE←LINE-1 MAX 1
ELSE IF F = "↓" THEN
IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE
IFC VERSION=PARCVER THENC
IF DEVICE=XGP THEN
IF (SCRLVL←SCRLVL-SCRIPT)≥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);
END ELSE CTRL(THISFONT)
END
ELSE ENDC
IFC VERSION=SAILVER THENC
IF DEVICE=XGP THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
ELSE IF F = "_" THEN
BEGIN
UNDERLINE ← CHAR;
IFC VERSION=SAILVER THENC
IF DEVICE=XGP THEN CTRL(ESCAPE1&'46);
ENDC
END
ELSE IF F = "≡" THEN
BEGIN "END UNDERLINED TEXT"
IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
UNDERLINE ← -1 ;
IFC VERSION=SAILVER THENC
IF DEVICE=XGP AND BAR TES 10/22/73; THEN CTRL(ESCAPE1&'47&BASELINE);
ENDC
END "END UNDERLINED TEXT"
ELSE IF F="-" THEN
IF DEVICE=MIC THEN CTRL(DOLSPCS(CVD(S[3 TO ∞])))
ELSE CHAR←CHAR-CVD(S[3 TO ∞]) MAX 0
ELSE IF F="*" THEN CHAR ← LASC[LINE] comment not always correct! ;
ELSE IF F="+" THEN
IF DEVICE=MIC THEN CTRL(DORSPCS(CVD(S[3 TO ∞])))
ELSE IF DEVICE=XGP THEN CTRL(VARBLANK(CVD(S[3 TO ∞])))
ELSE CHAR←CHAR+CVD(S[3 TO ∞]) MIN IMC
ELSE IF F="=" THEN
BEGIN "TAB"
F ← CVD(S[3 TO ∞]) ;
IF DEVICE ≠ XGP THEN F ← F + LEFTCH - 1 MIN IMC MAX 1 ;
IF DEVICE = XGP THEN XGPTAB(F)
ELSE IF DEVICE ≠ MIC THEN CHAR ← F
ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
END "TAB"
ELSE IF F = "π" THEN
BEGIN F←S[∞ FOR 1] ;
IF DEVICE = TTY THEN CHAR ← APPD(F)
ELSE BEGIN
IFC VERSION=CMUVER THENC
DEFINE S1="'34",
K1="(IF DEVICE=XGP THEN 2 ELSE 1)",
K2="(IF DEVICE=XGP THEN 1 ELSE 2)";
ELSEC DEFINE S1="NULL",K1="1",K2="1";
ENDC
CHAR←APPD(RUBOUT&S1&(
IF F="." THEN '0 ELSE IF F="G" THEN '11 ELSE IF F="∂" THEN '12 ELSE IF F
="~" THEN '13 ELSE IF F="-" THEN '14 ELSE IF F="+" THEN '15 ELSE 0))-K1 ;
LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + K2 ; END ;
IF UNDERLINE≥0 ∧ DEVICE≠MIC THEN BEGIN CHAR←CHAR-1; CHAR←APPD(BAR) 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 VERSION=CMUVER THENC
INTEGER Q;
Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
LASC[L]←LASC[L]-1; CHAR←CHAR-1;
CTRL(RUBOUT&'35); CHAR←APPD(Q);
ENDC
IFC VERSION=SAILVER THENC IMPOSSIBLE("Overstrike") ENDC
IFC VERSION=PARCVER THENC
CTRL('10)
ENDC
END
ELSE IF F=RUBOUT THEN IF DEVICE≠XGP THEN CHAR←APPD(SP) ELSE
BEGIN
CHAR←APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
END
ELSE IMPOSSIBLE("FONT `"&F&"'") ;
comment 2 ... ALTMODE -- word break ;
IF SHORTM ∧ G > FSTBRK THEN
IF DEVICE ≠ MIC THEN
BEGIN "SPREAD"
TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
IF DEVICE = XGP THEN
BEGIN "DOVSB"
CTRL(VARBLANK((TERMX-TERM) MIN SHORTM));
SHORTM←(SHORTM-TERMX+TERM) MAX 0;
END "DOVSB"
ELSE CHAR ← CHAR + TERMX - TERM MIN IMC ;
TERM ← TERMX ;
END "SPREAD"
ELSE CHANGESPACING
ELSE IF SHORTM AND DEVICE=XGP THEN
BEGIN
CHAR←APPD(SP);
END;
comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
END ; COMMENT three cases ;
IF CHORIZ ≠ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ;
IFC VERSION=SAILVER THENC
IF DEVICE=XGP AND UNDERLINE≥0 THEN
CTRL(ESCAPE1&'47&BASELINE);
ENDC
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
END "JUSTIFY" ;
comment 5 ... LF ; BEGIN END ;
END ; comment, by BRC ;
END "PIECE"
UNTIL PAGEBRC = LF ;
END "LINE" ;
END "COLUMN" ;
END "AREA" ;
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 ∧ LENGTH(S←SRCREF[L])>F ∧ DEVICE=LPT THEN S←S[1 TO F] ;
NEEDCR ← FALSE ; TES 11/1/73 ;
DO BEGIN "PART LINE"
IF M ← LASC[L] THEN
BEGIN "NONBLANK"
IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE) ELSE NEEDCR ← TRUE ; TES 11/1/73;
OUT(LISTCHAN, IMG[L][1 TO M+FAKE[L]]) ;
IF DEBUG ∧ L=N THEN OUT(LISTCHAN, SPS((IMC MAX 80)-M) & S);
END "NONBLANK" ;
M ← L ; L ← LINK[M] ; LINK[M] ← LASC[M] ← FAKE[M] ← 0 ;
END "PART LINE" UNTIL L=0 ;
TES 11/1/73 CHANGED ; OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
OUT(LISTCHAN, ENDLINE) ;
IF DEBUG THEN SRCREF[N] ← NULL ;
END "LIST LINE" ;
IFC VERSION=SAILVER THENC IF DEVICE ≠ LPT THEN ENDC OUT(LISTCHAN, ENDPAGE) ;
END "PAGE" ;
IF ¬(PAGEEOF ∨ PAGEHIGH≤0) THEN DONE ; comment expand IMG ;
RELEASE(ICHAN) ; RELEASE(SCHAN) ;
END "FILE" ;
END "SIZE" UNTIL SEQEOF ;
IFC VERSION=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" ∨ DELINT="a" THEN
BEGIN
OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
DELINT ← INCHWL ;
END ;
IF DELINT="Y" ∨ DELINT="y" THEN
BEGIN "DELETE INTERMEDIATE FILES"
SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
DO INPUT(SEQCHAN, TO_LF_APPD) UNTIL SEQBRC=LF;
LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
RENAME(LABCHAN, NULL, 0, I) ; COMMENT DELETE ;
RELEASE(LABCHAN);
AWHILE DO
BEGIN
PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
IF SEQEOF THEN DONE ;
IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
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);
END ;
RENAME(SEQCHAN, NULL, 0, I) ; RELEASE(SEQCHAN) ;
END "DELETE INTERMEDIATE FILES"
ELSE IF DELINT≠"N" ∧ DELINT≠"n" THEN WARN(DELINT&"? -- .PUI FILES WERE NOT DELETED") ;
IFC VERSION=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$.RPG") ;
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 DEVICE=XGP THEN LODED("XSPOOL @QQXGP.RPG"&CRLF);
ENDC
IFC VERSION=CMUVER THENC
IF DEVICE = XGP THEN
BEGIN "RUN DOXAP"
INTEGER ARRAY RUNBLK[0:5];
INTEGER C,D;
INTEGER PROCEDURE PJOB;
START!CODE CALLI 1, '30; END;
SETFORMAT(-3,0);
C←WRITEON(CVS(PJOB)&"PB3.TMP");
OUT(C,LISTFILE&CR&LF);
RELEASE(C);
RUNBLK[0]←CVSIX("DSK");
RUNBLK[1]←CVFIL("PUB3[A700PU00]",RUNBLK[2],RUNBLK[4]);
RUNBLK[3]←RUNBLK[5]←0;
START!CODE
MOVE 1, RUNBLK;
HRLI 1, 1;
CALLI 1, '35;
JRST 4, ;
END;
END "RUN DOXAP";
ENDC
START_CODE CALLI 1,'12; CALLI 0,'12; END;
END "PUB2" ;