ASMB,R HED <> 92065-16001 NAM BASC3,7 92065-16001 REV.2001 791022 * * * DATE 2-09-77 * * SOURCE: 92065-18004 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ENT BASC3 ENT GETNM,CHRCK EXT LIMEM,MNTBL,BRTBL,INDCK EXT EXEC,OUTER,SSYMT,TRAP,BCKSP,GETCR,DIGCK EXT RDYPT,BASC4 COM TEMPS(30),PNTRS(61),SPEC(10) ********************************************** * * * SEGMENT #3: PRE-EXECUTION PROCESSING * * * ********************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * ONCE TO PERFORM BASIC SYTEM INITIALIZATION AND ALSO * WHENEVER THE 'RUN' COMMAND IS GIVEN. IT WILL CONSTRUCT THE * SYMBOL TABLE, CHECK FOR-NEXT LOOPS AND DETERMINE ARRAY STORAGE * ALLOCATIONS FOR THE USER PROGRAM. UPON COMPLETION, IT RETURNS * TO THE MAIN CONTROL PROGRAM WHICH THENS LOADS THE EXECUTION * SEGMENT AND BRANCHES TO IT. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVE-RESTORE FLAG FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 15 TEMPORARIES * ERBS DEF ERR-1 MBUF DEF TEMPS MNADD DEF MNTBL BTADD DEF BRTBL * SUP PRESS MULTIPLE LISTINGS SPC 1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .27 DEC 27 .28 DEC 28 .30 DEC 30 .32 DEC 32 .33 DEC 33 .34 DEC 34 .37 DEC 37 .63 DEC 63 .9999 DEC 9999 CALOP OCT 50000 DATOP OCT 51000 B400 OCT 400 B757 OCT 757 B1000 OCT 1000 B777 OCT 777 D72 OCT -72 HIMSK OCT 177400 SLASH OCT 57 STDIM OCT 5001 STANDARD DIMENSIONS FOR ARRAYS STRDM OCT 400 STANDARD DIMENSIONS FOR STRINGS COMOP OCT 34000 COMMON OPERATOR FILOP OCT 63000 OPMSK OCT 77000 DEFOP OCT 35000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M16 DEC -16 M40 DEC -40 M99 DEC -99 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER * SKP **************************** * * * PRE-EXECUTION PROCESSING * * * **************************** TEMPX NOP BASC3 NOP * ***************************************************** * * ** BASIC SYSTEM INITIALIZATION - ONCE ONLY CODE ** * * ***************************************************** * LDA PFLAG IS THIS AN CPA .9999 AN INITIALIZATION? RSS YES! JMP PREEX NO, DO PRE-EXECUTION * SPC 1 * DEFINE COMPILER BUFFERS AND USER AREA SPC 1 JSB LIMEM .FETCH MEMORY LIMITS DEF *+4 DEF .1 DEF FWAM .SET FIRST WORD AVAIL MEMORY DEF TEMPX .USE LAST WORD AVAIL TEMP FOR #WORDS LDB TEMPX .CALCULATE ADDRESS OF LAST WORD ADB FWAM ADB M40 ADB M2 .OFFSET BY TWO FOR LINE CHECK > 80 CHAR STB .INBF SET INPUT BUFFER ADDRESS ADB M40 SET OUTPUT STB .OTBF BUFFER ADDRESS ADB M1 SET SYMBOL TABLE STB SYMTA ADDRESS ADB M99 SET SYNTAX STB SBUFA BUFFER ADDRESS ADB M1 SET LAST WORD STB LWBM BASIC AVAILABLE MEMORY CLB INITIALIZE STB TYPE STB SLSTM STB FLFIL * LDA MNADD JSB INDCK .SET FIRST WORD OF MNEMONIC TABLE STA FWAMM * LDA BTADD JSB INDCK .SET FIRST WORD OF BRANCH TABLE INA STA FWAMB * * * 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 TO STA .LNUM ZERO INITIALLY CCA INITIALIZE STA FLTYP TYPE 0 FILE LDA SLASH INITIALIZE CHAR STA DLMTR EDIT DELIMTER SPC 1 * SET LOGICAL UNIT NUMBERS SPC 1 CLA,INA SET UP STA REC# RECORD NUMBER LDA TTYPR SZA,RSS L.U. # ENTERED? CLA,INA NO, SET TO #1 IOR B400 SET ECHO BIT STA TTYPR STA ERTTY .SET ERROR TO TTY LU LDA PRINT LIST OUTPUT SZA,RSS L.U. # ENTERED? LDA TTYPR NO, SET TO CONSOLE L.U.# STA PRINT LDA READR AUXILLARY INPUT SZA,RSS L.U. # ENTERED? LDA .5 NO, SET TO #5 IOR B400 YES, ADD CONTROL BIT STA READR LDA PUNCH AUXILLARY OUTPUT SZA,RSS L.U. # ENTERED? LDA .4 NO, SET TO #4 STA PUNCH JMP RDYPT START UP BASIC SPC 1 * SKP * * PREEX EQU * PRE-EXECUTION PROCESSING FOR SPEC SYNTAX BAS3 LDA PBUFF NULL CPA PBPTR PROGRAM? JMP RDYPT YES STA MPTR INITIALIZE PROÿÿGRAM POINTER LDA M16 ADA M1 STA TEMP4 CLA INITIALIZE COMMON STA COML SIZE TO ZERO * LDB PBUFF START OF PROGRAM MLO10 CPB PBPTR ALL COMMON JMP MLO14 STMTS CHECKED? ADB .2 NO LDA 1,I GET NEXT STMT TYPE INB AND OPMSK CPA COMOP COMMON STMT? RSS YES! JMP MLO11 NO! LDA 1,I FETCH COMMON SIZE ADA COML AND UPDATE STA COML COMMON COUNTER MLO11 ADB M2 STATEMENT SIZE ADB 1,I CALCULATE ADDRESS ADB M1 OF NEXT STATEMENT JMP MLO10 SPC 1 MLO14 LDB PBUFF GET START OF PROG CPB PBPTR END OF PROG? JMP MLO15 YES ADB .2 NO, GET LDA 1,I THE STATEMENT AND OPMSK OP CODE ADB M1 SET ADB 1,I (B) TO ADB M1 NEXT STATEMENT JMP MLO14+1 SPC 1 MLO15 STB FCORE SET FOR-TABLE POINTER LDA COML ANY COMMON INA JSB CKOVF IS BLOCK TOO BIG? CMA,INA ALLOCATE COMMON ADA LWBM STA SYMTA SYM TBL END = COM START -1 STA SYMTF SYM TBL START(EMPTY) INA STA COML START OF COMMON SPC 1 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 ARS STATEMENT AND SAVE ALF,ALF THE STATEMENT TYPE AND .63 STA TYP CPA .30 NO, REM STATEMENT? STB MPTR YES, SET TO SKIP IT CPA .28 COMMON? ISZ MPTR YES, SKIP CPA .28 OVER ISZ MPTR SIZE CPA .43 NO, PRINT STATEMENT? STB MPTR YES, SET TO SKIP IT CCA NO, SET STA MWDNO 'FIRST VARIABLE' JMP MLOP2+1 FLAG * MLO13 AND B777 YES, ISOLATE OPERAND LDB MPTR CPA B757 IS THIS A USER DEFINED FUNCTION? JMP *+4 YES, SO INCREMENT PAST CALL#-PARAMETER COUNT * INDEX THE PROGRAM POINTER BY SZA,RSS AN AMOUNT APPROPRIATE TO THE ADB .2 OPERAND. THE FOLLOWING APPLIES CPA .3 OPERAND = 0 ADD 2 TO POINTER INB OPERAND =3 ADD 1 TO POINTER STB MPTR * SKP * PROCESS OPERAND SPC 1 MLOP2 ISZ MPTR INCREMENT WORD-OF-STATEMENT PTR LDA MPTR STATEMENT CPA MNPTR EXHAUSTED? JMP MLOP5 YES LDA MPTR,I NO AND OPMSK 'QUOTE' CPA B1000 OPERATOR? JMP MLP4A YES, SET TO SKIP CPA CALOP CALL OPERATOR? JMP MLOP2 YES! SKIP LDA MPTR,I NO SSA 'CONSTANT' OPERAND? JMP MLO13 YES AND B777 NO SZA,RSS NULL OPERAND? JMP MLOP2 YES STA MBOX1 NO, SAVE IT AND .15 PROGRAMMER-DEFINED CPA .15 FUNCTION? JMP MLOP6 YES ADA M4 NO SSA ARRAY VARIABLE? JMP MLOP7 YES SPC 1 * PROCESS SIMPLE VARIABLE SPC 1 LDA MBOX1 NO, SIMPLE VARIABLE JSB SSYMT ALREADY IN SSB,RSS SYMBOL TABLE? JMP MLOP3 YES LDA MNEG NO LDB MNEG+1 ENTER STA MBOX1+1 IT WITH STB MBOX1+2 'UNDEFINED' LDA M3 VALUE JSB ESYMT MLOP3 LDB TYP LDA MBOX1 CPB .34 NEXT STATEMENT? JMP MLOP4 YES SPC 1 * PROCESS 'FOR' STATEMENT SPC 1 CPB .33 NO, FOR STATEMENT? ISZ MWDNO YES, FIRST VARIABLE? JMP MLOP2 NO ISZ FCORE DEMAND LDB FCORE SPACE CPB SYMTF FOR NEW JMP MER8-1 ENTRY STA FCORE,I SAVE VARIABLE NAME JMP MLOP2 SPC 1 * PROCESS 'NEXT' STATEMENT SPC 1 MLOP4 LDB FCORE FOR-TABLE CPB PBPTR EMPTY? JSB ERROR YES MER3 CPA FCORE,I NO, MATCH LATEST ENTRY? RSS YES JMP MER3-1 NO ADB M1 REMOVE STB FCORE MATCHED JMP MLOP2 ENTRY SPC 1 SPC 1 * PROCESS 'END' STATEMENT SPC 1 MLP4A XOR MPTR,I SET POINTER TO ADA .3 CLOSING ARS QUOTES ADA MPTR STA MPTR JMP MLOP2+1 SPC 1 MLOP5 CPA PBPTR PROGRAM EXHAUSTED? RSS YES JMP MLOP1 NO LDA TYP YES CPA .37 END STATEMENT? JMP M1LOP YES JSB ERROR NO SPC 1 * PROCESS 'DEF' STATEMENT SPC 1 MLOP6 LDA MPTR,I ISOLATE AND OPMSK PRECEDING OPERATOR CPA DEFOP 'DEF' ? RSS YES JMP MLOP2 NO GO TO PROCESS NEXT WORD LDA MBOX1 SEARCH SYMBOL TABLE FOR JSB SSYMT THE FUNCTION 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 SPC 1 * PROCESS ARRAY VARIABLE SPC 1 MLOP7 CPA M4 IF STRING VARIABLE INA FORCE TO SINGLE DIMENSION STA 1 (B)=ARRAY TYPE LDA TYP CPA .27 DIM STATEMENT? JMP MLOP8 YES CPA .28 NO, COM STATEMENT? JMP MLOP8 YES JSB MSYMT NO, LOOK FOR IT IN SYMBOL TABLE JMP MLOP2 FOUND CLA NOT THERE STA MBOX1+1 ENTER IT WITH STA MBOX1+2 DIMENSIONS AND STA MBOX1+3 DIMENSIONALITY JMP MLOP0 UNDEFINED SPC 1 * PROCESS 'COM' AND 'DIM' STATEMENT SPC 1 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT ISZ MPTR LDA MPTR,I PICK UP FIRST DIMENSION ALF,ALF SHIFT TO M. S. PART OF WORD CPB M3 IS THIS A SINGLE DIMENSION ARRAY JMP *+5 YES, JUMP ISZ MPTR NO, INDEX POINTER TO THE LOC. ISZ MPTR OF SECOND DIMENSION AND PACK IOR MPTR,I INTO A WITH THE FIRST DIMENSION 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 SPC 1 JSB MSYMT IN SYMBOL TABLE? JMP MLOP9 NO LDA TYP YES CPA .28 RSS IS STMT A COM JMP MLOP0 NO, JUMP LDA MBOX1+2 YES PICK UP PACKED DIMENSIONS JSB MDIM COMPUTE STORAGE REQUIRED SWP LDA MBOX1 IS IT A AND .15 STRING SZA,RSS VARIABLE? JMP STRM1 YES! LDA COML POINTER TO NEXT FREE LOC IN COM STRM2 STA MBOX1+1 STORE IN STORAGE ALLOCATION SLOT ADA 1 UPDATE POINTER BY THE AMOUNT OF STA COML STORAGE ASSIGNED. MLOP0 LDA M4 ENTER THE FOUR WORD ENTRY JSB ESYMT PREVIOUSLY SET UP IN MBOX1 INTO JMP MLOP2 SYMBOL TABLE AND CONTINUE SKP * STRM1 BRS SET UP INB POINTER BRS FOR STRINGS LDA COML,I SET UP AND B377 STA COML,I STRING HEADER LDA MBOX1+2 AND M256 IOR COML,I STA COML,I LDA COML INCREMENT INA TO FIRST WORD OF STRING DATA JMP STRM2 MLOP9 ADB .2 CHECK THE FORMAL DIMENSIONS LDA 1,I LOCATION TO SEE IF THE DIMENSION SZA IS ALREADY DEFINED JSB ERROR ERROR, DOUBLY DIMENSIONED MER5 LDA TYP CPA .28 COM STMT? JSB ERROR ERROR MISPLACED COM STMT MER5A 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 SPC 1 * CHECK FOR UNMATCHED 'FOR' STATEMENTS SPC 1 M1LOP LDA FCORE ALL FORS CPA PBPTR MATCHED? RSS YES JSB ERROR NO MER6 LDB SYMTF SPC 1 * CHECK ARRAY VARIABLE DIMENSIONS SPC 1 M2LOP CPB SYMTA MORE SYMBOLS? RSS NO, EXECUTE PROGRAM! JMP M7LOP YES LDA FCORE LDB FCORE ADA .20 ALLOCATE LIST SPACE STA FCORE CLA MCLOP STA 1,I AND CLEAR ALL SLOTS INB CPB FCORE RSS JMP MCLOP LDA .1 SET UP TRAP JSB TRAP TABLE (B)=-1 IF TABLE IS IN USE NOP JSB BASC4 GOTO SEGMENT #4 * M7LOP LDA 1,I YES AND .15 ACCOUNT FOR ADB .2 A FUNCTION CPA .15 IS IT? JMP M2LOP YES INB SZA,RSS STRING SYMBOL? JMP M5LOP YES! ADA M4 SIMPLE VARIABLE SSA,INA,RSS IS IT? JMP M2LOP YES SZA,RSS NO, # OF SUBSCRIPTS KNOWN? JSB ERROR NO * SKP MER10 INA SAVE STA MBOX1+1 FLAG STB MBOX1 SAVE POINTER LDA 1,I DEFINED SZA ARRAY? JMP M3LOP YES LDA STDIM NO, LOAD ISZ MBOX1+1 APPROPRIATE ADA .9 STANDARD DIMENSIONS STA 1,I RECORD AS ADB M1 FORMAL AND ACTUAL STA 1,I DIMENSIONS SPC 1 * ALLOCATE ARRAY STORAGE SPC 1 M3LOP JSB MDIM SAVE STORAGE STA MBOX1+1 REQUIREMENT LDB MBOX1 LOAD ADB M2 ADDRESS OF LDA 1,I ELEMENT SPACE SZA DEFINED IN COM? JMP M4LOP YES LDA FCORE NO, USE CURRENT STA 1,I FREE-CORE ADDRESS ADA MBOX1+1 UPDATE FREE-CORE STA FCORE ADDRESS CMA,INA OUT ADA SYMTF OF SSA SPACE? JSB ERROR YES MER7 LDB MBOX1+1 DIMENSIONS TO CMB,INB 'UNDEFINED' ADB FCORE M6LOP LDA MNEG STA 1,I INB LDA MNEG+1 STA 1,I INB CPB FCORE DONE? RSS JMP M6LOP NO! M4LOP LDB MBOX1 ADVANCE POINTER INB TO NEXT SYMBOL JMP M2LOP SPC 1 * SET UP STRING SYMBOLS SPC 1 M5LOP LDA 1,I DEFINED? AND M256 SZA,RSS DEFINED? LDA STRDM NO, LOAD STANDARD DIMENSIONS STA 1,I ADB M1 STA 1,I STA MBOX1 SAVE DIMENSION ADB M1 LDA 1,I DEFINED IN COMMON? SZA JMP M8LOP YES! LDA FCORE NO, SET UP STA 1,I ADDRESS OF STRING IN SYMBOL TBL LDA MBOX1 SET UP DIMENSIONS STA FCORE,I IN STRING HEADER ISZ 1,I BUMP ADDRESS TO ACTUAL STRING DATA ALF,ALF COMPUTE INA THE NUMBER ARS OF WORDS IN INA STRING ADA FCORE STA FCORE CMA,INA ADA SYMTF MORE CORE? SSA JMP MER7-1 NO! M8LOP ADB .3 JMP M2LOP CHECK NEXT SYMBOL SKP * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * THE A REG=NEXT CHAR * CALLING SEQUENCE * JSB GETNM * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER * GETNM NOP JSB GETCR GET NEXT CHAR LDA .10 CPA .10 EOF? JMP GETNM,I YES, RETURN CLB,CLE CLEAR E AND B REG STB TEMP1 CLEAR OUT SUM WORD STB TEMP2 CLEAR OUT DIGIT RECIEVED WORD CPA .43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA .45 IS IT A "-" CCB,CCE SET B=-1, SET E =READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ,RSS READ ANOTHER CHAR? JMP *+3 NO! GTNMA JSB GETCR YES LDA .10 EOF! JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA TEMP1 GET PARTICAL SUM IN A REG STB TEMP1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY .10 MULTIPLY PARTICAL SUM BY 10 ADA TEMP1 AND IN NEXT DIGIT STA TEMP1 SAVE NEW SUM ISZ TEMP2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB TEMP2 DID WE GET ANY DIGITS? SZB,RSS JMP GETNM,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB TEMP1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ GETNM GET DIGIT RETURN JMP GETNM,I RETURN * .10 DEC 10 .15 DEC 15 .20 DEC 20 .45 DEC 45 .43 DEC 43 .9 DEC 9 B377 OCT 377 B54 OCT 54 B72 OCT 72 M256 DEC -256 SPC 2 SKP * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * IS EITHER AN END OF LINE ".10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN * NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA .10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA B72 IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN SKP * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS BYTE * B REG CONTAINS BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA TEMP7 SAVE IN TEMP LOCATION CLE,ERB CHANGE FROM BYTE TO WORD ADD LDA 1,I GET WORD SEZ,RSS RIGHT OR LEFT HALF ALF,ALF LEFT AND HIMSK MASK ALL BUT UPPER 8 BITS IOR TEMP7 OR IN NEW BYTE SEZ,RSS LEFT OR RIGHT ALF,ALF LEFT STA 1,I STORE WORD BACK ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 2 ************************* * * * ENTER SYMBOL IN TABLE * * * ************************* 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 FOR TABLE DO NOT OVERLAP 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 ********************************* * * * SEARCH SYMBOL TABLE FOR ARRAY * * * ********************************* MSYMT NOP B GIVES ARRAY TYPE -3 = 1 DIM, STB MBIN1 -2 = 2DIM, -1 = UNDIMENSIONED LDA MBOX1 LOAD IDENTIFIER JSB SSYMT SEARCH SYMBOL TABLE 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 AND .15 SZA,RSS STRING? JMP MSYM YES, DONT CHECK FURTHER LDA MBOX1 ADA .2 NOT APPEAR IN THE TABLE WITH ADA M1 DIFFERENT DIMENSIONS. CHANGE JSB SSYMT TYPE 2 TO 1 & TYPE 1 TO 2 AND SSB,RSS SEARCH AGAIN JSB ERROR FOUND, INCONSISTENT DIMENSIONS MSYM ISZ MSYMT NOT FOUND, INCREMENT RETURN JMP MSYMT,I ADDRESS AND RETURN * ************************************* * * * COMPUTE STORAGE REQUIRED BY ARRAY * * * ************************************* MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND B377 STA TEMP8 STORE # OF COLUMNS LDA 1 ALF,ALF AND B377 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY TEMP8 COMPUTE 2*ROWS:COLUMNS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN SKP ****************************** * * CHECK FOR COMMON BLOCK OVERFLOW * ****************************** * CKOVF NOP STA TEMP5 .SAVE BLOCK SIZE ADA PBPTR .WILL WE ADA .256 . DESTROY CMA,INA . THE PROGRAM ADA LWBM . IF WE CONTINUE SSA . JMP MER7-1 .YES ERROR LDA TEMP5 JMP CKOVF,I .NO - EXIT * .256 DEC 256 SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .34 ADJUST FOR SEG 1 ERRORS STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE *************** * * * ERROR TABLE * * * *************** ERR DEF MER5A COM STATEMENT OUT OF ORDER DEF MER4 FUNCTION DEFINED TWICE DEF MER6 UNMATCHED FOR DEF MER3 NEXT WITHOUT MATCHING FOR DEF MSYM DIMENSIONS NOT COMPATIBLE DEF MLOP6 LAST STATEMENT NOT 'END' DEF MER5 VARIABLE DIMENSIONED TWICE DEF MER10 ARRAY OF UNKNOWN DIMENSIONS DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE DEF MER8 SYMBOL TABLE OVERFLOW SKP MBOX1 EQU TEMPS MBIN1 EQU TEMPT+1 MBIN2 EQU TEMPT+2 MNPTR EQU TEMPT+3 TYP EQU TEMPT+4 NAME EQU TEMPT+5 SC EQU TEMPT+8 LU EQU TEMPT+9 COML EQU TEMPT+10 MWDNO EQU TEMPT+11 MPTR EQU SBPTR FERR EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 * END