** *** 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) ** *** FIND CALLED SUBROUTINE ** ** FNDSB NOP STB TEMP2 SAVE SUBROUTINE NUMBER LDB ASBTB LOAD (B) WITH SUBROUTINE TABLE FNDS1 CPB SBTBE END OF TABLE? JSB ERROR YES CALER LDA 1,I NO, EXTRACT AND .63 SUBROUTINE NUMBER CPA TEMP2 DESIRED ONE? JMP FNDSB,I YES ADB .2 NO, MOVE TO JMP FNDS1 NEXT TABLE ENTRY SPC 5 * ************************************************ * 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. TEMPORALILY AND MSK0 STA .FLUN STORE # OF COLUMNS LDA 1 ALF,ALF AND MSK0 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT JSB MPY DEF .FLUN COMPUTE 2*ROWS*COLUMNS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN SKP ** *** ROUND A SUBSCRIPT TO AN INTEGER ** ** * * RETURNS INTEGER IN (1,32767) (BIASED BY -1) * OR EXITS TO ERROR. * SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB IFIX 24-BIT INTEGER? JMP E6M1A,I NO SEZ,RSS YES, ROUND AND ADB M1 BIAS BY -1 SZA,RSS 15-BIT SSB POSITIVE INTEGER? JMP E6M1A,I NO JMP SBFIX,I YES ** *** INTEGERIZE FLOATING POINT NUMBER ** ** IFIX NOP STO STA GETCR SAVE (A) JSB .FLUN EXPONENT SSA NON-NEGATIVE? JMP IFIX3 NO ADA M16 YES, EXPONENT SSA <= 15? CLO YES ADA M8 EXPONENT SSA,RSS <= 23? JMP IFIX,I NO, ALL SIGNIFICANCE IS INTEGER ADA M8 MOVE BINARY POINT TO END OF (B) STA .FLUN SAVE SHIFT COUNT LDA GETCR RETRIEVE (A) JMP IFIX2 IFIX1 CLE,SLA,ARS SHIFT (A) RIGHT CME SHIFT (B) SLB,ERB RIGHT STO NOTE IF A 1 IS LOST IFIX2 ISZ .FLUN DONE? JMP IFIX1 NO ISZ IFIX YES JMP IFIX,I IFIX3 LDA GETCR RETRIEVE (A) CLE,SSA TRUNCATE CCA,RSS TO CLA,RSS -1 CCB,RSS OR CLB 0 JMP IFIX2+2 SKP ** *** TAKE ARITHMETIC INVERSE ** ** ARINV NOP NUMBER IN (A) AND (B) STA OUTLN SWAP LDA 1 LDB OUTLN REGISTERS 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 OUTLN SWAP LDA 1 LDB OUTLN REGISTERS 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 SKP ** *** 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 YES JMP OPCH1 NO LDA 1,I LOW PART 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 OR GREATER? ISZ LETCK YES JMP LETCK,I NO * * ON END-OF-FILE CONDITION RETURN TO P+1 ELSE * RETURN TO P+2 WITH NON-BLANK CHARACTER IN (A) * 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 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 FIELD ADB CCNT SZB FULL? JMP *-5 NO JMP ENOUT,I ** *** SPACE FOR A COMMA ** ** EDELM NOP LDB CCNT NO, LOAD CHARACTER COUNT EDEL1 SZB,RSS ZERO? JMP EDELM,I YES ADB M15 NO, SUBTRACT ZONE WIDTH SSB,RSS NEGATIVE RESULT? JMP EDEL1 NO STB OUTLN YES, SAVE BLANK COUNT LDA .32 FETCH BLANK JSB OUTCR OUTPUT ISZ OUTLN JMP *-3 BLANKS LDB CCNT LINE ADB M76 SSB,RSS FULL? JSB OUTLN YES JMP EDELM,I SKP ** *** OUTPUT A COMPLETED LINE ** ** OUTLN NOP 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 CORRECT ADB CCNT STB MLBX1+1 MARKER CLA RESET COUNT OF STA TYPE CHARACTERS PRINTED JSB PRNIA,I CLEAN UP JMP OUTLN,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 * * 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 MANT1 EQU SYMCK MANT2 EQU MDIM EXPON EQU LETCK DPFLG EQU BCKSP ARYAD EQU OUTCR EOL EQU CONST FINBP EQU * FIRST UNUSED WORD OF BASE PAGE HED BASIC INTEPRETER CONTROL * *************** BASIC INTERPRETER CONTROL ************************* * * THIS PROGRAM INTERPRETS THE SYSTEM COMMANDS AND PROVIDES * I/O CONTROL FOR THE BASIC INTERPRETER. ALL USER * COMMUNICATION IS DONE THRU THIS PROGRAM. USER RESPONSES ARE * CHECKED FOR SYSTEM COMMANDS AND IF A VALID COMMAND IS * DETECTED THIS PROGRAM INITIATES APPROPRIATE ACTION. * ORG 2000B * * DATA LOCAL TO MONITOR * RDYA DEF READY READY ASC 2,READ OCT 54415 LFEED DEF LF QMRKA DEF QMARK STOPA DEF STCMD CMNDA DEF CMNDS * ENTRY CLC 0,C STARTING POINT, TURN OFF ALL I/O STF 0 TURN ON INTERRUPT SYSTEM LDA LWBM LOADED CPA LWAM BY 'BOSS'? JMP FLUSH NO STA LWAM YES, RESET INA POINTER STA SYMTA VALUES * FLUSH LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER STA .LNUM TO 0 INITIALLY * RDYPT LDA TLSTR SET TO STA LISTR COMMAND MODE CLA STA DRQST CLEAR DATA REQUEST FLAG STA TFLAG CLEAR PHOTO READER INPUT FLAG STA TTYFL CLEAR TTY TAPE FLAG JSB WRITE,I DO A RETURN AND LINE FEED. LDA M6 LDB RDYA JSB WRITE,I PRINT *READY* ON TTY * PEXMK LDA TLSTR SHIFT TO STA LISTR COMMAND MODE LDA TFLAG SZA IS TAPE FLAG SET? JMP PTAPE+1 YES, GET RECORD FROM PHOTO RDR SKP DATAI LDB LFEED LOAD ADDRESS OF LINE FEED STB RSYM STORE ADDRESS OF READY SYMBOL LDA TTYFL TTY TAPE SZA INPUT? JMP GTRCD YES, SUPPRESS LINE FEED CCA NO LDB RSYM LOAD LF OR '?' ADDRESS JSB WRITE,I PRINT LF OR '?', NO CR-LF * GTRCD JSB IMOFF,I TURN OFF KEYBOARD INTERRUPT MODE 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=-1-# CHARS AND CHECK FOR JSB ERROR RECORD TOO LONG RTLE STA CCNT -1-# CHARACTERS < 0,SET CCNT LDA .BUFA LOAD BUFFER ADDRESS CLE,ELA SHIFT LEFT,LEAST BIT USED AS STA BADDR ODD/EVEN FLAG JSB GETCR FETCH FIRST CHARACTER JMP DATAI NULL RECORD, INPUT AGAIN LDB DRQST SZB,RSS DATA REQUEST? JMP CKRCD NO DATA REQUEST,GO CHECK RECORD CPA S ASCII S FIRST CHARACTER? JSB STOP ASSUME STOP REQUESTED CLA LINE JSB WRITE,I FEED JSB BCKSP BACKSPACE LDA RMODE RETURN TO STA LISTR RUN MODE LDB DRQST CLA STA DRQST CLEAR DATA REQUEST FLAG JSB IMON,I DATA REQUEST,TURN ON INTRPT MODE JMP 1,I GO TO DATA REQUEST CALLING POINT * ASC 1,\ DEF *-1 RBOUT LDB *-1 OUTPUT 'X' WITH CLA,INA CARRIAGE RETURN JSB WRITE,I AND LINE FEED JMP GTRCD * * THIS SECTION REQUESTS DATA INPUT * DRQST NOP EXIT/ENTRY AND FLAG LDB TLSTR SHIFT TO STB LISTR COMMAND MODE LDB QMRKA JMP DATAI+1 PRINT '?' AND WAIT SKP * * THIS SECTION CHECKS RECORD FOR SYSTEM COMMANDS. * CKRCD LDB SBUFA STB SBPTR INITIALIZE SYNTAX BUFFER POINTER STA SBPTR,I PUT FIRST CHAR IN SYNTAX BUFFER JSB LETCK IS CHARACTER A LETTER JMP SYNTX NO, TRY SYNTAX * LDA TBLAD LOAD SYS CMND TABLE START POINT LDB M8 LOOK FOR A JSB TSRCH,I SYSTEM COMMAND JSB ERROR NOT A VALID COMMAND * INVSC EQU * INVALID CMND ERROR REFERENCE * ALF,ALF ENTRY FOUND ARS MOVE JMP ADDR TO LEAST BITS POS. ADA CMNDA ADD START ADDR. OF CMND ROUTINES STA STOP SAVE (A) CLA OUTPUT JSB WRITE,I A CR-LF JMP STOP,I EXECUTE COMMAND SKP * * THIS SETS UP AND EXECUTES THE SYSTEM COMMANDS * CMNDS EQU * COMMAND LIST REFERENCE * RUN JSB IMON,I TURN ON TTY INTERRUPT MODE JMP RUNA,I GO TO RUN ENTRY POINT * SCRTH JMP FLUSH SCRATCH CURRENT PROGRAM * TLIST LDA TLSTR LIST PROGRAM, TFLAG = 0 CLB,RSS * PLIST LDA PLSTR PUNCH PROGRAM, TFLAG # 0 STA LISTR SET DRIVER ADDRESS STB TFLAG SET DEVICE FLAG JSB IMON,I TURN ON TTY INTERRUPT MODE JMP LISTA,I GO TO LIST ENTRY POINT * PTAPE JSB IMON,I PTAPE COMMAND LDA .72 LDB .BUFA JSB PREAD,I GET RECORD FROM PHOTO READER CPA M2 END OF TAPE? JMP EOTR YES,GO SEE IF START OR END CPA M3 PHOTO READER READY? JSB ERROR NO PRERR SZA,RSS YES JMP PTAPE+1 NULL RECORD STA TFLAG SET FLAG # 0 JMP RPRCS GO PROCESS RECORD * EOTR LDB TFLAG SZB,RSS START OR END OF TAPE? JMP PTAPE+1 START JMP RDYPT GO TO READY POINT * * STOP COMMAND SERVICE * STOP NOP JSB IMOFF,I TURN OFF KEYBOARD INTERRUPT MODE LDB TLSTR SHIFT TO STB LISTR COMMAND MODE LDA MNEG INA,SZA JMP *-1 DELAY FOR 100 MILLISECONDS JSB WRITE,I CARRIAGE-RETURN LINE-FEED LDA .4 LDB STOPA JSB WRITE,I PRINT *STOP* JMP RDYPT SKP * ** SET LINE FEED SUPPRESSION * TAPE STA TTYFL SET TO 'TAPE' MODE JMP GTRCD * ** RETURN TO 'BOSS' EXECUTIVE * BYEC CLA JMP 77B