HED ** MONITOR/BASIC LINKAGE AREA ** ORG 100B SPC 10 * * TIME-SHARE BASIC COMPILER * * KILE B. BAKER * JOHN S. SHEMA * * DATA RECORDING CENTER * * MONTANA STATE UNIVERSITY * * 16K SYSTEM * * SKP * *** BASE PAGE LINKAGE AREA * ORG 2B JMP 3B,I ADDRESS IS SET BY PREPARE BASIC ORG 60B A EQU 0 B EQU 1 * *** THESE LOCATIONS ARE SET BY PREPARE BASIC * .CARD BSS 1 ?PTAP DEF PTAPE LINK TO PHOTOREADER INPUT .HSPR BSS 1 PHOTOREADER LINK USN NOP ACTIVATED USER NUMBER ASTK DEF ACTIV LINK TO ACTIVE STACK * *** EXECUTION FLAGS * EXU1 NOP EXU2 NOP EXU3 NOP EXU4 NOP * *** USER STACK ADDRESSES * BSK1 BSS 1 BSK2 BSS 1 BSK3 BSS 1 BSK4 BSS 1 * ORR START DEF FLUSH START OF BASIC ?OFF BSS 1 LINK TO LOG-OFF SUBROUTINE ?MESG BSS 1 LINK TO MESSAGE EXECUTION MONIT BSS 1 PRIMARY ENTRY POINT TO MONITOR SEXU BSS 1 SET EXECITION FLAG LINK TO MONITOR IMON BSS 1 LINK TO TURN ON INT IMOFF BSS 1 LINK TO TURN OFF INT. XECUT DEF XEC4. EXECUTION RETURN I.STP DEF STOP LINK TO STOP ROUTINE * *** ACTIVE STACK LOCATION * ACTIV EQU * TAPE! BSS 1 TAPE INPUT LINK WRITE BSS 1 TTY OUTPUT LINK REED BSS 1 TTY INPUT LINK FWAM BSS 1 FIRST WORD AVAIL MEM LWAM BSS 1 LAST WORD AVAIL MEM .BUFA BSS 1 I/O BUFFER ADDRESS SYMTA BSS 1 SYMBOL TABLE END SBUFA BSS 1 SYNTAX BUFFER ADDRESS PBUFF BSS 1 FIRST WORD OF USER'S PROGRAM PBPTR BSS 1 LAST WORD+1 OF USER'S PROG BLANK BSS 1 .LNUM BSS 1 CURRENT LINE NUMBER BADDR BSS 1 I/O BUFFER CCNT BSS 1 POINTERS TFLAG NOP PHOTOREADER FLAG TTYFL NOP TAPE FLAG FCORE BSS 1 START OF FREE CORE SYMTF BSS 1 START OF SYMBOL TABLE SBPTR BSS 1 SYNTAX BUFFER POINTER LSTAK BSS 1 LOW-CORE STACK ADDRESS TSTPT BSS 1 TEMPORARY STACK POINTER LSTPT BSS 1 LOW-CORE STACK POINTER HSTPT BSS 1 HIGH-CORE STACK POINTER PRADD BSS 1 PROGRAM EXECUTION NXTST BSS 1 SEQUENCING INFORMATION TYPE BSS 1 CURRENT STATEMENT TYPE DSTRT BSS 1 DATA NXTDT BSS 1 STATEMENT DCCNT BSS 1 POINTERS RSYM BSS 1 SIGN BSS 1 EXP BSS 1 XH BSS 1 RANDOM XL BSS 1 VARIABLES EOL BSS 1 * STK1 BSS 1 * STORAGE STK2 BSS 1 * STK3 BSS 1 * FOR STK4 BSS 1 * STK5 BSS 1 * RETURN STK6 BSS 1 * STK7 BSS 1 * ADDRESSES STK8 BSS 1 * STK9 BSS 1 * IN USER STK10 BSS 1 * STK11 BSS 1 * STACK STK12 BSS 1 * STK13 BSS 1 * AREA STK14 BSS 1 * STK15 BSS 1 STK16 BSS 1 STORAGE FOR ERROR CCNT STK17 BSS 1 STOREAGE FOR ERROR BUFAD STK18 BSS 1 STORAGE FOR ERROR # STK19 BSS 1 RETURN ADDR FOR ERROR STK20 BSS 1 STK21 BSS 1 STK22 BSS 1 STK23 BSS 1 STK24 BSS 1 SBOXX BSS 1 * TEMPS BSS 12 TEMPORARIES MLBX1 EQU TEMPS+10 B1 BSS 2 * TEMPS USED B2 BSS 2 * BY MATRIX AND B3 BSS 2 * LIB FUNCTIONS A1 BSS 1 A2 BSS 1 C1 BSS 1 C2 BSS 1 FORM& BSS 1 MANT1 BSS 1 MANT2 BSS 1 EXPON BSS 1 DPFLG BSS 1 FFLAG EQU SBOXX TT1 EQU B1 TT2 EQU B2 TT3 EQU TEMPS+4 TT4 EQU TEMPS+5 MBUF DEF TEMPS MBOX1 EQU TEMPS MBIN1 EQU STK5 MBIN2 EQU STK4 MPTR EQU STK2 MNPTR EQU STK3 COML EQU TEMPS+9 MWDNO EQU TEMPS+10 HED ** BASIC LINKAGE AND CONSTANTS ** RDYA DEF READY READY ASC 2,READ OCT 54415 LFEED DEF LF QMRKA DEF QMARK STOPA DEF STCMD CMNDA DEF CMNDS QMARK OCT 37421 * RUNA DEF MFASE PHASE 2: BUILD SYMBOL TABLE FASE3 DEF XEC PHASE 3: PROGRAM EXECUTION PEXMA DEF PEXMK RETURN TO MONITOR FROM SYNTAX RDYDA DEF RDYPT RETURN TO MONITOR FROM PHASE 3 DRQSA DEF DRQST REQUEST DATA INPUT LISTA DEF LIST LIST PROGRAM MATA DEF MAT+1 EMATA DEF EMAT TSRCH DEF TBSRH SEARCH PRINT-NAME TABLE FNDPA DEF FNDPS CNSTA DEF CONST NUMCA DEF NUMCK INCHK DEF INTCK ENOTA DEF ENOUT NUMOA DEF NUMOT PGINT DEF PRGIN OUTIA DEF OUTIN OUTSA DEF OUTST OUTLA DEF OUTLN OUTCA DEF OUTCR GETCA DEF GETCR DIGCA DEF DIGCK LETCA DEF LETCK SSYMA DEF SSYMT FETCA DEF FETCH EVALUATE A FORMULA FORMA DEF FORMX .LOGA DEF .LOG .EXPA DEF .EXP .FADA DEF .FAD .FSBA DEF .FSB .FMPA DEF .FMP .FDVA DEF .FDV ARINA DEF ARINV MPYA DEF MPY FLUNA DEF .FLUN PACKA DEF .PACK FLT DEF FLOAT IFIXA DEF IFIX PRNIA DEF PRNIN CHRSA DEF CHRST ACCST DEF ACTST DELST DEF DLSTM FDAT DEF FDATA LCK2A DEF LCHK2 XEC4A DEF XEC4 FSC1A DEF FSC14 FOR1A DEF FORM1 FOR0A DEF FORM0 FOR0B DEF FOR11 FOR1B DEF FOR10 FR12A ABS FOR12 EOF JSB ERROR NOEOF JSB ERROR E8M1A DEF E8-1 ESYN3 DEF SYNE3-1 FSCEF DEF FSCE4 E6M1A DEF E6-1 ERBS DEF ERR-1 RECER DEF RCERR-ERR FOPBS DEF QUOTE-2 STBAS DEF SYNTB-26,I XECBR DEF XECTB-26,I ARBAS DEF AROTB-6,I PDFBS DEF PDFT-1 TBLAD DEF SYCMD STTYP DEF LET MATIO DEF READ MCBOP DEF AND PDFNS DEF SIN MATFN DEF ZER ANEXT DEF NEXT ADATA DEF DATA ATHEN DEF THEN ATO DEF TO ASTEP DEF STEP ANOT DEF NOT ATAB DEF TAB MBXL DEF MLBX1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .7 DEC 7 .8 DEC 8 .9 DEC 9 .10 DEC 10 .12 DEC 12 .15 DEC 15 .23 DEC 23 .26 DEC 26 .27 DEC 27 .28 DEC 28 .30 DEC 30 .31 DEC 31 .32 DEC 32 .33 DEC 33 .34 DEC 34 .35 DEC 35 .36 DEC 36 .37 DEC 37 .40 DEC 40 .41 DEC 41 .43 DEC 43 .45 DEC 45 .46 DEC 46 .47 DEC 47 .48 DEC 48 .49 DEC 49 .58 DEC 58 .63 DEC 63 B100 OCT 100 E OCT 105 F OCT 106 .72 DEC 72 .74 DEC 74 .75 DEC 75 N OCT 116 R OCT 122 S OCT 123 B133 OCT 133 B177 OCT 177 B200 OCT 200 MSK0 OCT 377 B400 OCT 400 B776 OCT 776 MSK1 OCT 777 B1000 OCT 1000 B2000 OCT 2000 B3000 OCT 3000 SCCNT OCT 3002 B4000 OCT 4000 LF OCT 5000 B1400 OCT 14000 UNMNC OCT 21000 B2200 OCT 22000 B2300 OCT 23000 DEFOP OCT 35000 REMOP OCT 36000 RDOP OCT 52000 TENTH OCT 63146 OPMSK OCT 77000 MSK4 OCT 77600 INF OCT 77777 TYPFL OCT 100017 TABCN OCT 100037 OPDMK OCT 100777 UNNRM OCT 140000 HIMSK OCT 174000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M6 DEC -6 M7 DEC -7 M8 DEC -8 M9 DEC -9 M10 DEC -10 M11 DEC -11 M15 DEC -15 M16 DEC -16 M19 DEC -19 M21 DEC -21 M25 DEC -25 M32 DEC -32 D53 OCT -53 D72 OCT -72 D100 OCT -100 M72 DEC -72 M73 DEC -73 M76 DEC -76 D133 OCT -133 M256 DEC -256 M310 DEC -310 M1000 DEC -1000 MAXSN DEC -10000 MSK3 EQU M7 FN ASC 1,FN HALF OCT 40000 NOP HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG MAXFX DEC -999999.5 MINFX DEC -0.099999959 COLON EQU .58 TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 COUNT EQU TEMPS+6 STEMP EQU TEMPS+4 ARYAD EQU B3+1 LFLAG EQU STK15 DIGCT EQU STK20 DIVSR EQU STK21 LDZRO EQU STK22 MIND EQU STK23 HED ** BASE PAGE SUBROUTINES ** * *** EMIT ERROR MESSAGE * ERROR NOP LDA ERROR SAVE ERROR RETURN STA STK19 STORE RETURN ADDRESS LDA CCNT SAVE CHAR-OUT COUNT STA STK16 SAVE COUNT LDA BADDR SAVE I/O BUFFER STA STK17 SAVE ADDRESS * CLA SET EXU FLAG TO I/O JSB SEXU,I TO "IN I/O" STA TTYFL TAPE FLAG TO ZERO STA CCNT CHARS-OUT COUNT TO ZERO JSB WRITE,I OUTPUT CR-LF LDB .35 ADB .BUFA COMPUTE BUFF ADR-1 STB BADDR STORE AS POINTER * LDA E LOAD ASCII "E" JSB OUTCR PUT IT IN BUFFER LDA R LOAD ASCII "R" JSB OUTCR PUT IT IN BUFFER JSB OUTCR PUT IT IN BUFFER LDA BLANK LOAD BLANK JSB OUTCR PUT IT IN BUFFER * LDB STK19 LOAD RETURN ADDRESS LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB A,I SAME AS ACTUAL ERROR CMA,INA,RSS YES JMP *-3 NO ADA ERBS COMPUTE ERROR STA STK18 SAVE NEG. ERROR NUMBER CMA,INA JSB OUTIA,I PUT ERROR CODE IN BUFFER LDA COLON LOAD COLON JSB OUTCR PUT IT IN BUFFER LDA .LNUM LOAD LINE NUMBER JSB OUTIA,I PUT IT IN BUFFER * *** OUTPUT ERROR CODE ON TTY * LDA CCNT LDB .36 ADB .BUFA INDEX TO BUFF START ADR JSB WRITE,I OUTPUT ERR MESSAGE ON TTY * LDA STK18 GET ERROR NUMBER ADA RECER RECOVERABLE ERROR? SSA,RSS JMP PEXMA,I RETURN TO SYNTAX MODE CLA,INA SET EXECUTION JSB SEXU,I FLAG TO IN EXU. LDA STK16 LOAD COUNT LDB STK17 LOAD ADDRESS STA CCNT CCNT AND STB BADDR BADDR JMP STK19,I RETURN * ** *** MOVE WORDS TO HIGHER CORE ** ** MVTOH NOP LDB TEMP2 FETCH SOURCE ADDRESS MVTO1 CPB TEMP3 ALL RELOCATION DONE? JMP MVTOH,I YES,EXIT CCA BACK UP ADA TEMP4 SOURCE AND STA TEMP4 DESTINATION ADB M1 ADDRESSES LDA 1,I MOVE STA TEMP4,I WORD JMP MVTO1 ** *** INPUT A CONSTANT ** ** CONST NOP LDB CONST STB STK6 JSB GETCR JMP STK6,I CLB SET SIGN STB SIGN POSITIVE INB CPA .43 "+"? JMP CONS1 YES, IGNORE IT CPA .45 "-"? CCB,RSS YES JMP CONS2 NO CONS1 STB SIGN RECORD SIGN JSB GETCR FETCH NEXT JMP SYE12-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND ISZ STK6 JMP STK6,I CONS3 CPB SIGN CCA,RSS JSB ERROR SYE12 JMP STK6,I ** *** FETCH NUMBER AND CONVERT TO BINARY ** ** NUMCK NOP CHARACTER IN (A), SIGN SET LDB NUMCK STB STK7 CLB STB EXP ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON STB TEMP3 SET "NUMBER" FLAG FALSE CCB SET "DECIMAL POINT" STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXP SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXP EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 YES, SET "NUMBER" FLAG TRUE JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXP BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 SET EXPONENT PART TO ZERO CPB TEMP3 OR DIGIT FOUND? JMP STK7,I CPA E "E"? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR NUMER JSB ERROR CPA .43 JMP NUMC8 CPA .45 NO, "-"? CCA,RSS JMP NUMC9 YES STA TEMP4 NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK JMP NUMER STA TEMP3 JSB GETCR JMP NUM10 JSB DIGCK JMP NUM10 LDB TEMP3 BLS,BLS ADB TEMP3 BLS ADA 1 STA TEMP3 JSB GETCR JMP NUM10 JSB DIGCK RSS JMP NUMER NUM10 LDA TEMP3 ISZ TEMP4 CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) ISZ SBPTR STA SBPTR,I STORE ISZ SBPTR NUMBER IN STB SBPTR,I PROPER ISZ SBPTR LOCATION JSB BCKSP FETCH JSB GETCR FIRST LDA .10 UNUSED CHARACTER ISZ STK7 JMP STK7,I ** *** NORMALIZE AND PACK FLOATING POINT NUMBER ** ** .PACK NOP MANTISSA IN (A) AND (B), JSB NORML EXPONENT IN EXP, (E) CLEARED CLE,SZA,RSS ZERO RESULT? JMP .PACK,I ADB B177 NO, ROUND SSA,RSS POSITIVE NUMBER? INB YES, FINISH ROUND CLO SEZ OVERFLOW FROM (B)? CLE,INA YES, BUMP (A) SOS OVERFLOW? (A=100000, B=0) RAL SSA,SLA,RSS TWO HIGH BITS 1'S? (A=140000)) JMP PACK1 NO CCE YES ARS,SLA,ALS SET (A) =100000 AND SKIP PACK1 RAR COUNTERPART TO *-5 STA MBY10 SAVE (A) LDA 1 DELETE 8 LOW AND M256 ORDER BITS OF MANTISSA STA 1 SAVE LOWER MANTISSA LDA .PACK STA STK14 LDA EXP FETCH EXPONENT SEZ DECREMENT EXPONENT? ADA M1 YES SOC NO, PRIOR OVERFLOW? INA YES, INCREMENT EXPONENT ADA B200 NO, EXPONENT SSA UNDERFLOW? JMP PACK3 YES ADA M256 NO, EXPONENT SSA,RSS OVERFLOW? JMP PACK4 YES ADA B200 NO, RESTORE EXPONENT, RAL POSITION SIGN, AND MSK0 MASK TO 8 BITS, AND ADB 0 COMBINE WITH LOW MANTISSA LDA MBY10 RETRIEVE HIGH MANTISSA CPA MNEG RSS NEGATIVE JMP STK14,I CPB MNEG+1 OVERFLOW? JMP PACK4 YES JMP STK14,I PACK3 JSB ERROR UNDER CLA ZERO RESULT CLB ON UNDERFLOW JMP STK14,I PACK4 JSB ERROR OVRER LDA MBY10 JSB OVFLW JMP STK14,I ** *** LOAD INFINITY ON OVERFLOW ** ** OVFLW NOP LDB M2 SSA LDB B776 IOR INF SSA LDA MNEG JMP OVFLW,I INFINITY ** *** NORMALIZE (A), (B), AND EXP ** ** NORML NOP SET STA MBY10 LEFT-SHIFT CLA COUNTER STA MPY TO ZERO LDA MBY10 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA EXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ MPY COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, -UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA MPY COMPUTE CMA,INA CORRECTED ADA EXP EXPONENT STA EXP VALUE LDA MANT1 JMP NORM1 ** *** MULTIPLY UNPACKED NUMBER BY 10 ** ** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXP MULTIPLY ADB .3 BY STB EXP 8 LDB MANT2 LOAD MANTISSA CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA SSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXP OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I ** *** DIVIDE UNPACKED NUMBER BY 10 ** ** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXP "TENTH" TO STB EXP MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER MANTISSA JSB MPY MULTIPLY BY DEF TENTH 63146 (ONE TENTH) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA * SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO JSB MPY SAME DEF TENTH FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I ** *** MULTIPLY INTEGER IN (A) ** ** MPY NOP ADDRESS OF MULTIPLIER IN MPY,I LDB M2 SET -2 IN STB MBY10 SIGN TEMP LDB MPY,I LOAD LDB 1,I MULTIPLIER CLE,SSA (A) NEGATIVE? CMA,CME,INA YES COMPLEMENT (A) AND (E) SSB (B) NEGATIVE? CMB,CME,INB YES, COMPLEMENT (B) AND (E) SEZ (E) = 0? ISZ MBY10 NO, SET SIGN OF RESULT NEGATIVE STB NORML SAVE MULTIPLIER LDB M16 SET STB MVTOH COUNTER CLB ZERO PRODUCT ELA BIAS (A) TO LEFT MPY1 ERA,CLE,SLA SHIFT, TEST, ADB NORML AND ADD UPON ERB NON-ZERO BIT ISZ MVTOH DONE? JMP MPY1 NO ERA,CLE YES, ADJUST FINAL RESULT ISZ MBY10 NEGATIVE RESULT? JMP MPY2 NO CMB YES CMA,INA,SZA,RSS COMPLEMENT INB RESULT MPY2 CLO ISZ MPY JMP MPY,I ** *** FIND AND STORE ONE-CHARACTER OPERATORS ** ** SYMCK NOP CHARACTER IN (A) STB COUNT -(ENTRIES TO BE SEARCHED) ALF,ALF POSITION IOR .32 CHARACTER LDB SYMCK,I STARTING TABLE ENTRY -2 ISZ SYMCK SET RETURN ADDRESS SYMC1 ADB .2 UPDATE TABLE POINTER CPA 1,I MATCH? JMP SYMC2 ISZ COUNT NO, CONTINUE SEARCH? JMP SYMC1 YES ALF,ALF NO, RESTORE AND B177 CHARACTER JMP SYMCK,I AND EXIT SYMC2 CCA GET ADA 1 INFORMATION LDA 0,I WORD AND OPMSK AND STA SBPTR,I STORE IT CPA B1400 JMP FSC1A,I ISZ SYMCK RETURN VIA JMP SYMCK,I (P+2) ** * ************************************************* * SUBROUTINE TO COMPUTE THE STORAGE REQUIRED BY AN * ARRAY WHOSE PACKED DIMENSIONS ARE IN A UPON ENTRY * ************************************************* ** * THE SUBROUTINE RETURNS IN A THE NUMBER OF LOCATIONS * REQUIRED FOR THE SPECIFIED DIMENSIONS * = 2*DIM1*DIM2 ** MDIM NOP STA 1 STORE PACKED DIMS. TEMPORARILY AND MSK0 STA .FLUN LDA 1 ALF,ALF AND MSK0 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT JSB MPY DEF .FLUN SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I ** *** ROUND A SUBSCRIPT TO AN INTEGER ** ** SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB IFIX INTEGERIZE JMP E6M1A,I SEZ,RSS ADB M1 SZA,RSS SSB JMP E6M1A,I JMP SBFIX,I ** *** INTEGERIZE FLOATING POINT NUMBER ** ** IFIX NOP NUMBER IN (A) AND (B) STO STA STK15 JSB .FLUN UNPACK LOW WORD SSA JMP IFIX3 YES ADA M16 SSA CLO ADA M8 SSA,RSS JMP IFIX,I ADA M8 STA .FLUN LDA STK15 JMP IFIX2 IFIX1 CLE,SLA,ARS CME TO A(0) SLB,ERB STO OVERFLOW ON NON-INTEGER IFIX2 ISZ .FLUN JMP IFIX1 YES ISZ IFIX JMP IFIX,I NO, (E) = 0 FOR INTEGER NUMBER IFIX3 LDA STK15 CLE,SSA CCA,RSS CLA,RSS CCB,RSS CLB JMP IFIX2+2 ** *** TAKE ARITHMETIC INVERSE ** ** ARINV NOP NUMBER IN (A) AND (B) STA STK4 LDA 1 LDB STK4 CMB,CLE COMPLEMENT HIGH PART XOR M256 COMPLEMENT LOW PART ADA B400 ADD IN 1 SEZ,RSS OVERFLOW? JMP ARIN2 NO INB YES, INCREMENT HIGH MANTISSA CPB FLGBT OVERFLOW? JMP ARIN1 YES CPB UNNRM NO, NEGATIVE UNNORMALIZED? RSS YES JMP ARIN2 NO ARIN1 ADB UNNRM FIX HIGH MANTISSA SLA,RAR POSITION EXPONENT IOR MSK4 FILL IN BITS IF NEGATIVE SSB,RSS POSITIVE? INA,RSS YES, BUMP EXPONENT ADA M1 NO, DECREMENT EXPONENT RAL POSITION AND MSK0 EXPONENT ARIN2 STA STK4 LDA 1 LDB STK4 JMP ARINV,I ** *** UNPACK LOW WORD OF NUMBER ** ** .FLUN NOP WORD IN (B) LDA 1 (A) = (B) AND MSK0 EXTRACT EXPONENT IN (A) CMB SUBTRACT OFF ADB 0 EXPONENT FROM CMB MANTISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR MSK4 YES, FILL IN LEADING BITS JMP .FLUN,I NO ** *** STACK (B) ON LOW CORE STACK ** ** SLWST NOP ISZ LSTPT ADVANCE 'LOW LDA LSTPT STACK' POINTER CPA HSTPT STACK OVERFLOW? E1 JSB ERROR YES STB LSTPT,I NO, STACK (B) JMP SLWST,I ** *** BUMP HIGH STACK POINTER ** ** BHSTP NOP CCB ADVANCE ADB HSTPT STB HSTPT POINTER CPB LSTPT OVERFLOW? JMP E1 YES JMP BHSTP,I NO ** *** FETCH TOP OF STACK ** ** STTOP NOP JSB OPCHK VALIDATE JSB RSCHK OPERAND LDB HSTPT,I SAVE LDA 1,I LOAD INB LDB 1,I NUMBER JMP STTOP,I ** *** VERIFY LEGITIMACY OF OPERAND ** ** OPCHK NOP LDB HSTPT,I OPERAND ADDRESS TO (B) LDA 1,I HIGH PART OF CPA MNEG OPERAND 100000B? INB,RSS JMP OPCH1 NO LDA 1,I OF OPERAND CPA MNEG+1 776B? JSB ERROR YES E8 ADB M1 OPCH1 CPB TSTPT TEMPORARY OPERAND? RSS YES JMP OPCHK,I NO LDA TSTPT UNSTACK ADA M2 THE TEMPORARY STA TSTPT OPERAND JMP OPCHK,I EXIT WITH ADDRESS IN (B) ** *** ALLOT SPACE FOR INTERMEDIATE RESULT ** ** RSCHK NOP LDA TSTPT ALLOT ADA .2 STA TSTPT SPACE ADA M1 OVERFLOW INTO CPA LSTAK LOW-CORE STACK? RSS YES JMP RSCHK,I NO LDA LSTAK SAVE INA LOWER STA TEMP3 STACK BOUND ADA .9 UPDATE STA LSTAK STACK BOTTOM LDA LSTPT SET INA SOURCE STA TEMP2 ADDRESS ADA .9 UPDATE STA LSTPT STACK TOP INA SET DESTINATION STA TEMP4 ADDRESS CMA,INA OVERFLOW ADA HSTPT INTO SSA HIGH-CORE STACK? JMP E1 YES JSB MVTOH NO, MOVE JMP RSCHK,I LOW-CORE STACK ** *** CHECK FOR DIGIT ** ** DIGCK NOP CHARACTER IN (A) LDB 0 ADB D72 ASCII 72B SSB,RSS OR GREATER? JMP DIGCK,I YES, RETURN WITH CHARACTER ADB .10 NO, ASCII 60B SSB OR GREATER? JMP DIGCK,I NO ISZ DIGCK YES, SET "SUCCESS" EXIT, LDA 1 LOAD DIGIT INTO (A), JMP DIGCK,I AND RETURN ** *** CHECK FOR LETTER ** ** LETCK NOP CHARACTER IN (A) LDB 0 ADB D133 ASCII 133B SSB,RSS OR GREATER? JMP LETCK,I YES, EXIT WITH CHARACTER IN (A) ADB .26 NO, ASCII 101B SSB,RSS ISZ LETCK YES, SET "SUCCESS" EXIT, JMP LETCK,I AND RETURN ** *** GET A CHARACTER FROM INPUT BUFFER ** GETCR NOP ISZ CCNT ANY CHARACTERS LEFT? RSS JMP GETCR,I NO, END-OF-FILE EXIT LDB BADDR LOAD BUFFER ADDRESS ISZ BADDR UPDATE FOR NEXT TIME CLE,ERB SET CHARACTER FLAG LDA 1,I LOAD CURRENT BUFFER WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 MASK EXTRANEOUS BITS CPA BLANK BLANK? JMP GETCR+1 YES, FETCH NEXT CHARACTER ISZ GETCR UPDATE RETURN ADDRESS JMP GETCR,I AND EXIT ** *** BACKSPACE OVER ONE CHARACTER ** ** BCKSP NOP CCA BACKSPACE ADA CCNT OVER STA CCNT LAST CCA CHARACTER IN ADA BADDR INPUT STA BADDR BUFFER JMP BCKSP,I ** *** PRINT A NUMBER ** ** ENOUT NOP STB BCKSP LDB ENOUT STB STK13 LDB BCKSP CCE SET SIGN FLAG TRUE JSB NUMOA,I OUTPUT THE NUMBER JSB OUTLN END-OF-LINE ACTION LDA .32 OUTPUT JSB OUTCR A BLANK LDB MLBX1+1 ADB CCNT SZB FULL? JMP *-5 NO JMP STK13,I ** *** SPACE FOR A COMMA ** ** EDELM NOP LDB EDELM LOAD ADDRESS STB STK2 LDB CCNT NO, LOAD CHARACTER COUNT EDEL1 SZB,RSS ZERO? JMP STK2,I ADB M15 NO, SUBTRACT ZONE WIDTH SSB,RSS NEGATIVE RESULT? JMP EDEL1 NO STB STK4 LDA .32 FETCH BLANK JSB OUTCR OUTPUT ISZ STK4 JMP *-3 BLANKS LDB CCNT LINE ADB M76 SSB,RSS FULL? JSB OUTLN YES JMP STK2,I ** *** OUTPUT A COMPLETED LINE ** OUTLN NOP LDA OUTLN LOAD RETURN ADDRESS STA STK4 LDA TYPE FETCH 'CHARACTERS PRINTED' COUNT SLA CORRECT FOR START ON INA ODD PRINT POSITION ADA CCNT OUTPUT LDB .BUFA A JSB WRITE,I LINE LDB MLBX1+1 ADB CCNT STB MLBX1+1 CLA RESET COUNT OF STA TYPE CHARACTERS PRINTED JSB PRNIA,I CLEAN UP JMP STK4,I ** *** ADD A CHARACTER TO OUTPUT BUFFER ** ** OUTCR NOP CHARACTER IN (A) STA IFIX SAVE CHARACTER ISZ CCNT COUNT IT LDB CCNT FIRST CHARACTER SLB OF BUFFER WORD? ISZ BADDR YES, MOVE TO FRESH WORD LDA BADDR,I LOAD BUFFER WORD SLB SAVE ALF,ALF OTHER AND M256 CHARACTER IOR IFIX ADD NEW CHARACTER SLB POSITION ALF,ALF WORD AND STA BADDR,I STORE IT JMP OUTCR,I HED BASIC INTERPRETER CONTROL * *** BASIC INTERPRETER CONTROL * * FLUSH LDA FWAM STA PBUFF SET PROGRAM BUFFER ADR STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER STA .LNUM TO ZERO * RDYPT CLA JSB SEXU,I SET EXU FLAG TO ZERO STA STK12 SET DATA REQUEST TO ZERO STA TFLAG CLEAR PHOTO-READER FLAG STA TTYFL CLEAR TTY TAPE FLAG JSB WRITE,I OUTPUT CR-LF LDA M6 OUTPUT LDB RDYA "READY" JSB WRITE,I ON TTY * *** CHECK IF INPUT IS FROM PHOTOREADER * PEXMK LDA TFLAG LOAD PHOTOREADER FLAG SSA CHECK IF PTAPE MODE JMP PTAPE YES- INPUT FROM PHOTO RDR * LDB LFEED LOAD LF ADDRESS STB RSYM STAOR FOR EMIT LF * *** CHECK FOR TAPE MODE * DATAI LDA TTYFL LOAD TAPE FLAG SZA,RSS IS IT SET? JMP KEYIN NO- GET KEYBOARD INPUT JMP MONIT,I YES: GO DIRECTLY TO MONITOR !TAPE JSB TAPE!,I SET UP TAPE INPUT SZA JMP RPRCS -TAPE: NOT FINISHED RETURN- JMP RDYPT -TAPE: FINISHED RETURN- * KEYIN LDA M2 SET TO OUTPUT 2 CHARS LDB RSYM LOAD LF OR '? X-ON' ADR JSB WRITE,I PRINT LF OR '? X-ON', NO CR * *** GET INPUT FROM TTY KEYBOARD * GTRCD JSB IMOFF,I KEYINT3 LDA .72 LDB .BUFA JSB REED,I GET RECORD FROM TTY CPA M2 JMP RBOUT RUBOUT IN RECORD, INPUT AGAIN RPRCS CMA,SSA,RSS SET A=-U-#CHARS AND JSB ERROR CHECK FOR RECORD TOO LONG RTLE STA CCNT -1-# CHARS <0,SET CCNT LDA .BUFA LOAD BUFFER ADDRESS CLE,ELA SHIFT LEFT, LEAST BIT STA BADDR USED AS ODD/EVEN FLAG JSB GETCR FIRCH FIRST CHARACTER JMP DATAI-2 NULL RECORD- INPUT AGAIN LDB STK12 SZB,RSS DATA REQUEST? JMP CKRCD NO- CHECK FOR COMMAND CPA S ASCII S FIRST CHAR? JSB STOP ASSUME STOP REQUESTED CLA OUTPUT CR-LF JSB WRITE,I ON TTY JSB BCKSP BACKSPACE 1 CHAR JSB IMON,I LDB STK12 CLA CLEAR DATA REQUEST FLAG STA STK12 JMP B,I GO TO DATA REQUEST CALL POINT * ASC 1,\ DEF *-1 RBOUT LDB *-1 OUTPUT '/' WITH CLA,INA CARRIAGE RETURN JSB WRITE,I AND LINE-FEED JMP KEYIN+3 * ** THIS SECTION REQUESTS DATA INPUT * DRQST NOP LDB DRQST SAVE RETURN ADDRESS STB STK12 AND FLAG LDB QMRKA JMP DATAI-1 PRINT '?-X-ON' AND WAIT * ** THIS SECTION CHECKS RECORDS FOR SYS COMMANDS * CKRCD LDB SBUFA STB SBPTR STA SBPTR,I JSB LETCK JMP SYNTX * CLA OUTPUT CR-LF STA TTYFL SET TTY TAPE FLAG JSB WRITE,I ON TTY LDA TBLAD LDB M9 SET TO SEARCH TABLE OF 9 COMMANDS JSB TSRCH,I JSB ERROR INVSC EQU * INVALID CMND ERROR REFERENCE ALF,ALF ARS ADA CMNDA JMP A,I * *** THIS SECTION SETS UP AND EXECUTES THE SYSTEMS COMMANDS * CMNDS EQU * COMMAND LIST REFERENCE * *** RUN COMMAND * RUN JSB IMON,I JMP RUNA,I * *** SCRATCH COMMAND * SCRTH JMP FLUSH DELETE CURRENT PROGRAM * *** LIST COMMAND * CLB * *** PLIST COMMAND * PLIST STB STK18 SET PUNCH FLAG JSB IMON,I JMP LISTA,I GO TO LIST ENTRY POINT * *** PTAPE COMMAND * PTAPE LDA TFLAG LOAD PHOTO/CARD FLAG ERA SET FLAG FOR CARD OR PHOTO LDA .72 ASK FOR 72 CHARS INPUT LDB .BUFA SEZ MAKE CALL TO CORRECT DRIVER JSB .HSPR,I GET INPUT FROM PHOTORDR JSB .CARD,I GET INPUT FROM CARD READER CPA M3 END-OF-TAPE? JMP RDYPT YES- GO TO ENTRY POINT * PRERR SZA,RSS NULL RECORD? JMP PTAPE YES- READ AGAIN JMP RPRCS GO PROCESS RECORD * *** STOP COMMAND * STOP NOP JSB IMOFF,I CLA CLEAR EXECUTION JSB SEXU,I FLAG JSB WRITE,I OUTPUT A CR-LF LDA .4 LDB STOPA PRINT "STOP" JSB WRITE,I JMP RDYPT GO TO READY POINT * *** TAPE COMMAND * TAPE CLB CLEAR TTY FLAG STB TFLAG STA TTYFL JSB IMOFF,I JMP !TAPE SET UP TAPE INPUT * *** EXECUTE LOG-OFF COMMAND * JMP ?OFF,I * *** MESG COMMAND * JMP ?MESG,I * *** RENUMBER COMMAND * JMP ?NBER,I EXECUTE "RENUMBER" COMMAND * ?NBER DEF RENUM LINK TO RENUMBER EXECUTION * HED CHECK SYNTAX AND TRANSLITERATE * * *** CHECK SYNTAX OF STATEMENT *** * ** *** DETERMINE SEQUENCE NUMBER ** ** SYNTX JSB INCHK,I RECORD DEF MAXSN SEQUENCE NUMBER ISZ SBPTR SAVE SPACE FOR LENGTH WORD STB .LNUM SAVE LINE NUMBER LDB SBUFA SET INB TEMP TO STB TEMP (SBUFF)+1 ** *** DETERMINE STATEMENT TYPE ** ** CPA .10 NULL STATEMENT? JMP DELST,I YES, DELETE IT STA SBPTR,I NO, RECORD NEXT CHARACTER LDA STTYP PRINT-TABLE ADDRESS LDB M19 -(NUMBER OF ENTRIES) JSB TSRCH,I FIND STATEMENT TYPE JSB ERROR NOT FOUND SYNE1 LDB M9 STB MSFLG TO FALSE LDB PBPTR SET S-STACK CPB PBUFF RSS JMP SYNT1 LDB FWAM STB PBUFF STB PBPTR SYNT1 STB TEMPS CLB SET DEFINE FLAG STB DFLAG TO FALSE STB PFLAG SET PARAMETER FLAG TO FALSE ALF,ALF COMPUTE RAR ADDRESS OF ADA STBAS SYNTAX ROUTINE AND JMP 0,I BRANCH TO IT ** *** SINGLE CHARACTER AND/OR FORMULA OPERATORS ** ** QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD ASC 1," COMMA OCT 2000 ARE THE BASIC CODE OPERATOR ASC 1,, SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE ASC 1,; RPARN OCT 4001 OPERATOR'S HIERARCHICAL ASC 1,) RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS ASC 1,] SCMMA OCT 6002 BELONGING TO FORMULAS. THE ASC 1,, ASSOP OCT 7002 UNLABELED WORD GIVES THE ASC 1,= PLUS OCT 10007 ASCII REPRESENTATION OF THE ASC 1,+ MINUS OCT 11007 SINGLE CHARACTER OPERATORS. ASC 1,- TIMES OCT 12010 ASC 1,* DIV OCT 13010 ASC 1,/ EXPS OCT 14012 ASC 1,^ GTR OCT 15005 ASC 1,> LSS OCT 16005 ASC 1,< UNEQL OCT 17005 ASC 1,# EQUAL OCT 20005 ASC 1,= UNMIN OCT 21011 ASC 1,- LBRAC OCT 22020 ASC 1,[ LPARN OCT 23020 ASC 1,( UPLUS OCT 24011 ASC 1,+ OROP OCT 25003 MSFLG NOP ANDOP OCT 26004 DFLAG NOP NOTOP OCT 27011 PFLAG NOP GTREQ OCT 30005 UFLAG NOP LSSEQ OCT 31005 * ** LET STATEMENT SYNTAX ** * LETS STB SFLAG LDA M8 SET MULTIPLE STORE FLAG STA MSFLG TO TRUE JSB FSC FETCH FORMULA CPB SFLAG STORE OCCUR? JSB ERROR NO SYNE2 EQU * ** *** CHECK FOR END OF STATEMENT ** ** EOST CPA .10 END-OF-STATEMENT? JMP ACCST,I YES, ACCEPT STATEMENT JMP NOEOF NO, ILLEGAL CHARACTER * *** DIM STATEMENT SYNTAX * DIMS ISZ DFLAG SET DFLAG TO TRUE JSB ARRYS CHECK AN ARRAY JMP ACCST,I DONE JMP DIMS+1 WAS A COMMA, CONTINUE * *** COM STATEMENT SYNTAX * COMS LDB PBPTR HAS A PROGRAM BUFFER CPB FWAM BEEN MOVED? RSS NO JSB ERROR YES, ILLEGAL COM SYNE3 STB TEMPS+7 SET ARRAY POINTER ISZ DFLAG SET DEFINE FLAG TO TRUE COMS1 CCA SET COMMON FLAG STA PFLAG TO TRUE JSB ARRYS CHECK AN ARRAY RSS DONE JMP COMS1 MORE ARRAYS LDB TEMPS+7 FETCH UPDATED POINTER STB PBUFF SET PROGRAM BUFFER ADDRESS STB PBPTR SET PROGRAM BUFFER POINTER JMP ACCST,I EXIT * *** DEF STATEMENT SYNTAX * DEFS JSB LTR JMP SYNE4 FIRST LDA TEMP1 ALF,ALF TWO CHARACTERS IOR TEMP2 CPA FN 'FN'? RSS YES JMP SYNE4 NO JSB LTR LETTER FOLLOWS? SYNE4 JSB ERROR NO LDA TEMP1 YES, RECORD LDB .58 FUNCTION JSB STROP NAME LDA TEMP2 RETRIEVE NEXT CHARACTER JSB LPCK LEFT PARENTHESIS? IOR FLGBT YES, SET FORMAL STA SBPTR,I PARAMETER BIT JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JSB ERROR SUBSCRIPTED VARIABLE FOUND SYNE5 JSB RPCK RECORD A RIGHT PARENTHESIS CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? SYNE6 JSB ERROR NO LDA M2 YES, ADA SBPTR RETRIEVE LDA 0,I PARAMETER AND MSK1 AND STA PFLAG SAVE IT JSB FSC FETCH DEFINING FORMULA JMP EOST END-OF-STATEMENT TEST * *** REM STATEMENT SYNTAX * REMS LDA .10 DUMMY STRING TERMINATOR JSB CHRSA,I FETCH CHARACTER STRING JMP ACCST,I * *** IF STATEMENT SYNTAX * IFS JSB FSC GET DECISION FORMULA STA SBPTR,I TABLE LDA ATHEN SEARCH CCB FOR JSB TSRCH,I 'THEN' JSB ERROR NOT FOUND SYNE7 EQU * * *** GOTO AND GOSUB STATEMENT SYNTAX * GOTOS JSB PGINT,I FETCH AND RECORD DEF MAXSN SEQUENCE NUMBER JMP EOST END-OF-STATEMENT TEST * *** FOR STATEMENT SYNTAX * FORS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND SYNE8 JSB ERROR SUBSCRIPTED VARIABLE FOUND CCB JSB SYMCK ASSIGNMENT DEF ASSOP-1 OPERATOR? JMP SYNE6 NO JSB FSC YES, FETCH INITIAL VALUE FORMULA STA SBPTR,I LOOK LDA ATO FOR CCB THE JSB TSRCH,I 'TO' JSB ERROR MISSING SYNE9 JSB FSC CPA .10 END-OF-STATEMENT? JMP ACCST,I YES CCB FOR ADB SBPTR STB SBPTR STA SBPTR,I NO, LDA ASTEP LOOK CCB JSB TSRCH,I THE 'STEP' JSB ERROR MISSING SYE10 JSB FSC JMP EOST END-OF-STATEMENT TEST * *** NEXT STATEMENT SYNTAX * NXTS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE8 SUBSCRIPTED VARIABLE FOUND JMP EOST END-OF-STATEMENT TEST * *** END, STOP, RESTORE, RETURN STATEMENT SYNTAX * ENDS ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACCST,I YES JMP NOEOF NO * *** DATA STATEMENT SYNTAX * DATAS JSB CONST FETCH A CONSTANT JMP SYE12-1 JSB NUMOP CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA JMP EOST END-OF-STATEMENT TEST JMP DATAS FETCH ANOTHER NUMBER * *** READ AND INPUT STATEMENT SYNTAX * READS JSB VAROP RECORD VARIABLE OPERAND JSB ERROR MISSING SYE13 NOP CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA RSS JMP READS IS, FETCH NEXT ITEM CLB APPEND STB SBPTR,I END-OF-FORMULA ISZ SBPTR OPERATOR JMP EOST END OF STATEMENT TEXT * *** PRINT STATEMENT SYNTAX * PRIN1 LDB M2 NO, JSB SYMCK COMMA OR DEF COMMA-1 SEMICOLON? JMP PRIN2 NO PRINS CCA YES, ENABLE STA TEMP,I FORMULA ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACCST,I YES PRIN2 CCB JSB SYMCK QUOTE? DEF QUOTE-1 JMP PRIN3 NO LDA .34 YES, SET QUOTE AS TERMINATOR JSB CHRSA,I CHARACTER AND FETCH STRING JSB ERROR MISSING QUOTE SYE14 LDA QUOTE RECORD STA SBPTR,I QUOTE ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACCST,I YES CCB ENABLE STB TEMP,I FORMULA JMP PRIN1 NO PRIN3 ISZ TEMP,I TAB OR FORMULA PERMITTED? JSB ERROR NO SYE15 STA SBPTR,I SEARCH LDA ATAB FOR CCB 'TAB' JSB TSRCH,I CLA,RSS LDA TABCN FOUND, CCB ADB SBPTR STB SBPTR SZA,RSS JMP PRIN4 IOR SBPTR,I STA SBPTR,I RECORD 'TAB' JSB GETPF FETCH PARAMETER CLB STB SBPTR,I ISZ SBPTR JMP PRIN5 PRIN4 JSB BCKSP BACKSPACE OVER LAST CHARACTER JSB FSC FETCH FORMULA PRIN5 CPA .10 END-OF-STATEMENT? JMP ACCST,I YES JMP PRIN1 NO * *** MAT STATEMENT SYNTAX * MATS JSB LTR FIRST JSB ERROR TWO CHARACTERS SYE16 JSB LETCK LETTERS? JMP MATS2 NO ISZ SBPTR YES, MOVE TO FRESH S-BUFFER WORD LDB TEMP1 RETRIEVE FIRST LETTER AND BLF,BLF PUT IT IN THE IOR 1 UPPER CHARACTER OF (A) STA SBPTR,I SEARCH LDA MATIO FOR LDB M2 'READ' OR JSB TSRCH,I 'PRINT' JSB ERROR NOT FOUND SYE17 CPA RDOP JMP MATS1 YES MATS0 JSB ARRID RECORD ARRAY CPA .10 END-OF-STATEMENT? JMP ACCST,I YES LDB M2 NO, JSB SYMCK COMMA OR DEF COMMA-1 SEMICOLON? JSB ERROR NO SYE18 JSB GETCR END-OF-STATEMENT? JMP *+3 YES JSB BCKSP NO JMP MATS0 ISZ SBPTR INCLUDE JMP ACCST,I PARAMETER MATS1 JSB ARRID RECORD ARRAY JSB MAT&,I NOP RECORD IT CPA .10 END-OF-STATEMENT JMP ACCST,I YES CCB NO JSB SYMCK DEF COMMA-1 COMMA? JMP SYE18-1 NO JMP MATS1 YES MATS2 STA TEMP2 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE FIRST LETTER LDB .46 RECORD AN JSB STROP ARRAY LDA TEMP2 RETRIEVE CHARACTER CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? JMP SYNE6 NO LDA ARYAD,I YES RETRIEVE AND MSK1 AND SAVE STA TEMP,I PREVIOUS ARRAY IDENTIFIER JSB LTR LETTER NEXT? JMP MATS4 NO JSB LETCK YES, SECOND LETTER? JMP MATS5 NO ISZ SBPTR YES, LDB TEMP1 CONCATENATE BLF,BLF LETTERS IOR 1 AND STA SBPTR,I SEARCH LDA MATFN FOR LDB M5 ARRAY JSB TSRCH,I FUNCTION JSB ERROR NOT FOUND SYE19 ALF,ALF FOUND ALF,RAR POSITION IT, ADA .15 COMPLETE OPERAND, CCB COMBINE ADB SBPTR WITH IOR 1,I OPERATOR, IOR FLGBT ADD FLAG BIT, STA 1,I AND STORE AND MSK1 'INV' ADA M256 OR SSA,RSS 'TRN'? JMP MATS3 YES JSB GETCR NO, END-OF-STATEMENT? JMP ACCST,I YES JSB MAT&,I JSB ERROR NO SYE20 JMP NOEOF MATS3 JSB GETCR JMP EOF JSB LPCK GET LEFT PARENTHESIS JSB ARRID FETCH AND RECORD AN ARRAY JSB RPCK RECORD A RIGHT PARENTHESIS LDA ARYAD,I RETRIEVE AND MSK1 PREVIOUS ARRAY IDENTIFIER CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? JSB ERROR YES SYE21 JMP ACCST,I NO MATS4 ISZ SBPTR JSB LPCK FETCH LEFT PARENTHESIS JSB FSC FETCH FORMULA JSB RPCK FETCH RIGHT PARENTHESIS CCB MULTIPLICATION JSB SYMCK OPERATOR? DEF TIMES-1 JSB ERROR NO SYE22 JSB ARRID YES, FETCH AND RECORD ARRAY CPA .10 END-OF-STATEMENT? JMP ACCST,I YES JMP NOEOF NO MATS5 STA TEMP2 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE LDB .46 AND RECORD JSB STROP ARRAY LDA TEMP2 END-OF- CPA .10 STATEMENT? JMP ACCST,I YES LDB M3 NO, MUST BE JSB SYMCK A '+', DEF PLUS-1 '-',OR'*' JSB ERROR ISN'T SYE23 CLB IS, SET FOR FALSE ADA .8 CPA TIMES '*'? JMP MATS7 YES MATS6 STB PFLAG NO, SET PFLAG JSB ARRID GET SECOND ARRAY CPA .10 END-OF-STATEMENT? RSS YES JMP NOEOF NO ISZ PFLAG WAS OPERATOR A '*'? JMP ACCST,I NO LDA ARYAD,I YES RETRIEVE AND MSK1 SECOND ARRAY CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? SYE24 JSB ERROR YES JMP ACCST,I NO MATS7 LDA ARYAD,I RETRIEVE AND MSK1 ARRAY CCB SET FOR TRUE CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? JMP SYE24 YES JMP MATS6 NO MAT& DEF MATSB ** *** JUMP TABLE FOR STATEMENT SYNTAX ** ** SYNTB DEF LETS LET DEF DIMS DIM DEF COMS COM DEF DEFS DEF DEF REMS REM DEF GOTOS GO TO DEF IFS IF DEF FORS FOR DEF NXTS NEXT DEF GOTOS GOSUB DEF ENDS RETURN DEF ENDS END DEF ENDS STOP * * THESE TWO STATEMENTS WILL FORCE AN ERROR * CALL AND WAIT * DEF ENDS ANALYZE WAIT AS END STATEMENT DEF ENDS ANALYZE CALL AS END STATEMENT DEF DATAS DATA DEF READS READ DEF PRINS PRINT DEF READS INPUT DEF ENDS RESTORE DEF MATS MAT * *** FORMULA SYNTAX CHECKER * FSC NOP CLA SET LEFT PARENTHESIS STA TEMPS,I COUNT TO ZERO FSC1 CCA SET UNARY FLAG STA UFLAG TO TRUE FSC2 JSB VAROP LOOK FOR VARIABLE OPERAND JMP FSC9 NOT FOUND JMP FSC6 SUBSCRIPTED VARIABLE FOUND JSB LETCK FOLLOWED BY LETTER? JMP FSC6 NO LDB M2 YES, LOOK FOR JSB MCBCK 'AND' OR 'OR' LDA TEMP1 NOT FOUND, FETCH PREVIOUS ALF,ALF CHARACTER AND LEFT-JUSTIFY IT IOR TEMP2 ADD LATEST CHARACTER CPA FN 'FN'? JMP FSC4 YES STA SBPTR,I NO, LDA PDFNS SEARCH FOR LDB M11 PREDEFINED JSB TSRCH,I FUNCTION JMP FSC3 NOT FOUND ALF,ALF ASSEMBLE ALF,RAR OPERAND IOR FLGBT ADD FLAG BIT JMP FSC5 FSC3 ISZ UFLAG 'NOT' PERMITTED? JMP FSC8-1 NO LDA ANOT YES, CCB SEARCH FOR JSB TSRCH,I 'NOT' JMP FSC8-1 'NOT' NOT FOUND CCB RETRIEVE ADB SBPTR PREVIOUS WORD LDA 1,I WORD AND OPMSK SET TO STA 1,I NULL OPERAND JMP FSC14 FSC4 JSB GETCR IDENTIFYING JMP SYNE4 FUNCTION JSB LETCK LETTER? JMP SYNE4 NO ADA D100 YES, ALF ASSEMBLE AND FSC5 ADA .15 SAVE STA TEMP1 FUNCTION IDENTIFIER CCB RETRIEVE ADB SBPTR PREVIOUS LDA 1,I PROGRAM WORD AND OPMSK EXTRACT OPERATOR, IOR TEMP1 APPEND OPERAND, STA 1,I AND RECORD JSB GETCR LEFT PARENTHESIS FSCE1 JSB ERROR OR JSB LPCK LEFT BRACKET? JSB FRCUR YES, SAVE LOCAL VARIABLES OF FSC JSB FSC FETCH ACTUAL PARAMETER JSB FPOP RESTORE LOCAL VARIABLE OF FSC JSB RPCK FETCH RIGHT PARENTHESIS JMP FSC10+1 FSC7 LDB M2 JSB SYMCK DEF RPARN-1 JMP FSC8 LDA B4000 STA SBPTR,I LDA .41 CCB ADB TEMPS,I SSB JMP FSC8 STB TEMPS,I ISZ SBPTR JSB GETCR LDA .10 FSC6 CPA .10 END OF FORMULA? JMP FSC8 YES STA UFLAG NO, SET UNARY FLAG TO FALSE LDB M5 JSB MCBCK BINARY OPERATOR LDA SBPTR,I NOT FOUND, ALF,ALF RESTORE AND B177 CHARACTER LDB MSFLG SEARCH JSB SYMCK FOR A DEF PLUS-1 BINARY OPERATOR RSS NOT JMP FSC12 CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? JMP FSC7 NO STA SFLAG YES, SET JMP FSC1 'STORE OCCURRED' FLAG LDA TEMP2 FSC8 LDB TEMPS,I ALL LEFT PARENTHESES SZB MATCHED? FSCE2 JSB ERROR NO STB SBPTR,I YES, RECORD AN ISZ SBPTR END-OF-FORMULA AND JMP FSC,I EXIT WITH CHARACTER IN (A) FSC9 CPA .40 JMP FSC11 CPA B133 JMP FSC11 CLB STB SIGN POSITIVE JSB NUMCK NUMBER? JMP FSC13 FSC10 JSB NUMOP YES, FIX UP PRECEDING OPERATOR LDB M9 UPDATE STB MSFLG MULTIPLE STORE JMP FSC6 FLAG FSC11 ISZ SBPTR LDA B2300 STA SBPTR,I ISZ TEMPS,I FSC12 LDB M9 STB MSFLG JMP FSC1 FSC13 ISZ UFLAG UNARY OPERATORS PERMITTED? FSCE3 JSB ERROR NO LDB UNMNC CPA .43 '+'? JMP *+4 YES CPA .45 NO, '-'? JMP *+3 YES JMP FSCE3 NO ADB B3000 STORE ISZ SBPTR UNARY STB SBPTR,I OPERATOR FSC14 LDB M9 UPDATE STB MSFLG MULTIPLE STORE FLAG JMP FSC2 FLAG * *** CHECK FOR MULTICHARACTER BINARY OPERATOR * MCBCK NOP STA SBPTR,I SEARCH LDA MCBOP FOR 'AND' JSB TSRCH,I OR 'OR' JMP MCBCK,I NOT FOUND JMP FSC12 ** *** RESTORE FSC LOCAL QUANTITIES ** ** FPOP NOP STA TEMP1 SAVE CHARACTER LDB TEMPS ADB M5 STB TEMPS RESTORE S-STACK TOP INB LDA 1,I STA MSFLG RESTORE MULTIPLE STORE FLAG INB LDA 1,I STA UFLAG RESTORE UNARY OPERATOR FLAG INB LDA 1,I STA FSC RESTORE FSC RETURN ADDRESS INB LDA 1,I RESTORE STA VAROP VAROP RETURN ADDRESS LDA TEMP1 RETRIEVE CHARACTER JMP FPOP,I ** *** SAVE LOCAL QUANTITIES OF FSC ** ** FRCUR NOP LDB TEMPS FETCH CURRENT S-STACK POINTER INB UPDATE IT LDA MSFLG DUMP MULTIPLE STORE STA 1,I FLAG ON S-STACK INB LDA UFLAG STACK UNARY OPERATOR STA 1,I FLAG INB LDA FSC STACK FSC STA 1,I RETURN ADDRESS LDA VAROP STACK VAROP RETURN ADDRESS JSB SSOV AND CHECK FOR S-STACK OVERFLOW JMP FRCUR,I ** *** PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW ** ** SSOV NOP STORE QUANTITY INB ADVANCE S-STACK POINTER STA 1,I SAVE ITEM IN (A) INB ADVANCE S-STACK POINTER STB TEMPS AND RECORD IT CMB,INB LAST WORD ADB LWAM SSB EXCEEDED? FSCE4 JSB ERROR YES JMP SSOV,I ** *** CHECK FOR SUBSCRIPT PART ** ** SBSCK NOP CHARACTER IN (A) LDB M2 LEFT BRACKET JSB SYMCK OR DEF LBRAC-1 LEFT PARENTHESIS? JMP SBSCK,I NO, RETURN VIA (P+1) ISZ SBSCK YES, SET RETURN TO (P+2) LDA ARYAD,I SET AND M16 ARRAY INA TO STA ARYAD,I SINGLE SUBSCRIPT LDA B2200 STA SBPTR,I RECORD IT CLB DIM OR COM CPB DFLAG STATEMENT? JMP SBSC3 NO JSB PGINT,I FETCH INTEGER DEF M256 SUBSCRIPT BOUND BLF,BLF SAVE STB TEMP1 BOUND CCB JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC1 ISZ ARYAD,I NOTE SECOND SUBSCRIPT JSB PGINT,I FETCH SECOND DEF M256 INTEGER SUBSCRIPT BOUND RSS SBSC1 CLB,INB ISZ PFLAG COM STATEMENT? JMP SBSC2 NO STA TEMP2 SAVE CHARACTER LDA 1 IOR TEMP1 RETRIEVE FIRST BOUND JSB MDIM FIND STORAGE NEED ADA TEMPS+7 UPDATE COM STA TEMPS+7 STORAGE POINTER LDA TEMP2 RETRIEVE NEXT CHARACTER SBSC2 LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? JMP FSCE2 NO LDA LF STA SBPTR,I RIGHT BRACKET ISZ SBPTR ADJUST S-BUFFER POINTER JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER LDB DFLAG SZB JMP SBSCK,I YES, EXIT JSB FPOP RESTORE FSC LOCAL VARIABLES LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB FETCH LDB 1,I RETURN ADDRESS JMP 1,I AND EXIT SBSC3 LDA SBSCK SAVE LDB TEMPS RETURN ADDRESS JSB SSOV ON S-STACK JSB FRCUR SAVE FSC LOCAL VARIABLES LDB M9 SET MULTIPLE STORE FLAG STB MSFLG TO FALSE LDA ARYAD SAVE LDB TEMPS OPERAND JSB SSOV ADDRESS JSB FSC GET SUBSCRIPT FORMULA CCB CANCEL ADB SBPTR END-OF-FORMULA STB SBPTR OPERATOR LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB RESTORE LDB 1,I OPERAND STB ARYAD ADDRESS CCB CANCEL OTHER JSB SYMCK DEF SCMMA-1 JMP SBSC2 ISZ ARYAD,I JSB FSC CCB ADB SBPTR STB SBPTR JMP SBSC2 ** *** CHECK SYNTAX OF ARRAY DEFINITIONS ** ** ARRYS NOP JSB ARRID FETCH ARRAY IDENTIFIER JSB SBSCK RECORD A SUBSCRIPT JSB ERROR MISSING SUBSCRIPT ARRE1 CPA .10 END-OF-STATEMENT? JMP ARRYS,I YES, RETURN VIA (P+1) CCB NO, JSB SYMCK MUST BE DEF COMMA-1 A COMMA JMP NOEOF ISN'T ISZ ARRYS IS, RETURN JMP ARRYS,I VIA (P+2) ** *** FETCH ARRAY IDENTIFIER ** ** ARRID NOP JSB LTR FETCH LETTER JSB ERROR NONE FOUND ARRE2 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RECORD LDB .46 ARRAY JSB STROP IDENTIFIER LDA TEMP2 RETRIEVE FOLLOWING CHARACTER JMP ARRID,I ** *** CHECK FOR VARIABLE OPERAND ** ** VAROP NOP JSB LTR LETTER? JMP VAROP,I NO, EXIT VIA (P+1) ISZ VAROP CPA .40 LEFT PARENTHESIS? JMP VARO5 YES CPA B133 NO, LEFT BRACKET? JMP VARO5 YES ISZ VAROP NO JSB DIGCK DIGIT? JMP VARO1 NO LDA TEMP1 YES, RETRIEVE LETTER, ADB .48 AND RESTORE ASCII DIGIT STB TEMP1 JSB STROP RECORD VARIABLE JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER JMP VARO2 VARO1 LDA TEMP1 RETRIEVE LETTER, LDB .47 SET 'NO DIGIT', JSB STROP AND RECORD VARIABLE LDA TEMP2 RETRIEVE FOLLOWING CHARACTER VARO2 STA TEMP2 SAVE CHARACTER CLB INSIDE A CPB PFLAG DEF STATEMENT? JMP VAROP,I NO, EXIT VIA (P+3) CCB ADB SBPTR RETRIEVE LDA 1,I AND MSK1 OPERAND CPA PFLAG MATCH PARAMETER? JMP VARO4 YES VARO3 LDA TEMP2 NO, RETRIEVE JMP VAROP,I CHARACTER AND EXIT VIA (P+3) VARO4 LDA 1,I SET OPERAND TO IOR FLGBT ACTUAL PARAMETER STA 1,I AND RECORD IT JMP VARO3 VARO5 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE LETTER LDB .46 RECORD JSB STROP ARRAY IDENTIFIER LDA B133 RETRIEVE LEFT BRACKET JSB SBSCK FETCH SUBSCRIPT NOP JMP VAROP,I EXIT VIA (P+2) ** *** FETCH A LETTER ** ** LTR NOP JSB GETCR LDA .10 JSB LETCK LETTER? JMP LTR,I NO, EXIT VIA (P+1) ISZ LTR YES, STA TEMP1 SAVE IT JSB GETCR NEXT CHARACTER LDA .10 TO (A) STA TEMP2 SAVE SECOND CHARACTER JMP LTR,I EXIT VIA (P+2) ** *** STORE AN OPERAND NAME ** ** STROP NOP LETTER IN (A), NUMBER IN (B) ADA D100 NUMERICALLY ADJUST THE ADB D53 OPERAND NAME ALF COMBINE THE IOR 1 TWO PARTS IOR SBPTR,I COMPLETE OPERAND-OPERATOR PAIR STA SBPTR,I AND STORE IT ISZ SBPTR UPDATE S-BUFFER POINTER JMP STROP,I ** *** CHECK FOR LEFT PARENTHESIS ** ** LPCK NOP CHARACTER IN (A) LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP FSCE1 NO LDA B2300 STA SBPTR,I PARENTHESIS JMP LPCK,I EXIT ** *** CHECK FOR RIGHT PARENTHESIS ** ** RPCK NOP LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? JMP FSCE2 NO LDA B4000 STA SBPTR,I PARENTHESIS ISZ SBPTR UPDATE SYNTAX BUFFER POINTER JSB GETCR FETCH LDA .10 FOLLOWING CHARACTER JMP RPCK,I ** *** FETCH PARENTHESIZED FORMULA ** ** GETPF NOP JSB GETCR JMP EOF ISZ SBPTR JSB LPCK FETCH LEFT PARENTHESIS JSB FSC FETCH FORMULA JSB RPCK GET RIGHT PARENTHESIS JMP GETPF,I ** *** FLAG OPERATOR WHICH PRECEDES NUMBER ** ** NUMOP NOP STA TEMP4 LDB M3 FETCH ADB SBPTR PRECEDING LDA 1,I OPERATOR IOR FLGBT ADD FLAG BIT STA 1,I REPLACE OPERATOR LDA TEMP4 JMP NUMOP,I SKP * * SYSTEM COMMAND TABLE * SYCMD OCT 23004 STCMD ASC 2,STOP STOP COMMAND ENTRY * OCT 00003 ASC 2,RUN RUN COMMAND * OCT 02003 ASC 2,SCR SCRATCH COMMAND ENTRY * OCT 04005 ASC 3,PUNCH * OCT 03004 ASC 2,LIST LIST COMMAND * OCT 34004 ASC 2,TAPE TAPE COMMAND * OCT 41003 ASC 2,BYE LOG-OFF COMMAND * OCT 42004 ASC 2,MESG MESSAGE COMMAND * OCT 43003 ASC 2,REN RENUMBER COMMAND ** *** PRINT NAME TABLE FOR OPERATORS ** ** LET OCT 32003 BITS 15-9 OF THE LABELLED WORD ASC 2,LET DIM OCT 33003 ARE THE BASIC CODE OPERATOR ASC 2,DIM COM OCT 34003 NUMBERS. BITS 2-0 ARE THE ASC 2,COM DEF OCT 35003 LENGTH IN CHARACTERS OF THE ASC 2,DEF REM OCT 36003 SYMBOL. THE ASCII VERSION OF ASC 2,REM GOTO OCT 37004 THE SYMBOL FOLLOWS. ASC 2,GOTO IF OCT 40002 ASC 1,IF FOR OCT 41003 ASC 2,FOR NEXT OCT 42004 ASC 2,NEXT GOSUB OCT 43005 ASC 3,GOSUB RTRN OCT 44006 ASC 3,RETURN END OCT 45003 ASC 2,END STP OCT 46004 ASC 2,STOP DATA OCT 51004 ASC 2,DATA READ OCT 52004 ASC 2,READ PRINT OCT 53005 ASC 3,PRINT INPUT OCT 54005 ASC 3,INPUT RSTOR OCT 55007 ASC 4,RESTORE MAT OCT 56003 ASC 2,MAT THEN OCT 57004 ASC 2,THEN TO OCT 60002 ASC 1,TO STEP OCT 61004 ASC 2,STEP NOT OCT 27003 ASC 2,NOT AND OCT 26003 ASC 2,AND OR OCT 25002 ASC 1,OR GTE OCT 30002 ASC 1,>= LTE OCT 31002 ASC 1,<= AUNEQ OCT 17002 ASC 1,<> TAB OCT 1003 ASC 2,TAB SIN OCT 2003 THIS SECTION HAS THE PRE-DEFINED ASC 2,SIN COS OCT 3003 FUNCTIONS. HERE BITS 13-9 ARE ASC 2,COS TAN OCT 4003 THE IDENTIFYING NUMBER OF THE ASC 2,TAN ATN OCT 5003 FUNCTION. ASC 2,ATN EXPN OCT 6003 ASC 2,EXP LOG OCT 7003 ASC 2,LOG ABS OCT 10003 ASC 2,ABS SQR OCT 11003 ASC 2,SQR INT OCT 12003 ASC 2,INT RND OCT 13003 ASC 2,RND SGN OCT 14003 ASC 2,SGN ZER OCT 15003 MATRIX FUNCTIONS ASC 2,ZER CON OCT 16003 ASC 2,CON IDN OCT 17003 ASC 2,IDN INV OCT 20003 ASC 2,INV TRN OCT 21003 ASC 2,TRN ** *** TABLE SEARCH FOR MULTICHARACTER SYMBOLS ** ** TBSRH NOP STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA BADDR SAVE STA TEMP3 INPUT LDA CCNT BUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL AND B177 TWO CPA SBPTR,I CHARACTERS? RSS NO JMP TSR10 YES ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .7 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, STA SMEND,I AND STORE JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, STA SMEND,I AND STORE TSR10 ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' EXIT TSRC9 LDA TEMP3 RESTORE STA BADDR INPUT LDA TEMP4 BUFFER STA CCNT STATUS JMP TBSRH,I 'FAILURE' EXIT ** *** FETCH AND RECORD PROGRAM INTEGER ** ** PRGIN NOP LDA SBPTR,I SET IOR FLGBT 'INTEGER ADA .3 FOLLOWS' STA SBPTR,I OPERAND LDA PRGIN,I GIVE ADDRESS STA PRGI1 TO INTCK ISZ SBPTR JSB GETCR SYE25 JSB ERROR JSB INTCK FETCH PRGI1 NOP ISZ PRGIN JMP PRGIN,I ** *** BUILD AN INTEGER ** ** INTCK NOP CHARACTER IN (A) CLB STORE STB INTGR PARTIAL RESULT INTC1 JSB DIGCK DIGIT? JMP INTC2 NO CLO LDB INTGR MULTIPLY ADB 1 PARTIAL ADB 1 RESULT ADB INTGR BY ADB 1 10 ADB 0 ADD LATEST DIGIT SOC OVERFLOW? JMP SYE25 YES STB INTGR STORE PARTIAL RESULT JSB GETCR NO, FETCH LDA .10 NEXT CHARACTER JMP INTC1 INTC2 LDB INTGR ZERO SZB,RSS INTEGER? JMP SYE25 YES STB SBPTR,I NO, RECORD IT LDB INTCK,I INTEGER LDB 1,I TOO ADB INTGR LARGE? SSB,RSS JMP SYE25 YES LDB INTGR NO, ISZ SBPTR RETURN WITH ISZ INTCK INTEGER JMP INTCK,I IN (B) ** *** PROCESS CHARACTER STRING ** ** CHRST NOP STA TEMP2 RECORD TERMINATOR CHARACTER LDA .10 DUMMY STA BLANK DELETE CHARACTER CHRS1 JSB GETCR JMP CHRS3 TO END-OF-STATEMENT EXIT CPA TEMP2 TERMINATOR CHARACTER? JMP CHRS2 YES IOR SBPTR,I NO, FILL STA SBPTR,I SECOND CHARACTER JSB GETCR JMP CHRS3 TO END-OF-STATEMENT EXIT CPA TEMP2 TERMINATOR CHARACTER? JMP CHRS2 YES ISZ SBPTR NO, MOVE TO NEW WORD ALF,ALF AND STORE STA SBPTR,I FIRST CHARACTER JMP CHRS1 CHRS2 ISZ CHRST SET (P+2) EXIT CHRS3 ISZ SBPTR MOVE TO NEXT BUFFER WORD LDA .32 RESTORE BLANK AS STA BLANK DELETE CHARACTER JMP CHRST,I ** *** DELETE STATEMENT ** ** DLSTM LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS FIND STATEMENT TO BE DELETED JMP PEXMA,I JMP PEXMA,I CLA ZERO WORD SKIP FOR DESTINATION INB ADDRESS OF SOURCE WORD SKIP IN B JSB CLPRG CLOSE UP PROGRAM JMP PEXMA,I * *** ACCEPT STATEMENT * ACTST LDA SBUFA COMPUTE CMA,INA LENGTH ADA SBPTR OF STATEMENT STA TEMP,I AND RECORD IT LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS SEARCH ON SEQUENCE NUMBER JMP ACCS1 APPEND STATEMENT TO PROGRAM JMP ACCS4 INSERT STATEMENT IN PROGRAM INB REPLACE STATEMENT IN PROGRAM LDA 1,I COMPARE LENGTHS OF CMA,INA STATEMENT BEING REPLACED ADA TEMP,I AND STATEMENT SZA,RSS REPLACING IT JMP ACCS2 EQUAL SSA,RSS JMP ACCS4+1 SHORTER LDA TEMP,I LONGER, JSB CLPRG CLOSE UP PROGRAM JMP ACCS2 ACCS1 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? ACCS2 CLB YES, SET COUNTER TO ZERO LDA SBUFA INITIALIZE STA TEMP2 SOURCE ADDRESS ACCS3 LDA TEMP2,I TRANSFER WORD FROM STA TEMP3,I S-BUFFER TO PROGRAM SPACE ISZ TEMP2 INCREMENT SOURCE AND ISZ TEMP3 DESTINATION ADDRESSES INB BUMP COUNTER CPB TEMP,I ENTIRE STATEMENT MOVED? JMP PEXMA,I JMP ACCS3 NO ACCS4 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? JSB MVTOH MAKE JMP ACCS2 ROOM ** *** FIND SEQUENTIAL POSITION ** ** FNDPS NOP STA TEMP3 SAVE SEQUENCE NUMBER LDB PBUFF STARTING ADDRESS FNDP1 CPB PBPTR END OF PROGRAM? JMP FNDP4 YES, EXIT VIA (P+1) LDA 1,I SUBTRACT PROGRAM CMA,INA SEQUENCE NUMBER FROM ADA TEMP3 S-BUFFER SEQUENCE NUMBER SZA,RSS EQUAL? JMP FNDP2 YES, SET EXIT TO (P+3) SSA NO, P-SEQ NO > S-SEQ NO ? JMP FNDP3 YES, SET EXIT TO (P+2) LDA 1 POINT (A) TO INA PROGRAM ADDRESS INCREMENT ADB 0,I COMPUTE NEW ADDRESS JMP FNDP1 FNDP2 ISZ FNDPS FNDP3 ISZ FNDPS FNDP4 STB TEMP3 SAVE STATEMENT ADDRESS JMP FNDPS,I ** *** DELETE SPACE IN PROGRAM ** ** CLPRG NOP REFERENCE LOCATION IN TEMP3 ADA TEMP3 SKIP (A) LOCATIONS FROM TEMP3 STA TEMP4 AND SAVE DESTINATION ADDRESS LDB 1,I SKIP TO END OF STATEMENT BEING ADB TEMP3 DELETED, SOURCE ADDRESS IN (B) CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP CLPRG,I ** *** CHECK FOR PROGRAM SPACE OVERFLOW ** ** OVCHK NOP NEW WORD REQUIREMENT IN (A) LDB PBPTR SET SOURCE ADDRESS STB TEMP2 FOR PROGRAM RELOCATION ADB 0 SET DESTINATION STB TEMP4 ADDRESS CMB,INB SUBTRACT FROM ADDRESS ADB LWAM SSB NON-NEGATIVE RESULT? JMP FSCEF,I NO, PROGRAM SPACE OVERFLOW LDB TEMP4 YES, RELOCATE FREE STB PBPTR PROGRAM SPACE POINTER JMP OVCHK,I HED ** LIST THE PROGRAM** * *** LIST THE PROGRAM * LIST LDB PBUFF INITIALIZE TO FIRST STB TEMPS STATEMENT OF PROGRAM JSB GETCR SEQUENCE NUMBER GIVEN? JMP LIST0 LDB .BUFA SET FOR STB SBPTR SEQUENCE NUMBER JSB INCHK,I YES, DEF MAXSN FETCH IT LDA .BUFA,I LOAD SEQUENCE NUMBER JSB FNDPS FIND INITIAL STATEMENT JMP RDYDA,I NOP SAVE STB TEMPS ADDRESS LIST0 CLB CPB STK18 CHECK PUNCH LAG JMP LIST1 NO LDA B133 YES, EMIT JSB WRITE,I LIST1 LDB TEMPS MORE CPB PBPTR PROGRAM? JMP LIS13 NO CCA INITIALIZE ADA SBUFA OUTPUT BUFFER STA BADDR POINTER CLA INITIALIZE STA CCNT CHARACTER COUNT LDA TEMPS,I OUTPUT JSB OUTIN SEQUENCE NUMBER LDA BLANK OUTPUT JSB OUTCR BLANK ISZ TEMPS FETCH LDA TEMPS,I STATEMENT LENGTH CMA,INA SET INA WORD STA STK5 LIST3 ISZ TEMPS MORE ISZ STK5 JMP LIST4 YES LIST2 LDB SBUFA OUTPUT LDA CCNT JSB WRITE,I JMP LIST1 LIST4 LDA TEMPS,I AND OPMSK SZA,RSS NULL OPERATOR? JMP LIST5 YES STA TEMP2 NO, SAVE OPERATOR ALF,ALF SINGLE ARS LDB 0 ADA M21 OPERATOR? SSA,RSS JMP LIS12 NO BLS INB ADB FOPBS LDA 1,I SYMBOL ALF,ALF ADJUST AND MSK0 CHARACTER CPA .34 QUOTE MARK? JMP LIS14 JSB OUTCR NO LIST5 LDA TEMPS,I AND OPDMK SAVE STA TEMP3 OPERAND AND TYPFL EXTRACT OPERAND TYPE STA LFLAG SET LFLAG FALSE SSA FLAG BIT SET? JMP LIST9 YES SZA,RSS NO, NULL OPERAND? JMP LIST3 YES CPA .15 FUNCTION? JMP LIST8 YES LIST6 ADA M5 SSA LETTER-DIGIT COMBINATION? JMP LIST7 NO CCA YES, SET STA LFLAG LFLAG FALSE LIST7 LDA TEMP3 ALF,ALF RESTORE AND ALF AND B177 OUTPUT ADA B100 JSB OUTCR LETTER ISZ LFLAG DIGIT FOLLOWS? JMP LIST3 NO LDA TEMP3 YES AND .15 RESTORE ADA .43 DIGIT JSB OUTCR OUTPUT DIGIT JMP LIST3 LIST8 LDA F OUTPUT JSB OUTCR 'F' LDA N OUTPUT JSB OUTCR 'N' JMP LIST7 LIST9 XOR FLGBT CLE,SZA NUMBER? JMP LIS10 NO ISZ TEMPS YES, STA SIGN SET SIGN FLAG FALSE LDA TEMPS,I ISZ TEMPS OUTPUT LDB TEMPS,I ISZ STK5 ISZ STK5 SSA NEGATIVE NUMBER? CCE YES, SET SIGN FLAG TRUE JSB NUMOA,I NOP JMP LIST3 LIS10 CPA .3 INTEGER? JMP LIS11 YES CPA .15 NO, FUNCTION? RSS YES JMP LIST6 NO, MUST BE A PARAMETER LDA TEMP3 COMPUTE ALF,RAL PRINT AND OPMSK TABLE STA TEMP2 CODE LDB ATAB JSB MCOUT OUTPUT FUNCTION NAME JMP LIST3 LIS11 ISZ TEMPS OUTPUT ISZ STK5 LDA TEMPS,I INTEGER JSB OUTIN JMP LIST3 OPERAND LIS12 LDA BLANK OUTPUT JSB OUTCR BLANK LDB STTYP JSB MCOUT OUTPUT LDA REMOP CPA TEMP2 A REM? JMP OUTS1 YES, OUTPUT REMARK LDA BLANK NO, OUTPUT JMP LIST5-1 LIS13 CLB HIGH-SPEED CPB STK18 PUNCH? JMP RDYDA,I LDA B133 YES, EMIT JSB WRITE,I JMP RDYDA,I LIS14 JSB OUTCR JSB OUTST LDA .34 JMP LIST5-1 OUTIN NOP INTEGER IN (A) LDB M4 SET STB DIGCT DIGIT COUNTER LDB LDVSR SET DIVISOR STB DIVSR ADDRESS CLB SET LEADING STB LDZRO ZERO FLAG OUT11 LDB DIVSR,I NEGATE CMB,INB AND STORE STB MIND DIVISOR CCB SET QUOTIENT INB TO ZERO ADA MIND SUBTRACT DIVISOR FROM INTEGER SSA,RSS NEGATIVE RESULT? JMP *-3 NO, INCREMENT QUOTIENT ADA DIVSR,I YES, RECOVER REMAINDER STA MCOUT AND SAVE IT LDA 1 SZA JMP OUT12 CPA LDZRO JMP OUT13 OUT12 ADA .48 NO, COMPUTE ASCII FOR DIGIT STA LDZRO SET 'ZEROES SIGNIFICANT' JSB OUTCR OUTPUT DIGIT OUT13 LDA MCOUT RETRIEVE REMAINDER ISZ DIVSR SET FOR NEXT DIVISOR ISZ DIGCT DIVISION NECESSARY? JMP OUT11 YES ADA .48 NO, COMPUTE ASCII FOR LAST JSB OUTCR DIGIT AND OUT PUT IT JMP OUTIN,I OUTST NOP " ENTRY POINT LDA OUTST SAVE OUTST STA STK7 OUTS1 LDA TEMPS,I AND B177 SZA JSB OUTCR ISZ TEMPS ISZ STK5 RSS JMP LIST2 LDA TEMPS,I ALF,ALF YES, POSITION IT AND B177 EXTRACT CHARACTER CPA .2 JMP STK7,I CPA .3 JMP STK7,I JSB OUTCR NO, OUTPUT CHARACTER JMP OUTS1 MCOUT NOP MCOU1 LDA 1,I LOAD INFORMATION WORD AND OPMSK COMPARE WITH CPA TEMP2 OPERATOR CODE JMP MCOU2 EQUAL LDA 1,I UNEQUAL, AND .7 COMPUTE ADA .3 ENTRY ARS LENGTH ADB 0 COMPUTE ADDRESS OF NEXT ENTRY JMP MCOU1 MCOU2 LDA 1,I COMPUTE AND .7 ENTRY CMA,INA LENGTH STA STK8 CLE,INB SET FOR FIRST CHARACTER STB TEMP3 SAVE SYMBOL ADDRESS MCOU3 LDA TEMP3,I LOAD WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 EXTRACT CHARACTER JSB OUTCR OUTPUT IT SEZ,CME SET FOR NEXT CHARACTER ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL ISZ STK8 JMP MCOU3 YES JMP MCOUT,I LDVSR DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 SFLAG EQU ARRYS TABLE EQU PRGIN LNGTH EQU TEMPS+8 SMEND EQU INTCK SLENG EQU OVCHK TBLPT EQU FNDPS TSPTR EQU CLPRG INTGR EQU OVCHK HED *** EXECUTE "RENUMBER" SYSTEM COMMAND *** * *** EXECUTE "RENUMBER" SYSTEMS COMMAND * RENUM BSS 0 ENTRY POINT OF RENUMBER * LDA !INS1 SET UP STA &IN1 FOR LDA !INS2 PASS 1 STA &IN2 AND LDA !INS3 PASS 2 STA &IN3 LDB .10 STB LNUM SET LINE NUMBER TO 10 LDB PBUFF SET ADDR TO FIRST WORD STB ADDR ADDRESS OF USER'S PROGRAM JMP FASTM FETCH A STATEMENT * *** SET UP CALL FOR NEXT STATEMENT * NXSTM LDB ADDR PUT ADDRESS IN B-REG ADB LNGT1 UPDATE BY PROG STMT LENGTH STB ADDR RESET VALUE OF PROGRAM ADDRESS LDA LNUM * UPDATE ADA .10 * LINE STA LNUM * NUMBER * * *** FETCH A STATEMENT ( OUTER LOOP ) * FASTM CPB PBPTR END OF PROGRAM? JMP PASS3 YES - GO TO PASS 3 PROCESSOR LDA B,I LOAD LINE # AND STORE STA LNUM. FOR REFERENCE IN OUTER LOOP INB INDEX (B) TO LENGTH ADR LDA B,I LOAD STORE LENGTH STA LNGT1 SAVE LENGTH * *** CHECK LINE NUMBER * LDA LNUM LOAD X10 LINE NUMBER CPA LNUM. DOES IT MATCH? JMP NXSTM YES - GO TO NEXT STATEMENT STA ADDR,I SET NEW LINE # IN STATEMENT * *** CHECK IF REFERENCED BY OTHER STATEMENT (INNER LOOP) * LDB PBUFF LOAD PROGRAM START ADDRESS LOOP2 CPB PBPTR DONE? &IN1 JMP NXSTM YES - RETURN TO OUTER LOOP INB INDEX TO STORE LENGTH STB LNGT2 SAVE FOR INDEXING INB INDEX TO OPERATIONS ADDRESS LDA B,I LOAD OPERATION TYPE AND OPMSK MASK TO OPERATIONS FIELD ALF,ALF POSITION OPERATION CODE RAR CPA N37 "GOTO" STATEMENT ? JMP PRCS YES - PROCESS IT CPA N40 "IF-THEN" STATEMENT ? JMP PRCS YES - PROCESS IT CPA N43 "GOSUB" STATEMENT ? JMP PRCS YES - PROCESS IT * *** DOES NOT REFERENCE OUTER INSTRUCTION * EXIT CCB SET B = -1 ADB LNGT2 SET NEXT STATEMENT START ADR ADB LNGT2,I INDEX BY STATEMENT LENGTH JMP LOOP2 CHECK NEXT STATEMENT * *** PROCESS "GOTO" "GOSUB" "IF-THEN" STATEMENTS * PRCS LDB M2 SET B = -2 ADB LNGT2 INDEX BY CURRENT "AT" ADDRESS ADB LNGT2,I INDEX BY STATEMENT LENGTH LDA B,I LOAD INSTRUCTION DESTINATION &IN2 CPA LNUM. SAME AS CURRENT STATEMENT? RSS YES - UPDATE DESTINATION JMP EXIT NO - TRY NEXT STATEMENT * &IN3 LDA LNUM * SET CMA,INA * NEW STA B,I * DESTINATION JMP EXIT * ADDRESS PASS3 LDA !INS4 STA &IN1 SET UP LDA !INS5 FOR STA &IN2 PASS 3 CLA STA &IN3 JMP LOOP2-1 * !INS1 JMP NXSTM !INS2 CPA LNUM. !INS3 LDA LNUM !INS4 JMP RDYDA,I !INS5 SSA LNUM EQU TEMPS+1 LNUM. EQU TEMPS+2 LNGT1 EQU TEMPS+3 LNGT2 EQU TEMPS+4 ADDR EQU TEMPS+5 N60 EQU .48 N37 EQU .31 N40 EQU .32 N43 EQU .35 HED PRE-EXECUTION PROCESSING * * *********************** * PHASE 2 OF THE COMPILER * *********************** * * THIS PHASE HAS THE FOLLOWING 3 FUNCTIONS: * 1. SYMBOL TABLE CONSTRUCTION * 2. FOR LOOP CHECKING * 3. ARRAY STORAGE ALLOCATION * MFASE LDA PBPTR CPA PBUFF JMP RDYDA,I STA FCORE LDA FWAM STA COML INITIALIZE COMMON POINTER LDA SYMTA STA SYMTF INITIALIZE SYMBOL TABLE POINTER LDA PBUFF STA MPTR INITIALIZE PROGRAM POINTER MLOP1 LDB MPTR,I STB .LNUM SET LINE NUMBER LDB MPTR ISZ MPTR ADB MPTR,I COMPUTE LOCATION OF NEXT STB MNPTR STATEMENT AND STORE THIS ISZ MPTR LDA MPTR,I FETCH THE FIRST WORD IN THE MLO10 ARS ALF,ALF PART TO DETERMINE THE TYPE OF AND .63 STATEMENT AND STORE STA TYPE CPA .46 JMP MLO12 CPA .30 IS THIS A REM STATEMENT STB MPTR CPA .43 IS THIS A PRINT STMT STB MPTR CCA STA MWDNO JMP MLOP2+1 MLO12 LDA MPTR INA LDA 0,I FETCH THE SECOND WORD IN THE STMT JMP MLO10 MLO13 AND MSK1 LDB MPTR SZA,RSS ADB .2 CPA .3 INB STB MPTR MLOP2 ISZ MPTR INCREMENT PROGRAM POINTER LDA MPTR CPA MNPTR HAS THE CURRENT STATEMENT JMP MLOP5 LDA MPTR,I SSA JMP MLO13 AND MSK1 SZA,RSS JMP MLOP2 STA MBOX1 AND .15 CPA .15 JMP MLOP6 ADA M4 SSA JMP MLOP7 LDA MBOX1 JSB SSYMA,I SSB,RSS JMP MLOP3 LDA MNEG LDB MNEG+1 STA MBOX1+1 STB MBOX1+2 LDA M3 JSB ESYMT MLOP3 LDB TYPE LDA MBOX1 CPB .34 JMP MLOP4 CPB .33 ISZ MWDNO JMP MLOP2 ISZ FCORE LDB FCORE CPB SYMTF JMP MER8-1 STA FCORE,I JMP MLOP2 MLOP4 LDB FCORE CPB PBPTR JSB ERROR IF NOT END ISSUE DIAGNOSTIC MER3 CPA FCORE,I RSS AS THE LAST FOR VARIABLE IN THE JMP MER3-1 FOR TABLE. NO, ERROR ADB M1 YES, DELETE LAST ENTRY FROM STB FCORE JMP MLOP2 THE POINTER AND GO TO PROCESS MLOP5 CPA PBPTR RSS JMP MLOP1 LDA TYPE CPA .37 JMP M1LOP JSB ERROR MLOP6 LDA MPTR,I AND OPMSK CPA DEFOP RSS JMP MLOP2 NO GO TO PROCESS NEXT WORD LDA MBOX1 SEARCH SYMBOL TABLE FOR JSB SSYMA,I SSB,RSS JSB ERROR FOUND. ERROR MULTIPLY DEFINED MER4 LDA MPTR ADA .3 ENTER THE FUNCTION INTO THE STA MBOX1+1 SYMBOL TABLE TOGETHER WITH LDA M2 ITS ENTRY POINT IN THE SOURCE JSB ESYMT CODE JMP MLOP2 GO TO PROCESS THE NEXT WORD MLOP7 STA 1 LDA TYPE CPA .27 JMP MLOP8 GO TO MLOP8 CPA .28 JMP MLOP8 JSB MSYMT LOOK UP IN SYMBOL TABLE JMP MLOP2 FOUND, GO TO PROCESS NEXT WORD CLA STA MBOX1+1 ENTER THE VARIABLE INTO THE STA MBOX1+2 SYMBOL TABLE WITH ITS STORAGE STA MBOX1+3 ALLOCATION, FORMAL AND ACTUAL JMP MLOP0 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT ISZ MPTR LDA MPTR,I PICK UP FIRST DIMENSION ALF,ALF SHIFT M. S. PART OF WORD CPB M3 IS THIS A SINGLE DIMENSION ARRAY JMP *+5 YES, JUMP ISZ MPTR OF SECOND DIMENSION AND PACK ISZ MPTR NO, INDEX POINTER TO THE LOC, IOR MPTR,I RSS IOR .1 STA MBOX1+2 SET UP TO STORE PACKED STA MBOX1+3 DIMENSIONS IN FORMAL AND ACTUAL CLA SLOTS AND UNDEFINED FLAG IN STA MBOX1+1 STORAGE ALLOCATION SLOT JSB MSYMT SEARCH SYMBOL TABLE JMP MLOP9 NOT FOUND, JUMP LDA TYPE CPA .28 RSS JMP MLOP0 LDA MBOX1+2 JSB MDIM LDB COML STB MBOX1+1 ADB 0 STB COML MLOP0 LDA M4 JSB ESYMT JMP MLOP2 MLOP9 ADB .2 LDA 1,I SZA JSB ERROR MER5 LDA TYPE CPA .28 COM STMT? JMP ESYN3,I ERROR MISPLACED COM STMT LDA MBOX1+2 STA 1,I STORE THESE DIMENSIONS IN FORMAL INB AND ACTUAL SLOTS IN SYMBOL TABLE STA 1,I ENTRY JMP MLOP2 GO TO PROCESS NEXT WORD SKP M1LOP LDA FCORE CPA PBPTR RSS IS THE FOR TABLE EMPTY JSB ERROR NO, ERROR MER6 LDB SYMTF CHECK THROUGH THE SYMBOL TABLE M2LOP CPB SYMTA JMP M4LOP LDA 1,I AND .15 ADB .2 CPA .15 JMP M2LOP INB ADA M4 SSA,INA,RSS JMP M2LOP SZA,RSS JSB ERROR NO. OF DIMENSIONS UNSPECIFIED MER10 INA STA MBOX1+1 SET FLAG FOR NO. OF DIMENSIONS STB MBOX1 SAVE SYMBOL TABLE LOCATOR LDA 1,I PICK UP DIMENSIONS SZA DEFINED ? JMP M3LOP LDA STDIM NO, LOAD FIRST STANDARD DIMENSION ISZ MBOX1+1 SKIP IF SINGLE DIMENSION ADA .9 STA 1,I STORE IN FORMAL AND ACTUAL ADB M1 STA 1,I M3LOP JSB MDIM STA MBOX1+1 SAVE LDB MBOX1 ADB M2 LDA 1,I PICK UP STORAGE ASSIGNMENT SZA SKIP IF UNDEFINED JMP MER7 LDA FCORE STA 1,I STORAGE ASSIGNMENT SLOT ADA MBOX1+1 STA FCORE CMA,INA ADA SYMTF CHECK THAT THE ARRAY STORAGE SSA DOES NOT OVERLAP THE SYMBOL JSB ERROR TABLE IF SO GO TO ERROR MER7 ADB .3 JMP M2LOP M4LOP LDB PBPTR CPB FCORE JMP FASE3,I LDA MNEG STA 1,I INB LDA MNEG+1 STA 1,I INB JMP M4LOP+1 STDIM OCT 5001 * ***************************** * ENTER SYMBOL TABLE SUBROUTINE * ***************************** * * THE SUBROUTINE IS CALLED WITH THE NEGATIVE OF THE * ENTRY LENGTH IN A . THE ENTRY IS IN TEMPORARY * LOCATIONS AND IS TRANSFERRED TO THE SYMBOL TABLE * BY THE SUBROUTINE * ESYMT NOP STA MBIN1 SAVE NEGATIVE OF LENGTH OF ENTRY ADA SYMTF STA SYMTF MOVE SYMBOL TABLE START LOCATOR STA MBIN2 UP BY THE LENGTH OF ENTRY CMA,INA CHECK THAT THE SYMBOL TABLE AND ADA FCORE SSA,RSS JSB ERROR OVERLAP ERROR MER8 LDB MBUF POINTER TO REQD ENTRY LDA 1,I TRANSFER ENTRY TO THE SYMBOL STA MBIN2,I TABLE INB ISZ MBIN2 ISZ MBIN1 JMP MER8+1 JMP ESYMT,I RETURN SKP * ********************************************** * SUBROUTINE TO SEARCH SYMBOL TABLE FOR AN ARRAY * ********************************************** ** MSYMT NOP B GIVES ARRAY TYPE -3 = 1 DIM, STB MBIN1 -2 = 2DIM, -1 = UNDIMENSIONED LDA MBOX1 LOAD IDENTIFIER JSB SSYMA,I SSB,RSS JMP MSYMT,I FOUND, RETURN ISZ MBIN1 IF ARRAY UNDIMENSIONED RSS JMP MSYM JUMP TO NOT FOUND EXIT ISZ MBIN1 SET UP TO CHECK THAT ARRAY DOES ADA .2 NOT APPEAR IN THE TABLE WITH ADA M1 DIFFERENT DIMENSIONS. CHANGE JSB SSYMA,I SSB,RSS SEARCH AGAIN JSB ERROR FOUND, INCONSISTENT DIMENSIONS MSYM ISZ MSYMT NOT FOUND, INCREMENT RETURN JMP MSYMT,I ADDRESS AND RETURN HED ** EXECUTE THE PROGRAM ** * * PHASE 3 OF THE COMPILER - PROGRAM EXECUTION * FORMX NOP FORMULA BEGINS IN (TEMPS) LDB FORMX STB FORM& CLB INITIALIZE OPERATOR JSB SLWST STACK FORM1 LDA TEMPS,I FETCH OPERAND ISZ TEMPS SET FOR NEXT WORD OF FORMULA AND OPDMK EXTRACT OPERAND STA TEMPS+6 AND SAVE IT SZA,RSS NULL OPERAND? JMP FORM2 YES JSB BHSTP SET STACK FOR OPERAND ADDRESS SSA FLAG BIT SET? JMP FORM4 YES JSB SSYMA,I INB,SZB,RSS JMP E8M1A,I NO AND .15 YES CPA .15 FUNCTION? JMP FORM6 STB HSTPT,I NO, STACK OPERAND ADDRESS FORM2 LDA TEMPS,I FETCH AND OPMSK OPERATOR ALF,ALF POSITION IT LDB 0 ADB FOPBS NO, LOAD OPERATOR ADA M8 NON-FORMULA SSA OPERATOR? CLB YES ADA D53 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I INFORMATION WORD AND MSK1 SAVE STA TEMPS+7 XOR 1,I SAVE ARS STA TEMPS+6 IDENTIFICATION JMP FOR11 FORM0 STA TSTPT,I STACK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS INA STORE STB 0,I LOW WORD FOR11 LDA LSTPT,I DOES OPERATOR AND MSK0 ON TOP OF CMA OPERATOR STACK ADA TEMPS+7 HAVE HIGHER SSA PRECEDENCE? JMP FORM9 YES, EXECUTE IF RSS NO FOR10 ISZ LSTPT LDB TEMPS+7 RETRIEVE PRECEDENCE ADB M15 NO, LEFT PARENTHESIS SSB OR LEFT BRACKET? ADB .15 NO, RESTORE PRECEDENCE ADB TEMPS+6 COMBINE IDENTIFICATION JSB SLWST WITH PRECEDENCE AND STACK JMP FORM1 FORM4 CPA FLGBT JMP FORM5 YES AND .15 NO, PRE-DEFINED CPA .15 FUNCTION JMP FORM7 YES LDB TEMPS+9 NO, MUST BE A JMP FORM2-1 PARAMETER FORM5 LDB TEMPS LOAD CONSTANT ADDRESS ISZ TEMPS MOVE POINTER TO ISZ TEMPS NEXT CODE WORD JMP FORM2-1 FORM6 STB TEMPS+6 LDB TSTPT JSB SLWST LDB TEMPS+6,I JSB SLWST LDA FORM& STA HSTPT,I ADDRESS ON OPERHAND STACK JSB FORMX EVALUATE PARAMETER ISZ TEMPS UPDATE ISZ TEMPS FORMULA POINTER LDA TEMPS LDB LSTPT,I STB TEMPS STA LSTPT,I LDB TEMPS+9 LDA HSTPT,I ISZ LSTPT ISZ HSTPT STB LSTPT,I STA TEMPS+9 CPA TSTPT JSB RSCHK JSB FORMX LDA LSTPT,I STA TEMPS+9 LDA LSTPT ADA M3 STA LSTPT INA LDB 0,I STB TSTPT INA LDB 0,I STB TEMPS JSB STTOP FOR12 STA TSTPT,I STORE HIGH WORD LDA TSTPT STACK INA STORE STB 0,I LOW WORD ISZ HSTPT UNSTACK LDB HSTPT,I LOAD 'RESULT' ADDRESS STB FORM& ADA M1 STA HSTPT,I JMP FORM2 FORM7 LDA TEMPS+6 ALF,ALF ALF AND .31 ADA PDFBS LDB 0,I JSB SLWST LDA FORM& STA HSTPT,I JSB FORMX ISZ TEMPS ISZ TEMPS LDB LSTPT,I CCA ADA LSTPT STA LSTPT STB ESYMT JSB STTOP JMP ESYMT,I FORM9 LDA LSTPT,I UNSTACK CCB OPERATOR ADB LSTPT INFORMATION STB LSTPT WOSD ALF,ALF COMPUTE AND B177 SUBROUTINE ADA ARBAS ADDRESS JMP 0,I EXECUTE * *** EXECUTION BRANCH TABLE * XECTB DEF ELET LET DEF XEC4 DIM DEF XEC4 COM DEF XEC4 DEF DEF XEC4 REM DEF EGOTO GO TO DEF EIF IF DEF EFOR FOR DEF ENEXT NEXT DEF EGOSB GOSUB DEF ERTRN RETURN DEF RDYDA,I DEF RDYDA,I DEF RDYDA,I DEF RDYDA,I DEF XEC4 DATA DEF EREAD READ DEF EPRIN PRINT DEF EINPT INPUT DEF ERSTR RESTORE DEF EMAT MAT *** EXECUTE THE PROGRAM * * ** *** INITIALIZE FOR OUTPUT ** ** XEC CLA SET COUNTER FOR STA TYPE CHARACTERS OUTPUTTED STA XH INITIALIZE INA RANDOM STA XL VARIABLE ** *** INITIALIZE THE DATA POINTER ** ** CCA STA DCCNT -NO STA DSTRT DATA- LDB PBUFF CONDITION STB NXTDT LDA ADATA,I SEARCH JSB STSRH DATA STAREMENT JMP XEC2 STB DSTRT SAVE STATEMENT LOCATION JSB SETDP SET DATA POINTER ** *** INITIALIZE STACK POINTERS ** ** XEC2 LDB SYMTF INITIALIZE STB HSTPT POINTERS TO LDB FCORE -HIGH CORE- STACK, STB TSTPT -TEMPORARY- ADB .23 STB LSTAK STB LSTPT STACK CMB ADB HSTPT SSB JMP E1 CLA,INA SET EXECUTION FLAG=1 JSB SEXU,I LDB PBUFF BEGIN JMP XEC5 EXECUTION ** *** FIND NEXT STATEMENT TO BE EXECUTED ** ** XEC4 JMP MONIT,I XEC4. LDA NXTST NEXT STATEMENT NUMBER LDB PRADD PROSPECTIVE ADDRESS CPA 1,I DESIRED STATEMENT? JMP XEC6 YES LDB PBUFF NO, FIND JSB FNDPA,I NOP NON-EXISTENT JSB ERROR STATEMENT XEC5 LDA 1,I SAVE NEW XEC6 STA .LNUM SEQUENCE NUMBER ** *** SET SUCCESSOR STATEMENT ** ** JSB FLWST AND OPMSK EXTRACT STATEMENT TYPE ALF,ALF POSITION RAR IT ADA XECBR COMPUTE EXEXUTION ADDRESS JMP 0,I BRANCH TO EXECUTION ADDRESS ** *** EVALUATE FORMULA AND RETURN RESULT ** ** FETCH NOP LDB FETCH STB STK3 JSB FORMA,I EVALUATE FORMULA JSB OPCHK ISZ HSTPT UNSTACK RESULT ADDRESS LDA 1,I LOAD (A) WITH HIGH MANTISSA INB LOAD LOW PART LDB 1,I OF RESULT INTO (B) JMP STK3,I ** *** SET POINTER TO START OF DATA STATEMENT ** ** SETDP NOP STATEMENT ADDRESS IN (B) INB LOAD LDA 1,I STATEMENT LENGTH CMA,INA SET INA DATA COUNTER STA DCCNT TO 1-STATEMENT LENGTH INB SET -NEXT DATA- POINTER ONE STB NXTDT WORD ABOVE FIRST CONSTANT JMP SETDP,I ** *** SEARCH FOR STATEMENT OF GIVEN TYPE ** ** STSRH NOP TYPE IN (A), ADDRESS IN (B) AND OPMSK EXTRACT STA TEMP4 STATEMENT TYPE STSR1 LDA 1 EXTRACT ADA .2 PROGRAM LDA A,I AND OPMSK TYPE CPA TEMP4 DESIRED TYPE? JMP STSR2 YES LDA 1 NO, FETCH INA STATEMENT LENGTH ADB 0,I CPB PBPTR PAST LAST STATEMENT? JMP STSRH,I YES JMP STSR1 NO STSR2 ISZ STSRH JMP STSRH,I ** *** FETCH A DATA ITEM ** ** FDATA NOP FDAT1 ISZ DCCNT MORE DATA? JMP FDAT2 YES LDA ADATA,I NO, SEARCH LDB NXTDT FOR NEXT JSB STSRH JSB ERROR NONE FOUND E4 JSB SETDP INITIALIZE THE JMP FDAT1 DATA POINTERS FDAT2 ISZ DCCNT UPDATE ISZ DCCNT POINTER ISZ NXTDT LDA NXTDT,I LOAD ISZ NXTDT DATA LDB NXTDT,I ITEM ISZ NXTDT UPDATE POINTER JMP FDATA,I ** *** SET FOR FOLLOWING STATEMENT ** ** FLWST NOP (B) HOLDS PRESENT ADDRESS LDA 1 COMPUTE INA ADDRESS LDA 0,I ADA 1 NEXT STA PRADD STATEMENT LDA 0,I RECORD THE STA NXTST SEQUENCE NUMBER ADB .2 FETCH STB TEMPS FIRST WORD LDA 1,I OF CURRENT JMP FLWST,I STATEMENT ** *** SEARCH STACK FOR GIVEN FOR-VARIABLE ** ** FVSRH NOP LDA TEMPS,I FETCH AND MSK1 FOR-VARIABLE STA STK2 JSB SSYMA,I INB SYMBOL TABLE LDA HSTPT STA TEMP3 STACK TOP FVSR1 CPA SYMTF STACK BOTTOM? JMP FVSRH,I YES, EXIT VIA (P.1) CPB 0,I JMP FVSR2 YES ADA .6 NO, MOVE TO JMP FVSR1 NEXT STACK ENTRY FVSR2 ISZ FVSRH EXIT JMP FVSRH,I VIA (P.2) * *** EXECUTE LET * ELET JSB FORMA,I JMP XEC4 ** *** EXECUTE GOTO ** EGOTO INB LOAD SEQUENCE LDA 1,I NUMBER STA NXTST RECORD FOR EXECUTION JMP XEC4 RETURN TO MONITOR * *** EXECUTE IF * EIF JSB FETCA,I FETCH VALUE OF FORMULA SZA,RSS RESULTANT TRUE? JMP XEC4 NO ISZ TEMPS YES, BRANCH TO LDB TEMPS FOLLOWING JMP EGOTO SEQUENCE NUMBER * *** EXECUTE FOR * EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? JMP EFOR1 NO STA TEMP2 YES, SAVE SOURCE ADDRESS ADA .6 SAVE STA TEMP4 DESTINATION ADDRESS STB TEMP1 SAVE FOR-VARIABLE ADDRESS JSB MVTOH COMPRESS STACK LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS CLA,RSS EFOR1 LDA M6 TOP OF ADA HSTPT FOR-STACK STA HSTPT POINTER STA TEMP1 CMA,INA STACK ADA LSTPT SSA,RSS OVERFLOW? JMP E1 YES STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS JSB FORMA,I INITIALIZE FOR-VARIABLE ISZ TEMPS ISZ TEMP1 SAVE LDA TEMP1 LIMIT STA ENEX2 ADDRESS JSB FETCA,I FETCH STA TEMP1,I AND ISZ TEMP1 STORE STB TEMP1,I LIMIT ISZ TEMP1 LDB M2 SET FOR STEP SIZE STB FDATA SIGN CHECK LDA TEMPS,I SZA JMP EFOR2 FOUND LDA HONE NOT FOUND, LDB .2 DEFAULT RSS IS 1.0 EFOR2 JSB FETCA,I SSA STEP SIZE NEGATIVE? ISZ FDATA YES STA TEMP1,I SAVE ISZ TEMP1 SET POINTER STB TEMP1,I SIZE ISZ TEMP1 STEP LDA NXTST TO STATEMENT STA TEMP1,I FOLLOWING THE FOR EFOR3 LDA ANEXT,I FIND LDB PRADD -NEXT- JSB STSRH STATEMENT NOP JSB FLWST FIND FOLLOWING STATEMENT AND MSK1 SAME CPA STK2 RSS YES JMP EFOR3 NO LDB HSTPT,I LOAD LDA 1,I VALUE INB OF LDB 1,I FOR-VARIABLE JMP ENEX2-1 CHECK ACCEPTABILITY * *** EXECUTE NEXT * ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY JMP XEC4 NONE PRESENT STA HSTPT RESET TOP OF STACK STB ENEX1 INA SAVE LIMIT STA ENEX2 ADDRESS ADA .2 SAVE STEP SIZE STA TEMP1 ADDRESS LDB M2 SET STEP SIZE STB FDATA SIGN CHECK LDA TEMP1,I LOAD ISZ TEMP1 STEP LDB TEMP1,I ISZ TEMP1 SSA CHECK ISZ FDATA SIGN JSB .FAD INCREMENT ENEX1 NOP FOR-VARIABLE STA ENEX1,I ISZ ENEX1 SAVE STB ENEX1,I VALUE JSB .FSB COMPUTE FOR-VARIABLE-LIMIT ENEX2 NOP ISZ FDATA POSITIVE STEP SIZE? ELA YES, COMPLEMENT SIGN SSA NO, NON-NEGATIVE RESULT? JMP ENEX3 NO LDA TEMP1,I YES,GO TO FIRST STA NXTST JMP XEC4 ENEX3 LDA HSTPT FAILS, ADA .6 ERASE STA HSTPT STACK JMP XEC4 * *** EXECUTE GOSUB * EGOSB INB LOAD (A) WITH LDA 1,I SEQUENCE NUMBER LDB NXTST LOAD (B) WITH STA NXTST RETURN SEQUENCE NUMBER JSB SLWST STACK RETURN ON LOW-CORE STACK ADA M10 GOSUBS NESTED CPA LSTAK JSB ERROR YES E2 JMP XEC4 NO * *** EXECUTE RETURN * ERTRN LDB LSTPT RETURN STACK CPB LSTAK EMPTY? JSB ERROR YES E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS STA NXTST STORE FOR EXECUTION ADB M1 RESET STB LSTPT STACK POINTER JMP XEC4 RETURN TO THE MONITOR * *** EXECUTE READ * EREAD CPB PRADD END-OF-STATEMENT? JMP XEC4 YES JSB FORMA,I NO, EVALUATE NEXT ADDRESS LDA HSTPT,I RECORD STA STK4 JSB FDATA STA STK4,I ISZ STK4 STB STK4,I ISZ HSTPT LDB TEMPS INB JMP EREAD ** *** INITIALIZE FOR PRINT ** ** PRNIN NOP CLA JSB SEXU,I CCA INITIALIZE ADA .BUFA BUFFER STA BADDR POINTER LDA TYPE INITIALIZE CMA,INA -CHARACTERS OUTPUTTED- STA CCNT COUNTER SLA,RSS START ON ODD CHARACTER POSITION? JMP PRNIN,I NO ADA M1 YES, BIAS STA CCNT COUNTER CLA OUTPUT A JSB OUTCR NULL CHARACTER JMP PRNIN,I * *** EXECUTE PRINT * EPRIN JSB PRNIN SET FOR PRINT CLA JMP EPRI1+1 EPRI0 CLA CPA EOL JSB EDELM EPRI1 CCA STA EOL LDA TEMPS,I AND OPDMK SZA JMP EPRI3 EPRI2 ISZ TEMPS LDB TEMPS CPB PRADD JMP EPRI7 LDA TEMPS,I AND OPMSK CPA B2000 JMP EPRI0 CPA B3000 NO, SEMICOLON? JMP EPRI1 CPA B1000 NO, QUOTE? JMP EPRI4 YES CCA ADA TEMPS STA TEMPS EPRI3 CCA STA EOL CLA,INA JSB SEXU,I JSB FETCA,I STA ENOUT CLA JSB SEXU,I LDA ENOUT ISZ EOL JMP EPRI2 JSB ENOUT JMP EPRI2 EPRI4 CLA STA EOL STA STK5 STA STK4 EPRI5 LDA 1,I AND MSK0 SZA,RSS JMP EPRI6 ISZ STK4 INB QUOTE LDA 1,I AND OPMSK CPA B1000 JMP EPRI6 ISZ STK4 JMP EPRI5 EPRI6 LDB STK4 ADB CCNT WILL LINE ADB M73 SSB,RSS CHARACTERS? JSB OUTLN YES, GET FRESH LINE JSB OUTSA,I OUTPUT STRING JMP EPRI1+2 EPRI7 ISZ EOL JMP EPRI8 LDB TYPE CMB,INB CHARACTERS OUTPUTTED LDA CCNT LOAD LINE LENGTH CMA,INA SAVE NEW COUNT OF STA TYPE CHARACTERS OUTPUTTED ADA 1 COMPUTE CHARACTERS NOT YET OUT SLB CORRECT FOR START ON ADA M1 ODD PRINT POSITION LDB .BUFA OUTPUT SZA JSB WRITE,I RSS EPRI8 JSB OUTLN CLA,INA SET EXU FLAG JSB SEXU,I TO EXECUTION MODE JMP XEC4 ** *** TAB TELEPRINTER ** ** ETAB JSB IENTA,I JMP ETAB1 CLB STB EOL ADA M72 EXCEED SSA,RSS 72? JMP ETAB1 YES CMA,INA NO, COMPUTE ADA M72 BLANKS? ADA CCNT REQUIRED SSA,RSS ANY? JMP FR12A,I STA STK4 LDA .32 OUTPUT JSB OUTCR REQUIRED ISZ STK4 JMP *-3 OF BLANKS JMP FR12A,I ETAB1 CLA JSB SEXU,I JSB OUTLN CLA,INA JSB SEXU,I JMP FR12A,I IENTA DEF .IENT * *** EXECUTE INPUT * EINP1 INA,SZA JSB DRQSA,I EINP2 JSB CONST JMP EINP1 LDB TEMPS INB CPB PRADD JMP EINP3 CPA .10 JMP *+4 JMP *+4 EINPT CLA JSB SEXU,I JSB DRQSA,I JSB FORMA,I CCA ADA HSTPT,I ISZ HSTPT STA SBPTR JMP EINP2 EINP3 CLA STA TYPE CLA,INA JSB SEXU,I JMP XEC4 ** *** EXIT FORMULA ON EMPTY STACK ** ** DEF FORM&,I ** *** EXECUTE RESTORE ** ERSTR LDB DSTRT GET FIRST DATA STATEMENT ADDRESS CPB M1 IMPOSSIBLE ADDRESS? JMP XEC4 YES, DONE JSB SETDP NO, SET DATA POINTER JMP XEC4 DONE ** *** FORMULA OPERATOR JUMP TABLE ** ** AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FOR1A,I '(' DEF FOR0B,I UNARY '+' DEF EOR OR DEF EAND AND DEF ENOT NOT DEF EGORE '>=' DEF ELORE '<=' ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP SAVE LDA BINOP,I SUBROUTINE STA BINO1 CALL ISZ BINOP SET RETURN ADDRESS JSB OPCHK SAVE ADDRESS OF STB BINO2 TOP OPERAND ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD SECOND OPERAND BINO1 NOP PERFORM OPERATION BINO2 NOP ADDRESS OF SECOND OPERAND JMP BINOP,I ** *** EXECUTE SUBSCROPT COMMA ** ** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I FETCH ADB .2 SUBSCRIPT LDA 1,I BOUNDS AND MSK0 SAVE STA STK4 LDA 1,I EXTRACT ALF,ALF ROW AND MSK0 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO LDA STK4 CPA .1 COLUMN MATRIX? JMP ESCM1 YES JSB MPY NO, COMPUTE ADDRESS DEF LSTPT,I DISPLACEMENT RSS DUE TO ROWS ESCM1 LDA LSTPT,I CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB STK4 CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS LDB LSTPT UNSTACK ADB M1 STB LSTPT I JMP FOR1A,I ** *** INTERGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT LDA 1,I FETCH INB SUBSCRIPT LDB 1,I JSB SBFIX INTEGERIZE STB LSTPT,I ISZ HSTPT POP OPERAND STACK JMP ESBS,I ** *** EXECUTE STORE ** ** ESTR LDB TEMPS+7 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR1B,I NO, DEFER STORE CPB TEMPS+6 YES, FIRST STORE OPERATOR USED? JMP ESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMPS+9 DESTINATION LDA TEMPS+6 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMPS+9,I PART OF SOURCE ISZ TEMPS+9 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMPS+9,I PART OF SOURCE ISZ HSTPT POP STACK JMP FOR0B,I ESTR2 JSB OPCHK SAVE ADDRESS STB TEMPS+6 OF QUANTITY ISZ HSTPT YES, POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE ** *** CALL ADD ** ** EFAD JSB BINOP JSB .FAD JMP FOR0A,I ** *** CALL SUBTRACT ** ** EFSB JSB BINOP JSB .FSB JMP FOR0A,I ** *** CALL MULTIPLY ** ** EFMP JSB BINOP JSB .FMP JMP FOR0A,I ** *** CALL DIVIDE ** ** EFDV JSB BINOP JSB .FDV JMP FOR0A,I ** *** EXECUTE ^ *** ** EPWR LDB HSTPT,I LOAD LDA 1,I INB POWER LDB 1,I JSB IFIX JMP *+3 SOS INTEGER? JMP EPWR1 YES JSB BINOP NO JMP RPWR RPWR JSB PCHK CHECK ARGUMENTS SSA NEGATIVE BASE? JSB ERROR YES BASER EQU * LDB BINO1 NO, LOAD BASE JSB .LOGA,I TAKE NATURAL LOG JSB .FMP MULTIPLY DEF BINO2,I BY POWER JSB .EXPA,I EXPONENTIATE JMP FOR0A,I RESULT EPWR1 STB TT1 SSB CMB,INB STB TT2 JSB BINOP JMP IPWR IPWR JSB PCHK CHECK ARGUMENTS LDB BINO1 STORE STA BINO1 STB BINO2 BASE LDA HONE INITIALIZE STA TT3 RESULT LDA .2 TO STA TT4 1.0 IPWR1 LDB TT2 DIVIDE POWER SLB,BRS BY 2 JMP IPWR3 WAS ODD STB TT2 WAS EVEN IPWR2 SZB ZERO? JMP IPWR4 NO LDA TT1 YES SSA POSITIVE POWER? JMP IPWR5 NO LDA TT3 YES, LOAD LDB TT4 RESULT JMP FOR0A,I IPWR5 LDA HONE LOAD LDB .2 1.0 JSB .FDV DIVIDE BY DEF TT3 RESULT JMP FOR0A,I IPWR3 STB TT2 SAVE POWER LDA BINO1 LOAD LDB BINO2 BASE JSB .FMP MULTIPLY BY DEF TT3 RESULT-SO-FAR STA TT3 SAVE PARTIAL STB TT4 LDB TT2 LOAD POWER JMP IPWR2 IPWR4 LDA BINO1 LOAD LDB BINO2 BASE JSB .FMP SQUARE DEF BINO1 IT STA BINO1 SAVE STB BINO2 RESULT JMP IPWR1 ** *** INSURE VALID OPERATION ** ** PCHK NOP STB BINO1 LOAD LDB BINO2,I POWER SZA BASE ZERO? JMP PCHK1 NO SZB,RSS YES, POWER ZERO? JSB ERROR YES POWER EQU * SSB,RSS NO, POWER POSITIVE? JMP FALSE YES JSB ERROR NO ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FOR0A,I PCHK1 SZB,RSS POWER ZERO? JMP TRUE YES, RETURN 1,0 JMP PCHK,I NO ** ** EXECUTE > ** ** EGTRT JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP FALSE YES JMP ENEQ1 NO ** ** EXECUTE < ** ** ELST JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP TRUE YES JMP FALSE NO ** *** EXECUTE = ** ** EEQL JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE EEQL1 SZA ZERO? JMP FALSE NO JMP TRUE YES ** ** EXECUTE >= ** ** EGORE JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA POSITIVE? JMP FALSE NO JMP TRUE YES ** *** EXCUTE <= ** ** ELORE JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP TRUE YES JMP EEQL1 NO ** ** EXECUTE # ** ** ENEQL JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE ENEQ1 SZA NON-ZERO? JMP TRUE YES ** *** SET LOGICAL VALUES ** ** FALSE CLA LOAD CLB ZERO JMP FOR0A,I TRUE LDA HONE LOAD LDB .2 ONE JMP FOR0A,I ** *** EXECUTE UNARY - ** ** EUMIN JSB STTOP LOAD NUMBER JSB ARINV NEGATE NUMBER JMP FOR0A,I ** *** EXECUTE LEFT BRACKET ** ** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP STACK JSB RSCHK JMP TRUE 1 ** *** EXECUTE OR ** ** EOR JSB BINOP VALIDATE JMP ORS OPERANDS ORS SZA SECOND OPERAND NON-ZERO? JMP TRUE YES ORS1 LDA BINO2,I NO, CHECK SECOND JMP ENEQ1 OPERAND ** *** EXECUTE AND ** ** EAND JSB BINOP VALIDATE JMP ANDS OPERANDS ANDS SZA,RSS SECOND OPERAND ZERO? JMP FALSE YES JMP ORS1 NO ** *** EXECUTE NOT ** ** ENOT JSB STTOP LOAD OPERAND SZA ZERO? JMP FALSE NO JMP TRUE YES ** ** ADD TWO FLOATING POINT QUANTITIES ** ** ADMUP NOP LDA ADMUP STA STK24 LDA STK4 ADMU1 CMA,INA EXPONENT ADA EXP DIFFERENCE SSA,RSS ARG 1 LARGER? JMP ADMU2 YES LDA A1 NO, LDB A2 SWAP STA A2 ARGUMENTS STB A1 LDA C1 LDB C2 STA C2 STB C1 LDA EXP LDB STK4 STA STK4 STB EXP JMP ADMU1 ADMU2 ADA M25 SHIFT COUNT >= LDB C1 SSA,RSS 25 ? JMP ADMU4 YES, IGNORE SMALLER ARGUMENT CMA,CLE NO, COMPUTE ADA M25 SHIFT COUNT STA STK4 LDA A2 LOAD SMALLER LDB C2 MANTISSA ADMU3 ISZ STK4 JMP ADMU5 YES ADB C1 NO, ADD LOW MANTISSAS CLO RBR,ELB SAVE (E) IN B(0) CLE ADA A1 ADD HIGH MANTISSAS SLB OVERFLOW FROM LOWER MANTISSA? INA YES, ADD IT IN ERB,CLE,ELB ERASE B(0) SOS OVERFLOW? JMP ADMU4+1 NO ERA YES, SHIFT ERB MANTISSA DOWN AND ISZ EXP CORRECT EXPONENT JMP ADMU4+1 RSS ADMU4 LDA A1 RETRIEVE HIGH MANTISSA JSB .PACK NORMALIZE AND PACK JMP STK24,I ADMU5 CLE,SLA,ARS ARITHMETIC CME DOUBLE ERB,CLE SHIFT JMP ADMU3 ** *** ADD TWO FLOATING POINT NUMBERS ** ** .FAD NOP JSB UNPAK UNPACK THE ARGUMENTS LDA .FAD STA STK6 JSB ADMUP ADD THEM UP JMP STK6,I ** *** SUBTRACT TWO FLOATING POINT NUMBERS ** ** .FSB NOP JSB UNPAK UNPACK THE ARGUMENTS LDA .FSB STA STK6 LDA A2 TWO'S COMPLEMENT CMA THE SECOND ARGUMENT CMB,INB,SZB LOW PART ZERO? JMP .FSB1 NO SSA,INA,RSS YES, ORIGINAL NUMBER NEGATIVE? SSA,RSS YES, STILL NEGATIVE? JMP .FSB1 NO RAR YES, SHIFT DOWN AND ISZ STK4 .FSB1 STB C2 SAVE COMPLEMENTED STA A2 NUMBER JSB ADMUP ADD ARGUMENTS JMP STK6,I ** *** UNPACK ARGUMENTS FOR ARITHMETIC OPERATIONS ** ** UNPAK NOP STA A1 SAVE HIGH PART OF ARG 1 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN WORD STB C1 SAVE LOW PART OF ARG 1 STA EXP SAVE EXPONENT OF ARG 1 LDA UNPAK COMPUTE ADDRESS OF ADA M2 CALLING ROUTINE LDB 0,I ISZ 0,I SET CALLING ROUTINE-S RETURN LDB 1,I LOAD RBL,CLE,SLB,ERB JMP *-2 LDA 1,I LOAD INB ARG 2 LDB 1,I STA A2 SAVE HIGH PART OF ARG 2 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN STB C2 SAVE LOW PART OF ARG 2 STA STK4 JMP UNPAK,I ** *** MULTIPLY TWO FLOATING POINT NUMBERS ** ** .FMP NOP UNPACK THE JSB UNPAK ARGUMENTS ADA EXP ADD EXPONENTS INA PLUS 1 FOR STA EXP NORMALIZATION RBR POSITION LOW PART OF ARG 2 LDA 1 COMPUTE A JSB MPY CROSS PRODUCT DEF A1 STA C2 SAVE RESULT LDA .FMP STA STK6 LDA C1 LOAD AND POSITION RAR LOW PART OF ARG 1 STB C1 SAVE REST OF PRIOR RESULT JSB MPY COMPUTE SECOND DEF A2 CROSS PRODUCT ADB C1 ADD CLE CROSS ADA C2 PRODUCTS SEZ CORRECT INB FOR CARRY STB C2 SAVE RESULT LDA A1 COMPUTE JSB MPY HIGH PART DEF A2 OF PRODUCT CLE,ERA POSITION LOW PART ADA C2 ADD IN CROSS TERMS CLE,ELA REPOSITION SEZ,RSS CARRY FROM LOW PART? JMP *+4 SOC YES, POSITIVE CARRY? INB,RSS YES ADB M1 NO STA A1 EXCHANGE LDA 1 LDB A1 REGISTERS JSB .PACK NORMALIZE AND PACK JMP STK6,I ** *** PERFORM FLOATING DIVIDE ** ** .FDV NOP JSB UNPAK UNPACK ARGUMENTS LDB .FDV STB STK6 LDB A2 DIVISOR SZB,RSS ZERO? JMP .FDV2 YES LDB A1 NO,DIVIDEND SZB,RSS ZERO? JMP .FDV1 YES CMA,INA NO, COMPUTE INA EXPONENT ADA EXP DIFFERENCE STA EXP PLUS 1 LDA C1 LOAD DIVIDEND CLE,SLB,BRS ARITHMETIC CME RIGHT SHIFT ERA TWICE TO CLE,SLB,BRS PREVENT CME DIVISION ERA OVERFLOW JSB IDIV DIVIDE STA STK4 BRS DIVIDE REMAINDER BY 2 TO CLA PREVENT DIVISION OVERFLOW JSB IDIV DIVIDE REMAINDER AND STA STK7 LDB C2 CLA,CLE SCALE TO ERB,BRS PREVENT BRS OVERFLOW JSB IDIV COMPUTE B2/A2 = Q CMA,INA COMPUTE JSB MPY -HIGH QUOTIENT*Q DEF STK4 BLS,CLE,ELB SHIFT SIGN TO (E) LDA STK7 SSA NEGATIVE? CCA,RSS YES, SET (A)=-1 (EXTEND CLA NO, SET (A)=0 SIGN) CMA,SEZ IF (E)=1 SUBTRACT INA 1 AS EXTENSION CMA,CLE OF PRODUCT ADB STK7 SEZ CARRY INA INTO (A) CLE,ELB POSITION ELA REGISTERS ADA STK4 RSS .FDV1 CLA SET MANTISSA TO ZERO JSB .PACK NORMALIZE AND PACK JMP STK6,I .FDV2 JSB ERROR DIVIDE-BY-ZERO DBYZR LDA A1 JSB OVFLW RETURN INFINITY JMP STK6,I ** *** INTEGER DIVIDE ** ** IDIV NOP DIVIDEND IN (B) AND (A) STB A1 SAVE HIGH DIVIDEND LDB A2 CLE,SSB SET (B) TO ABS(B) CMB,CME,INB AND (E) TO SIGN(B) STB .FAD SAVE POSITION DIVISOR CMB,INB SAVE STB .FSB NEGATIVE DIVISOR LDB M16 SET STB C1 COUNTER LDB M2 SET STB SIGN STB .FMP SIGNS LDB A1 RETRIEVE HIGH DIVIDEND SSB,RSS POSITIVE? JMP IDIV1 YES ISZ .FMP NO, SET REMAINDER SIGN CMB,CME NEGATIVE AND COMPLEMENT SZA THE DIVISOR CMA,INA,RSS AND (E) INB IDIV1 SEZ QUOTIENT POSITIVE? ISZ SIGN NO IDIV2 CLE,ELA SHIFT ELB DIVIDEND ADB .FSB SUBTRACT DIVISOR SSB,RSS OK? INA,RSS YES ADB .FAD NO, RESTORE DIVIDEND ISZ C1 DONE? JMP IDIV2 NO CMA,INA YES, NEGATE QUOTIENT ISZ SIGN RESULT TO BE POSITIVE? CMA,INA YES ISZ .FMP NO,REMAINDER POSITIVE? JMP IDIV,I YES CMB,INB NO JMP IDIV,I SKP * ****************************** * SYMBOL TABLE SEARCH SUBROUTINE * ****************************** * SSYMT NOP STA STEMP STORE IDENTIFIER AND .15 ISOLATE IDENTIFIER TYPE ADA M4 SSA,INA JMP *+4 JUMP IF ARRAY TYPE LDA STEMP RESTORE A STA 1 STORE IN B JMP SYMT1+3 SSA SKIP IF UNDIMENSIONED JMP SYMT1 LDA STEMP RESTORE A AND MSK3 177771B SET TYPE TO 1 STA 1 INB SET TYPE IN 3 TO 2 JMP *+4 SYMT1 CCB SET DIMENSIONED FLAG TO B LDA .3 IOR STEMP SET TYPE TO UNDEFINED STA STEMP+1 STORE A STB STEMP+2 STORE B LDB SYMTF START OF SYMBOL TABLE JMP SYMT4 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY CPA STEMP COMPARE WITH IDENTIFIER JMP SSYMT,I MATCH? RETURN CPA STEMP+1 COMPARE WITH DIFFERENT DIM. JMP SYMT3 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. JMP SYMT3 LDA 1,I AND .15 CPA .15 JMP *+5 ADA M4 SSA INB INB ADB .2 SYMT4 CPB SYMTA CCB,RSS JMP SYMT2 LDA STEMP JMP SSYMT,I SYMT3 LDA STEMP RESTORE A ISZ STEMP+2 DIMENSIONED IDENTIFIER? RSS NO, SKIP STA 1,I YES CHANGE 1ST WORD OF ENTRY TO JMP SSYMT,I APPROPRIATE DIMENSION TYPE SKP ** *** ERROR TABLE ** ** ERR DEF EOF+1 PREMATURE STATEMENT END DEF RTLE INPUT EXCEEDS 71 CHARACTERS DEF INVSC SYSTEM COMMAND NOT RECOGNIZED DEF SYNE1 NO STATEMENT TYPE FOUND DEF NUMER+1 DEF SYE16 NO LETTER WHERE EXPECTED DEF SYNE2 LET STATEMENT HAS NO STORE DEF SYNE3 ILLIGAL COM STATEMENT DEF SYNE4+1 NO FUNCTION IDENTIFIER (OR BAD) DEF SYNE5 MISSING PARAMETER DEF SYNE6+1 MISSING ASSIGNMENT OPERATOR DEF SYNE7 MISSING 'THEN' DEF SYNE8+1 MISSING OR IMPROPER FOR-VARIABLE DEF SYNE9 MISSING 'TO' DEF SYE10 BAD 'STEP' PART IN FOR STATEMENT DEC -1 DEC -1 DEF SYE12 NO CONSTAND WHERE EXPECTED DEF SYE13 NO VARIABLE WHERE EXPECTED DEF SYE14 NO CLOSING QUOTE FOR STRING DEF SYE15 PRINT JUXTAPOSES FORMULAS DEF SYE17 IMPROPER WORD IN MAT STATEMENT DEF SYE18 NO COMMA WHERE EXPECTED DEF SYE19 IMPROPER ARRAY FUNCTION DEF SYE20 NO SUBSCRIPT WHERE EXPECTED DEF SYE21 ARRAY INVERSION INTO SELF DEF SYE22 MISSING MULTIPLICATION OPERATOR DEF SYE23 IMPROPER ARRAY OPERATOR DEF SYE24+1 ARRAY MULTIPLICATION INTO SELF DEF FSCE1+1 MISSING LEFT PARENTHESIS DEF FSCE2+1 MISSING RIGHT PARENTHESIS DEF FSCE3+1 UNRECOGNIZED OPERAND DEF ARRE1 MISSING SUBSCRIPT DEF ARRE2 MISSING ARRAY IDENTIFIER DEF SYE25+1 MISSING OR BAD INTEGER DEF NOEOF+1 CHARACTERS AFTER STATEMENT END DEF FSCE4+1 DEF PRERR PHOTO READER NOT READY DEF MER4 FUNCTION MULTIPLY DEFINED DEF MER6 UNMATCHED FOR STATEMENT DEF MER3 UNMATCHED NEXT DEF MER8 OUT OF STORAGE-SYMBOL TABLE DEF MSYM INCONSISTENT DIMENSIONS DEF MLOP6 DEF MER5 ARRAY DOUBLE DIMENSIONED DEF MER10 NO OF DIMENSIONS UNSPECIFIED DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE-ARRAY ALLOCATION DEF E6 SUBSCRIPT TOO LARGE DEF E8 UNDEFINED OPERAND ACCESSED DEF BASER NEGATIVE BASE POWERED TO REAL DEF POWER ZERO TO ZERO POWER DEF XEC5 MISSING STATEMENT DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN FINDS NO ADDRES DEF E4 OUT OF DATA DEF E1+1 OUT OF STORAGE - EXECUTION DEF E7 RE-DIMENSIONED ARRAY TOO LARGE DEF LERR+1 DEF LCHK5 MATRIX UNASSIGNED DEF LDUM1 NEARLY SINGULAR MATRIX DEF TRGER ARGUMENT TOO LARGE DEF SQRER SQRT HAS NEGATIVE ARGUMENT DEF LOGER LOG OF NEGATIVE ARGUMENT RCERR EQU * ** RECOVERABLE ERRORS FOLLOW ** DEF OVRER OVERFLOW DEF UNDER UNDERFLOW DEF LNZR LOG OF ZERO DEF EXPER EXPONTIAL OVERFLOW DEF DBYZR DIVIDE BY ZERO DEF ZRTNG ZERO TO NEGATIVE POWER ** *** OUTPUT A NUMBER ** ** NUMOT NOP NUMBER (A) AND (B) STA EXPON SAVE NUMBER LDA NUMOT STA STK9 LDA EXPON SEZ,RSS SIGN? JMP NS2 NO SSA,RSS YES,NEGATIVE NUMBER? JMP NS1 NO JSB ARINV YES, INVERT IT STA EXPON LDA .45 RSS NS1 LDA .32 STORE STA SIGN SIGN LDA EXPON NS2 STB STK8 JSB IFIX INTEGERIZE NOP LDA STK9,I STA NUMO1 STA NUMO3 ISZ STK9 SOC WAS IT AN INTEGER? JMP NUMO2 NO CLA STB B1+1 ADB M1000 SSB,RSS ADA .3 ADA .6 ADA CCNT CMA,INA STA MLBX1+1 ADA .74 SSA NUMO1 NOP NO LDA SIGN SZA SIGN? JSB OUTCR YES, OUTPUT IT LDA B1+1 JSB OUTIA,I THE INTEGER JMP STK9,I NUMO2 CCA SET 'FIXED' STA FFLAG FLAG FALSE LDA EXPON LOAD * *** THESE TWO INSTRUCTIONS CHECK FOR AN NUMERIC UNDERFLOW. *** IF MANTISSA IS ZERO, GIVE AN ERROR 50 MESSAGE. *** OTHERWISE, CONTINUE TO OUTPUT NUMBER * SZA,RSS ZERO MANTISSA? JMP E8-1 YES - ERROR (UNDERFLOW) * LDB STK8 JSB .FADA,I IS NUMBER DEF MAXFX LESS THAN SSA,RSS 999999.5? JMP NUMO5 NO LDA EXPON YES, IS LDB STK8 JSB .FADA,I LESS DEF MINFX THAN LDB .12 SAVE SSA,RSS ISZ FFLAG NUMO5 LDB .15 WIDTH ADB CCNT SAVE CMB,INB END-OF-FIELD STB MLBX1+1 ADB .75 ROOM SSB ENOUGH? NUMO3 NOP NO ** *** OUTPUT A FLOATING POINT NUMBER ** ** LDA EXPON STA MANT1 LDB STK8 JSB .FLUN STB MANT2 NUMBER STA EXP LDA SIGN SZA SIGN JSB OUTCR YES, OUTPUT IT CLA INITIALIZE COUNTER STA EXPON FOR DECIMAL EXPONENT CPA EXP EXPONENT ZERO? JMP EOUT4 YES EOUT2 JSB MBY10 NO, LDA EXP MULTIPLY CMA,INA NUMBER BY 10 SSA UNTIL JMP *+3 ISZ EXPON GREATER JMP EOUT2 THAN 1 JSB DBY10 DIVIDE BY 10 LDA EXPON EOUT3 LDB EXP DIVIDE CMB,INB NUMBER SSB,RSS BY 10 JMP EOUT4 UNTIL STA EXPON IT IS JSB DBY10 LESS CCA THAN ADA EXPON 1 JMP EOUT3 EOUT4 CMA SET EXPONENT STA EXPON TO TRUE VALUE-1 LDB M7 SET DIGIT STB STK10 CCB SET DECIMAL STB STK4 CPB FFLAG FIXED POINT? JMP EOUT6 NO CMA YES, SET STA STK4 CPA .1 .1? JMP EOUT5 YES SSA,RSS LEADING DECIMAL POINT? JMP EOUT7+2 YES EOUT6 JSB GETDG OUTPUT ADA .48 A JSB OUTCR DIGIT JMP EOUT8 EOUT5 LDA .46 OUTPUT JSB OUTCR DECIMAL POINT LDA .48 OUTPUT JMP EOUT8-1 LEADING ZERO EOUT7 ISZ STK4 JMP EOUT6 NO LDA .46 YES, JSB OUTCR OUTPUT IT EOUT8 ISZ STK10 JMP EOUT7 YES LDA CCNT NO, STA NUMO1 SAVE LDA BADDR OUTPUT STA NUMO3 POINTERS JSB GETDG NEXT DIGIT ADA M5 FIVE OR SSA GREATER? JMP EOUT1 NO CCA SET DECIMAL ERND1 STA STK11 JSB RETCR RETRIEVE CHARACTER CPA .46 DECIMAL POINT? JMP ERND1-1 YES, FLAG IT JSB DIGCK NO, DIGIT? JMP ERND2 NO CPA .9 YES,9? JMP *+3 ADA .49 NO, BUMP JMP ERND3 DIGIT 1 LDA .48 OVERLAY JSB OUTCR A ZERO JSB RETCR BACKSPACE CCA DECREMENT ADA STK11 JMP ERND1 COUNTER ERND2 JSB OUTCR RESTORE CHARACTER ISZ EXPON CORRECT NOP EXPONENT LDA .49 OVERLAY A1 LDB FFLAG SZB JMP ERND3 NO JSB OUTCR A ZERO LDA .48 OVERLAY ISZ STK11 JMP *-3 NO LDA .46 YES ERND3 JSB OUTCR LDA NUMO1 RESTORE STA CCNT OUTPUT LDA NUMO3 POINTERS STA BADDR EOUT1 ISZ FFLAG NO, FIXED POINT? JMP EOUT9 YES LDA E NO, JSB OUTCR OUTPUT 'E' LDA .45 LOAD '-' LDB EXPON POSITIVE SSB EXPONENT? CMB,INB,RSS NO LDA .43 YES, LOAD '+' STB EXPON JSB OUTCR OUTPUT SIGN LDB EXPON LDA .48 COMPUTE ADB M10 SSB EXPONENT JMP *+3 INA DIGIT JMP *-4 ADB .58 COMPUTE STB EXPON SECOND DIGIT JSB OUTCR OUTPUT LDA EXPON JSB OUTCR EXPONENT JMP STK9,I EOUT9 JSB RETCR RETRIEVE CHARACTER CPA .48 ZERO? JMP EOU10 YES JSB OUTCR NO, RESTORE CHARACTER JMP STK9,I EOU10 LDA .32 OVERLAY JSB OUTCR A BLANK JSB RETCR JMP EOUT9 ** *** GET DIGIT TO OUTPUT ** ** GETDG NOP JSB MBY10 MULTIPLY BY 10 LDB EXP GET EXPONENT IN (B) CMB,INB AS NEGATIVE AND HIMSK KEEP 5 HIGH BITS OF (A) RAL NORMALIZE TO BIT 15 SSB,INB ROTATE INTEGER JMP *-2 INTO (A) AND MSK0 STA STK7 LDB EXP ROTATE CMB,INB RAR BACK SSB,INB JMP *-2 XOR MANT1 REMOVE LDB MANT2 DIGIT JSB NORML NORMALIZE REMAINDER LDA STK7 JMP GETDG,I * *** RETRIEVE CHARACTER FROM OUTPUT BUFFER ** * RETCR NOP LDB CCNT DECREMENT ADB M1 CHARACTER STB CCNT COUNT LDA BADDR,I POSITION SLB,RSS AND ALF,ALF EXTRACT AND MSK0 SLB FIRST CHARACTER OF WORD? JMP RETCR,I NO LDB BADDR YES, DECREMENT ADB M1 BUFFER STB BADDR POINTER JMP RETCR,I HED LIBRARY ROUTINES * ****************************** * SUBROUTINE TO CALCULATE TAN(X) * ****************************** * ETAN JSB .FMPA,I DEF FOPI 4/PI STA XTEMP STB XTEMP+1 JSB .FADA,I DEF K1 JSB .PWR2 DEC -2 JSB .IENT JSB ERROR TRGER JSB FLOAT JSB ARINV JSB .PWR2 DEC 2 JSB .FADA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=X-4*ENTIER((X+1)/4) JSB .FSBA,I DEF K1 STA SBOXX SSA X<1? JMP ELSE1 YES LDA K2 NO LDB K2+1 JSB .FSBA,I DEF XTEMP BOTH1 STA YTEMP STB YTEMP+1 Y= 2-X JSB .FMPA,I DEF YTEMP JSB .FMPA,I DEF K2 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEFF JSB .FMPA,I DEF YTEMP STA YTEMP STB YTEMP+1 Y=Y*CHEBY(2*Y**2-1) LDA SBOXX SSA X<1? JMP ELSE2 YES LDA K1 LDB K1+1 JSB .FDVA,I DEF YTEMP JMP FR12A,I ELSE1 LDA XTEMP LDB XTEMP+1 JMP BOTH1 Y=X ELSE2 LDA YTEMP LDB YTEMP+1 JMP FR12A,I FOPI DEC 1.273239545 4/PI K1 DEC 1. XTEMP BSS 2 YTEMP BSS 2 UTEMP BSS 2 K2 DEC 2. COEFF DEC 1.4458E-8 DEC 2.013766E-7 DEC 2.804816E-6 DEC 3.906637E-5 DEC 5.4417038E-4 DEC 7.586101578E-3 DEC .10675392857 DEC 1.7701474227 OCT 0 SKP * ****************************** * SUBROUTINE TO CALCULATE ATN(X) * ****************************** * EATN STA XTEMP STB XTEMP+1 LDA 1 AND MSK0 STA SBOXX SZA SLA ABS (X) > 1 ? JMP ELS1 NO LDA K1 LDB K1+1 JSB .FDVA,I DEF XTEMP U=1/X BTH1 STA UTEMP STB UTEMP+1 JSB .FMPA,I DEF UTEMP JSB .FMPA,I DEF K2 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEF JSB .FMPA,I DEF UTEMP STA YTEMP STB YTEMP+1 Y=U*CHEBY(2*U**2-1) LDA SBOXX SZA SLA ABS(X)>1 ? JMP ELS2 NO LDA XTEMP SSA X= 15 JSB FLOAT JSB .FMPA,I DEF MM4 JSB .FADA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=X-4*ENTIER((X+1)/4) JSB .FSBA,I DEF K1 SSA X<1 ? JMP PAST YES LDA K2 LDB K2+1 JSB .FSBA,I DEF XTEMP STA XTEMP STB XTEMP+1 X=2-X PAST LDA XTEMP LDB XTEMP+1 JSB .FMPA,I DEF XTEMP JSB .PWR2 DEC 1 JSB .FSBA,I DEF K1 JSB .CHEB DEF COEF1 JSB .FMPA,I DEF XTEMP JMP FR12A,I TOPI DEC .636619772 2/PI MM4 DEC -4. COEF1 DEC 1.18496E-6 DEC -1.365875E-4 DEC 9.118016E-3 DEC -.2852615692 DEC 2.5525579248 OCT 0 SPC 10 * ***************************** * SUBROUTINE TO COMPUTE ABS (X) * ***************************** EABS SSA JSB ARINV YES, NEGATE IT JMP FR12A,I SKP * **************************** * SUBROUTINE TO COMPUTE RND(X) * **************************** * * ERND CLA STA EXP INITIALIZE EXPONENT LDA XH COMPUTE ALS HIGH ADA XH PART LDB XL 2*XH CLE,ERB + XH + ADA 1 XL*2^15 LDB XL RBL,CLE,SLB,ERB ADD XL[15] TO INA (A) (FROM 2*XL$ CLE,ELB 2*XL ADB XL + XL ELA,CLE,SLA,ERA ADD OVERFLOW CLE,INA TO (A) ADB FLGBT ADD IN TRAILING BIT OF XL*2^15 SEZ ADD OVERFLOW INA TO (A) ELA,CLE,ERA ERASE A[15] STA XH STORE STB XL INTEGER JSB .PACK NORMALIZE AND PACK JMP FR12A,I SKP * ****************************** * SUBROUTINE TO CALCULATE SQR(X) * ****************************** * ESQR SZA,RSS JMP FR12A,I SSA X=124 ? JMP EXPER-1 YES,ERROR ADA .244 INTE <-120 ? SSA JMP ZERE YES,ANS=0 LDA XTEMP LDB XTEMP+1 JSB .FSBA,I DEF YTEMP STA XTEMP STB XTEMP+1 X=X-ENTIER(X) JSB .FMPA,I DEF XTEMP STA UTEMP STB UTEMP+1 U=X**2 JSB .FADA,I DEF AAAA STA YTEMP STB YTEMP+1 Y=X**2+AAAA LDA BBBB LDB BBBB+1 JSB .FDVA,I DEF YTEMP STA YTEMP STB YTEMP+1 Y=BBBB/Y LDA CCCC LDB CCCC+1 JSB .FMPA,I DEF UTEMP JSB .FADA,I DEF DDDD JSB .FSBA,I DEF XTEMP JSB .FSBA,I DEF YTEMP STA YTEMP STB YTEMP+1 Y=X+DDDD+CCCC*X**2-Y LDA XTEMP LDB XTEMP+1 JSB .FDVA,I DEF YTEMP JSB .FADA,I DEF HALF ISZ INTE NOP JSB .PWR2 INTE OCT 0 JMP .EXP,I AND=(0.5+X/Y)*2**INTE ZERE CLA CLB JMP .EXP,I .EXP1 LDA X2TMP SSA JMP ZERE JSB ERROR EXPER LDA INF LDB M2 JMP .EXP,I M124 DEC -124 .244 DEC 244 AAAA DEC 87.417497202 BBBB DEC 617.9722695 CCCC DEC .03465735903 DDDD DEC 9.9545957821 L2E DEC 1.4426950409 SKP * ****************************** * SUBROUTINE TO COMPUTE CHEBY(X) * ****************************** * .CHEB NOP STA .IENT LDA .CHEB STA RSYM LDA .IENT JSB .FMPA,I DEF K2 STA X2TMP STB X2TMP+1 X2 =X+2 LDB RSYM,I STB CTMP C POINTS TO COEFFICIENT TABLE LDA 1,I INB LDB 1,I GET FIRST COEFF STA DTMP STB DTMP+1 D=C(N) CLA STA BTMP STA BTMP+1 B=0 LOPC ISZ CTMP ISZ CTMP N=N-1 LDA CTMP,I SZA,RSS C(N)=0 ? JMP COUT ZERO FLAGS END OF TABLE LDA BTMP NO LDB BTMP+1 STA ATMP STB ATMP+1 A=B LDA DTMP LDB DTMP+1 STA BTMP STB BTMP+1 B=D JSB .FMPA,I DEF X2TMP JSB .FSBA,I DEF ATMP JSB .FADA,I DEF CTMP,I STA DTMP STB DTMP+1 D=C(N) -A+B*X2 JMP LOPC COUT LDA DTMP LDB DTMP+1 JSB .FSBA,I DEF ATMP JSB .FMPA,I DEF HALF ISZ RSYM JMP RSYM,I * *** CONSTANTS FOR .CHEB * X2TMP BSS 2 ATMP BSS 2 BTMP BSS 2 CTMP BSS 2 DTMP BSS 2 SKP * ******************************************** * SUBROUTINE TO COMPUTE THE ENTIER OF A NUMBER * WHOSE EXPONENT IS LESS THAN 15 * ******************************************** * .IENT NOP STA X2TMP STORE HIGH PART LDA 1 MOVE LOW PART TO A AND MSK0 ISOLATE EXPONENT SLA,RAR JMP *+4 IF NEGATIVE OK ADA M15 SSA,RSS EXPO(X) > 14 JMP .IENT,I YES, ERROR RETURN ISZ .IENT NO BUMP RETURN POINT LDA X2TMP RESTORE HIGH PART JSB IFIX CALL ENTIER NOP LDA 1 JMP .IENT,I SPC 5 * ****************************** * SUBROUTINE TO FLOAT AN INTEGER * ****************************** * FLOAT NOP LDB FLOAT STB STK1 LDB .15 STB EXP CLB JSB .PACK JMP STK1,I SKP * **************************************** * SUBROUTINE TO MULTIPLY BY A POWER OF TWO * **************************************** * .PWR2 NOP SZA,RSS X=0 ? JMP .RET YES, ANS=0 STA X2TMP JSB .FLUN STB X2TMP+1 ADA .PWR2,I RAL AND MSK0 STA 1 ADB X2TMP+1 LDA X2TMP .RET ISZ .PWR2 JMP .PWR2,I HED *** MATRIX ROUTINES *** * ***************************** * MATRIX STMT EXECUTION CONTROL * ***************************** * EMAT LDA TEMPS,I LOAD FIRST WORD OF STMT ISZ TEMPS AND MSK1 ISOLATE OPERAND PART SZA JMP EMAT7 LDA TEMPS,I LOAD NEXT WORD OF STMT AND OPMSK STA MLBX1 CPA RDOP RSS JSB PRNIA,I * EMAT1 LDA TEMPS,I AND MSK1 SZA,RSS JMP EMAT4+4 JSB SSYMA,I INB,SZB,RSS JMP E8M1A,I ISZ TEMPS LDA 1,I STA B1 LDA MLBX1 CPA RDOP JMP EMAT5 ADB .2 LDA 1,I STA B1+1 AND MSK0 CMA,INA STA B2 STA B2+1 LDA 1,I ALF,ALF AND MSK0 CMA,INA STA B3 JSB LCK2A,I CLA STA B3+1 LDA TEMPS CPA PRADD JMP EMAT3 LDA TEMPS,I AND OPMSK CPA B3000 ISZ B3+1 JMP EMAT3 EMAT2 CLB CPB B3+1 JSB EDELM EMAT3 LDA B1,I ISZ B1 LDB B1,I ISZ B1 JSB ENOUT ISZ B2 JMP EMAT2 JSB OUTLN JSB OUTLN LDA B2+1 STA B2 ISZ B3 JMP EMAT3 EMAT4 LDB TEMPS CPB PRADD RSS JMP EMAT1 CLA,INA JSB SEXU,I JMP XEC4A,I * EMAT5 STB B2 LDA TEMPS,I AND OPMSK LDB TEMPS CPB PRADD CLA CPA B2200 JSB REDIM LDA B2 ADA .2 LDA 0,I JSB MDIM ARS CMA,INA STA B3 EMAT6 JSB FDAT,I STA B1,I ISZ B1 STB B1,I ISZ B1 ISZ B3 JMP EMAT6 JMP EMAT4 * EMAT7 JSB SSYMA,I INB LDA 1,I STA B3 STB B2 ADB .2 LDA 1,I STA B3+1 CLA,INA STA STK1 EMAT0 LDA TEMPS,I ISZ TEMPS SSA JMP EMA11 EMAT8 AND MSK1 SZA,RSS JMP EMA10 JSB SSYMA,I INB LDA 1,I STA B1 ADB .2 LDA 1,I STA B1+1 LDB TEMPS CPB PRADD JMP EMAT9 LDA TEMPS,I ARS ALF,ALF AND .63 ADA M6 STA STK1 LDA TEMPS,I AND MSK1 JSB SSYMA,I INB LDA 1,I STA B2 ADB .2 LDA 1,I STA B2+1 EMAT9 LDA STK1 ADA LMAP JSB 0,I JMP XEC4A,I LMAP DEF LBASE-1,I LBASE DEF REPLC DEF ADD DEF SUB DEF MULT DEF SZER DEF LCON DEF LIDN DEF LINV DEF TRAN DEF SMULT EMA10 LDA .10 STA STK1 JSB FETCA,I STA MLBX1 STB MLBX1+1 ISZ TEMPS ISZ TEMPS JMP EMAT0 EMA11 ALF,ALF ALF AND .31 ADA M8 STA STK1 ADA M8 SSA JMP EMA12 LDA TEMPS,I ISZ TEMPS ISZ TEMPS JMP EMAT8 EMA12 LDB TEMPS CPB PRADD JMP EMAT9 JSB REDIM JMP EMAT9 SKP * ******************************* * SUBROUTINE TO REDIMENSION ARRAY * ******************************* * REDIM NOP JSB MCKS BLF,BLF STB B3+1 CLB,INB ISZ TEMPS INDEX POINTER LDA TEMPS,I AND OPMSK CHECK OPERAND PART CPA LF JMP REDI1 JSB MCKS ISZ TEMPS REDI1 ISZ TEMPS ADB B3+1 STB B3+1 LDA B2 ADA .2 STB 0,I ADA M1 LDA 0,I JSB MDIM COMPUTE SIZE OF ASSIGNED STORAGE STA MLBX1+1 LDA B3+1 JSB MDIM COMPUTE STORAGE REQUIRED CMA,INA COMPLEMENT ADA MLBX1+1 SSA OK IF POSITIVE JSB ERROR E7 JMP REDIM,I SKP * ****************************************** * SUBROUTINE TO EVALUATE & CHECK A SUBSCRIPT * ****************************************** MCKS NOP JSB FETCA,I CALL FOR EVALUATION JSB SBFIX CONVERT TO INTEGER (ROUNDED) INB LDA 1 ADA M256 SSA,RSS JMP E6M1A,I JMP MCKS,I RETURN ** *** PREDEFINED FUNCTION JUMP TABLE ** ** PDFT DEF ETAB DEF ESIN DEF ECOS DEF ETAN DEF EATN DEF EEXP DEF ELOG DEF EABS DEF ESQR DEF EINT DEF ERND DEF ESGN SKP *** MATRIX ROUTINES EXECUTION * * *** SUBROUTINE GENERAL * GENER NOP SUBROUTINE GENERAL LDA B2+1 LOAD DIM FOR MATRIX 2 LDB B1+1 LOAD DIM FOR MATRIX 1 JSB COMPR CHECK ROW AND COL DIM GEN2 LDA B1+1 LDB B3+1 LOAD DIM FOR MATRIX 3 JSB COMPR CHECKS ROW AND COL DIM JSB MPY DEF T3 CMA,INA STA LPIV LOOP LDA B1,I ISZ B1 LDB B1,I ISZ B1 MOD1 NOP NOP STA B3,I ISZ B3 STB B3,I ISZ B3 MOD2 NOP NEXT FOUR INSTR ARE MOD NOP ISZ LPIV JMP LOOP COMPUTE NEXT ELEMENT JMP GENER,I * *** SUBROUTINE COMPARE * COMPR NOP CPA 1 RSS LERR JSB ERROR PRINT ERROR DIAGNOSTIC ALF,ALF AND MSK0 STA T3 LDA 1 AND MSK0 STA T4 JMP COMPR,I * *** SUBROUTINE LCHK * LCHK2 NOP LDA LCHK2 STA LCHK1 JMP *+5 LCHK1 NOP LDB B2 LDA B2+1 JSB LCHK4 TEST EACH TERM OF B1 LDB B1 LDA B1+1 JSB LCHK4 JMP LCHK1,I LCHK4 NOP SUBROUTINE TO TEST TERMS STB T6 SAVE JSB MDIM COMPUTE SIZE OF MATRIX ARS CMA,INA STA T7 COUNTER FOR ELEMENTS LCHK6 LDA T6,I ISZ T6 LDB T6,I ISZ T6 CPA MNEG COMPARE WITH PRESET QTY. JMP *+2 JMP LCHK5 CPB MNEG+1 JSB ERROR ERROR 'MAT UNASSIGNED' LCHK5 ISZ T7 JMP LCHK6 JMP LCHK4,I RETURN SKP * *** SUBROUTINE MATRIX ADD * ADD NOP LDA LPLUS OCTAL INSTR FOR FAD T18 ADD1 STA MOD1 LDA LPLUS+1 ADDRESS OF T18 STA MOD1+1 MODIFY ROUTINE GENERAL LDA INCB2 STA MOD2 MODIFY ROUTINE GENERAL STA MOD2+1 MODIFY ROUTINE GENERAL JSB LCHK1 JSB GENER ROUTINE GENERAL JMP ADD,I EXIT TO MAIN PROGRAM * *** SUBROUTINE MATRIX SUBTRACT * SUB NOP LDA SUB STA ADD LDA LMIN OCTAL INSTR FOR FSB T18 JMP ADD1 * *** SUBROUTINE MATRIX REPLACE * REPLC NOP LDA REPLC STA GENER CLA CLB REPL1 STA MOD1 STB MOD1+1 CLA STA MOD2 STA MOD2+1 JSB LCHK2 JMP GEN2 SKP * *** SUBROUTINE MATRIX SCALAR MULTIPLY * SMULT NOP LDA SMULT STA GENER LDA LTIME LDB MBXL JMP REPL1 * *** SUBROUTINE MATRIX CON * LCON NOP LDA HONE LDB .2 LCON1 STA MLBX1 STB MLBX1+1 LDA B3+1 JSB MDIM ARS CMA,INA STA LPIV LDA MLBX1 LDB MLBX1+1 LCON2 STA B3,I ISZ B3 STB B3,I ISZ B3 ISZ LPIV JMP LCON2 JMP LCON,I * *** SUBROUTINE MATRIX ZERO * SZER NOP LDA SZER STA LCON CLA CLB JMP LCON1 * *** SUBROUTINE MATRIX IDN * LIDN NOP LDA B3 STA T9 JSB SZER LDA B3+1 ALF,ALF CPA B3+1 ALS,SLA JMP LERR AND MSK1 STA MLBX1 ARS CMA,INA STA MLBX1+1 LDB T9 STB B3 LIDN1 LDA HONE STA 1,I INB LDA .2 STA 1,I INB ADB MLBX1 ISZ MLBX1+1 JMP LIDN1 JMP LIDN,I * *** SUBROUTINES DLD AND DST * .DLD NOP JSB GETAD GET ADDRESS DEF .DLD,I ISZ .DLD BUMP RETURN ADDRESS LDA ADRES,I LOAD HIGH PART. ISZ ADRES LDB ADRES,I LOAD LOW PART. JMP .DLD,I .DST NOP JSB GETAD GET ADDRESS. DEF .DST,I ISZ .DST BUMP RETURN ADDRESS. STA ADRES,I STORE HIGH PART. ISZ ADRES STB ADRES,I STORE LOW PART. JMP .DST,I GETAD NOP COMPUTES EFFECTIVE ADDRESS. STA TINY SAVE A REGISTER. LDA GETAD,I GET POINTER TO ADDRESS. GET STA ADRES STORE IN ADRES. LDA TINY RESTORE A REGISTER. LDA ADRES,I RAL,CLE,SLA,ERA TEST FOR INDIRECT JMP GET IT IS INDIRECT. STA ADRES EFFECTIVE ADDRESS. LDA TINY ISZ GETAD RETURN JMP GETAD,I ADRES BSS 1 TINY BSS 1 * *** SUBROUTINE TRANSPOSE * TRAN NOP JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS LDA B3+1 PARAMETERS OF B3 ALF,ALF INTERCHANGE ROW AND COLUMN LDB B1+1 PARAMETERS OF B1 JSB COMPR SUBROUTINE COMPARE JSB MPY DEF T3 STA LPIV PRODUCT OF ROW*COL LDA T4 CMA,INA STA T5 TRAN1 CLA STA T6 SET T6=0 LNEXT LDB T6 BLS ADB B1 LDA 1,I INB LDB 1,I STA B3,I ISZ B3 STB B3,I ISZ B3 LDA T6 SET T6=T6+T4 ADA T4 T6 POINTS TO NEXT TERM IN STA T6 A COLUMN TO BE TRANSPOSED CPA LPIV TEST FOR LAST IN COL JMP *+2 JMP LNEXT ISZ B1 ISZ B1 ISZ T5 JMP TRAN1 TRANSPOSE NEXT COL JMP TRAN,I EXIT TO MAIN PROGRAM * *** SUBROUTINE MATRIX MULTIPLY * MULT NOP JSB LCHK1 TEST B1,B2 FOR UNASSIGNED TERMS LDA B3+1 PARAMETERS OF B3 AND MSK0 STA T6 LDA B2+1 AND MSK0 CPA T6 RSS JMP LERR LDA B3+1 PARAMETERS OF B3 AND M256 STA 1 STORE ROW IN MSP OF B LDA B2+1 PARAMETERS OF B2 ALF,ALF AND MSK0 ADA 1 COMBINE A AND B LDB B1+1 PARAMETERS OF B1 JSB COMPR COMPARE ROW AND COL LDA B2 MULT STA T5 LDA T3 CMA,INA STA T9 MULT4 LDA T6 CMA,INA STA T10 LDA T5 STA B2 RESTORE BASE ADDRESS B2 MULT3 CLA STA T11 COUNTER FOR B2. INCR BY STA T12 COUNTER FOR B1. INCR BY 2 CLB JSB .DST CLEAR TO ZERO DEF B3,I MULT2 LDB B1 COMPUTE PROD OF ONE TERM ADB T12 IN ROW BY ONE TERM IN COL STB T18 LDB B2 ADB T11 JSB .DLD DEF 1,I JSB .FMPA,I DEF T18,I JSB .FADA,I COMPUTES RUNNING SUM DEF B3,I JSB .DST DEF B3,I ISZ T12 SELECT NEXT TERM IN ROW ISZ T12 LDA T6 SELECT NEXT TERM IN COL ALS ADA T11 STA T11 LDA T4 ALS CPA T12 JMP *+2 JMP MULT2 MULT AND ADD IN NEXT TERM ISZ B3 INCR RECEIVING MAT ISZ B3 ISZ B2 BASE ADDRESS OF NEXT COL ISZ B2 ISZ T10 JMP MULT3 COMPUTE SAME ROW*NEXT COL LDA T4 ALS ADA B1 STA B1 ADDRESS OF NEXT ROW ISZ T9 COUNTER FOR ROW IN B1 JMP MULT4 MULT ROW BY ALL COLUMNS JMP MULT,I EXIT TO MAIN PROGRAM SKP * *** SUBROUTINE MATRIX INVERT * LINV NOP SUBROUTINE MATRIX INVERT JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS LDA B1+1 DIMENSIONS OF MATRIX B1 LDB B3+1 DIMENSIONS OF MATRIX B3 JSB COMPR CHECK DIMENSIONS LDA B3 STA T13 LDA B1+1 JSB MDIM CMA,INA ARS STA T2 ALS LDB LSTPT INB STB B2 STB B3 CMB,INB ADB HSTPT ADA 1 SSA SKIP IF SUFFICIENT CORE JMP E1 PRINT 'OUT OF CORE' JSB REPLC COPY B1 INTO B3 (B2) LDA T13 STA B3 RESTORE ADDRESS JSB LIDN SET B3 TO IDENTITY MATRIX LDA T13 STA B3 LSTPT+1 CLA STA T12 T12,T13 IS STORE STA T13 FOR GREATEST VALUE LDA B2 COPY B2 INTO B1 AS STA B1 B2 NEEDED LATER LIN11 LDA B1,I ISZ B1 LDB B1,I ISZ B1 SSA GET ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE STA T18 SAVE NUMBER STB T19 JSB .FSBA,I SUBTRACT EXISTING MAX. DEF T12 VALUE SSA SKIP AND SWAP IF POSITIVE JMP LIN10 LDA T18 SWAP LDB T19 STA T12 STB T13 LIN10 ISZ T2 JMP LIN11 LDA T12 COMPUTE RELATIVE TOLERANCE LDB T13 TOL=ABSOLUTE TOL * MAX VALUE JSB .FMPA,I DEF T16 ABSOLUTE TOLERANCE STA MLBX1 STB MLBX1+1 CLA STA LPIV ISZ T4 REQUIRE CONSTANT (ROW+1) LINV1 ISZ LPIV SELECT NEXT PIVOT LDA LPIV TEST IF HAVE PROCESSED CPA T4 LAST PIVOT JMP LINV,I NORMAL EXIT TO MAIN PROG LDA LPIV COMPUTE ADDRESS OF PIVOT LDB LPIV COLUMN USING ROUTINE LWHR STA T2 ROW COUNTER JSB LWHR ON RETURN, ADDRESS IN A STA T1 CLA STA T12 T12,T13 IS STORE STA T13 FOR GREATEST VALUE LINV2 JSB .DLD LOAD FP NUMBER DEF T1,I SSA OBTAIN ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE STA T18 STORE VALUE OF FP NUMBER STB T19 JSB .FSBA,I SUBTR EXISTING LARGEST VALUE DEF T12 SSA SKIP AND SWAP IF POSITIVE JMP LINV7 T12 STILL CONTAINS MAX VALUE LDA T18 STORE NEW MAX VALUE LDB T19 STA T12 STB T13 LDA T2 SET T5 TO POSITION IN STA T5 COLUMN OF MAX VALUE LINV7 ISZ T2 LDA T2 TEST FOR LAST TERM IN COL CPA T4 JMP LINV8 SWAP ROWS LDA T3 COMPUTE ALS NEXT ADDRESS ADA T1 IN PIVOT STA T1 COLUMN JMP LINV2 SELECT NEXT TERM LINV8 LDA LPIV COMPUTE ADDRESS CLB,INB JSB LWHR STA T1 ADDRESS OF PIVOTAL ROW LDA T5 CLB,INB JSB LWHR STA T2 ADDR OF ROW TO BE SWAPPED LDA LPIV CLB,INB JSB LWHR2 PIVOTAL ROW IN I-MATRIX STA T9 STA T10 KEEP COPY LDA T5 CLB,INB JSB LWHR2 BE SWAPPED IN I-MATRIX STA T11 LDA T3 CMA,INA STA T12 COUNTER FOR TERMS IN A ROW LINV3 JSB .DLD SWAP ONE ELEMENT OF ROW DEF T1,I STA T18 STB T19 JSB .DLD DEF T2,I STA T1,I ISZ T1 STB T1,I ISZ T1 LDA T18 LDB T19 STA T2,I ISZ T2 STB T2,I ISZ T2 JSB .DLD SWAP ONE ELEMENT IN A ROW DEF T9,I OF I-MATRIX STA T18 STB T19 JSB .DLD DEF T11,I STA T9,I ISZ T9 STB T9,I ISZ T9 LDA T18 LDB T19 STA T11,I ISZ T11 STB T11,I ISZ T11 ISZ T12 INCREMENT COUNTER JMP LINV3 SWAP NEXT ELEMENT LDA LPIV COMPUTE LDB LPIV ADDRESS OF JSB LWHR PIVOT STA T1 ELEMENT JSB .DLD PIVOT VALUE DEF T1,I SSA OBTAIN ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE JSB .FSBA,I SUBTRACT TOLERANCE AND DEF MLBX1 SSA COMPARE TO ZERO JSB ERROR PRINT-NEARLY SING MATRIX' LDUM1 LDA T1 ADDRESS OF PIOT ELEMENT STA T2 LDA HONE LDB .2 JSB .FDVA,I DEF T1,I STA T18 INVERSE OF PIVOT STB T19 LDA LPIV STA T11 COUNTER FOR ROW LINV6 ISZ T11 INCREMENT COUNTER LDA T11 CPA T4 TEST FOR END OF ROW JMP LIN12 ISZ T2 ADDRESS OF NEXT ELEMENT ISZ T2 JSB .DLD DEF T2,I JSB .FMPA,I DEF T18 JSB .DST DEF T2,I JMP LINV6 LIN12 LDA T10 STA T5 IN I-MATRIX LDA T3 CMA,INA STA T11 ROW COUNTER LIN13 JSB .DLD DEF T5,I SZA,RSS SKIP MULTIPLICATION IF ZERO SZB JMP *+2 NOT ZERO JMP LIN14 ZERO JSB .FMPA,I DEF T18 JSB .DST DEF T5,I LIN14 ISZ T5 NEXT ELEMENT IN I-MATRIX ISZ T5 ISZ T11 INCREMENT COUNTER JMP LIN13 NO CLA STA B1 LINV4 ISZ B1 LDA B1 CPA T4 TEST FOR LAST ROW JMP LINV1 SELECT NEXT PIVOT CPA LPIV TEST TO SKIP PIVOTAL ROW JMP LINV4 SKIP PIVOTAL ROW LDA B1 CLB,INB JSB LWHR2 ADDRESSOF ROW TO BE TRANSFORMED STA T11 IN I-MATRIX LDA B1 LDB LPIV JSB LWHR STA T9 SAVE ADDRESS JSB .DLD DEF 0,I STA T7 VALUE OF MULTIPLIER STB T8 LDA LPIV STA T13 COUNTER LDA T1 STA T2 LINV5 ISZ T13 LDA T13 CPA T4 TEST FOR LAST TERM IN ROW JMP LIN15 ISZ T9 T9 IS ADDRESS OF ISZ T9 ELEMENT TO BE CHANGED ISZ T2 T2 IS ADDR OF CORRESPONDING ISZ T2 ELEMENT IN PIVOTAL ROW LDA T7 LDB T8 JSB .FMPA,I DEF T2,I STA T18 MULTIPLIER*VALUE IN STB T19 PIVOT ROW JSB .DLD DEF T9,I JSB .FSBA,I DEF T18 JSB .DST TRANSFORMED ELEMENT DEF T9,I JMP LINV5 SELECT NEXT TERM LIN15 LDA T10 ADDRESS OF STA T5 PIVOTAL ROW LDA T3 CMA,INA STA T13 COUNTER LIN18 LDA T5,I ISZ T5 LDB T5,I ISZ T5 SZA,RSS SKIP IF ZERO SZB JMP *+2 NOT ZERO JMP LIN17 ZERO JSB .FMPA,I MULTIPLY BY DEF T7 MULTIPLIER STA T18 STB T19 JSB .DLD DEF T11,I JSB .FSBA,I DEF T18 JSB .DST DEF T11,I LIN17 ISZ T11 ISZ T11 ISZ T13 JMP LIN18 SELECT NEXT TERM JMP LINV4 ELIMINATE NEXT ROW SKP * *** SUBROUTINE LWHR * LWHR NOP STB T7 ADA M1 JSB MPY DEF T3 ADA T7 ADA M1 ALS ADA B2 JMP LWHR,I LWHR2 NOP STB T7 ADA M1 JSB MPY ADDR=LWHR3+2((A-1)*T3+B-1) DEF T3 ADA T7 ADA M1 ALS ADA B3 JMP LWHR2,I * *** CONSTANTS * T1 BSS 1 TEMPORARY CONSTANTS T2 BSS 1 T3 BSS 1 T4 BSS 1 T5 BSS 1 T6 BSS 1 T7 BSS 1 T8 BSS 1 T9 BSS 1 T10 BSS 1 T11 BSS 1 T12 BSS 1 T13 BSS 1 T16 DEC +1E-6 ABSOLUTE TOLERANCE T18 BSS 1 T19 BSS 1 LPIV BSS 1 LPLUS JSB .FADA,I GENERATES CODE DEF B2,I LMIN JSB .FSBA,I GENERATES CODE LTIME JSB .FMPA,I GENERATES CODE INCB2 ISZ B2 GENERATES CODE ** *** FETCH MAT STATEMENT SUBSCRIPT ** ** MATSB NOP LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP MATSB,I NO ISZ MATSB YES, SET RETURN ADDRESS LDA B2200 STA SBPTR,I BRACKET JSB FSC&,I CCB JSB SYMCK COMMA? DEF COMMA-1 RSS NO JSB FSC&,I LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET JMP FSCA&,I LDA LF STA SBPTR,I BRACKET ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACCST,I YES JMP MATSB,I FSCA& DEF FSCE2 FSC& DEF FSC FINIS EQU * END