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 22255-80010 D