Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/rtran.sai
There is 1 other file named rtran.sai in the archive. Click here to see a list.
COMMENT VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 HISTORY
C00004 00003 Declarations, Trivial Procedures
C00009 00004 Initialization, Getword, Hash, Reserved, Nxtsym, Gensym, Ison
C00019 00005 Printreserved, Assigned
C00021 00006 Macros, Cond
C00024 00007 Functions
C00030 00008 Defin, Main Loop
C00037 ENDMK
C;
COMMENT HISTORY
SAIL
004 401200000042 ;
COMMENT
VERSION 10-4(34) 12-9-73
VERSION 10-4(33) 12-2-73
VERSION 10-4(32) 7-27-73
VERSION 10-4(31) 3-18-73
VERSION 10-4(30) 10-29-72
VERSION 10-4(29) 10-29-72
VERSION 10-4(28) 10-29-72
VERSION 10-4(27) 10-29-72
VERSION 10-4(26) 10-29-72
VERSION 10-4(25) 10-29-72
VERSION 10-4(24) 10-29-72
VERSION 10-4(23) 10-29-72
VERSION 10-4(22) 10-29-72
VERSION 10-4(21) 10-29-72
VERSION 10-4(20) 10-29-72
VERSION 10-4(19) 10-29-72
VERSION 10-4(18) 10-29-72
VERSION 10-4(17) 10-29-72
VERSION 10-4(16) 10-29-72
VERSION 10-4(15) 10-29-72
VERSION 10-4(14) 10-29-72
VERSION 10-4(13) 10-29-72
VERSION 10-4(12) 10-29-72
VERSION 10-4(11) 10-29-72 BY DCS ADD BUILT-IN MACRO CAPABILITY
VERSION 10-4(10) 10-29-72
VERSION 10-4(9) 3-2-72
VERSION 10-4(8) 3-2-72
VERSION 10-4(7) 3-2-72
VERSION 10-4(6) 3-2-72
VERSION 10-4(5) 3-1-72
VERSION 10-4(4) 3-1-72
VERSION 10-4(3) 3-1-72
VERSION 10-4(2) 2-6-72 BY DCS CONVERT TO SLS-COMPATIBLE, CMDSCNSCNCMD
VERSION 10(1) 1-14-72 BY DCS REPLACE CMDSCN BY SCNCMD
;
COMMENT Declarations, Trivial Procedures;
BEGIN "RTRAN"
DEFINE VERSIONNUMBER = "'401200000042";
LET DEFINE = REDEFINE;
DEFINE VERSIONNUMBER = "'401200000037";
REQUIRE VERSIONNUMBER VERSION;
REQUIRE "<><>" DELIMITERS;
REQUIRE 5000 STRING!SPACE;
IFC DECLARATION(GTJFN) THENC DEFINE TENX(A)=<A>, NOTENX(A)=<>;
ELSEC DEFINE TENX(A)=<>,NOTENX(A)=<A>; ENDC
IFC EQU(COMPILER!BANNER[LENGTH(SCANC(COMPILER!BANNER,"-",NULL,
"IA"))+1 FOR 8],"TYMSHARE") THENC
DEFINE TYMSW(A)=<A>,NOTYMSW(A)=<>; ELSEC
DEFINE TYMSW(A)=<>,NOTYMSW(A)=<A>; ENDC;
DEFINE SUPERCOMMENT(A)=<>;
COMMENT For now we will suppress the SOS type line numbers, if it is
ever desirable to include them later , delete the following
macro definition;
DEFINE LINOUT(X,Y) = <>;
COMMENT This is a program to generate the initial symbol table for the
SAIL compiler. The input is in the form of files -- containing data
about the reserved words -- both syntactic and reserved function names.
THE FORMAT IS:
"<TRUECONDITIONALS>"
a list of all conditional compilation flags which are "on".
Conditional compilation uses "[]" for brackets, and
the left bracket must immediately follow the flag word, i.e.,
TENX[ ... ]
"<RESERVED-WORDS>"
(SYMBOL) (NUMBER) (C OR N)
...C MEANS MEMBER OF A CLASS, N NOT
"<ASSIGN>"
(PASSED RIGHT ON TO FAIL AS SYMBOLIC ASSIGNMENTS FOR
THE ARGUMENTS TO THE FUNCTION PARAMETERS)
"<FUNCTIONS>"
(SYMBOL) (TYPE) (NUMBER OF PARAMETERS)
FOR EACH PARAMTER:
(DESCRIPTOR) (TYPE) (VALUE,REFERENCE)
"<END>"
;
DEFINE RELMODE=<0>, LSTMODE=<0>, SRCMODE=<0>, LSTEXT=<NULL>, RELEXT=<NULL>,
SWTSIZ=<2>, SRCEXT=<"QQQ">, PROCESSOR=<"RTRAN">, GOODSWT=<"X">;
REQUIRE "SCNCMD.SAI" SOURCEFILE;
DEFINE SRC=<1>,SNK=<2>,BREAK=<SRCBRK>,EOF=<SRCEOF>,
NORSCAN=<2>,SUPSPC=<1>,MACSCAN=<3>, ONESCAN=<4>, FBRK=<5>, CBRK=<6>,
FF=<'14>, CR=<'15>,
LF=<'12>,CRLF=<('15&'12)>,PRINT=<OUTSTR(>,
MSG=<&CRLF)>,FUNCNO=<20>,
RESNO=<220>,LINCNT=<5>,BUCKLEN=<13>;
EXTERNAL INTEGER $OS;
INTEGER OSTYP;
INTEGER COMMAND,LINENO,SYMCNT,RESCNT,TYPCNT,TYPARAM;
STRING WORD,CURSYM,ABC,PARM,TEMPSTR;
STRING BAITSTR;
INTEGER BAICH2,BAIDUM; INTEGER ARRAY BCHPD[1:5];
INTEGER NCOND; STRING ARRAY CONDWORD[1:12];
STRING ARRAY RESPRINT[1:RESNO];
SAFE STRING ARRAY BUCKET[0:BUCKLEN];
INTEGER ARRAY RESNUM[1:RESNO];
SAFE STRING ARRAY PARAMS[1:20];
PROCEDURE PUTOUT(STRING A);
BEGIN
LINOUT(SNK,LINENO);
LINENO_LINENO+LINCNT;
OUT(SNK,A&CRLF);
END;
STRING PROCEDURE PRINTOCT(INTEGER A); RETURN(CVOS(ABS A));
PROCEDURE PRINTROOM;
BEGIN
PUTOUT(NULL);PUTOUT(NULL);
END;
COMMENT Initialization, Getword, Hash, Reserved, Nxtsym, Gensym, Ison;
PROCEDURE INITIALIZATION;
BEGIN INTEGER T; STRING TEM;
SIMPLE PROCEDURE OPENFILE(STRING NAME; REFERENCE INTEGER CHAN); BEGIN
INTEGER D; D_0;
OPEN(CHAN_GETCHAN,"DSK",0,0,5,D,D,D);
ENTER(CHAN,NAME,D) END;
SETBREAK(NORSCAN," ["&LF&FF,CR&"]","INR");
SETBREAK(SUPSPC," "&CRLF&FF&"]",NULL,"XNR");
SETBREAK(MACSCAN,"?"&'15,NULL,"IN");
SETBREAK(ONESCAN,NULL,NULL,"XNA");
SETBREAK(FBRK,"!",NULL,"INS");
SETBREAK(CBRK,"[]",NULL,"INS");
NXTFIL_0; WANTBIN_TRUE; NCOND_1;
TYMSW (<CONDWORD[1]_"TYMSHARE";>)
NOTYMSW (<CONDWORD[1]_"NOTYMSHARE";>)
COMMANDSCAN;
OPENFILE("BAISM1.FAI",BAICH2);
OPENFILE("BAICLC.FAI",BCHPD[1]);
OPENFILE("BAIIO1.FAI",BCHPD[2]);
OPENFILE("BAIIO2.FAI",BCHPD[3]);
OPENFILE("BAIMSC.FAI",BCHPD[4]);
OPENFILE("BAIPRC.FAI",BCHPD[5]);
TEM_"
$BEGIN__.+1
";
CPRINT(BCHPD[1]," TITLE BAICLC",TEM);
CPRINT(BCHPD[2]," TITLE BAIIO1",TEM);
CPRINT(BCHPD[3]," TITLE BAIIO2",TEM);
CPRINT(BCHPD[4]," TITLE BAIMSC",TEM);
CPRINT(BCHPD[5]," TITLE BAIPRC",TEM,"
ITMVAR_ITMVAR+UNTYPE ;TYPE KLUGE
");
NOTENX(<OUT(BAICH2," TITLE PD8SM1
^^START: RESET
OPEN 1,FDB1
HALT .
ENTER 1,ENT1
HALT .
OPEN 2,FDB2
HALT .
ENTER 2,ENT2
HALT .
OPEN 3,FDB3
HALT .
ENTER 3,ENT3
HALT .
OPEN 4,FDB4
HALT .
ENTER 4,ENT4
HALT .
OPEN 5,FDB5
HALT .
ENTER 5,ENT5
HALT .
A_1
B_2
C_3
D_4
F_6
P_17
MOVE P,[IOWD 10,PDL]
MOVE A,[POINT 36,$BEGIN]
NEXT: ILDB F,A ;WHICH FILE IT GOES TO
CAMN F,[-1]
JRST FIN
MOVE F,-1+[ OBUF1
OBUF2
OBUF3
OBUF4
OBUF5](F) ;ADDR OF BUFFER RING
ILDB B,A ;FIRST DATA WORD
PUSHJ P,WORD
ILDB B,A ;SECOND DATA WORD
PUSHJ P,WORD
MOVEI D,-400000+3(B) ;NUMBER OF ADDITIONAL DATA WORDS
ILDB B,A
PUSHJ P,WORD
SOJG D,.-2
JRST NEXT
FIN: MOVEI D,5
MOVE F,-1+[OBUF1OBUF2OBUF3OBUF4OBUF5](D)
MOVE B,[-1] ;END-OF-FILE FLAG
PUSHJ P,WORD
SOJG D,FIN+1 ;FOR EACH FILE
RELEASE 1,
RELEASE 2,
RELEASE 3,
RELEASE 4,
RELEASE 5,
EXIT
WORD: SOSG 2(F) ;DECR CHR COUNT
XCT 3(F) ;NO ROOM. DO OUT
JRST WORD1
HALT .
WORD1: IDPB B,1(F)
POPJ P,
FDB1: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF1: BLOCK 3
OUT 1, ;XCT'ED TO WRITE BUFFER
FDB2: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF2: BLOCK 3
OUT 2, ;XCT'ED TO WRITE BUFFER
FDB3: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF3: BLOCK 3
OUT 3, ;XCT'ED TO WRITE BUFFER
FDB4: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF4: BLOCK 3
OUT 4, ;XCT'ED TO WRITE BUFFER
FDB5: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF5: BLOCK 3
OUT 5, ;XCT'ED TO WRITE BUFFER
ENT1: SIXBIT /BAICLC/
SIXBIT /SM1/
0
0
ENT2: SIXBIT /BAIIO1/
SIXBIT /SM1/
0
0
ENT3: SIXBIT /BAIIO2/
SIXBIT /SM1/
0
0
ENT4: SIXBIT /BAIMSC/
SIXBIT /SM1/
0
0
ENT5: SIXBIT /BAIPRC/
SIXBIT /SM1/
0
0
PDL: BLOCK 10
$BEGIN:
PDA1__PDA2__PDA3__PDA4__PDA5__1
");>) COMMENT NOTENX;
TENX(< OUT(BAICH2," TITLE PD8SM1
PDL: BLOCK 20 ;[clh]
^^START: RESET
A_4
B_5
C_6
D_7
F_11 ;[clh]
P_17
MOVE P,[IOWD 10,PDL]
MOVEI D,5
GTNEXT: MOVSI 1,1
HRRO 2,-1+[ [ASCIZ/BAICLC.SM1/]
[ASCIZ/BAIIO1.SM1/]
[ASCIZ/BAIIO2.SM1/]
[ASCIZ/BAIMSC.SM1/]
[ASCIZ/BAIPRC.SM1/] ](D)
GTJFN
PUSHJ P,ERR
MOVEM 1,JFN-1(D) ;[clh]
MOVE 2,[440000100000]
OPENF
PUSHJ P,ERR
SOJG, D,GTNEXT
MOVE A,[POINT 36,$BEGIN]
NEXT: ILDB F,A ;WHICH FILE IT GOES TO
CAMN F,[-1]
JRST FIN
MOVE 1,JFN-1(F) ;WHICH JFN
ILDB 2,A ;FIRST DATA WORD
BOUT
ILDB 2,A ;SECOND DATA WORD
MOVEI D,-400000+3(2) ;[clh] NUMBER OF ADDITIONAL DATA WORDS
BOUT
ILDB 2,A
BOUT
SOJG D,.-2
JRST NEXT
FIN: MOVEI D,5
FLOOP: MOVE 1,JFN-1(D) ;[clh]
MOVE 2,[-1] ;END-OF-FILE FLAG
BOUT
CLOSF
PUSHJ P,ERR
SOJG D,FLOOP ;[clh] FOR EACH FILE
HALTF
ERR: HRROI 1,[ASCIZ /ERROR!/]
PSOUT
JRST ERR-1
JFN: BLOCK 5
$BEGIN:
PDA1__PDA2__PDA3__PDA4__PDA5__1
");>) COMMENT TENX;
FOR T_0 STEP 1 UNTIL BUCKLEN DO BUCKET[T]_"0";
TYPCNT_SYMCNT_COMMAND_EOF_0;
LINENO_LINCNT;
END;
SIMPLE BOOLEAN PROCEDURE ISON(STRING A);
BEGIN INTEGER I;
FOR I_1 STEP 1 UNTIL NCOND DO IF EQU(A,CONDWORD[I]) THEN RETURN(TRUE);
RETURN(FALSE) END;
RECURSIVE STRING PROCEDURE GETWORD;
BEGIN INTEGER BR;
COMMAND_0;
WORD_INPUT(SRC,SUPSPC);
IF EOF THEN BEGIN
COMMANDSCAN;
WORD_INPUT(SRC,SUPSPC);
WHILE COMMAND =0 DO WORD _ GETWORD ;
RETURN (WORD);
END;
WORD_INPUT(SRC,NORSCAN);
IF EQU (WORD,"MUMBLE") THEN BEGIN
WHILE WORD";" AND WORD[ FOR 1]";" DO
WORD_ GETWORD;
WORD_GETWORD;
END;
IF SRCBRK="[" THEN BEGIN COMMENT CONDITIONAL COMPILTION;
INPUT(SRC,ONESCAN);
IF ISON(WORD) THEN WORD_GETWORD
ELSE BEGIN INTEGER CCNT;
CCNT_1;
DO BEGIN
INPUT(SRC,CBRK);
IF SRCBRK="[" THEN CCNT_CCNT+1;
IF SRCBRK="]" THEN CCNT_CCNT-1 END
UNTIL CCNT=0;
WORD_GETWORD
END
END;
IF WORD="<" THEN COMMAND_1;
RETURN (WORD);
END;
PROCEDURE RESERVED;
BEGIN STRING A;
A_GETWORD;
FOR RESCNT_1 STEP 1 WHILE COMMAND=0 DO BEGIN
RESPRINT[RESCNT]_A;
RESNUM[RESCNT]_CVO(GETWORD);
A_GETWORD;
IF A="C" THEN RESNUM[RESCNT]_-RESNUM[RESCNT];
A_GETWORD;
END;
END;
STRING PROCEDURE NXTSYM;
RETURN("SYM"&CVS(SYMCNT+1));
STRING PROCEDURE GENSYM;
BEGIN
SYMCNT_SYMCNT+1;
CURSYM_"SYM"&CVS(SYMCNT);
RETURN(CURSYM);
END;
INTEGER PROCEDURE HASH(STRING A);
BEGIN
INTEGER J,HASS;
HASS_0;
FOR J_1 STEP 1 UNTIL 5 DO BEGIN
IF J>LENGTH(A) THEN HASS_(HASS LSH 7) ELSE
HASS_ (HASS LSH 7)+(A[J FOR 1]);
END;
HASS_(HASS LSH 1);
HASS_((HASS XOR LENGTH(A)) MOD BUCKLEN);
IF HASS>0 THEN RETURN(HASS) ELSE RETURN(-HASS);
END;
COMMENT Printreserved, Assigned;
PROCEDURE PRINTRESERVED;
BEGIN INTEGER I,J;
STRING A,OLDRES;
OLDRES_"0";
FOR I _1 STEP 1 UNTIL RESCNT-1 DO BEGIN
PUTOUT(" ");
J_HASH(RESPRINT[I]);
A_BUCKET[J];
BUCKET[J]_GENSYM;
PUTOUT(CURSYM&": XWD "&OLDRES&","&A);
OLDRES_BUCKET[J];
PUTOUT(" "&PRINTOCT(LENGTH(RESPRINT[I])));
PUTOUT(" POINT 7,.+2");
IF RESNUM[I]<0 THEN BEGIN
PUTOUT(" XWD RES+CLSIDX,"&PRINTOCT(-RESNUM[I]));
END ELSE BEGIN
PUTOUT(" XWD RES,"&PRINTOCT(RESNUM[I]));
END;
PUTOUT(" ASCIZ/"&RESPRINT[I]&"/");
END;
PUTOUT(OLDRES);
PUTOUT("^RESEND:");
COMMENT PRINT BUCKET;
PRINTROOM; PRINTROOM;
PUTOUT("^MBUCK: ;INITIALIZED BUCKET");
FOR I_1 STEP 1 UNTIL (BUCKLEN+1)/2 DO BEGIN
PUTOUT(" XWD "&BUCKET[2*I-2]&","&BUCKET[2*I-1]);
END;
END;
PROCEDURE ASSIGN;
BEGIN STRING A,B;
WHILE COMMAND=0 DO BEGIN
A_NULL;
BREAK_0;
WHILE BREAK LF AND COMMAND=0 DO BEGIN
B_GETWORD;
A_A&B;
END;
IF COMMAND=0 THEN PUTOUT(A);
END;
END;
COMMENT Macros, Cond;
PROCEDURE MACROS;
BEGIN "MACROS"
STRING A, B, NPR, BODY, BODADD;
INTEGER J, BRF, NUM;
PROCEDURE OUTBYT(INTEGER BYT);
BEGIN "OUTBYT"
STRING B;
IF NUM=0 THEN B_"BYTE (7) " ELSE B_B&",";
B_B&(IF BYT=0 BYT='177 BYT='15 BYT='12 THEN CVOS(BYT) ELSE
""""&BYT&""""); NUM_NUM+1;
IF NUM=15 BYT=0 THEN BEGIN PUTOUT(B&";"); NUM_0 END
END "OUTBYT";
PUTOUT ("; BUILT-IN MACROS");
WHILE COMMAND = 0 DO BEGIN "A MACRO"
PRINTROOM;
A_GETWORD;
IF COMMAND0 THEN DONE;
NPR_GETWORD;
BODY_NULL; NUM_0; INPUT(SRC,ONESCAN);
DO BEGIN "GET BODY"
BODY_BODY&INPUT(SRC,MACSCAN);
BRF_SRCBRK;
INPUT(SRC,ONESCAN);
IF BRF="?" THEN
BODY_BODY&SRCBRK&(IF SRCBRK'15 THEN NULL ELSE INPUT(SRC,ONESCAN))
ELSE IF BRF="" THEN BODY_BODY&'177&(SRCBRK-"0")
END "GET BODY" UNTIL BRF=""SRCBRK="0";
BODADD_GENSYM;
PUTOUT(BODADD&": 0 ;MACRO BODY STRING");
PUTOUT(" "&PRINTOCT(LENGTH(BODY)));
PUTOUT(" POINT 7.,.+3");
PUTOUT(" XWD CNST,STRING0 ;TBITS,,SBITS");
BRF_LENGTH(BODY);
FOR J_1 STEP 1 UNTIL BRF DO OUTBYT(LOP(BODY));
PRINTROOM;
J_HASH(A);
B_BUCKET[J]; BUCKET[J]_GENSYM;
PUTOUT (CURSYM&": XWD "&BODADD&","&B&" ; HEADER FOR "&A);
PUTOUT (" "&PRINTOCT(LENGTH(A)));
PUTOUT (" POINT 7,.+6");
PUTOUT (" XWD DEFINE,0000XWD "&NPR&",0");
PUTOUT (" ASCII /"&A&"/")
END "A MACRO"
END "MACROS";
PROCEDURE COND;
BEGIN STRING A;
WHILE COMMAND =0 DO BEGIN
A_GETWORD; IF COMMAND NEQ 0 THEN DONE;
CONDWORD[NCOND_NCOND+1]_A END
END;
COMMENT Functions;
PROCEDURE FUNCTIONS;
BEGIN
INTEGER J,PAR,I,EXTREF; INTEGER NVSTRPAR,NPDA,BRCHAR,BCH;
STRING FIRVARB,CURVARB,A,C,VARBLOW,PREVARB,B,TYPE,BILTIN,QQ,D,E;
STRING XXY; STRING BTSTR;
PUTOUT ("; FUNCTION SYMBOL TABLE ENTRIES");
PUTOUT("^IPROC:");
PREVARB _ "0";
WHILE COMMAND=0 DO BEGIN "A FUNCTION"
EXTREF_FALSE;
PRINTROOM;
E_A_GETWORD;
IF COMMAND=0 THEN BEGIN "FUN"
TYPE_GETWORD; BILTIN _ GETWORD; IF EQU(BILTIN[INF-5 FOR 6],"FNYNAM") THEN E_E&"$";
D_NULL; WHILE LENGTH(E) DO BEGIN
D_D&SCAN(E,FBRK,BRCHAR); IF BRCHAR="!" OR BRCHAR="" THEN D_D&"." END;
J_HASH(A);
B_BUCKET[J];
BUCKET[J]_GENSYM;
CURVARB_CURSYM;
IF A="." THEN BEGIN "PROVIDE NAMED ACCESS TO THIS SEMBLK"
PUTOUT("^"&A&":"); COMMENT FOR .LOP. ETC;
A_A[2 TO ];
END;
XXY_GETWORD; IF XXY="X" THEN BEGIN "EXTERN TOO"
PUTOUT("EXTERNAL "&A); EXTREF_TRUE; XXY_XXY[2 TO ]
END "EXTERN TOO";
PAR_CVD(XXY); NVSTRPAR_CVD(GETWORD); BCH_CVD(GETWORD);
PUTOUT(CURSYM&": "&B&" ;HEADER FOR "&A);
PUTOUT(" "&PRINTOCT(LENGTH(A)));
PUTOUT(" POINT 7,.+"&
(IF EQU(A,"M") THEN "11" ELSE IF PAR 10000 THEN "10" ELSE "4"));
IF BCH NEQ 0 THEN CPRINT(BCHPD[BCH],"
EXTERNAL ",D,"
0
LINK PDLNK,.-1
,",D,"
",CVOS(LENGTH(A)),"
POINT 7,[ASCII/",A,"/]
REFB+PROCB+"&TYPE&"
XWD 2*",CVOS(NVSTRPAR),",",CVOS(PAR-NVSTRPAR+1),"
0
0
XWD 0,.+4
XWD .-10,0
XWD ",D,",0
XWD ",D,",0");
IF BCH NEQ 0 THEN CPRINT(BAICH2,"
",BCH,"
4
400000+",CVOS((LENGTH(A)+4)%5),"
XWD 777777,0
XWD BBLTPRC+",TYPE,",PDA",BCH,"
ASCII /",A,"/
PDA",BCH,"__PDA",BCH,"+14+",CVOS(PAR),"
0");
IF PAR > 10000 THEN BEGIN "SOME SORT OF SPECIAL GLITCH"
PUTOUT(" XWD "&BILTIN&","&TYPE);
PUTOUT(" 00");
PUTOUT(" ASCII/"&A&"/");
J_(LENGTH(A)+4)%5;
PUTOUT(" BLOCK "&PRINTOCT(3-J));
END ELSE BEGIN "REGULAR FUNCTION"
STRING PARSTR; INTEGER I,ZZ;
PUTOUT(" XWD EXTRNL+"&BILTIN&",PROCED+FORWRD+"
&TYPE);
PUTOUT(" 0");
QQ_NULL;
FOR I_1 STEP 1 UNTIL LENGTH(A) DO
QQ_QQ&(IF (ZZ_A[I FOR 1])=
"" THEN "." ELSE ZZ);
IF EXTREF THEN
PUTOUT(" XWD 0+"&QQ&",IFN DCS,<0+"&QQ&" ;>0 ")
ELSE
PUTOUT(" IFN DCS,<0+"&QQ&" ;>0 ");
PARSTR_" BYTE (6) "; BAITSTR_NULL;
FOR I_1 STEP 1 UNTIL PAR DO BEGIN "ONE PARAM"
INTEGER DFVFLG;
DFVFLG_0;
B_GETWORD ; COMMENT SWINEHART'S DUMMY;
B_GETWORD ; COMMENT DESCRIPTOR;
TEMPSTR_GETWORD;
IF TEMPSTR="$" THEN
BEGIN
DFVFLG_'40;
TEMPSTR_GETWORD;
END;
PARM_(BTSTR_GETWORD) &","& TEMPSTR;
IF LENGTH(TEMPSTR)>6 THEN TEMPSTR_"UNTYPE";
IF DFVFLG THEN TEMPSTR_"DEFLT+$DFLT$+" & TEMPSTR;
IF BCH NEQ 0 THEN CPRINT(BCHPD[BCH],"
0+",TEMPSTR,"+",BTSTR);
TYPARAM_0;
FOR J_1 STEP 1 UNTIL TYPCNT DO BEGIN "MATCH TYPES"
IF EQU(PARAMS[J],PARM) THEN BEGIN
TYPARAM_J;DONE; END;
END;
IF TYPARAM THEN PARAMS[TYPCNT_TYPARAM_TYPCNT+1]_PARM;
PARSTR _ PARSTR&CVOS(TYPARAM+DFVFLG)&",";
END "ONE PARAM";
PUTOUT(PARSTR&"0");
PUTOUT(" BLOCK "&CVS(3-((PAR+6)%6)));
END; "REGULAR FUNCTION";
C _ NXTSYM;
PUTOUT(" XWD "&C&","&PREVARB&"");
IF EQU(A,"M") THEN PUTOUT(" 0");
IF PAR < 10000 THEN
PUTOUT(" ASCII /"&A&"/");
PREVARB _ CURSYM ;
PRINTROOM;
END "FUN"
END "A FUNCTION";
PUTOUT ("^BLTTBL_.-1");
FOR I_1 STEP 1 UNTIL TYPCNT DO PUTOUT("XWD "&PARAMS[I]);
PUTOUT(NXTSYM&"__0");
C_GENSYM;
END "FUNCTIONS";
COMMENT Defin, Main Loop;
PROCEDURE DEFIN;
BEGIN STRING A,B; INTEGER I; LABEL M;
PRINTROOM;
A_GETWORD;
WHILE COMMAND =0 DO BEGIN
FOR I_1 STEP 1 UNTIL RESCNT-1 DO BEGIN
IF EQU(A,RESPRINT[I]) THEN BEGIN
A_A&" ";
IF RESNUM[I] 0 THEN B_"OPER" ELSE B_"CLASOP";
PUTOUT("^R"&A[1 FOR 5]&"__"&B&"+"&PRINTOCT(RESNUM[I]));
GO TO M;
END; END;
M: A_GETWORD;
END;
END;
STRING TEM1,TEM2;
ONETIME_FALSE;
WHILE TRUE DO BEGIN "EXEC"
STRING A;
INITIALIZATION;
PUTOUT("SUBTTL INITIAL SYMBOL TABLE");
PUTOUT("BEGIN RESTAB");
PUTOUT("IFNDEF DCS,<DCS __ 0>");
PUTOUT("^RESYM:");
PUTOUT("LSTON(SMTB)");
WHILE EOF = 0 AND EQU(WORD,"<END>")=0 DO BEGIN
WHILE COMMAND=0 DO BEGIN
A_GETWORD;
END;
COMMAND_0;
IF EQU(WORD,"<TRUECONDITIONALS>") THEN COND;
IF EQU(WORD,"<RESERVED-WORDS>") THEN RESERVED;
IF EQU(WORD,"<FUNCTIONS>") THEN FUNCTIONS;
IF EQU(WORD,"<MACROS>") THEN MACROS;
IF EQU(WORD,"<DEFINITIONS>") THEN DEFIN;
IF EQU(WORD,"<ASSIGN>") THEN ASSIGN;
END;
PRINTRESERVED;
CPRINT(BCHPD[2],";SOME PROCEDURES NOMRALLY COMPILED INLINE
0 ;WORD FOR PROCEDURE DESCRIPTOR LINK
LINK PDLNK,.-1
..LDB ;ENTRY ADDRESS
3 ;SAIL STRING DESCRIPTOR FOR NAME
POINT 7,[ASCII/LDB/]
REFB+PROCB+INTEGR ;TYPE OF PROCEDURE
XWD 0,2 ;STRING PARAMS*2,,ARITH PARAMS+1
0 ;SS DISPL,,AS DISPL
0 ;LEX LEV,,LOCAL VAR INFO
XWD 0,.+4 ;DISPL LEV,,PNTR TO PARAM INFO
XWD .-10,0 ;PDA,,0
XWD ..LDB,0 ;PCNT AT END OF MKSEMT,,PARENTS PDA
XWD ..LDB,0 ;PCNT AT PRDEC,,LOC FOR JRST EXIT
0+INTEGR+VALUE ;TYPE BITS FOR PARAMETER
0
LINK PDLNK,.-1
..ILDB
4
POINT 7,[ASCII/ILDB/]
REFB+PROCB+INTEGR
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..ILDB,0
XWD ..ILDB,0
0+INTEGR+REFRNC
0
LINK PDLNK,.-1
..IBP
3
POINT 7,[ASCII/IBP/]
REFB+PROCB
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..IBP,0
XWD ..IBP,0
0+INTEGR+REFRNC
0
LINK PDLNK,.-1
..DPB
3
POINT 7,[ASCII/DPB/]
REFB+PROCB
XWD 0,3
0
0
XWD 0,.+4
XWD .-10,0
XWD ..DPB,0
XWD ..DPB,0
0+INTEGR+VALUE
0+INTEGR+REFRNC
0
LINK PDLNK,.-1
..IDPB
4
POINT 7,[ASCII/IDPB/]
REFB+PROCB
XWD 0,3
0
0
XWD 0,.+4
XWD .-10,0
XWD ..IDPB,0
XWD ..IDPB,0
0+INTEGR+VALUE
0+INTEGR+REFRNC
P__17
TEMP__14
INTERNAL ..LDB,..ILDB,..DPB,..IDPB,..IBP
EXTERNAL X22,X33
..LDB: LDB 1,-1(P)
..RET2: SUB P,X22
JRST @2(P)
..ILDB: ILDB 1,@-1(P)
JRST ..RET2
..IBP: IBP 1,@-1(P)
JRST ..RET2
..DPB: MOVE TEMP,-2(P)
DPB TEMP,-1(P)
..RET3: SUB P,X33
JRST @3(P)
..IDPB: MOVE TEMP,-2(P)
IDPB TEMP,@-1(P)
JRST ..RET3
");
OUT(BAICH2,"
;FOR THE FAKE RUNTIMES
2 ;'MAJOR IO' FILE
4 ;PROCEDURE INFO COMING
400000+1 ;FLAG+ NUMBER OF WORDS IN NAME
XWD 777777,0 ;THIS WORD IGNORED BY BAIL'S LOADER
XWD BBLTPRC+INTEGR,PDA2 ;TYPE BITS,,ADDR OF PDA IN BAIPDn FILE
ASCII /LDB/ ;NAME
0
PDA2__PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC+INTEGR,PDA2
ASCII /ILDB/
0
PDA2__PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /IBP/
0
PDA2_PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /DPB/
0
PDA2__PDA2+14+2
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /IDPB/
0 ;END OF FAKIRS
PDA2__PDA2+14+2
");
TEM1_"
0
$DFLT$: 0
0
LINK BALNK,.-1
XWD $BEGIN,$BEGIN
";
TEM2_"
-1
END
";
BEGIN "UGHFAIL"
SIMPLE STRING PROCEDURE F(STRING A); RETURN("
IFNDEF GTJFN,<
1,,1
SIXBIT /"&A&"/
>;IFNDEF GTJFN
"&(if OSTYP
then
"IFDEF GTJFN,<
1,,3
ASCIZ /SAI:"
else
"IFDEF GTJFN,<
1,,4
ASCII /<SAIL>")
&A&".SM1/
>;IFDEF GTJFN
");
IF SWTVAL[1] COMMENT if user typed /nnX;
THEN IF SWTVAL[1] = 10 COMMENT /10X is Tenex;
THEN OSTYP _ 0
ELSE OSTYP _ 2 COMMENT else T20;
ELSE IF ($OS LAND '770000) = '030000 COMMENT TENEX IF ON IT;
THEN OSTYP _ 0
ELSE OSTYP _ 2; COMMENT ELSE USE T20;
outstr("BAIL files for Tops-10 and "&(IF OSTYP THEN "Tops-20" else "Tenex")&" being produced"&'15&'12);
CPRINT(BCHPD[1],TEM1,F("BAICLC"),TEM2);
CPRINT(BCHPD[2],TEM1,F("BAIIO1"),TEM2);
CPRINT(BCHPD[3],TEM1,F("BAIIO2"),TEM2);
CPRINT(BCHPD[4],TEM1,F("BAIMSC"),TEM2);
CPRINT(BCHPD[5],TEM1,F("BAIPRC"),TEM2);
END "UGHFAIL";
RELEASE(BCHPD[1]); RELEASE(BCHPD[2]); RELEASE(BCHPD[3]);
RELEASE(BCHPD[4]); RELEASE(BCHPD[5]);
OUT(BAICH2,"
-1
END START
");
RELEASE(BAICH2);
PUTOUT("BEND RESTAB");
END "EXEC";
END "RTRAN";