File FORT.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/ PDP-8 (8K) FORTRAN COMPILER	*** FORT.05 ***

/ OCTOBER 28, 1970

/ COPYRIGHT 1969, DIGITAL EQUIPMENT CORP. MAYNARD, MASS.
/
/ SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8)
/ FOR USE WITH DISK/DECTAPE MONITOR SYSTEM
/  CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN
/ SAVE ON THE DISK AS FOLLOWS:
/
/	SAVE FTC0!0-7577;5363<C/R>
/	SAVE FTC1!200,1000-1577,2600,6000-16377;<C/R>
/
/ CALL FTC1 FIRST, THEN CALL FTC0 TO COMPILE
/ FOR SUBSEQUENT COMPILATIONS ONLY CALL FTC0.

	FIELD	0
	*200
INBUF,	TEXT /PDP-8 FORTRAN DEC-08-A2B1-4/

	*1000
BEGIN,	PLS		/INITIALIZATION ROUTINE
	TLS
	RFC
	CDF	00
	TAD	CM1300	/SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1)
	DCA	INDX
	TAD	BSYMP
	DCA	TPTT
LP,	DCA I	TPTT
	ISZ	INDX
	JMP	LP
	TAD	CM60
	DCA	INDX
	TAD	BTTAB
	DCA	TPTT
	DCA I	TPTT	/ZERO OUT TEMPORARY TABLES IN FIELD 0
	ISZ	INDX
	JMP	.-2
	CDF	10
	TAD	MIN104	/ZERO EVERYTHING FROM ZERO TO 107
	DCA	INDX
	TAD	CP6
	DCA	TPTT
LPP,	DCA I	TPTT
	ISZ	INDX
	JMP	LPP
	TAD	TPT	/MOVE DATA FROM TABLE TO FIELD 0
	DCA	TPTT
REP,	CDF	00
	TAD I	TPTT
	SNA		/END OF FIELD 0 INITIALIZATION?
	JMP	DN	/YES
	DCA	LOC
	TAD I	TPTT
	CDF	10
	DCA I	LOC
	JMP	REP
DN,	TAD I	TPTT	/MOVE DATA FROM TABLE TO FIELD 1
	SNA		/END FIELD 1 INITIALIZATION
	JMP	DNN	/YES
	DCA	LOC
	TAD I	TPTT
	DCA I	LOC
	JMP	DN
DNN,	CIF	10
	JMP I	STRT
LOC,	0
INDX,	0
MIN104,	L7-ASSIGN
CP6,	L7-1
CM1300,	-1300
CM60,	-60
BTTAB,	ITTAB-1
BSYMP,	BSYM-1		/BOTTOM OF TEMPORARY SYMBOL TABLE
STRT,	FORST		/STARTING POINT AFTER INITIALIZATION
TPTT=10
TPT,	TABLE-1
TABLE,
PUNCH
	LTTYPE
15
	DOEND
45
	FTTAB
51
	ITTAB
47
	TSYM-3
50
	TSYM
55
	-25
56
	BSYM
57
	BSYM
71
	5777
74
	3000
MIKE4
	3377
POINTZ
	3377
BASE
	INBUF
BASE2
	INBUF+100
SCOUNT
	0
SCOUNT+1
	0
SCOUNT+2
	0
QONE
	0
QONE+1
	0
QONE+2
	0
QONE+3
	0
QONE+4
	0
QONE+5
	0
QONE+6
	0
0		/THIS TERMINATES FIELD ZERO INITIALIZATION
2375
	4000
2376
	4000
2377
	4000
0


