CALCS * /--- FILE TYPE = E * /--- BLOCK EXT 00 000 76/11/25 03.28 IDENT CALCS TITLE CALC / BRANCH / DOTO * * GET COMMON SYMBOL TABLE * CST * * EXT GETLINE,ECSPRTY,CALC= EXT COMCONT,CALCNAM EXT BRANNAM,DOTONAM EXT CONTCOM,COMPARG,NOTLITS EXT PAD,LONGI,SHORT * * -CALCACT- IS USED AS A FLAG TO TELL * WHETHER A -CALC- IS ACTIVE. -NXTLINE- * (IN CONDEN) LOOKS AT -CALCACT- AND * TERMINATES THE CALC IF THE NEXT * COMMAND IS NOT A CALC-TYPE COMMAND * (I.E. -BRANCH-, -DOTO-, -IF-, ETC...). * 'THE STANDARD CONDENSE ERROR ROUTINES * ALWAYS CLEAR -CALCACT-. 'THUS, BE * VERY CAREFUL ABOUT USING THE -RJERR- * ROUTINES, AS YOU MAY NEED TO RESTORE * -CALCACT-. * /--- BLOCK CALC 00 000 76/12/22 12.42 TITLE -CALC- COMMAND READIN * -CALCS- ENTRY FOR -CALC- COMMAND * ENTRY CALCS CALCS RJ INITCAL DO INITIALIZATIONS SA1 TAGCNT ZR X1,OKCONT JUMP IF BLANK LINE * CHECK IF MIGHT HAVE -BRANCH- OR -DOTO- SA1 TAG CHECK FOR *BRANCH* SX0 X1-1RB DOES IT START WITH A B ZR X0,CKBRDT SX0 X1-1RD CHECK IF STARTS WITH A D ZR X0,CKBRDT * COMPILE CODE AND CHECK FOR ASSIGNMENT CALC CALCGO RJ CALCINS SA1 LASTKEY SHOULD BE END OF LINE ZR X1,OKCONT GO CHECK FOR CONTINUED CALC EQ CALCE1 ***TEMP NAME ONLY*** * FINISH CHECK FOR -BRANCH- AND -DOTO- CKBRDT SB1 1 SB2 5 SET TO LOOK AT FIRST 5 CHARS MX0 0 CKBRDT1 LX0 6 BX0 X0+X1 MERGE IN NEW CHARACTER SA1 A1+B1 LOAD NEXT CHAR SB2 B2-B1 NZ B2,CKBRDT1 LOOP UNTIL ALL CHARS IN SA2 =5RDOTO CHECK FOR -DOTO- BX2 X2-X0 NZ X2,CKBRDT2 SX6 A1 MOVE WORDPT PAST *DOTO* SA6 WORDPT EQ DOTO CKBRDT2 LX0 6 BX0 X0+X1 MERGE 6TH CHAR SA2 =6RBRANCH BX2 X2-X0 CHECK FOR BRANCH NZ X2,CALCGO JUMP IF REGULAR CALC LINE SX6 A1+B1 MOVE WORDPT PAST *BRANCH* SA6 WORDPT EQ BRANCH * * CHECK FOR CONTINUED (BLANK) -CALC- OKCONT SA2 NEXTCOM PICK UP COMMAND NAME NOCONT EQU OKCONT FOR NOW, JUST USE OKCONT SA3 COMCONT CHECK AGAINST CONTINUATION COMMAND (BLANKS) BX3 X3-X2 ZR X3,CALCONTB JUMP IF CONTINUED CALC SA1 IBRAN ZR X1,=XNXTLINE EXIT IF NO BRANCH -Q- SA4 CALCNAM CHECK AGAINST -CALC- COMMAND BX4 X4-X2 ZR X4,NXTLINE JUMP IF -CALC- COMMAND MX0 6 CHECK FOR STATEMENT LABEL BX7 X0*X2 LX7 6 SX3 X7-1R0 CHECK FIRST CHAR GT OR EQ TO 0 NG X3,CALCONTA JUMP IF NOT SX3 X7-1R9-1 CHECK ALSO LT EQ TO 9 NG X3,NXTLINE IF SO, GO PROCESS THE LABEL CALCONTA RJ ENDCALC TERMINATE THE CALC EQ =XNXTLINE GO PROCESS NEXT COMMAND CALCONTB RJ GETLINE GET NEXT LINE EQ CALCS * /--- BLOCK CALCINS 00 000 76/08/30 15.03 * * SUBROUTINE TO COMPILE NEXT CALC CALCINS EQ * COMPILE CODE AND CHECK FOR ASSIGNMENT CALC MX7 0 SA7 COMPALL RE-INITIALIZE COMPILE VARIABLES SX7 1 SA7 RSULTX1 SA7 CMOVFLG RJ CONTCOM COMPILE, RETURN X1 AND B1 INFORMATION ZR B1,CALCE2 ERROR IF CAN STORE INTO EXPRESSION BX2 X1 AX2 XCODEAL GET GETVAR TYPE MX0 57 BX2 -X0*X2 THROW AWAY I/F BIT SX2 X2-4 SHOULD BE CALC TYPE NZ X2,CALCE3 ***TEMP NAME ONLY*** EQ CALCINS * /--- BLOCK BRANCH 00 000 76/08/30 21.34 TITLE -BRANCH- COMMAND READIN * -BRANI- ENTRY FOR -BRANCH- COMMAND * ENTRY BRANI BRANI RJ INITCAL DO INITIALIZATIONS SA1 TAGCNT ZR X1,NOTAG ERROR IF BLANK TAG * -BRANCH- IN CALC TAG ENTERS HERE BRANCH SX6 -1 SA6 XBRAN MARK NO -BRANCH X- ENCOUNTERED SA1 COMACNT CHECK FOR UNCONDITIONAL BRANCH ZR X1,UBRANCH * * TIME TEST IS DONE AFTER COMPUTING BRANCH ADDRESS * RJ BRANCMP PROCESS CONDITIONAL PART * *GETLINE COUNTS ALL COMMAS, INCLUDING SHIFTED COMMAS *(QUOTE MARKS), AND COMMAS INSIDE MULTI-ARG FUNCTIONS. *SO WE MUST CORRECT THE COMMA COUNT. SA1 LASTKEY ZR X1,BDBRNCH CONDITIONAL BRANCH MUST HAVE LABELS SB1 1 (COMACNT WRONG IF FUNCTIONS CONTAIN COMMAS) SX7 1 COUNT INITIAL COMMA SX0 1R, X0 CONTAINS TEST CHAR SA1 WORDPT PREPARE TO COUNT COMMAS SA1 X1-1 COUNTC SA1 A1+B1 PICK UP CHAR ZR X1,CNTDONE JUMP IF END OF LINE IX1 X1-X0 CHECK FOR COMMA NZ X1,COUNTC JUMP IF NOT COMMA SX7 X7+B1 COUNT THE COMMA EQ COUNTC CNTDONE SA7 COMACNT CORRECT COMMA COUNT * SX1 X7-2 UPPER BOUND IS COMMA COUNT MINUS 2 * /--- BLOCK BRANCH2 00 000 78/12/13 01.46 NG X1,UBRANCH UNCONDITIONAL IF ONLY ONE LABEL SX7 710B TRANSMIT UPPER BOUND IN X0 LX7 21 BX7 X1+X7 RJ LONGI SX1 1 COMPILE RETURN JUMP TO *CONDITIONAL BRANCH* LX1 24 SA2 LLBRAN ADDRESS OF -BRANFNC- BX7 X1+X2 RJ LONGI PUT IN INSTRUCTION STREAM RJ PAD BE SURE AT WORD BOUNDRY FOR FOLLOWING JUMPS * NAMELY, NINST MUST HAVE CORRECT COUNT * SA2 TAGCNT CHECK FOR LAST BRANCH BEING A FALL THROUGH SA1 X2+TAG-1 LOAD LAST CHAR OF LINE SX3 X1-1R, IF COMMMA, IS FALL THROUGH ZR X3,LASTFALL SX3 X1-1RX IS LAST CHAR AN X NZ X3,BRANCHL NO, LAST CANNOT BE A FALL THROUGH SA1 A1-1 LOAD PRECEEDING CHAR SX3 X1-1R, IF IT IS COMMA, LAST BRANCH IS FALL THROUGH NZ X3,BRANCHL LASTFALL MX7 0 CONVERT LAST COMMA TO END OF LINE SA7 A1 SA2 COMACNT AND REDUCE COMMA COUNT SX7 X2-1 SA7 A2 BRANCHL RJ PAD PAD OUT INSTRUCTION WORD RJ GETSYM GET NEXT STATEMENT NUMBER LX1 B2,X0 LEFT JUSTIFY SYMBOL INTO X1 SX6 X4 SAVE LAST CHARACTER FOUND SA6 SAVLAST ZR X0,BRANCHX ZERO SYMBOL IS FALL THROUGH SX2 X0-1RX SO IS AN *X* ZR X2,BRANCHX * ONE ARGUMENT BRANCH ENTERS HERE BRANCHB MX0 6 BX2 X0*X1 MUST START WITH A NUMBER LX2 6 SX3 X2-1R0 NG X3,BADLABL SX3 X2-1R9-1 PL X3,BADLABL MX0 42 BX1 X0*X1 MASK SYMBOL TO 7 CHARS RJ LABFIND B1 = NUMBER FOR THIS LABEL SA1 NINST LOAD CURRENT INSTRUCTION WORD POINTER SX6 INST AWKWARDNESS OF LOADER IX1 X1-X6 RELATIVE ADDRESS RJ SA5JPB5 GENERATE DEFERRED JUMP TO THIS LABEL * FILL WORD WITH A -JP B3- IN CASE LABEL NOT FOUND BRANJP3 SX7 23B COMPILE A CALC EXIT JUMP... MAY BE LX7 21 RJ LONGI COMPILE SA4 SAVLAST NZ X4,BRANCHL JUMP IF MORE TEXT TO GO RJ PAD SA1 XBRAN CHECK IF THERE WAS A -BRANCH X- NG X1,OKCONT EXIT IF NOT SB1 X1+0 RJ LABDEF DEFINE THE IMAGINARY -X- LABEL + LT B1,* HANG IF DUPLICATE LABEL EQ OKCONT * * /--- BLOCK BRANCH3 00 000 79/12/02 03.53 BRANCHX SA5 XBRAN SB1 X5 IMAGINARY LABEL NUMBER FOR -X- SX1 B0 SET ARGUMENT FOR -LABFIND- PL X5,BRANCHXX JUMP IF ALREADY HAVE LABEL NUMBER RJ LABFIND GENERATE IMAGINARY LABEL NUMBER SX6 B1 SA6 A5 SAVE LABEL NUMBER IN -XBRAN- BRANCHXX SB2 2 TYPE = 2 SB3 30 UPPER INSTRUCTION SX2 0255B JP B5+* (UPPER 12 BITS) SA1 NINST COMPUTE DISPLACEMENT IN -INST- SX6 INST IX1 X1-X6 RJ CLABREF PROCESS DEFERRED REFERENCE EQ BRANJP3 GO INCREMENT -NINST- * * PROCESS ONE ARGUMENT BRANCH UBRANCH SX7 0100B SET UP A *RJ BREAK* SA1 LLBREAK ADDRESS OF EXECUTION ROUTINE LX7 18 BX7 X1+X7 CALL LONGI CALL PAD FORCE NEXT INSTRUCTION UPPER RJ GETSYM GET STATEMENT NUMBER LX1 X0,B2 LEFT JUSTIFY SYMBOL INTO X1 MX6 0 MARK END-OF-LINE SA6 SAVLAST ZR X0,BDBRNCH ERROR IF ZERO SYMBOL SX2 X0-1RX ZR X2,BDBRNCH ERROR IF -X- EQ BRANCHB * * -BRANCMP- * * 'THIS SUBROUTINE PROCESSES THE CONDITIONAL * PART OF THE -BRANCH-, -IF-, AND -ELSEIF- COMMANDS. * BRANCMP DATA 0 SX7 1 ELSE, SET UP PARAMETERS FOR SPECIAL CALC SA7 COMPALL SET TO *COMPILE* EVEN SIMPLE LITERAL LOAD MX7 0 SA7 RSULTX1 SET TO LEAVE CALC RESULT IN X1 RJ CONTCOM COMPILE CALC PART OF CODITIONAL BRANCH LX1 62-XCODEL SHIFT I/F BIT TO SIGN POS PL X1,BRANCMPA ALREADY INTEGER, OK SX7 10210B BX2 X1 RJ SHORT SX7 21274B AX2 60 RJ SHORT SX1 7130B MAKE A *SX3 .5 SHR 45* SX7 17174B LX1 18 BX7 X7+X1 RJ LONGI SX7 20355B LX3 45 RJ SHORT SX7 13332B BX3 X3-X2 RJ SHORT SX7 30113B FX1 X1+X3 RJ SHORT SX7 26111B UX1 X1,B1 RJ SHORT SX7 22111B LX1 X1,B1 RJ SHORT BRANCMPA SX7 1 SA7 RSULTX1 RESET COMPILE PARAMETERS MX7 0 SA7 COMPALL EQ BRANCMP * /--- BLOCK IF 00 000 77/01/06 01.33 TITLE -IF- COMMAND READIN * -IF- ENTRY FOR -IF- COMMAND * ENTRY IFIN IFIN RJ INITCAL DO INITIALIZATIONS SA1 TAGCNT ZR X1,NOTAG ERROR IF BLANK TAG * PROCESS TAG RJ BRANCMP * SET UP AND STORE -ISTACK- INFO SX1 0 GENERATE IMAGINARY LABEL RJ LABFIND FOR FALSE BRANCH SB5 B1 B5 = LABEL FOR FALSE BRANCH SX1 B0 GENERATE IMAGINARY LABEL RJ LABFIND FOR END BRANCH SX6 10000B TYPE = 1 FOR -IF- COMMAND PX6 X6,B1 PACK UP -TYPE- AND END LABEL LX6 -12 -TYPE- FIELD IS SIX BITS * 'CALLING -CHKIND- USING THE INDENT LEVEL OF * THE CURRENT LINE AS AN ARGUMENT GUARENTEES * THAT THE STACK IS NOT FULL. 'THUS, WE DO NOT * NEED TO CHECK FOR STACK OVERFLOW. (-GETLINE- * DISCARDS LINES WITH TOO MANY INDENTS.) SA1 PISTACK CURRENT LENGTH OF -ISTACK- SX7 X1+1 INCREMENT -PISTACK- SA7 A1 STORE UPDATED VALUE PX6 X6,B5 ADD -FALSE- LABEL SA6 ISTACK+X1 STORE -IF- COMMAND INFO * COMPILE CODE FOR BRANCH X,FALSE (B5 HAS LABEL) * -ELSEIF- COMMAND ENTERS HERE (WITH B5 SET) IFGO RJ JPB3 PUT JPB3 IN INSTRUCTION STREAM SX2 7105B SX0 B5+0* SB2 1 TYPE = 1 (COMMAND PART) SB1 B5 LABEL NUMBER RJ CLABREF X0 WILL HOLD NEW VALUE FOR A5 RJ JPB3 NEXT INSTRUCTION SX2 6115B SB1 B5+0* SB2 2 TYPE = 2 (EXTRA STORAGE PART) SB1 B5 LABEL NUMBER RJ CLABREF B1 WILL HOLD JUMP ADDRESS SA5 LLSYSNT ADDRESS OF -SYSJPNT- (NO TIME CHECK DONE) SX7 0321B PL X1,SYSJPNT LX7 18 BX7 X7+X5 RJ LONGI PRESERVES X5 SX7 0301B ZR X1,SYSJPNT LX7 18 BX7 X7+X5 RJ LONGI EQ NOCONT * /--- BLOCK ELSE 00 000 77/01/06 01.34 TITLE -ELSE- AND -ELSEIF- COMMAND READIN * -ELSE- ENTRY FOR -ELSE- COMMAND * ENTRY ELSEC ELSEC RJ IFCHECK INITIAL PROCESSING SA1 TAGCNT NZ X1,IFERR94 ERROR IF TAG RJ ELSEDO * CHANGE TYPE FIELD FROM 1 TO 2 MX0 -6 BX5 X0*X5 CLEAR OLD *TYPE* SX6 2 NEW TYPE = 2 BX5 X6+X5 PX6 X5,B5 PACK IN NEW -FALSE- LABEL SA6 A5 STORE -ISTACK- INFO EQ NOCONT * * -ELSEIF- ENTRY FOR -ELSEIF- COMMAND * ENTRY ELSEIFC ELSEIFC RJ IFCHECK INITIAL PROCESSING SA1 TAGCNT ZR X1,NOTAG ERROR IF BLANK TAG RJ ELSEDO PX6 X5,B5 PACK IN NEW -FALSE- LABEL SA6 A5 STORE -ISTACK- INFO * PROCESS TAG RJ BRANCMP * -CHKIND- GUARENTEED THAT PISTACK = INDENT+1 SA1 PISTACK CURRENT LENGTH OF -ISTACK- SA1 ISTACK-1+X1 GET TOP STACK ELEMENT UX1,B5 X1 SET B5 FOR -IFGO- EQ IFGO JUMP INTO -IF- PROCESSOR * * THIS SUBROUTINE DOES SPECIAL PROCESSING * FOR THE -ELSE- AND -ELSEIF- COMMANDS. * * B5 IS RETURNED WITH NEXT -FALSE- BRANCH * A5,X5 HOLDS REMAINDER OF ISTACK INFO * ELSEDO DATA 0 * MAKE SURE AN -IF- IS ACTIVE * -CHKIND- GUARENTEED THAT PISTACK = INDENT+1 SA5 PISTACK CURRENT LENGTH OF -ISTACK- SA5 ISTACK-1+X5 GET TOP STACK ELEMENT MX1 -6 BX1 -X1*X5 GET -TYPE- FIELD SX1 X1-1 CHECK FOR TYPE = 1 NZ X1,IFERR91 ERROR IF NO -IF- IS ACTIVE * COMPILE A DIRECT BRANCH TO END-OF-CASE LABEL RJ JPB3 FIND LOC OF NEXT INSTRUCTION SX2 5155B SA5 B5+0* SB2 1 TYPE = 1 (COMMAND PART) UX5,B5 X5 B5 = LABEL FOR FALSE BRANCH LX5 12 UX5,B1 X5 END LABEL NUMBER PX5 X5,B1 PRESERVE IT RJ CLABREF A5 WILL BE UPDATED PROPERLY RJ JPB3 NEXT INSTRUCTION SX2 0255B JP B5+0* SB2 2 TYPE = 2 (EXTRA STORAGE PART) * /--- BLOCK ENDIF 00 000 77/01/06 15.49 UX5,B1 X5 PX5 X5,B1 RJ CLABREF WILL DO DIRECT JUMP INTO X-STOR * DEFINE LABEL FOR FALSE BRANCH OF PREVIOUS -IF- SB1 B5 LABEL NUMBER OF FALSE BRANCH RJ LABDEF SX1 0 GENERATE IMAGINARY LABEL RJ LABFIND FOR NEXT FALSE BRANCH SB5 B1 RETURN IN B5 LX5 -12 EQ ELSEDO TITLE -ENDIF- COMMAND READIN * -ENDIF- ENTRY FOR -ENDIF- COMMAND * ENTRY ENDIFC ENDIFC SA1 TAGCNT NZ X1,IFERR94 ERROR IF TAG RJ IFCHECK INITIAL PROCESSING RJ POPTOP TERMINATE THE -IF- STRUCTURE EQ NOCONT DISALLOW CONTINUED ENDIF'7S * * -IFCHECK- * * 'THIS ROUTINE IS USED BY THE -ELSEIF-, * -ELSE-, AND -ENDIF- COMMANDS. 'IT MAKES * SURE THAT AN -IF- COMMAND IS ACTIVE, AND * CALLS -CHKIND- TO VERIFY THAT THE USER * HAS DECREASED HIS INDENTING EXACTLY ONE * LEVEL. * IFCHECK DATA 0 RJ INITCAL DO INITIALIZATIONS * MAKE SURE AN -IF- STRUCTURE IS ACTIVE SA1 INDENT INDENT LEVEL OF CURRENT COMMAND SA2 PISTACK CURRENT LENGTH OF -ISTACK- IX3 X1-X2 SEE IF -ISTACK- IS FULL ENOUGH PL X3,IFERR91 JUMP IF CAN'7T HAVE -IF- STRUCTURE SA2 ISTACK+X1 STACK ELEMENT FOR THIS LEVEL MX0 -6 BX2 -X0*X2 GET -TYPE- FIELD ZR X2,IFERR91 SX2 X2-3 ALLOW ONLY TYPES 1 AND 2 PL X2,IFERR91 JUMP IF NO -IF- COMMAND SX1 X1+1 CURRENT STACK LEVEL MUST BE ONE MORE RJ CHKIND VERIFY PROPER INDENTING EQ IFCHECK * /--- BLOCK LOOP 00 000 77/01/06 16.27 TITLE -LOOP- COMMAND READIN * -LOOP- ENTRY FOR -LOOP- COMMAND * ENTRY DOUNTOC DOUNTOC BSS 0 SX5 30000B TYPE = 3 FOR LOOP STRUCTURES RJ INITCAL DO INITIALIZATIONS SX1 0 GENERATE IMAGINARY LABEL RJ LABFIND FOR *END* BRANCH PX5 X5,B1 ATTACH *END* LABEL SX1 B0 GENERATE IMAGINARY LABEL RJ LABFIND FOR *LOOP* BRANCH AX5 12 PX6 X5,B1 ATTACH *LOOP* LABEL SA6 LOOPTEMP LOOPTEMP = INFO FOR -STACK- RJ LABDEF DEFINE *LOOP* LABEL + NZ B1,* SYSTEM ERROR PROTECTION SA1 TAGCNT ZR X1,LOOPFIN JUMP IF NO TAG RJ BRANCMP PROCESS TAG SA1 LASTKEY CHECK TERMINATING CHAR NZ X1,=XERRTERM ERROR IF NOT E-O-L SA1 LOOPTEMP STACK INFO LX1 12 UX1,B1 X1 B1 = LABEL FOR *END* BRANCH SA1 PLX1ZRX1 PL X1,*END* ZR X1,*END* RJ LABJUMP COMPILE JUMP TO *END* LABEL * * -LOOPTEMP- HOLDS INFO FOR UPDATING THE STACK * LOOPFIN SA1 LOOPTEMP LOAD STACK INFO SA2 PISTACK CURRENT LENGTH OF -ISTACK- SX6 X2+1 INCREMENT -PISTACK- SA6 A2 BX6 X1 SA6 ISTACK+X2 STORE NEW INFO IN -ISTACK- EQ NOCONT DISALLOW CONTINUED LINES LOOPTEMP BSS 1 * /--- BLOCK EXITLP 00 000 80/05/06 00.08 TITLE -RELOOP-/-OUTLOOP- COMMAND READIN * ENTRY REDOC -RELOOP- REDOC RJ LPCHECK INITIAL PROCESSING SA2 INDENT INDENT LEVEL OF CURRENT COMMAND SA1 ISTACK+X2 X1 = INFO FOR THIS LOOP UX1,B1 X1 B1 = LABEL FOR -LOOP- BRANCH EQ REOUTC * ENTRY EXITDOC -OUTLOOP- EXITDOC RJ LPCHECK SA2 INDENT SA1 ISTACK+X2 LX1 12 UX1,B1 X1 B1 = LABEL FOR -END- BRANCH * * -REOUTC- * COMMON READIN FOR -RELOOP- / -OUTLOOP- * REOUTC SX6 B1 SAVE BRANCH DESTINATION SA6 LPINFO OVER COMPILE SA1 EQ ASSUME NO TAG SA2 TAGCNT SEE IF TAG PRESENT ZR X2,REOUTC2 EMIT BRANCH IF NOT * * COMPILE EXPRESSION * RJ BRANCMP COMPILE CODE FOR TAG * ADD 0 TO X1, IN CASE EXPRESSION = -0 SX7 76000B SX0 B0 RJ SHORT SX7 36110B IX1 X1+X0 RJ SHORT SA1 NGX1 NG X1,-END- * * EMIT BRANCH, USING LABEL IN *LPINFO* * AND BRANCH TYPE IN X1 * REOUTC2 SA2 LPINFO SB1 X2 B1 = LABEL TO BRANCH TO RJ LABJUMP COMPILE JUMP EQ NOCONT * LPINFO BSS 1 SAVED BRANCH DESTINATION * * /--- BLOCK +ENDLP 00 000 81/04/09 23.12 TITLE -ENDDO- COMMAND READIN * -ENDDO- ENTRY FOR -ENDDO- COMMAND * ENTRY ENDDOC ENDDOC SA1 TAGCNT NZ X1,IFERR94 ERROR IF TAG RJ LPCHECK INITIAL PROCESSING SA1 INDENT INDENT LEVEL OF CURRENT COMMAND SX1 X1+1 CURRENT STACK LEVEL MUST BE ONE MORE RJ CHKIND VERIFY PROPER INDENTING SA1 EQ SET FOR UNCONDITIONAL BRANCH EQ ENDUNTC AND FINISH COMMAND * * ENTRY UNTILC * UNTILC RJ LPCHECK INITIAL PROCESSING * SA1 INDENT INDENT LEVEL OF CURRENT COMMAND * SX1 X1+1 CURRENT STACK SHOULD BE 1 MORE * RJ CHKIND VERIFY PROPER INDENTING * RJ BRANCMP COMPILE CODE FOR TAG * SA1 LASTKEY CHECK TERMINATING CHAR * NZ X1,=XERRTERM ERROR IF NOT E-O-L * SA1 PLX1ZRX1 SET BRANCH TYPE * * END-OF-LOOP PROCESSING * ENDUNTC BX6 X1 SA6 LPINFO SAVE END-OF-LOOP BRANCH TYPE RJ POPTOP TERMINATE THE -LOOP- STRUCTURE EQ NOCONT DISALLOW CONTINUED ENDDO'7S * * -LPCHECK- * * 'THIS ROUTINE IS USED BY THE -REDO-, * -EXITDO-, AND -ENDDO- COMMANDS. 'IT MAKES * SURE THAT A -LOOP- STRUCTURE IS ACTIVE * AT THE INDENT LEVEL OF THE CURRENT COMMAND. * LPCHECK DATA 0 RJ INITCAL DO INITIALIZATIONS * MAKE SURE A -LOOP- STRUCTURE IS ACTIVE SA1 INDENT INDENT LEVEL OF CURRENT COMMAND SA2 PISTACK CURRENT LENGTH OF -ISTACK- IX3 X1-X2 SEE IF -ISTACK- IS FULL ENOUGH PL X3,LPERR97 JUMP IF CAN'7T HAVE -LOOP- STRUCTURE SA2 ISTACK+X1 STACK ELEMENT FOR THIS LEVEL MX0 -6 BX2 -X0*X2 GET -TYPE- FIELD SX2 X2-3 ALLOW ONLY TYPE 3 ZR X2,LPCHECK LPERR97 SB1 97 NO -DOUNTO- COMMAND EQ =XERR * /--- BLOCK DOTO 00 000 76/08/30 21.35 TITLE -DOTO- COMMAND READIN * * * DOTO LABEL,INDEX_INITIAL,END,(INCREMENT) * * ENTRY DOTOI ENTRY FOR -DOTO- COMMAND DOTOI RJ INITCAL DO INITIALIZATIONS SA1 TAGCNT ZR X1,NOTAG ERROR IF BLANK TAG * -DOTO- IN CALC TAG ENTERS HERE DOTO CALL TAGSAVE SAVE *TAG* (COMPILE MAY MODIFY) RJ GETSYM LX1 X0,B2 LEFT-JUSTIFY LABEL MX0 -18 BX1 X0*X1 LIMIT SYMBOL TO 7 CHARS MX0 6 BX2 X0*X1 GET TOP CHAR LX2 6 SX3 X2-1R0 MAKE SURE FIRST CHAR IS NUMERIC NG X3,LABLERR ERROR IF LESS THAN ZERO SX3 X2-1R9-1 PL X3,LABLERR ERROR IF GREATER THAN NINE RJ LABFIND LOCATE LABEL NAME SA1 LABADDR+B1 INFO FOR THIS LABEL BX0 X1 AX0 18 CHECK IF LABEL IS DEFINED NZ X0,DTOE78 ERROR IF LABEL ALREADY DEFINED * * COMPILE CODE TO INITIALIZE INDEX (INDEX_INITIAL) * SA1 WORDPT BX6 X1 SAVE *WORDPT* OF INDEX SA6 DOSAVE1 SX6 B1 SA6 DOLABEL SAVE LABEL NUMBER RJ CALCINS COMPILE INDEX_INITIAL SA1 WORDPT BX6 X1 SAVE *WORDPT* OF END-TEST SA6 DOSAVE3 SX7 67303B ADD A SB3 B0-B3 CALL SHORT CALL PAD FINISH UP CURRENT WORD * SA1 NINST RESERVE WORD FOR INITIAL JUMP SB3 DTO30 -UPNINST- WILL RETURN HERE SX7 X1+1 -UPNINST- PRESERVES X7 EQ =XUPNINST INCREMENT -NINST- * /--- BLOCK DOTO 00 000 76/11/25 03.29 DTO30 SA7 DOSAVE2 SAVE ADDRESS FOR LATER SA2 JPB3A PRESET TO SB3 -B3 JP B3 BX6 X2 SA6 X7-1 STORE PRESET VALUE FOR INITIAL JUMP SX1 INST+1 IX7 X7-X1 DISPLACEMENT TO WORD HOLDING INITIAL JUMP SX1 B0 GENERATE IMAGINARY LABEL FOR RJ LABFIND START OF ENDTEST CODING BX1 X7 SX7 B1 RJ SA5JPB5 GENERATE DEFERRED JUMP TO ENDTEST CODING SA5 DOLABEL NUMBER OF -DOTO- LABEL LX5 12 SX1 B0 GENERATE IMAGINARY LABEL RJ LABFIND FOR START OF LOOP SX1 B1 BX5 X5+X1 COMBINE WITH -DOTO- LABEL RJ LABDEF DEFINE LABEL FOR START OF LOOP + LT B1,* HANG IF DUPLICATE LABEL LX5 12 BX7 X5+X7 COMBINE WITH ENDTEST LABEL SA1 INDENT CURRENT INDENT LEVEL LX7 6 BX7 X1+X7 COMBINE LABELS AND INDENT LEVEL LX7 18 MOVE TO TOP OF WORD SA7 A5 SAVE FOR LATER * * COMPILE CODE TO STORE INDEX IN *COMPUSE(0)* * CALL TAGREST SA1 DOSAVE1 RE-SET *WORDPT* TO INDEX BX6 X1 SA6 WORDPT SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR CALL PSCAN FIND END OF INDEX EXPRESSION BX0 X0-X1 NZ X0,=XERRTERM ERROR IF TERMINATOR NOT ASSIGN SX6 1R, SA6 B1 REPLACE ASSIGNMENT WITH COMMA SX6 B1 SA6 DOSAVE4 SAVE ADDRESS OF TERMINATOR CALL GCOMP1 COMPILE INDEX EXPRESSION AX1 XCODEAL+2 SX0 2 SAVE I/F TYPE OF INDEX BX6 X0*X1 SA6 DOVTYPE SX7 10610B CALL SHORT ADD A BX6 X1 SX7 5160B LX7 18 ADD A SA6 COMPUSE SA1 LLCOUSE BX7 X1+X7 ATTACH ADDRESS OF *COMPUSE* CALL LONGI * * COMPILE CODE TO STORE END-TEST IN *COMPUSE(1)* * SA1 DOSAVE3 RE-SET *WORDPT* BX6 X1 SA6 WORDPT CALL GCOMP1 EVALUATE END-TEST EXPRESSION RJ ITFFTI DO ANY I-F OR F-I CONVERSIONS SX7 10610B CALL SHORT ADD A BX6 X1 SX7 5160B LX7 18 ADD A SA6 COMPUSE+1 SA1 LLCOUSE SX1 X1+1 BX7 X1+X7 ATTACH ADDRESS OF *COMPUSE* +1 CALL LONGI * * /--- BLOCK DOTO 00 000 76/07/18 19.15 * * COMPILE CODE TO GET INCREMENT TO X1 * SA1 LASTKEY SEE IF AT END-OF-LINE NZ X1,DTO100 SX7 7110B ASSUMED INCREMENT IS +1.0 LX7 18 SX0 1 ADD A SX1 B0+1 BX7 X0+X7 CALL LONGI EQ DTO110 * DTO100 CALL GCOMP1 EVALUATE INCREMENT EXPRESSION DTO110 RJ ITFFTI * * COMPILE RETURN JUMP TO PROPER -DO- EXECUTOR * SX7 0100B SET UP RJ INSTRUCTION LX7 18 SA1 DOVTYPE GET I/F INDEX FLAG NZ X1,DTO112 SA1 LLDOTOI INTEGER INDEX ROUTINE EQ DTO114 * DTO112 SA1 LLDOTOF FLOATING INDEX ROUTINE * DTO114 BX7 X1+X7 ADD AN RJ DOX CALL LONGI CALL PAD SA1 NINST RESERVE WORD FOR END LOOP JUMP BX6 X1 SAVE ADDRESS OF EXIT JUMP SA6 DOSAVE3 SB3 DTO115 -UPNINST- RETURNS TO DTO115 EQ =XUPNINST INCREMENT -NINST- DTO115 BSS 0 * * COMPILE CODE TO STORE INDEX * SA1 DOSAVE1 RE-SET *WORDPT* TO INDEX BX6 X1 SA6 WORDPT SA1 DOSAVE4 REPLACE ASSIGMENT WITH COMMA SX6 1R, SA6 X1 CALL PCOMP1 COMPILE CODE TO STORE INDEX CALL PAD FILL OUT REST OF WORD * * /--- BLOCK DOTO 00 000 77/12/02 21.05 * * SET UP *DOOFF* TABLE ENTRIES * SA1 NINST RESERVE WORD FOR LOOPING JUMP SX7 X1+0 -UPNINST- PRESERVES X7 SB3 DTO116 -UPNINST- RETURNS TO DTO116 EQ =XUPNINST INCREMENT -NINST- DTO116 SA2 DOSAVE2 BEGINNING ADDRESS OF CODE SA0 X2 SET UP CM ADDRESS IX6 X7-X2 DISPLACEMENT TO LOOPING JUMP SB1 X6+1 SAVE LENGTH OF COMPILED CODE SA1 DOSAVE3 ADDRESS OF END-LOOP JUMP IX1 X1-X2 LX1 18 POSITION RELATIVE JUMP ADDRESS BX6 X1+X6 SA1 IDOOFF SX7 X1+1 INCREMENT -DOTO- STACK SA7 A1 SX7 X7-DOLIM CHECK FOR TABLE OVERFLOW PL X7,OVRERR LX1 1 INDEX INTO *DOOFF* TABLE SA6 X1+DOOFF+1 STORE JUMP ADDRESSES SA3 IDOPNT POINTER IN -DOTO- ECS BUFFER SX7 X3+B1 SX0 X7-CDOLTH CHECK FOR BUFFER FULL PL X0,OVRERR SA7 A3 UPDATE ECS BUFFER POINTER SA2 DOLABEL BX7 X2+X3 COMBINE LABEL/ECS ADDRESS SA7 X1+DOOFF SA1 ADOBUFF ADDRESS OF ECS BUFFER IX0 X1+X3 + WE B1 WRITE COMPILED CODE TO ECS RJ ECSPRTY SX6 A0 BACK UP *NINST* SA6 NINST MX6 0 PRE-CLEAR FIRST WORD SA6 A0 * TIME CHECK NOW DONE IN EXECUTION ROUTINE.... GPK ** ** ADD CALL TO -BREAK- ROUTINE AT BEGIN OF LOOP ** * SX7 0100B * LX7 18 ADD AN RJ BREAK * SA1 LLBREAK * BX7 X1+X7 * CALL LONGI ADD CALL TO -BREAK- * CALL PAD EQ OKCONT * * /--- BLOCK LABEL 00 000 76/12/22 12.44 TITLE CHECK IF COMMAND IS STATEMENT LABEL ENTRY LABELI LABELI SA1 COMMAND GET POSSIBLE STATEMENT LABEL MX0 6 BX7 X0*X1 MUST START WITH A NUMBER LX7 6 SX3 X7-1R CHECK IF FIRST CHAR IS A SPACE ZR X3,BADINDT SX3 X7-1R0 CHECK FIRST CHAR GT OR EQ TO 0 NG X3,BADCMND SX3 X7-1R9-1 CHECK ALSO LT EQ TO 9 PL X3,BADCMND CALL LJUST,(1R ),0 MX0 42 BX3 -X0*X1 MUST BE 7 CHARACTERS OR LESS NZ X3,BADLABL BX5 X1 PRESERVE LABEL NAME RJ INITCAL INITIALIZE THE CALC BX1 X5 RESTORE LABEL NAME TO X1 RJ LABFIND LOCATE NUMBER FOR THIS LABEL SX7 B1 X7 = LABEL NUMBER RJ LABDEF DEFINE THE LABEL LT B1,OKCONT EXIT IF DUPLICATE LABEL * CHECK IF LABEL IS THE END OF A -DOTO- LOOP SA1 IDOOFF SEE IF ANY UNFINISHED -DOTO- ZR X1,CALCS TREAT AS -CALC- IF NONE SB7 B0 MARK NO MATCH FOUND LX7 48 POSITION NUMBER IN TOP 12 BITS MX0 12 LX1 1 SB2 X1-2 PICK UP STARTING INDEX SA1 B2+DOOFF BX1 X0*X1 SEE IF MATCHES LATEST -DOTO- BX1 X1-X7 NZ X1,CHKDOTO2 GO TO SEARCH PREVIOUS LABELS SB7 -1 * * BACK UP THRU -DOTO-(S) SATISFIED BY THIS LABEL * CHKDOTO1 SB2 B2-2 DECREMENT INDEX NG B2,CHKDOTO3 SA1 B2+DOOFF LOAD NEXT -DOTO- LABEL BX1 X0*X1 BX1 X1-X7 SEE IF MATCHES IN-HAND LABEL ZR X1,CHKDOTO1 * * SEARCH THRU PREVIOUS -DOTO- LABELS * NESTING ERROR IF ANY SATISFIED * CHKDOTO2 SB2 B2-2 DECREMENT INDEX NG B2,CHKDOTO3 SA1 B2+DOOFF BX1 X0*X1 BX1 X1-X7 SEE IF MATCHES IN-HAND LABEL NZ X1,CHKDOTO2 EQ NESTERR ERROR IF FIND A MATCH * CHKDOTO3 ZR B7,CALCS EXIT IF NO -DOTO-S MATCHED SA2 TAGCNT COUNT OF CHARS IN TAG NZ X2,DTOE82 LABEL OF DOTO MUST HAVE NO TAG EQ ENDDOTO * /--- BLOCK ENDDOTO 00 000 76/12/22 12.44 TITLE ENDDOTO -- INSERT COMPILED CODE FOR END OF -DOTO- LOOP * * FINISH COMPILING CODE FOR ALL -DOTOS- SATISFIED * X7 HAS LABEL NUMBER IN UPPER 12 BITS * ENDDOTO CALL PAD -PAD- PRESERVES X7 SA1 IDOOFF NUMBER OF -DOTO-S OUTSTANDING NZ X1,ENDDOTOA SX6 0 RE-SET ECS BUFFER POINTER SA6 IDOPNT EQ OKCONT ENDDOTOA BX5 X1 LX5 1 COMPUTE INDEX IN -DOTO- TABLE SA5 X5+DOOFF-2 X5 = FIRST WORD OF DOOFF TABLE MX0 12 BX2 X0*X5 X2 = LABEL NUMBER MX4 6 LX4 -36 BX4 X4*X5 AX4 18 X4 = AMOUNT -DOTO- WAS INDENTED SA3 INDENT AMOUNT LABEL IS INDENTED BX4 X4-X3 CHECK IF SAME INDENTING BX2 X2-X7 SEE IF LABELS MATCH NZ X2,OKCONT DONE IF DIFFERENT LABELS NZ X4,DTOE83 ERROR IF NOT SAME INDENTING SX6 X1-1 SA6 A1 UPDATE -IDOOFF- LX0 -24 BX1 X0*X5 AX1 24 SB1 X1 B1 = LABEL FOR START OF ENDTEST CODING RJ LABDEF + LT B1,* HANG IF DUPLICATE LABEL MX0 12 LX0 -12 BX3 X0*X5 AX3 36 SB1 X3 B1 = START-OF-LOOP LABEL SA3 ADOBUFF SX6 X5 DISPLACEMENT TO CODE IN ADOBUFF IX0 X3+X6 X0 = ECS ADDRESS OF COMPILED CODE SA6 IDOPNT BACK BUFFER POINTER SA5 A5+1 LOAD SECOND WORD OF TABLE ENTRY SB2 X5+1 B2 = LENGTH OF COMPILED CODE SA1 NINST AX5 18 IX5 X5+X1 X5 = POINTS TO END-OF-LOOP JUMP SA0 X1 CM ADDRESS TO BRING CODE TO SX1 X1+B2 X1 = NEW VALUE FOR -NINST- SX3 INST+INSTLNG-1 IX3 X1-X3 PL X3,OVRERR ERROR IF TOO MUCH CODE SX6 X1 SA6 A1 UPDATE -NINST- SX6 B0 SA6 X1 PRE-CLEAR NEXT WORD + RE B2 BRING IN COMPILED CODE RJ ECSPRTY SX0 INST+1 IX1 X1-X0 DISPLACEMENT TO WORD HOLDING LOOPING JUMP IX5 X5-X0 ADJUST END-OF-LOOP JUMP SX5 X5+1 RJ SA5JPB5 GENERATE JUMP TO START OF LOOP * /--- BLOCK ENDDOTO2 00 000 76/08/30 22.41 SX1 0 GENERATE IMAGINARY LABEL RJ LABFIND FOR END OF LOOP SB5 B1 PRESERVE LABEL NUMBER SX1 X5 RJ SA5JPB5 GENERATE DEFERRED JUMP TO END OF LOOP SB1 B5 RJ LABDEF DEFINE END-OF-LOOP LABEL + LT B1,* HANG IF DUPLICATE LABEL EQ ENDDOTO CHECK NEXT -DOTO- * ENTRY DOVTYPE DOVTYPE BSS 1 * JPB3A SB3 -B3 JP B3 SJP VFD 12/5155B,18/0,12/0250B,18/0 * DOLABEL BSS 1 DOSAVE1 BSS 1 DOSAVE2 BSS 1 DOSAVE3 BSS 1 DOSAVE4 BSS 1 * /--- BLOCK ERRORS 00 000 81/07/28 01.05 TITLE ERROR EXITS NOTAG SB1 41 NO TAG EQ =XERR * BADLABL SB1 42 BAD LABEL EQ =XERR * BDBRNCH SB1 43 BAD BRANCH EQ =XERR * BADSYM SB1 44 BAD SYMBOL EQ =XERR * CALCE1 SB1 46 CALCERR1 EQ =XERR * CALCE2 SB1 47 CALCERR2 EQ =XERR * CALCE3 SB1 48 CALCERR3 EQ =XERR * BADCMND SB1 73 BAD COMMAND NAME EQ =XERR * BADINDT SB1 75 ILLEGAL INDENTING EQ =XERR * NESTERR SB1 55 DOTO NESTING ERROR EQ =XERR * LABLERR SB1 56 DOTO STATEMENT LABEL ERROR EQ =XERR * OVRERR SB1 57 DOTO BUFFER OVERFLOW EQ =XERR * DTOE78 SB1 78 LABEL OF -DOTO- ALREADY DEFINED EQ =XERR * DTOE82 SB1 82 LABEL OF DOTO MAY NOT HAVE TAG EQ =XERR * DTOE83 SB1 83 LABEL OF DOTO HAS BAD INDENTING EQ =XERR * IFERR91 SB1 91 NO -IF- COMMAND EQ =XERR * IFERR94 SB1 94 COMMAND MUST HAVE NO TAG EQ =XERR * * SAVLAST BSS 1 XBRAN BSS 1 -1 IF NO BRANCH X YET IBRAN BSS 1 -1 IF -BRANCH Q- ENCOUNTERED IDOOFF BSS 1 IDOPNT BSS 1 * EXT CALCACT,NLABELS MOVED TO COND TDEFER BSS 1 POINTER TO TEMPORARY BUFFER * /--- BLOCK INITCALC 00 000 76/08/30 21.35 TITLE INITCAL -- INITIALIZATIONS FOR FIRST CALC-TYPE COMMAND * THIS ROUTINE PRESERVES ALL 4, 5, AND 7 REGISTERS INITCAL DATA 0 SA1 CALCACT NG X1,INITCAL EXIT IF CALC IS ALREADY ACTIVE MX6 -1 SA6 A1 MARK CALC ACTIVE SX6 LABLIM MAXIMUM NUMBER OF LABELS SA6 TDEFER INIT. POINTER TO DEFERRED TEMPS SX6 0 SA6 IBRAN MARK NO -BRANCH Q- ENCOUNTERED SA6 COMPALL SET NO COMPILE OF SIMPLE REF SA6 INST CLEAR FIRST INSTRUCTION WORD SX6 INST SA6 NINST INITIALIZE INST POINTER SX6 X6+INSTLNG SA6 NINSTLIM LIMIT ON ADVANCE OF NINST SX6 1 SA6 RSULTX1 SET RESULT NOT NEEDED IN X1 SA6 CMOVFLG SET NOT TO MOVE CODE AFTER EACH LINE SA6 NOTLITS FOR ROUTINE -SHORT- SA1 DOBFPNT BX6 X1 SAVE COMPILED CODE POINTER SA6 IDOPNT SA1 NDOOFF BX6 X1 SAVE VALUE OF *NDOOFF* AT ENTRY SA6 IDOOFF EQ INITCAL * /--- BLOCK ENDCALC 00 000 79/08/08 10.45 TITLE ENDCALC -- TERMINATE CALC AND PROCESS TEMPORARY TABLE * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * ENTRY ENDCALC ENDCALC DATA 0 SA1 CALCACT PL X1,ENDCALC EXIT IF NO -CALC- ACTIVE SX6 B0 SA6 A1 MARK -CALC- NOT ACTIVE * COMPILE A JP B3 SX7 23B LX7 21 RJ LONGI RJ PAD * MOVE COMPILED CODE INTO -INFO- BUFFER SA1 ATEMPEC ECS WORK BUFFER POINTER SX3 INST FIRST WORD OF CODE BX0 X1 SA0 X3 SA1 NINST ONE PAST LAST WORD OF CODE IX3 X1-X3 SB1 X3 B1 = LENGTH OF COMPILED CODE SA2 ICX WE B1 RJ =XECSPRTY SX2 X2-1 NEW VALUE FOR -ICX- SA1 INX SA0 INFO+X1 WHERE CODE GOES IN INFO BUFFER IX6 X1+X3 NEW VALUE FOR -INX- IX3 X6-X2 COMPARE PL X3,=XLNGUNIT ERROR EXIT IF UNIT TOO LONG SA6 A1 UPDATE -INX- BX6 X2 SA6 A2 UPDATE -ICX- SX3 CALC= SB7 X1 SET ARGUMENT FOR -TEMPREF- LX1 60-XCODEL BEGINNING OF CALC IN XSTOR BX6 X1+X3 FORM COMPLETE COMMAND WORD SA6 INFO+X2 STORE COMMAND WORD RE B1 RJ =XECSPRTY * PROCESS THE TEMPORARY TABLE RJ TEMPREF * UPDATE -DOTO- POINTERS AND WRITE -DOOFF- TO ECS SA2 IDOOFF CURRENT INDEX IN *DOOFF* TABLE SA3 IDOPNT BX6 X2 SA6 NDOOFF UPDATE *NDOOFF* BX6 X3 SA6 DOBFPNT UPDATE -DOTO- CODE POINTER EQ ENDCALC * /--- BLOCK GETSYM 00 000 77/12/13 16.07 TITLE GETSYM -- GET NEXT LABEL FOR -BRANCH- OR -DOTO- GETSYM EQ * GET NEXT SYMBOL SA4 WORDPT SB2 60 KEEP LEFT JUSTIFY COUNT IN B2 SB1 1 SA4 X4 LOAD FIRST CHAR MX0 0 EQ GETSYM1 * GETSYML LX0 6 BX0 X0+X4 MERGE IN NEW CHAR SB2 B2-6 GETSYL1 SA4 A4+B1 LOAD NEXT CHAR GETSYM1 ZR X4,GETSEOL JUMP IF END OF LINE SX7 X4-1R REMOVE ANY SPACES ZR X7,GETSYL1 SX7 X4-1R9-1 MUST BE A LETTER OR NUM IF PART OF SYMBOL NG X7,GETSYML OK * SX7 X4-1R. PERIOD IS ALSO OK * ZR X7,GETSYML SX7 A4+B1 MOVE WORDPT PAST COMMA SA7 WORDPT SX7 X4-1R, ELSE CHECK FOR COMMA NZ X7,=XERRTERM TOO BAD, FORM ERROR MX7 18 BX7 X7*X0 MASK OFF TOP 3 CHARACTERS NZ X7,=XERRNAME ERROR IF NAME TOO LONG EQ GETSYM GETSEOL SX7 A4 LEAVE WORDPT AT EOL SA7 WORDPT MX7 18 BX7 X7*X0 MASK OFF TOP 3 CHARACTERS NZ X7,=XERRNAME ERROR IF NAME TOO LONG EQ GETSYM * /--- BLOCK ITFFTI 00 000 77/01/06 18.12 TITLE ITFFTI * * * -ITFFTI- * GENERATE INSTRUCTIONS TO CONVERT FROM INTEGER TO * FLOATING OR FROM FLOATING TO INTEGER * * ENTRY ITFFTI ITFFTI EQ * MX0 -1 AX1 XCODEAL+3 POSITION I/F BIT BX1 -X0*X1 SA2 DOVTYPE LOAD I/F BIT OF INDEX BX1 X1+X2 MERGE I/F BITS SB1 X1 JP B1+*+1 JUMP ON COMBINED I/F BITS * + EQ ITFFTI 0 = I TO I + EQ FTI 1 = F TO I + EQ ITF 2 = I TO F + EQ ITFFTI 3 = F TO F * FTI SX7 0100B ADD A RJ XGFTOI LX7 18 SA1 LLFTOI ADDRESS OF F TO I ROUTINE BX7 X1+X7 CALL LONGI CALL PAD FILL OUT REST OF WORD EQ ITFFTI * ITF SX7 27101B ADD A PX1 X1,B0 CALL SHORT SX7 24101B ADD A NX1 X1,B0 CALL SHORT EQ ITFFTI * /--- BLOCK GLOBSYM 00 000 77/05/06 00.12 TITLE PROCESS DEFERRED GLOBAL SYMBOL REFERENCES * * * * -GLOBSYM- * CALLED ON COMPLETION OF UNIT TO SATISFY DEFERRED * REFERENCES TO STATEMENT LABELS * * ENTRY GLOBSYM GLOBSYM EQ * SX6 0 MARK NO MISSING LABELS SA6 GLOBMISS SA1 NDEFERR SEE IF ANY DEFERRED REFERENCES ZR X1,GLOBSYM EXIT IF NONE SB5 X1 B5 = NUMBER OF DEFERRED SYMBOLS * * PROCESS EACH DEFERRED REFERENCE GLOBSYMA SA2 LDEFER-1+B5 LOAD NEXT REFERENCE UX2,B1 X2 B1 = LABEL NUMBER MX0 -24 BX1 -X0*X2 LOWER 24 BITS TO X1 BX2 X0*X2 LX1 -12 X1 = POINTER INTO -INST- BUFFER LX2 -36 X2 = OTHER INFO (DEPENDS ON TYPE) UX1,B2 X1 B2 = TYPE OF TABLE ENTRY UX2,B3 X2 B3 = SHIFT COUNT (FOR MOST TYPES) * CHECK IF LABEL IS DEFINED SA3 LABADDR+B1 AX3 19 SHIFT TEMP+XSTOR NZ X3,GLOBSYMB JUMP IF LABEL DEFINED SX6 -1 MARK MISSING LABELS SA6 GLOBMISS EQ GLOBSYMC GLOBSYMB RJ LABRF PROCESS THE DEFERRED REFERENCE GLOBSYMC SB5 B5-1 END TEST GT B5,GLOBSYMA SA1 GLOBMISS ZR X1,GLOBSYM EXIT IF NO MISSING LABELS * SEARCH LABEL TABLE FOR UNDEFINED LABELS SA1 NLABELS SB7 X1 B7 = NUMBER OF LABELS SB5 B0 GLOBSYMD SB5 B5+1 GT B5,B7,GLOBSYM CALL UERRSET SET EDIT CONNECT GOTO UNIT CMD SA2 LABADDR-1+B5 CHECK NEXT LABEL AX2 19 SHIFT TEMP+XSTOR NZ X2,GLOBSYMD CONTINUE IF LABEL DEFINED * OUTPUT ',MISSING LABEL', MESSAGE SA1 LABELS-1+B5 GET LABEL NAME ZR X1,GLOBSYMD SKIP ANY IMAGINARY LABELS SB2 -1 NO BAD LINE TO SAVE SB1 912 MISSING LABEL MESSAGE RJ =XRJERR2 EQ GLOBSYMD CONTINUE SEARCH * GLOBMISS BSS 1 TEMPORARY * /--- BLOCK +CHKIND 00 000 80/05/06 01.20 TITLE CHKIND -- CHECK IF INDENTING IS CORRECT * -CHKIND- * * 'THIS ROUTINE VERIFIES THAT THE USER * IS INDENTING HIS CODE PROPERLY. 'CHANGING * THE STACK WHEN IMPROPER INDENTING IS * DETECTED MAKES IT SO THAT ERRORS LIKE * ',MISSING ENDIF COMMAND', DO NOT PROPAGATE * THEMSELVES OVER MANY LINES OF CODE. * * 'ON 'ENTRY -- X1 HOLDS HOW MANY ELEMENTS * THE STACK SHOULD HAVE IN IT * IF THE USER HAS INDENTED THE * CURRENT LINE CORRECTLY. * * 'ON 'EXIT -- 'THE STACK IS CHANGED TO HOLD * WHAT IS SHOULD HOLD. 'APPROPRIATE * ERROR MESSAGES ARE OUTPUT. * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * ENTRY CHKIND CHKIND DATA 0 SA2 PISTACK CURRENT LENGTH OF -ISTACK- IX7 X1-X2 COMPARE WITH DESIRED VALUE SX6 B0 ZR X7,CHKIND IMMEDIATE EXIT IF THE SAME + NG X1,* SYSTEM ERROR PROTECTION SX3 X1-ISTACKL-1 CAN'7T BE MORE THAN -ISTACKL- + PL X3,* SYSTEM ERROR PROTECTION NG X7,CHKINDB JUMP IF -ISTACK- IS TOO FULL * INCREASE -STACK- BY INSERTING ZERO ELEMENTS CHKINDA SA6 ISTACK+X2 CLEAR NEXT -ISTACK- ELEMENT SX2 X2+1 ADVANCE POINTER SX7 X7-1 NZ X7,CHKINDA LOOP UNTIL ALL WORDS ARE ZEROED SX6 X2 SA6 A2 UPDATE -PISTACK- SB1 74 ILLEGAL INDENTING RJ =XRJERR OUTPUT CONDENSE ERROR MESSAGE EQ CHKIND * DECREASE -ISTACK- BY TERMINATING ANY ACTIVE STRUCTURES CHKINDB BX6 X1 SA6 CHKTEMP SAVE ARGUMENT FOR LATER RJ INITCAL MAKE SURE -CALC- IS INITIALIZED CHKINDC SA2 PISTACK SA1 CHKTEMP IX7 X2-X1 ZR X7,CHKIND EXIT IF -ISTACK- LENGTH IS NOW CORRECT SA2 ISTACK-1+X2 LOAD TOP -ISTACK- ELEMENT MX0 -6 BX2 -X0*X2 GET -TYPE- FIELD ZR X2,CHKINDD NO ERROR MESSAGE IF TYPE ZERO SA1 CHKTAB-1+X2 GET ERROR MESSAGE FOR THIS TYPE SB1 X1 RJ =XRJERR OUTPUT CONDENSE ERROR MESSAGE * /--- BLOCK +CHKIND 00 000 81/03/18 20.43 CHKINDD SA1 EQ SET ENDLOOP BRANCH TYPE BX6 X1 SA6 LPINFO RJ POPTOP DECREMENT THE STACK EQ CHKINDC * CHKTEMP BSS 1 * ERROR MESSAGES FOR EACH TYPE (EXCEPT ZERO) CHKTAB DATA 92 MISSING -ENDIF- COMMAND DATA 92 MISSING -ENDIF- COMMAND DATA 96 MISSING -ENDDO- COMMAND ***NOTE***ADD ENTRIES TO THE ABOVE TABLE FOR EACH NEW -TYPE- * /--- BLOCK +POPTOP 00 000 81/03/18 20.45 TITLE POPTOP -- REMOVE TOP STACK ELEMENT * -POPTOP- * * 'THIS ROUTINE REMOVES THE TOP ELEMENT * OF -ISTACK- BY PROPERLY TERMINATING WHATEVER * STRUCTURE WAS ACTIVE. * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * POPTOP DATA 0 SA2 PISTACK CURRENT STACK POINTER SX6 X2-1 DECREMENT BY ONE + NG X6,* SYSTEM ERROR PROTECTION SA1 ISTACK+X6 LOAD TOP ELEMENT OF STACK SA6 A2 UPDATE -PISTACK- SX6 B0 SA6 A1 CLEAR THIS -ISTACK- POSITION MX0 -6 BX0 -X0*X1 LOWER 6 BITS ARE -TYPE- FIELD SB1 X0 SB2 POPTOPK-POPTOPJ LENGTH OF TABLE + GE B1,B2,* SYSTEM ERROR PROTECTION JP POPTOPJ+B1 DO JUMP ON -TYPE- POPTOPJ EQ POPTOP 0 = NOTHING IN STACK EQ POPENDIF 1 = -IF- COMMAND IS ACTIVE EQ POPENDIF 2 = -ELSE- COMMAND ENCOUNTERED EQ POPENDLP 3 = -LOOP- OR -FOR- COMMAND IS ACTIVE ***NOTE*** 'EACH TIME A NEW -TYPE- IS DEFINED, BE SURE TO ***NOTE*** UPDATE THE TABLE -CHKTAB- IN ROUTINE -CHKIND-. POPTOPK BSS 0 MARKER FOR END OF TABLE * * 'TERMINATE THE -IF- STRUCTURE. * X1 HAS STACK INFO. POPENDIF UX7,B7 X1 B7 = LABEL FOR -FALSE- BRANCH RJ INITCAL DO INITIALIZATIONS SB1 B7 RJ LABDEF DEFINE -FALSE- LABEL LX7 12 UX7,B1 X7 B1 = LABEL FOR -END- BRANCH RJ LABDEF DEFINE -END- BRANCH EQ POPTOP * * 'TERMINATE THE -LOOP- STRUCTURE. * X1 HAS STACK INFO. * *LPINFO* HAS END-OF-LOOP BRANCH TYPE POPENDLP UX7,B7 X1 B7 = LABEL FOR -LOOP- BRANCH RJ INITCAL DO INITIALIZATIONS SA7 POPTEMP SAVE LABEL FOR -END- BRANCH SA1 LPINFO X1 = BRANCH TYPE SB1 B7 LABEL NUMBER RJ LABJUMP OUTPUT BRANCH TO START OF LOOP SA2 POPTEMP LX2 12 UX2,B1 X2 B1 = LABEL FOR -END- BRANCH RJ LABDEF DEFINE THE LABEL EQ POPTOP * POPTEMP BSS 1 * * /--- BLOCK LABJUMP 00 000 79/08/08 11.48 TITLE LABJUMP -- COMPILE BRANCH TO SPECIFIED STATEMENT LABEL * -LABJUMP- * * 'THIS ROUTINE COMPILES A BRANCH TO A * SPECIFIED STATEMENT LABEL. 'IT CHECKS * FOR FORWARDS BRANCHES (NO TIME CHECK * NEEDED) AND FOR A LABEL WITHIN THE SAME * CALC (NO RESET OF -A5- NEEDED). 'THE * GENERATED CODE (ALWAYS) SETS B1 TO THE * EXTRA STORAGE PART OF THE LABEL AND * (SOMETIMES) SETS X0 TO THE COMMAND PART * OF THE LABEL. 'IT THEN COMPILES A BRANCH * TO ONE OF THE FOLLOWING CENTRAL MEMORY * LOCATIONS'; * A) -SYSJP-, IF THE BRANCH IS BACKWARDS * AND WITHIN THE SAME CALC. 'DOES A TIME * CHECK BUT DOES NOT RESET A5. * B) -SYSJPA5-, IF THE BRANCH IS BACKWARDS * BUT IN A DIFFERENT CALC. 'DOES A TIME * CHECK AND RESETS A5 (TO X0). * C) -SYSJPNT-, IF THE BRANCH IS FORWARDS. * 'RESETS A5 BUT DOES NO TIME CHECKS. * * 'ON 'ENTRY -- * B1 = LABEL NUMBER * X1 = 6400 INSTRUCTIONS TELLING WHEN * THE BRANCHES ARE TO BE TAKEN. * 'THE LOWER 12 BITS HOLD THE FIRST * INSTRUCTION. 'IF THE SAME BRANCH * IS TO BE TAKEN FOR SEVERAL CONDITIONS, * THE UPPER BITS MAY HOLD ADDITIONAL * INSTRUCTIONS. (LIMIT'; 4 INSTRUCTIONS * IN LOWER 48 BITS) * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * LABJUMP DATA 0 + SA2 CALCACT A -CALC- MUST BE ACTIVE * PL X2,* SYSTEM ERROR PROTECTION PL X2,=XERRORC IF NOT ACTIVE PX6 X1,B1 SAVE ARGUMENTS IN -LJTEMP- SA6 LJTEMP * GENERATE SB1 TO X-STOR PART OF LABEL RJ JPB3 PUT JPB3 IN INSTRUCTION STREAM SX2 6115B SB1 B5+0* SB2 2 TYPE = 2 (EXTRA STORAGE PART) SA3 LJTEMP UX3,B1 X3 LABEL NUMBER SB7 B1 SAVE IN B7 RJ CLABREF B1 WILL HOLD JUMP ADDRESS * CHECK FOR BACKWARDS BRANCH WITHIN THE SAME CALC SA1 LABADDR+B7 LOAD INFO FOR THIS LABEL AX1 18 COMMAND PART OF LABEL SX1 X1-1 *1* MEANS LABEL IS TEMP DEFINED SX7 LLSYSJP TO -SYSJP- IF SAME CALC ZR X1,LABJUMPA JUMP IF LABEL IS IN SAME CALC * /--- BLOCK LABJUMP2 00 000 77/01/09 21.39 * GENERATE SX0 TO COMMAND PART OF LABEL RJ JPB3 NEXT INSTRUCTION SX2 7105B SX0 B5+0* SB2 1 TYPE = 1 (COMMAND PART) SA3 LJTEMP UX3,B1 X3 LABEL NUMBER SB7 B1 SAVE IN B7 RJ CLABREF X0 WILL HOLD NEW VALUE FOR A5 * CHECK FOR FORWARDS BRANCH SA1 LABADDR+B7 LOAD INFO FOR THIS LABEL AX1 18 COMMAND PART OF LABEL SX7 LLSYSNT TO -SYSJPNT- IF FORWARDS BRANCH ZR X1,LABJUMPA JUMP IF LABEL IS NOT DEFINED SX7 LLSYSA5 TO -SYSJPA5- IF BACKWARDS LABJUMPA SA2 X7 GET CM ADDRESS BX6 X2 SA6 LJTEMP2 SAVE IN LJTEMP2 LABJUMPB SA1 LJTEMP MX0 -12 UX6 X1 BX1 -X0*X1 GET NEXT INSTRUCTION LX1 18 POSITION ZR X1,LABJUMP EXIT IF NO MORE INSTRUCTIONS AX6 12 DISCARD CURRENT INSTRUCTION SA6 A1 STORE NEW LJTEMP SA2 LJTEMP2 CM LOCATION BX7 X1+X2 COMBINE WITH OP CODE RJ =XLONGI OUTPUT DESIRED INSTRUCTION EQ LABJUMPB * LJTEMP BSS 1 LJTEMP2 BSS 1 * EQ DATA 0400B EQ * NGX1 DATA 0331B NG X1,* PLX1ZRX1 DATA 03010321B PL X1,* ZR X1,* * * /--- BLOCK LABFIND 00 000 79/08/08 14.51 TITLE LABFIND -- RETURN INTERNAL NAME FOR LABEL HOLERITH * -LABFIND- * * 'THIS ROUTINE SEARCHES THE LABEL TABLE * FOR SPECIFIED NAME. 'IF NOT FOUND, IT ADDS * THE NAME TO THE END OF THE TABLE. 'A ZERO * NAME MEANS TO CREATE AN IMAGINARY LABEL. * * 'ON ENTRY -- * X1 = LABEL HOLERITH (ZERO IF CREATING IMAGINARY LABEL) * * 'ON EXIT -- * B1 = POSITION OF LABEL IN TABLE (INTERNAL NAME) * * 'THIS ROUTINE PRESERVES ALL 4, 5 AND 7 REGISTERS. * LABFIND DATA 0 SA2 NLABELS NUMBER OF LABELS NOW IN TABLE MX0 42 BX6 X0*X1 GET TOP SEVEN CHARS ONLY ZR X6,LABFINDB JUMP TO CREATE NEW LABEL SB1 X2+0 LABFINDA LE B1,LABFINDB CREATE NEW LABEL IF NOT FOUND SB1 B1-1 SA3 LABELS+B1 LOAD NEXT TABLE ENTRY BX3 X3-X6 CHECK IF SAME NZ X3,LABFINDA CONTINUE SEARCH IF NOT EQ LABFIND EXIT IF NAME FOUND IN TABLE LABFINDB SA3 TDEFER POINTER TO MOST RECENT DEFERRED TEMPORARY IX3 X2-X3 SB1 X2 B1 = POSITION FOR NEXT ENTRY PL X3,LABFULL ERROR IF TABLE IS FULL SA6 LABELS+B1 STORE NEW LABEL NAME MX6 0 ZERO LABEL ADDRESS WORD SA6 LABADDR+B1 STORE ADDRESS SX6 X2+1 SA6 NLABELS UPDATE NLABELS EQ LABFIND * /--- BLOCK LABDEF 00 000 76/08/31 02.14 TITLE LABDEF -- DEFINE LABEL FOR UNIT * -LABDEF- * * 'ON ENTRY, B1 HOLDS THE NUMBER OF * THE LABEL WHICH IS TO BE DEFINED. * 'THIS LABEL BECOMES ASSOCIATED WITH THE * 'N'E'X'T COMMAND THAT IS STORED IN THE UNIT. * (-ICX- IS USED TO DETERMINE THIS.) * * 'IF A CALC IS ACTIVE (AS SHOWN BY -CALCACT-), * -PAD- IS CALLED AND THE LABEL IS ALSO * ASSOCIATED WITH THE NEXT WORD OF -INST- BUFFER. * 'THE *TEMP* BIT IN THE LABEL TABLE IS SET * AND THE ACTUAL LABEL DEFINITION IS DEFERRED * UNTIL THE CALC IS COMPLETED. * * 'IF A CALC IS NOT ACTIVE, THE LABEL IS * NOT ASSOCIATED WITH EXTRA STORAGE AND ITS * DEFINITION IS DONE IMMEDIATELY. * * 'ON ENTRY, -B1-, -CALCACT-, AND -ICX- MUST * BE SET PROPERLY AS DESCRIBED ABOVE. * * 'ON EXIT, B1 = 0 IF NO ERROR * = -1 IF DUPLICATE LABEL * * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS. * LABDEF DATA 0 SA2 CALCACT X2 = CALCACT * CHECK IF LABEL ALREADY DEFINED SA1 LABADDR+B1 LOAD INFO FOR THE LABEL BX0 X1 AX0 1 REMAINING BITS MUST BE ZERO NZ X0,LABDUP JUMP IF DUPLICATE LABEL SA4 ICX POINTER TO LAST COMMAND SX4 X4-INFOLTH ZERO IF NO COMMANDS YET SX4 X4-2 X4 IS MINUS TWO OR LESS PL X2,LABDEFA JUMP IF NO CALC ACTIVE * IF IN CALC, MUST STORE IN TEMPORARY TABLE SB4 B1+0 PRESERVE B1 RJ PAD SAVES ALL 4, 5, AND 7 REGISTERS SA1 NINST POINTER TO NEXT WORD OF -INST- SX2 INST-1 WORD BEFORE FIRST INSTRUCTION IX1 X1-X2 RELATIVE LABEL ADDRESS (+1) BX2 -X4 X2 = COMMAND LABEL IS AT (+1) SB1 B4 B1 = LABEL NUMBER SB3 B0 B3 IS NOT USED SB2 4 TYPE = 4 RJ CLABREF STORE IN TEMPORARY TABLE SX6 1 MARK LABEL AS TEMP. DEFINED LX6 18 POSITION TO TEMP DEFINE BIT SA6 LABADDR+B4 SAVE TEMP DEFINE SB1 0 MARK NO ERROR EQ LABDEF * IF NOT IN CALC, DEFINE LABEL IMMEDIATELY LABDEFA LX4 18 POSITION COMMAND DISPLACEMENT BX6 -X4 SAVE COMMAND DISPLACEMENT SA6 LABADDR+B1 STORE NEW LABEL ADDRESS SB1 0 MARK NO ERROR EQ LABDEF * /--- BLOCK LABDEF2 00 000 79/08/08 14.46 * DUPLICATE LABEL ENCOUNTERED LABDUP BX6 X2 SA6 LABTEMP PRESERVE -CALCACT- SA1 LABELS+B1 GET LABEL NAME SX2 B0 SAVE UNIT NAME SB2 0 SAVE BAD LINE SB1 911 DUPLICATE UNIT MESSAGE RJ =XRJERR2 SA1 LABTEMP RESTORE -CALCACT-, SINCE IT BX6 X1 IS CLEARED BY -RJERR2- SA6 CALCACT SB1 -1 RETURN B1=-1 IF DUPLICATE LABEL EQ LABDEF * /--- BLOCK LABREF 00 000 77/05/06 00.13 TITLE LABRF -- PROCESS LABEL REFERENCE * -LABRF- * * 'THE MAIN PURPOSE OF THIS ROUTINE * IS TO PROCESS REFERENCES TO LABELS. * 'IT ALSO HANDLES LABEL DEFINITIONS WHICH * HAD TO BE DEFERRED BECAUSE THEY OCCURRED * IN A CALC. * * ON ENTRY -- * B1 = LABEL NUMBER * B2 = TYPE OF REFERENCE'; * 1 IF INSTRUCTION AND COMMAND PART OF LABEL * 2 IF INSTRUCTION AND EXTRA STORAGE PART OF LABEL * 3 IF 9 BIT COMMAND PART OF LABEL * 4 IF TEMPORARY LABEL DEFINITION * 5 IF BRANCH X * B3 = SHIFT COUNT FOR POSITIONING NEW INFO * (COUNT OF BITS TO THE RIGHT OF INFO * THAT IS TO BE UPDATED) * X1 = DISPLACEMENT IN INFO BUFFER OF WORD * THAT NEEDS UPDATING * X2 = EXTRA INFO DEPENDING ON TYPE'; * TYPE 1'; UPPER 12 BITS OF INSTRUCTION * 2'; UPPER 12 BITS OF INSTRUCTION * 3'; UNUSED * 4'; COMMAND DISPLACEMENT (B3 IS UNUSED) * * ON EXIT -- * 'IF THE LABEL IS DEFINED THE REFERENCE * IS UPDATED IMMEDIATELY. 'IF THE LABEL IS * NOT DEFINED THE REFERENCE IS SAVED IN A * DEFER BUFFER AND PROCESSED UPON COMPLETION * OF THE UNIT. * * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS. * LABRF DATA 0 + LT B2,* SYSTEM ERROR IF B2 OUT-OF-RANGE SB4 4 + GT B2,B4,* JP *+B2 JUMP ON TYPE EQ LABREF1 DO INDIVIDUALIZED PROCESSING EQ LABREF2 EQ * LABREF3 EQ LABREF4 EQ * LABREF5 * * TYPE = 1 * 30 BIT INSTRUCTION, ADDRESS PORTION * IS SET TO THE COMMAND PART OF LABEL. * * B1 = LABEL NUMBER * B3 = SHIFT COUNT TO POSITION INSTRUCTION * X1 = DISPLACEMENT IN INFO BUFFER OF WORD * THAT NEEDS UPDATING * X2 = UPPER 12 BITS OF INSTRUCTION LABREF1 SA3 LABADDR+B1 GET ENTRY FOR THIS LABEL BX0 X3 AX0 19 DISCARD *TEMP DEFINED* BIT ZR X0,LABREFD JUMP IF LABEL NOT YET DEFINED MX6 -18 AX3 18 GET COMMAND PART OF LABEL (+1) SX3 X3-1 FIRST COMMAND GIVES X0 = 1 BX3 -X3 COMMANDS GO BACKWARDS BX0 -X6*X3 CLEAR TOP BITS LX2 18 SHIFT UPPER BITS OF INSTRUCTION BX2 X2+X0 COMBINE WITH ADDRESS PART MX0 30 MASK FOR 30 BIT INSTRUCTION LX0 30 EQ LABREFS GO TO STORE THE INFO * * /--- BLOCK LABREF2 00 000 79/08/08 12.28 * * TYPE = 2 * 30 BIT INSTRUCTION, ADDRESS PORTION * IS SET TO THE EXTRA STORAGE PART OF LABEL. * * B1 = LABEL NUMBER * B3 = SHIFT COUNT TO POSITION INSTRUCTION * X1 = DISPLACEMENT IN INFO BUFFER OF WORD * THAT NEEDS UPDATING * X2 = UPPER 12 BITS OF INSTRUCTION * * 'FOR NOW, IT IS ILLEGAL TO USE THIS TYPE * WITH A LABEL WHICH HAS NO EXTRA STORAGE. LABREF2 SA3 LABADDR+B1 GET INFO FOR THIS LABEL BX0 X3 AX0 19 DISCARD *TEMP DEFINED* BIT ZR X0,LABREFD JUMP IF LABEL NOT YET DEFINED MX0 -18 LOWER 9 BITS HOLD X-STOR INFO BX0 -X0*X3 GET EXTRA STORAGE POINTER (+1) + ZR X0,* HANG IF LABEL NOT IN X-STOR SX0 X0-1 LOWEST POSSIBLE VALUE IS ZERO LX2 18 SHIFT UPPER BITS OF INSTRUCTION BX2 X2+X0 COMBINE WITH ADDRESS BITS MX0 30 SET MASK FOR 30 BIT INSTRUCTION LX0 30 EQ LABREFS GO TO STORE THE INFO * * TYPE = 4 * 'LABEL OCCURRED INSIDE A CALC, AND * HENCE WAS ONLY TEMPORARILY DEFINED. 'COME * HERE TO DEFINE IT PERMANENTLY. * * B1 = LABEL NUMBER * B3 = 0 (UNUSED) * X1 = LOCATION OF LABEL IN EXTRA STORAGE (+1) * X2 = LOCATION OF LABEL IN COMMAND STORAGE (+1) LABREF4 LX2 18 POSITION COMMAND LABEL IS AT BX6 X1+X2 ATTACH TO X-STOR DISPLACEMENT SA6 LABADDR+B1 STORE DEFINED LABEL INFO EQ LABRF EXIT * /--- BLOCK LABREF3 00 000 80/03/20 11.35 * * 'COME HERE IF LABEL IS UNDEFINED. * 'THE REFERENCE IS PROCESSED WHEN THE UNIT * IS COMPLETED. LABREFD PX1 X1,B2 PACK REGISTERS INTO ONE WORD PX2 X2,B3 LX1 12 LX2 36 BX6 X1+X2 PX6 X6,B1 SA3 NDEFERR CHECK IF STILL ROOM IN TABLE SX3 X3+1 SX0 X3-DEFRLIM PL X0,LABFULL JUMP IF -DEFERR- IS FULL SA6 LDEFER-1+X3 SAVE TEMP LABEL SX6 X3 SA6 A3 UPDATE TABLE POINTER EQ LABRF * * 'COME HERE TO PROCESS THE LABEL REFERENCE * X0 = MASK * X1 = INFO WORD THAT NEEDS UPDATING * X2 = NEW INFO * B3 = SHIFT COUNT FOR INFO AND MASK LABREFS LX0 X0,B3 POSITION MASK LX2 X2,B3 POSITION NEW INFO SA3 INFO+X1 WORD THAT NEEDS UPDATING BX3 -X0*X3 CLEAR OLD INFO BX6 X2+X3 INSERT NEW INFO SA6 INFO+X1 STORE UPDATED WORD EQ LABRF * LABTEMP BSS 1 * * /--- BLOCK CLABREF 00 000 79/08/08 12.40 TITLE CLABREF -- SAVE LABEL REFERENCE IN TEMPORARY TABLE * -CLABREF- * 'THIS ROUTINE IS CALLED WHEN THE * INSTRUCTION WHICH REFERENCES THE LABEL * IS IN THE -INST- BUFFER. 'THE INFO IS * STORED TEMPORARILY AT THE END OF THE * LABEL TABLE AND PROCESSED WHEN -INST- * IS MOVED INTO EXTRA STORAGE (SEE -TEMPREF-). * * 'ON ENTRY -- * 'ARGUMENTS ARE EXACTLY AS IN -LABREF-, * 'E'X'C'E'P'T -- X1 HOLDS THE DISPLACEMENT INTO * -INST-, NOT -INFO-. * * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS * 'IT ALSO PRESERVES ALL INPUT ARGS. (B1,B2,B3,X1,X2) * CLABREF DATA 0 PX0 X1,B2 BEGIN PACKING REGISTERS PX3 X2,B3 LX3 24 BX0 X0+X3 * CHECK IF STILL ROOM IN LABEL TABLE SA3 TDEFER POINTER TO LAST TEMP ENTRY SA4 NLABELS NUMBER OF LABEL NAMES IX4 X4-X3 PL X4,LABFULL JUMP IF TABLE IS FULL SX6 X3-1 SA6 A3 UPDATE -TDEFER- LX0 12 FINISH PACKING REGISTERS PX6 X0,B1 SA6 LABADDR-1+X3 STORE THE REFERENCE EQ CLABREF * FOR NOW, GIVE ',LONG UNIT', IF TABLE IS FULL LABFULL EQ =XLNGUNIT * * /--- BLOCK TEMPREF 00 000 79/08/08 12.41 TITLE TEMPREF -- PROCESS THE TEMPORARY TABLE * -TEMPREF- * * 'THIS ROUTINE IS CALLED UPON COMPLETION * OF A CALC TO PROCESS THE DEFERRED REFERENCE * ENTRIES THAT ARE SAVED TEMPORARILY AT THE * END OF THE LABEL TABLE. 'THE MAIN REASON * FOR THIS IS BECAUSE CODE IS GENERATED INTO * THE -INST- BUFFER; WE DO NOT KNOW ITS * LOCATION IN EXTRA STORAGE UNTIL THE CALC * IS COMPLETED. * * 'ON ENTRY -- * B7 = DISPLACEMENT TO WHERE THE -INST- * BUFFER WAS PUT IN EXTRA STORAGE. * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * TEMPREF DATA 0 SA1 TDEFER POINTER TO LAST TEMP ENTRY SX6 LABLIM LENGTH OF -LABELS- SA6 A1 RESET -TDEFER- TO -LABLIM- SX7 X1 X7 = POINTER TO NEXT ENTRY TEMPREFL SB1 X7-LABLIM CHECK IF NO MORE TO DO GE B1,TEMPREF SA2 LABADDR+X7 LOAD NEXT ENTRY UX2,B1 X2 B1 = LABEL NUMBER MX0 -24 BX1 -X0*X2 LOWER 24 BITS TO X1 BX2 X0*X2 LX1 -12 X1 = POINTER INTO -INST- BUFFER LX2 -36 X2 = OTHER INFO (DEPENDS ON TYPE) UX1,B2 X1 B2 = TYPE OF TABLE ENTRY UX2,B3 X2 B3 = SHIFT COUNT (FOR MOST TYPES) SX1 X1+B7 UPDATE X1 TO POINT INTO X-STOR RJ LABRF PROCESS ENTRY (SAVES B7 AND X7) SX7 X7+1 EQ TEMPREFL * * /--- BLOCK JP B3 00 000 79/08/08 12.42 TITLE JPB3 -- COMPUTE POSITION OF NEXT INSTRUCTION * -JPB3- * * 'THIS ROUTINE OUTPUTS A -JP B3- INSTRUCTION * AND COMPUTES ITS POSITION IN THE -INST- BUFFER. * * 'ON 'EXIT -- * X1 = INST DISPLACEMENT TO WORD WITH THE -JP B3- * B3 = SHIFT COUNT GIVING BIT POSITION OF -JP B3- * * 'THIS ROUTINE PRESERVES A5,B5, AND X5 * JPB3 DATA 0 SX7 0233B JP B3+0 LX7 18 RJ LONGI * FIGURE OUT WHERE THE INSTRUCTION WAS PUT SA1 NINST SX0 INST SA2 X1 CURRENT INSTRUCTION WORD IX1 X1-X0 DISPLACEMENT TO CURRENT WORD ZR X2,JPB3C JUMP IF EMPTY MX0 30 BX2 X0*X2 CHECK TOP 30 BITS NZ X2,JPB3B JUMP IF ONLY 15 BITS LEFT SB3 30 TOP HALF OF WORD EQ JPB3 JPB3C SX1 X1-1 BACK UP TO PREVIOUS WORD SB3 0 LOWER HALF OF WORD EQ JPB3 JPB3B SB3 15 MIDDLE OF WORD EQ JPB3 * * /--- BLOCK SA5 JP B5 00 000 79/08/08 12.43 TITLE SA5JPB5 -- OLD WAY OF HANDLING DEFERRED REFERENCES * -SA5JPB5- * * 'THIS ROUTINE SETS UP DEFERRED * PROCESSING FOR A ',SA5 B5+(COMMAND * DISPLACEMENT OF LABEL)', AND A * ',JP B5+(X-STOR DISPLACEMENT OF LABEL)', * 'IT IS USED BY ROUTINES WHICH WERE * USING THE OLD DEFERRED REFERENCE STUFF. * * 'ON ENTRY -- * B1 = LABEL NUMBER * X1 = INST DISPLACEMENT TO WORD WHICH * IS TO BRANCH TO THE LABEL IN (B1). * * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS. * SA5JPB5 DATA 0 * CHECK IF LABEL IS DEFINED WITHIN THIS CALC SA3 LABADDR+B1 LOAD INFO FOR THIS LABEL AX3 18 SX3 X3-1 *1* MEANS TEMP DEFINED SB3 30 SET FOR UPPER INSTRUCTION ZR X3,SA5JPA JUMP IF LABEL IS IN THIS CALC * PUT IN A *SA5* DEFERRED REFERENCE SB2 1 TYPE = 1 SX2 5155B SA5 B5+* (UPPER 12 BITS) RJ CLABREF STORE IN TEMP TABLE SB3 0 SET FOR LOWER INSTRUCTION * PUT IN A *JP B5* DEFERRED REFERENCE SA5JPA SB2 2 TYPE = 2 SX2 0255B JP B5+* (UPPER 12 BITS) RJ CLABREF STORE IN TEMP TABLE EQ SA5JPB5 * * /--- BLOCK END 00 000 79/08/08 12.43 * END