/ ERROR MESSAGE TABLE AND TEXT ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION -ERR3-1; IE -ERR6-1; IE -ERR9-1; EMSG3 -ERR10-1; EMSG4 -ERR12-1; EMSG4 -ERR14-1; EMSG4 -ERR15-1; EMSG3 -ERR16-1; EMSG5 -ERR17-1; EMSG6 -ERR18-1; SE /SYNTAX ERROR -ERR28-1; SE -ERR29-1; SE -ERR30-1; EMSG8 /ILLEGAL VARIABLE -ERR31-1; SE -ERR35-1; SE -ERR37-1; CE -ERR38-1; EMSG9 /ILLEGAL DO NESTING -ERR39-1; SE -ERR40-1; IE -ERR41-1; EMSG10 /EXPRESSION TOO BIG -ERR42-1; IE -ERR43-1; EMSG11 /MIXED MODE -ERR44-1; EMSG9 -ERR48-1; SE -ERR50-1; SE -ERR51-1; SE -ERR52-1;IE -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING -ERR59-1; SE -ERR60-1; EMSG3 0; EMSG14 /COMPILER MALFUNCTION EMSG1, TEXT /ILLEGAL CONTINUATION/ IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/ EMSG3, TEXT /ILLEGAL STATEMENT/ EMSG4, TEXT /ILLEGAL CONSTANT/ EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/ EMSG6, TEXT /SYMBOL TABLE EXCEEDED/ SE, TEXT /SYNTAX ERROR/ EMSG8, TEXT /ILLEGAL VARIABLE/ EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/ EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/ EMSG11, TEXT /MIXED MODE EXPRESSION/ EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/ EMSG13, TEXT /ILLEGAL EQUIVALENCING/ EMSG14, TEXT /COMPILER MALFUNCTION/ CE, TEXT /UNBALANCED QUOTES/
ITTAB=710 FTTAB=ITTAB+30 DOEND=2377 BSYM=6300 TSYM=7600 / THE STATEMENT TYPE TABLE FOLLOWS *2600 STYPE, 7361 /-DO 0000 LDO 6672 /-IF 0000 LIF 7061 /-GO 5361 /-TO LGOTO 7477 /-CA 6364 /-LL CAL 5573 /-RE 5353 /-TU LRET 7461 /-CO 6154 /-NT LCONT 5454 /-ST 6060 /-OP LSTOP 5777 /-PA 5255 /-US LPAUSE 5573 /-RE 7674 /-AD LREAD 5056 /-WR 6654 /-IT LWRIT 7161 /-FO 5563 /-RM LFRMAT 7262 /-EN 7400 /-D LLAST 7461 /-CO 6263 /-MM LCOMON 7367 /-DI 6273 /-ME LDIMEN 7257 /-EQ 5267 /-UI EQUI -0611 /-FI -1611 /-NI LFIN XXSUBR, 5453 /-SU 7556 /-BR LSUB 7153 /-FU 6175 /-NC LFUNC 0000 /THIS IS THE END OF LIST AREA1, 0 AREA2, 0 / THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR -45 / PREC('%') = 7 NOTE: '%' REPLACES '**' 700 -52 / PREC('*') = 5 500 -57 / PREC('/') = 5 500 -53 / PREC('+') = 4 400 -55 / PREC('-') = 4 400 -75 / PREC('=') = 1 100 -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT 100 1 /THIS IS THE END OF THE TABLE THOU, -1750 -144 -12 -1 / THE PERMANENT SYMBOL TABLE BEGINS HERE *6000 1501 /MAIN 1116 0001 0601 /FAD 0400 0001 2324 /STO 1700 0001 0623 /FSB 0200 0001 0615 /FMP 2000 0001 0604 /FDV 2600 0001 1520 /MPY 3100 0001 0411 /DIV 2600 0001 2205 /READ 0104 0001 2722 /WRITE 1124 0501 1117 /IOH 1000 0001 5060 /(0 0000 0001 1215 /JMP 2000 0001 1617 /NOP 2000 0001 0516 /ENTRY 2422 3101 0501 /EAP 2000 0001 2001 /PAUSE 2523 0501 OPTADI, 2401 /TAD I 0440 1101 OPTAD, 2401 /TAD 0400 0001 OPDCA, 0403 /DCA 0100 0001 OPJMPI, 1215 /JMP I 2040 1101 2205 /RETRN 2422 1601 0320 /CPAGE 0107 0501 OPSNA, 2316 /SNA 0100 0001 2320 /SPC 0300 0001 0301 /CALL 1414 0001 0313 /CKIO 1117 0001 1014 /HLT 2400 0001 OPCLA, 0314 /CLA 0100 0001 0614 /FLOT 1724 0001 1106 /IFAD 0104 0001 0311 /CIA 0100 0001 0310 /CHS 2300 0001 0611 /FIX 3000 0001 1123 /ISTO 2417 0001 2001 /PAGE 0705 0001 BLCK, 0214 /BLOCK 1703 1301 0516 /END 0400 0001 1401 /LAP 2000 0001 0317 /COMMN 1515 1601 1123 /ISZ 3200 0001 2325 /SUBSC 0223 0301 DUMMY, 0425 /DUMMY 1515 3101 0122 /ARG 0700 0001 0314 /CLEAR 0501 2201 1111 /IIPOW 2017 2701 0611 /FIPOW 2017 2701 1106 /IFPOW 2017 2701 0606 /FFPOW 2017 2701 0403 /DCA I 0140 1101 0103 /ACH 1000 0001 OPEN, 1720 /OPEN 0516 0001 0522 /ERROR 2217 2201 1116 /INC 0300 0001 FORTR, 0617 /FORTR 2224 2201 OPCMA, 0315 /CMA 0100 0001 OPIAC, 1101 /IAC 0300 0001 EXIT, 0530 /EXIT 1124 0001
FIELD 1 *7 L7, 0 L10, 0 L11, 0 L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION 0 L14, 0 L15, 2377 /POINTER INTO DOEND LIST L16, 0 L17, 0 L20, 0 /FLAG, NON-ZERO IF '=' SEEN L21, 0 L22, 0 /SUBSCRIPT NESTING LEVEL L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH L24, 0 /LINE POINTER L25, 0 /HIGHEST SUBSCRIPT TEMP USED L26, 0 /USED FOR DIMENSION INFORMATION 0 /UNUSED L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY L31, 0 L32, 0 L33, 0 L34, 0 L35, 0 L36, 0 L37, 0 L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR L43, 0 / L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE L50, 7600 /CONTAINS START OF DIMENSION TABLE L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE L53, 0 /CONTAINS THE LAST CREATED LABEL L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE L57, 6300 /CONTAINS END OF SYMBOL TABLE L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY L63, 0 /CONTAINS THE CURRENT OPERATOR L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR BPAREN, 0 /PARENTHESIS COUNTER L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME L71, 5777 /BEGINNING OF PUSHDOWN LIST L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED L73, 0 / L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER L76, 0 / L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE /THE FOLLOWING THREE LOCS ARE USED BY THE /LITERAL COLLECTER COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT MIKE4,MA, 3377 MIKE8,TOTAL, 0 INTA, 0 INTB,MIKE7, 0 SNUM,MB, 0 POINTZ, 3377 CHK, 0 IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG KOUNT, 0 ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER PROP, LPROP /PRINTS OPCODES PRCRL, LPRCRL /PRINTS CREATED LABELS PRINT, LPRINT /PRINTS ONE ASCII CHAR P2, LP2 /PRINT TWO PACKED ASCII CHARS GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER LUNCH, LLUNCH /PRINTS ERROR COMMENTS MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT PRSYM, LPRSYM /PRINTS SYMBOLS CREATE, LCREAT /CREATES LABELS PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL PLAB, LPLAB /PRINTS LABELS PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION GENER, LGENER /GENERATES THE TRIPLES LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE STORE, LSTORE /STORES THE CONTENTS OF THE AC FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES ZER, LZER DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE C2, 2 C3, 3 C40, 40 C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE C77, 77 CM40, -40 CM4046, -4046 CM50, -50 CM51, -51 CM54, -54 CM2, -2 CM3, -3 CHECK, LCHECK SMODE, LSMODE BSS, LBSS ARG, LARG C54, 54 BASE, INBUF BASE2, INBUF+100 C4000, 4000 GNB, LGNB
*177 START, CLA /COME HERE AT BEGINNING OF EACH STMT TAD IMPDO SZA CLA JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON /CONTINUATIONS (I THINK) ISZ CHK /IS THERE A STMT IN THE BUFFER? JMP .+3 JMS I SWAP /YES, SWITCH BUFFER POINTERS JMP .+3 TAD BASE JMS I RCD /NO, READ THE NEXT LINE TEST, TAD L15 TAD CM3 DCA L16 /SET UP XR FOR DO TERMINATION TEST TAD L54 CIA TAD I L16 SZA CLA /ARE WE TERMINATING A DO? JMP ATRY JMS LDNEXT /TERMINATE DO LOOP JMP TEST /SEE IF THERE IS ANY MORE... ATRY, TAD L61 SZA CLA /A COMMENT? JMP CMNT TAD CHK SZA CLA /ILLEGAL CONTINUATION? ERR1, JMS I LUNCH JMS I STMT /GET THE STMT NR... TAD L32 SNA JMP .+4 /NO STMT NUMBER CIA TAD L12 SZA CLA /CAN WE OMIT A TERMINAL JMP? JMS I PRINT DCA L24 FLST, JMS LIST /PUNCH SOURCE STMT JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE TAD L32 DCA L54 TAD CM2 DCA L64 SKP ACA, DCA I BAREA1 JMS I GETCH JMP ALPH NOP JMS I PUTCH /PUT CHARACTER BACK ALPH, RTL CLL RTL RTL DCA L65 JMS I GETCH JMP ALPH2 NOP JMS I PUTCH /PUT CHARACTER BACK ALPH2, TAD L65 ISZ L64 JMP ACA DCA I BAREA2 DCA CHK TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE DCA L17 TRY, TAD I L17 SNA /END OF THE TABLE? JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT TAD I BAREA1 SZA CLA JMP NOHIT2 TAD I BAREA2 TAD I L17 SZA CLA JMP NOHIT1 TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER... DCA L30 JMP I L30 NOHIT2, ISZ L17 NOHIT1, ISZ L17 JMP TRY /DOESN'T MATCH, TRY AGAIN LDNEXT, 0 TAD L15 /RESET THE DO END POINTER TAD CM3 DCA L15 TAD L15 IAC DCA L16 CMA TAD L55 DCA L55 JMS I PROP /PUNCH 'JMP <LABEL>' 6044 TAD I L16 JMS I PRCRL JMS I PRINT TAD I L16 /PUNCH '<LABEL>,' JMS I CLAB JMS I PRINT JMP I LDNEXT PTEM, 0 LIST, 0 /PUNCH THE SOURCE STATEMENT TAD BASE /GET THE POINTER DCA PTEM TAD I PTEM /PUNCH A CHARACTER PAIR... JMS I P2 TAD I PTEM ISZ PTEM AND C77 SZA CLA /END OF THE BUFFER? JMP LIST+3 JMS I PRINT /YES, PUNCH A CR-LF AND RETURN JMP I LIST CMNT, JMS I PRINT /WE HAVE A COMMENT DCA L24 JMS LIST JMP START BAREA1, AREA1 BAREA2, AREA2 RCD, LRCD SSTYP, STYPE-1 /POINTER TO STATMENT TABLE IN FIELD 1 WIPE, LWIPE STMT, LSTMT SWAP, LSWAP
*400 / THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC / IT PUTS ONE LINE INTO THE BUFFER, / CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A / CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN / LRCD, 0 DCA TEM1 /SAVE THE BUFFER POINTER DCA I TEM1 DCA CHK /ZERO CONTINUATION FLAG DCA L20 /ZERO THE EQUALS FLAG DCA L61 /ZERO THE COMMENT FLAG TAD CM111 /BUFFER LIMIT IS 72 CHARACTERS DCA IX LRCDL, JMS LPTRIN AND D177 SNA /LEADER OR BLANK TAPE? JMP LRCDL TAD CM177 SNA /RUBOUT? JMP LRCDL TAD CM15X SNA /CAR RETURN? JMP LCAR IAC SZA /FORM FEED? TAD C2 SNA /LINE FEED? JMP LRCDL IAC SNA /TAB? JMP TAB TAD CM75X SNA /AN '=' ? ISZ L20 TAD C75 /CHAR OK... RESTORE IT & PUT IN BUFFER JMS KRONK /PUT IT IN THE BUFFER... JMP LRCDL /AND GET ANOTHER LCAR, TAD IX /PROCESS A CAR RETURN... CIA TAD CM111 SNA CLA /NULL STATEMENT? JMP LRCDL /YES, IGNORE JMS KRONK /PUT A ZERO IN THE BUFFER TAD I TEM1 TAD CM3 SNA JMP COMNT TAD CM20 SZA CLA /TEST FOR "S" IN COLUMN ONE JMP TINUE JMP I (SCODE COMNT, ISZ L61 /SET COMMENT FLAG... TAD C40 JMP STORSL TINUE, TAD TEM1 /CHECK FOR CONTINUATION... TAD C3 DCA P /SET THE POINTER TO COLS. 6 AND 7 TAD I P AND C5700 /NON-ZERO OR NON BLANK IN COL 6 TAD C4000 /MAKES THIS A CONTINUATION... SNA CLA /IS IT? JMP LRCDA /MAYBE... LRCDX, TAD B7 /YES, MAKE IT START IN COL 7 DCA KOUNT ISZ CHK /INCREMENT THE CONTINUATION FLAG TAD I TEM1 STORSL, TAD C5700 /MAKE THIS INTO A COMMENT LINE DCA I TEM1 JMP I LRCD /THEN RETURN LRCDA, TAD I P /NUMERIC AND NON-ZERO IN COL 7 MAKES AND C77 /THIS A CONTINUATION... TAD CM61 SPA CLA /IS IT? JMP LRCDX+3 /NO, RETURN IAC /YES, MAKE IT START IN COL 8 JMP LRCDX TAB, TAD C40 /PROCESS TAB CHARACTERS... JMS KRONK /PUT SOME SPACES IN THE BUFFER TAD IX TAD C3 /MAKE 1ST TAB GO TO COL 7 SMA /ARE WE AT END OF THE BUFFER? CLA /YES, FORCE TERMINATION AND B7 SZA CLA /MODULO 8? JMP TAB /NO, PUNCH SOME MORE SPACES JMP LRCDL /YES, GET ANOTHER CHAR KRONK, 0 /PUT A CHARACTER IN THE BUFFER... DCA CAR TAD IX /FIRST COMPUTE BUFFER ADDRESS... TAD C112 CLL RAR TAD TEM1 DCA P TAD CAR /PICK UP THE CHARACTER AND C77 SZL /ZERO LINK SAYS WE WANT THE LEFT HALF JMP .+5 RTL RTL RTL DCA I P TAD I P /ADD IN THE LEFT 6 BITS DCA I P /AND SALT THEM AWAY... ISZ IX /BUFFER OVERFLOW? JMP I KRONK CLA CMA /YES, RESET THE INDEX DCA IX JMP I KRONK LPTRIN, 0 /PAPER TAPE READER INPUT ROUTINE RSF JMP .-1 RRB RFC JMP I LPTRIN CAR, 0 /TEMPORARY, HOLDS THE CURRENT CHARACTER P, 0 /THIS IS THE BUFFER POINTER TEM1, 0 /THIS CONTAINS THE CURRENT BUFFER ADDRESS IX, 0 /THIS IS THE CHARACTER COUNTER CM111, -111 /MINUS THE BUFFER LIMIT PLUS ONE C112, 112 /THIS IS THE BUFFER LIMIT PLUS TWO D177, 177 CM177, -177 CM15X, 177-15 CM75X, 11-75 C75, 75 B7, 7 C5700, 5700 CM61, -61 CM20, -20 M1700, -1700
*600 CAL, TAD KOUNT /SUBROUTINE CALL STMT PROCESSOR DCA COUNT3 JMS I ENTITY JMP I ASSIGN JMP ON COUNT3, 0 Q12, 12 JMP I ASSIGN ON, JMS I GNB SNA /ANY ARGUMENTS? JMP CR2 /NO TAD CM50 SZA /MAYBE, IS THIS A '(' ? JMP I ASSIGN JMS I ZZZ /YES, PUNCH STMT NR, IF ANY TAD COUNT3 DCA KOUNT ISZ L44 DCA L46 /AC SWITCH DCA L52 /IF STATEMENT SWITCH JMS I GENER /LET TRIPLE GENERATOR PROCESS IT DCA L46 /ZERO AC AGAIN JMP START /COMPLETE, GET NEXT STATEMENT CR2, ISZ L32 /NO ARGUMENTS JMS I SYMTAB TAD L77 DCA GLU JMS I ZZZ /PUNCH '<LABEL>, CALL 0,<NAME>' JMS I FPROP GLU, 0 JMP START LGNB, 0 JMS LGTC DCA GLU TAD GLU TAD CM40 SNA CLA JMP LGNB+1 TAD GLU JMP I LGNB LGETCH, 0 JMS I GNB SNA /IS IT A END OF CARD JMP PUNC /YES ITS PUNTUATION TAD QM32 SPA SNA /IS IT ALPHABETIC JMP ALPHA //YES TAD CM40 CLL TAD Q12 SZL /IS IT NUMERIC? ISZ LGETCH /NUMERIC PUNC, ISZ LGETCH /PUNCTUATION ALPHA, CLA /ALPHABETIC TAD GLU JMP I LGETCH /RETURN / THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER / ROUTINE SKIPS IF SYMBOL IS INTEGER LMODE, 0 SMA /IF ITS PLUS WE HAVE AN INTEGER JMP AINT /WE HAVE AN INTEGER RAL /GET NEXT BIT SPA /CHECK THIS BIT JMP FV /ITS EITHER A FCON OR VARIABLE RTL /GET NEXT TWO BITS SNL /IS IT AN OPERATOR ERR2, JMS I LUNCH /YES AFP, SMA CLA /CHECK THIS BIT JMP AINT /ITS AN INTEGER JMP I LMODE /SYMBOL WAS F P MODE FV, RAR /RESTORE AC TO ORIGINAL CONTENTS CIA /SET NEGATIVE TAD L47 /ADD START OF FCON TABLE SPA /IS /SYMBOL FCON JMP AFP /YES CIA /NO /RESTORE AC AGAIN TAD L47 DCA ATEM /SAVE THE RESTORED NUMBER TAD I ATEM /GET THE POINTER TO THE VARIABLE TAD CM1100 /SUBTRACT AN I SPA /IS IT LESS THAN I JMP AFP /YES ITS FLOATING POINT TAD CON1 /NOW SUBTRACT AN N SPA CLA /IS IT LESS THAN N AINT, ISZ LMODE /YES CON1, CLA /CLEAR THE AC FOR THE RETURN JMP I LMODE ATEM, 0 CM1100, -1100 QM32, -32 LGTC, 0 /GET A CHARACTER FROM THE BUFFER TAD KOUNT ISZ KOUNT CLL RAR /LINK TELLS IF LEFT OR RIGHT HALF TAD BASE DCA GLU TAD I GLU SZL /WHICH CHARACTER JMP MMSK RTR RTR RTR MMSK, AND C77 SZA JMP I LGTC TAD CHK SPA CLA /DO WE WANT A NEW LINE YET? JMP I LGTC /NOT YET... TAD BASE2 /YES, USE THE ALTERNATE BUFFER JMS I RLCD TAD CHK SZA CLA /IS IT A CONTINUATION? JMP .+4 CMA /NO, SET FLAG AND RETURN W ZERO AC DCA CHK JMP I LGTC JMS LSWAP /YES, SWITCH BUFFERS AND CONTINUE DCA CHK JMP LGTC+1 RLCD, LRCD LSWAP, 0 /SWITCH THE LINE BUFFER POINTERS TAD BASE DCA ATEM TAD BASE2 DCA BASE TAD ATEM DCA BASE2 JMP I LSWAP
*1000 / THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS / IN LOC 41, THE CURRENT TRIPLE NUMBER IS IN LOCATION 40 / LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT. PBEGN, AREA2 /START OF THE PRECEDENCE LIST BINTEG, TAD L32 /HERE IF ENTITY SENT AN INTEGER JMP I BPUSH /PUSH IT INTO STACK FLPT, JMS I FCON /HERE IF ENTITY FOUND A FLOATING POINT CON SKP /ENTER IT INTO FPTABLE BLPHA, JMS I SYMTAB /HERE IF ENTITY FOUND A VARIABLE TAD L77 /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN JMP I BPUSH /PUSH IT DOWN LABELX, JMP I LGENER LGENER, 0 /ENTRY POINT TAD C5000 DCA L40 /* DCA L21 /ZERO THE SYMBOL TABLE SWITCH TAD L71 DCA L41 /SET PUSH DOWN POINTER DCA L22 DCA BPAREN /ZERO OUT THE PAREN SWITCH TAD C4000 DCA I L41 /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0 BNEXT, JMS I ENTITY /THIS WILL GET THE NEXT DATUM TO BE PROCESSE JMP HOO /END OF STATEMENT RETURN,TREAT LIKE PUNCTION JMP BLPHA /VARIABLE RETURN JMP BINTEG /INTEGER RETURN JMP FLPT /FLOATING POINT RETURN HOO, TAD CM50 /PUNCTIOATION RETURN, SNA /IS IT ( JMP I BPAR /YES TAD C7753 SZA /IS IT AN '=' ? JMP BRET TAD L44 /WE HAVE AN '=', IS IT LEGAL? SNA CLA JMP BRET /IT IS TAD IMPDO SZA CLA /ARE!WE`IN AN IMPLIED DO LOOP? JMP I PIOEQL /YES - TERMINATE LOOP CODE ERR3, JMS I LUNCH PIOEQL, IOEQL BRET, TAD C0075 DCA L63 TAD I L41 /CHECK FOR A UNARY OPERATOR TAD C4000 AND C7000 SZA CLA /WAS IT AN OPERAATOR AT ALL JMP PREC /NO, STILL NOT UNARY OPERATOR TAD L63 TAD C7725 SNA /IS IT A '+' JMP BNEXT /YES, IGNORE IT TAD CM2 /NO SZA CLA /IS IT A '-' ? JMP ERR3 TAD C4643 /THIS IS THE UNARY MINUS JMP I BPUSH PREC, TAD PBEGN /HERE IS WHERE WE FIND THE PRECIDENCE DCA L17 DCA L65 SKP RETUR, ISZ L17 /PICK UP NEXT OP CODE IN LIST TAD I L17 /TO GET THE NEXT LIST ITEM SMA SZA /IS THIS THE END OF THE LIST JMP BMORE /NO, THE ASSUMPTION IS THAT THE PRECIDENCE TAD L63 /IS ZERO SZA CLA /IS THIS THE RIGHT TABLE ENTRY JMP RETUR /TRY AGAIN (IT WASN"T) TAD I L17 /TO GET THE PRECEDENCE DCA L65 BMORE, CLA IAC /HERE WE ARE GOING TO SEE IF THERE IS A PREC TAD L41 DCA L64 /L64 NOW POINTS TO THE PREVIOUS OPERATOR TAD I L64 TAD C4000 AND C7000 SZA /IS THERE A VALID OPERATOR ON THE STACK? JMP ERR3 /APPARENTLY NOT... TAD I L64 /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR AND C700 /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER SNA /THAN OR EQUAL TO THE PRECEDENCE OF THE JMP NO /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS CIA /OPERATOR; IF NOT WE WILL PROBABLY PUT TAD L65 /THE CURRENT OPERATOR ON THE STACK AND GET SMA SZA CLA /ANOTHER ITEM FROM THE STATEMENT BUFFER... JMP NO ISZ L40 /YES, INCREMENT THE TRIPLE NUMBER AND.... JMS I TRIPL /PROCESS THE PREVIOUS OPERATOR ISZ L41 /*****NOTE WHAT IF IT WAS UNARY************ TAD I L41 TAD C3135 /THIS IS MINUS UNARY MINUS SZA CLA ISZ L41 /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR TAD L46 DCA I L41 JMP BMORE /TRY FOR ANOTHER TRIPLE NO, TAD L63 SNA /IS IT A END OF STATEMENT MARK JMP I LCDONE /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING TAD CM51 SNA /IS IT A ')' ? JMP I LKPAR /YES TAD CM3 SZA /IS IT A ',' ? JMP NCOMMA /NO TAD BPAREN SNA CLA /IS A COMMA LEGAL HERE? JMP I LCDONE /MAYBE... NCOMMA, TAD CM21 SNA CLA /IS IT AN EQUALS SIGN? ISZ L44 /YES - SET EQUALS SWITCH ON TAD L63 /PUT THE OPERATOR ON THE STACK TAD L65 /ADD THE PRECEDENCE TAD C4000 JMP I BPUSH / BPUSH, PUSH C5000, 5000 BPAR, ALPAR C7753, 7753 C0075, 75 C7000, 7000 CM21, -21 C7725, 7725 C4643, 4643 C700, 700 C3135, 3135 LCDONE, CDONE LKPAR, KPAR FCON, LFCON
*1200 PUSH, DCA L63 CLA CMA TAD L41 /SPACE THE POINTER UP ONE DCA L41 /* TAD L63 DCA I L41 /* JMP I LBNEXT /BACK TO BEGINING / THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS--- / IF ARITHMETIC, JUST DELETE BOTH ( AND ) KPAR, TAD I L64 TAD C3730 /MINUS LEFT PAREN SZA /IS IT ( JMP BCON /NO-- CHECK SOME MORE TAD I L41 /DELETE PARENS DCA I L64 ISZ L41 /UPDATE POINTER LAPP, ISZ BPAREN /DO PARENS BALENCE JMP I LBNEXT TAD L52 /YES SNA CLA /SHOULD WE RETURN IF BALANCED JMP I LBNEXT TAD L46 SZA CLA JMP CDONE TAD I L41 DCA L77 JMS I XTAD /GENERATE TAD OR (TAD I) DCA I L41 /ZERO IS INTEGER CDONE, TAD L41 CMA TAD L71 SZA /WELL... ERR6, JMS I LUNCH /HA...YOU GOOFED JMS I XZQ JMP I .+1 LABELX BCON, IAC /IS IT FUNCTION ISZ L40 SNA JMP BFOUT /YES IAC /NO-- NOW IS IT SUBSCRIPT SNA JMP SOUT /YES TAD C7772 /NO SZA /IS IT COMMA JMP ERR6 /NO - BYE BYE CHARLIE ISZ L64 ISZ L64 TAD I L64 TAD C3724 /IS IT A COMMA SNA JMP BFOUT /FOUND TWO COMMAS,MUST BE FUNCTION TAD C5 /NO SNA /IS IT A PRIME JMP BFOUT /GOT A FUNCTION IAC /NO SZA CLA JMP ERR6 /SORRY, IT AIN'T NUTTIN SOUT, JMS I PLSBSC /PROCESS A SUBSCRIPT CMA TAD L22 DCA L22 SKP BFOUT, JMS I FUNCT JMP LAPP FUNCT, LFUNCT / THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR ALPAR, CMA TAD BPAREN DCA BPAREN TAD I L41 TAD C4000 AND B7000 /IS IT AN OPERAND SZA CLA JMP CUNT /NO , TRY SOME MORE IAC JMP PRIME CUNT, TAD I L41 /PICK UP TOP LIST ITEM TAD C2 /ADD TWO TO FIND THE DIMENSION INTO(INFO) DCA L64 TAD I L64 AND C20 /JUST WANT ONLY THIS ONE BIT(DIMENSION) SNA CLA /IS IT DIMENSIONED JMP PRIME /NO ITS GOT TO BE A FUNCTION CALL ISZ L22 CMA PRIME, TAD C4047 JMP PUSH /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN XZQ, LXZQ LBNEXT, BNEXT C3730, 3730 C7772, 7772 C3724, 3724 C5, 5 D7, 7 B7000, 7000 C20, 20 C4047, 4047 XTAD, LXTAD LPUTCH, 0 CLA CMA TAD KOUNT DCA KOUNT JMP I LPUTCH LASIGN, TAD L20 /ARITHMETIC STATEMENT PROCESSOR SNA CLA /IS THERE AN '=' IN THE STMT? ERR9, JMS I LUNCH /NO, BETTER COMPLAIN... TAD D7 /SET POINTER TO COL 7 DCA KOUNT JMS I ZZZ /PUNCH THE LABEL, IF ANY DCA L46 DCA L44 DCA L52 JMS I GENER /PROCESS IT... TAD L63 SZA CLA /WAS TERMINATOR A <CR/LF> ? JMP ERR9 /NO, ILLEGAL STATEMENT ERROR ... JMP START PLSBSC, LSUBSC LPRCRL, 0 /SUBROUTINE PRINTS CREATED LABELS DCA LPRCTM TAD C36 /PUNCH '^' JMS I PRINT TAD LPRCTM /PUNCH THE LETTERS JMS I P2 JMP I LPRCRL C36, 36 LPRCTM, 0
*1400 PRET, ISZ LENTT /PUNCTIONATION EXIT POINT FRET, ISZ LENTT /FLOATING POINT EXIT POINT XIRET, ISZ LENTT /INTEGER EXIT POINT XARET, ISZ LENTT /VARIABLE EXIT ERET, JMP I LENTT /CR END OF LINE EXIT LENTT, 0 /ENTRY POINT CLA /WIPE OUT PSEUDO ACCUMULATOR DCA L32 DCA L31 DCA COUNT2 /RESET ALL KINDS OF THINGS TO ZERO DCA L36 DCA L37 DCA L30 DCA FPSW DCA ESIGN TAD CM6 DCA L65 /SET UP FOR MAXIMUM OF 6 CHARS JMS I GETCH /GET THE FIRST INPUT CHARACTER JMP .+3 /ALPHA RETURN JMP PUNCT /PUNCTIONATION RETURN JMP DIG /DIGIT RETURN JMS PACK /STORE THIS CHARACTER JMS I GETCH /GET ANOTHER CHACTER JMP .-2 /ALPHA- IS OK SKP /PUNCTUATION JMP .-4 /DIGIT--IS OK PROCESS IT JMS I PUTCH /PUT THAT PUNCTUATION BACK IN THE BUFFER TAD L32 AND CC7700 /MAKE SURE NAME IS <= 5 CHARACTERS LONG DCA L32 JMP XARET /RETURN WITH VARIABLE PACK, 0 /THIS PACK CHARS INTO L30 L31 AND L32 DCA L64 /SAVE THE CHAR... TAD L65 SNA /DO WE HAVE SIX CHARS ALREADY? JMP I PACK /YES - IGNORE STL; RAR TAD P33 DCA LTEM ISZ L65 C7, 7 TAD L64 CDF 10 SNL /DO WE HAVE LEFT OR RIGHT HALF? JMP .+5 CLL RTL /MUST BE LEFT HALF... RTL RTL SKP TAD I LTEM DCA I LTEM CDF 00 JMP I PACK LTEM, 0 PUNCT, SNA /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET JMP ERET /YES, GO RIGHT BACKTO THE CALLER....BY-BY TAD C7722 /IS IT A PERIOD SNA JMP CC /YES--WE ASSUME THAT THIS LENTT IS A FLOATING TAD C7 SNA /IS IT A QUOTE? JMP I QUOTE /YES - CHARACTER LITERAL TAD CM3 SZA /IS IT AN ASTERISK JMP NAH /NO JMS I GETCH /YES- PEEK AT NEXT CHAR JMP NOASS /ALPHA-- PUT IT BACK JMP ASSCK /PUNCTUATION-- CHECK FOR AN ASTERISK NOASS, JMS I PUTCH /DIGIT---PUT IT BACK NAH, TAD X52 /RESTORE CHARACTER TO WHAT IT WAS JMP PRET /THATS ALL---IT WAS PUNCTIONATION ASSCK, TAD CM52 /ANOTHER PUNCTUATION--IS IT (*) SZA JMP NOASS /NO---PUT IT BACK TAD C45 /IT WAS-- CHANGE ** TO PERCENT JMP PRET /---ALTERED PUNCTUATION DIG, AND C17 /FIRST CHAR WAS A DIGIT, DONT KNOW IS INTEGER O DCA L32 /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER CA, JMS I GETCH /GET ANOTHER CHACTER JMP I LTESTE /ALPHA--GO SEE IF IT IS AN -E- SKP /PUNCT JMP BONT /DIGIT GO PROCESS IT TAD C7722 /PUNCTUATION HERE, IS IT A PERIOD SZA JMP I LCOP / IT IS . WE HAVE A FLOATING POINT NUMBER CC, TAD FPSW SZA ERR10, JMS I LUNCH /TOO MANY (.) ISZ FPSW DCA COUNT2 JMP CA /GO BACK AND GET ANOTHER CHAR BONT, AND C17 /***COME HERE WITH ANOTHER DIGIT. DCA L36 /SAVE IT ISZ COUNT2 JMS I LMUL10 / AC = AC * 10 + DIGIT JMP CA /GO GET ANOTHER CHAR P33, L30+3 CM6, -6 C7722, 7722 X52, 52 CM52, -52 C17, 17 LTESTE, TESTE C45, 45 LCOP, COP LMUL10, MUL10 QUOTE, LQUOTE DMPLIN, 0 /SUBROUTINE TO DUMP "LAST LINE" BUFFER ISZ L24 TAD I L24 /GET NEXT CHAR JMS I PUNCH /PUNCH IT TAD I L24 TAD CM212 SZA CLA /IS CHAR A LINE FEED? JMP DMPLIN+1 /NO CLA IAC DCA L24 /RESET POINTER DCA L12 /ZERO CONTENTS FLAG JMP I DMPLIN /RETURN CM212, -212 CC7700, 7700
*1600 TESTE, TAD C7773 /IS IT E SZA JMP COP /NO, GO PUT IT BACK AND PROCESS / HERE IF EXPONENT FOLLOWES DCA L37 /IT WAS AN E / THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE / ISZ FPSW /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED JMS I GETCH /GET ANOTHER CHAR JMP ERR12 /ALPHA , CANT BE-- SO LONG, ITS BEEN NICE SKP /PUNCT JMP CD /DIGIT, GO PROCESS IT TAD X7725 /IS IT PULS SIGN SNA JMP CF /YES, IGNOR IT TAD CM2 SZA /IS IT MINUS JMP COP /NO, GO PROCESS THE FLOATING POINT NUMBER CLA CMA DCA ESIGN /YES- REMEMBER THAT THE EXPONENT WAS MINUS CF, JMS I GETCH /GET ANOTHER CHAR JMP COP /ALPHA, ALL READY TO PROCESS JMP COP /PUNCTUATION, READY TO PROCESS CD, AND X17 /DIGIT DCA L36 /SAVE IT IN 36 AND.. TAD L37 /MULTIPLY THE - EXPONENT TO DATE- BY 10 RAL CLL DCA L37 TAD L37 RAL CLL RAL CLL TAD L37 TAD L36 /AND ADD IN THIS DIGIT I.E. 37C10* DCA L37 / L37 = 10 * L37 + L36 JMP CF /GO DO IT AGAIN COP, JMS I PUTCH CLA CLL /PROCESS THIS NUMBER TAD FPSW /IS IT AN INTEGER SZA CLA JMP CH /NO, MUST BE FLOATING POINT / INTEGER IS IN ACC TAD L30 /YESS SNA /MAKE SURE INTEGER IS VALID TAD L31 SZA CLA JMP ERR12 TAD L32 SPA CLA ERR12, JMS I LUNCH /TOO BIG JMP I .+1 /TAKE INTEGER RETURN WITH INTEGER IN 32 XIRET CH, TAD L37 /WAS THIS AN E-CONVERSION NUMBER ISZ ESIGN /EXPONENT POSITIVE? CIA /YES TAD COUNT2 /ADD POST-DECIMAL COUNTER CLL SNA JMP CM /NOTHING TO DO SMA /DETERMINE WHETHER TO CML CIA /MULTIPLY OR DIVIDE DCA COUNT2 RAL TAD CJ DCA CK JMS XFLOAT /SET UP THE NUMBER CK, HLT /JMP I (MULT OR JMP I (DIVIDE ISZ COUNT2 JMP CK /LOOP ON COUNT JMP I LPOLIS /FINISH UP CM, JMS XFLOAT JMP I LPOLIS CJ, JMS I .+1 MULT DIVIDE / THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT XFLOAT, 0 CLA CLL TAD L32 /CHECK IF THE ACCUMULATED NUMBER IS ZERO SNA TAD L31 SNA TAD L30 SNA CLA JMP I LFRET /IT WAS ZERO SEND A FLOATING POINT ZERO BACK-- TAD C2440 /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10 DCA L37 JMS NORMAL /GO TO THE NORMALIZE ROUTINE JMP I XFLOAT /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA / ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U / NORMAL IZATION OF A F P NUMBER NORMAL, 0 DA, TAD L30 /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N SPA CLA JMP I NORMAL /IT IS NEG., ALL DONE JMS I LLSHIF /GO DO A TRIPLE PRECISION LEFT SHIFT TAD L37 /AND SUBTRACT ONE FROM THE EXPONENT TAD C7770 /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED SPA /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW JMP ERR12 /BY-BY NUMBER TOO LARGE FOR THE MACHINE DCA L37 JMP DA / THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ C7773, 7773 X7725, 7725 X17, 17 C7770, 7770 LPOLIS, POLISH LFRET, FRET C2440, 2440 LLSHIF, LSHIFT SCODE, CDF 10 /SHIFT S-CODE 2 COLS. LEFT TAD I (TEM1 CDF 0 DCA SLOC1 TAD SLOC1 IAC DCA SLOC2 ISZ L61 /SET COMMENT FLAG SCODL, TAD I SLOC2 DCA I SLOC1 TAD I SLOC2 AND C77 SNA CLA /END OF LINE? JMP I (STORSL+2 ISZ SLOC1 ISZ SLOC2 JMP SCODL /AND CONTINUE PROCESS SLOC1, 0 SLOC2, 0
*2000 XSAVE, 0 /-- THE F.P. AC IS IN LOCS 30-32 TAD L30 /-- THE "MQ" IS IN LOCS 33-35 DCA L33 /---THE EXPONENT IS IN LOCS 37 TAD L31 DCA L34 TAD L32 DCA L35 JMP I XSAVE / SHIFTS THE PSEUDO-ACC LEFT ONE PLACE LSHIFT, 0 CLA CLL TAD L32 RAL DCA L32 TAD L31 RAL DCA L31 TAD L30 RAL DCA L30 JMP I LSHIFT / THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC ADD, 0 CLA CLL TAD L32 TAD L35 DCA L32 RAL TAD L31 TAD L34 DCA L31 RAL TAD L30 TAD L33 DCA L30 JMP I ADD / THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE RSHIFT, 0 CLA CLL TAD L30 RAR DCA L30 TAD L31 RAR DCA L31 TAD L32 RAR DCA L32 JMP I RSHIFT / / MULT, 0 /ACCCACC*10 MQ JMS RSHIFT JMS XSAVE JMS RSHIFT JMS RSHIFT JMS ADD /THIS FINISHES THE MULT BY 10 TAD L37 /NOW DIDDLE THE EXPONENT TAD C40 SPA /OVERFLOW TEST ERR14, JMS I LUNCH /FLOATING POINT OVERFLOW DCA L37 JMS I LNRMAL /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO JMP I MULT DIVIDE, 0 /DIVIDE THE F P NUMBER BY 10 JMS RSHIFT /BASED ON THE FACT THAT .1 BASE 10 C .000110011 JMS XSAVE /THAT IS WE MULTIPLE BY ONE TENTH TAD C7766 /THIS IS A COUNTER********************** DCA ZCTR DB, JMS RSHIFT JMS ADD ISZ ZCTR SKP JMP DC JMS RSHIFT JMS RSHIFT JMS RSHIFT JMS ADD JMP DB DC, TAD L37 TAD C7750 /********INSERT HERE THE CONSTANT************ DCA L37 /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP JMS I LNRMAL /MAKE SURE IT IS STILL NORMALIZ D JMP I DIVIDE ZCTR, 0 MUL10, 0 /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E JMS LSHIFT /BY 10 JMS XSAVE JMS LSHIFT JMS LSHIFT JMS ADD TAD L36 /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH DCA L35 /* DCA L34 DCA L33 JMS ADD /AND ADD IT TO THE ACC JMP I MUL10 /IN OTHER WORDS ACCCACC*10 DIGIT POLISH, CLA CLL /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT. TAD C400 /AND PUTS THEM INTO 7090 FORM. THIS IS THE R-U DCA L35 /27 DIGITS DCA L34 /ROUND FACTOR IS CRAMED INTO THE MQ DCA L33 JMS ADD /AND ADDED TO THE INTEGER IN THE ACC SNL /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY JMP POLSH /WE DIDNT TAD C4000 /SET THE ACC TO .1000000000 (THE REST OF IT IS DCA L30 TAD L37 /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N TAD J10 SNA JMP ERR14 /EXPONENT OVERFLOW ... DCA L37 POLSH, TAD C7767 /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES DCA ZCTR /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E HOOP, JMS RSHIFT ISZ ZCTR JMP HOOP TAD L37 /CRAM THE EXP TAD L30 /INTO THE ACC DCA L30 /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX JMP I .+1 FRET LNRMAL, NORMAL C7766, 7766 C7750, 7750 C400, 400 J10, 10 C7767, 7767
*2200 / THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER LSTMT, 0 JMS I CLEAR /CLEAR THE PSEUDO ACC AND MQ TAD C4000 /DON'T LET LGTC GET ANOTHER LINE YET DCA CHK IAC DCA KOUNT LABEL, JMS I GTCL /GET A CHARACTER SNA /IS THIS A CAR RET? ERR15, JMS I LUNCH /YES, INCOMPLETE STATEMENT TAD CM40 SNA /SPACE? JMP SPACE TAD CM32 CLL TAD C12 SNL / 260 <= CHAR < 272 ? ERR16, JMS I LUNCH DCA L36 /SAVE THIS DIGIT... JMS I MULT10 / ACC = 10 * ACC + L36 SPACE, TAD KOUNT TAD DM6 SPA CLA /ENE OG sTMt NR FIELD? JMP LABEL /NOT YET... JMS I GTCL /SKIP OVER COL 6 SNA CLA /IS IT A CAR RET? JMP ERR15 TAD L31 /SEE IF STMT NR IS LEGAL... SZA JMP ERR16 TAD L32 SPA CLA /IS STMT NR < 2048 ? JMP ERR16 /NO, STMT NR TOO BIG JMP I LSTMT CLEAR, LCLEAR GTCL, LGTC MULT10, MUL10 CM32, -32 DM6, -6 C12, 12 / / SUBROUTINEE TO PRINT A SYMBOL / / JMS I PRSYM / LPRSYM, 0 /THIS ROUTINE PRINTS SYMBOLS DCA LCH TAD LCH SMA /IS IT AN INTEGER CONSTANT JMP ICON /YES PROCESS IT RTL /SHIFT THE NEXT BIT INTO THE LINK SNL /IS IT A TEMPORARY JMP TEMPO /ITS A TEMPORARY RTR /RESTORE THE SYMBOL CIA /SET IT NEGATIVE TAD L47 /SUBTRACT THE BEGINNING OF THE XFCON TABLE SPA CLA /DO WE HAVE AN FCON JMP XFCON /YES PROCESS IT TAD LCH TAD C2 /ADD TWO TO THE SYMBOL TABLE POINTER DCA LP2 /AND SAVE IT TAD I LP2 /GET THE CONTROL BITS FOR THE SYMBOL RAR /GET EXTERNAL SUBROUTINE BIT IN LINK SZL CLA /IS THIS AN EXTERNAL SUBROUTINE JMP SKPIT /YES...DONT PUT OUT THE BACK SLASH TAD C34 JMS I PRINT SKPIT, TAD I LCH JMS LP2 /PRINT THEM ISZ LCH TAD I LCH JMS LP2 /AND PRINT THEM ISZ LCH TAD I LCH AND X7700 /MASK SO WE DONT PUT OUT CONTROL BITS JMS LP2 /AND PRINT IT JMP I LPRSYM /NOW RETURN LP2, 0 /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS DCA UNCH /SAVE THE CHARS TAD UNCH /GET THEM AGAIN RTR /ROTAT FIRST CHAR INTO POSITION RTR RTR AND C77 /MASK SECOND CHARACTER SZA /IS IT AN ACTUAL CHARACTER JMS I PRINT /YES PRINT IT TAD UNCH /GET THE TWO CHARS AGAIN AND C77 /MASK OUT FIRST CHARACTER SZA /IS IT ACTUALLY A CHARACTER JMS I PRINT /YES PRINT IT JMP I LP2 /AND RETURN ICON, CLA /INTEGER CONSTANT, PUNCH A '(' TAD K50 JMS I PRINT TAD LCH /AND THE NUMBER PROCT, JMS I PROTAC JMP I LPRSYM /RETURN TEMPO, RTL SPA CLA /SUBSCRIPT TEMPORARY? JMP SBSCR RTL TAD D33 /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT JMS I PRINT /AND PRINT IT TAD LCH SPA /DO WE STILL HAVE A TEMPORARY JMS I TEMPOR /YES GET THE TEMPORARY NUMBER JMS I PRINT /AND PRINT IT JMP I LPRSYM /RETURN SBSCR, TAD D33 /SUBSCRIPT TEMPORARY, PUNCH A '[' JMS I PRINT TAD LCH JMS I SUBTEM /AND 4 DIGITS JMP PROCT XFCON, TAD C35 /FLOATING POINT CONSTANT... JMS I PRINT /PUNCH A ']' TAD LCH CIA TAD L50 /SUBTRACT FROM END OF TABLE JMP PROCT D33, 33 C35, 35 K50, 50 C34, 34 X7700, 7700 LCH, 0 UNCH, 0 SUBTEM, LSBTEM TEMPOR, LTMPOR
*2400 / / SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS / C300, 300 C212, 212 C215, 215 SCOUNT, 0 /CURRENT NUMBER OF SYMBOLS XCTR, 0 /COUNTER FCOUNT, 0 /CURRENT NUMBER OF FCONS LSYMTB, 0 CLA /CLEAR THE AC LOOP1, TAD L56 /GET BEGINNING OF SYMBOL TABLE DCA LSYMTM /AND SAVE IN TABLE TAD SCOUNT /GET NUMBER OF SYMBOLS CURRENTLY CMA DCA XCTR /USE AS A COUNTER TAD C7700 /GIVE SEARCH A MASK TO USE ON LAST SYMBOL JMS SEARCH /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE JMP ZCHECK /SYMBOL IS IN TABLE CHECK IT TAD L57 /TELL ENTER WHERE TO PUT THE SYMBOL JMS ENTER /ENTER THE SYMBOL TAD C3 /UPDATE THE POINTER DCA L57 /AND SAVE IT DCA L21 /ZERO SWITCH SINCE SYMBOL JUST LOADED ISZ SCOUNT /UPDATE COUNT OF SYMBOLS JMP LOOP1 /GO BACK AND CHECK IT ZCHECK, TAD L77 /GET POINTER INTO SYMBOL TABLE TAD C2 /MOVE TO LAST WORD DCA LSYMTM /SAVE IT TAD I LSYMTM /GET THE CONTROL BITS AND L21 /AND THE MASK SZA CLA /ARE ANY ILLEGAL BITS ON ERR54, JMS I LUNCH /ERROR 54 ... PROBABLY IN EQUIVALENCING ... TAD L32 /NOW OR IN NEW BITS CMA AND I LSYMTM TAD L32 DCA I LSYMTM JMP I LSYMTB /RETURN / FLOATING CONSTANT IS IN 30 THRU 32 LFCON, 0 CLA MLOOP, TAD L47 /GET BEGINNING OF FCON TABLE TAD C3 /MOVE TO ACTUAL START OF TABLE DCA LSYMTM /AND SAVE TAD FCOUNT /GET NUMBER OF FCONS SO FAR CMA DCA XCTR /AND USE FOR A COUNTER CMA /GIVE SEARCH A MASK FOR THE LAST WORD JMS SEARCH /SEARCH THE TABLE FOR THE CURRENT FCON JMP I LFCON /ITS ALREADY IN THERE JUST RETURN TAD L47 /TELL ENTER WHERE TO PUT THE FCON JMS ENTER /ENTER THE FCON TAD CM3 /AND UPDATE IT DCA L47 /AND SAVE ISZ FCOUNT /UPDATE NUMBER OF FCONS JMP MLOOP /GO BACK AND CHECK / THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR / OCCURRENCES OF THE CURRENT SYMBOL OR FCON SEARCH, 0 DCA ENTER /SAVE THE MASK MBACK, ISZ XCTR /SEE IF WE HAVE PROCESSED ALL SYMBOLS SKP /NO GO ON JMP QRET /YES TAD I LSYMTM /GET FIRST WORD OF SYMBOL CIA /NEGATE TAD L30 /SUBTRACT FIRST WORD OF CURRENT SYMBOL ISZ LSYMTM /INCREMENT POINTER SZA CLA /DO THEY MATCH JMP I1 /NO GO TO NEXT SYMBOL TAD I LSYMTM /YES GET SECOND WORD OF SYMBOL CIA TAD L31 /SUBTRACT SECOND WORD OF CURRENT SYMBOL ISZ LSYMTM /ADVANCE POINTER SZA CLA /DO THEY MATCH JMP I2 /NO GO TO NEXT SYMBOL TAD I LSYMTM /SEE IF NEXT WORD MATCHES AND ENTER /MASK OUT DESIRED PORTIONS CIA TAD L32 /SUBTRACT THIRD CURRENT WORD AND ENTER /K AGAIN ISZ LSYMTM /ADVANCE POINTER SZA CLA /DO THEY MATCH JMP MBACK /NO GO TO NEXT SYMBOL TAD LSYMTM /YES TAD CM3 /MOVE BACK POINTYER DCA L77 /PUT POINTER IN PAGE ZERO JMP I SEARCH /RETURN QRET, ISZ SEARCH /SET UP RETURN FOR NOT FOUND JMP I SEARCH /RETURN I1, ISZ LSYMTM /ADVANCE POINTER I2, ISZ LSYMTM /ADVANCE PIINTER JMP MBACK /GO TO NEXT SYMBOL / THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED ENTER, 0 DCA LSYMTM /SAVE ADDRESS TAD L47 /GET BEGINNING OF FCON TABLE CMA TAD L57 /SUBTRACT END OF SYMBOL TABLE C7700, SMA CLA /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON ERR17, JMS I LUNCH /NO TAD L30 /YES GEYT FIRST WORD DCA I LSYMTM /STORE IT TAD LSYMTM DCA L11 /SET UP AUTO - XR TAD L31 DCA I L11 TAD L32 DCA I L11 TAD LSYMTM /GET THE ADDRESS BACK INTO THE AC JMP I ENTER /AND RETURN DUMPLN, DMPLIN LSYMTM=. LPRINT, 0 / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII DCA LFCON /SAVE THE CHARACTER TAD L75 /S GET THE SUPPRESS PRINTING WITCH SZA CLA JMP I LPRINT ISZ L24 /IS THIS A NEW LINE? SKP /NO JMS I DUMPLN /YES - DUMP THE OLD ONE FIRST TAD LFCON /NO...GET THE CHARACTER SNA /IS IT A CR JMP CRLF /YES...PUT OUT CRLF AND C40 /CHECK BIT SIX CLL RAL CIA /AC CONTAINS 0 OR -100 TAD C300 /NOW CONTAINS 300 OR 200 TAD LFCON /NOW ADD THE CHARACTER IN PRIT, DCA I L24 /AND STORE IT IN THE BUFFER JMP I LPRINT CRLF, TAD C215 /GET AN EIGHT BIT CR DCA I L24 /STORE IT IN THE BUFFER ISZ L24 TAD C212 DCA I L24 /STORE A LINE FEED TOO CLA CMA DCA L24 /SET SWITCH TO DUMP LINE ON NEXT CHAR JMP I .+1 PRIT+1
LCOMON, CLA JMS I LOOK /CHECK REST OF STATEMENT NAME -2 /TWO CHARACTERS -17 /O -16 /N GETVAR, JMS I ENTITY /GET A VARIABLE SKP /NOT A VARIZBLE JMP VARI /WE GOT A VARIABLE NOP B20, 20 ERR18, JMS I LUNCH /ERROR VARI, TAD C40 TAD L32 /PUT IN COMMON BIT DCA L32 TAD K37 /GET MASK FOR SYMBOL TABLE SWITCH DCA L21 /PUT IN THE SWITCH JMS I SYMTAB /PUT SYMBOL IN TABLE JMS I ENTITY /LOOK FOR A COMMA JMP START /THAT'S ALL GOT A CR-LF... K37, 37 K27, 27 JMP .+3 /ERROR TAD CM54 /CHECK FOR COMMA SZA CLA /IS IT A COMMA JMP ERR18 /NO...ERROR JMP GETVAR /GET ANOTHER VARIABLE LDIMEN, JMS I LOOK /LOOK FOR REST OF STATEMENT -5 /FIVE CHARS -16 /N -23 /S -11 /I -17 /O -16 /N QAGAIN, CLA CMA /-U DCA REDY /SET SWITH FOR VARIABLE QGET, JMS I ENTITY /GET WHATEVER IS NEXT IN LINE JMP QDONE /IT EAS A CR JMP .+4 /IT WAS A VARIABLE JMP ASUBSC /IT WAS ONE OF THE SUBSCRIPTS JMP ERR18 /WE BETTER NOT GET ANY FP NUMBERS JMP QPUNC /IT WAS A PUNCTION ISZ REDY JMP ERR18 /WE WERENT READY FOR A VAR TAD B20 TAD L32 DCA L32 TAD K27 /GET THE MASK FOR THE SYMBOL TABLE DCA L21 /PUT IN THE SWITCH JMS I SYMTAB /PUT SYMBOL IN TABLE CMA CLA TAD L47 /GET BEGINNING OF TABLE DCA L16 TAD L77 /GET TABLE ADDRESS DCA I L16 CLA CMA DCA V /SET)W@TCH TO SAY WEVE GOTTEN A VAR JMP QGET /GET NEXT THING QPUNC, TAD CM54 SNA /IS IT A COMMA JMP COMMA /YES TAD C3 SNA JMP QRPAR /RIGHT PAREN IAC SNA /IS IT A LEFT PAREN ISZ V /PRECEDED BY A VAR JMP ERR18 /NO - ERROR CLA CMA DCA XLP /SET SWITCH TO SHOW LPAR JMP QGET ASUBSC, ISZ XLP /DID WE JUST GET LPAR JMP SECOND /NO...BETTER BE SECOND SUBSC TAD L32 /GET INTEGER DCA I L16 /PUT IN DIMTAB CMA CLA DCA QONE /SET SWITCH TO SHOW WE HAVE ONE SUBSC JMP QGET COMMA, ISZ QONE /DOES THIS COMMA SEPARATE SUBSCS JMP RIGHT /NO...LAST CHAR BETTER HAVE BEEN L RPAR CMA CLA DCA SEC /SET SWITCH TO EXPECT SECOND SUBSCRIPT JMP QGET SECOND, ISZ SEC /IS THIS SECOND SUBSCRIPT JMP ERR18 /NO...ERROR TAD 32 /GET INTEGER DCA I L16 CMA CLA DCA R /SET SWITCH FOR RPAR JMP QGET QRPAR, ISZ QONE /HAVE WE GOTTEN ONE SUBSC JMP QTWO /NO...CHECK FOR TWO IAC /ONLY ONE SO USE 1 AS SECOND DCA I L16 QBACK, CMA CLA DCA RIG TAD L47 /GET BEGINNING OF TABLE DCA L50 /SAVE IN LOW CORE TAD L47 TAD CM3 /SUBTRACT THREE FROM ADDRESS DCA L47 /AND SAVE JMP QGET /WE EXPECT COMMA OR CR QTWO, ISZ R /HAVE WE GOTTEN TWO JMP ERR18 /NO...ERROR JMP QBACK RIGHT, ISZ RIG /DID WE JUST GET RPAR JMP ERR18 /NO...ERROR JMP QAGAIN QDONE, ISZ RIG JMP ERR18 JMP START QONE, 0 RIG, 0 R, 0 REDY, 0 V, 0 XLP, 0 SEC, 0
*3000 LGOTO, TAD L74 DCA L16 /USE AUTO INDEXING DCA L76 JMS I ENTITY NOP SKP JMP ALAB /WE HAVE A LABEL JMP I ASSIGN TAD CM50 /IF PUNCT...CHECK FOR LEFT PAREN SZA CLA /IS IT ( JMP I ASSIGN ANEXT, JMS I ENTITY NOP SKP JMP THERE /WE HAVE A LABEL NOP ERR28, JMS I LUNCH THERE, TAD L32 /GET THE LABEL DCA I L16 /PUT IN LIST ISZ L76 JMS I GNB TAD CM54 /CHECK FOR BEING A COMMA SNA /IS IT A COMMA JMP ANEXT /YES GET ANOTHER LABEL TAD C3 /CHECK FOR BEING A RIGHT PAREN SZA CLA /IS IT A ) JMP I ASSIGN JMS I GNB TAD CM54 /CHECK FOR ANOTHER COMMA SZA /IS IT ANOTHER JMS I PUTCH /IGNORE ANYTHING ELSE ... JMS I ENTITY /GET THE CONTROL VARIABLE SKP JMP .+4 /WE GOT IT NOP NOP ERR29, JMS I LUNCH DCA L21 /ZERO THE SYMBOL TABLE SWITCH JMS I SYMTAB /PUT VARIABLE IN SYMBOL TABLE TAD L77 /GET ADD RESS OF SYMBOL JMS I MODE /CHECK THE MODE OF THE VAIABLE ERR30, JMS I LUNCH /ITS FLOATING POINT JMS I ZZZ /PUT OUT STMT LABEL JMS LXTAD /LOAD VARIABLE WITH TAD OR TAD* JMS I PROP /PUT OUT OP CODE Q6066, 6066 /OP CODE IS TAD JMS I CREATE /GET THE NEXT CREATED LABEL JMS I PRCRL /PRINT THE CREATED LABEL JMS I PRINT /PUT OUT CR LF JMS I PROP /PUT OUT OP CODE 6071 /OP CODE IS DCA TAD GO7 JMS I PROTAC JMS I PRINT /PUT OUT CRLF JMS I PROP /PUNCH 'TAD I 7' OPTADI TAD GO7 JMS I PROTAC JMS I PRINT JMS I PROP /PUNCH 'DCA 7' OPDCA TAD GO7 JMS I PROTAC JMS I PRINT JMS I PROP /PUNCH 'JMP I 7' OPJMPI TAD GO7 JMS I PROTAC JMS I PRINT TAD L76 /PUNCH 'CPAGE <N+1>' IAC JMS I PIFF TAD L53 /PUNCH '<CR.LABEL2>, <CR.LABEL2>' JMS I CLAB TAD L53 JMS I PRCRL JMS I PRINT TAD L76 /NOW PUNCH THE LABELS CIA /SET NEGATIVE DCA L76 TAD L74 DCA L16 /USE AUTO INDEXING AGAIN TAD I L16 /GET THE NEXT LABEL JMS I PLAB /PRINT THE LABEL JMS I PRINT /PUT OUT CRLF ISZ L76 JMP .-4 /NO JMP START / THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S ALAB, JMS I ZZZ TAD L32 JMS PRJUMP /PUT OUT A JUMP TO THE LABEL IN "L32" JMP START LXTAD, 0 TAD L77 /GET ADDRESS AGAIN JMS I DUMARG TAD CM3 TAD Q6066 /TAD OR TAD* DCA OP /USE AS OPERATOR JMS I PROP /PUT OUT OP CODE OP, 0 TAD L77 /GET ADDRESS AGAIN JMS I PRSYM /PRINT THE SYMBOL JMS I PRINT /PUT OUT A CR LF JMP I LXTAD LLEAD, 0 /PUNCH SOME LEADER... DCA L7 JMS I PUNCH ISZ L7 JMP .-2 JMP I LLEAD GO7, 7 PRJUMP, 0 /SUBROUTINE TO PUT OUT A JUMP DCA LLEAD /STORE THE LABEL JMS I PROP 6044 /JMP TAf LLEAD JMS I PLAB /PUT OUT THE LABEL JMS I PRINT /PUT OUT A CRLF TAD LLEAD DCA L12 /SET CONTENTS OF LAST LINE TO LABEL JMP I PRJUMP
*3200 / THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS LPRTAC, 0 DCA TMP /SAVE THE NUMBER DCA TM TAD CM4 /PUT OUT FOUR CHARACTERS DCA DCTR /CHARACTER COUNTER BK, TAD TMP /GET THE NUMBER RAL /ROTATE IT LEFT ONE RTL /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT DCA TMP /SAVE THE ROTATED NUMBER TAD TMP /GET IT IN ACCUMULATOR AND C3 RAL /GET THE DIGIT INTO THE LOW-ORDER AC ISZ DCTR /IS THIS THE LAST DIGIT? JMP .+4 /NO, CONTINUE TAD C60 /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT JMS I PRINT /PRINT THE DIGIT JMP I LPRTAC SZA /DO WE HAVE A ZERO DIGIT? JMP .+4 TAD TM SNA CLA /YES, IS IT A LEADING ZERO? JMP BK /YES, IGNORE IT TAD C60 JMS I PRINT ISZ TM /DON'T SUPPRESS ZEROS ANY MORE JMP BK /NOW...PUT OUT ANOTHER TMP, 0 TM, 0 CM4, -4 C60, 60 LIF, TAD CM4 DCA COUNT1 /SET UP COUNTER JMS I GNB TAD CM50 /CHECK FOR LEFT PAREN SZA CLA /IS IT A ( JMP I ASSIGN JMS I PUTCH /YES...PUT IT BACK FOR GENER JMS I ZZZ ISZ L52 /SET BALANCED PARENS SWITCH FOR GENER ISZ L44 /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN JMS I GENER /NOW CALL GENER AND PROCESS EXPRESSION TAD I L41 JMS I MODE /WHAT IS ITS MODE JMS I GETHI /GET HI ORDER P.P. AC TAD CDCA41 DCA LIFDCA /SET UP INSTRUCTION TO STORE LABELS LABL, JMS I ENTITY /GET A LABEL D34, 34 SKP JMP INTEG /WE GO A LABEL C46, 46 ERR31, JMS I LUNCH /DIDNT GET A LABEL INTEG, TAD L32 /GET THE LABEL ISZ LIFDCA LIFDCA, .-. /STORE LABELS IN L42 THROUGH L44 DCTR=LIFDCA ISZ COUNT1 /HAVE WE GOTTEN TOO MANY LABELS SKP /NO JMP ERR31 /YES JMS I GNB SNA /SEE IF ITS A CR JMP .+5 /ITS A CR TAD CM54 /CHECK FOR COMMA SZA CLA /IS IT A COMMA JMP ERR31 JMP LABL /YES ISZ COUNT1 /DID WE GET THE RIGHT NUMBER OF LABELS JMP ERR31 /NO TAD L42 CIA TAD L44 SNA CLA /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL JMP ISPECL /WE CAN SAVE SOME CODE TAD L43 CIA TAD L44 SNA CLA /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL JMP SPCONL /WE CAN ALSO SAVE SOME CODE JMS I PROP /PUT OUT OP CODE 6105 /OP CODE IS SNA JMS I PRINT /PUT OUT CRLF TAD L43 JMS I PRJMP /OUTPUT THE ZERO BRANCH SPCONL, JMS I PROP /PUT OUT OP CODE 6110 /OP CODE IS P SPA CLA JMS I PRINT /PUT OUT CRLF TAD L42 /OUTPUT THE NEGATIVE BRANCH IFCOMN, JMS I PRJMP TAD L44 JMS I PRJMP /OUTPUT THE POSITIVE (>0) BRANCH DCA L46 /ZERO AC JMP START /GO GET NEXT STATEMENT ISPECL, JMS I PROP /PUNCH 'SNA CLA' OPSNA JMS I PROP OPCLA JMS I PRINT TAD L43 JMP IFCOMN /OUTPUT THE ZERO AND POSITIVE BRANCHES PRJMP, PRJUMP COUNT1, 0 LCREAT, 0 ISZ L53 /INCREMENT BY ONE... TAD L53 AND C77 TAD CM33 SMA CLA /HAVE WE BEEN HERE 26 TIMES? TAD C46 /YES, BUMP THE HIGH ORDER DIGIT TAD L53 DCA L53 /AND SAVE TAD L53 /NOW RETURN IT IN AC JMP I LCREAT /RETURN LPLAB, 0 /THIS PRINTS REGULAR LABELS DCA TMP /FIRST SAVE LABEL TAD D34 /NOW PUNCH A '\' JMS I PRINT TAD TMP /GET LABEL JMS I DECOUT /AND PRINT IT JMP I LPLAB /RETURN GETHI, LGETHI CDCA41, DCA L41 CM33, -33 DECOUT, LDCOUT
*3400 DORET, JMP I XDO ISZDO, JMS I PROP 6237 /INC TAD L30 JMS I PRSYM JMS I PRINT JMP DOSUBT /GO GENERATE THE LIMIT TEST NUMB, 0 SWIT, 0 DM5, -5 CM24, -24 C5001, 5001 LEQI, EQI LDO, JMS I ZZZ JMS I ENTITY /LOOK FOR THE SCOPE LABEL C55, 55 SKP JMP SLAB /WE GOT THE SCOPE LABEL E53, 53 JMP I ASSIGN SLAB, TAD L32 /GET THE INTEGER JMS XDO /PUT OUT DO-LOOP CODE JMP START /NORMAL EXIT JMP ERR35 /IMPLIED DO EXIT - ERROR XDO, 0 /DO LOOP SUBROUTINE - ENTERED WITH /TARGET LABEL IN AC DCA I L15 /PUT IN DO END PUSH DOWN LIST TAD L74 DCA L16 /SET UP LIST OF DO ENDS DCA L21 /ZERO THE SYMBOL TABLE SWITCH CMA CLA DCA SWIT /SET SWITCH FOR CONTROL VARIABLE TAD DM5 DCA NUMB /SET COUNTER OF NUMBER OF PARAMETERS GETMOR, JMS I ENTITY /LOOK FOR A PARAMETER JMP .+3 /ERR JMP CVAR /GOT A VARIABLE JMP DPAR /GOT AN INTEGER C21, 21 JMP ERR35 CVAR, JMS I SYMTAB /PUT SYMBOL IN TABLE TAD L77 /GET ADDRESS JMS I MODE /DETERMINE MODE OF SYMBOL JMP ERR35 TAD L77 /GET ADDRESS AGAIN DOSTOR, DCA I L16 /SAVE ISZ NUMB /HAVE WE GOTTEN TOO MANY PARAMS SKP /NO ERR35, JMS I LUNCH /YES, DO ERROR ... JMS I GNB SNA /IS IT CR JMP ALLDNE+1 /YES WERE DONE TAD CM51 SNA /IS IT A RIGHT PAREN? JMP ALLDNE /YES-FINISH UP AND TAKE IMPLIED DO EXIT TAD CM24 SZA /IS IT = JMP MCOM /NO ISZ SWIT /IS SWITCH SET FOR IT JMP ERR35 /NO JMP GETMOR /YESS...GO BACK FOR ANOTHER PARAMETER MCOM, TAD C21 /CHECK FOR COMMA ISZ SWIT /IF NO EQUAL SIGN YET SZA /OR IF THIS ISN'T A COMMA JMP ERR35 /THEN ITS AN ERROR JMP GETMOR /GET ANOTHER DPAR, TAD L32 /GET THE INTEGER ISZ SWIT /HAVE WE SEEN AN EQUAL SIGN? JMP DOSTOR /YES - SAVE THE INTEGER AND PROCEED JMP ERR35 /NO ALLDNE, ISZ XDO /BUMP RETURN POINTER IF TERMINATOR WAS RPAR CLA IAC DCA I L16 /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT TAD C2 TAD NUMB SPA CLA /DID WE GET AT LEAST THREE ARGS? JMP ERR35 /NO ISZ L44 TAD L74 /GET ERASABLE LOCATIONS DCA L16 /USE THE AUTO INDEX REGISTERS TAD I L16 /GET CONTROL VARIABLE DCA L30 /AND PUT IN THIRTY TAD I L16 /GET INITIAL VALUE DCA L31 /AND SAVE IT TAD I L16 /GET FINAL VALUE DCA L32 /AND SAVE IT TAD I L16 /GET INCREMENT DCA L33 /AND SAVE IT TAD L74 /GET ADDR OF ERASABLE AGAIN IAC /INCREMENT ONCE DCA L41 /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES TAD L74 /GET IT AGAIN DCA L16 /USE AUTO INDEX TO STORE TRIPLE DCA L46 /ZERO THE AC TAD C5001 /SET UP INITIAL TRIPLE NUMBER DCA L40 TAD L33 CIA TAD L31 SNA CLA /IF INITIAL VALUE = STEP SIZE JMP STCTLV /NO NEED TO COMPUTE THE DIFFERENCE TAD L33 /GET STEP SIZE DCA I L16 /PUT IN TRIPLE TAD C55 /PUT IN A MINUS SIGN DCA I L16 TAD L31 /GET INITIAL VALUE DCA I L16 JMS I TRIPL /PROCESS THE TRIPLE STCTLV, JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE JMS I CLAB /PUT A CDREATED LABVEL ON THE NEXT STATEMENT TAD L53 /GET THE CREATED LABEL DCA I L15 /AND PUT IN DO END LIST TAD L74 DCA L16 TAD L33 /GET STEP SIZE CLL RAR SNA /IF STEP SIZE=1 THEN JMP ISZDO /WE CAN USE AN ISZ TO INCREMENT RAL DCA I L16 TAD E53 /WERE GOING TO ADD DCA I L16 / L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI" JMS I TRIPL /ADD STEP SIZE TO CONTROL VARIABLE JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE DOSUBT, TAD L74 DCA L16 TAD L30 /GET THE CONTROL VARIABLE DCA I L16 TAD C55 /WERE GOING TO SUBTRACT DCA I L16 TAD L32 /GET FINAL VALUE DCA I L16 JMS I TRIPL /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
DCA L46 /CLEAR THE AC FLAG JMS I PROP 6110 /SPA CLA JMS I PRINT JMS I PROP 6044 /PUT OUT A JMP JMS I CREATE /TO A CREATED LABEL DCA I L15 /PUT CREATED LABEL IN DO END LIST TAD L53 /GET LABEL JMS I PRCRL /AND PRINT IT JMS I PRINT /CRLF ISZ L55 /INCREMENT UNENDED DO COUNTER SKP ERR38, JMS I LUNCH /TOOO MANY UNENDED DOS JMP I .+1 DORET /RETURN FROM SUBROUTINE "XDO" EQI, 0 TAD L74 DCA L16 TAD L46 /GET RESULT OF PREVIOUS COMPUTATION DCA I L16 TAD E75 /GET EQUALS SIGN DCA I L16 TAD L30 /GET CONTROL VARAIBLE DCA I L16 JMS I TRIPL /PROCESS DCA L46 /WIPE AC SWITCH JMP I EQI /RETURN LFUNCT, 0 DCA ARGCNT TAD L46 /GET AC SZA CLA /IS IT ZERO JMS I STORE /NO...STORE THE AC TAD L53 /GET CURRENT CREATED LABEL DCA L73 /AND SAVE CLA CMA /AC IS MINUS ONE TAD L41 /PUSH LIST POINTER DCA L42 /PUSH LIST POINTER MINUS ONE CKFNCT, ISZ L42 /INCREMENT POINTER ISZ L42 /AGAIN TAD I L42 /GET THE OPERATOR TAD CM4047 /SUBTRACT THE FUNCTION OPERATOR SZA /IS THIS THE FUNCTION OPERATOR JMP CKSBSC /NO CLA IAC /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO TAD L42 /THIS POINTS TO IT DCA SAVE /AND SAVE TAD I SAVE TAD C2 DCA EQI TAD I EQI AND CM2 IAC DCA I EQI MOR, CLA CMA /NOW EXAM THE ARGUMENTS TAD L42 /WERE POINTING TO THE FIRST ARGUMENT DCA L42 /SAVE THE POINTER ISZ ARGCNT JMS I LCHNG /CHECK L42 FOR ZERO OR DUMMY ARG DCA I L42 /REPLACE IT BY UPDATED VALUE TAD L42 /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT CIA TAD L41 /SUBTRACT THE END OF ARGUMENT LIST SNA CLA /IS IT ZERO JMP OUT /YES...WE'VE COMPLETED THIS PHASE CLA CMA /NO...MOVE THE POINTER BACK ONE TAD L42 DCA L42 /AND SAVE JMP MOR /NOW CHECK THE NEXT ARGUMENT OUT, TAD SAVE /GET THE POINTER TO THE FUMCTION NAME AGAIN DCA L42 /AND PUT IN 42 TAD I L42 /GET THE ARGUMENT DCA FUNOP /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION TAD ARGCNT /GIVE FPROP THE NUMBER OF ARGUMENTS JMS I FPROP /PUT OUT THE CALL TO THE FUNCTION FUNOP, 0 TAD L73 /NOW RESTORE THE CREATED LABEL LOCATION DCA L53 MNEXT, TAD L42 /GET THE POINTER TAD CM2 /MOVE POINTER TO ARGUMENT DCA L42 /AND SAVE TAD I L42 /GET NEXT ARGUMENT JMS I PSYMOT /GENERATE AN "ARG" FOR THE ARGUMENT TAD L42 /GET THE POINTER CIA /SET IT NEGATIVE TAD L41 /ADD SZA CLA /ARE THEY EQUAL JMP MNEXT /NO THERE ARE MORE ARGS TAD I SAVE /YES...GET THE FUNCTION NAME JMS I MODE /WHAT MODE IS IT TAD E400 /ITS FLOATING POINT TAD L40 /ITS INTEGER DCA L46 /PUT THE TRIPLE NUMBER IN THE AC SWITCH TAD SAVE /YES...CHANGE PUSH LIST POINTER DCA L41 /STORE POINTER TO NAME IN PUSH LIST POINTER TAD L46 /GET CURRENT TRIPLE NUMBER DCA I L41 /AND PUT IT IN THE PUSH LIST JMP I LFUNCT /RETURN CKSBSC, IAC SZA CLA /IS IT THE SUBSCRIPT OPERATOR? JMP CKFNCT /NO - KEEP LOOKING JMP I .+1 ERR39 PSYMOT, SYMOUT SAVE, 0 ARGCNT, 0 E75, 75 CM4047, -4047 E400, 400 TAD C47 JMS I PPACK LQUOTE, JMS I PGTC /GET A CHARACTER SNA ERR37, JMS I LUNCH /CARRIAGE RETURN - ERROR TAD CM47 SZA JMP LQUOTE-2 /IF NOT A QUOTE, STORE IT JMP I .+1 FRET C47, 47 CM47, -47 PGTC, LGTC PPACK, PACK
*4000 LCONT, JMS I LOOK /CHECK REST OF LINE -4 /LOOK FOR FOUR CHARACTERS -11 /I -16 /N -25 /U -5 /E JMS I ZZZ JMS I PROP /PUNCH 'NOP' 6047 JMS I PRINT /PUT OUT A CRLF JMP START /GO GET NEXT STATEMENT LPAUSE, JMS I LOOK /CHECK REST OF STATEMENT TYPE -1 /JUST ONEiChARACTER -5 /E CLA CMA LSTOP, DCA SW /SET SWITCH FOR STOP OR PAUSE DCA L32 JMS I ENTITY /LOOK FOR THE OPTIONAL INTEGER JMP MCR /WE GOT A CR SKP /ERR JMP .+3 /WE GOT AN INTEGER NOP /ERR JMP I ASSIGN MCR, JMS I ZZZ ISZ SW /PAUSE OR STOP? JMP STOP JMS I FPROP /PUNCH 'CALL 0,CKIO' 6116 JMS I PROP /PRINT OP CODE 6066 /OPCODE IS TAD TAD L32 /GET THE INTEGER JMS I PRSYM /PRINT IT JMS I PRINT /CR JMS I PROP 6121 JMS I PRINT JMS I PROP 6124 JMS I PRINT /PUT OUT CRLF JMP START /GO GET NEXT STATEMENT STOP, JMS OSTOP JMP START OSTOP, 0 /PUNCH 'CALL 0,CKIO' JMS I FPROP 6116 JMS I CLAB /PUNCH '<LAB>, HLT' JMS I PROP 6121 JMS I PRINT JMS I PROP /PUNCH 'JMP <LAB>' 6044 TAD L53 JMS I PRCRL JMS I PRINT JMP I OSTOP SW, 0 LFRMAT, JMS I LOOK /CHECK REST OF STATEMENT TYPE -2 /TWO CHARACTERS -1 /A -24 /T ISZ OSTOP TAD L74 DCA L10 DCA L76 JMS I PROP 6044 JMS I CREATE JMS I PRCRL JMS I PRINT JMS I GNB /READ UNTIL A PAREN IS GOTTEN TAD CM50 /SUBTRACT A ( SZA CLA /IS IT A ( ERR39, JMS I LUNCH /NO...ILLEGAL CHARACTER TAD C50 /GET A LEFT PAREN JMP PAREN /AND GO START COUNTING PARENS AGAIN, JMS I GTC SNA /IS IT A CR JMS I PUTCH PAREN, RTL CLL /SHIF CHAR LEFT RTL RTL DCA L32 /SAVE THE CHAR JMS I GTC SNA /IS IT A CR DCA OSTOP TAD L32 /PACK THE TWO CHARS DCA I L10 ISZ L76 TAD OSTOP /GET BALANCED PAREN SWITCH SZA CLA /ARE THEY BALANCED JMP AGAIN /NO GET SOME MORE CHARS TAD L76 JMS I PIFF TAD L74 DCA L10 TAD L76 CIA DCA L76 JMS I ZZZ TAD I L10 JMS I PROTAC JMS I PRINT ISZ L76 JMP .-4 TAD L53 /PUNCH '<LABEL>,' JMS I CLAB JMS I PRINT JMP START GTC, LGTC PXSUBR, XXSUBR C50, 50 LPIFF, 0 /PUNCH 'IFF <N>' DCA LZZZ /ENTER WITH N IN THE AC JMS I PROP 6102 TAD LZZZ JMS I PROTAC JMS I PRINT JMP I LPIFF LZZZ, 0 /PUNCH THE CURRENT LABEL, IF ANY TAD L54 SNA /IS THERE A LABEL? JMP ZZZRET /NO JMS I PLAB /PUNCH '<LABEL>, ' TAD C7240 JMS I P2 ZZZRET, DCA I PXSUBR /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL JMP I LZZZ
*4200 LTRIPL, 0 JMS I XZQL /FIRST CHECK IF A TRIPLE IS LEGAL HERE TAD L41 /GET PUSH LIST POINTER IAC /INCREMENT TO POINT TO OPERATOR DCA L42 /OPERATOR POINTER TAD L42 /GET IT AGAIN IAC /INCREMENT IT DCA L43 /OPERAND TWO POINTER TAD I L42 /GET OPERATOR AND C77 /MASK GARBAGE BITS TAD CM41 /SUBTRACT AN ADD INDIRECT OPERATOR SNA CLA /IS OPERATOR <DOLLAR> JMP I LADDIN /YES PROCESS IT TAD I L43 /NO...GET OPERAND TWO JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT SKP /YES IT IS JMP CK2 /NO ..CHECK THE OTHER ARGUMENT TAD I L42 /YES GET THE OPERATOR AND C77 /MASK GARBAGE BITS TAD EM75 /IS IT AN EQUALS SIGN SNA /IS OP C JMP LEQUIN /YES USE C* IAC /SEE IF ITS ALREADY EQUALS INDIRECT SZA CLA /IS OP C* JMS I LDUMTW /YES TWO IS DUMMY ARG CK2, CLA TAD I L41 /NO IS OPND ONE A SYMBOL JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT JMS I LDUMON /IT IS CLA CLL /NOW LETS SEE WHAT THE OPERATOR IS TAD I L42 /GET THE OPERATOR AND C77 /MASK OUT GARBAGE BITS TAD CM53 SNA /IS IT JMP I LAADD /YES IAC SNA /IS IT * JMP I LMUL /YES TAD CM3 SNA /IS IT - JMP I LASUB /YES TAD CM2 SNA /IS IT / JMP I LDIV /YES TAD CM16 SNA /IS IT C JMP I LEQU /YES IAC SNA /IS IT C* JMP I LEIND /YES TAD J27 SNA /IS IT ** JMP I LEXP /YES TAD C2 SNA /IS IT A UNARY MINUS JMP I LUMIN /YES ERR40, JMS I LUNCH /NO BETTER COP OUT LDMARG, 0 SMA /IS HIGH ORDER BIT ON JMP INC /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER RAL /GET NEXT BIT SMA /IS IT ON JMP MAYBE /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH RAR /YES...RESTOR THE PARAMETER CIA /SET IT NEGATIVE TAD L47 /SUBTRACT IT FROMTHE START OF THE FCON TABLE SPA /IS THE RELULT POSITIVE JMP INC /NO...ITS AN FCON NOT A SYMBOL CIA /YESS...RESTORE ORIGINAL PARAMETER TAD L47 TAD C2 /YES MOVE POINTER TO CONTROL BITS DCA L23 /SAVE TAD I L23 /GET THE CONTROL BITS AND C10 /MASK ALL BUT DUMMY ARG BIT OUT INC1, SNA CLA /IS THIS SYMBOL. A DUMMY ARG INC, ISZ LDMARG /NO...INCREMENT THE RETURN CLA /CLEAR THE ACCUMULATOR JMP I LDMARG /AND RETURN MAYBE, AND F400 /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER JMP INC1 /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG ARET, JMP I LTRIPL /THIS IS THE RETURN FROM TRIPLE LEQUIN, TAD C74 DCA I L42 /SET OP TO =* JMP CK2 C74, 74 / / THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT LLOOK, 0 JMS GLOOK /GET CHARACTER COUNT DCA LTRIPL ABACK, JMS I GNB JMS GLOOK /ADD IN THE TEST CHAR SZA CLA /WERE THEY EQUAL JMP I ASSIGN /NO...IT MUST BE AN ASSIGNMENT STATEMENT ISZ LTRIPL /THEY MATCH...ARE WE DONE JMP ABACK /NO JMP I LLOOK /RETURN GLOOK, 0 CDF 10 TAD I LLOOK ISZ LLOOK CDF 00 JMP I GLOOK / LAADD, AADD LADDIN, ADDIND LASUB, ASUB LEQU, EQU LEIND, EIND LEXP, EXP LUMIN, UMIN CM41, -41 EM75, -75 LDUMTW, DUMTWO CM16, -16 C10, 10 F400, 400 LDUMON, DUMONE CM53, -53 LMUL, MUL LDIV, DIV XZQL, LXZQ J27, 27
*4400 / FIGURE OUT WHATS IN AC LCHECK, 0 TAD L46 /GET WHATS IN THE AC CIA /SET NEGATIVE TAD I L41 /SUBTRACT SNA CLA /ARE THEY EQUAL JMP ONE /YES TAD L46 /GET AC AGAIN CIA /SET NEGATIVE TAD I L43 /SUBTRACT TWO SNA CLA /ARE THEY EQUAL JMP TWO /YES TAD L46 /GET THE AC SNA CLA /IS IT ZERO JMP NONE /NO YES YES YES JMP SOME /JUST SIMETHING IN AC ONE, ISZ LCHECK NONE, ISZ LCHECK SOME, ISZ LCHECK TWO, JMP I LCHECK / FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO LTMPOR, 0 DCA LFPROP /SAVE TRIPLE NUMBER TAD LFPROP JMS I MODE /DETERMINE ITS MODE TAD C30 /FLOATING POINT TAD TTAB /INTEGER DCA LCHECK TAD CM30 DCA FOP /SET UP COUNT FOR SEARCH LTLP1, TAD I LCHECK CIA TAD LFPROP SNA CLA /IS THIS THE ONE? JMP ZEROIT /YES - ZERO IT OUT AND RETURN IT ISZ LCHECK ISZ FOP JMP LTLP1 /LOOP OVER ENTIRE TABLE TAD LCHECK /NOT FOUND - WE HAVE TO ASSIGN IT TAD CM30 DCA LCHECK /RESET POINTERS FOR ZERO SEARCH TAD CM30 DCA FOP LTLP2, TAD I LCHECK SNA CLA /IS THIS TEMPORARY FREE? JMP TEMPTY /YES ISZ LCHECK ISZ FOP JMP LTLP2 /CHECK THEM ALL ERR41, JMS I LUNCH /OUT OF TEMPORARIES TEMPTY, TAD LCHECK CIA TAD L45 SNA CLA /ADJUST THE NUMBER OF FLOATING POINT TEMPS ISZ L45 TAD LCHECK CIA TAD L51 SNA CLA /ADJUST THE NUMBER OF INTEGER TEMPS ISZ L51 TAD LFPROP /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT ZEROIT, DCA I LCHECK TAD FOP TAD C31 /GET POSITIVE NUMBER FROM TABLE COUNTER JMP I LTMPOR /RETURN C31, 31 LFPROP, 0 /THIS ROUTINE PUNCHES SUBROUTINE CALLS DCA FOP /SAVE THE NUMBER OF ARGUMENTS JMS I PROP 6113 /PUT OUT THE CALL TAD FOP /GET THE NUMBER OF ARGUMENTS JMS I PROTAC /PRINT IT TAD C54 /GET A COMMA JMS I PRINT /PRINT IT CDF 10 TAD I LFPROP CDF 00 JMS I PRSYM JMS I PRINT ISZ LFPROP /INCREMENT RETURN JMP I LFPROP /RETURN FOP, 0 / COME HERE IF OP IS - ASUB, JMS I SMODE /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE TAD I L43 /GET OPERAND TWO JMS I MODE JMP FSUB /ITS FLOATING POINT JMS LCHECK /ITS INTEGER...CHECK WHATS IN THE AC JMP STWO /TWO IS IN THE AC JMS I STORE /SMETHING IS IN THE AC JMS I LADDON /NOTHING IS IN THE AC...ADD ONE TO IT ASBCMN, JMS I LCOMP /ONE IS IN AC...COMPLEMENT IT JMS I LADDTW /ADD TWO TO IT JMP I LRETUR /AND RETURN STWO, JMS I LCOMP /TWO IS IN AC...COMPLEMENT IT JMS I LADDON /ADD ONE TO IT JMS I LCOMP /AND COMPLEMENT IT AGAIN JMP I LRETUR /AND RETURN FSUB, JMS LCHECK /FLOATING POINT...CHECK THE AC JMP FS /TWO IS IN AC JMS I STORE /SOMETHING IN AC...STORE IT JMP FAS /NOTHING IN AC JMP ASBCMN /ONE IS IN AC - COMPLEMENT AND ADD TWO FAS, JMS I LADDTW /NOTHING IN AC...ADD TWO IN FS, IAC /WE HAVE ONE ARG JMS I FPROP 6011 JMS I ARG /PUT OUT THE ARG PSEUDO OP TAD I L41 /GET ARGUMENT ONE IRET, JMS I PRSYM /AND PUT IT OUT JMS I PRINT /PUT OUT CRLF JMP I LRETUR TTAB, ITTAB /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE LCOMP, COMP LADDON, ADDONE C30, 30 CM30, -30 LRETUR, RETURN LADDTW, ADDTWO
*4600 / PROCESS * ADDIND, JMS I CHECK /CHECK WHATS IN THE AC NOP /TWO IS IN AC SKP /N SOMETHING IS IN AC SKP /NOTHING IS IN AC JMS I STORE /STORE WHATEVER IS IN AC TAD I L41 /GET OPERAND ONE JMS I MODE /WHAT MODE IS IT JMP FLOT /YES IT FLOATING POINT JMS I PROP /IST INTEGER... 6063 /PUT OUT A TAD* LOOP6, TAD I L41 /GET THE FIRST OPERAND AGAIN JMP I LIRET /GO TO THE RETURN ROUTINE FLOT, IAC /WE ONLY HAVE ONE ARG JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE 6132 /PUT OUT A CALL TO FLOATING INDIRECT ADD JMS I ARG /PUT OUT THE ARG PSEUDO OP JMP LOOP6 /AND JUMP BACK / THIS PUTS OUT OPCODES FOR AN ADD ADDL, 0 CLL RAR SNA /TEST FOR 0 OR 1 JMP ADSPCL RAL /NOT 0 OR 1, TREAT NORMALLY JMS I MODE /WHAT MODE ARE WE IN JMP LOOP7 /YES JMS I PROP /PUT OUT A TAD 6066 JMP I ADDL /RETURN LOOP7, IAC /WE ONLY HAVE ONE ARGUMENT JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE 6003 /PUT OUT A FLOATING ADD JMS I ARG /PUT OUT THE ARG PSEUDO OP JMP I ADDL /AND RETURN ADSPCL, ISZ ADDL ISZ ADDL /BUMP RETURN POINT PAST ARGUMENT TO "TAD" SNL /0? JMP I ADDL /YUP - DON'T PUT OUT NUTTIN JMS I PROP OPIAC /PUT OUT "IAC" JMP I ADDL / STORES CONTENTS OF AC IN TEMPORARY / PUT OUT DCA OR CALL STO / FOLLOWED BY THE TEMPORARY LOC LSTORE, 0 TAD L46 /GET THE AC JMS I MODE /WHAT MODE IS IT JMP FSTO /ITS FLOATING POINT JMS I PROP 6071 /ITS INTEGER...PUT OUT A DCA STORET, TAD L46 /GET THE AC AGAIN JMS I PRSYM /PRINT WHATEVER IS IN IT JMS I PRINT /PUT OUT A CRLF DCA L46 /ZERO THE AC JMP I LSTORE /AND RETURN FSTO, IAC /WE ONLY HAVE ONE ARG JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE 6006 /PUT OUT A CALL TOFLOATING STORE JMS I ARG /PUT OUT THE ARG PSEUDO OP JMP STORET /AND JMP BACK COMP, 0 TAD L46 /GET THE AC JMS I MODE /WHAT MODE IS IT JMP FCOM /ITS FLOATING POINT JMS I PROP /ITS INYTEGER 6135 /PUT OUT A CIA JMS I PRINT /PUT OUT A CRLF JMP I COMP /AND RETURN FCOM, JMS I FPROP 6140 /TO FLOATING CHANGE SIGN JMP I COMP / COME HERE IF OP IS * MUL, JMS I SMODE /CHECK FOR SAME MODE JMS I CHECK /CHECK WHATS IN THE AC JMP TMUL /TWO IS IN THE AC JMS I STORE /SOMETHING IS IN AC...STORE IT JMS I KADDON /NOTHING IS IN AC..GET ONE IN AC AMUL, TAD I L43 /GET OPERND TWO JMS I MODE /WHAT MODE IS IT TAD EM6 TAD C6022 DCA FML /SAVE OPCODE IAC JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE FML, 0 JMS I ARG /PUT OUT THE ARG PSEUDO OP TAD I L43 /GET OPERAND TWO JMP I LIRET /AND GO TO THE RETURN ROUTINE TMUL, TAD I L41 /GET OPERAND ONE AND REPLACE OPERAND TWO DCA I L43 JMP AMUL /AND JUMP BACK KADDON, ADDONE LIRET, IRET EM6, -6 C6022, 6022
*5000 / THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG DUMTWO, 0 TAD I L41 /GET OPND ONE DCA FDV /AND SAVE TAD I L43 /GET OPND TWO DCA I L41 /ZERO OPND ONE JMS DUMONE /PROCESS DUMMY ARGUMENT TAD FDV /GET SAVED OPERAND DCA I L41 /AND USE AS OPERAND TAD L46 /GET TRIPLE NUMBER DCA I L43 /AND REPLACE JMP I DUMTWO /RETURN / TAKES CARE OF ONE BIING DUMMY ARG DUMONE, 0 TAD I L42 /GET OPERATOR DCA ASTOP /AND SAVE TAD E41 /GET ADD INDIRECT OPERATOR DCA I L42 /AND REPLACE OPERATOR CDF 10 TAD I TRIPL CDF 00 DCA FEX /AND SAVE RETURN JMS I TRIPL /CALL TRIPL TAD L46 /GET TRIPLE NUMBER DCA I L41 /AND REPLACE OPERAND TAD ASTOP /RESTORE OPERATOR DCA I L42 ISZ L40 /ADVANCE TRIPLE TAD FEX /RESTORE RETURN CDF 10 DCA I TRIPL CDF 00 JMP I DUMONE /RETURN / COME HERE IF OP IS / DIV, JMS I SMODE /CHECK FOR SAME MODE JMS I CHECK /CHECK WHATS IN THE AC JMP DIVE /TWO IS IN AC JMS I STORE /THERES SOMETHING IN THE AC...STORE IT SKP /NOTHING IS IN AC JMS I STORE /THERES SOMETHING IN THE AC...STORE IT JMS I MADDTW /GET TWO INTO THE AC DIVE, TAD I L41 /GET OPERAND ONE JMS I MODE /WHAT MODE IS IT TAD FM6 TAD C6025 DCA FDV /SAVE OERATOR IAC JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE FDV, 0 JMS I ARG /PUT OUT THE ARG PSEUDO OP TAD I L41 /GET OPERAND ONE JMP I MIRET /JUMP TO RETURN ROUTINE / COME HERE IF OP IS ** EXP, JMS I CHECK /CHECK WHATS IN THE AC JMP FEXP /TWO IS IN AC JMS I STORE /THERES SOMETHING IN THE AC...STORE IT SKP /NOW NOTHING IS IN AC JMS I STORE /THERES SOMETHING IN THE AC...STORE IT JMS I MADDTW /GET TWO IN AC FEXP, TAD I L41 JMS I MODE TAD C6 DCA FDV TAD I L43 /GET OPERAND TWO JMS I MODE /WHAT IS ITS MODE TAD C3 /FLOATING POINT TAD C6207 /INTEGER TAD FDV DCA FEX /SAVE REOUTINE POINTER IAC JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE FEX, 0 TAD I L41 /GET OPERAND ONE DCA I L43 /SAVE IN OPERAND TWO TAD FEX /GET THE OP CODE JUST PUT OUT TAD CM6207 /SUBTRACT THE INTEGER TO INTEGER CASE SZA CLA /WAS THIS THE INTEGER INTEGER CASE TAD L50 /NO, GET A FLOATING POINT POINTER DCA I L41 /AND SUBSTITUTE IT FOR OPERAND ONE JMS I ARG /PUT OUT THE PSEUDO OP ARG TAD I L43 /GET THE REAL OPERAND ONE IN THE AC JMP I MIRET /JUMP TO THE RETURN ROUTINE /COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED EIND, TAD C132 /GET AN ASTERISK DCA L60 /PUT IT IN SIXTY /COMES HERE IF THE OPERATOR IS AN '=' EQU, JMS I CHECK /CHECK WHATS IN THE AC NOP /TWO IS IN THE AC JMS I STORE /THERES SOMETHING IN THE AC...STORE IT JMS I TADDON /NOTHING IS IN AC...ADD ONE TO IT TAD I L43 /GET OPERA ND TWO JMS I MODE /WHAT IS ITS MODE JMP FEQU /ITS FLOATING POINT TAD L46 /GET THE AC JMS I MODE /WHAT MODE IS IT JMP I LFIX /ITS FLOATING POINT EFIX, TAD L60 /GET EQUALS INDIRECT LOCATION TAD C6071 /ADD A DCA DCA ASTOP /AND SAVE OPCODE JMS I PROP /POT OUT THE OPCODE ASTOP, 3 EQRET, DCA L46 /ZERO THE AC TAD I L43 /GET OPERAND TWO JMS I PRSYM /PRINT IT JMS I PRINT /PUT OUT A CRLF DCA L60 /ZERO SIXTY JMP I .+1 /AND RETURN ARET FEQU, TAD L46 /GET THE AC JMS I MODE /WHAT MODE IS IT SKP /ITS FLOATING POINT JMS I LFLOAT /ITS INTEGER...FLOAT IT JMP I .+1 XXX LARG, 0 JMS I PROP 6201 JMP I LARG TADDON, ADDONE E41, 41 MADDTW, ADDTWO FM6, -6 C6025, 6025 MIRET, IRET C6, 6 C6207, 6207 LFIX, FIX C6071, 6071 LFLOAT, FLOAT CM6207, -6207 C132, 132
*5200 XXX, TAD L60 /GET THE INDIRECT EQUALS SWITCH SNA CLA /IS THE SWITCH ON TAD CM140 /NO, FLOATING POINT STORE TAD C6146 /YES...ISTO DCA FSTOP /SAVE OPCODE IAC /WE ONLY HAVE ONE ARG JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE FSTOP, 6146 JMS I ARG /PUT OUT THE ARG PSEUDO OP JMP I .+1 /JUMP BACK EQRET / THIS ADDS OPERAND ONE TO THE AC ADDONE, 0 TAD I L41 /GET OPERAND ONE JMS I LADDL /PUT OUT OPCODES FOR AN ADD TAD I L41 /GET FIRST OPERAND JMS I PRSYM /PUT OUT SYMBOL JMS I PRINT /PUT OUT CR LF TAD I L41 /GET OPERAND ONE DCA L46 /PUTN THE AC JMP I ADDONE /RETURN UMIN, JMS I CHECK /CHECK WHATSN THE AC NOP /TWOSN AC JMS I STORE /THERES SOMETHINGN THE AC...STORET JMS ADDONE /NOTHINGSN AC NOW...PUT ONEN AC JMS I MCOMP /AND COMPLEMENTT JMP RETURN /AND RETURN AADD, JMS I SMODE JMS I CHECK /CHECK WHATSN THE AC JMP AONE /TWOSN AC JMS I STORE /THERES SOMETHINGN THE AC...STORET JMS ADDONE /GET ONEN AC JMS ADDTWO /ONESN AC JMP RETURN /RETURN AONE, JMS ADDONE /ADD ONE TO TWO JMP RETURN /AND RETURN LPROP, 0 CDF 10 TAD I LPROP CDF 00 JMS I PRSYM /AND PRINT THE SYMBOL TAD C40 /GET A SPACE JMS I PRINT /PUT OUT ISZ LPROP /INCREMENT RETURN JMP I LPROP /AND RETURN / THIS ADDS OPERAND TWO TO THE AC ADDTWO, 0 TAD I L43 /GET OPERAND TWO JMS I LADDL /PUT OUT OPCODES FOR AN ADD TAD I L43 /GET SECOND OPERAND JMS I PRSYM /PRINT THE SYMBOL JMS I PRINT /PUT OUT CR LF TAD I L43 /GET OPERAND TWO DCA L46 /AND PUTN AC JMP I ADDTWO /RETURN LXZQ, 0 /CHECK FOR EXPRESSION LEFT OF = CLA TAD L22 /GET SUBSCRIPT NESTING DEPTH TAD L44 /GET EQUALS SIGN SWITCH SNA CLA /ARE THEY BOTH ZERO ERR42, JMS I LUNCH /N YES ...THATS AN ERROR JMP I LXZQ /RETURN RETURN, TAD I L41 /THISS THE RETURN...GET OPERAND ONE JMS I MODE /WHAT MODEST TAD G400 /ITS FLOATING POINT...TURN F.P. BIT ON TAD L40 /ADD CURRENT TRIPLE NUMBER DCA L46 /PUTN AC SW JMP I NARET /AND NOW RETURN FROM THE ROUTINE FLOAT, 0 JMS I FPROP /PUT OUT A CAL TO THE FLOAT ROUTINE 6127 JMP I FLOAT /AND RETURN FIX, JMS I FPROP /PUT OUT A CAL 6143 /TO THE FIX ROUTINE JMP I .+1 /AND JUMP BACKLADDL, ADDL EFIX C6146, 6146 LADDL, ADDL MCOMP, COMP G400, 400 NARET, ARET LSMODE, 0 TAD I L43 /GET FIRST OPERAND JMS I MODE /FIND WHAT ITS MODE IS JMP IBM /ITS FLOATING POINT TAD I L41 /GET OPERAND TWO JMS I MODE /THIS BETTER BE INTEGER TOO JMP .+5 /ITS NOT, LUNCH JMP I LSMODE /GREAT, RETURN IBM, TAD I L41 /GET OPERAND TWO JMS I MODE /THIS BETTER BE F.P. TOO JMP I LSMODE /IT IS RETURN ERR43, JMS I LUNCH /ERROR LPUNCH, 0 PSF /IS PUNCH READY JMP .-1 /NO, TRY AGAIN PLS /YES, PUNCH THE CHARACTER CLA /CLEAR THE ACCUMULATOR JMP I LPUNCH /AND RETURN CM140, -140 LFINI, 0 /FINAL CLEANUP AT END OF COMPILATION JMS I FPROP /PUNCH 'CALL 0,OPEN' OPEN JMS I PROP /PUNCH A 'PAUSE' 6060 JMS I PRINT JMS I PRINT /FORCE LAST LINE OUT TAD CM100 JMS I LEADR /PUNCH SOME LEADER CDF 10 XFINI, HLT /JMP I LFINI, FOR DISK SYSTEM ... CIF 0 JMP I D1000 /BEGIN NEXT COMPILATION D1000, 1000 CM100, -100 LEADR, LLEAD FORST, JMS I PRINT /FORTRAN STARTING POINT JMS I (LIST DCA .-1 TAD (LPUNCH DCA PUNCH TAD CM50 JMS I LEADR JMS I PROP FORTR JMS I PRINT JMP START PAGE
*5400 LLAST, TAD C4000 /END OF COMPILATION, SET CHK SO THAT DCA CHK /LGTC WILL NOT READ ANOTHER LINE... JMS I GNB SZA JMP I ASSIGN JMS I (OSTOP /PUNCH A 'HLT' ETC. TAD L55 TAD C25 SZA CLA /IS DO LIST EMPTY? ERR44, JMS I LUNCH /NO, COMPLAIN... MORDUM, TAD L56 /GET POINTER INTO SYMBOL TABLE TAD C2 /ADD TWO TO IT FOR CONTROL BITS DCA L72 /SAVE ADDRESS OF CONTROL BITS TAD I L72 /GET THE CONTROL BITS AND E10 /MASK ALL BUT THE DUMMY ARG BIT SNA CLA /IS THE DUMMY ARG BIT ON JMP LEDOUT /NO, PUT OUT DUMMY SUBSCRIPT DEFNS JMS I DEFN /YES, PUT OUT THE VARIABLE NAME JMS I PROP /PUT OUT THE OP CODE 6154 /WHICH IS BSS TAD C2 /RESERVE TWO LOCATIONS JMS I PROTAC /PRINT THE TWO JMS I PRINT ISZ L56 /ADVANCE THE POINTER ISZ L56 ISZ L56 JMP MORDUM /GO BACK AND DO THE NEXT ONE LEDOUT, DCA L72 /ZERO LOCATION 72 LEDOT1, TAD L25 /GET THE NUMBER OF SUBSCRIPT TEMPS CMA TAD L72 /SUBTRACT FROM THE NUMBER WEVE DEFINED SNA CLA /HAVE WE DEFINED THEM ALL YET JMP GOOON /YES, NOW PUT OUT THE END TAD K5200 /GET SUBSCRIPT DESIGNATOR TAD L72 /GET WHICH SUBSCRIPT JMS I PRSYM /AND PRINT IT TAD C7240 /GET THE TERMINATOR JMS I P2 /PRINT IT JMS I PROP /PRINT THE OP CODE 6154 /WHICH IS BSS TAD C2 /RESERVE TWO LOCATIONS JMS I PROTAC JMS I PRINT /CRLF ISZ L72 /GO ON TO THE NEXT ONE JMP LEDOT1 GOOON, JMS I PROP 6157 /PUT OUT AN END JMS I PRINT /PUT OUT A CRLF DCA L65 /ZERO THE PSEUDO LOCATION COUNTER TAD START /CLA = -600 JMS I LEAD /PUT OUT LOTS OF LEADER CODE JMS I PROP 6162 /PUT OUT A LAP JMS I PRINT SYM, TAD L57 CIA TAD L56 SZA CLA /ARE THERE ANY SYMBOLS JMP SYM1 TAD MIKE8 SZA CLA /NO, IS THERE ANY EQUIVALENCING? JMP I LPTEMP JMP I .+1 PTEMP SYM1, TAD L56 TAD C2 DCA L72 TAD I L72 /GET THE CONTROL BITS DCA L72 /SAVE THEN TAD L72 /GET THE BITS AND E7 /MASK SZA CLA /ARE THEY FUNCT NAME, JMP UP /YES JMS I DEFN /PUT IT OUT TAD L72 AND E20 /MASK ALL BUT THE DIMEN SNA CLA /IS EITHER ONE ON JMP NORM /NO TAD L56 JMS I DIM DCA L26 TAD I L14 /GET THE SECOND DIMENSION CIA /AND NEGATE DCA L73 /SAVE TAD L26 ISZ L73 JMP .-2 ACK, DCA L26 TAD L56 JMS I MODE /DETERMINE MODE OF SYMBOL TAD L26 RAL CLL TAD L26 DCA L26 TAD L72 AND C40 SZA CLA JMP COM JMS I BSS UP, ISZ L56 ISZ L56 ISZ L56 JMP SYM NORM, IAC JMP ACK C25, 25 E7, 7 K5200, 5200 DEFN, LDEFN E20, 20 E10, 10 LPTEMP, EEK LEAD, LLEAD COM, JMS I PROP 6165 TAD L26 JMS I PROTAC JMS I PRINT JMP UP LCLEAR, 0 /CLEAR THE PSEUDO ACC AND MQ DCA L30 DCA L31 DCA L32 DCA L33 DCA L34 DCA L35 JMP I LCLEAR
*5600 C7600, 7600 C177, 177 LBSS, 0 TAD L65 /GET THE LOCATION COUNTER TAD L26 /ADD THE CURRENT AMOUNT TO IT AND C7600 /MASK ALL BUT THE PAGE BITS DCA L64 /SAVE THE NUMBER OF PAGES TAD L65 /GET THE LOCATION COUNTER AGAIN TAD L26 /ADD THE CURRENT DISPLACEMENT AGAIN AND C177 /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE DCA L65 /AND SAVE L, TAD L64 /GET THE NUMBER OF PAGES TO BE RESERVED SNA /ARE THERE ANY TO BE RESERVED JMP CRAM /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS TAD C7600 /YES...SUBTRACT ONE FROM THE PAGE COUNT DCA L64 /AND SAVE IT TAD L65 /GET THE NUMBER OF EXTRA LOCATIONS DCA L26 /AND PUT IN THE DISPLACEMENT LOCATION JMS I PROTAC /PUT OUT A ZERO JMS I PRINT /PUT OUT A CRLF JMS I PROP /PUT OUT THE OPCODE 6151 /WHICH IS THE PAGE PSEUDO OP JMS I PRINT /PUT OUT A CRLF JMP L /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES CRAM, JMS I PROP /NOW PUNCH 'BLOCK <N>' BLCK TAD L26 JMS I PROTAC JMS I PRINT JMP I LBSS LDEFN, 0 TAD L56 /GET THE POINTER TO THE SYMBOL JMS I PRSYM /PRINT THE SYMBOL TAD C7240 /GET THE TERMINATOR JMS I P2 /PRINT IT JMP I LDEFN /AND RETURN AFCON, TAD L47 /GET START OF FCON TABLE TAD C3 /UPDATE IT DCA L56 /SAVE UPDATED ADDRESS FLOOP, TAD L50 /GET END OF FCON TABLE CIA TAD L56 /SUBTRACT FROM CURRENT POINTER SNA CLA /ARE WE DONE JMP ALTHRU /YES TAD CM3 /NO, GET MINUS THREE DCA L63 /TO USE AS A COUNTER JMS LDEFN /DEFINE IT TAD I L56 /GET THE FIRST WORD ISZ L56 /ADVANCE THE POINTER TO THE NEXT WORD JMS I PROTAC /PRINT THE WORD JMS I PRINT /PUT OUT A CRLF ISZ L63 /HAVE WE PUT OUT ALL THREE WORDS JMP .-5 /NO...PUT OUT ANOTHER JMP FLOOP /YES...GET THE NEXT CONSTANT PTEMP, TAD K561 DCA L56 FTLOOP, TAD L45 CMA TAD L56 SNA CLA JMP ITEMP TAD C3 DCA L26 TAD K5400 /GET F.P. DESIGNATOR JMS LDEFN /PRINT THE SYMBOL JMS I BSS /RESERVE THE LOCATIONS FOR IT ISZ L56 /INCREMENT THE POINTER JMP FTLOOP ITEMP, TAD K531 DCA L56 ILOOP, TAD L51 CMA TAD L56 SNA CLA JMP SUBOUT IAC DCA L26 TAD K5000 /GET THE INTEGER TEMP DESIGNATOR JMS LDEFN /PRINT IT JMS I BSS /RESERVE LOCATIONS FOR IT ISZ L56 /INCREMENT THE POINTER JMP ILOOP ALTHRU, TAD D6 /PUNCH AN 'IFF 6' JMS I PIFF /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE JMS I PROP 6055 /PUT OUT AN EAP JMS I PRINT TAD L70 /GET THE SUBROUTINE FUNCTION POINTER SZA CLA /IS IT ZERO JMP THRU /NO...WE MUST BE IN A SUBR OR A FUNC JMS I PROP /YES ...WERE IN A MAIN PROGRAM 6052 /PUT OUT ENT TAD C6000 /POINTER TO THE SYMBOL MAIN JMS I PRSYM /PRINT THE SYMBOL JMS I PRINT /PUT OUT A CRLF TAD C6000 /GET THE POINTER TO MAIN AGAIN JMS I PRSYM /PRINT IT TAD C7240 /GET A COLON JMS I P2 /PRINT THEM JMS I PROP 6047 JMS I PRINT /PUT OUT A CRLF THRU, JMS I FINI 6201 /CDF FIELD 0 JMP I C7600 /AND RETURN TO THE MONITOR ... C6000, 6000 SUBOUT, DCA L56 SUBOT1, TAD L25 CMA TAD L56 SNA CLA JMP AFCON JMS I PROP /PUT OUT THE OP CODE 6176 /WHICH IS DUMMY TAD X5200 /GET SUBSCRIPT DESIGNATOR TAD L56 /GET THE POINTER JMS I PRSYM /PRINT THE SYMBOL JMS I PRINT /CRLF ISZ L56 JMP SUBOT1 K5000, 5000-ITTAB K5400, 5400-FTTAB K531, ITTAB+1 K561, FTTAB+1 X5200, 5200 FINI, LFINI D6, 6
*6000 /FUNCTION AND SUBROUTINE STATEMENT PROCESSOR LFUNC, JMS I LOOK /CHECK REST OF STATEMENT MFOUR, -4 / -24 /T -11 /I -17 /O -16 /N CLA IAC /SET SWITCH JMP TART LSUB, JMS I LOOK /CHECK REST OF STATEMENT -6 / -17 /O -25 /U -24 /T -11 /I -16 /N -5 /E TART, DCA L67 /THIS IS THE SWITCH JMS SUBB CLA CMA TAD C6275 /THIS IS THE PLACE TO STORE FUNCTION NAME DCA L11 /USE AUTO INDEXING TO STORE THE NAME TAD L30 /GET THE FIRST WORD DCA I L11 /PUT IT IN THE SYMBOL TABLE TAD L31 /GET THE SECOND WORD DCA I L11 /PUT IT IN THE TABLE TAD L32 /GET THE THIRD WORD IAC /TURN THE EXTERNAL SYMBOL BIT ON DCA I L11 /AND PUT IT IN THE TABLE TAD C6275 /GET THE POINTER DCA L70 /AND PUT IT IN LOC 70 JMS I PROP 6052 /PUT OUT AN ENT TAD L70 /GET THE SUBROUTINE NAME JMS I PRSYM /PRINT IT JMS I PRINT /PUT OUT A CRLF CLA CMA DCA READY /SET SWITCH TAD L70 /GET THE SUB NAME JMS I PRSYM /PUT IT OUT TAD C7240 JMS I P2 /PUT IT OUT JMS I PROP /PUT OUT THE OP CODE 'BLOCK 2' BLCK TAD C2 JMS I PROTAC JMS I PRINT DCA WHICH /ZERO THE SWITCH WHICH TELLS WHICH WORD MORE, JMS I GNB SNA /CHECK FOR END OF CARD JMP CKCR TAD CM50 /CHECK FOR LEFT PAREN SNA /IS IT A LPAR JMP GET1 /YES TAD MFOUR SNA /IS IT A COMMA JMP XGET /YES TAD C3 SNA CLA /IS IT A LPAR JMP START /YES JMP ERR48 /NO GET1, ISZ READY /WERE WE READY FOR LPAR JMP ERR48 /NO, ERROR ... XGET, JMS SUBB TAD L32 TAD TEN DCA L32 TAD C77 /GET MASK FOR SYMBOL TABLE DCA L21 /AND PUT INTO THE SWITCH JMS I SYMTAB /AND PUT IN SYMBOL TABLE JMS I PROP DUMMY TAD L77 JMS I PRSYM JMS I PRINT DLOOP, JMS I PROP 6063 /PUT OUT A TAD* TAD L70 /GET THE FUNCTION NAME JMS I PRSYM /AND PRINT IT JMS I PRINT /PUT OUT A CRLF JMS I PROP 6071 /PUT OUT A DCA TAD L77 /GET ADDRESS OF SYMBOL JMS I PRSYM /PRINT IT TAD WHICH /GET THE WHICH SWITCH RAR /GET THE LOW BIT INTO THE LINK SNL CLA /IS THE WHICH SWITCH BIT SWITCHED JMP NEXT /NO...THAT MEANS WERE ON THE FIRST WORD TAD E43 /YES...WERE ON SECOND WORD...GET A "#" JMS I PRINT /PRINT IT NEXT, JMS I PRINT JMS I PROP /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP) 6237 TAD L70 /GET THE FUNCTION NAME JMS I PRSYM /AND PRINT IT TAD E43 JMS I PRINT JMS I PRINT /PUT OUT A CRLF ISZ WHICH /INCREMENT THE SHICH SWITCH TAD WHICH /GET THE SWITCH RAR /GET LOW BIT IN THE LINK SZL CLA /IS THE LOW BIT ON JMP DLOOP /YES...WORK ON THE SECOND WORD JMP MORE /GO GET SOME MORE READY, 0 SUBB, 0 JMS I ENTITY SKP JMP I SUBB E43, 43 TEN, 10 JMP ERR48 WHICH, 0 C6275, 6275 /SUBROUTINE OR FUNCTION NAME POINTER CKCR, ISZ READY ERR48, JMS I LUNCH JMP START IOEQL, CLA CMA /ROUTINE TO TERMINATE IMPLIED DO LOOPS TAD IMPDO DCA IMPDO /REDUCE THE DEPTH BY 1 JMS I DONEXT /GENERATE END-OF-LOOP CODE JMS I GNB TAD CM51 SZA CLA /SKIP TO A RIGHT PAREN JMP .-3 JMP I .+1 IOH0 DONEXT, LDNEXT
*6200 LWRIT, JMS I LOOK /LOOK FOR REST OF STATEMENT -1 -5 TAD C3 LREAD, TAD C6030 /GET THE POINTER TO READ AND WRITE DCA IOP /USE AS A PARAMETER WITH FPROP JMS I GNB TAD CM50 SZA CLA /IS THIS A LEFT PAREN? JMP I ASSIGN JMS SUBA JMS I ZZZ TAD C2 JMS I FPROP IOP, 0 JMS I ARG TAD L32 JMS I PRSYM JMS I PRINT JMS I ARG JMS I GNB TAD CM54 /IS IT A COMMA SZA CLA JMP ERR50 /NO, ERROR ... JMS SUBA TAD L32 /GET FORMAT JMS I PLAB JMS I GNB TAD CM51 /CHECK FOR A RIGHT PAREN SZA CLA /IS IT? ERR50, JMS I LUNCH JMS I PRINT IOH0, JMS I GNB SNA JMP IOH2 TAD CM54 SNA CLA /IS IT A COMMA JMP IOH3 /YES ... IOH1, JMS I PUTCH /NO...PUT IT BACK JMS I GNB /THIS STMT IS TRANSFERRED TO! TAD CM50 SNA CLA JMP I IOPEN /OPEN PAREN - MAY BE IMPLIED DO-LOOP IOH1BK, JMS I PUTCH DCA L52 /SET SWITCHES FOR GENER DCA L46 ISZ L44 JMS I GENER /START PROCESSING THE IO LIST TAD L41 DCA L42 TAD L53 DCA L73 /SAVE CREATED LABEL LOC DCA L23 /ZERO TEMPORARY FOR "DUMARG" JMS I LCHNG /TEST FOR 0 OR DUMMY ARG DCA I L41 TAD L23 /GET TEMPORARY FROM "DUMARG" SZA CLA /ZERO MEANS NON-VARIABLE NAME TAD I L23 /NON-ZERO POINTS TO FLAG WORD OF VAR AND Q20 SNA CLA /DO WE HAVE AN ARRAY NAME? JMP NOSYMB /NO JMS I PROP OPCMA /PUT OUT A "CMA" TO DISTINGUISH THIS CALL JMS I PRINT /FROM A REGULAR CALL TO "IOH" TAD C2 JMS I FPROP 6036 /OUTPUT A "CALL 2,IOH" JMS I ARG TAD L23 TAD CM2 JMS I DIM /GET THE DIMENSIONS DCA IOP TAD I L14 CIA DCA L44 TAD L23 TAD CM2 JMS I MODE /GET THE MODE OF THE ARRAY TAD C4000 /FLOATING POINT - ADD 4000 TO AC TAD IOP ISZ L44 JMP .-2 /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT JMS I PROTAC /PRINT IT JMS I PRINT JMP IOHRSM /GO PRINT ARRAY NAME NOSYMB, TAD L46 SZA CLA JMS I STORE IAC /THERE WILL BE ONE ARGUMENT JMS I FPROP /PUT OUT THE CALL TO IOH 6036 IOHRSM, TAD L73 DCA L53 /RESTORE CREATED LABEL LOC TAD I L41 JMS I QSYMOT TAD L63 /GET TERMINATING CHAR SNA CLA /WAS IT A <CR>? JMP IOH2 /YES IOH3, JMS I GNB /GENTLY LOOK AHEAD ... SNA CLA /DO WE HAVE A ',<CR>' ? JMP START /YES, DO NOT TERMINATE YET ... JMP IOH1 /NO, PUSH IT BACK & PROCESS NEXT ITEM IOH2, IAC /THERE WILL BE ONE ARGUMENT JMS I FPROP /PUT OUT A CALL TO IOH 6036 JMS I ARG /PUT OUT THE PSEUDO OP ARG JMS I PROTAC JMS I PRINT JMP START SUBA, 0 JMS I ENTITY JMP ERR51 /ITS A CR JMP ERR51+1 /ITS A VARIABLE JMP I SUBA Q20, 20 ERR51, JMS I LUNCH DCA L21 /ZERO THE SYMBOL TABLE SWITCH JMS I SYMTAB TAD L77 JMS I MODE JMP ERR51 TAD L77 DCA L32 JMP I SUBA IOPEN, IOOPEN QSYMOT, SYMOUT C6030, 6030
*6400 LRET, JMS I LOOK /CHECK REST OF STATEMENT -2 -22 -16 JMS I ZZZ TAD L70 SNA CLA /ARE WE COMPILING MAIN PROGRAM? ERR60, JMS I LUNCH /YES TAD L67 SNA CLA JMP INT /ITS A SUBROUTINE TAD L70 /GET HE NAME OF THE FUNCTION JMS I MODE /IS IT FP OR INTEGER JMP .+4 /ITS FP JMS I PROP 6066 /OPCODE IS TAD JMP .+5 /PUT OUT THE SYMBOL IAC /THERE IS ONE ARGUMENT JMS I FPROP 6003 JMS I ARG TAD F34 /GET A BACK SLASH JMS I PRINT TAD L70 /GET THE NAME OF THE FUNCTION JMS I PRSYM /PRINT THE NAME JMS I PRINT /PUT OUT A CRLF INT, JMS I PROP 6077 /OPCODE IS RTN TAD L70 /GET THE FUNCTION NAME JMS I PRSYM /PRINT IT JMS I PRINT /PUT OUT A CRLF JMP START /WERE DONE LGETHI, 0 /PUNCH 'TAD ACH' JMS I PROP 6066 JMS I PROP /PRINT THE OP CODE 6226 /WHICH IS ACH (HIGH ORDER AC) JMS I PRINT JMS I FPROP /PUNCH 'CALL 0,CLEAR' 6204 JMP I LGETHI LDIM, 0 /GETS THE 1ST DIMENSION OF THIS VARIABLE DCA LGETHI /SYMBOL TABLE ADDRESS IS IN THE AC CMA TAD L50 DCA L14 LK, TAD I L14 /SEARCH THE DIMENSION TABLE CIA TAD LGETHI SNA CLA JMP .+4 ISZ L14 ISZ L14 JMP LK TAD I L14 /EXIT WITH DIMENSION IN THE AC JMP I LDIM / THIS PROCESSES SUBSCRIPTS SUBRET, JMP I LSUBSC /RETURN FROM SUBSC LSBTEM, 0 /THIS ROUTINE MAKES AN ENTRY DCA TRIP /IN SUBSCRIPT TEMPORARY TABLE TAD FBASE DCA POINT TAD CM40 DCA PCTR LOOP, TAD I POINT /LOOK FOR CURRENT TRIPLE NR SNA /OR END OF TABLE... JMP YES CIA TAD TRIP SNA CLA JMP GOT ISZ POINT ISZ PCTR JMP LOOP ERR53, JMS I LUNCH YES, TAD TRIP DCA I POINT GOT, TAD FBASE CIA TAD POINT DCA POINT TAD POINT CIA TAD L25 SPA CLA /IF TEMPORARY NR > L25 ISZ L25 /BUMP L25 TAD POINT JMP I LSBTEM LWIPE, 0 /ZERO THE SUBSCRIPT TEMP. TABLE TAD FBASE DCA POINT TAD CM40 DCA PCTR LOOP2, DCA I POINT ISZ POINT ISZ PCTR JMP LOOP2 JMP I LWIPE LZER, 0 ISZ LZER /INCREMANT JMS I PROTAC /PUT OUT A ZERO JMP I LZER /AND REUTURN LCLAB, 0 SNA /IF NO LABEL IN AC, JMS I CREATE /CREATE A LABEL JMS I PRCRL /AND PRINT IT TAD C7240 /PUT OUT A COLON AND SPACE JMS I P2 JMP I LCLAB /RETURN FBASE, 4600 POINT, 0 PCTR, 0 TRIP, 0 F34, 34 LSUBSC, 0 TAD L46 SZA /IS THERE ANYTHING IN THE AC? CHANGE, SKP CLA /******************************** / TRY CHANGING THIS LOCATION TO A "JMS I MODE" / TO LIMIT THE CHECK TO THE INTEGER AC! / COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P. / EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS) SKP /NOTHING IN THE AC JMS I STORE /YES - STORE IT IAC DCA L63 TAD L53 DCA L73 TAD L41 DCA L42 ISZ L41 TAD I L41 TAD CM4046 SNA CLA /WAS IT A PRIME JMP BACK JMS I LCHNG DCA L63 ISZ L41 ISZ L41 ISZ L42
ISZ L42 IAC BACK, ISZ L41 DCA SYMOUT JMS CHNG DCA L65 ISZ L42 ISZ L42 JMS CHNG DCA LDUM /SAVE ARRAY POINTER (OR 0 IF DUMMY) TAD L73 /NOW RESTORE THE CREATED LABEL LOC DCA L53 TAD SYMOUT SNA CLA /HOW MANY SUBSCRIPTS? JMP .+7 /ONE - SKIP OUTPUTTING "TAD" JMS I PROP 6066 TAD I L41 JMS I DIM JMS I PRSYM JMS I PRINT TAD I L41 JMS I MODE JMP FP CASUB, TAD H200 TAD L40 DCA I L41 /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK TAD SYMOUT /GET NUMBER OF ARGUMENTS (2 OR 3) TAD C2 JMS I FPROP /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE 6173 /TO THE SUBSCRIPTING ROUTINE TAD SYMOUT SNA CLA /ONLY ONE ARG? JMP .+3 /YES - DON'T OUTPUT FIRST SUBSCRIPT TAD L63 JMS SYMOUT TAD L65 JMS SYMOUT TAD LDUM /GET THE ARRAY NAME JMS SYMOUT /OUTPUT IT AS AN ARGUMENT TAD I L41 JMS I PRSYM /OUTPUT THE DESTINATION TEMPORARY JMS I PRINT TAD I L41 DCA L12 /MARK IT AS THE CONTENTS OF THE LAST LINE JMP I FSUBSC /RETURN FP, JMS I PROP OPCMA /OPCODE IS CMA JMS I PRINT TAD H400 /SET MODE TO FLOATING POINT JMP CASUB SYMOUT, 0 DCA CHNG TAD CHNG SNA CLA JMS I CLAB /CREATE LABEL IF DUMMY ARG JMS I ARG TAD CHNG SNA /IS IT ZERO JMS I ZER /YES PUT OUT A ZERO JMS I PRSYM /OTHERWISE PUT OUT SUBSCRIPT JMS I PRINT /PUT OUT A CRLF JMP I SYMOUT LDSPCL, DCA L24 JMS I CREATE JMS I PRCRL /CHANGE LAST LINE TO STORE IN NEW DESTINATION DCA L12 /MARK LAST LINE USELESS FOR OPTOMIZATION JMP LDMRET LDUM, 0 ISZ LDUM /INCREMENT RETURN TAD I L42 /GET THE THING WHICH IS DUMMY CIA TAD L12 /DID WE JUST PUT THIS OUT AS A SUBSCRIPT SNA CLA /DESTINATION?? JMP LDSPCL /YES - SAVE OODLES OF CODE JMS I PROP 6066 /PUT OUT A TAD TAD I L42 JMS I PRSYM /PUT IT OUT JMS I PRINT /PUT OUT A CRLF JMS I PROP 6071 /PUT OUT A DCA JMS I CREATE /CREATE A LABEL JMS I PRCRL /AND PRINT IT JMS I PRINT /PUT OUT A CRLF JMS I PROP 6066 TAD I L42 JMS I PRSYM TAD H43 JMS I PRINT JMS I PRINT JMS I PROP 6071 TAD L53 JMS I PRCRL TAD H43 JMS I PRINT LDMRET, JMS I PRINT JMP I LDUM /RETURN CHNG, 0 TAD I L42 /NO...THERES TWO SUBSCRIPTS SNA TAD H6041 DCA I L42 TAD I L42 JMS I DUMARG /SEE IF SECOND SUBSC IS A DUMMY ARG JMS I DUM /YES IT IS A DUMMY ARG TAD I L42 /GET THE SECOND SUBSC JMP I CHNG H400, 400 H200, 200 H43, 43 FSUBSC, SUBRET H6041, 6041
*7000 IOHTMP,MCHAR, 0 NPOINT,LLUNCH, 0 CLA DCA L75 DCA L24 /ZERO "BUFFER WAITING TO PRINT" FLAG DCA IMPDO /ZERO IMPLIED DO LOOP FLAG TAD TTYPE /CHANGE TO TTY OUTPUT DCA PUNCH JMS I LLIST /TYPE THE CURRENT LINE TAD KOUNT /USE THE BUFFER POINTER AS AN INDEX CIA IAC DCA L7 TAD C40 /NOW PUT OUT SOME SPACES... JMS I PRINT ISZ L7 JMP .-3 TAD D36 /AND AN '^' JMS I PRINT JMS I PRINT TAD LELIST /NOW TYPE THE ERROR MESSAGE DCA L10 UNCH1, TAD I L10 SZA /END OF TABLE? TAD LLUNCH SNA CLA /IS THIS THE MSG WE WANT? JMP UNCH2 ISZ L10 /NO JMP UNCH1 UNCH2, TAD BASE CIA TAD I L10 JMS I LLIST /FAKE LISTER INTO PRINTING ERROR MESG JMS I PRINT /FORCE BUFFER TAD EPNCH /BACK TO PUNCH OUTPUT DCA PUNCH ISZ L75 /SET THE NON-PRINT SWITCH JMP START /GO PROCESS THE NEXT STATEMENT LLIST, LIST D36, 36 LELIST, ELIST-1 /ERROR LIST ... TTYPE, LTTYPE EPNCH, LPUNCH CTR, 0 TEM, 0 / THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL PARCT,LDCOUT, 0 DCA TEM /SAVE THE AC TAD CM3 /WE WILL PUT OUT FOUR CHARACTERS DCA CTR TAD ASE /THIS IS THE ASE OF THE CONVERSION TABLE DCA NPOINT /SAVE IT IN THE POINTER DCA FLAG LOP, DCA MCHAR /ZERO OUT THE CHARACTER TAD TEM /GET THE NUMBER AGAIN TAD I NPOINT /TO GET THE ITEM IN THE TABLE SPA /IS THE RESULT POSITIVE JMP LOPRST /NO...RESTORE THE NUMBER DCA TEM /AND SAVE THIS VALUE TAD D60 DCA FLAG /SET FLAG TO SHOW THAT WE HAVE SOMETHING ISZ MCHAR /YES...INCREMENT THE OUTPUT CHARACTER JMP LOP+1 /TRY THE SEQUENCE AGAIN LOPRST, CLA TAD MCHAR TAD FLAG SZA /DO WE HAVE A SIGNIFICANT DIGIT? JMS I PRINT /YES - PRINT IT ISZ NPOINT ISZ CTR JMP LOP /AND GET THE NEXT DIGIT TAD TEM /GET THE CHARACTER TO OUTPUT TAD D60 /PUT IT IN TRIMMED ASCII FORM JMS I PRINT /PRINT IT JMP I LDCOUT /YES...RETURN TO CALLING PROGRAM ASE, THOU FLAG, 0 / TELETYPE OUTPUT TOUTINE FOR ERROR MESSAGES LTTYPE, 0 TSF JMP .-1 TLS CLA JMP I LTTYPE IOOPEN, TAD KOUNT DCA IOHTMP /SAVE POINTER TO LEFT PAREN +1 CLA CMA DCA PARCT /INITIALIZE PAREN COUNTER TAD KOUNT DCA TEM /TEM POINTS TO ENTITY (OR PREV ONE IF A VAR) IOPENL, JMS I ENTITY /GET SOMETHING ERR52, JMS I LUNCH /END OF STMT - BAD JMP IOPENL /VARIABLE - DON'T UPDATE TEM D60, 60 JMP IOPENL-2 /CONSTANT - UPDATE TEM TAD CM51 /PUNCTUATION - TEST FOR RIGHT PAREN SNA JMP IORPAR /YES IAC SNA /LEFT PAREN? JMP IOLPAR TAD CM25 SNA CLA /IF CHAR IS AN EQUAL SIGL TAD PARCT IAC SZA CLA /AND WE ARE ON THE TOP LEVEL OF PARENTHESES JMP IOPENL-2 TAD TEM /THEN WE HAVE AN IMPLIED DO DCA KOUNT JMS I DO /GENERATE DO LOOP CODE JMP ERR52 /NOT TERMINATED WITH RPAR - ERROR ISZ IMPDO /BUMP IMPLIED DO COUNT TAD IOHTMP DCA KOUNT /RESTORE CHAR PTR TO BEGINNING OF LOOP JMP I .+1 IOH1+1 /COMPILE INNARDS OF LOOP IOLPAR, CLA CMA TAD PARCT JMP IOPENL-3 /BUMP PAREN COUNT UP AND LOOP IORPAR, ISZ PARCT /BUMP PAREN COUNT DOWN JMP IOPENL-2 /LOOP IF NOT BALANCED TAD IOHTMP DCA KOUNT /BALANCED - NOT AN IMPLIED DO JMP I .+1 IOH1BK /COMPILE NORMALLY CM25, -25 DO, XDO
*7200 EQUI, JMS I LOOK /CHECK REST OF STATEMENT TYPE -7 /THERE ARE 7 MORE CHARACTERS -26 /V -1 /-A -14 /-L -5 /-E -16 /-N -3 /-C -5 /-E RETA, ISZ SNUM /INCREMENT THE STRING NUMBER JMS CCCC /GET AND CHECK THE NEXT NON-BLANK CHARACTER SKP /ONLY LEGAL CHAR HERE IS A "(" JMP RETB /WE GOT THE "(" NOP JMP ERR59 RETB, JMS I ENTITY /LOOK FOR A VARIABLE SKP JMP LA /GOT IT, ANYTHING ELSE IS AN ERROR NOP NOP JMP ERR59 LA, ISZ L32 /TURN EQUIVALENCE BIT ON ISZ L32 TAD K57 /GET MASK FOR SYMBOL TABLE DCA L21 /PUT IN THE SYMBOL TABLE SWITCH JMS I SYMTAB /PUT IN SYMBOL TABLE TAD L77 /GET THE POINTER ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE DCA I MIKE4 TAD SNUM /GET THE CURRENT STRING NUMBER ISZ MIKE4 /AND PUT IT IN THE EQUIVALENCE TABLE DCA I MIKE4 ISZ MIKE8 /INCREMENT NUMBER OF ENTRIES JMS CCCC /GET NEXT PUNCTUATION JMP ERR59 /C/R, THAT'S AN ERROR ... JMP .+3 /LEFT PAREN, VARIABLE IS SUBSCRIPTED JMP LB /COMMA, NOT SUBSCRIPTED, STRING CONTINUES JMP LC /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING JMS I ENTITY /LOOK FOR SUBSCRIPT NOP SKP JMP LD /GOT IT, ANYTHING ELSE IS ERROR NOP JMP ERR59 LD, CLA CMA /SUBTRACT ONE FROM TAD L32 /FIRST SUBSCRIPT DCA INTA /AND SAVE JMS CCCC /GET NEXT PUNCTUATION NOP /CR IS ILLEGAL HERE JMP RETB-1 /SO IS LEFT PAREN SKP /COMMA, DOUBLY SUBSCRIPTED JMP LF /RIGHT PAREN, SINGLY SUBSCRIPTED JMS I ENTITY /GET OTHER SUBSCRIPT NOP SKP JMP LG /GOT IT NOP JMP LD-1 LG, TAD L32 /SET IT NEGATIVE CIA DCA INTB /AND SAVE IT JMS CCCC /GET NEXT PUNCTUATION NOP NOP ERR59, JMS I LUNCH TAD L77 /RIGHT PAREN IS ONLY LEGAL CHARACTER JMS I DIM /GET DIMENSION INFORMATION DCA CCCC /AND SAVE SKP /GO TO TEST PART OF LOOP TAD CCCC /THIS LOOP IS A MAKESHIFT MULTIPLY ISZ INTB /ARE WE DONE JMP .-2 /NO TAD INTA /YES, ADD FIRST SUBSCRIPT DCA INTA /AND SAVE LF, TAD L77 /GET POINTER TO VARIABLE JMS I MODE /WHAT MODE IS IT TAD INTA /F.P., MULTIPLY BY THREE RAL CLL /INTEGER TAD INTA IAC /ADD ONE TO ANSWER ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE DCA I MIKE4 JMS CCCC /GET NEXT PUNCTUATION NOP JMP RETB-1 /CR AND "(" ARE ILLEGAL HERE JMP RETB /COMMA MEANS STRING NOT FINISHED JMP LI /")" MEANS STRING FINISHED LC, CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE ISZ MIKE4 DCA I MIKE4 LI, JMS CCCC /WE FINISHED A STRING, ARE THERE MORE JMP START /NO SKP JMP RETA /YES JMP RETB-1 /"(" AND ")" ARE ILLEGAL HERE LB, CLA IAC /CRAM A ONE INTO TABLE ISZ MIKE4 DCA I MIKE4 JMP RETB /AND GO BACK / / THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR / CCCC, 0 JMS I GNB SNA /PUNCTUATION IS WHAT WE WANT JMP I CCCC /ITS A CR TAD CM54 SNA /IS IT A COMMA JMP XCOMMA /YES TAD C3 SNA /IS IT A ")" JMP XRPAR /YES IAC SNA /IS IT A "(" JMP XLPAR /YES JMP RETB-1 /NONE OF THE ABOVE XRPAR, ISZ CCCC XCOMMA, ISZ CCCC XLPAR, ISZ CCCC JMP I CCCC K57, 57 LFIN, JMS I GNB SZA CLA JMP I ASSIGN JMS I ZZZ /PRINT LABEL ON "FINI" JMP I .+1 IOH2 /THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE /AT THE END OF A COMPILATION
*7376 EEK, ISZ MIKE4 ISZ MIKE4 DCA I MIKE4 /SET END OF LIST JMS INIT /INITIALIZE POINTERS AAB, TAD MA /SET POINTERS TO STRING NUMBERS TAD C3 DCA MB ISZ MA ISZ MA AAC, ISZ MB AA, ISZ MB TAD I MA /GET FIRST STRING NUMBER CIA TAD I MB /SUBTRACT FROM SECOND SZA CLA /ARE THEY THE SAME JMP KICK1 /NO, ADVANCE POINTERS ISZ MA /YES, MOVE TO LINEAR SUBSCRIPT ISZ MB TAD I MA /GET FIRST SUBSC CIA TAD I MB /SUBTRACT FROM SECOND SPA CLA SNA /IS FIRST ONE SMALLER JMP KICK2 /NO, JUST ADVANCE POINTERS TAD MA /YES, SWITCH PLACES TAD CM2 DCA MA TAD MB TAD CM2 DCA MB TAD CM3 DCA INIT RAUCH, TAD I MA DCA L76 TAD I MB DCA I MA TAD L76 DCA I MB ISZ MA ISZ MB ISZ INIT JMP RAUCH TAD MA TAD CM2 DCA MA JMP AA /NOW THEYRE SWITCHED, CHECK AGAIN KICK2, CLA CMA /MOVE BACK FIRST POINTER TAD MA DCA MA JMP AAC KICK1, ISZ MA /MOVE UP FIRST POINTER ISZ MIKE7 /ARE WE OUT OF ENTRIES JMP AAB /NO / / NOW THE SORTING IS DONE / JMS INIT /INITIALIZE POINTERS DCA TOTAL /ZERO OUT TOTAL MIKE2, ISZ MA TAD I MA JMS I PRSYM /PUT OUT THE SYMBOL TAD C7240 JMS I P2 /PUT OUT THE TERMINATOR IAC TAD I MA DCA L14 TAD I L14 /GET CONTROL BITS FROM SYMBOL TABLE AND P20 SNA CLA /IS IT DIMENSIONED JMP MIKE5 /NO TAD I MA /YES, COMPUTE THE TOTAL LENGTH JMS I DIM DCA L26 TAD I L14 CIA DCA L73 TAD L26 ISZ L73 JMP .-2 SKP /GOT IT MIKE5, IAC /IF NOT DIMENSIONED, USE ONE A LENGTH DCA MB /SAVE LENGTH TAD I MA JMS I MODE /WHAT IS THE MODE OF THE SYMBOL TAD MB /FP, MULTIPLY BY THREE RAL CLL TAD MB DCA INIT /SAVE IT TAD TOTAL /GET TOTAL REMAINING LENGTH OF STRING CIA TAD INIT /SUBTRACT CURRENT LENGTH FROM IT SPA CLA /WHICH IS BIGGER JMP .+3 /REMAINING PORTION IS BIGGER TAD INIT /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION DCA TOTAL ISZ MA TAD MA TAD C3 DCA MB TAD I MB /GET NEXT ENTRY STRING NUMBER CIA TAD I MA /SUBTRACT CURRENT STRING NUMBER SZA CLA /ARE THEY EQUAL JMP MIKE1 /NO ISZ MA /YES, GET THE DIFFERENCE ISZ MB TAD I MB CIA TAD I MA DCA MB /AND SAVE TAD MB /SUBTRACT DIFFERENCE FROM TOTAL REMAINING CIA TAD TOTAL MIKE6, DCA TOTAL /SAVE TAD MB /GET THE DIFFERENCE DCA L26 JMS I BSS /RESERVE THAT MANY LOCATIONS ISZ MIKE7 /ARE WE DONE JMP MIKE2 /NO JMP I ROGER /YES MIKE1, TAD TOTAL /SWITCH TOTAL TO THE CURRENT LOCATION DCA MB ISZ MA /EQUALIZE POINTERS JMP MIKE6 / INIT, 0 TAD MIKE8 /GET ENTRY COUNT CIA /SET NEGATIVE DCA MIKE7 /SAVE TAD POINTZ /GET TABLE POINTER DCA MA /SAVE JMP I INIT / ROGER, PTEMP P20, 20 $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search