; UPD ID= 3514 on 5/5/81 at 10:32 AM by NIXON TITLE CMNGEN FOR COBOL V12B SUBTTL COMMON ROUTINES USED BY CODE GENERATORS AL BLACKINGTON/CAM ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION SEARCH P SEARCH OPCTAB %%P==:%%P ;EDITS ;NAME DATE COMMENTS ;V12A**************** ;JSM 19-Mar-81 [1123] Bad table link, catastrophe in phase E with ; subscript assoc with linkage item with no occurs clause. ;DMN 31-Dec-80 [1110] Allow ON SIZE ERROR code to catch divide by zero for COMP-1 result. ;DAW 29-Dec-80 [1107] Prevent "Ill mem ref" ;DAW 15-Dec-80 [1103] Bug in literal pooler caused bad code to ; be generated in rare cases. ;DAW 18-Nov-80 [1077] Prevent "ILL MEM REF" in PHASE E ;DAW 14-Nov-80 [1073] Bad code gen when depending item is at a level ; two or more down from the item being looked at ;DMN 1-APR-80 [1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK. ;DMN 30-JAN-80 [762] ADD SMALL CONSTANT TO COMP-2 COMPUTE CALCULATIONS. ; IMPLEMENT AND USE D. P. FLOATING POINT LITERALS. ;DAW 25-OCT-79 [753] MAKE 745 WORK FOR ANS68 TOO ;DAW 15-OCT-79 [745] MULTIPLE SUBSCRIPTS WITH NON-COMP DEPENDING VAR. ; COBOL-74 ONLY ;V12***************** ;DMN 6-OCT-79 [743] COBOL-74 MORE OF EDIT 721 ;DMN 7-SEP-79 [730] FIX MULTIPLY A BY B ON SIZE ERROR FOR QUAD WORD. ;DMN 26-JUL-79 [722] COBOL-74 FIX MOVE HIGH/LOW-VALUES WITH PROGRAM COL. SEQ. ;DMN 24-JUL-79 [721] COBOL-74 FIX SUBSCRIPTED IF WITH PROGRAM COL. SEQ. ;DAW 22-JUN-79 [716] FIX BAD CHECK FOR EBCDIC MODE IN SUBSCRIPTING ;DMN 2-APR-79 [673] FIX QUAD WORD ROUNDING PROBLEM ;DAW 28-MAR-79 [671] FIX PROBLEM WITH LINKAGE SECTION SUBSCRIPTS ;DAW 12-MAR-79 [661] GIVE ERROR MESSAGE AND DISALLOW COMP-1 SUBSCRIPTS ;DAW 12-MAR-79 [660] FIX ERROR MESSAGE POINTS TO WRONG PLACE ;DAW 27-FEB-79 [643] FIX "?SIZTE RETURNED 0" IF PROGRAM ERRORS ;DMN 26-FEB-79 [636] FIX BAD LITERAL GENERATION IF PROGRAM HAS FATAL SUBSCRIPT ERRORS ;DAW 20-FEB-79 [634] FIX SIZE ERROR CHECKING FOR FOUR-WORD RESULTS ;DMN 16-JAN-79 [625] FIX BAD TEST FOR TWO WORD TEMP IN PUTEMP ;DMN 4-JAN-79 [621] MAKE BADALL A GLOBAL FOR MOVGEN ;DMN 11-DEC-78 [610] FIX INCORRECT CODE GENERATED IN ARRAY WHERE TOP LEVEL IS COMP IS REFERENCED VIA CONSTANT SUBSCRIPT ;DAW 7-DEC-78 [606] FIX ?INTERNAL COMPILER ERROR IF 01 ITEM OCCURS USAGE IS NON-DISPLAY ;DMN 31-OCT-78 [577] FIX SET DOWN BY 262144 (I.E. <-1,,0>) ;DMN 6-OCT-78 [570] ADD QUAD-WORD ROUNDING FUNCTION ;EHM 16-SEP-78 [551] FIX CATASTROPHE IN PHASE E ;EHM 14-SEP-78 [543] FIX ACCEPT INTO A DISPLAY-6 ITEM ;V10***************** ;EHM 6-JAN-78 [525] FIX SUBSCRIPT EXPRESSION AND NON COMP ;EHM 7-NOV-77 [522] FIX ROUNDING FOR LARGE DIFFERENCES IN NUMBER OF DECIMAL PLACES. ;DPL 23-JUN-76 [431] ADD PUTAYY AS INTERNAL FOR SORT GIVING ; 6-APR-76 [424] DONT ATTEMPT TO MAKE LITERAL IF NO SIZE ; 17-FEB-76 [406] SET ERROR RETURN FROM SETOPN IF DATA ITEM HAS ERROR BIT (DA.ERR) SET ; 28-JAN-76 [402] ALLOW INDEX REG AND INDIRECT ADDRESSING FOR ARGUMENT TO LIBOL ;JEC 21-JAN-76 [374] FIX CONVERSION FROM ASCII TO SIXBIT LITERALS ;DBT 23-JUN-75 REMOVE LAST OF UUOS - SETUUO: ;ACK 20-APR-75 ADD ABILITY TO MOVE DISPLAY-9 TO/FROM OTHER FLAVORS OF DISPLAY. ;ACK 22-APR-75 SAME AS ABOVE FOR FIGURATIVE CONSTANTS. ;******************** ; EDIT 365 FIX MULTIPLE CALLS TO SETOPN FOR TALLY. ; EDIT 333 ALLOW TALLY AS A SUBSCRIPT TO BE ADDED TO SUBTRACTED FROM ; EDIT 330 MAINTAIN FFATAL ERROR BIT ON ; EDIT 306 JEC FIX SUBSCRIPTING OF COMP ITEMS IN AN ASCII RECORD. ; EDIT 274 RECOVER IF LITERAL SUBCRIPT IS TOO LARGE ; EDIT 262 HANDLE DUMMY SUBSCRIPT CORRECTLY [262] ; EDIT 251 RECOVER IF SUBSCRIPT IS SUBSCRIPTED ; EDIT 250 ALLOW TALLY AS A SUBSCRIPT ; EDIT 173 PUT BACK SOME CODE TAKEN OUT BY LITTAB FIX 167 ; CODE MOVES CURLIT WHICH CONTAINS HEADER WORD LOCATION. ; EDIT 167 FIXES LITTAB OVERFLOW ; EDIT 161 DON'T ASSIGN FATHER'S USAGE TO THE SON IF SON'S IS NOT BINARY TWOSEG RELOC 400000 SALL ENTRY CMNGEN CMNGEN: EXTERNAL XPNLIT,XPNTAG,XPNEOP,FATAL,WARN,KILL,DEVDED,ERATYP EXTERNAL LNKSET,GETTAG,PUTAS1,PUTAS2,PUTAS3,ADJDP.,FNDBRO EXTERNAL MXAC.,MACX.,MXX.,CFPCX.,CC1C2. EXTERN CPOPJ1,CPOPJ ;ROUTINES INCLUDED HERE INTERNAL SZERO.,SQUOT.,ASRJ.,AZRJ.,AQRJ.,AHRJ.,ALRJ.,FPLOV. IFN ANS74,< INTERN SHVAL.,SLVAL. ;[722] INTERN TSTARO,GDEBV,GDEBA,GDEBB,GDEBAB,CDEBA,CDEBB,CDEBAB > INTERNAL M.IA,M.IB,GETEMP,SETEMP,PUTEMP,PUTTAG,SETOPA,SETOPB,SETOPN INTERN STASHI,STASHL,STASHP,STASHQ,MBYTPA,MBYTPB,PVALIT,PVLIT2 INTERNAL VALLIT,VLIT2,CONVNL,CONVFP,CONVF2,SCANL,MBYTEA,MBYTEB,DPDIV. INTERNAL PUTASY,PUTASN,FORCX0,BMPEOP,GENFPL,GENF2L,PUSEOP,PUSH12,PUTAYY ;[431] INTERNAL NEGATL,CREATL,MAKEL,MAKEL2,ROUND,SIZERA,B1PAR,B2PAR INTERNAL SWAPAB,ADJSL.,JOUT,SUBSCR,BYTE.A,BYTE.B,BYTE.C INTERNAL SUBSCA,SUBSCB,SUBSCC,SUBSCD,SUBSCE INTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.LC,PUT.LD INTERNAL PUT.P,PUT.PA,PUT.PC,PUT.XA,PUT.XB,PUT.EX,PUT.16,PUT.SX,PUT.AO,PUT.BO,PUT.PJ INTERNAL SUBSIZ INTERNAL SZDPVA,SZDPVB INTERNAL DEPCKK,DEPTSA,DEPTSB,DPBDEP IFN BIS,< INTERNAL EPSLON ;[762] > ;**************************************************************** ;CONSTANTS INCLUDED HERE INTERNAL BYTE.S,BYTE.W,CHAC,CHOP,W1LN,W1CP,TCLN,TCCP,POWR10,DPWR10 INTERNAL ACMODE,ACSIZE,TESUBC,W2SUBC,TASUBC ;**************************************************************** ;ERROR ROUTINES INCLUDED HERE INTERNAL OPNWRN, OPWRN, OPNFAT, OPFAT INTERNAL BADEOP, NOTNUM, NOTDAT, NOTDEF ;PUT A WORD ONTO THE CURRENT ASYFIL AND BUMP APPROPRIATE PC PUTASY: TLC CH,UUOMSK ;COMPLIMENT SO WE CAN CHECK FOR UUO'S TLCN CH,UUOMSK ;POSSIBLE UUO?? JRST CNVUUO ;YES PUTAYY: TSWT FAS3 ;ARE WE CURRENTLY IN A NON-RESIDENT SEGMENT? AOSA EAS2PC ;NO--BUMP RESIDENT PC AOSA EAS3PC ;YES--BUMP NON-RESIDENT PC JRST PUTAS2 ;WRITE ONTO AS2FIL JRST PUTAS3 ;WRITE ONTO AS3FIL ;PUT ALTERNATE CODE SET MARKER INTO ASYFIL PUTASA::MOVSI CH,ASMACS ;PUT A WORD ONTO THE CURRENT ASYFIL, BUT DON'T BUMP PC PUTASN: TSWFZ FUUOIC ;DO WE HAVE A UUO INCREMENT TO TRAP? JRST CNVUUI ;YES - GO DO IT TSWT FAS3 ;CURRENTLY IN NON-RESIDENT SEGMENT? JRST PUTAS2 ;NO--USE AS2FIL JRST PUTAS3 ;YES--USE AS3FIL ;PUT OUT REFERENCE TO A CONSTANT ;ENTER WITH INST IN CH, AND CONSTANT IN TE ;IF RHS OF CH = AS.CNB ;AND TE .LT. 77777 ;GENERATE SMALL CONSTANT, ELSE GENERATE LARGE CONSTANT PUTASC: CAILE TE,77777 ;IS IT A SMALL CONSTANT? JRST PTASC2 ;NO, SO GIVE UP NOW PUSH PP,CH HRRZ CH,CH ;GET RHS ONLY CAIE CH,AS.CNB+ASINC ;CONSTANT? JRST PTASC1 ;NO POP PP,CH HRR CH,TE ;JUST USE CONST JRST PUTASY ;AND OUTPUT IT PTASC1: POP PP,CH PTASC2: PUSH PP,TE ;SAVE CONST. PUSHJ PP,PUTASY POP PP,CH ;GET BACK CONST. JRST PUTASN ;CALL PUTASY OR PUT.EX IF ADDRESS IS AN EXTERNAL SYMBOL PUTAXY: LDB TE,[POINT 3,CH,20] ;LOOK AT ADDRESS CAIN TE,AC.EXT## ;IS IT AN EXTERNAL SYMBOL? JRST PUT.EX ;YES, CALL "PUT AN EXTERNAL" JRST PUTASY ;NO, CALL REGULAR OUTPUT ROUTINE ;THIS ROUTINE IS CALLED FROM PUTASY AND PUTASN WITH JRST'S ; TO CNVUUO AND CNVUUI RESPECTIVELY ; ;THIS ROUTINE IS CALLED WHEN THERE IS A UUO TO BE CONVERTED TO ; A PUSHJ. WHEN IT RECIEVES A UUO ( IN CH ) FROM PUTASY IT CHECKS ; TO SEE IF THERE IS AN INCREMENT TO FOLLOW AND IF SO IT SETS THE ; SW FLAG FUUOIC AND RETURNS DIRECTLY TO THE PUTASY CALLER. ; FUUOIC WILL THEN CAUSE PUTASN TO JRST TO CNVUUI WITH THE INCREMENT. ; IF THERE IS NO INCREMENT IT WILL GENERATE THE PUSHJ IMMEDIATELY. ; THERE ARE 4 POSSIBLE CASES TO BE HANDLED DEPENDING UPON 1. IF THERE ; IS AN INCREMENT TO FOLLOW AND 2. IF THE UUO ROUTINE NEEDS TO SEE ; THE AC NUMBER IN THE UUO. ; NO INCREMENT - NO AC ; MOVEI 16,UUO.ADRESS.FIELD ; PUSHJ 17,UUO.ROUTINE ; INCREMENT - NO AC ; MOVEI 16,UUO.ADRESS.FIELD ; INCREMENT WORD TO ASY ; PUSHJ 17,UUO.ROUTINE ; NO INCREMENT - AC NEEDED ; MOVE 16,LIT00% ; LIT00% INCREMENT TO ASY ; PUSHJ 17,UUO.ROUTINE ; ... ; LIT00%+N: ; UUO INSTRUCTION ; INCREMENT - AC ; MOVE 16,LIT00% ; LIT00% INCREMENT TO ASY ; PUSHJ 17,UUO.ROUTINE ; ... ; LIT00%+N: ; UUO ; UUO ADDRESS INCREMENT ; NOTE THAT IF SOMEONE GENERATES A UUO WHICH MAKES ; USE OF THE INDEX FIELD AND/OR THE INDIRECT BIT IT WILL BE ; IMPROPERLY HANDLED IN THE LATTER 2 CASES SINCE THE ADDRESS WILL ; NOT BE EVALUATED A'LA A UUO CALL. INTERNAL COMPILER ERRORS ; WILL BE GENERATED FOR THIS CASE AND IF IT OCCURS THE UUO GENERATING ; ROUTINE WILL BE FIXED TO GENERATE THE PUSHJ DIRECTLY ; NOTE ALSO THE RUSSIAN ROUTLETTE WHICH IS BEING PLAYED BY PLACING ; THINGS INTO THE LIT00% TABLE - WE COULD BE SPLITTING A BLOCK WHICH ; THE CALLER IS GENERATING. IT IS HOPED THAT THIS WILL NOT OCCUR. ; IT WOULD BE A STRANGE THING TO DO BUT WHO KNOWS. ; FIRST A FEW SYMBOLIC DEFINITIONS OF FIELDS ENDIT==177 ;END OF ASY FILES CODE ; ASY INSTRUCTION FIELD MASKS IM.CD==600000 ;CODE FIELD OF INSTRUCTION IM.IC==400000 ;INSTRUCTION CODE BIT IM.OP==177000 ;OP CODE CODE FIELD IM.AC==000740 ;AC FIELD IM.ACL==000040 ;LOW ORDER AC BIT IM.IN==000017 ;INDEX FIELD IM.IX==000020 ;INDIRECT BIT IM.ADH==600000 ;HIGH ORDER TWO BITS OF ADDRESS CODE ; ASY INSTRUCTION FIELD BYTE POINTERS IP.OP== ;ASY OPERATOR FIELD IP.AC== ;AC FIELD IP.ACH== ;HIGH 3 AC BITS EXTERNAL UUOSV% ;SAVE UUO TO BE CONVERTED EXTERNAL UUINC% ;SAVE INCREMENT OF UUO TO BE CONVERTED CNVUUO:: ;PUTASY ENTRY POINT ;IS THERE ANY POINT IN LOOKING AT ALL?? SKIPE LITASY## ;IF NOT = 0 THEN JRST PUTAYY ;LITERALS, NOT INSTRUCTIONS ARE BEING ;SHOVED INTO THE ASY FILES ; FIRST DO AN INTERNAL CHECK OF THE INCREMENT FLAG ; IT SHOULD NEVER BE ON AT THIS POINT TSWFZ FUUOIC PUSHJ PP,CNVER ;BAD NEWS ;NOW DO WE HAVE A VALID UUO??? PUSH PP,TE ;SAVE SOME REGS PUSH PP,TD TLNE CH,IM.IC ;IS THIS REALLY AN INSTRUCTION OR ; JUST A REVERSED ASY ASN CALL??? JRST CNVUNO ;BAD CALL - IF A UUO SLIPED THROUGH ; COBOLG WILL LET US KNOW LDB TE,[IP.OP] ;OPERATOR CAIGE TE,FSTUUO ;IS IT IN THE LOWER BOUND? ;THIS IS DONE BECAUSE THE CHECK IN PUTASY ; IS NOT COMPLETELY ACCURATE JRST CNVUNO ;NOT A UUO LDB TD,[IP.AC] ;GET AC FOR LATER CAIE TE,ENDIT ;END OF ASY FILE??? JRST CNVU11 ;ITS A UUO ;MAYBE - CHECK AC FOR 17 CAIN TD,17 JRST CNVUNO ;YES IT IS THE END CNVU11: ;HACK HACK IF ADDRESS TYPE 6 OR 7 SET ASINC TRC CH,IM.ADH TRCN CH,IM.ADH TLO CH,ASINC ;SET IT IF 6 OR 7 MOVEM CH,UUOSV%## ;SAVE UUO AWAY TLNN CH,ASINC ;IS INCREMENT TO FOLLOW?? JRST CNVUU2 ;NO - LETS GET IT OVER WITH NOW ;YES INDEED LETS GO BACK AND WAIT FOR THE PUTASN CALL SWON FUUOIC ;SET FLAG TO GET BACK JRST CNVUED ;BACK TO CALLER OF PUTASY CNVUNO: POP PP,TD ;RESTORE REGS POP PP,TE JRST PUTAYY ;RETURN PAST UUO TEST AND CONTINUE CNVUUI:: ;PUTASN ENTRY POINT PUSH PP,TE PUSH PP,TD MOVEM CH,UUINC%## ;SAVE INCREMENT MOVE CH,UUOSV% ;GET UUO LDB TE,[IP.OP] ;GET OPERATOR LDB TD,[IP.AC] ; AND AC FIELD CNVUU2: PUSH PP,TA ;SAVE TA JUMPE TD,CNVU2A ;USE MOVEI IF AC = 0 REGARDLESS CAIGE TE,UUOWAC+1 ;DOES AC EXTEND OP CODE? ; THE 1 IS ADDED BECAUSE FOR OPEN/CLOSE ;THE AC IS A PARAMETER AND DEFINES OP JRST CNVUU5 ;NO ; YES - SO WE CAN USE THE MOVEI 16,UUO.ADDRESS CNVU2A: TLZ CH,IM.OP!IM.AC ;CLEAR OPERATOR,AC TLO CH,MOVEI.+AC16 ;CHANGE IT TO MOVEI 16, PUSHJ PP,PUTASY ;PUT IT INTO ASY FILE MOVE CH,UUOSV% ;IS THERE AN INCREMENT TO FOLLOW? TLNN CH,ASINC JRST CNVUU6 ;NO INCREMENT MOVE CH,UUINC% ;YES - PUT IT INTO ASY FILE PUSHJ PP,PUTASN JRST CNVUU6 ;GO DO PUSHJ CNVUU5: ;WE NEED A MOVE 16,[UUO] ; FIRST PUT UUO IN LIT TABLE MOVE TA,[XWDLIT,,2] ;PUT OUT XWD PUSHJ PP,STASHP HLRZ TA,UUOSV% ;GET AC FIELD TRZ TA,IM.CD!IM.OP ;CLEAR CODE AND OP FIELDS ;[402] TRNE TA,IM.IX!IM.IN ;ARE INDEX AND INDIRECT BITS 0? ;[402] PUSHJ PP,CNVER ;OH OH COMPILER ERROR PUSHJ PP,STASHQ ;STORE AC AWAY AS A COMMENT MOVE TA,UUOSV% ;GET ADDRESS FIELD TLNN TA,ASINC ;IS THERE AN INCREMENT SETZM UUINC% ;NO INCREMENT HRL TA,UUINC% ;YES- GET IT PUSHJ PP,POOLIT ;NOW THE MOVE 16,[UUO] MOVE CH,[MOV+ASINC+AC16,,AS.MSC] PUSHJ PP,PUTASY SKIPN CH,PLITPC ;GET POOLED LIT SKIPA CH,ELITPC ;NOT POOLED, USE THE INCREMENT TO LIT00% CAIA AOS ELITPC IORI CH,AS.LIT PUSHJ PP,PUTASN HLRZ TA,UUOSV% ; [402] PICK UUO TRNN TA,IM.IX!IM.IN ; [402] IF NO INDEX OR INDIRECT JRST CNVUU6 ; [402] GO GENERATE NOW , THE PUSHJ LDB TE,[POINT 7,UUOSV%,8] ;GET OPERATOR CAIN TE,UUOWAC ;OPEN AND CLOSE ARE SPECIAL JRST CNVUU6 ;NEED THESE BITS FOR VARIOUS FUNCTIONS MOVE CH,[EXP B17++<_<-5>>] ; [402] GENERATE PUSHJ PP,PUTASY ; [402] "HRRI 16,@16" CNVUU6: ;NOW FOR THE PUSHJ ;FIRST GET EXTAB INDEX FROM TABLE MOVE CH,UUOSV% ;GET UUO BACK LDB TE,[IP.OP] ;OPERATOR CAIGE TE,UUOWAC ;NEED AC ?? JRST CNVUU9 ;NO LDB TD,[IP.ACH] ;YES- GET AC CAIG TE,UUOWAC ;IS OPEN/CLOSE SETZI TD, ;YES- CLEAR HIGH 3 BITS TLNE CH,IM.ACL ;RIGHT OR LEFT HALF OF TABLE? SKIPA CH,@UUOTBB-UUOWAC(TE) ;RIGHT HLRZ CH,@UUOTBB-UUOWAC(TE) ;LEFT JRST CNVU10 CNVUU9: ;AC DOES NOT EXTEND OP CODE HRRZ CH,UUOTB6-FSTUUO(TE) ;GET EXTAB INDEX CNVU10: ;PUT OUT PUSHJ TRNN CH,77777 ;FIRST CHECK FOR LEGAL INDEX PUSHJ PP,CNVER ;NO LEGAL PUSHJ PP,GNPSX. ;GO GENERATE THE PUSHJ. POP PP,TA ;RESTORE TA CNVUED: POP PP,TD POP PP,TE POPJ PP, CNVER: OUTSTR [ASCIZ '?Compiler error - UUO conversion '] SWON FFATAL ;SET ERROR FLAG POPJ PP, ; A TABLE OF POINTERS TO DISPATCH TABLES UUOTBB: Z UUO1.(TD) Z UUO2.(TD) Z UUO3.(TD) Z UUO4.(TD) Z UUO5.(TD) DEFINE TABLE2,< UUOTB6.: TABSEP TABSEP TABSEP TABSEP TABSEP > DEFINE TABSEP (Y),< IRP Y,<0>, EXP Y >> UUO1.: XWD C%OPEN##,C%CLOS## UUO2.: XWD DSPLY%##,ACEPT%## XWD READ%##,WRITE%## IFN ANS68,< XWD WADV%##,SEEK%## > IFN ANS74,< XWD WADV%##,RDNXT%## > XWD DELET%##,RERIT%## XWD PURGE%##,INIT%## XWD TERM%##,0 XWD DSPL%6##,DSPL%7## XWD 0,0 UUO3.: XWD COMP%##,CMP%76## XWD 0,NUM%6## XWD ALF%6##,ZERO%6## XWD POS%6##,NEG%6## XWD 0,NUM%7## XWD ALF%7##,ZERO%7## XWD POS%7##,NEG%7## XWD COMP%D##,0 UUO4.: XWD MOVE%##,C%D6D7## XWD C%D7D6##,CMP%E## XWD CMP%G##,CMP%GE## XWD CMP%L##,CMP%LE## XWD CMP%N##,0 REPEAT 3,< XWD 0,0> UUO5.: XWD EDIT%S##,EDIT%U## IFN ANS68,< XWD EXAM%##,SUBSC%## > IFN ANS74,< XWD INSP%##,SUBSC%## > XWD SIZE%1##,SIZE%2## XWD SIZE%3##,E%C3C1## XWD E%C3C3##,OVLAY%## XWD C%EXIT##,ARGS%## XWD PUTF%##,RESF%## XWD GETNM%##,ILLC%## TABLE2 ;ROUTINE TO GENERATE: ; HRRZI 16, ; PUSHJ 17, ;WHERE: ; EXTERNAL = RH(CH) ; ADR = (EACC) IF NON ZERO OR SXR IF (EACC) IS ZERO. PMOPV.:: HRLM CH, (PP) ;SAVE THE EXTERNAL. PUSH PP, [EXP PMOPU7] ;WHERE WE GO NEXT. MOVE CH, [XWD HRRZI.+AC16,SXR] ;ASSUME (EACC)=0. JUMPE EACC, PUTASY ;IF THE PARAMETER IS GOING TO ; BE IN SXR, GO GENERATE THE ; INSTRUCTION AND GO ON. TLO CH, ASINC ;OTHERWISE CHANGE THE ADDRESS HRRI CH, AS.MSC ; SO THAT IT HAS AN INCREMENT. PUSHJ PP, PUTASY ; GENERATE THE INSTRUCTION. HRRZI CH, (EACC) ;GET THE ADDRESS PORTION PJRST PUTASN ;GO WRITE IT OUT AND GO ON. IFN BIS,< ;ROUTINE TO GENERATE: ; HRRZI 16, ; PUSHJ 17, ;WHERE: ; EXTERNAL = RH(CH) PMOPB.:: HRLM CH,(PP) ;SAVE THE EXTERNAL. PUSH PP,[EXP PMOPU7] ;WHERE WE GO NEXT. MOVSI CH,HRRZI.+AC16 JRST PUT.B ;GET ADDRESS ;ROUTINE TO GENERATE: ; HRRZI 16, ; PUSHJ 17, ;WHERE: ; EXTERNAL = RH(CH) ; POWER OF TEN = TC PMOPC.:: PUSHJ PP,CREATL ;GET POWER OF TEN IN LIT POOL MOVE EACC,EPWR10(TC) ;GET ADDRESS OF LITERAL JRST PMOPV. ;GENERATE CALL > ;ROUTINE TO GENERATE: ; MOVE 16, %LIT ; PUSHJ 17, ; . ; . ; . ; %LIT: BYTE (9)0(4)AC(5)0(18)ADR ;WHERE: ; EXTERNAL = RH(CH) ; AC = (EAC) ; ADR = (EACC) IF NON ZERO OR SXR IF (EACC) IS 0. PMOPU.:: SKIPN EAC ;IF THE AC FIELD IS GOING TO BE JRST PMOPV. ; ZERO GO GENERATE HRRZI INSTEAD. HRLM CH, (PP) ;SAVE THE EXTERNAL. MOVE TA, [XWD XWDLIT,2] ;SET UP XWD HEADER. PUSHJ PP, STASHP ;GO WRITE IT OUT. HRRZ TA, EAC ;GET THE AC. LSH TA, 5 ;PUT IT IN THE AC FIELD. PUSHJ PP, STASHQ ;WRITE OUT THE LH OF THE XWD. MOVEI TA, SXR ;ASSUME THE PARAMETER IS IN SXR. JUMPE EACC, PMOPU5 ;IS IT? HRLI TA, (EACC) ;NO, GET IT. HRRI TA, AS.MSC ;IT IS MISCELLANEOUS. PMOPU5: PUSHJ PP, POOLIT ;WRITE OUT THE RH OF THE XWD. MOVE CH, [XWD MOV+AC16,AS.MSC] ;GET THE MOVE INSTR. PUSHJ PP, PUTASY ;WRITE IT OUT. SKIPN CH, PLITPC ;GET PC IF POOLED SKIPA CH, ELITPC ;GET THE LITAB PC. CAIA AOS ELITPC ;BUMP IT OVER THE XWD. IORI CH, AS.LIT ;FORM THE XWD'S ADDRESS. PUSHJ PP, PUTASN ;WRITE IT OUT. PMOPU7: HLRZ CH, (PP) ;GET THE EXTERNAL BACK AND ; FALL INTO THE ROUTINE TO PUT ; OUT "PUSHJ 17,". ;ROUTINE TO GENERATE "PUSHJ 17,". ; ENTER WITH THE EXTAB ADDRESS OF THE EXTERNAL IN RH(CH). GNPSX.:: HRRZI TA, (CH) ;SAVE THE EXTAB LINK. HRLI CH, EPJPP ;FORM THE INSTRUCTION. PUSHJ PP, PUTASY ;GO PUT IT IN THE ASY FILE. ANDI TA, LMASKB## ;GET THE EXTAB OFFSET. ADD TA, EXTLOC ;FORM THE ADDRESS. SETOI TE, ;GET SOME ONES. TSWF FAS3; ;ARE WE IN A NONRESIDENT SEGMENT? DPB TE, EX.NRS## ;YES, SET THE FLAG. POPJ PP, ;RETURN. ;CREATE THE LITERAL SZERO.: SKIPE ESZERO ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN MOVE TB,[SIXBIT "000000"] ;NO PUSHJ PP,SLITX. MOVEM TB,ESZERO ;SET ADDRESS POPJ PP, ;CREATE THE LITERAL SQUOT.: SKIPE ESQUOT ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN MOVE TB,[SIXBIT '""""""'] ;NO PUSHJ PP,SLITX. MOVEM TB,ESQUOT POPJ PP, ;NOTE, DON'T POOL THESE LITERAL, THEY ARE POOLED ALREADY ELITX.: SKIPA TA,[XWD EBCLIT,1] ;PUT ONE EBCDIC LITERAL IN LITAB. SLITX.: MOVE TA,[XWD SIXLIT,1] PUSHJ PP,STASHI MOVE TA,TB PUSHJ PP,STASHL MOVE TB,ELITPC AOS ELITPC IORI TB,AS.LIT POPJ PP, ;[722] CREATE THE LITERAL SIXBIT HIGH-VALUES WITH PROG. COL. SEQ. IFN ANS74,< SHVAL.: SKIPE ESHIVL## ;[722] HAS IT ALREADY BEEN GENERATED? POPJ PP, ;[722] YES--RETURN HRRZ TB,COHVLV## ;[722] NO, GET HIGH-VALUE CHAR. IMULI TB,10101 ;[722] THREE CHARACTERS HRL TB,TB ;[722] SIX CHARACTERS PUSHJ PP,SLITX. ;[722] MOVEM TB,ESHIVL ;[722] SET ADDRESS POPJ PP, ;[722] ;[722] CREATE THE LITERAL SIXBIT LOW-VALUES WITH PROG. COL. SEQ. SLVAL.: SKIPE ESLOVL## ;[722] HAS IT ALREADY BEEN GENERATED? POPJ PP, ;[722] YES--RETURN HRRZ TB,COHVLV+3 ;[722] NO, GET LOW-VALUE CHAR. IMULI TB,10101 ;[722] THREE CHARACTERS HRL TB,TB ;[722] SIX CHARACTERS PUSHJ PP,SLITX. ;[722] MOVEM TB,ESLOVL ;[722]SET ADDRESS POPJ PP, ;[722] > ;CREATE THE LITERAL (EBCDIC '0000') EZERO.:: SKIPE EEZERO## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. MOVE TB, [XWD 360360,360360] ;GET THE LITERAL. PUSHJ PP, ELITX. ;GO PUT IT IN LITAB. MOVEM TB, EEZERO## ;REMEMBER ITS ADDRESS. POPJ PP, ;RETURN. ;CREATE THE LITERAL (EBCDIC HIGH VALUES) EHVLS.:: SKIPE EEHIGH## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. IFN ANS74,< SKIPLE COLSEQ ;[1004] [722] PROGRAM COL. SEQ.? JRST [HRRZ TB,COHVLV+2 ;[722] YES, GET EBCDIC HIGH-VALUE IMUL TB,[1001,,1001] ;[722] 4 CHARS. JRST .+2] ;[722] > MOVE TB, [XWD 377377,377377] ;GET THE LITERAL. PUSHJ PP, ELITX. ;GO PUT IT IN LITAB. MOVEM TB, EEHIGH## ;REMEMBER ITS ADDRESS. POPJ PP, ;RETURN. IFN ANS74,< ;[722] CREATE THE LITERAL (EBCDIC LOW VALUES) ELVLS.:: SKIPE EELOW## ;[722] HAS IT ALREADY BEEN GENERATED? POPJ PP, ;[722] YES, RETURN. HRRZ TB,COHVLV+5 ;[722] GET EBCDIC LOW-VALUE IMUL TB,[1001,,1001] ;[722] 4 CHARS. PUSHJ PP,ELITX. ;[722] GO PUT IT IN LITAB. MOVEM TB,EELOW## ;[722] REMEMBER ITS ADDRESS. POPJ PP, ;[722] RETURN. > ;CREATE THE LITERAL (EBCDIC ' ') ESPAC.:: SKIPE EESPCE## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. MOVE TB, [XWD 100100,100100] ;GET THE LITERAL. PUSHJ PP, ELITX. ;GO PUT IT IN LITAB. MOVEM TB, EESPCE## ;REMEMBER ITS ADDRESS. POPJ PP, ;RETURN. ;CREATE THE LITERAL (EBCDIC '""""') EQUOT.:: SKIPE EEQUOT## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. MOVE TB, [XWD 177177,177177] ;GET THE LITERAL PUSHJ PP, ELITX. ;GO PUT IT IN LITAB. MOVEM TB, EEQUOT## ;REMEMBER ITS ADDRESS. POPJ PP, ;RETURN. ;CREATE THE LITERAL ; OCT 231231231231 ; OCT 231231231231 ; OCT 231231231237 ;(COMP-3 HIGH-VALUES PIC S9(18).) C3HVL.:: SKIPE EACC, C3HIVL## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. PUSH PP, [XWD 231237,C3HIVL##] ;SET UP THE PUSH PP, [XWD 231231,231231] ; PARAMETERS. PJRST PC3LIT ;GO WRITE OUT THE LITERAL. ;CREATE THE LITERAL ; OCT 231231231231 ; OCT 231231231231 ; OCT 231231231233 ;(COMP-3 LOW-VALUES PIC S9(18).) C3LVL.:: SKIPE EACC, C3LOVL## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. PUSH PP, [XWD 231233,C3LOVL##] ;SET UP THE PUSH PP, [XWD 231231,231231] ; PARAMETERS. PJRST PC3LIT ;GO WRITE OUT THE LITERAL. ;CREATE THE LITERAL ; OCT 0 ; OCT 0 ; OCT 17 ;(COMP-3 ZERO PIC S9(18).) C3ZRO.:: SKIPE EACC, C3ZERO## ;HAS IT ALREADY BEEN GENERATED? POPJ PP, ;YES, RETURN. PUSH PP, [XWD 17,C3ZERO##] ;SET UP THE PUSH PP, EACC ; PARAMETERS. ;AND FALL INTO THE SUBROUTINE. ;NOTE, DON'T POOL THESE LITERALS PC3LIT: MOVE TA, [XWD OCTLIT,3] ;SET UP THE HEADER. PUSHJ PP, STASHI ;GO WRITE IT OUT. POP PP, TA ;GET THE FIRST 3 DIGITS. PUSHJ PP, STASHL ;GO WRITE THEM OUT. PUSHJ PP, STASHL ;THE NEXT 8 ARE THE SAME. HLR TA, (PP) ;GET THE LAST 3 AND THE SIGN. ; THE PRECEEDING 4 DON'T CHANGE. PUSHJ PP, STASHL ;GO WRITE THEM OUT. MOVEI EACC, 3 ;GET THE ADDRESS AND EXCH EACC, ELITPC ; BUMP THE PC. ADDM EACC, ELITPC IORI EACC, AS.LIT ;NOTE THAT IT IS IN LITTAB. POP PP, TA ;GET THE LOCATION INTO WHICH ; WE SHOULD PUT THE ADDRESS. MOVEM EACC, (TA) ;REMEMBER WHERE WE PUT THE LIT. POPJ PP, ;RETURN. ;CREATE THE LITERAL , AND THE SAME LITERAL ; SHIFTED RIGHT 1 BIT. AZRJ.: SKIPE EAZRJ ;HAVE THEY ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN MOVE TB,[ASCII "00000"] ;NO PUSHJ PP,AXRJ. MOVEM TB,EAZRJ POPJ PP, ;CREATE THE LITERAL , AND THE SAME LITERAL ; SHIFTED RIGHT 1 BIT. ASRJ.: SKIPE EASRJ ;HAVE THEY ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN MOVE TB,[ASCII " "] ;NO PUSHJ PP,AXRJ. MOVEM TB,EASRJ POPJ PP, ;CREATE THE LITERAL , AND THE SAME LITERAL ; SHIFTED RIGHT 1 BIT. AQRJ.: SKIPE EAQRJ ;HAVE THEY ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN MOVE TB,[ASCII '"""""'] ;NO PUSHJ PP,AXRJ. MOVEM TB,EAQRJ POPJ PP, ;CREATE THE LITERAL ASCII HIGH-VALUES, AND THE SAME LITERAL ; SHIFTED RIGHT 1 BIT. AHRJ.: SKIPE EAHRJ## ;HAVE THEY ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN IFN ANS74,< SKIPLE COLSEQ## ;[1004] [722] PROGRAM COLLATING SEQUENCE JRST [HRRZ TB,COHVLV+1 ;[722] YES, GET ASCII HIGH-VALUE CHAR. IMUL TB,[2010,,40201] ;[722] 5 CHARACTERS LSH TB,1 ;[722] LEFT JUSTIFIED (MUST BE SEPARATE TO AVOID OVERFLOW) JRST .+2] ;[722] > MOVE TB,[BYTE (7) 177,177,177,177,177] ;NO PUSHJ PP,AXRJ. MOVEM TB,EAHRJ POPJ PP, ;CREATE THE LITERAL ASCII LOW-VALUES, AND THE SAME LITERAL ; SHIFTED RIGHT 1 BIT. ALRJ.: SKIPE EALRJ## ;HAVE THEY ALREADY BEEN GENERATED? POPJ PP, ;YES--RETURN IFN ANS74,< SKIPLE COLSEQ## ;[1004] [722] PROGRAM COLLATING SEQUENCE JRST [HRRZ TB,COHVLV+4 ;[722] YES, GET ASCII LOW-VALUE CHAR. IMUL TB,[2010,,40201] ;[722] 5 CHARACTERS LSH TB,1 ;[722] LEFT JUSTIFIED (MUST BE SEPARATE TO AVOID OVERFLOW) JRST .+2] ;[722] > SETZ TB, ;[BYTE (7) 0,0,0,0,0] PUSHJ PP,AXRJ. MOVEM TB,EALRJ POPJ PP, ;NOTE, DON'T POOL THESE LITERALS AXRJ.: MOVE TA,[XWD ASCLIT,1] PUSHJ PP,STASHI MOVE TA,TB PUSHJ PP,STASHL AOS ELITPC MOVE TA,[XWD OCTLIT,1] PUSHJ PP,STASHI MOVE TA,TB LSH TA,-1 PUSHJ PP,STASHL AOS TB,ELITPC SUBI TB,2 ;BACKUP TO START OF LITERAL PAIR IORI TB,AS.LIT POPJ PP, ;CREATE TWO-WORD "HIGH-VALUE" LITERAL HIVAL:: SKIPE EHIVAL ;IS THERE ONE ALREADY? POPJ PP, ;YES--QUIT HRLOI TC,377777 ;NO PUSHJ PP,HILO. MOVEM TE,EHIVAL POPJ PP, ;CREATE TWO-WORD "LOW-VALUE" LITERAL LOVAL:: SKIPE ELOVAL ;IS THERE ONE ALREADY? POPJ PP, ;YES--QUIT HRLZI TC,1B18 ;NO PUSHJ PP,HILO. MOVEM TE,ELOVAL POPJ PP, ;CREATE LOW-VALUE FOR FLOATING-POINT FPLOV.: SKIPE EFPLOV ;IS THERE ONE ALREADY? POPJ PP, ;YES--QUIT MOVE TA,[XWD OCTLIT,1] ;NO PUSHJ PP,STASHI MOVE TA,[EXP 1B0!1B35] PUSHJ PP,STASHL MOVE TA,ELITPC IORI TA,AS.LIT MOVEM TA,EFPLOV AOS ELITPC POPJ PP, ;COMMON ROUTINE FOR HIVAL. & LOVAL. HILO.: MOVE TA,[XWD OCTLIT,2] PUSHJ PP,STASHI MOVE TA,TC PUSHJ PP,STASHL PUSHJ PP,STASHL MOVEI TE,2 EXCH TE,ELITPC ADDM TE,ELITPC IORI TE,AS.LIT POPJ PP, ;INCREMENT PARAMETERS OF "A" OPERAND BY THE NUMBER OF BYTES ; WHOSE VALUE IS IN "TE". M.IA: MOVE TC,EMODEA CAIN TC, C3MODE ;IF IT'S COMP-3, GO CHANGE PUSHJ PP, M.IA2 ; IT TO DISPLAY-9. IDIV TE,BYTE.W(TC) ;ADJUST INCREMENT ADDM TE,EINCRA HLRZ TE,ERESA PUSHJ PP,M.IB5 JUMPG TE,M.IA1 ;TO BIT 35 OR BEYOND? AOS EINCRA ;YES--INCREMENT THE INCREMENT ADDI TE,^D36 ;RESET RESIDUE M.IA1: HRLM TE,ERESA POPJ PP, M.IA2: SKIPN TC, ESIZEA ;SKIPPING THE WHOLE THING? JRST M.IB7 ;YES. JRST M.IB6N ;NO. ;INCREMENT PARAMETERS OF "B" OPERAND BY THE NUMBER OF BYTES ; WHOSE VALUE IS IN "TE". M.IB: HRRZ TC,EMODEB CAIN TC, C3MODE ;IF IT'S COMP-3 GO CHANGE PUSHJ PP, M.IB6 ; IT TO DISPLAY-9. IDIV TE,BYTE.W(TC) ADDM TE,EINCRB PUSHJ PP,M.IB4 JUMPG TE,M.IB1 AOS EINCRB ADDI TE,^D36 M.IB1: HRLM TE,ERESB POPJ PP, M.IB4: HLRZ TE,ERESB M.IB5: IMUL TD,BYTE.S(TC) SUB TE,TD CAML TE,BYTE.S(TC) POPJ PP, CAIN TC,D7MODE SUBI TE,1 POPJ PP, M.IB6: SKIPN TC, ESIZEB ;SKIPPING THE WHOLE THING? JRST M.IB7 ;YES. M.IB6N: ADDI TC, (TE) ;FORM THE ORIGIONAL LENGTH. TRNN TC, 1 ;IF IT WAS EVEN ADDI TE, 1 ; MAKE SURE WE SKIP TO THE TRNA ; NEXT BYTE. M.IB7: ADDI TE, 2 ;ROUND UP AND SKIP THE SIGN. M.IB8: LSH TE, -1 ;NUMBER OF 9 BIT BYTES TO SKIP. MOVEI TC, D9MODE ;PRETEND IT'S DISPLAY-9. POPJ PP, ;RETURN. ;GET A BYTE POINTER TO "A", IN ASYFIL XWD FORMAT, INTO TA&TB BYTE.A: MOVEI TE,EBASEA BYTE.X: HRRZ TC,EMODEX(TE) HLRZ TA,ERESX(TE) LSH TA,6 ADD TA,BYTE.S(TC) ROT TA,-14 BYTE.Y: HRRI TA,AS.CNB MOVE TB,EBASEX(TE) HRL TB,EINCRX(TE) POPJ PP, ;SIMILAR TO BYTE.A, EXCEPT FOR "B" BYTE.B: MOVEI TE,EBASEB JRST BYTE.X ;SIMILAR TO BYTE.B, EXCEPT SIZE PUT INTO BITS 6-17 BYTE.C: MOVEI TE,EBASEB HLRZ TA,ERESB LSH TA,14 ADD TA,ESIZEZ HRLZS TA JRST BYTE.Y ;PUT A SINGLE WORD INTO EOPTAB. ;ENTER AT PUSEOP WITH WORD IN 'CH'. PUSEO1: PUSHJ PP,XPNEOP ;EXPAND EOPTAB PUSEOP: MOVE EACA,EOPNXT CAML EACA,[XWD -1,0] ;ENOUGH ROOM? JRST PUSEO1 ;NO PUSH EACA,CH ;YES--STASH IT MOVEM EACA,EOPNXT ;SAVE EACA POPJ PP, ;STASH W1&W2 IN EOPTAB. ;ENTER AT PUSH12. PUS12A: PUSHJ PP,XPNEOP ;EXPAND EOPTAB PUSH12: MOVE EACA,EOPNXT ;GET END OF TABLE CAML EACA,[XWD -2,0] ;ENOUGH ROOM FOR TWO WORDS? JRST PUS12A ;NO PUSH EACA,W1 ;YES--STASH W1 PUSH EACA,W2 ; AND W2 MOVEM EACA,EOPNXT ;SAVE EACA POPJ PP, ;HERE FOR LITERAL POOLING ;STASHP JUST STORES A LITERAL IN THE TEST POOL ; IF THE POOL IS FULL DUMP THE CONTENTS INTO STASHL AND SET FLAG ; ;POOLIT STORES THE CURRENT LITERAL IN POOL ; THEN TESTS ENTIRE CONTENTS OF POOL AGAINST LITTAB ; IF A MATCH IS FOUND PLITPC POINT TO START OF LITERAL ; IF NO MATCH IS FOUND THE LITERAL IS PUT IN LITTAB AND PLITPC SET TO ZERO ;INITIALIZE THE POINTERS POOLINI:: MOVEI TE,1 MOVEM TE,PLITOF## ;SET OFFSET TO 1 INITIALL TO ACCOUNT FOR ZERO PLINI1: SETZM PLITPC## ;SET NO POOLED PC PLINI2: MOVEI TE,PLITSZ## ;GET SIZE MOVEM TE,PLITCT## ;INITIALIZE THE COUNT PLINI3: MOVE TE,[POINT 36,PLITBF##] MOVEM TE,PLITPT## ;INITIALIZE THE POINTER POPJ PP, ;STORE THE HEADER OF A LITERAL IN THE POOL BUFFER STASHP: SKIPGE PLITCT ;ANY ROOM? JRST STASHI ;NO SOSGE PLITCT ;ONE MORE WORD? JRST [PUSHJ PP,POOLFL ;NO, POOL JUST FILLED UP JRST STASHI] TRNE TA,770000 ;VERY LARGE LITERAL HALT ;YES HRRZ TE,TA ;GET SIZE HLLZ TA,TA ;GET TYPE ONLY LSH TA,-6 IOR TA,TE ;ADD IN SIZE HRL TA,ELITPC ;AND PUT LIT P.C. IN LHS JRST STSHP0 ;STORE REST OF LITERAL IN POOL BUFFER STASHQ: SKIPGE PLITCT ;ANY ROOM? JRST STASHL ;NO SOSGE PLITCT ;ONE MORE WORD? JRST [PUSHJ PP,POOLFL ;NO, POOL JUST FILLED UP JRST STASHL] STSHP0: IDPB TA,PLITPT ;YES, STORE POPJ PP, POOLFL: PUSH PP,TA ;SAVE CURRENT LITERAL PUSHJ PP,PLINI1 ;RESET POINTERS ILDB TA,PLITPT ;GET LITERAL PUSHJ PP,STASHL ;STORE SOSLE PLITCT ;COUNT DOWN JRST .-3 ;LOOP SETOM PLITCT ;MAKE SURE WE DON'T COME AGAIN POP PP,TA ;ORIGINAL LIT POPJ PP, ;ACC USAGE ;TA POINTER INTO LITTAB ;TB POINTER INTO PLITBF ;TC END OF LITTAB ;TD COUNTER OF ITEMS IN THIS LITERAL ;TE DATUM POOLIT:: PUSHJ PP,STASHQ ;STORE THIS LITERAL POOL:: SKIPGE PLITCT ;ANYTHING IN POOL? JRST PLINI1 ;NO, RESET POINTERS MOVE TE,[TD,,SAVEAC] BLT TE,SAVEAC+4 ;SAVE TD THRU TA MOVEI TB,PLITBF ;BASE OF POOLED LITS HRRZ TC,LITNXT ;END OF LITS HRRZ TA,LITLOC ;BASE OF LITS ADD TA,PLITOF ;BYPASS FIRST WORD (ITS ZERO) PLIT0: MOVEI TB,PLITBF ;BASE OF POOLED LITS PLIT1: HRRZ TE,(TA) ;GET LITERAL FROM LITTAB HRRZ TD,(TB) ;AND FROM POOLING BUFFER CAMN TE,TD ;MATCH? AOJA TB,PLIT2 ;YES ANDI TE,7777 ;GET SIZE ADDI TA,1(TE) ;BYPASS THIS GROUP CAIGE TA,(TC) ;AT END? JRST PLIT1 ;NO PLIT1A: MOVS TE,[TD,,SAVEAC] ;[1103] New label BLT TE,TA ;RESTORE PUSHJ PP,PLINI3 ;RESET POINTER MOVNI TE,PLITSZ ADDM TE,PLITCT ;- COUNT OF WORDS TO MOVE ILDB TA,PLITPT ;GET LITERAL PUSHJ PP,STASHL ;STORE IT AOSGE PLITCT ;COUNT DOWN JRST .-3 JRST PLINI1 ;RETURN WITH PLITPC=0 ;POOL ROUTINE (CONT'D) PLIT2: MOVE TD,(TA) ;GET WORD AGAIN HLRZM TD,PLITPC ;ASSUME SUCCESS PLIT3: ANDI TD,7777 ;FORM COUNT MOVN TD,TD ;NEGATE TO HRL TB,TD ; FORM AOBJN POINTER PLIT4: ADDI TA,1 ;BUMP POINTER MOVE TE,(TA) ;GET LITERAL CAME TE,(TB) ;MATCH? JRST PLIT90 ;NO AOBJN TB,PLIT4 ;LOOP FOR ALL OF IT HRRZ TE,PLITPT ;GET END OF BUFFER CAIGE TE,(TB) ;FINISHED? JRST PLIT99 ;YES, FOUND A MATCH CAMN TA,TC ;[1103] Is the group that just matched ;[1103] the first literal group at the ;[1103] logical end of the literals? JRST PLIT1A ;[1103] Yes, can't pool even if it matches ;[1103] past the end ADDI TA,1 ;BYPASS HEADER HRRZ TD,(TA) ;GET NEXT GROUP HEADER HRRZ TE,(TB) CAMN TD,TE ;MATCH? AOJA TB,PLIT3 ;YES PLIT90: HLRE TB,TB ;GET WORDS LEFT MOVM TB,TB ADDI TA,(TB) ;BYPASS REST OF GROUP JRST PLIT0 ;AND TRY AGAIN PLIT99: SKIPN PLITPC ;MAKE SURE ITS NOT AT LIT+00 JRST PLIT0 ;TOO BAD, WE CAN NOT TELL IT FROM FAILURE MOVS TE,[TD,,SAVEAC] ;OK BLT TE,TA ;RESTORE JRST PLINI2 ;SUCCESSFUL RETURN ;PUT A WORD INTO AS.LIT ;IF LITAB IS FULL AND < FULLIT WORDS, EXPAND AS.LIT ;IF LITAB FULL AND > FULLIT WORDS, WRITE OUT SOME WORDS ; ONTO LITFIL, AND MOVE REMAINDER TO TOP OF AS.LIT FULLIT==10*200 ;NUMBER OF WORDS WRITTEN OUT EACH TIME. ;THIS MUST BE > ^D768 (SEE EBURPL IN XFRGEN), ;YET SMALL ENOUGH SO THAT CURRENT LITERAL GROUP ;BEING STASHED WILL NOT BE WRITTEN OUT. ;LARGEST LITERAL GROUP IS ASCII, SIZE 120, OR ; A MULTI-DIMENSION SUBSCRIPT CALL. STASHI: SETZM PLITPC ;JUST INCASE STILL SET TRNE TA,770000 ;VERY LARGE LITERAL HALT ;YES HRRZ TE,TA ;GET SIZE HLLZ TA,TA ;GET TYPE ONLY LSH TA,-6 IOR TA,TE ;ADD IN SIZE HRL TA,ELITPC ;AND PUT LIT P.C. IN LHS IFN DEBUG,< SKIPN TE,ELITPC JRST STASHL ;IGNORE FIRST TIME EXCH TE,IMPAT.## CAML TE,IMPAT. ;IT BETTER INCREASE IN SIZE JFCL ;PUT BREAK POINT HERE > STASHL: MOVE TE,LITNXT ;GET NEXT HOLE ADDRESS AOBJP TE,STSHL0 ;IF NO ROOM, JUMP MOVEM TA,(TE) ;STORE WORD MOVEM TE,LITNXT ;RESTORE LITNXT POPJ PP, ;TABLE IS FULL STSHL0: HLRE TE,LITLOC ;IS MOVMS TE ; LITAB CAILE TE,FULLIT ; AS BIG AS IT GETS? JRST STSHL2 ;YES STSHL1: SKIPE ALITSV## ;[1077] NEED TO SAVE A PTR? JRST STSL1A ;[1077] YES PUSHJ PP,XPNLIT ;NO--EXPAND LITAB JRST STASHL ;TRY AGAIN ;[1077] THE ABSOLUTE POINTER TO LITTAB WILL NOT BE ANY GOOD AFTER ;[1077] THIS, SO WE HAVE TO MAKE IT A RELATIVE POINTER DURING THE ;[1077] TABLE EXPANSION. STSL1A: PUSH PP,TA ;[1077] SAVE A COUPLE ACS PUSH PP,TE ;[1077] PUSH PP,TB ;[1077] MOVE TA,ALITSV ;[1077] GET PTR TO EBASEA OR SOMETHING.. HRRZ TE,EBYTEX(TA) ;[1077] GET PRESENT BP HRRZ TB,VALLOC## ;[1077] START OF TABLE SUB TE,TB ;[1077] THIS IS OFFSET PUSH PP,TE ;[1077] PUSHJ PP,XPNLIT ;[1077] EXPAND LITTAB POP PP,TE ;[1077] GET BP OFFSET ADD TE,VALLOC ;[1077] GET NEW PTR INTO VALTAB MOVE TA,ALITSV ;[1077] GET BP TO EBASEA OR SOMETHING.. HRRM TE,EBYTEX(TA) ;[1077] RESTORE BP POP PP,TB ;[1077] POP PP,TE ;[1077] POP PP,TA ;[1077] RESTORE ACS JRST STASHL ;[1077] GO CALL STASHL AGAIN ;LITAB IS FULL, AND IS AS BIG AS IT SHOULD GET STSHL2: MOVEM TA,SAVEAC ;SAVE MOVE TA,[XWD TD,SAVEAC+1]; AC'S BLT TA,SAVEAC+3 ; TD THRU TA SKIPLE LITBLK ;IS LITFIL ALREADY OPEN? JRST STSHL3 ;YES SKIPL LITBLK ;WAS ANYTHING EVER WRITTEN? CLOSE LIT, ;YES--CLOSE INPUT MOVE TE,LITHDR ;GET FILE NAME HLLZ TD,LITHDR+1 ; AND EXTENSION SETZB TC,TB ;CLEAR PROTECTION, PROJ-PROG ENTER LIT,TE ;OPEN FILE FOR OUTPUT JRST STSHL5 ;CANNOT--TROUBLE SETZM LITBLK ;CLEAR WORD COUNT ;PUT WORD INTO LITAB (CONT'D) ;LITFIL IS NOW OPEN FOR OUTPUT ;NOW COUNT WORDS SO THAT WE LEAVE A COMPLETE BLOCK AS FIRST THING IN LITAB STSHL3: HRRZ TE,LITLOC ;BASE OF LITERALS ADD TE,PLITOF ;PLUS OFFSET SOS TA,PLITOF ;INITIALIZE THE COUNT STSHL6: HRRZ TD,(TE) ;GET TYPE AND COUNT ANDI TD,7777 ADDI TA,1(TD) ADDI TE,1(TD) ;NEXT LITERAL GROUP CAIGE TA,FULLIT ;ENOUGH? JRST STSHL6 ;NO SUBI TA,FULLIT-1 ;GET EXTRA WORDS MOVEM TA,PLITOF ;RESET OFFSET FOR COMPARES MOVEI TE,FULLIT ADDM TE,LITBLK ;BUMP WORD COUNT MOVSI TE,-FULLIT ;CREATE HRR TE,LITLOC ; IOWD LIST FOR SETZ TD, ; OUTPUT OUT LIT,TE ;WRITE IT JRST STSHL4 ;OK MOVEI CH,LITDEV ;ERROR--KILL JRST DEVDED STSHL4: MOVE TD,LITLOC ;MOVE MOVSI TE,FULLIT+1(TD) ; WORDS HRRI TE,1(TD) ; UP MOVN TD,[XWD FULLIT,FULLIT]; FROM ADDB TD,LITNXT ; BOTTOM BLT TE,(TD) ; OF TABLE ; AT STSHL4+6 [167] MOVNI TA,FULLIT ;UPDATE SKIPE CURLIT ; ANY NON-ZERO ADDM TA,CURLIT ; CURLIT MOVE TA,[XWD SAVEAC+1,TD] BLT TA,TB MOVE TA,SAVEAC JRST STASHL ;ENTER FAILURE STSHL5: OUTSTR [ASCIZ "?Cannot enter "] MOVEI DA,LITDEV HRRZ I2,TD ;GET ERROR CODE JRST ERATYP ;GET SOME TEMPORARY LOCATIONS ;ENTER WITH DESIRED NUMBER OF WORDS IN "TE". GETEMP: MOVE EACC,ETEMPC ADDB TE,ETEMPC CAMLE TE,ETEMAX MOVEM TE,ETEMAX IORI EACC,AS.TMP ADD EACC,TEMBAS POPJ PP, ;SET UP "B" PARAMETERS TO REPRESENT AN ASCII TEMP. ;ENTER WITH SIZE IN "TD", RELATIVE ADDRESS IN "TA". SETEMP: IORI TA,AS.TMP MOVEM TA,EINCRB MOVEI TE,AS.MSC MOVEM TE,EBASEB MOVEI TE,^D36 HRLM TE,ERESB MOVEM TD,ESIZEB SETZM EDPLB MOVEI TE,D7MODE MOVEM TE,EMODEB SWOFF FBNUM!FBSIGN POPJ PP, ;MOVE AC'S TO %TEMP. PUTEMP: SWON FANUM!FASIGN; SWOFF FASUB!FAINAC; HRRZ TD,EMODEA MOVEI TE,1 CAIE TD,D2MODE CAIN TD,F2MODE MOVEI TE,2 PUSHJ PP,GETEMP MOVEM EACC,EINCRA MOVEI TE,AS.MSC MOVEM TE,EBASEA MOVSI CH,MOVEM. CAIE TD,D2MODE ;[625] CAIN TD,F2MODE TRNA PJRST PUT.AA IFN BIS,< PUSHJ PP,PUTASA MOVSI CH,DMOVM. PJRST PUT.AA > IFE BIS,< PUSHJ PP,PUT.AA MOVSI CH,MOVEM. AOS EINCRA AOS EAC PUSHJ PP,PUT.AA SOS EAC SOS EINCRA POPJ PP, > ;PUT A TAG ONTO ASYFIL, AND RESOLVE ADDRESS PUTTAG: ANDI CH,77777 IORI CH,AS.TAG HRLI CH,720000 ;WRITE IT OUT PUSHJ PP,PUTASN TSWF FAS3 ;ARE WE IN NON-RESIDENT SEGMENT? SKIPA TE,EAS3PC ;YES SKIPA TE,EAS2PC ;NO--RESIDENT IORI TE,1B18 ANDI CH,77777 ;GET LOW 15 BITS ONLY MOVE TD,TAGLOC ADDI CH,(TD) HRRM TE,0(CH) ;STORE PC OF TAG POPJ PP, ;SET UP "A" PARAMETERS. ;ENTER WITH "TC" POINTING TO AN OPERAND. ;IF ANY ERRORS DETECTED, POP OFF ONE EXIT FROM PUSH-DOWN LIST, SUCH THAT ; WE EXIT TO THE ROUTINE WHICH CALLED THE CALLING ROTUINE. SETOPA: MOVEI LN,EBASEA STOPA1: PUSHJ PP,SETOPN TSWF FERROR; POP PP,TE POPJ PP, ;SIMILAR FOR "B" SETOPB: MOVEI LN,EBASEB JRST STOPA1 ;SET UP OPERAND PARAMETERS. ;ENTER WITH ADDRESS OF 2-WORD OPERAND IN TC, ADDRESS OF ; EITHER EBASEA OR EBASEB IN LN. SETOPN: MOVE TB,0(TC) MOVE TA,1(TC) IFN ANS68,< CAIN TA,TALLY.## ; [250] TALLY ADDRESS ? JRST [CAIE LN,EBASEA ; [365] IF "A" OPERAND SWOFFS FBSUB; ; [365] TURN OFF "A" SUBSCRIPTED SWOFF FASUB; ; [365] ELSE TURN OFF "B" SUBSCRIPTED JRST SETOP7] ; [365] FINISH UP OPERAND SETTING ; [365] FOR TALLY. > HRRZM TA,ETABLX(LN) LDB TE,LNKCOD CAIE TE,TB.DAT JRST SETOP1 ANDI TA,LMASKB IORI TA,AS.DAT SETOP1: HRRZM TA,EBASEX(LN) ;STASH BASE ADDRESS TLNE TB,GNLIT ;IS THIS A LITERAL? JRST SETOP4 ;YES TLNE TA,GNNOTD ;IS OPERAND EITHER TEMP OR AC'S? JRST SETOP9 MOVEI DW,E.101 ;GET READY FOR "NOT DATA-NAME" ERROR LDB TE,LNKCOD CAIE TE,TB.DAT ;IS IT A DATA-NAME? JRST OPERA ;NO--ERROR SETZM EINCRX(LN) ;YES--CLEAR INCREMENT SETZM EFLAGX(LN) ;CLEAR FLAGS MOVE TA,ETABLX(LN) PUSHJ PP,LNKSET ;SET UP TABLE ADDRESS LDB TE,DA.ERR## ; [406] ERROR BIT ON? JUMPN TE,[SWON FERROR ; [406] CANT USE SET ERROR POPJ PP,] ; [406] RETURN LDB TE,DA.USG SUBI TE,1 CAIN TE,IXMODE ;INDEX MODE? MOVEI TE,D1MODE ;YES--PRETEND IT'S 1-WORD COMP CAIN TE,%US.C3-1 ;COMP-3? MOVEI TE,C3MODE ;YES, USE INDEX'S SLOT. CAIN TE,%US.C2-1 ;COMP-2? MOVEI TE,F2MODE ;YES, USE CORRECT INDEX MOVEM TE,EMODEX(LN) LDB TD,DA.RES ;GET RESIDUE HRLM TD,ERESX(LN) ; AND STASH LDB TD,DA.NDP ;GET DECIMAL PLACES LDB TE,DA.DPR ;IS DECIMAL POINT SKIPE TE ; TO RIGHT OF FIELD? MOVNS TD ;YES--NEGATE MOVEM TD,EDPLX(LN) ;NO--STASH DECIMAL PLACES LDB TE,DA.INS ;GET INTERNAL SIZE MOVEM TE,ESIZEX(LN) MOVEI DW,E.104 ;GET READY FOR "UNDEFINED" ERROR LDB TD,DA.DEF ;IF DEFINED, JUMPN TD,SETOP0 ; GO ON SWON FERROR ;SET ERROR FLAG HRRZ TD,DATLOC ;CK FOR DUMMY DATAB ENTRY SUBI TD,-1(TA) JUMPN TD,OPERA ;IF NOT, PUT OUT ?NOT DEFINED POPJ PP, ;IF DUMMY, EXIT NOW ;SET UP OPERAND PARAMETERS (CONT'D). SETOP0: MOVE TE,1(TC) ;ANY LDB TE,TESUBC ; SUBSCRIPTS? JUMPE TE,SETOP2 ;NO IF JUMP LDB TD,DA.SUB ;SHOULD JUMPN TD,SETOP2 ; THERE BE? MOVEI DW,E.275 ;YES PUSHJ PP,OPERA ; ERROR SETOP2: IFN ANS74,< SKIPN FLGSW ;FIPS FLAGGER WANTED? JRST SETP2A ;NO LDB TE,DA.LVL ;GET THE LEVEL # CAIE TE,LVL.66 ;IS OPERAND A RENAMES? JRST SETP2A ;NO PUSH PP,LN ;YES, WHAT A CROCK PUSH PP,CUREOP ; WE HAVE TO FLAG ALL REFERENCES TO IT MOVEM TC,CUREOP ;SO FAKE UP WHAT WE NEED PUSHJ PP,TST.N2 ; FOR GENERAL ERROR ROUTINE MOVE TC,CUREOP POP PP,CUREOP POP PP,LN SETP2A:> CAIN LN,EBASEA ;"A" OPERAND? JRST SETOP3 ;YES ;"B" OPERAND IFN ANS74,< SKIPL TE,EDEBDB## ;DID USER WANT DEBUGGING? JRST SETOQ2 ;NO SKIPE INDCLR## ;ARE WE STILL IN DECLARATIVES? TDZA TD,TD ;YES, SO NO DEBUGGING ALLOWED LDB TD,DA.DEB## ;DEBUGING ON THIS DATA-NAME ALLOWED? SKIPE TD ;NO HRRZ TD,EBASEX(LN) ;YES, GET BASE ADDRESS MOVEM TD,EDEBDB ;SIGNAL DEBUGGING REQUIRED (OR NOT) JUMPE TD,SETOQ2 ;DONE IF NOT DEBUGGING HRRZM TE,EDEBGB## ;SAVE AS FLAG FOR "ARO" TEST MOVE TD,EDEBDB ;GET BASE PUSHJ PP,TSTARO ; SEE IF IT IS "ON ALL REFERENCES OF" SETOQ2:> LDB TD,DA.SGN ;IS 'B' SKIPE TD ; SIGNED? SWONS FBSIGN; ;YES SWOFF FBSIGN; ;NO LDB TE,DA.EDT LDB TD,DA.CLA SKIPN TE CAIE TD,2 SWOFFS FBNUM ;EDITED OR NOT NUMERIC SWON FBNUM ;NUMERIC AND NOT EDITED LDB TD,DA.SUB ;SHOULD ITEM SKIPN TD ; BE SUBSCRIPTED? SWOFFS FBSUB; ;NO SWON FBSUB ;YES LDB TD,DA.LKS## ;LINKAGE SECTION? SKIPE TD ;NO SWON FBSUB ;YES IFN ANS74,< TSWF FBNUM ;NUMERIC? JRST SETOPF ;YES, SET SIGN FLAGS > POPJ PP, ;"A" OPERAND SETOP3: IFN ANS74,< SKIPL TE,EDEBDA## ;DID USER WANT DEBUGGING? JRST SETOQ3 ;NO SKIPE INDCLR ;ARE WE STILL IN DECLARATIVES? TDZA TD,TD ;YES, SO NO DEBUGGING ALLOWED LDB TD,DA.DEB## ;DEBUGING ON THIS DATA-NAME ALLOWED? SKIPE TD ;NO HRRZ TD,EBASEX(LN) ;YES, GET BASE ADDRESS MOVEM TD,EDEBDA ;SIGNAL DEBUGGING REQUIRED (OR NOT) JUMPE TD,SETOQ3 ;DONE IF NOT DEBUGGING HRRZM TE,EDEBGA## ;SAVE AS FLAG FOR "ARO" TEST MOVE TD,EDEBDA## ;GET BASE PUSHJ PP,TSTARO ; SEE IF IT IS "ON ALL REFERENCES OF" SETOQ3:> LDB TD,DA.SGN ;IS 'A' SKIPE TD ; SIGNED? SWONS FASIGN; ;YES SWOFF FASIGN ;NO LDB TE,DA.EDT LDB TD,DA.CLA SKIPN TE CAIE TD,2 SWOFFS FANUM ;EDITED OR NOT NUMERIC SWON FANUM ;NUMERIC AND NOT EDITED LDB TD,DA.SUB ;IS IT SKIPN TD ; SUBSCRIPTED? SWOFFS FASUB ;NO SWON FASUB ;YES LDB TD,DA.LKS ;LINKAGE SECTION? SKIPE TD ;NO SWON FASUB ;YES IFN ANS74,< TSWT FANUM ;NUMERIC? POPJ PP, SETOPF: LDB TE,DA.SCF## ;GET FLAGS DPB TE,[POINT 2,EFLAGX(LN),1] > POPJ PP, ;SET UP OPERAND PARAMETERS (CONT'D). ;OPERAND IS A LITERAL. SETOP4: IFN ANS74,< CAIE LN,EBASEA JRST .+3 SKIPGE EDEBDA## SETZM EDEBDA ;DON'T DEBUG ON "A" OPERAND CAIN LN,EBASEA JRST .+3 SKIPGE EDEBDB## SETZM EDEBDB ;DON'T DEBUG ON "B" OPERAND > CAIE LN,EBASEA SWOFFS FBSUB; SWOFF FASUB; TLNE TB,GNFIGC JRST SETOP6 MOVEI TE,LTMODE MOVEM TE,EMODEX(LN) PUSHJ PP,LNKSET HRLI TA,350700 MOVEM TA,EBYTEX(LN) LDB TD,TA MOVEM TD,ESIZEX(LN) SETZM EDPLX(LN) CAIE LN,EBASEA JRST SETOP5 TLNE TB,GNNUM ;IS IT NUMERIC? SWONS FANUM!FASIGN; SWOFF FANUM!FASIGN; POPJ PP, SETOP5: TLNE TB,GNNUM ;IS IT NUMERIC? SWONS FBNUM!FBSIGN; SWOFF FBNUM!FBSIGN; POPJ PP, ;SET UP OPERAND PARAMETERS (CONT'D). ;OPERAND IS A FIGURATIVE CONSTANT SETOP6: IFN ANS68,< TLNE TB,GNTALY JRST SETOP7 > MOVEI TE,FCMODE MOVEM TE,EMODEX(LN) TLNE TB,GNTODY MOVEI TE,0 TLNE TB,GNFCS MOVEI TE,1 TLNE TB,GNFCZ MOVEI TE,2 TLNE TB,GNFCQ MOVEI TE,3 TLNE TB,GNFCHV MOVEI TE,4 TLNE TB,GNFCLV MOVEI TE,5 IFN ANS74,< TLNN TB,GNDATE!GNDAY!GNTIME JRST .+3 LDB TE,[POINT 2,TB,7] ADDI TE,5 > MOVEM TE,EFLAGX(LN) JRST SETOP8 ;SET UP OPERNAD (CONT'D). ;OPERAND IS "TALLY" IFN ANS68,< SETOP7: MOVEI TE,D1MODE MOVEM TE,EMODEX(LN) HRRI TA,TALLY.## ; [333] SET TALLY BUT KEEP LEFT HALF INTACT HRRZM TA,EBASEX(LN) ; [333] WE ONLY WANT TALLY ADDRESS. SETZM EINCRX(LN) SETZM EDPLX(LN) MOVEI TE,5 MOVEM TE,ESIZEX(LN) CAIE LN,EBASEA SWONS FBSIGN!FBNUM; SWON FASIGN!FANUM; TLZ TB,GNFIGC!GNLIT MOVEM TB,0(TC) TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT? JRST SETOP8 ;NO MOVE TD,TA ;YES--SET FLAG IN EXTAB ENTRY FOR TALLY ANDI TD,77777 ADD TD,EXTLOC MOVSI TE,1B18 IORM TE,1(TD) > SETOP8: MOVEM TA,1(TC) POPJ PP, ;SET UP OPERAND (CONT'D). ;OPERAND IS A TEMP OR THE AC'S. SETOP9: CAIE LN,EBASEA SWOFFS FBSUB; SWOFF FASUB; MOVE TD,TA LDB TE,ACMODE MOVEM TE,EMODEX(LN) LDB TE,ACSIZE MOVEM TE,ESIZEX(LN) HRREM TD,EDPLX(LN) MOVEI TE,(TB) ;IS IT THE AC'S? CAIG TE,17 JRST STOP10 ;YES MOVEI TE,AS.MSC ;NO--TEMP MOVEM TE,EBASEX(LN) HRRZM TB,EINCRX(LN) JRST STOP11 STOP10: SETZM EBASEX(LN) ;YES SETZM EINCRX(LN) STOP11: TLNE TB,GNOPNM ;IS IT NUMERIC? JRST STOP12 ;YES CAIE LN,EBASEA ;NO--"A"? SWOFFS FBSIGN!FBNUM ;NO--MUST BE "B" SWOFF FASIGN!FANUM ;YES POPJ PP, STOP12: CAIE LN,EBASEA ;IS THIS "A" OPERAND? SWONS FBNUM!FBSIGN ;NO SWON FANUM!FASIGN; POPJ PP, ;GENERATE CODE TO ROUND THE AC'S ROUND: SWON FROUND ;TURN ON "WE'RE ROUNDING" HRRZ TE,EMODEB CAIE TE,FPMODE CAIN TE,F2MODE JRST ROUND5 HRRZ TE,EMODEA CAIN TE,FPMODE JRST ROUND9 CAIN TE,F2MODE JRST ROUNDF ;COMP-2 ROUND0: MOVE TC,EDPLA ;COMPUTE DIFFERENCE IN DECIMAL PLACES SUB TC,EDPLB SKIPE REMRND## ;SPECIAL IF ROUNDING AND REMAINDER JUMPE TC,SPCRND ;IT IS JUMPLE TC,NOROUN ;IF NOT POSITIVE--NO NEED FOR ROUNDING IFN BIS,< CAIN TE,D4MODE ;[673] IS "A" 4 WORDS? JRST ROUND7 ;[673] YES, NEED TO REDUCE TO 2 FIRST > MOVEM TC,ESAVAC CAIG TC,^D10 ;MORE THAN 10? JRST ROUND1 ;NO PUSHJ PP,FORCX0 ;YES--INSURE AC'S ARE 0&1 MOVEI TC,^D10 ;GENERATE MOVSI CH,DIV.21 PUSHJ PP,PUT.PC MOVNI TE,^D10 ;RESET SIZE AND DECIMAL PLACES ADDM TE,ESIZEA ADDM TE,EDPLA ADDM TE,ESAVAC ;[522] GENERATE THE CORRECT LITERAL ROUND1: MOVSI CH,SKIPL. ;GENERATE HRR CH,EAC PUSHJ PP,PUTASY MOVE TC,ESAVAC ;IS LITERAL ALREADY CREATED? SKIPN CH,RPWR10-1(TC) PUSHJ PP,ROUND4 ;NO--CREATE IT MOVEM CH,ESAVAC MOVEM CH,RPWR10-1(TC) MOVE CH,[XWD SKIPA.+AC4,AS.MSC] ;GENERATE PUSHJ PP,PUTASY MOVE CH,ESAVAC PUSHJ PP,PUTASN MOVE CH,[XWD MOVN.+AC4,AS.MSC] ;GENERATE PUSHJ PP,PUTASY MOVE CH,ESAVAC PUSHJ PP,PUTASN ROUND6: HRRZ TE,EMODEA CAIN TE,D2MODE JRST ROUND3 IFN BIS,< CAIE TE,D4MODE ;[570] SPECIAL QUAD-WORD CODE? JRST ROUND2 ;[570] NO MOVEI CH,ADD.4R## ;[570] YES PJRST PUT.PJ ;[570] NEED HELP WITH THIS ONE ROUND7: AOS EDPLB ;[673] ACCOUNT FOR ROUNDING AOS ESIZEB ;[673] AND MAKE SIZE BIGGER ALSO MOVN TC,TC ;[673] GET NO. OF DECIMAL PLACES TO REMOVE ADD TC,ESIZEA ;[673] GET NEW SIZE WHEN DONE CAIGE TC,MAXSIZ ;[673] SKIP IF REDUCING D.P. WON'T DO ANY GOOD PUSHJ PP,ADJ4C.## ;[673] ADJUST DECIMAL PLACES MOVE TE,EMODEA ;[673] MAKE SURE WE DON'T LOOP CAIE TE,D4MODE ;[673] MODE SHOULD HAVE CHANGED BY NOW JRST ROUND8 ;[673] OK, SO RETURN PUSHJ PP,CUTC4## ;[673] NO, TRY TO REDUCE INTEGERS INSTEAD PUSHJ PP,FORCX0 ;[673] PUT RESULT IN ACC 0 & 1 MOVE TE,EMODEA ;[673] MAKE SURE WE DON'T LOOP CAIE TE,D4MODE ;[673] MODE SHOULD HAVE CHANGED BY NOW JRST ROUND8 ;[673] OK, SO RETURN PUSHJ PP,ADJ4C. ;[673] ONE LAST TRY MOVE TE,EMODEA ;[673] MAKE SURE WE DON'T LOOP CAIN TE,D4MODE ;[673] MODE SHOULD HAVE CHANGED BY NOW JRST KILL ;[673] SHOULD NEVER HAPPEN ROUND8: SOS EDPLB ;[673] BACK THE WAY IT WAS SOS ESIZEB ;[673] ... JRST ROUND0 ;[673] SO TRY AGAIN > ;GENERATE CODE TO ROUND AC'S (CONT'D). ;AC'S CONTAIN 1-WORD COMP OR INDEX ROUND2: MOVE CH,[XWD AD,4] JRST PUT.XA ;AC'S CONTAIN A 2-WORD COMP ROUND3: PUSHJ PP,FORCX0 IFE BIS,< MOVE CH,[XWD ADD.21,4] > IFN BIS,< PUSHJ PP,PUTASA MOVE CH,[ASHC.+AC4+ASINC,,AS.CNB] PUSHJ PP,PUTASY ;"ASHC 4,-^D35" MOVEI CH,-^D35 PUSHJ PP,PUTASN PUSHJ PP,PUTASA MOVE CH,[DADD.,,4] >;END IFN BIS JRST PUTASY ;GET ROUNDING VALUE INTO LITERAL POOL ROUND4: MOVE TA,[XWD D1LIT,1] PUSHJ PP,STASHI MOVE TA,ROUNDR-1(TC) PUSHJ PP,STASHL HRRZ CH,ELITPC IORI CH,AS.LIT AOS ELITPC POPJ PP, ;ROUNDING NOT ALLOWED WITH COMP-1 OR COMP-2 RECEIVING FIELDS ROUND5: MOVEI DW,E.300 JRST OPNWRN ;AC'S ARE FLOATING POINT, "B" IS NOT. ;CONVERT AC'S TO TWO-WORD COMP LEAVING 1 EXTRA DECIMAL PLACE. ROUND9: MOVE TD,EDPLB AOSE TD PUSHJ PP,GENFPL MOVSI CH,FIX. PUSHJ PP,PUT.XA JRST ROUNDG ;AC'S ARE D.P. FLOATING POINT, "B" IS NOT. ;CONVERT AC'S TO TWO-WORD COMP LEAVING 1 EXTRA DECIMAL PLACE. ROUNDF: MOVE TD,EDPLB AOSE TD PUSHJ PP,GENF2L HRRZ CH,EAC DPB CH,CHAC ;GET ACC FIELD PUSHJ PP,PUT.16 ;OUTPUT MOVX 16, MOVEI CH,FIX.2## PUSHJ PP,PUT.PJ ;PUSHJ P,FIX.2 ROUNDG: MOVE TE,[XWD ESIZEB,ESIZEA] BLT TE,EBASAX AOS ESIZEA AOS EDPLA MOVEI TE,D2MODE MOVEM TE,EMODEA JRST ROUND0 ;GENERATE CODE TO ROUND IF REMAINDER ALSO ; THE FOLLOWING IS TRUE: ; THE REMAINDER IS IN AC 2 (2 AND 3 IF 2-WORD). ; THE QUOTIENT TO ROUND IS IN AC0 AND AC1. ; THE DIVISOR'S ADDRESS IS POINTED TO BY REMRND AND REMRN1. ; THE REMAINDER HAS ALSO BEEN SAVED IN %TEMP. ; ; ROUNDING PROCEDURE IS: ; MULTIPLY REMAINDER IN 2 BY 2. IF THIS IS GREATER OR EQUAL TO DIVISOR, ; ROUND UP (ADD 1 TO DIVIDEND), ELSE TRUNCATE (ADD 0 TO DIVIDEND). SPCRND: HLRZ TC,REMRND ;GET "B" SIZE SKIPN SGNREM## ;COULD REMAINDER BE NEGATIVE? JRST SPCRNA ;NO--DON'T GET MAGNITUDE CAIG TC,^D10 JRST SPCR10 ;S.P. MOVM IFN BIS,< MOVE CH,[SKPGE.,,2] PUSHJ PP,PUTASY PUSHJ PP,PUTASA MOVE CH,[DMOVN.+AC2,,2] >;END IFN BIS IFE BIS,< MOVE CH,[MAG.+AC2,,2] >;END IFN BIS PUSHJ PP,PUTASY JRST SPCRNA ;DONE GETTING POSITIVE REMAINDER IN 2&3 SPCR10: MOVE CH,[MOVM.+AC2,,2] PUSHJ PP,PUTASY ;MOVM 2,2 SPCRNA: PUSHJ PP,PUTASA ;NOW TO MULTIPLY BY 2 CAIG TC,^D10 SKIPA CH,[ASH.+AC2,,1] MOVE CH,[ASHC.+AC2,,1] PUSHJ PP,PUTASY SKIPN SGNDIV## ;DID WE HAVE A SIGNED DIVISOR? JRST SPCRNB ;NO- LEAVE IT WHERE IT IS ;GET MAGNITUDE OF DIVISOR INTO AC4&5, CHANGE REMRND ACCORDINGLY CAIG TC,^D10 ;BIG? JRST SPCR20 ;NO IFN BIS,< PUSHJ PP,PUTASA MOVSI CH,DMOVE.+AC4+ASINC >;END IFN BIS IFE BIS,< MOVSI CH,MAG.+AC4+ASINC >;END IFE BIS HRR CH,REMRND MOVE TE,REMRN1 PUSHJ PP,PUTASC ;PUT OUT CORRECT FORM OF CONSTANT JRST SPCR30 SPCR20: MOVSI CH,MOVM.+AC4+ASINC HRR CH,REMRND MOVE TE,REMRN1 PUSHJ PP,PUTASC SPCR30: MOVEI TE,AS.CNB ;RESET REMRND TO POINT TO ACS HRRM TE,REMRND MOVEI TE,4 MOVEM TE,REMRN1 SPCRNB: MOVE TD,REMPAR## ;GET REMAINDER PARAMETERS LDB TC,ACSIZE ;GET SIZE CAILE TC,^D10 ;D.P. JRST SPCRDP ;YES HRLI CH,CAMGE.+AC2+ASINC HRR CH,REMRND MOVE TE,REMRN1## PUSHJ PP,PUTASC SPCRNC: MOVE CH,[TDCA.+AC4,,4] PUSHJ PP,PUTASY MOVE CH,[MOVEI.+AC4,,1] PUSHJ PP,PUTASY MOVSI CH,SKPGE. HRR CH,EAC PUSHJ PP,PUTASY MOVE CH,[MOVN.+AC4,,4] PUSHJ PP,PUTASY SETZM REMRND JRST ROUND6 SPCRDP: HRLI CH,CAMN.+AC2+ASINC HRR CH,REMRND MOVE TE,REMRN1 PUSHJ PP,PUTASC HRLI CH,CAML.+AC3+ASINC HRR CH,REMRND MOVE TE,REMRN1 ADDI TE,1 PUSHJ PP,PUTASC MOVSI CH,CAMGE.+AC2+ASINC HRR CH,REMRND MOVE TE,REMRN1 PUSHJ PP,PUTASC JRST SPCRNC ;GENERATE "SIZE ERROR" CODING SIZERA: SWON FSZERA ;SET 'DON'T WORRY ABOUT TOO BIG' MOVE TE,EDPLA CAMLE TE,EDPLB SIZER0: PUSHJ PP,ADJDP. HRRZ TE,EMODEB ;IS RESULT FIELD FLOATING-POINT? CAIE TE,FPMODE CAIN TE,F2MODE JRST SIZER7 ;[1110] YES, TEST FOR DIVIDE BY ZERO ONLY HRRZ TD,EMODEA ;NO--IS "A" FLOATING-POINT? CAIE TD,FPMODE CAIN TD,F2MODE PUSHJ PP,CFPCX. ;YES--CONVERT MOVE TC,ESIZEB ;FIND POWER OF 10 REQUIRED IFN ANS74,< SKIPGE EFLAGB ;SEPARATE SIGN SUBI TC,1 ;YES, 1 LESS DIGIT > SUB TC,EDPLB ADD TC,EDPLA JUMPL TC,SIZER0 CAILE TC,^D10 ;NEED A 2-WORD LITERAL? JRST SIZER6 ;YES HRRZ TD,EMODEA ;NO CAIE TD,D1MODE JRST SIZER4 ;AC'S CONTAIN ONE WORD COMP OR INDEX, LITERAL IS ONE WORD. ;GENERATE TEST INLINE MOVSI CH,MOVM.+AC13 HRR CH,EAC PUSHJ PP,PUTASY ;GENERATE MOVM 13,ACC MOVE CH,[SKIPN.,,OVFLO.##] SKIPGE OVFLFL## ;SEE IF NEEDED PUSHJ PP,PUT.EX PUSHJ PP,CREATL MOVSI CH,CAML.+AC13 PUSHJ PP,PUT.PC ;CAML 13,[POWER OF TEN] MOVSI CH,SKIPA. PUSHJ PP,PUTASY ;SKIP--WE HAVE TO SET SZERA. PUSHJ PP,GETTAG ;GET A TAG FOR JRST AROUND SETOM PUSH PP,CH HRLI CH,JRST. HRRZ TA,CH PUSHJ PP,REFTAG## ;AND REFERENCE IT PUSHJ PP,PUTASY MOVE CH,[SETOM.,,SZERA.##] PUSHJ PP,PUT.EX SKIPN EMULSZ SKIPA CH,ESZERA PUSHJ PP,GETTAG MOVEM CH,ESAVAC HRRZ TA,CH ;GET TAG NUMBER PUSHJ PP,REFTAG## ;REFERENCE IT HRLI CH,JRST. ;JRST SIZE-ERROR TAG PUSHJ PP,PUTASY POP PP,CH ;GET TAG PUSHJ PP,PUTTAG ;OUTPUT IT SETZM OVFLFL ;CLEAR OVFLO. FLAG SKIPN EMULSZ ;MORE THAN ONE RESULT? JRST MACX. ;NO--GENERATE STASH AND RETURN PUSHJ PP,MACX. MOVE CH,ESAVAC JRST PUTTAG ;GENERATE "SIZE ERROR" CODING (CONT'D). ;AC'S CONTAIN TWO WORDS, LITERAL IS ONE WORD SIZER4: IFN BIS,< ;[634] CAIN TD,D4MODE ;[634] FOUR WORDS IN ACS? JRST SZER4A ;[634] YES >;END IFN BIS ;[634] MOVSI CH,SIZE.2 JRST SIZER2 IFN BIS,< ;[634] SZER4A: PUSH PP,[EPJPP,,SIZE.4] ;[634] ONE WORD LIT COMPARE-- CALL TO SIZE.4 CAIA ;[634] SIZE6A: PUSH PP,[EPJPP,,SIZE.5] ;[634] TWO WORD LIT COMPARE-- CALL TO SIZE.5 MOVSI CH,MOVEI.+AC16 ;[634] PUSHJ PP,PUTASY ;[634] AC16 POINTS TO 1ST AC OF FOUR POP PP,CH ;[634] PUSHJ PP,PUTASY ;[634] PUT OUT ROUTINE CALL JRST SIZR2A ;[634] GO PUT OUT 2ND WORD >;END IFN BIS ;[634] ;LITERAL IS TWO WORDS ;[634] CHECK SIZE ERROR ON QUAD-WORD RESULT SIZER6: HRRZ TE,EMODEA ;IS AC ONE WORD? IFN BIS,< ;[634] CAIN TE,D4MODE ;[634] FOUR WORDS IN ACS? JRST SIZE6A ;[634] YES, USE SIZE.5 >;END IFN BIS ;[634] CAIE TE,D2MODE PUSHJ PP,CC1C2. ;YES--CONVERT TO TWO WORDS MOVSI CH,SIZE.3 SIZER2: SETZM OVFLFL ;CLEAR OVFLO. FLAG HRR CH,EAC PUSHJ PP,PUTASY SIZR2A: PUSHJ PP,CREATL ;[634] ADD LABEL MOVE CH,[XWD AS.XWD,1] PUSHJ PP,PUTASN SKIPN EMULSZ SKIPA CH,ESZERA PUSHJ PP,GETTAG MOVEM CH,ESAVAC LDB TA,[POINT 15,CH,35] ;GET TAG NUMBER PUSHJ PP,REFTAG## ;REFERENCE IT PUSHJ PP,PUTASY HRRZI CH,AS.MSC HRL CH,EPWR10(TC) PUSHJ PP,PUTASN IFN BIS,< MOVE TE,EMODEA ;[730] GET MODE OF INTERMEDIATE TEMP CAIN TE,D4MODE ;[730] IS IT QUAD-WORD? PUSHJ PP,CUTC2C## ;[730] YES, CONVERT TO 2 WORDS NOW JFCL ;[730] TAKE CARE OF NON-SKIP RETURN > SKIPN EMULSZ ;MORE THAN ONE RESULT? JRST MACX. ;NO--GENERATE STASH AND RETURN PUSHJ PP,MACX. MOVE CH,ESAVAC JRST PUTTAG ;[1110] HERE TO GENERATE FLOATING OVERFLOW TEST (DIVIDE BY ZERO) ;[1110] FOR COMP-1 AND COMP-2 RESULTS SIZER7: PUSHJ PP,PUTASA ;[1110] MOVSI CH,JFOV. ;[1110] HRR CH,ESZERA ;[1110] TAG OF "ON SIZE ERROR" CODE PUSHJ PP,PUTASY ;[1110] SETZM OVFLFL ;[1110] CLEAR OVFLO. FLAG JRST MACX. ;[1110] AND FORGET SIZE ERROR ;[762] GENERATE CODE TO ADD A SMALL NUMBER (EPSILON) TO COMP-2 ITEMS ;[762] TO MAKE UP FOR BITS LOST IN DP INSTRUCTIONS ;[762] THE EPSILON IS MORE THAN 2 ORDERS OF MAGNITUDE LESS THAN THE ROUNDING ;[762] VALUE IF ROUNDING HAD BEEN SPECIFIED. IFN BIS,< EPSLON: SKIPGE TC,EDPLB ;[762] GET NO OF DECIMAL PLACES IN "B" POPJ PP, ;[762] GIVE UP IF "P" SHIFTED ADDI TC,2 ;[762] MAKE IT 1000 TIMES SMALLER MOVE TA,[F2LIT,,2] ;[762] TWO WORDS PUSHJ PP,STASHP ;[762] INITIALIZE POOLER MOVN TA,TC ;[762] GET NEGATIVE POWER OF TEN PUSHJ PP,STASHQ ;[762] PUT IN POOL MOVSI TA,(BYTE (4)0,1) ;[762] GET 0.1 PUSHJ PP,POOLIT ;[762] POOL LITERAL SKIPE CH,PLITPC ;[762] GET LITERAL IF POOLED JRST .+4 ;[762] MOVEI CH,2 ;[762] NO, COUNT THE 2 NEW ONES EXCH CH,ELITPC ;[762] ADDM CH,ELITPC ;[762] IORI CH,AS.LIT ;[762] PUSH PP,CH ;[762] PUSHJ PP,PUTASA ;[762] SECOND SET OF OPCODES MOVE CH,[DMOVE.+AC4,,AS.MSC] ;[762] PUSHJ PP,PUTASY ;[762] POP PP,CH ;[762] GET BACK LITERAL PUSHJ PP,PUTASN ;[762] MOVSI CH,SKPGE. ;[762] HRR CH,EAC ;[762] PUSHJ PP,PUTASY ;[762] GENERATE PUSHJ PP,PUTASA ;[762] MOVE CH,[DMOVN.+AC4,,4] ;[762] PUSHJ PP,PUTASY ;[762] NEGATE CONSTANT ALSO PUSHJ PP,PUTASA ;[762] MOVE CH,[DFAD.,,4] ;[762] PJRST PUT.XA ;[762] ADD IN CONSTANT > ;MOVE A LITERAL FROM VALTAB TO LITAB (DISPLAY ONLY) ;THE HEADER WORD HAS ALREADY BEEN PUT OUT. VALLIT: MOVEI TE,EBASEA ;[1077] SAVE EBYTEA IF XPAND LITERALS MOVEM TE,ALITSV## ;[1077] REMEMBER INCASE WE EXPAND HRRZ TC,EMODEB PUSHJ PP,VLIT5. JUMPE TD,VLIT3A ;[1077] RETURN IF SIZE IF ZERO VLIT2: ILDB TE,EBYTEA ;GET A CHARACTER XCT VLIT6.(TC) ;CONVERT IT IF NECESSARY. IDPB TE,TB ;STASH IT INTO TA SOJLE TD,VLIT2A ;QUIT IF ALL HAVE BEEN TRANSFERRED TLNN TB,760000 ;IS "TA" FULL? PUSHJ PP,VLIT4. ;YES--PUT IT INTO LITAB JRST VLIT2 VLIT2A: SKIPN TD,ADCRLF## ;NEED TO ADD CR-LF? JRST VLIT3. ;NO SOJE TD,VLIT2B ;ONLY NEED NULL TLNN TB,760000 ;ANY ROOM? PUSHJ PP,VLIT4. ;NO MOVEI TE,15 ;CR IDPB TE,TB TLNN TB,760000 ;FULL? PUSHJ PP,VLIT4. ;YES MOVEI TE,12 ;LF IDPB TE,TB VLIT2B: TLNN TB,760000 PUSHJ PP,VLIT4. IBP TB ;ENSURE NULL AT END VLIT3.:: TLNN TB,760000 ;[1077] JUST ENOUGH TO FIT WORD? JRST VLIT4. ;[1077] MORE WORDS VLIT3A: SETZM ALITSV## ;[1077] DON'T WORRY ABOUT THIS ANYMORE POPJ PP, ;[1077] RETURN VLIT4.:: PUSHJ PP,STASHL ;PUT THAT WORD INTO LITAB VLIT5.:: MOVEI TA,0 ;CLEAR LITAB WORD MOVE TB,VLIT7.(TC) ;PICK UP THE APPROPRIATE BYTE POINTER. SKIPN IMCONS## ;IMMEDIATE MODE FLAG SET? POPJ PP, ;NO MOVEI TB,1(TC) ;MODE + 1 IMUL TB,ESIZEB ;*SIZE MOVE TB,VLIT7I-1(TB) ;GET BYTE POINTER POPJ PP, ;BYTE POINTERS FOR PUTTING THE CONVERTED CHAR INTO TA. VLIT7I: POINT 6,TA,29 ;1-SIXBIT. POINT 7,TA,28 ;1-ASCII. POINT 9,TA,26 ;1-EBCDIC. POINT 6,TA,23 ;2-SIXBIT. POINT 7,TA,21 ;2-ASCII. POINT 9,TA,17 ;2-EBCDIC. POINT 6,TA,23 ;3-SIXBIT. ;SAME AS VALLIT EXCEPT THAT LITERAL WILL BE POOLED PVALIT: MOVEI TE,EBASEA ;[1077] GET BASE FOR EBYTEA MOVEM TE,ALITSV## ;[1077] SAVE INCASE WE EXPAND LITTAB HRRZ TC,EMODEB PUSHJ PP,VLIT5. JUMPE TD,PVLT5A ;[1077] IF SIZE IF ZERO QUIT NOW PVLIT2: ILDB TE,EBYTEA ;GET A CHARACTER XCT VLIT6.(TC) ;CONVERT IT IF NECESSARY. IDPB TE,TB ;STASH IT INTO TA SOJLE TD,PVLIT3 ;QUIT IF ALL HAVE BEEN TRANSFERRED TLNN TB,760000 ;IS "TA" FULL? PUSHJ PP,PVLIT6 ;YES--PUT IT INTO LITAB JRST PVLIT2 PVLIT3: SKIPN TD,ADCRLF## ;NEED TO ADD CR-LF? JRST PVLIT5 ;NO SOJE TD,PVLIT4 ;ONLY NEED NULL TLNN TB,760000 ;ANY ROOM? PUSHJ PP,PVLIT6 ;NO MOVEI TE,15 ;CR IDPB TE,TB TLNN TB,760000 ;FULL? PUSHJ PP,PVLIT6 ;YES MOVEI TE,12 ;LF IDPB TE,TB PVLIT4: TLNN TB,760000 PUSHJ PP,PVLIT6 IBP TB ;ENSURE NULL AT END PVLIT5::SKIPN IMCONS ;IMMEDIATE MODE? TLNE TB,760000 ;JUST ENOUGH TO FIT WORD? JRST PVLT5A ;[1077] NO--QUIT PVLIT6::PUSHJ PP,STASHQ ;PUT THAT WORD INTO LITAB JRST VLIT5. PVLT5A: SETZM ALITSV## ;[1077] FORGET ABOUT THIS POPJ PP, ;[1077] RETURN ;INSTRUCTIONS XCT'ED TO CONVERT THE CHAR IN TE FROM ASCII TO EBCDIC. VLIT6.:: PUSHJ PP,VLIT10 ; [374] SIXBIT. JFCL ;ASCII. PUSHJ PP, VLIT8. ;EBCDIC. ;BYTE POINTERS FOR PUTTING THE CONVERTED CHAR INTO TA. VLIT7.:: POINT 6,TA ;SIXBIT. POINT 7,TA ;ASCII. POINT 9,TA ;EBCDIC. ;ROUTINE TO CONVERT AN ASCII CHAR TO EBCDIC. VLIT8.:: ROT TE, -2 ;FORM THE INDEX INTO THE TABLE. JUMPL TE, VLIT9 ;LEFT OR RIGHT HALF? HLR TE, ASEBC.##(TE) ;LEFT. CAIA VLIT9: HRR TE, ASEBC.##(TE) ;RIGHT. TLNN TE, (1B1) ;IS THE CHAR RIGHT JUSTIFIED? LSH TE, -^D9 ;IT IS NOW. ANDI TE,377 ;JUST SAVE CHAR VALUE. POPJ PP, ;RETURN. ;ROUTINE TO CONVERT AN ASCII CHAR TO SIXBIT VLIT10:: ; [374] CAIL TE,40 ; [374] IS THIS ASCII CHAR CONVERTABLE? CAILE TE,137 ; [374] IE TO SIXBIT? SETOM LITERR## ; [374] NO- IFGEN WILL GIVE ERROR VLIT76:: ROT TE, -2 ; [374] FORM THE INDEX INTO THE TABLE. JUMPL TE, VLIT11 ; [374] LEFT OR RIGHT HALF? HLR TE, ASCSX.##(TE) ; [374] LEFT. CAIA ; [374] VLIT11: HRR TE, ASCSX.##(TE) ; [374] RIGHT. TLNN TE, (1B1) ; [374] IS THE CHAR RIGHT JUSTIFIED? LSH TE, -^D9 ; [374] IT IS NOW. TRZ TE,777700 ; [374] GET RID OF STATUS BITS POPJ PP, ; [374] RETURN. ;CONVERT A NUMERIC LITERAL INTO 2-WORD COMP. ;ENTER WITH EITHER "BASEA" OR "EBASEB" IN "LN". ;RETURN WITH RESULT IN TD&TC. CONVNL: PUSHJ PP,FDIGIT ;GET FIRST DIGIT TSWF FERROR ;ANY ERRORS SO FAR? POPJ PP, ;YES--QUIT SETZB TC,TD HRRZI TE,1 JRST CNVNL2 CNVNL1: SOSGE ESIZEX(LN) JRST CNVNL4 ILDB CH,EBYTEX(LN) ;GET NEXT CHARACTER CAIN CH,"." JRST CNVNL3 CAIG CH,"9" CAIGE CH,"0" JRST BADLK CAILE TE,^D18 JRST TOOBIG ADDI TE,1 CNVNL2: TSWF FLITDP ;ANY DECIMAL POINT? AOS EDPLX(LN) ;YES--INCREMENT DECIMAL PLACES IMULI TD,^D10 MULI TC,^D10 ADD TD,TC MOVE TC,TB ADDI TC,-"0"(CH) TLZN TC,1B18 JRST CNVNL1 AOJA TD,CNVNL1 CNVNL3: CAIE LN,EBASEA JRST CNVNL5 TSWT FANUM; JRST BADLK JRST CNVNL6 CNVNL5: TSWT FBNUM; JRST BADLK CNVNL6: SWON FLITDP ;YES--SET "DECIMAL POINT SEEN" JRST CNVNL1 ;LOOP CNVNL4: MOVEM TE,ESIZEX(LN) POPJ PP, ;CREATE A FLOATING POINT LITERAL. ;EXIT WITH EXPONENT IN TD, MANTISSA IN TC. CONVFP: PUSHJ PP,FDIGIT ;GET FIRST DIGIT TSWF FERROR ;ANY ERRORS? POPJ PP, ;YES MOVEI TC,0 MOVN TD,EDPLX(LN) HRRZI TE,1 MOVE TB,[POINT 4,TC,3] JRST CNVFP2 CNVFP1: SOSGE ESIZEX(LN) POPJ PP, ILDB CH,EBYTEX(LN) CAIN CH,"." JRST CNVFP3 CAIG CH,"9" CAIGE CH,"0" JRST BADLK CAILE TE,^D8 JRST CNVFP7 ADDI TE,1 CNVFP2: TSWT FLITDP; AOS TD IDPB CH,TB JRST CNVFP1 CNVFP3: CAIE LN,EBASEA JRST CNVFP5 TSWT FANUM; JRST BADLK JRST CNVFP6 CNVFP5: TSWT FBNUM; JRST BADLK CNVFP6: SWON FLITDP; JRST CNVFP1 CNVFP7: CAIE CH,"0" JRST TOOBIG TSWT FLITDP ;IS THIS A DECIMAL PLACE? AOJA TD,CNVFP1 ;NO--BUMP INTEGRAL SIZE JRST CNVFP1 ;YES--LOOP WITHOUT BUMPING ;CREATE A D. P. FLOATING POINT LITERAL. ;EXIT WITH EXPONENT IN TD, MANTISSA IN C2MANT (3 WORDS). CONVF2: PUSHJ PP,FDIGIT ;GET FIRST DIGIT TSWF FERROR ;ANY ERRORS? POPJ PP, ;YES SETZM C2MANT## ;ZERO THE MANTISSA SETZM C2MANT+1 ;... SETZM C2MANT+2 ;... MOVN TD,EDPLX(LN) HRRZI TE,1 MOVE TB,[POINT 4,C2MANT,3] JRST CNVF22 CNVF21: SOSGE ESIZEX(LN) POPJ PP, ILDB CH,EBYTEX(LN) CAIN CH,"." JRST CNVF23 CAIG CH,"9" CAIGE CH,"0" JRST BADLK CAILE TE,^D18 ;ALLOW UP TO 18 DIGITS JRST CNVF27 ADDI TE,1 CNVF22: TSWT FLITDP; AOS TD IDPB CH,TB JRST CNVF21 CNVF23: CAIE LN,EBASEA JRST CNVF25 TSWT FANUM; JRST BADLK JRST CNVF26 CNVF25: TSWT FBNUM; JRST BADLK CNVF26: SWON FLITDP; JRST CNVF21 CNVF27: CAIE CH,"0" JRST TOOBIG TSWT FLITDP ;IS THIS A DECIMAL PLACE? AOJA TD,CNVF21 ;NO--BUMP INTEGRAL SIZE JRST CNVF21 ;YES--LOOP WITHOUT BUMPING ;SCAN A LITERAL TO GET SIZE AND DECIMAL PLACES SCANL: HLRZ TE,OPERND ;IS "ALL" FLAG UP? MOVE TE,0(TE) TLNE TE,GNALL JRST BADALL ;YES--ERROR MOVEI LN,EBASEA PUSHJ PP,FDIGIT ;GET FIRST DIGIT TSWF FERROR ;ANY ERROR? POPJ PP, ;YES--QUIT MOVE TD,[POINT 6,LITHLD] HRRZI TC,0 ;CLEAR SIZE JRST SCANL3 SCANL2: SOSGE ESIZEA ;ANYTHING LEFT? JRST SCANL5 ;NO ILDB CH,EBYTEA CAIN CH,"." JRST SCANL4 CAIG CH,"9" CAIGE CH,"0" JRST BADLK SCANL3: ADDI TC,1 TSWF FLITDP AOS EDPLA CAILE TC,^D120 ;[FCCTS NC105] ALLOW UP TO 120 CHARS JRST TOOBIG SUBI CH,40 IDPB CH,TD JRST SCANL2 SCANL4: TSWT FANUM ;DECIMAL POINT SEEN JRST BADLK TSWT FBNUM JRST BADDP SWON FLITDP JRST SCANL2 SCANL5: MOVEM TC,ESIZEA POPJ PP, ;GET FIRST SIGNIFICANT DIGIT OF LITERAL IN VALTAB ;RETURN WITH THAT FIRST DIGIT IN "CH" FDIGIT: SWOFF FLITDP!FLNEG!FERROR; SETZM EDPLX(LN) SOSGE ESIZEX(LN) JRST LNOSIZ ILDB CH,EBYTEX(LN) CAIN CH,"+" JRST FDIG4 CAIN CH,"-" JRST FDIG3 FDIG1: CAILE CH,"9" JRST BADLK CAIL CH,"1" POPJ PP, CAIN CH,"0" JRST FDIG6 CAIE CH,"." JRST BADLK SWONS FLITDP; FDIG3: SWON FLNEG; FDIG4: CAIE LN,EBASEA JRST FDIG5 TSWT FANUM; JRST BADLK JRST FDIG7 FDIG5: TSWT FBNUM; JRST BADLK JRST FDIG7 FDIG6: SKIPN ESIZEX(LN) POPJ PP, TSWF FLITDP; AOS EDPLX(LN) FDIG7: SOSGE ESIZEX(LN) JRST LNOSIZ ILDB CH,EBYTEX(LN) JRST FDIG1 ;MULTIPLY A LITERAL BY SOME POWER OF 10. ;ENTER WITH THE POWER IN "TE", A PARAMETER TABLE BASE IN "LN". ADJSL.: JUMPLE TE,CPOPJ ;REFUSE ANY NEGATIVE OR ZERO POWERS ADDM TE,EDPLX(LN) MOVE TA,TE ADDB TA,ESIZEX(LN) CAILE TA,MAXSIZ JRST TOOBIG CAILE TE,^D10 JRST ADJSL1 IMUL TD,POWR10(TE) MUL TC,POWR10(TE) ADD TD,TC MOVE TC,TB POPJ PP, ADJSL1: SUBI TE,^D11 LSH TE,1 MOVEM TC,ELITLO IMUL TD,DPWR10+1(TE) MUL TC,DPWR10(TE) ADD TD,TB MOVE TC,ELITLO MUL TC,DPWR10+1(TE) ADD TD,TC MOVE TC,TB POPJ PP, ;SWAP THE TWO OPERANDS. SWAPAB: MOVE TE,[XWD EBASEA,ESAVEB] BLT TE,ESAVBX MOVE TE,[XWD EBASEB,EBASEA] BLT TE,EBASAX MOVE TE,[XWD ESAVEB,EBASEB] BLT TE,EBASBX MOVE TA,SW TSWTZ FBSIGN; SWOFFS FASIGN; SWON FASIGN; TSWTZ FBNUM; SWOFFS FANUM; SWON FANUM; TSWTZ FBSUB; SWOFFS FASUB; SWON FASUB; TRNE TA,FASIGN SWON FBSIGN; TRNE TA,FANUM SWON FBNUM; TRNE TA,FASUB SWON FBSUB; MOVSS OPERND IFN ANS74,< MOVE TE,EDEBDA ;SWAP THE DEBUG STUFF ALSO EXCH TE,EDEBDB MOVEM TE,EDEBDA MOVE TE,EDEBPA EXCH TE,EDEBPB MOVEM TE,EDEBPA MOVE TE,EDEBGA EXCH TE,EDEBGB MOVEM TE,EDEBGA > POPJ PP, ;CREATE A BYTE POINTER TO "A" AND PUT IT INTO LITAB MBYTEA: MOVEI TB,EBASEA JRST MBYTEX ;LIKEWISE FOR "B" MBYTEB: MOVEI TB,EBASEB MBYTEX: HRRZ TA,EBASEX(TB) PUSHJ PP,STASHL HLRZ TA,ERESX(TB) ROT TA,-6 HRRZ TC,EMODEX(TB) MOVE TC,BYTE.S(TC) DPB TC,[POINT 6,TA,11] HRR TA,EINCRX(TB) JRST STASHL ;SAME BUT FOR POOLED LITERALS MBYTPA: MOVEI TB,EBASEA JRST MBYTPX ;LIKEWISE FOR "B" MBYTPB: MOVEI TB,EBASEB MBYTPX: HRRZ TA,EBASEX(TB) PUSHJ PP,STASHQ HLRZ TA,ERESX(TB) ROT TA,-6 HRRZ TC,EMODEX(TB) MOVE TC,BYTE.S(TC) SKIPE USENBT## IMUL TC,NBYTES## ;USE LARGER BYTES DPB TC,[POINT 6,TA,11] HRR TA,EINCRX(TB) SKIPE MAKBPB## ;MAKE AN INCREMENTED BYTE PTR? IBP TA ;YES, INCREMENT BP SETZM MAKBPB## ;CLEAR THE FLAG JRST STASHQ ;WRITE OUT PUT.AA: MOVE TE,EAC PUT.A0: DPB TE,CHAC ;WRITE OUT PUT.A: TSWF FASUB ;IS IT SUBSCRIPTED? JRST PUT.A2 ;YES PUT.A1: HRR CH,EBASEA SKIPN EINCRA JRST PUTAXY ;CHECK FOR EXTERNAL REF TLO CH,ASINC PUSHJ PP,PUTAXY ;CHECK FOR EXTERNAL SYMBOL HRRZ CH,EINCRA JRST PUTASN PUT.A2: LDB TE,[POINT 3,EBASEA,20] CAIE TE,TB.DAT JRST PUT.A1 TLO CH,SXR HRR CH,EINCRA JRST PUTASY ;WRITE OUT PUT.AO: MOVE TE,EAC AOJA TE,PUT.A0 ;WRITE OUT PUT.BA: MOVE TE,EAC PUT.B0: DPB TE,CHAC ;WRITE OUT PUT.B: TSWF FBSUB ;IS IT SUBSCRIPTED? JRST PUT.B2 ;YES PUT.B1: HRR CH,EBASEB SKIPN EINCRB JRST PUTAXY ;CHECK FOR EXT. SYMBOL AND PUT IT OUT TLO CH,ASINC PUSHJ PP,PUTAXY ;CHECK FOR EXT. SYMBOL HRRZ CH,EINCRB JRST PUTASN PUT.B2: LDB TE,[POINT 3,EBASEB,20] CAIE TE,TB.DAT JRST PUT.B1 TLO CH,SXR HRR CH,EINCRB JRST PUTASY ;WRITE OUT PUT.BO: MOVE TE,EAC AOJA TE,PUT.B0 ;WRITE OUT . ;LITERAL VALUE IS IN TC. PUT.LA: MOVE TE,EAC DPB TE,CHAC TLNE TC,-1 JRST PUT.L2 ADD CH,[1B8] PUT.L0: TRNE TC,7B20 JRST PUT.L1 HRR CH,TC JRST PUTASY PUT.L1: HRRI CH,AS.CNB TLO CH,ASINC PUSHJ PP,PUTASY HRRZ CH,TC JRST PUTASN ;CHECK TO SEE IF LITERAL IS NEGATIVE SMALL NUMBER PUT.L2: TLC TC,-1 TLCN TC,-1 ;LEFT HALF ALL ONES TLNE CH,777000 ;AND OP WAS MOVE JRST PUT.L ;NO TRNN TC,-1 ;[577] CHECK FOR -262144 I.E. <-1,,0> JRST [TLO CH,MOVSI. ;[577] YES, GENERATE MOVEI TC,-1 ;[577] MOVSI AC,-1 JRST PUT.L0] ;[577] TLO CH,MOVNI. ;YES MOVNS TC ;MAKE LITERAL POSITIVE JRST PUT.L0 ;GENERATE MOVNI AC, ;WRITE OUT . ;PUT LITERAL INTO AS.LIT ;LITERAL VALUE IS IN TC PUT.L: MOVE TA,[XWD D1LIT,1] PUSHJ PP,STASHP MOVE TA,TC PUSHJ PP,POOLIT SKIPN EACC,PLITPC SKIPA EACC,ELITPC CAIA AOS ELITPC ;WRITE OUT ;ADDRESS OF LITERAL IS IN EACC PUT.LB: HRRI CH,AS.MSC TLO CH,ASINC PUSHJ PP,PUTASY HRRZ CH,EACC IORI CH,AS.LIT JRST PUTASN ;GENERATE , OR . ;ENTER WITH OP SET UP IN CH, THE POWER IN TC. PUT.PA: MOVE TE,EAC ;SET AC FIELD DPB TE,CHAC PUT.P: CAIG TC,5 ;CAN IT BE IMMEDIATE MODE? JRST PUT.P1 ;YES ;SIMILAR TO GENOPL, EXCEPT THAT AC-FIELD NOT TOUCHED, AND ; NO IMMEDIATE MODE. PUT.PC: PUSHJ PP,CREATL ;CREATE THE LITERAL, IF NEEDED HRRI CH,AS.MSC ;CREATE INSTRUCTION TLO CH,ASINC PUSHJ PP,PUTASY ;WRITE OUT FIRST OF TWO WORDS HRRZ CH,EPWR10(TC) JRST PUTASN ;WRITE OUT INCREMENT AND RETURN PUT.P1: ADD CH,[1B8] ;IMMEDIATE MODE USED CAILE TC,4 ;IS IT LESS THAN 77777? JRST PUT.P2 HRR CH,POWR10(TC) ;YES JRST PUTASY PUT.P2: HRRI CH,AS.CNB ;NO TLO CH,ASINC PUSHJ PP,PUTASY HRRZ CH,POWR10(TC) JRST PUTASN ;GENERATE AN INSTRUCTION REFERENCING CURRENT LITERAL. ;OP-CODE IS IN "CH", AC-FIELD IN EAC. PUT.LC: MOVE TE,EAC DPB TE,CHAC ;SIMILAR TO PUT.LC, EXCEPT THAT AC-FIELD UNALTERED. PUT.LD: HRRI CH,AS.MSC TLO CH,ASINC PUSHJ PP,PUTASY SKIPN CH,PLITPC## HRRZ CH,ELITPC IORI CH,AS.LIT JRST PUTASN ;SET AC-FIELD TO "EAC", AND WRITE OUT INSTRUCTION. PUT.XA: MOVE TE,EAC PUT.X1: DPB TE,CHAC JRST PUTASY ;SET AC-FIELD TO EAC+1, AND WRITE OUT INSTRUCTION. PUT.XB: MOVE TE,EAC PUT.X2: AOJA TE,PUT.X1 IFN BIS,< INTERN PUT.XC ;SET AC-FIELD TO EAC+2, AND WRITE OUT INSTRUCTION. PUT.XC: MOVE TE,EAC AOJA TE,PUT.X2 > ;PUT OUT MOVX 16, ;ON ENTRY CH CONTAINS: ; LHS DESTINATION AC ; RHS SOURCE ACC OR EBASEA/EBASEB PUT.16: TLNN CH,-1 ;LHS 0? JRST PUT16I ;YES PUSH PP,CH ;NO MOVE TA,[XTNLIT,,1] TLNE CH,ASINC ;NEED TWO WORDS? ADDI TA,1 ;YES PUSHJ PP,STASHP ;GET LITERAL TO HOLD ACC MOVE TA,0(PP) ;GET TRNE TA,-20 ;IS SOURCE ACC? HRR TA,(TA) ;NO, GET IT TLNE TA,ASINC ;INCREMENT WANTED? JRST PUT162 ;YES PUSHJ PP,POOLIT ;NO, STORE 1 WORD POP PP,TA ;FIXUP STACK PUT161: MOVE CH,[MOV+ASINC+AC16,,AS.MSC] PUSHJ PP,PUTASY SKIPN CH,PLITPC SKIPA CH,ELITPC TRNA AOS ELITPC IORI CH,AS.LIT JRST PUTASN PUT162: PUSHJ PP,STASHQ ;STORE FIRST WORD MOVE TA,0(PP) ;GET WORD AGAIN HRRZ TA,EINCRX(TA) ;YES, GET IT PUSHJ PP,POOLIT ;STORE SECOND WORD POP PP,TA JRST PUT161 ;GO GENERATE THE MOVE PUT16I: TLO CH,MOVEI.+AC16 TLNE CH,ASINC ;INCREMENT TO FOLLOW? PUSH PP,EINCRX(CH) ;SAVE INCREMENT TRNE CH,-20 ;IS SOURCE ACC? HRR CH,(CH) ;NO, GET IT TLNN CH,ASINC ;INCREMENT TO FOLLOW? JRST PUTASY ;NO PUSHJ PP,PUTASY POP PP,CH JRST PUTASN ;PUT OUT REFERENCE TO EXTERNAL AND CHECK FOR NON-RESIDENT PUT.PJ: HRLI CH,EPJPP ;COMPLETE INSTRUCTION PUT.EX: PUSHJ PP,PUTASY TSWT FAS3 POPJ PP, ANDI CH,77777 ADD CH,EXTLOC MOVSI TE,NR.EXT IORM TE,1(CH) POPJ PP, ;SAME AS PUT.EX BUT TURNS ON @ SIGN NEEDED FLAG ALSO PUT.SX: PUSHJ PP,PUTASY TSWT FAS3 POPJ PP, ANDI CH,77777 ADD CH,EXTLOC MOVSI TE,NR.EXT!NR.IND IORM TE,1(CH) POPJ PP, ;ADJUST DECIMAL PLACES OF FLOATING-POINT ITEM IN AC'S. GENFPL: MOVM TC,TD SKIPE TD CAILE TC,MAXSIZ POPJ PP, MOVSI CH,FMP. SKIPG TD MOVSI CH,FDV. SKIPE TB,EFPCNV(TC) JRST GENFP1 MOVE TB,ELITPC IORI TB,AS.LIT MOVEM TB,EFPCNV(TC) MOVE TA,[XWD FLTLIT,2] PUSHJ PP,STASHI MOVEI TA,1(TC) PUSHJ PP,STASHL MOVSI TA,1B<^D18+7> PUSHJ PP,STASHL AOS ELITPC GENFP1: HRRI CH,AS.MSC TLO CH,ASINC PUSHJ PP,PUT.XA HRRZ CH,TB JRST PUTASN ;ADJUST DECIMAL PLACES OF D.P. FLOATING-POINT ITEM IN AC'S. GENF2L: MOVM TC,TD SKIPE TD CAILE TC,MAXSIZ POPJ PP, PUSHJ PP,PUTASA MOVSI CH,DFMP. SKIPG TD MOVSI CH,DFDV. SKIPE TB,EF2CNV(TC) ;ALREADY GENERATED JRST GENFP1 ;YES MOVE TB,ELITPC IORI TB,AS.LIT MOVEM TB,EF2CNV(TC) ;STORE LOCATION SKIPE EFPCNV(TC) ;[762] S.P. LOC ALREADY STORED? JRST GENF21 ;[762] YES MOVN TD,TC ;[762] NO, SEE IF S.P. VALUE IS SAME MOVSI TA,(1B0) ;[762] AS HIGH WORD OF D.P. VALUE LSH TA,(TD) ;[762] SHIFT BIT INTO POSITION AND TA,[1B12+1B14+1B15+1B16+1B18+7B23+7777] ;[762] MASK JUMPN TA,GENF21 ;[762] ITS NOT THE SAME (S.P. IS ROUNDED UP) MOVEM TB,EFPCNV(TC) ;[762] SAME SO MAY AS WELL STORE IT ALSO GENF21: MOVE TA,[F2LIT,,2] ;[762] D. P. FLOATING POINT PUSHJ PP,STASHI MOVEI TA,1(TC) PUSHJ PP,STASHL MOVSI TA,(BYTE (4)0,1) PUSHJ PP,STASHL AOS ELITPC AOS ELITPC ;SPACE FOR SECOND WORD OF ZERO JRST GENFP1 ;PUT A POWER OF 10 IN THE LITERAL POOL, AND PUT ENTRY ADDRESS INTO "EPWR10". ;ENTER WITH POWER IN "TC". CREATL: SKIPE EPWR10(TC) POPJ PP, CAILE TC,^D10 ;2 WORDS? JRST CREAT2 ;YES MOVE TA,[XWD D1LIT,1];NO--1 WORD PUSHJ PP,STASHI MOVE TA,POWR10(TC) PUSHJ PP,STASHL MOVE TE,ELITPC ;SAVE ADDRESS OF THE LITERAL AOS ELITPC ;BUMP THE ADDRESS CREAT1: IORI TE,AS.LIT ;SET TABLE ENTRY WITH ADDRESS MOVEM TE,EPWR10(TC) CAILE TC,^D20 SKIPE EPWR10-^D20(TC) POPJ PP, ADDI TE,1 MOVEM TE,EPWR10-^D20(TC) POPJ PP, CREAT2: MOVE TA,[XWD D2LIT,2] ;GENERATE 2-WORD LITERAL PUSHJ PP,STASHI CAILE TC,^D20 JRST CREAT4 MOVE TE,TC SUBI TE,^D11 LSH TE,1 MOVE TA,DPWR10(TE) MOVE TD,DPWR10+1(TE) PUSHJ PP,STASHL MOVE TA,TD CREAT3: PUSHJ PP,STASHL MOVEI TE,2 ;BUMP UP LITERAL ADDRESS EXCH TE,ELITPC ADDM TE,ELITPC JRST CREAT1 CREAT4: MOVEI TA,0 PUSHJ PP,STASHL MOVE TA,POWR10-^D20(TC) JRST CREAT3 ;INSURE THAT AC'S ARE 0&1. ;IF NOT, GENERATE A MOVE. FORCX0: SKIPN CH,EAC POPJ PP, HRLI CH,MOV IFE BIS,< PUSHJ PP,PUTASY MOVE CH,EAC SETZM EAC HRRZ TE,EMODEA CAIE TE,D2MODE POPJ PP, HRLI CH,MOV+AC1 AOJA CH,PUTASY > IFN BIS,< SETZM EAC HRRZ TE,EMODEA CAIE TE,D2MODE JRST PUTASY HRLI CH,DMOVE. PUSH PP,CH PUSHJ PP,PUTASA ;SIGNAL ALTERNATE POP PP,CH JRST PUTASY > ;PUT OUT A "JRST" TO A MISCELLANEOUS ADDRESS. ;ENTER WITH ADDRESS INCREMENT IN "TC". JOUT: MOVE CH,[XWD JRST.+ASINC,AS.MSC] PUSHJ PP,PUTASY MOVEI CH,(TC) JRST PUTASN ;DOUBLE PRECISION DIVIDE. "TE" SPECIFIES SOME POWER OF 10. DPDIV.: CAILE TE,^D10 JRST DPDIV1 MOVE TA,POWR10(TE) JRST DPD21 DPDIV1: SUBI TE,^D11 LSH TE,1 MOVE TB,DPWR10(TE) MOVE TA,DPWR10+1(TE) JRST DPD22 ;DIVIDE A DOUBLE PRECISION NUMBER BY A SINGLE PRECISION NUMBER.. ;ENTER WITH DIVIDEND IN TD&TC, DIVISOR IN TA. ;EXIT WITH QUOTIENT IN TD&TC, REMAINDER IN TB&TA. DPD21: JOV .+1 DIV TD,TA JOV DPD21A MOVE TA,TC MOVE TC,TD SETZB TD,TB POPJ PP, ;QUOTIENT IS DOUBLE PRECISION. DPD21A: MOVE TE,TD IDIV TE,TA DIV TD,TA MOVE TA,TC MOVE TC,TD MOVE TD,TE HRRZI TB,0 POPJ PP, ;DIVIDE A DOUBLE PRECISION NUMBER BY A DOUBLE PRECISION NUMBER. ;ENTER WITH DIVIDEND IN TD&TC, DIVISOR IN TB&TA. ;EXIT WITH QUOTIENT IN TD&TC, REMAINDER IN TB&TA. COMMENT \ DPD22: MOVE LN,TD MOVE CP,TC IDIV TD,TB MOVE CH,TD DPDIV3: MUL TD,TA MOVE TE,TB IMUL TE,CH ADD TD,TE SUBM LN,TD SUBM CP,TC TLZE TC,1B18 SUBI TD,1 TLNE TD,1B18 TLO TC,1B18 JUMPGE TD,DPDIV5 MOVEI TD,-1(CH) SOJA CH,DPDIV3 DPDIV5: MOVE TA,TC MOVE TB,TD HRRZI TD,0 MOVE TC,CH POPJ PP, \ DPD22: PUSH PP, SW ;SAVE SW. MOVE LN, TD ;SAVE A (THE DIVIDEND.) MOVE CP, TC IDIV TD, TB ;FORM S (INITIAL APPROXIMATION ; TO THE QUOTENT.) MOVE SW, TD ;SAVE I (THE INCREMENT.) SKIPA CH, TD ;SAVE S. DPDIV3: MOVE TD, CH ;GET S. LSH SW, -1 ;FORM I FOR THE NEXT ITERATION. SKIPN SW MOVEI SW, 1 MUL TD, TA ;FORM S * B (B IS THE DIVISOR.) MOVE TE, TB IMUL TE, CH ADD TD, TE SUBM LN, TD ;FORM S * B - A. SUBM CP, TC TLZE TC, (1B0) SUBI TD, 1 JUMPL TD, DPDIV7 ;IF S * B - A < 0, S > Q, GO ; MAKE S SMALLER. ;S * B - A > OR = 0. CAMLE TD, TB ;SEE IF S * B - A > B. JRST DPDIV5 ;IT IS. CAMN TD, TB CAMGE TC, TA JRST DPDIV9 ;IT ISN'T, S = Q, GO RETURN. ;S * B - A > B ==> S < Q, MAKE S LARGER. DPDIV5: ADD CH, SW JRST DPDIV3 ;ITERATE. ;S * B - A < 0 ==> S > Q, MAKE S SMALLER. DPDIV7: SUB CH, SW JRST DPDIV3 ;ITERATE. ;COME HERE TO RETURN. DPDIV9: POP PP, SW ;RSTORE SW. MOVE TA, TC ;GET THE REMAINDER. MOVE TB, TD SETZI TD, ;GET THE QUOTENT. MOVE TC, CH POPJ PP, ;RETURN. ;SET CUREOP TO THE NEXT OPERAND IN EOPTAB. BMPEOP: MOVE TE,CUREOP MOVE TD,0(TE) MOVE TE,1(TE) TLNN TE,GNNOTD TLNE TD,GNLIT TDCA TD,TD LDB TD,TESUBC LSH TD,1 ADDI TD,2 ADDB TD,CUREOP HRRZ TE,EOPNXT CAILE TE,(TD) AOS (PP) POPJ PP, ;NEGATE THE 2-WORD LITERAL TO BE FOUND IN TD&TC. NEGATL: SETCA TD, MOVNS TC JUMPN TC,CPOPJ ADDI TD,1 TLNN TD,1B18 TLZA TC,1B18 TLO TC,1B18 POPJ PP, ;PUT A LITERAL INTO %LIT. ;ENTER WITH VALUE OF LITERAL IN TD&TC. MAKEL: MOVEI TA,AS.MSC MOVEM TA,EBASEX(LN) MOVE TE,ESIZEX(LN) ;IS IT TWO WORDS? CAILE TE,^D10 JRST MAKL1A ;YES MAKEL1: MOVE TA,[XWD D1LIT,1] ;NO--CREATE A 1-WORD LITERAL PUSHJ PP,STASHP TSWT FLNEG ;LITERAL NEGATIVE? SKIPA TA,TC ;NO--USE POSITIVE VALUE MOVN TA,TC ;YES--USE NEGATIVE VALUE PUSHJ PP,POOLIT SKIPN TA,PLITPC SKIPA TA,ELITPC ;GET %LIT ADDRESS CAIA AOS ELITPC IORI TA,AS.LIT MOVEM TA,EINCRX(LN) MOVEI TA,D1MODE MOVEM TA,EMODEX(LN) POPJ PP, MAKL1A: JUMPE TD,MAKEL3 MAKL1B: MOVE TA,[XWD D2LIT,2] PUSHJ PP,STASHP TSWF FLNEG; PUSHJ PP,NEGATL MOVE TA,TD PUSHJ PP,STASHQ MOVE TA,TC PUSHJ PP,POOLIT SKIPN TA,PLITPC SKIPA TA,ELITPC TDZA TE,TE ;ZERO MOVEI TE,2 IORI TA,AS.LIT MOVEM TA,EINCRX(LN) ADDM TE,ELITPC MOVEI TE,D2MODE MOVEM TE,EMODEX(LN) POPJ PP, MAKEL3: MOVEI TE,^D10 MOVEM TE,ESIZEX(LN) JRST MAKEL1 MAKEL2: MOVEI TA,AS.MSC MOVEM TA,EBASEX(LN) JRST MAKL1B ;BUILD A SINGLE PARAMETER FROM "A" DATA. ;IF "A" IS SUBSCRIPTED, CALL SUBSCRIPT GENERATOR. ;IF "A" NOT SUBSCRIPTED, LEAVE PARAMETER IN %LIT. ;IF "SUBINP" IS -1, PUT BYTE POINTER IN SOME PLACE IT CAN BE MODIFIED. B1PAR: SKIPE IBPFLG## ;THIS BETTER BE 0 JRST E$IBP PUSHJ PP,SUBSCD TSWF FASUB ;IS "A" SUBSCRIPTED NOW? POPJ PP, ;YES--RETURN SKIPN SUBINP ;SKIP IF WE'RE SUPPOSED TO BE ABLE TO ; MODIFY IT JRST B1PARN ;NO, PUT IT IN %LIT ;PUT PARAMETER IN %PARAM (OR %TEMP IF A NON-RESIDENT SECTION) TSWF FAS3 ;ARE WE IN A NON-RESIDENT SECTION? JRST B1PAR7 ;YES, CAN'T USE %PARAM. ;PUT BASE PARAMETER IN %PARAM. PUSHJ PP,BYTE.A ;GET BYTE PTR TO "A" IN TA AND TB TLZ TA,7777 ;MAKE IT LOOK LIKE A PARAMETER MOVE CH,[XWD AS.XWD,1] PUSHJ PP,PUTAS1 MOVE CH,TA PUSHJ PP,PUTAS1 MOVE CH,TB PUSHJ PP,PUTAS1 HRRZ EACC,EAS1PC IORI EACC,AS.PAR ;RETURN AS.PAR AS ADDRESS AOS EAS1PC POPJ PP, ;HERE IF WE ARE IN A NON-RESIDENT SECTION.. BYTE POINTER MUST BE PUT ; INTO A TEMP. NOTE WE MUST USE A RUNTIME AC.. AC7 IS ASSUMED TO BE FREE ; AT THIS POINT. B1PAR7: MOVE TA,[BYTLIT,,2] PUSHJ PP,STASHP PUSHJ PP,MBYTPA PUSHJ PP,POOL SKIPN TE,PLITPC ;GET PTR TO LITERAL HRRZ TE,ELITPC IORI TE,AS.LIT SKIPN PLITPC AOS ELITPC ;UPDATE LITERAL PC MOVE CH,[MOV+AC7+ASINC,,AS.MSC] PUSHJ PP,PUTASY ;"MOVE AC7,LIT" MOVE CH,TE PUSHJ PP,PUTASN MOVEI TE,1 PUSHJ PP,GETEMP PUSH PP,EACC ;REMEMBER AS.TMP+N MOVE CH,[MOVEM.+AC7+ASINC,,AS.MSC] PUSHJ PP,PUTASY MOVE CH,-1(PP) PUSHJ PP,PUTASN POP PP,EACC ;SETUP EACC FOR RETURN POPJ PP, B1PARN: MOVE TA,[XWD XWDLIT,2] ;NO--PUT PARAMETER INTO %LIT PUSHJ PP,STASHP HLRZ TA,ERESA LSH TA,14 ADD TA,SUBCON HRLZS TA HRRI TA,AS.CNB PUSHJ PP,STASHQ MOVE TA,EBASEA HRL TA,EINCRA PUSHJ PP,POOLIT SKIPN EACC,PLITPC MOVE EACC,ELITPC SKIPN PLITPC AOS ELITPC IORI EACC,AS.LIT POPJ PP, ;ALTERNATE VERSION OF B1PAR ;SETUP BYTE PTR TO "A" IN AC5. NB1PAR:: MOVEI TE,5 MOVEM TE,SUSEAC## ;USE AC5 FOR SUBSCRIPTING SETOM IBPFLG## ;USING B.P. FOR ILDB OR EXTEND PUSHJ PP,SUBSCA ;DO SUBSCRIPTING IF NECESSARY TSWT FASUB ;CONSTANT OR NO SUBSCRIPTS? JRST NB1PR1 ;YES NB1PR2: SETZM SUSEAC## ;CLEAR "USE AC" FLAG SETZM IBPFLG## ;CLEAR INCASE SUBSCR NOT CALLED POPJ PP, ;RETURN NB1PR1: IFN BIS,< SKIPN USENBT ;USE LARGER BYTE OPT. ON? JRST NB1PR3 ;NO MOVE TA,NBYTES CAIE TA,4 ;FULL WORD BYTES? CAIN TA,6 JRST NB1PR2 ;YES--DON'T SETUP AC NB1PR3: >;END IFN BIS MOVE TA,[BYTLIT,,2] PUSHJ PP,STASHP PUSHJ PP,MBYTPA ;BYTE PTR TO "A" PUSHJ PP,POOL MOVSI CH,MOV+AC5 PUSHJ PP,PUT.LD SKIPN PLITPC AOS ELITPC JRST NB1PR2 ;LIKE NB1PAR, EXCEPT SETUP BYTE PTR TO "B" IN AC10 NBBPAR:: MOVEI TE,10 MOVEM TE,SUSEAC## SETOM IBPFLG## PUSHJ PP,SUBSCB TSWT FBSUB ;CONSTANT OR 0 SUBSCRIPTS? JRST NBBPR1 ;YES NBBPR2: SETZM SUSEAC## SETZM IBPFLG## POPJ PP, NBBPR1: IFN BIS,< SKIPN USENBT JRST NBBPR3 MOVE TE,NBYTES CAIE TE,4 CAIN TE,6 JRST NBBPR2 ;DON'T SETUP AC NBBPR3: >;END IFN BIS MOVE TA,[BYTLIT,,2] PUSHJ PP,STASHP PUSHJ PP,MBYTPB PUSHJ PP,POOL MOVSI CH,MOV+AC10 PUSHJ PP,PUT.LD SKIPN PLITPC AOS ELITPC JRST NBBPR2 ;SET UP TWO PARAMETERS (FOR MOVE OR IF). ;IF BOTH FIELDS ARE SUBSCRIPTED, PARAMETERS ARE PUT INTO %TEMP. ;IF ONLY ONE FIELD IS SUBSCRIPTED, PARAMETERS ARE PUT INTO %PARAM. ;IF NEITHER FIELD IS SUBSCRIPTED, PARAMETERS ARE PUT INTO %LIT. B2PAR: PUSHJ PP,SUBSCA ;SUBSCRIPT "A" IF NECESSARY TSWF FASUB ;IS IT SUBSCRIPTED NOW? JRST B2PAR3 ;YES PUSHJ PP,SUBSCC ;NO--SUBSCRIPT "B" IF NECESSARY TSWF FBSUB ;IS "B" SUBSCRIPTED? JRST B2PAR6 ;YES ;NEITHER IS SUBSCRIPTED PUSH PP,ELITPC ;[543] SAVE LITERAL PC NOW IFN ANS74,< SKIPN COLSCP## ;[1004] SPECIAL JRST B2PAR1 ;NO MOVE TA,[XWDLIT,,2] PUSHJ PP,STASHP MOVEI TA,AS.CNB ;LHS = 0 PUSHJ PP,STASHQ MOVE TA,EMODEA HRLZ TA,COLSQS##(TA) ;GET COLLATING SEQUENCE HRRI TA,AS.MSC PUSHJ PP,STASHQ AOS ELITPC B2PAR1:> MOVE TA,[XWD BYTLIT,2] PUSHJ PP,STASHP PUSHJ PP,BYTE.A EXCH TB,TA HLR TB,TA HRRZS TA PUSHJ PP,STASHQ MOVE TA,TB PUSHJ PP,STASHQ AOS ELITPC ;[543] MOVE TA,[XWD XWDLIT,2] PUSHJ PP,STASHP PUSHJ PP,BYTE.C TSWF FBSIGN; TLO TA,SYNBIT PUSHJ PP,STASHQ MOVE TA,TB PUSHJ PP,POOLIT POP PP,ELITPC ;[543] RESTORE INITIAL ELITPC SKIPN EACC,PLITPC MOVE EACC,ELITPC ;GET PC AT START OF THIS BUNCH OF LITS IORI EACC,AS.LIT ;SET UP TWO PARAMETERS (CONT'D). MOVEI TE,2 ;NORMAL NUMBER OF WORDS IFN ANS74,< SKIPE COLSCP ;[1004] SPECIAL COLL. SEQ.? ADDI TE,1 ;ONE MORE > SKIPN PLITPC ADDM TE,ELITPC ;GET LIT PC CORRECT POPJ PP, ;"A" IS SUBSCRIPTED B2PAR3: TSWT FAS3 ;ARE WE IN NON-RESIDENT SEGMENT? TSWF FBSUB ;NO--IS "B" ALSO SUBSCRIPTED? JRST B2PAR8 ;YES IFN ANS74,< SKIPE COLSCP ;[1004] [743] SPECIAL COL. SEQ.? PUSHJ PP,B2PR6C ;[743] YES > MOVE CH,[XWD AS.OCT,1] ;NO--USE IMPPAR PUSHJ PP,PUTAS1 HRRZI CH,0 PUSHJ PP,PUTAS1 MOVE CH,MOVSAC PUSHJ PP,PUTASY HRRZ CH,EAS1PC IORI CH,AS.PAR PUSHJ PP,PUTASN PUSHJ PP,BYTE.C TSWF FBSIGN; TLO TA,SYNBIT MOVE CH,[XWD AS.XWD,1] PUSHJ PP,PUTAS1 MOVE CH,TA PUSHJ PP,PUTAS1 MOVE CH,TB PUSHJ PP,PUTAS1 B2PAR4: MOVEI EACC,2 EXCH EACC,EAS1PC ADDM EACC,EAS1PC IFN ANS74,< SKIPE COLSCP ;[1004] [721] SPECIAL COL. SEQ.? SUBI EACC,1 ;[721] YES, ACCOUNT FOR EXTRA PARAM > IORI EACC,AS.PAR POPJ PP, ;SET UP PARAMETERS (CONT'D). ;"B" IS SUBSCRIPTED, "A" ISN'T B2PAR6: TSWF FAS3 ;ARE WE IN NON-RESIDENT SEGMENT? JRST B2PAR7 ;YES IFN ANS74,< SKIPE COLSCP ;[1004] [743] [721] SPECIAL COL. SEQ.? PUSHJ PP,B2PR6C ;[743] [721] YES > ;[743] [721] PUSHJ PP,BYTE.A MOVSI CH,AS.BYT HRR CH,TB PUSHJ PP,PUTAS1 MOVS CH,TB HLL CH,TA PUSHJ PP,PUTAS1 MOVE CH,[XWD AS.OCT,1] PUSHJ PP,PUTAS1 MOVEI CH,0 PUSHJ PP,PUTAS1 MOVE CH,MOVSAC PUSHJ PP,PUTASY HRRZ CH,EAS1PC ADDI CH,1 IORI CH,AS.PAR PUSHJ PP,PUTASN JRST B2PAR4 IFN ANS74,< B2PR6C: MOVE CH,[AS.XWD,,1] ;[743] [721] NEED EXTRA WORD FOR COL. SEQ. PUSHJ PP,PUTAS1 ;[721] PUT IN LOW SEQ DATA SETZ CH, ;[721] LHS = 0 PUSHJ PP,PUTAS1 ;[721] MOVE CH,EMODEA ;[721] HRLZ CH,COLSQS##(CH) ;[721] GET COLLATING SEQUENCE HRRI CH,AS.MSC ;[721] PUSHJ PP,PUTAS1 ;[721] AOS EAS1PC ;[721] ACCOUNT FOR EXTRA WORD POPJ PP, ;[743] > B2PAR7: MOVEI TE,2 IFN ANS74,< SKIPE COLSCP ;[1004] [721] SPECIAL COL. SEQ.? ADDI TE,1 ;[721] YES, NEED EXTRA WORD > PUSHJ PP,GETEMP IFN ANS74,< SKIPE COLSCP ;[1004] [721] SPECIAL COL. SEQ. CODE? AOS EACC ;[721] YES, LEAVE FIRST WORD FREE > PUSH PP,EACC MOVE CH,MOVSAC PUSHJ PP,PUTASY HRRZ CH,0(PP) ADDI CH,1 PUSHJ PP,PUTASN PUSHJ PP,B2PR9A MOVE CH,MOVSAC PUSHJ PP,PUTASY POP PP,CH IFN ANS74,< MOVE EACC,CH ;[721] INCASE COL. SEQ. JRST B2PR9B ;[721] SEE IF SPECIAL COL. SEQ.? > IFN ANS68,< JRST PUTASN ;[721] > ;SET UP TWO PARAMETERS (CONT'D). ;WE ARE GOING TO USE %TEMP TO HOLD PARAMETERS. ;EITHER BOTH ITEMS WERE SUBSCRIPTED, OR WE ARE IN NON-RESIDENT SEGMENT. B2PARD:: ;ENTER HERE TO FORCE PARAMS INTO TEMP FOR DEPENDENT MOVE PUSHJ PP,SUBSCA ;SUBSCRIPT "A" IF NECESSARY PUSHJ PP,SUBSCC ;DITTO "B" B2PAR8: MOVEI TE,2 IFN ANS74,< SKIPE COLSCP ;[1004] [721] SPECIAL COL. SEQ.? ADDI TE,1 ;[721] YES, NEED EXTRA WORD > PUSHJ PP,GETEMP IFN ANS74,< SKIPE COLSCP ;[1004] [721] SPECIAL COL. SEQ. CODE? AOS EACC ;[721] YES, LEAVE FIRST WORD FREE > PUSH PP,EACC ;SAVE ADDRESS TSWT FASUB ;IS "A" SUBSCRIPTED? PUSHJ PP,B2PR9A ;NO MOVE CH,MOVSAC PUSHJ PP,PUTASY HRRZ CH,(PP) PUSHJ PP,PUTASN PUSHJ PP,SUBSCC TSWF FBSUB ;"B" SUBSCRIPTED? JRST B2PAR9 ;YES MOVE TA,[XWD XWDLIT,2] PUSHJ PP,STASHP PUSHJ PP,BYTE.C TSWF FBSIGN TLO TA,SYNBIT PUSHJ PP,STASHQ MOVE TA,TB PUSHJ PP,POOLIT MOVSI CH,MOV+SAC PUSHJ PP,PUT.LD SKIPN PLITPC AOS ELITPC B2PAR9: MOVE CH,MOVSAC PUSHJ PP,PUTASY POP PP,EACC HRRZI CH,1(EACC) IFN ANS74,< B2PR9B: SKIPN COLSCP ;[1004] [721] SPECIAL COL. SEQ.? JRST PUTASN ;[721] NO SOS EACC ;[721] BACKUP TO FIRST WORD PUSH PP,EACC ;[721] SAVE AGAIN PUSHJ PP,PUTASN ;[721] SAVE SECOND SUBSCRIPT MOVE CH,[MOVEI.+AC12+ASINC,,AS.MSC] ;[721] PUSHJ PP,PUTASY ;[721] MOVE CH,EMODEA ;[721] HRRZ CH,COLSQS(CH) ;[721] GET COLLATING SEQUENCE PUSHJ PP,PUTASN ;[721] MOVE CH,MOVSAC ;[721] PUSHJ PP,PUTASY ;[721] POP PP,CH ;[721] POINT TO WORD 1 > JRST PUTASN B2PR9A: MOVE TA,[XWD BYTLIT,2] PUSHJ PP,STASHP PUSHJ PP,MBYTPA PUSHJ PP,POOL MOVSI CH,MOV+SAC PUSHJ PP,PUT.LD SKIPN PLITPC AOS ELITPC POPJ PP, ;SET UP TWO PARAMETERS, AND GET REAL BYTE POINTERS TO BOTH. ;THIS GENERATES CODE TO LEAVE AN ILDB BYTE PTR TO "A" IN AC5, BYTE ;POINTER TO "B" IN AC10 ; NOTE: IF USING FULL-WORD BYTES (4 OR 6 BYTES/BYTE), ONLY THE ;ADDRESS WILL BE PUT IN THE SUBSCRIPT AC, NOT A BYTE PTR. NB2PAR:: PUSHJ PP,EXMAB ;GET SUBSCRIPTS INTO TEMP LOCS IF NECESSARY TSWF FERROR ;ANY ERRORS? POPJ PP, ;YES, GIVE UP PUSHJ PP,NB1PAR ;GET BYTE PTR TO "A" IN AC5 PJRST NBBPAR ;BYTE PTR TO "B" IN AC10 IFN BIS,< ;ROUTINES TO SETUP BYTE PTRS FOR MOVE/COMPARE OF ONLY ONE BYTE. ; RETURNS TA= XWD , ;IF PTR POINTS TO AC, E.G. "5", BYTE PTR SHOULD BE INCREMENTED BEFORE ;USE. IF PTR POINTS TO %LIT00+N, BYTE PTR SHOULD BE ONLY "LDB'D" OR "DPB'D". PCXBP2:: PUSHJ PP,EXMAB ;MAKE SURE SUBSCRIPTS ARE IN %TEMP. PUSHJ PP,PCXBPA ;PUT PTR TO "A" IN LH (PCXPTR) TSWF FERROR ;ERRORS? JRST PCX2B ;YES PUSHJ PP,PCXBPB ;PUT PTR TO "B" IN RH (PCXPTR) TSWF FERROR ;ERRORS? PCX2B: SETZM PCXPTR## ;ERRORS - CLEAR PCXPTR POPJ PP, ;RETURN ;ROUTINE TO DO THE SAME FOR ONLY 1 PARAMETER PCXBP1:: PUSHJ PP,PCXBPA ;DO IT FOR "A" TSWF FERROR ;ERRORS? SETZM PCXPTR## ;YES, CLEAR POPJ PP, ;RETURN ;ROUTINE TO SETUP BYTE PTR TO "A", PUT IN LITAB IF NOT SUBSCRIPTED, ;AND RETURN PTR TO WHERE IT WILL BE IN LH (PCXPTR) PCXBPA: MOVEI TE,5 ;USE AC 5 FOR SUBSCRIPTING MOVEM TE,SUSEAC## SETOM IBPFLG## ;IGNORE SUBCON PUSHJ PP,SUBSCA TSWT FASUB JRST PCXC ;CONSTANT OR NO SUBSCRIPTS ;RETURN "5" AS PTR TO "A" PCXRT5: MOVEI TE,5 ;SUBSCRIPTING WAS DONE PCXRTA: HRLM TE,PCXPTR## ;RETURN PTR TO "A" PCXRTT: SETZM SUSEAC## SETZM IBPFLG## POPJ PP, PCXC: SKIPN USENBT## ;USING THE BIG BYTE OPTIMIZATION? JRST PCXC1 ;NO MOVE TE,NBYTES## ;YES CAIE TE,6 CAIN TE,4 ;4 OR 6 (36-BIT BYTES)? JRST PCXRT5 ;YES--DON'T SETUP AC PCXC1: MOVE TA,[XWD BYTLIT,2] ;PUT ANSWER IN LITAB PUSHJ PP,STASHP SETOM MAKBPB## ;TELL MBYTPA TO INCREMENT THE B.P. PUSHJ PP,MBYTPA PUSHJ PP,POOL SKIPN TE,PLITPC ;GET PTR TO LITERAL HRRZ TE,ELITPC IORI TE,AS.LIT SKIPN PLITPC ;DID WE POOL IT? AOS ELITPC ;NO, UPDATE LITERAL PC JRST PCXRTA ;STORE PTR TO "A" & RETURN ;SAME AS PCXBPA, EXCEPT FOR "B". USES AC 10 FOR SUBSCRIPTING PCXBPB: MOVEI TE,10 MOVEM TE,SUSEAC## SETOM IBPFLG## PUSHJ PP,SUBSCB TSWT FBSUB JRST PCXD ;CONSTANT OR NO SUBSCRIPTS ;RETURN "10" AS PTR TO "B" PCXR10: MOVEI TE,10 PCXRTB: HRRM TE,PCXPTR## ;RETURN PTR IN RH (PCXPTR) JRST PCXRTT ;RETURN PCXD: SKIPN USENBT## JRST PCXD1 MOVE TE,NBYTES## CAIE TE,6 CAIN TE,4 JRST PCXR10 ;DON'T SETUP AC10, RETURN PCXD1: MOVE TA,[XWD BYTLIT,2] PUSHJ PP,STASHP SETOM MAKBPB## PUSHJ PP,MBYTPB PUSHJ PP,POOL SKIPN TE,PLITPC HRRZ TE,ELITPC IORI TE,AS.LIT SKIPN PLITPC AOS ELITPC JRST PCXRTB ;RETURN PTR TO "B" ;GETNB -- ROUTINE TO CHECK FOR "LARGER BYTE" OPTIMIZATION. ; CALLED FROM MOVGEN & IFGEN. ; ;INPUTS: ; "A" & "B" SETUP BY SETOPN. ; NCHARS/ #CHARS TO MOVE OR COMPARE ; ;RETURNS: ; NBYTES/ MULTIPLE # OF BYTES TO USE, E.G., IF ; MODE IS SIXBIT AND NBYTES=2, USE 12 BIT BYTES. ; ; NOTE: THIS ROUTINE ONLY WORKS WHEN "A" AND "B" ARE ; DISPLAY ITEMS OF THE SAME MODE GETNB:: SKIPE USENBT## ;THIS SHOULD BE 0 AT THIS POINT JRST E$UNZ ;? INTERNAL COMPILER ERROR PUSHJ PP,DEPCKK ; ANY DEPENDING ITEMS? TRNA ;NO, OK JRST GOTAN1 ;"A" OR "B" HAS A DEPENDING ITEM - RETURN 1 SETOM ONLYEX## ;TELL SUBSCRIPT ROUTINE WE JUST WANT INFO, ;NO REAL SUBSCRIPT CODE GENERATED MOVEI DT,EBASEA ;POINT TO "A" MOVE TD,[FASUB] ;"A" SUBSCRIPT FLAG IN TD PUSHJ PP,GETNB1 ;HOW MANY BYTES/BYTE? PUSH PP,TA ;SAVE ANSWER FOR A MOVEI DT,EBASEB ;NOW DO THE SAME FOR B MOVE TD,[FBSUB] PUSHJ PP,GETNB1 POP PP,TC ;TC= "A" ANSWER, TA= "B" ANSWER ;USE EUCLID'S ALGORITHM TO FIND GREATEST COMMON DIVISOR CAMLE TA,TC ;GET TC= LARGER NUMBER EXCH TA,TC E1: IDIVI TC,(TA) ;GET TB= REMAINDER JUMPE TB,GOTNB ;IF 0, ANSWER=TA MOVE TC,TA MOVE TA,TB JRST E1 GOTNB: MOVE TC,NCHARS## ;GET # CHARS TO MOVE/COMPARE CAMLE TA,TC ;GET GREATEST COMMON DIVISOR AGAIN EXCH TA,TC E1AGEN: IDIVI TC,(TA) JUMPE TB,GOTANS MOVE TC,TA MOVE TA,TB JRST E1AGEN GOTAN1: MOVEI TA,1 ;RETURN 1 IF CAN'T DO IT GOTANS: MOVEM TA,NBYTES## ;SAVE # TO USE SETZM ONLYEX## ;CLEAR FLAG FOR SUBSCR POPJ PP, ;RETURN ;ROUTINE TO LOOK AT OPERAND POINTED TO BY DT, WITH CUREOP ;POINTING TO THE ITEM, AND FIGURE OUT HOW MANY BYTES WE CAN ;LDB AT ONCE (INDEPENDENT OF HOW MANY CHARS TO MOVE). ;RETURNS TA= MAX # BYTES. GETNB1: TDCN SW,TD ;IS IT SUBSCRIPTED? JRST NOTSB ;NO PUSH PP,TD ;SAVE FLAG SETOM IBPFLG## ;GENERATE A BYTE PTR! CAIN DT,EBASEB ;POINTING TO B? SKIPA TE,OPERND HLRZ TE,OPERND HRRZM TE,CUREOP ;SETUP CUREOP PUSH PP,DT ;SAVE PTR TO A OR B CAIN DT,EBASEA ;SETUP PTR THE WAY SUBSCR LIKES IT SKIPA DT,[ESAVES] MOVEI DT,ESAVSB ;. . PUSHJ PP,SUBSCR JRST NOTSBA ;LITERAL SUBSCRIPTS OR ERRORS POP PP,DT POP PP,TD TDO SW,TD ;REMEMBER IT IS SUBSCRIPTED ;RETURN GCD OF NUMBER RETURNED BY GETNBS AND S1SIZ PUSHJ PP,GETNBS ;# BYTES BASED ON BYTE RESIDUE MOVE TC,S1SIZ## ;TC= SIZE OF ELEMENTARY ITEM CAMLE TA,TC EXCH TA,TC ;GET TC=LARGER NUMBER GETNLP: IDIVI TC,(TA) JUMPE TB,CPOPJ ;ANSWER= TA MOVE TC,TA MOVE TA,TB JRST GETNLP ;LOOP ;HERE IF THE ITEM WAS NOT SUBSCRIPTED (OR LITERAL SUBSCRIPTS) NOTSBA: POP PP,DT POP PP,TD TSWF FERROR ;ERRORS? POPJ PP, ;YES. RETURN IMMEDIATELY HRRZM TE,EINCRX(DT) LSH TE,-14 HLLM TE,ERESX(DT) NOTSB: TDZ SW,TD ;CLEAR SUBSCRIPT FLAG PJRST GETNBS ;RETURN TA= # BYTES TO USE ;ROUTINE TO GET # BYTES/BYTE TO USE, DEPENDING ON BYTE RESIDUE ONLY ;RETURNS ANSWER IN TA GETNBS: HLRZ TB,ERESX(DT) ;GET BYTE RESIDUE SKIPN TB ;0? (END-OF-WORD) MOVEI TB,^D36 ;YES, SAME AS 36 MOVE TD,EMODEX(DT) ;GET MODE IDIV TB,[ EXP 6 EXP 7 EXP 9](TD) ;CONVERT BIT RESIDUE TO # BYTES MOVE TE,[ EXP NB6TBL EXP NB7TBL EXP NB9TBL](TD) ;GET TABLE TO USE HRLI TE,(POINT 6) ;POINT TO IT MOVEI TC,6 SUB TC,TB IMULI TC,6 ;GET BYTE RESIDUE IN "TABLE" DPB TC,[POINT 6,TE,5] ;MAKE TE POINT TO ANSWER LDB TA,TE ;PUT IT IN TA POPJ PP, ;AND RETURN ;1-WORD "TABLES" FOR GETNBS NB6TBL: BYTE(6) 1,2,3,2,1,6 NB7TBL: BYTE(6) 1,1,1,1,5,0 NB9TBL: BYTE(6) 1,2,1,4,0,0 >;END IFN BIS ;GENERATE SUBSCRIPT CALL FOR "A" SUBSCA: TSWT FASUB ;IS IT SUBSCRIPTED? POPJ PP, ;NO--NO ACTION HRRZ TE,EMODEA CAIN TE,C3MODE ;IS IT COMP-3? MOVEI TE,D9MODE ;YES, WE WILL USE 9 BIT BYTES THEN. CAILE TE,DSMODE TDCA TE,TE MOVE TE,BYTE.S(TE) LSH TE,6 MOVEM TE,SUBCON SBSCA1: MOVEI DT,ESAVES HLRZ TE,OPERND MOVEM TE,CUREOP PUSHJ PP,SUBSCR SWOFFS FASUB ;LITERAL SUBSCRIPTS POPJ PP, ;NON-LITERAL SUBSCRIPTS HRRZM TE,EINCRA LSH TE,-14 HLLM TE,ERESA POPJ PP, ;GENERATE SUBSCRIPT CALL FOR "B" SUBSCB: TSWT FBSUB; POPJ PP, HRRZ TE,EMODEB CAIN TE,C3MODE ;IF IT'S COMP-3, MOVEI TE,D9MODE ;PRETEND IT'S EBCDIC. CAILE TE,DSMODE TDCA TE,TE MOVE TE,BYTE.S(TE) LSH TE,6 SUBSB0: MOVEM TE,SUBCON SUBSB1: MOVEI DT,ESAVSB HRRZ TE,OPERND MOVEM TE,CUREOP PUSHJ PP,SUBSCR SWOFFS FBSUB ;LITERAL SUBSCRIPTS POPJ PP, ;NON-LITERAL SUBSCRIPTS HRRZM TE,EINCRB LSH TE,-14 HLLM TE,ERESB POPJ PP, ;GENERATE SUBSCRIPT CALL FOR "B", WITH SIZE IN SUBCON SUBSCC: TSWT FBSUB ;IS IT SUBSCRIPTED? POPJ PP, ;NO HRRZ TE,ESIZEB TSWF FBSIGN; IORI TE,SYNBIT JRST SUBSB0 ;GENERATE SUBSCRIPT CALL FOR "A", WITH "ESIZEZ" IN SUBCON. SUBSCD: HRRZ TE,ESIZEZ TSWF FASIGN; IORI TE,SYNBIT MOVEM TE,SUBCON TSWT FASUB; POPJ PP, JRST SBSCA1 ;GENERATE SUBSCRIPT CALL FOR "B", ASSUMING "SUBCON" IS SET UP SUBSCE: TSWT FBSUB ;IS "B" SUBSCRIPTED? POPJ PP, ;NO JRST SUBSB1 ;YES ;ROUTINE TO MAKE SURE THAT SUBSCRIPTS TO "A" AND "B" ARE ;PUT IN TEMP LOCATIONS BEFORE THE ACTUAL SUBSCRIPT CODE IS ;GENERATED. THIS ALLOWS THE LIBOL CONVERSION ROUTINES TO ;USE ALL AC'S WITHOUT FEAR OF SMASHING SOMETHING. EXMAB:: SETOM ONLYEX## ;"ONLY EXAMINE" FLAG SETOM IBPFLG## ; BYTE PTR BEING GENERATED PUSHJ PP,SUBSCA ; FOR "A" SETOM IBPFLG## PUSHJ PP,SUBSCB ; FOR "B" SETZM ONLYEX## ;DONE WITH THIS SETZM IBPFLG## POPJ PP, ;RETURN SUBTTL SUBSCR - GENERATE CODE FOR SUBSCRIPTING ;ENTER WITH "CUREOP" POINTING TO THE ITEM, A CONSTANT IN "SUBCON", ; AND "DT" POINTING TO EITHER ESAVES (FOR A), OR ESAVSB (FOR B). ;EXIT TO CALL+1 IF ALL SUBSCRIPTS ARE LITERALS, OR IF ERRORS FOUND ; WITH "TE" CONTAINING THE BYTE POINTER. ;EXIT TO CALL+2 IF NOT ALL SUBSCRIPTS WERE LITERALS, AFTER GENERATING CODE. ; ; IF "ONLYEX" IS -1, JUST CALL "EXMSUB" TO GEN CODE TO PUT SUBSCRIPTS ;INTO %TEMP, DON'T GENERATE ANY OTHER SUBSCRIPT CODE, AND RETURN S1SIZ= ;SIZE OF BASE ITEM. ON EXIT, "ONLYEX" WILL STILL BE -1. ; ; IF "ALSTMP" IS -1, PUT ALL SUBSCRIPTS IN %TEMP, EVEN COMP ONES. ;THIS FLAG SHOULD ONLY BE SET IN CONJUNCTION WITH "ONLYEX". ON ;EXIT, "ALSTMP" WILL STILL BE -1. ; ; IF "IBPFLG" IS -1, A BYTE PTR WILL BE GENERATED, AND "SUBCON" ;WILL BE IGNORED. THIS FLAG SHOULD ONLY BE SET IF THE BYTE PTR WILL ;BE USED FOR AN "EXTEND", "ILDB", OR "IDPB". ON EXIT, "IBPFLG" IS SET TO 0. ; ; [ANS74] IF DEBUGGING ON THIS DATA ITEM, ON ENTRY: ;1) EDEBDA (EDEBDB) WILL BE NON-ZERO (THE BASE DATA ITEM) ;2) EDEBPA (EDEBPB) WILL POINT TO THE %PARAM BLOCK TO STORE ; THE SUBSCRIPT INDICES. ; ; IN THIS CASE, CODE WILL BE GENERATED TO STORE THE SUBSCRIPT ; VALUES IN %PARAM THRU %PARAM+2, AND THE BASE ITEM POINTER ; IN %PARAM+3. SUBSCR: MOVEM SW,ESAVSW SWOFF FASUB!FBSUB!FALWY0; MOVEM DT,ESAVDT MOVE TE,[XWD EBASEA,ESAVES] ;SAVE "A" AND "B" PARAMS BLT TE,ESAVSX MOVE TC,CUREOP ;SAVE CUREOP MOVEM TC,ESAVOP MOVSI TE,(LKSFLG) ;GET OPERAND'S L.S. FLAG AND TE,(TC) MOVEM TE,ELNKSF## ;REMEMBER SETTING MOVE TE,1(TC) ;ANY SUBSCRIPTS WAITING? LDB TE,TESUBC SKIPN ELNKSF ;LINKAGE SECTION ARGUMENT? JUMPE TE,BADSB3 ;NO -- ERROR MOVEM TE,ENOCC2 ;YES -- SAVE COUNT IFN ANS74,< ; IF DEBUGGING THIS ITEM, PUT ADDR OF %PARAM BLOCK IN "SUBPBL". ; ELSE CLEAR IT. CAIN DT,ESAVES ;IS THIS "A" JRST SDEBA ;YES ;CHECK FOR DEBUGGING "B" ITEM SKIPN EDEBDB ;ARE WE DEBUGGING ON "B"? JRST SDEBNO ;NO MOVE TE,EDEBPB## ;GET %PARAM ADDR MOVEM TE,SUBPBL## ;SAVE IT JRST SDEBDN ;DONE ;CHECK FOR DEBUGGING "A" ITEM SDEBA: SKIPN EDEBDA ;ARE WE DEBUGGGING ON "A"? JRST SDEBNO ;NO MOVE TE,EDEBPA## ;GET %PARAM ADDR MOVEM TE,SUBPBL## ;SAVE IT TRNA ;SKIP SDEBNO: SETZM SUBPBL## ;NO DEBUGGING--CLEAR ITEM SDEBDN: >;END IFN ANS74 PUSHJ PP,EXMSUB ;LOOK AT THE SUBSCRIPTS JRST SUBS20 ;THEY ARE ALL LITERALS SUBSC0: TSWF FERROR ;ANY ERRORS? JRST SUBS10 ;YES -- QUIT AOS (PP) ;EXIT WILL BE TO CALL+2 MOVE TC,ESAVOP ;RESET CUREOP MOVEM TC,CUREOP MOVEM TC,HLDEOP## ;SAVE PTR FOR SUBS15 SETZM ENOCC1 ;CLEAR COUNTER ;GENERATE CODING FOR SUBSCRIPT (CONT'D). MOVE DT,ESAVDT JRST SILGO ; GENERATE INLINE CODE SUBS10: MOVE TA,[XWD ESAVES,EBASEA];RESTORE "A" AND "B" BLT TA,EBASBX MOVE TA,ESAVOP ;RESET CUREOP MOVEM TA,CUREOP SETZM IBPFLG## ;RESET "BP WILL BE INCREMENTED" FLAG TSWT FERROR ; [330]ANY ERRORS? JRST SUBS11 ; [330] NO-GO ON MOVSI TE,(FFATAL) ; [330] MAKE SURE THAT FFATAL IORM TE,ESAVSW ; [330] FLAG STAYS ON MOVEI TE,0 ;[330] NOW -- RETURN 0 SUBS11: MOVE SW,ESAVSW ; [330] GET BACK SAVED SW- ;WITH FFATAL FLAG ON IF SET BY SUBSCR. ERROR POPJ PP, ;ALL SUBSCRIPTS WERE NUMERIC LITERALS -- GENERATE INCREMENT SUBS20: SETZM EREMAN SETZM ENOCC1 MOVE TC,ESAVOP MOVEM TC,CUREOP MOVE DT,ESAVDT HLRZ TE,ERESX(DT) ROT TE,-6 HRRZ TD,EMODEX(DT) PUSHJ PP,SUBSCK ;IF COMP, GET GRANDFATHER'S USAGE TSWF FERROR ;IF ERRORS, POPJ PP, ;GIVE UP CAILE TD,DSMODE ;[610] IS TOP LEVEL DISPLAY? MOVEI TD,D6MODE ;[610] NO, PRETEND DISPLAY-6 ;[610] (SO "COMP" WILL WORK RIGHT) MOVEM TD,ESAVMD## ;[306] SAVE MODE OF FATHER FOR LATER CHECKING. MOVE TD,BYTE.S(TD) ;BITS/BYTE SKIPE USENBT## ;USE LARGER BYTES? IMUL TD,NBYTES## ;YES DPB TD,[POINT 6,TE,11] ;STORE BYTE SIZE IN BYTE PTR HRR TE,EINCRX(DT) MOVEM TE,EWORDB MOVE TC,CUREOP MOVE TA,1(TC) PUSHJ PP,LNKSET LDB TE,DA.OCC ;IS THERE AN OCCURS AT THIS LEVEL? JUMPN TE,SUBS21 ;YES, IF JUMP LDB TA,DA.OCH ;NO--BACK UP ONE LEVEL PUSHJ PP,LNKSET ;GET IT'S ADDRESS SUBS21: HRRZM TA,CURDAT ;SAVE ADDRESS OF ITEM LDB TE,DA.DEP ;ANY 'DEPENDING' ITEM? JUMPN TE,SUBSC0 ;YES--WE HAVE TO CALL SUBSCRIPT UUO LDB TE,DA.NOC ;GET NUMBER OF OCCURENCES MOVEM TE,ESMAX ;SAVE IT MOVEI TC,2 ;KICK UP TO NEXT SUBSCRIPT ADDB TC,CUREOP MOVEI LN,EBASEA ;SET UP "A" TO BE SUBSCRIPT PUSHJ PP,SETOPN PUSHJ PP,CONVNL ;GET VALUE JUMPN TD,BADLSB ;> 10**10? SKIPN EDPLA ;NO -- ANY DECIMAL PLACES? TSWF FLNEG ;NO -- NEGATIVE? JRST BADLSB ;YES -- TOUGH CAMLE TC,ESMAX ;LARGER THAN MAXIMUM? JRST BADSB6 ;YES -- ERROR SOJL TC,BADLSB ;NO -- DECREMENT AND IF IT WAS ZERO, ERROR PUSH PP,TC MOVE TA,CURDAT ;GET BACK TO OCCURENCE ITEM LDB TC,DA.USG ;GET SIZE IN BYTES XCT SUBSIZ(TC) POP PP,TC ;GET LITERAL VALUE BACK IMUL TE,TC ;MULTIPLY BY ADDM TE,EREMAN ;ADD TO SUM IFN ANS74,< ; IF DEBUGGING ON THIS ITEM, GENERATE CODE TO STORE THE SUBSCRIPT VALUE ; IN THE %PARAM BLOCK. SKIPN SUBPBL ;SKIP IF DEBUGGING JRST SUBS23 ;NO ;GENERATE MOVEI AC,VALUE ; MOVEM AC,%PARAM + SUBSCR# - 1 ADDI TC,1 ;GET REAL VALUE SKIPN TE,SUSEAC ;GET AC TO USE MOVEI TE,SXR ;(DEFAULT) CAILE TC,77777 ;SKIP IF VALUE SMALL SKIPA CH,[MOVEI.+ASINC,,AS.CNB] MOVSI CH,MOVEI. DPB TE,CHAC ;STORE AC FIELD CAILE TC,77777 ;SKIP IF SMALL JRST [PUSH PP,TC ;SAVE CONST. PUSHJ PP,PUTASY ;GEN FIRST PART POP PP,CH ;GET CONST. BACK PUSHJ PP,PUTASN ;GEN LAST PART JRST SUBS2B] ;NOW GEN THE MOVEM HRR CH,TC ;PUT IN INSTRUCTION PUSHJ PP,PUTASY ;GENERATE IT SUBS2B: MOVE CH,[MOVEM.+ASINC,,AS.MSC] ;GET START OF "MOVEM" SKIPN TE,SUSEAC ;PUT AC VALUE IN MOVEI TE,SXR ;(DEFAULT AC) DPB TE,CHAC PUSHJ PP,PUTASY ;GEN FIRST PART MOVE CH,SUBPBL ;GET %PARAM BASE HRRZ TE,SUBNUM ;GET TOTAL # SUBSCRIPTS SUB TE,ENOCC1 ; - THIS ONE SUBI TE,1 ; (BECAUSE THEY COUNT FROM 0) ADD CH,TE ;GET %PARAM OFFSET TO USE PUSHJ PP,PUTASN ;GEN THE INSTRUCTION >;END IFN ANS74 SUBS23: AOS TE,ENOCC1 ;KICK UP COUNT MOVE TA,CURDAT LDB TA,DA.OCH ;BACK UP TO PREVIOUS LEVEL CAML TE,ENOCC2 ;DONE? JRST SUBS24 ;YES JUMPE TA,SUBS25 ;NO -- ANY LEVELS LEFT? PUSHJ PP,LNKSET ;YES -- GET NEXT LEVEL'S ADDRESS JRST SUBS21 ;LOOP SUBS24: JUMPE TA,SUBS26 ;NO SUBSCRIPTS LEFT--ANY LEVELS LEFT? SUBS25: PUSHJ PP,NOTNUF ;YES -- ERROR SUBS26: MOVE TD,EREMAN ;GET COMPUTED OFFSET LDB TE,[POINT 6,EWORDB,11];COMPUTE BYTES/WORD MOVEI TB,^D36 IDIV TB,TE IDIV TD,TB ;COMPUTE NUMBER OF WORDS MOVE TE,EWORDB ;GET POINTER TO (1,...,1) BACK ADD TE,TD ;PUT #WORDS IN RH SUBS27: SOJL TC,SUBS28 ;ANY BYTES LEFT OVER? IBP TE ;YES -- BUMP POINTER JRST SUBS27 ;LOOP SUBS28: SKIPE IBPFLG## ;WANT A BYTE PTR TO INCREMENT? JRST SUBS29 ;YES, NO "SUBCON" MOVE TD,SUBCON DPB TD,[POINT 12,TE,17] IFN ANS68, JRST SUBS30 SUBS29: TLNE TE,760000 ;MAKE "POINT 36,BLAH" OR "POINT 35,BLAH" JRST SUBS30 ;IF NECESSARY TLZ TE,770000 ADD TE,[440000,,1] JRST SUBS30 IFN ANS74,< ;SUBS30: CHECK FOR DEBUGGING, IF SO, ; GEN CODE TO STORE BASE POINTER, AND CLEAR LAST SUBSCRIPT ; JRST'S TO SUBS10 WHEN DONE SUBS30: SKIPN SUBPBL ;SKIP IF DEBUGGING JRST SUBS10 ;NO, JUST GO TO SUBS10 PUSH PP,TE ;SAVE TE ;WE WILL GET THE FINAL BYTE PTR IN SUSEAC MOVE TA,[BYTLIT,,2] PUSHJ PP,STASHP HRRZ TA,EBASEX(DT) ;GET BASE ITEM PUSHJ PP,STASHQ MOVE TA,(PP) ;GET REST OF B.P. PUSHJ PP,POOLIT ;FINISH UP HRRZ TE,ELITPC ;LITERAL PC SKIPN PLITPC ;SKIP IF WE POOLED AOSA ELITPC ;NO, BUMP LITERAL PC HRRZ TE,PLITPC ;GET PC TO USE MOVE CH,[MOV+ASINC,,AS.MSC] SKIPN TD,SUSEAC MOVEI TD,SXR ;DEFAULT AC DPB TD,CHAC ;PUT IN INSTRUCTION PUSH PP,TE ;SAVE LIT PC FOR A SEC.. PUSHJ PP,PUTASY ;GEN FIRST PART POP PP,CH ;RESTORE LIT PC IORI CH,AS.LIT PUSHJ PP,PUTASN ;GEN REST OF INSTRUCTION ;GEN "MOVEM AC,%PARAM + MAXSUB" MOVE CH,[MOVEM.+ASINC,,AS.MSC] SKIPN TD,SUSEAC MOVEI TD,SXR DPB TD,CHAC PUSHJ PP,PUTASY ;FIRST PART OF INSTRUCTION HRRZ CH,SUBPBL ;%PARAM BASE ADDI CH,MAXSUB ;+ MAX # SUBSCRIPTS PUSHJ PP,PUTASN ;LAST PART OF INSTRUCTION ;GEN CODE TO CLEAR LAST SUBSCRIPT VALUE (IF NECESSARY) PUSHJ PP,DBCLRL ;CLEAR LAST SUBSCRIPT IF NECESSARY POP PP,TE ;RESTORE TE JRST SUBS10 ;DONE, RETURN ;ROUTINE TO GENERATE THE SETZM TO CLEAR LAST SUBSCRIPT ;CALL: SUBNUM/ TOTAL # OF SUBSCRIPTS THIS DATA ITEM HAS ; MAXSUB = MAX NUMBER OF SUBSCRIPTS THIS COMPILER ALLOWS ; SUBPBL/ %PARAM BASE FOR "DEBUGGING ITEM" ; ; PUSHJ PP,DBCLRL ; ;ALL ACS SMASHED DBCLRL: MOVE TE,SUBNUM ;GET # OF SUBSCRIPTS SEEN CAIL TE,MAXSUB ; LESS THAN MAX? POPJ PP, ;NO, DON'T GENERATE ANY CODE MOVE CH,[SETZM.+ASINC,,AS.MSC] PUSHJ PP,PUTASY ;YES, GENERATE SETZM HRRZ CH,SUBPBL ;GET %PARAM BASE ADD CH,SUBNUM ; LAST SUBSCRIPT+1 JRST PUTASN ;FINISH INSTRUCTION AND POPJ >;END IFN ANS74 NOTNUF: HRRZ TC,ESAVOP ;GET BACK EOP PTR TO MAIN ITEM MOVEM TC,CUREOP MOVEI DW,E.250 NOTNF1: SWON FERROR JRST OPNFAT BADLSB: MOVEI DW,E.251 JRST BADSB7 BADSB4: SKIPA DW,[E.264] ;[661] ?MUST REPRESENT AN INTEGER BADSB1: MOVEI DW,E.251 BADSB2: PUSHJ PP,NOTNF1 JRST EXMS9 ;LINKAGE SUBSCRIPT ERROR BADLS2: MOVEI TC,2 ;SKIP OVER THE ADDITIVE ADDM TC,CUREOP AOS ENOCC1 ; (ACCOUNT FOR THE ADDITIVE) BADLS1: MOVEI DW,E.598 ;?MUST BE USAGE COMP, FEWER THAN 11 ; DIGITS, AND NOT HAVE AN ADDITIVE JRST BADSB2 ;COMPLAIN, THEN GO ON TO NEXT SUBSCRIPT ;NO SUBSCRIPTS WHEN THERE SHOULD BE BADSB3: MOVEI DW,E.274 PUSHJ PP,NOTNF1 JRST SUBS10 BADSB6: MOVEI DW,E.252 BADSB7: PUSHJ PP,NOTNF1 JRST SUBS23 BADSB8: POP PP,DW ;REMOVE ONE FROM STACK MOVEI DW,E.251 PUSHJ PP,NOTNF1 JRST EXMS8A ;A TABLE WHICH DETERMINES SIZE OF ITEM (ALWAYS IN BYTES) SUBSIZ: PUSHJ PP,BADBAD ;0 PUSHJ PP,SUBSZX ;1 SIXBIT PUSHJ PP,SUBSZX ;2 ASCII PUSHJ PP,SUBSZX ;3 EBCDIC PUSHJ PP,SUBSZ1 ; [306] 4 1-WORD COMP PUSHJ PP,SUBSZ2 ; [306] 5 2-WORD COMP PUSHJ PP,SUBSZ1 ; [306] 6 COMP-1 PUSHJ PP,SUBSZ1 ; [306] 7 INDEX PUSHJ PP,SUBSZ3 ; 10 COMP-3. BADBAD: OUTSTR [ASCIZ "Compiler error--bad usage at SUBSIZ "] JRST KILL SUBSZX: LDB TE,DA.EXS SBSZX1: LDB TD,DA.SYL JUMPN TD,SUBSZY LDB TD,DA.SYR JUMPN TD,SUBSZY LDB TD,DA.SLL ;SYNC AT LOWER LEVEL? JUMPE TD,CPOPJ ;NO SUBSZY: IDIV TE,BYTE.W-1(TC) SKIPE TD ADDI TE,1 IMUL TE,BYTE.W-1(TC) POPJ PP, ;CHECK FATHER OF BINARY ITEMS TO SEE IF ASCII OR SIXBIT ; LEAVE USAGE IN TD SUBSCK: CAIN TD,C3MODE ;IF IT'S COMP-3, HIS FATHER SKIPA TD,[EXP D9MODE] ; MUST BE EBCDIC, IF HE EXISTS. CAIG TD,DSMODE ;[716] [161] SKIP IF USAGE IS BINARY POPJ PP, ;[161]; ELSE RETURN PUSH PP,TE ;SAVE AC'S HRRZ TA,ERESX(DT) PUSHJ PP,LNKFA## LDB TD,DA.USG POP PP,TE SOJA TD,CPOPJ ; MAKE SURE OCCURS SIZE WILL BE IN ACCORDANCE WITH MODE OF FATHER SUBSZ1: MOVE TD,ESAVMD ; [306] GET MODE OF FATHER MOVEI TE,6 ; [306] SIX CHAR/WORD IF SIXBIT CAIN TD,D7MODE ; [306] IF ASCII MOVEI TE,5 ; [306] FIVE CHAR/ WORD CAIN TD,D9MODE ;IF EBCDIC, MOVEI TE,4 ; 4 CHARS/WORD. POPJ PP, ; [306] SUBSZ2: PUSHJ PP,SUBSZ1 ;GET BYTES PER WORD. LSH TE,1 ;DOUBLE IT. POPJ PP, ;RETURN. SUBSZ3: LDB TE,DA.EXS## ;GET THE ITEM'S SIZE. ADDI TE,2 ;CONVERT IT TO NINE BIT BYTES. LSH TE,-1 MOVEI TC,%US.EB ;PRETEND IT'S EBCDIC. JRST SBSZX1 ;GO SEE IF IT'S JUSTIFIED. ;HERE TO DO INLINE SUBSCRIPTING GENERATION ;CALL: ; SUBNUM/ # OF SUBSCRIPTS (SET BY EXMSUB) ; JRST SILGO ; SILGO: SKIPE ONLYEX## ;ONLY EXAMINE? JRST RETSIZ ;YES, RETURN SIZE OF ITEM HRRZ TD,EMODEX(DT) ;MODE OF ITEM CAILE TD,DSMODE ;DISPLAY? CAIN TD,C3MODE ;OR COMP-3? CAIA ;YES, NEED BYTE PTR JRST SILGOB ;SKIP ;GET BYTE PTR TO (1,...,1) ELEMENT IF NEEDED HRRZ TD,EMODEX(DT) ;GET USAGE CAIN TD,C3MODE MOVEI TD,D9MODE ;CHANGE COMP-3 TO DISPLAY-9 MODE MOVEM TD,SSMODE## PUSHJ PP,SUBSCK ;CHECK FATHER OF COMP ITEMS TSWF FERROR ;ERRORS? POPJ PP, ;YES, GO AWAY MOVEM TD,ESAVMD## ;SAVE IT MOVE TD,BYTE.S(TD) ;GET # BITS/BYTE IFN BIS,< SKIPE USENBT## ;USE LARGER BYTES? IMUL TD,NBYTES## ;YES -- TD= # BITS IN BYTE CAIN TD,^D36 ;36 BITS/BYTE? JRST SILGOC ;YES, NO BYTE PTR GENERATED THEN >;END IFN BIS PUSH PP,TD ;SAVE # BITS/BYTE MOVE TA,[XWD BYTLIT,2] PUSHJ PP,STASHP HRRZ TA,EBASEX(DT) ;ADDRESS PORTION PUSHJ PP,STASHQ HLRZ TE,ERESX(DT) ROT TE,-6 ;SHIFT BYTE RESIDUE INTO LEFTMOST 6 BITS POP PP,TD ;GET # BITS/BYTE DPB TD,[POINT 6,TE,11] ;STORE IN BYTE PTR. HLLZ TA,TE HRR TA,EINCRX(DT) PUSHJ PP,POOLIT JRST SUBSIL ;CONTINUE SILGOB: MOVEM TD,SSMODE## ;MODE OF BASE ITEM PUSHJ PP,SUBSCK ;FATHER'S MODE TSWF FERROR ;[643] ERRORS? POPJ PP, ;[643] YES, GIVE UP MOVEM TD,ESAVMD## ; HERE WHEN SSMODE AND ESAVMD HAVE BEEN STORED, AND NO BYTE POINTER ;WAS GENERATED. STORE THE ADDRESS OF THE (1,...,1) ITEM IN "BASITM". SILGOC: HRRZ TE,EBASEX(DT) HRL TE,EINCRX(DT) MOVEM TE,BASITM## ;SAVE INFO OF BASE ITEM SUBSIL: MOVE TE,SUBNUM## ;TE:= # SUBSCRIPTS LEFT SKIPE ELNKSF## ;LINKAGE SECTION? JRST SILLNK ;YES, MAY BE 0 SUBSCRIPTS SUBSLA: SETZM ZEROSB## ;NOT 0 SUBSCRIPTS CAIL TE,1 ;REASONABLE #? CAILE TE,MAXSUB ; (BETWEEN 1 AND MAXSUB) JRST E$WNS ;?INTERNAL COMPILER ERROR MOVEI TE,1 ;START WITH 1ST SUBSCRIPT MOVEM TE,SUBNM1## JRST SETEAC SILLNK: JUMPN TE,SUBSLA SETOM ZEROSB## ;THERE ARE 0 SUBSCRIPTS ;... ;SET GENERATED AC TO DESIRED DESTINATION AC FOR BYTE PTR ; CODE GENERATED WILL USE AC THRU AC+2 FOR CALCULATIONS. SETEAC: PUSH PP,EAC SKIPN TE,SUSEAC## ;SHOULD I LEAVE BYTE PTR IN SOME AC? MOVEI TE,SXR ;NO, USE DEFAULT MOVEM TE,EAC SKIPE ZEROSB## ;ZERO SUBSCRIPTS? JRST SILZRO ;YES MOVE TA,CUREOP MOVE TA,1(TA) PUSHJ PP,LNKSET LDB TE,DA.OCC ;OCCURS AT THIS LEVEL? JUMPN TE,SUBS74 ;[745] YES, GO CHECK FOR CONVERSION LDB TA,DA.OCH ;NO, BACK UP ONE LEVEL PUSHJ PP,LNKSET ;[753] MOVED LINE TO SUBSI1+1 IFN ANS74,< ;[745] ;[745] IF ANY SUBSCRIPTS HAVE DEPENDING VARIABLES THAT REQUIRE ;[745] CONVERSION TO COMP, GENERATE THE CODE NOW SO THE SUBSCRIPT ;[745] ACS DON'T GET SMASHED IN THE MIDDLE OF THE COMPUTATION SUBS74: HRRZM TA,CURDAT ;[745] SAVE CURRENT DATA ITEM SUBS75: LDB CH,DA.DCR ;[745] CONVERSION REQUIRED? JUMPE CH,NOCNVT ;[745] NO IORI CH,AS.TAG ;[745] YES, CALL ROUTINE HRLI CH,EPJPP ;[745] "PUSHJ PP," MOVE TE,ESAVDT ;ARE WE SUBSCRIPTING "B"? CAIE TE,ESAVSB ;... JRST SUBS78 ;NO, MUST BE "A" PUSH PP,CH ;ITS "B", SAVE CURRENT INST. PUSHJ PP,PUTASA ;WE MUST PRESERVE AC5 FOR "A" MOVE CH,[PUSH.+AC17,,5] PUSHJ PP,PUTASY ; SINCE CONVERSION ROUTINE MIGHT DESTROY IT POP PP,CH PUSHJ PP,PUTASY ;GENERATE CONVERSION INST. PUSHJ PP,PUTASA MOVE CH,[POP.+AC17,,5] ;RESTORE AC5 SUBS78: PUSHJ PP,PUTASY ;[745] JRST SUBS76 ;[745] DONE NOW NOCNVT: LDB TA,DA.OCH ;[745] CHECK ALL LEVELS JUMPE TA,SUBS76 ;[745] NO MORE, DONE PUSHJ PP,LNKSET ;[745] JRST SUBS75 ;[745] LOOP FOR ALL SUBSCRIPT LEVELS SUBS76: HRRZ TA,CURDAT ;[745] RESTORE TA >;[745] END IFN ANS74 ; HERE TO GEN CODE FOR NEXT SUBSCRIPT SUBSI1: HRRZM TA,CURDAT ;SAVE ADDRESS OF OCCURS LEVEL ;[753] AT SUBSI1+1 (MOVED LINE DOWN) IFE ANS74, SUBS74==SUBSI1 ;[745] NO CONVERSION REQUIRED IN COBOL-68 LDB TE,DA.NOC MOVEM TE,ESMAX ;SAVE # OF OCCURS SETZM SUBFLG## ;CLEAR SUBSCRIPT FLAGS IFN ANS74,< ;[745] LDB CH,DA.DCR ;[745] JUMPE CH,SUBS77 ;[745] NO CONVERSION REQUIRED MOVE TA,[AS.PAR,,AS.MSC] ;[745] DEP. VAR HAS BEEN PUT IN %PARAM+0 JRST SUBSI2 ;[745] GO STORE IT SUBS77: ;[745] >;[745] END IFN ANS74 ;STILL IN SUBSIL ;PUT DEPENDING ITEM INFO (OR 0) IN DEPITM LDB TA,DA.DEP JUMPE TA,SUBSI2 ;JUMP IF NONE PUSH PP,TA PUSHJ PP,LNKSET LDB TE,DA.LKS JUMPE TE,SUBSI3 ;JUMP IF DEP. VARIABLE NOT IN LINKAGE S. LDB TE,DA.RBE ;YES, CHECK TO MAKE SURE IT WAS ;REFERENCED BY AN ENTRY OR PD USING JUMPE TE,SUBSIE ;GIVE ERROR, USE DATANAME POP PP,TE ;FIX STACK MOVSI TE,1B20 ;REMEMBER DEP. VARIABLE IN LINK. SEC. MOVEM TE,SUBFLG LDB TA,DA.ARG ;GET ARG IORI TA,AS.PAR ;IN %PARAM HRLZ TA,TA HRRI TA,AS.MSC JRST SUBSI2 SUBSIE: MOVEI DW,E.401 PUSHJ PP,OPNFAT SUBSI3: POP PP,TA ANDI TA,TM.DAT IORI TA,AS.DAT ;CHANGE CODE TO "DATANAME" SUBSI2: MOVEM TA,DEPITM## ;SAVE DEPENDING VARIABLE ITEM ;GET SUBSCRIPT VALUE MOVEI TC,2 ADDB TC,CUREOP MOVEI LN,EBASEA ;PUT SUBSCR AS "A" PARAM PUSHJ PP,SETOPN HRRZ TE,EMODEA ;A LITERAL? CAIN TE,LTMODE JRST SUBILL ;YES, CHECK IT OUT SKIPE EDPLA ;NO - ANY DECIMAL PLACES? JRST BADSL0 ;YES, COMPLAIN LDB TE,[POINT 3,EBASEA,20] CAIE TE,TB.DAT ;SKIP IF A DATANAME JRST SUBSI4 LDB TE,DA.LKS ;IS IT IN LINKAGE SECTION? JUMPN TE,SUBSL1 ;YES SUBSI4: MOVE TA,EBASEA HRL TA,EINCRA ;NORMAL INFO SUBSI5: MOVEM TA,SUBITM## ;STORE SUBSCRIPT INFO JRST SUBSI6 ;HERE IF SUBSCRIPT WAS A LITERAL ; SUBILL: PUSHJ PP,CONVNL ;GET VALUE IN TD&TC SKIPN EDPLA TSWF FLNEG JRST BADSL0 JUMPN TD,BADSL1 JUMPE TC,BADSL0 CAMLE TC,ESMAX JRST BADSL1 MOVS TA,TC HRRI TA,AS.CNB JRST SUBSI5 ;USER ERRORS BADSL0: SKIPA DW,[E.251] ;?IMPROPER SUBSCRIPT BADSL1: MOVEI DW,E.252 ;?SUBSCR. VALUE .GT. OCCURS VALUE PUSHJ PP,NOTNF1 SETZ TA, ;PUT ZERO IN SUBITM JRST SUBSI5 ;HERE IF SUBSCRIPT IN LINKAGE SECTION SUBSL1: MOVSI TE,1B21 IORM TE,SUBFLG ;REMEMBER INDIRECTING NEEDED SUBSL2: LDB TE,DA.VAL## ;GET VALUE MOVS TE,TE IOR TE,[AS.PAR,,AS.MSC] MOVEM TE,SUBITM## ;STORE SUBSCRIPT INFO LDB TE,DA.RBE ;REF. BY ENTRY? JUMPN TE,SUBSI6 ;YES, THEN ALL DONE SUBSL3: LDB TE,DA.LVL## ;GET LEVEL CAIE TE,01 ;AT LEVEL 01 CAIN TE,77 ;OR LEVEL 77 JRST SUBSI6 ;YES, DONE PUSHJ PP,LNKFA1## ;NO, BACKUP TO FATHER LDB TE,DA.RBE ;WAS FATHER REF. BY ENTRY? JUMPE TE,SUBSL3 ;NO, KEEP ON TRYING JRST SUBSL2 ;YES, STORE VALUE ;NOW WE'RE READY TO CALL GEN. SUBROUTINES SUBSI6: MOVSI TE,1B18 HRRZ TD,EMODEA CAIE TD,LTMODE IORM TE,SUBFLG ;SET FLAG IF NOT LITERAL PUSHJ PP,SILG00 ;GEN: SKIPLE AC,SUBSC. VALUE ; CAILE AC,OCCURS VALUE ; PUSHJ PP,SUBE1## SKIPE DEPITM## ;SKIP IF NO DEPENDING ITEM PUSHJ PP,SILG02 ;GEN: SKIPLE AC+1,DEPENDING.VAR ; CAILE AC,AC+1 ; PUSHJ PP,SUBE2## PUSHJ PP,SILG01 ;GEN: SUBI AC,1 AOS TE,SUBNM1## ;INCREMENT COUNTER CAILE TE,2 ;SKIP IF FIRST PASS JRST [PUSHJ PP,GENIML ;GENERATE THE IMULI AC,SIZE SOS EAC ;AC:=AC-1 PUSHJ PP,SILG03 ;GEN: ADD AC,AC+1 MOVE TE,SUBNM1## ;GET SUBSCR. INDEX AGAIN JRST .+1] CAMLE TE,SUBNUM ;SKIP IF .LE. NUMBER JRST SUBSI8 ;NO MORE, GEN END CAIG TE,2 ;ON 1ST SUBSCRIPT? PUSHJ PP,GENIML ;YES, GEN "IMULI AC,SIZE" AOS EAC ;BUMP EAC MOVE TE,CUREOP MOVE TE,1(TE) TLNN TE,BSUBSC ;DID IT HAVE AN ADDITIVE? JRST SUBSI9 ;NO MOVEI TE,2 ADDM TE,CUREOP ;YES, BUMP PAST ONE OPERAND SUBSI9: MOVE TA,CURDAT LDB TA,DA.OCH JUMPE TA,[PUSHJ PP,NOTNUF JRST SUBIDN] PUSHJ PP,LNKSET JRST SUBSI1 ;LOOP BACK FOR ALL ;HERE WHEN DONE CALCULATION OF OFFSET ;GEN. CODE TO ADJUST BYTE POINTER SUBSI8: MOVE TE,SSMODE ;GET MODE OF BASE ITEM CAILE TE,DSMODE ;IF NOT DISPLAY.. JRST SUBILC ;DON'T BOTHER WITH BYTE PTR STUFF MOVE TE,SUBNM1 CAIG TE,2 ;ONLY 1 SUBSCRIPT? PUSHJ PP,CHKIML ;YES, GEN "IMULI AC,SIZE" PUSHJ PP,SILG04 ;GEN CODE TO ADJUST BYTE PTR SKIPN IBPFLG## ;SKIP IF WE ARE MAKING A BYTE PTR PUSHJ PP,SILG05 ;GEN CODE TO DPB "SUBCON" INTO BITS 6-17 JRST SUBID1 ;AND THEN WE'RE DONE ;HERE IF BASE ITEM IS COMP ;GEN. "ADDI AC,BASE" INSTEAD OF BOTHERING WITH BYTE POINTER SUBILC: MOVE TE,SUBNM1 CAIG TE,2 ;ONLY 1 SUBSCRIPT? PUSHJ PP,GENIML ;YES, GENERATE "IMULI AC," PUSHJ PP,SILG06 ;"ADDI AC,BASE" SKIPE ELNKSF## ;ITEM IN LINKAGE SECTION? PUSHJ PP,SILG07 ;YES, ADD OFFSET ;HERE WHEN NO MORE CODE GENERATION TO DO - RESULT IS IN AC "SXR". SUBID1: IFN ANS74,< ;IF DEBUGGING, STORE AWAY THE BYTE PTR FROM AC, ; AND MAYBE GENERATE "SETZM %PARAM + LAST.SUBSCRIPT - 1" SKIPN SUBPBL ;DEBUGGING? JRST SUBID3 ;NO, SKIP THIS MOVE CH,[MOVEM.+ASINC,,AS.MSC] PUSHJ PP,PUT.XA ;FIRST PART OF INSTRUCTION HRRZ CH,SUBPBL ;GET %PARAM BASE ADDI CH,MAXSUB ; OFFSET SKIPS ALL SUBSCRIPTS PUSHJ PP,PUTASN ;FINISH "MOVEM". PUSHJ PP,DBCLRL ;(MAYBE) GENERATE A "SETZM" SUBID3: >;END IFN ANS74 IFN CSTATS,< SKIPN METRSW## ;METER--ING? JRST SUBID2 ;NO MOVEI CH,^D1477 ;BASE BUCKET NUMBER SKIPE DEPITM## ;DEPENDING VARIABLE? ADDI CH,6 ;YES, USE 2ND 6 BUCKETS SKIPE NACMP## ;ANY NON-COMP? ADDI CH,3 ;YES MOVE TE,SUBNUM## ADDI CH,-1(TE) ; + SUBNUM - 1 PUSHJ PP,MTRAOS ;COUNT IT SUBID2: SETZM NACMP## ;RESET NACMP FLAG >;END IFN CSTATS SUBIDN: POP PP,EAC ;RESTORE VALUE OF EAC PJRST SUBS10 ;RESTORE PARAMS & RETURN TO CALLER ;OF SUBSCR ;HERE FOR 0 SUBSCRIPTS - MOVE "A" TO "B" WHERE "A" IN LINKAGE. SILZRO: MOVE TE,SSMODE## CAILE TE,DSMODE JRST SILZRB ;NOT DISPLAY IFN BIS,< SKIPN USENBT## ;LARGER BYTES? JRST SILZR1 ;NO MOVE TD,NBYTES## ;HOW BIG? CAIE TD,4 CAIN TD,6 JRST SILZRB ;FULL WORD-- NO BYTE PTR SILZR1: >;END IFN BIS ;DISPLAY - GEN "MOVE AC,BYTE.PTR", "ADD AC,OFFSET" MOVSI CH,MOV PUSHJ PP,PUT.LC ;"MOVE AC,CURRENT.LITERAL" SKIPN PLITPC AOS ELITPC PUSHJ PP,SILG07 ;"ADD AC,OFFSET" SKIPN IBPFLG## ;SKIP IF MAKING A BYTE PTR PUSHJ PP,DPBSUB ;DPB SUBCON JRST SUBIDN ;NOT DISPLAY - GEN "MOVEI AC,BASITM", "ADD AC,OFFSET" SILZRB: MOVSI CH,MOVEI. PUSHJ PP,SILG6A PUSHJ PP,SILG07 ;"ADD AC,OFFSET" JRST SUBIDN ;HERE IF ONLYEX FLAG WAS ON, AND SUBSCRIPTS ARE NOT ALL LITERALS ; RETURN SIZE OF ELEMENTARY ITEM IN S1SIZ RETSIZ: MOVE TA,CUREOP ;BASE ITEM MOVE TA,1(TA) PUSHJ PP,LNKSET SKIPN TB,SUBNUM## ;ZERO SUBSCRIPTS? JRST RETSZ1 ;RIGHT, RETURN SIZE OF BASE ITEM LDB TE,DA.OCC ;AN OCCURS AT THIS LEVEL? JUMPN TE,RETSZA LDB TA,DA.OCH ;NO, BACK UP ONE LEVEL PUSHJ PP,LNKSET RETSZA: CAIN TB,1 ;JUST ONE SUBSCRIPT? JRST RETSZ1 ;YES, BE FAST ;MORE THAN 1 SUBSCRIPT. WE HAVE TO GET THE GREATEST COMMON DIVISOR ; OF ALL THE SUBSCRIPTS RETSZL: LDB TC,DA.USG PUSH PP,TA ;SAVE TA XCT SUBSIZ(TC) ;GET FIRST SIZE IN TE POP PP,TA ;RESTORE TA PUSH PP,TE ;SAVE SIZE ON STACK SOJLE TB,RETSZB ;JUMP IF ALL DONE NOW LDB TA,DA.OCH ;BACK UP ONE LEVEL PUSHJ PP,LNKSET JRST RETSZL ;LOOP RETSZB: POP PP,TA ;GET 1ST SUBSCRIPT SIZE MOVE TD,SUBNUM ;TD:= # SUBSCRIPTS LEFT SOJ TD, RETSZE: POP PP,TC ;NEXT ONE CAMLE TA,TC EXCH TA,TC RETSZC: IDIVI TC,(TA) JUMPE TB,RETSZD ;ANSWER = TA MOVE TC,TA MOVE TA,TB JRST RETSZC RETSZD: SOJG TD,RETSZE ;LOOP FOR ALL REMAINING SUBSCRIPTS MOVEM TA,S1SIZ## ;RETURN GCD JRST SUBS10 ;RESTORE PARAMS & RETURN RETSZ1: LDB TC,DA.USG XCT SUBSIZ(TC) ;GET SIZE IN TE MOVEM TE,S1SIZ## ;RETURN SIZE JRST SUBS10 ;RESTORE PARAMS & RETURN ;ROUTINE TO GENERATE: ; SKIPLE AC,SUBSCRIPT.VALUE ; CAILE AC,OCCURS.VALUE ; PUSHJ PP,SUBE1## ; ;OR; ; MOVE AC,SUBSCRIPT.VALUE SILG00: SKIPN TA,SUBITM## ;GET SUBSCRIPT INFO POPJ PP, ;?ERROR HAPPENED, DON'T DO ANYTHING HLRZ TB,SUBFLG TRNE TB,1B18 ;SKIP IF A VALUE JRST SILGA0 ;NO, A VARIABLE ;SUBSCRIPT VALUE IS A LITERAL - SET SIMULATED AC THEN RETURN SETOM SSMACF## ;SIMULATE RUN-TIME AC VALUE HLRZM TA,SSMACV## ;STORE INITIAL VALUE IFN ANS68,< POPJ PP, ;JUST RETURN > IFN ANS74,< ; IF DEBUGGING, STORE SUBSCRIPT VALUE SKIPN SUBPBL ;SKIP IF DEBUGGING.. POPJ PP, ;NO, JUST RETURN MOVE CH,[MOVEI.+ASINC,,AS.CNB] ;ASSUME A LARGE CONSTANT PUSHJ PP,PUT.XA MOVE CH,SSMACF PUSHJ PP,PUTASN ;WRITE VALUE SILGA7: MOVE CH,[MOVEM.+ASINC,,AS.MSC] PUSHJ PP,PUT.XA ;START INSTRUCTION.. HRRZ CH,SUBPBL ;GET %PARAM START HRRZ TE,SUBNUM ;TOTAL # SUBSCRIPTS SUB TE,SUBNM1 ; - THIS # ADD CH,TE ;GET %PARAM OFFSET TO USE PJRST PUTASN ;FINISH INSTRUCTION, AND RETURN >;END IFN ANS74 ;STILL IN SILG00 ROUTINE SILGA0: SETZM SSMACF## ;NOT SIMULATING AC TRNE TB,1B21 ;IF SUBSC. IN LINKAGE SECTION JRST SILGA2 ;INDIRECTING REQUIRED SKIPE QUIKSW## ;/Q TYPED? JRST SILGA1 ;YES, DON'T GENERATE ERROR CHECK MOVSI CH,SKPLE. PUSHJ PP,PUT.AA ;SKIPLE SUBSCRIPT.VALUE SILGA5: MOVE CH,[CAILE.+ASINC,,AS.CNB] PUSHJ PP,PUT.XA HRRZ CH,ESMAX PUSHJ PP,PUTASN ;CAILE AC,OCCURS.VALUE MOVEI CH,SUBE1.## IFN ANS68, PJRST PUT.PJ ; "PUSHJ PP,SUBE1.##" IFN ANS74,< PUSHJ PP,PUT.PJ ;'PUSHJ PP,SUBE1.##" JRST SILGA6> ;GO SEE IF DEBUGGING THE ITEM ;GENERATE "MOVE AC,SUBSCRIPT.VALUE" (NO ERROR CHECK) SILGA1: MOVSI CH,MOV IFN ANS68, PJRST PUT.AA ;PUT IT IN ASYFIL AND RETURN IFN ANS74, ;GO SEE IF DEBUGGING ;STILL IN SILG00 ROUTINE ;STILL IN SILG00 ROUTINE ;HERE TO GENERATE INDIRECTING ; MOVE AC,SUBSC.ADDR. ; MOVE AC,(AC) OR SKIPLE AC,(AC) ;EBASEA POINTS TO THE COMP SUBSCRIPT SILGA2: MOVE CH,[MOV+ASINC,,AS.MSC] PUSHJ PP,PUT.XA HLRZ CH,SUBITM ;POINT TO %PARAM+N PUSHJ PP,PUTASN ;CODE GENERATED HAS PUT ADDRESS OF SUBSCRIPT INTO EAC SKIPE QUIKSW## ;/Q? JRST SILGA3 ;YES, GEN "MOVE AC,EBASEA(AC)" ;GENERATE "SKIPLE AC,EBASEA(AC)" HRRZ CH,EAC IORI CH,SKPLE. HRLZ CH,CH HRR CH,EBASEA ;[671] GENERATES OFFSET INTO %PARAM BLOCK PUSHJ PP,PUT.XA JRST SILGA5 ;THEN DO ERROR CHECK ;GENERATE "MOVE AC,EBASEA(AC)" THEN RETURN SILGA3: HRRZ CH,EAC IORI CH,MOV HRLZ CH,CH HRR CH,EBASEA ;[671] OFFSET INTO %PARAM BLOCK IFN ANS68, PJRST PUT.XA IFN ANS74,< PUSHJ PP,PUT.XA ;CHECK FOR DEBUGGING ITEM.. IF SO, GENERATE A STORE OF THE SUBSC. VALUE SILGA6: SKIPN SUBPBL ;SKIP IF DEBUGGING THE ITEM POPJ PP, ;NO, JUST RETURN JRST SILGA7 ;GENERATE THE "MOVEM" FROM AC >;END IFN ANS74 ;ROUTINE TO GENERATE; ; SUBI AC,1 SILG01: SKIPE SSMACF## ;SIMULATING RUN-TIME AC? JRST SIMSL1 ;YES, DON'T GENERATE INSTRUCTIONS MOVSI CH,SUBI. AOJA CH,PUT.XA ;SUBI AC,1 SIMSL1: SOS SSMACV## ;SIMULATE "SUBI AC,1" POPJ PP, ;AND RETURN ;ROUTINE TO GENERATE: ; ADD AC,AC+1 SILG03: MOVE CH,[AD+ASINC,,AS.CNB] PUSHJ PP,PUT.XA HRRZ CH,EAC AOJA CH,PUTASN ;AC+1 ;ROUTINE TO GENERATE "IMULI AC," OR "LSH" GENIML: PUSHJ PP,SIZTE ;GET SIZE OF ITEM IN TE GENIM1: SKIPE SSMACF## ;SIMULATING AC? JRST SIMSL2 ;YES, PUT OUT MOVEI CAIN TE,1 ;IF SIZE IS 1 NO NEED FOR INSTRUCTION POPJ PP, ; . . MOVE CH,[IMULI.+ASINC,,AS.CNB] ;ASSUME IMULI ;USE LSH IF TE CONTAINS A MULTIPLE OF 2 JFFO TE,.+2 ;FIND FIRST 1 BIT JRST E$SIZ ;?TE WAS ZERO??? HRRZ TC,TE ;COPY NUMBER TO TC LSH TC,1(TD) ;SHIFT FIRST BIT OUT OF NUMBER JUMPN TC,USEIML ; IF THERE WERE MORE, # WAS NOT AN ;EVEN MULTIPLE OF 2 - USE "IMULI" ;# IN TE IS AN EVEN MULTIPLE OF 2 ;TD CONTAINS THE # OF 0'S TO THE LEFT OF IT MOVEI TE,^D35 SUB TE,TD ;TE= # TO LSH PUSHJ PP,PUTASA ;USE "LSH", IN ALTERNATE CODE SET MOVE CH,[LSH.+ASINC,,AS.CNB] USEIML: PUSH PP,TE ;SAVE # PUSHJ PP,PUT.XA POP PP,CH PJRST PUTASN ; ;HERE TO SIMULATE IMULI (AND ACTUALLY PUT OUT "MOVEI") SIMSL2: IMUL TE,SSMACV## MOVEM TE,SSMACV## PJRST GENMVI ;GO GENERATE THE "MOVEI" AND RETURN ;ROUTINE TO GENERATE: ; SKIPLE AC+1,DEPENDING.VARIABLE ; CAILE AC,(AC+1) ; PUSHJ PP,SUBE3.## ; CAILE AC+1,OCCURS.VALUE ; PUSHJ PP,SUBE2.## SILG02: SKIPN TA,DEPITM## ;SKIP IF ANY POPJ PP, ;NO, RETURN SKIPE SSMACF## ;WERE WE SIMULATING AC? PUSHJ PP,GENMVI ;YES, GET VALUE INTO RUNTIME AC HLRZ TB,SUBFLG TRNE TB,1B20 ;IN LINKAGE SECTION? JRST SILGB2 ;YES, INDIRECTING REQUIRED ;GENERATE "SKIPLE AC+1,DEPENDING VARIABLE" HRLI CH,SKPLE. HRR CH,DEPITM PUSHJ PP,PUT.XB ;AC+1 HLRZ CH,DEPITM SKIPE CH ;ANY INCREMENT? PUSHJ PP,PUTASN ;YES ;GENERATE "CAILE AC,(AC+1)" SILGB1: MOVE TE,EAC ADDI TE,1 ;AC+1 IORI TE,CAILE. HRLZ CH,TE ;CAILE (AC+1) PUSHJ PP,PUT.XA ;GENERATE "PUSHJ PP,SUBE3." MOVEI CH,SUBE3.## PUSHJ PP,PUT.PJ ;GENERATE CODE TO MAKE SURE DEPENDING VARIABLE VALUE IS ; .LE. AMOUNT OF OCCURS MOVE CH,[CAILE.+ASINC,,AS.CNB] PUSHJ PP,PUT.XB ;AC+1 HRRZ CH,ESMAX PUSHJ PP,PUTASN ;PUT OUT "PUSHJ PP,SUBE2.##" MOVEI CH,SUBE2.## PJRST PUT.PJ ;THEN RETURN ;STILL IN SILG02 ROUTINE ;STILL IN SILG02 ROUTINE ;HERE TO GEN INDIRECTING FOR DEPENDING VARIABLE ;PUT OUT "MOVE AC+1," SILGB2: MOVE CH,[MOV+ASINC,,AS.MSC] PUSHJ PP,PUT.XB ;"MOVE AC+1,DEP.VAR.ADDR" HLRZ CH,DEPITM SKIPE CH ;PUT OUT INCREMENT IF ANY PUSHJ PP,PUTASN ;"SKIPLE AC+1,(AC+1)" HRRZ CH,EAC ADDI CH,1 IORI CH,SKPLE. HRLZ CH,CH PUSHJ PP,PUT.XB JRST SILGB1 ;THEN GO BACK TO GEN "CAILE.." ;ROUTINE TO GENERATE: ; ADJBP AC,CURRENT LITERAL ; [ADD AC,OFFSET] ;FOR ITEM IN LINKAGE SECTION ; TLNE AC,760000 ;RAN OUT OF BYTES IN WORD? ; JRST .+3 ;NO ; TLZ AC,770000 ;YES, CLEAR BIT 10000 IF SET ; ADD AC,[440000,,1] ;POINT TO NEXT WORD ;OR; ; IDIVI AC,BYTES/WORD ; ADD AC,CURRENT LITERAL ; [ADD AC,OFFSET] ;FOR ITEM IN LINKAGE SECTION ; JUMPE AC+1,.+3 ; IBP AC ; SOJG AC+1,.-1 SILG04: IFN BIS,< SKIPN USENBT## ;USING LARGE BYTES? JRST HAVLTR ;NO, LITERAL WAS GENERATED AT SILGO MOVE TD,NBYTES## ;GET # BYTES/BYTE CAIE TD,4 CAIN TD,6 ;4 OR 6 MEANS 36-BIT BYTES CAIA JRST HAVLTR ;ELSE WE GENERATED A LITERAL AT SILGO ;HERE WHEN FULL WORD BYTES ARE USED. ROUTINES IN IFGEN OR MOVGEN ;WILL ONLY CARE ABOUT THE ADDRESS, NOT THE WHOLE BYTE POINTER.; ; GENERATE "ADDI AC,BASE.ADDR" PUSHJ PP,SILG06 ;GENERATE THE ADDI USING "BASITM" JRST SILG4C ;HERE WHEN LITERAL WAS GENERATED AT SILGO HAVLTR: SKIPN ELNKSF## ;ITEM IN LINKAGE SECTION? JRST SILG4B ;NO ;WE MUST GENERATE THE FOLLOWING TWO WORDS IN THIS CASE BECAUSE ; IF THE ITEM IS IN THE LINKAGE SECTION, THE BYTE POINTER MAY BE ; POINT 7,0 OR POINT 6,0, IN WHICH CASE THE ADJBP WILL DO THE ; WRONG THING IF ADJUSTING 0 BYTES. ;GEN "CAIN AC,0" MOVSI CH,CAIN. PUSHJ PP,PUT.XA ;GEN "SKIPA AC," MOVSI CH,SKIPA. PUSHJ PP,PUT.LC ;FAKE ADJBP OF 0 BYTES SILG4B: PUSHJ PP,PUTASA ;ALTERNATE CODE SET MOVSI CH,ADJBP. PUSHJ PP,PUT.LC ;"ADJBP AC,CURRENT.LITERAL" SKIPN PLITPC ;UNLESS WE POOLED IT.. AOS ELITPC ; COUNT THE LITERAL SILG4C: SKIPE ELNKSF## ;LINKAGE SECTION ARG? PUSHJ PP,SILG07 ;YES, ADD OFFSET SKIPE IBPFLG## ;WILL BYTE PTR BE INCREMENTED? POPJ PP, ;YES, NO NEED FOR THE FOLLOWING ;GEN "TLNE AC,760000" MOVE CH,[TLNE.+ASINC,,AS.CNB] PUSHJ PP,PUT.XA MOVEI CH,760000 PUSHJ PP,PUTASN ;GEN "JRST .+3" MOVE CH,[JRST.+ASINC,,AS.MSC] PUSHJ PP,PUTASY MOVEI CH,AS.DOT+3 PUSHJ PP,PUTASN ;GEN "TLZ AC,770000" MOVE CH,[TLZ.+ASINC,,AS.CNB] PUSHJ PP,PUT.XA MOVEI CH,770000 PUSHJ PP,PUTASN ;GEN "ADD AC,[440000,,1] MOVE TA,[XWDLIT,,2] PUSHJ PP,STASHP MOVE TA,[XWD 440000,AS.CNB] PUSHJ PP,STASHQ ;LEFT HALF MOVE TA,[XWD 1,AS.CNB] PUSHJ PP,POOLIT ;RIGHT HALF PJRST GENADL ;GEN "ADD AC,CURR.LIT" THEN RETURN >;END OF IFN BIS IFE BIS,< SKIPE NOIDVF## ;SKIP IF IDIVI NEEDED JRST SILG4A ;GREAT! MOVE CH,[IDIVI.+ASINC,,AS.CNB] PUSHJ PP,PUT.XA MOVE TE,SSMODE ;GET MODE CAILE TE,DSMODE ;MUST BE DISPLAY IF WE ARE HERE JRST E$UND ;?USAGE NOT DISPLAY MOVE CH,BYTE.W(TE) ;GET CH=BYTES/WD PUTBTW: SKIPE USENBT## ;USE LARGER BYTES? JRST [MOVE TC,CH ;YES, COPY SIZE IDIV TC,NBYTES## MOVE CH,TC ;GET ITEM SIZE IN BIG BYTES JRST .+1] PUSHJ PP,PUTASN ;GEN ADD AC,CURRENT LITERAL PUSHJ PP,GENADL ;"ADD AC,CURR. LIT" ;GEN "ADD AC,OFFSET" IF ITEM IN LINKAGE SECTION SKIPE ELNKSF## ;IS IT? PUSHJ PP,SILG07 ;YES, GEN ADD ;GEN JUMPE AC+1,.+3 MOVE CH,[JUMPE.+ASINC,,AS.MSC] PUSHJ PP,PUT.XB ;USE AC+1 MOVEI CH,AS.DOT+3 PUSHJ PP,PUTASN ;GEN IBP AC PUSHJ PP,PUTASA ;"IBP" IS IN ALTERNATE CODE SET MOVE CH,[IBP.+ASINC,,AS.CNB] PUSHJ PP,PUTASY HRRZ CH,EAC PUSHJ PP,PUTASN ;GEN SOJG AC+1,.-1 MOVE CH,[SOJG.+ASINC,,AS.MS2] PUSHJ PP,PUT.XB ;USE AC+1 MOVEI CH,AS.DOT+1 ;AS.MS2 SAYS NEG. INCREMENT PJRST PUTASN SILG4A: SETZM NOIDVF## ;CLEAR FLAG SKIPE ELNKSF## PUSHJ PP,SILG07 ;IN LINKAGE SECTION PJRST GENADL ;"ADD AC,CURR.LIT", RETURN >;END IFE BIS ;ROUTINE TO GEN "ADD AC,CURRENT.LITERAL" ; THEN BUMP LITERAL PC GENADL: MOVSI CH,AD PUSHJ PP,PUT.LC SKIPN PLITPC AOS ELITPC POPJ PP, IFE BIS,< ;ROUTINE TO CHECK FOR IMULI FOLLOWED BY IDIVI ; IF WE CAN DO IT WITH NO PROBLEM, SET NOIDVF TO -1 CHKIML: PUSHJ PP,SIZTE ;TE=SIZE MOVE TD,SSMODE CAILE TD,DSMODE ;WE SHOULD ONLY BE HERE IF IT'S DISPLAY JRST E$UND MOVE TD,BYTE.W(TD) ;TD= BYTES/WD SKIPE USENBT## ;USE LARGER BYTES? IDIV TD,NBYTES## ;YES, GET # OF "BIG" BYTES/WORD IDIVI TE,(TD) ;TE=DIVIDE FACTOR JUMPN TD,GENIML ;NOT EVENLY DIVISIBLE SETOM NOIDVF## ;NO IDIVI NEEDED! PJRST GENIM1 ;GEN THE SMALLER IMULI >;END IFE BIS IFN BIS,< CHKIML==GENIML ;NO IDIVI IF BIS >;END IFN BIS ;ROUTINE TO GEN CODE TO PUT SUBCON IN BITS 6-17 OF RESULT ;THIS ROUTINE MUST BE CALLED RIGHT AFTER SILG04 IS CALLED SILG05: MOVE TE,SSMODE## ;GET MODE MOVE TD,[EXP 600 EXP 700 EXP 1100](TE) ; GET DEFAULT SUBCON CAMN TD,SUBCON## ;IS IT ALREADY SETUP RIGHT? POPJ PP, ;YES, NO NEED FOR DPB IFE BIS,< ;HERE IS AN OPTIMIZATION FOR THE CASE WHEN SILG04 HAS ;GENERATED NON-BIS CODE. WE KNOW THAT C(AC+1) WILL BE 0 ;WHEN CODE GENERATED HERE IS EXECUTED. SKIPN SUBCON ;WILL IT GEN "MOVEI AC+1,0"? JRST SILG5A ;YES, DON'T NEED INSTRUCTION >;END OF IFE BIS DPBSUB: MOVE CH,SUBCON CAILE CH,77777 ;SMALL CONST. SKIPA CH,[HRRZI.+ASINC,,AS.CNB] HRLI CH,HRRZI. ;YES, PRINT AS OCTAL PUSHJ PP,PUT.XB MOVE CH,SUBCON CAILE CH,77777 ;DO WE NEED TO OUTPUT CONST. PUSHJ PP,PUTASN ;YES ;PUT THE BYTE POINTER IN THE LITERAL TABLE SILG5A: MOVE TA,[XWD BYTLIT,2] PUSHJ PP,STASHP MOVE TA,EAC ;ADDRESS PORTION PUSHJ PP,STASHQ MOVSI TA,(POINT 12,,17) PUSHJ PP,POOLIT ;REST OF IT ;NOW DPB AC+1, MOVSI CH,DPB. HRRZ TE,EAC ADDI TE,1 DPB TE,CHAC PUSHJ PP,PUT.LD SKIPN PLITPC ;SKIP IF WE POOLED IT AOS ELITPC ;REMEMBER WE MADE A LITERAL POPJ PP, ;ROUTINE TO GEN "ADDI AC,BASITM" (BASE ITEM WAS COMP) SILG06: MOVSI CH,ADDI. SILG6A: HRR CH,BASITM## HLRZ TE,BASITM## ;INCREMENT JUMPE TE,PUT.XA ;NONE TLO CH,ASINC PUSHJ PP,PUT.XA HLRZ CH,BASITM## ;GET INCREMENT PJRST PUTASN ;ROUTINE TO GET THE SIZE OF ITEM IN TE SIZTE: HRRZ TA,CURDAT LDB TC,DA.USG XCT SUBSIZ(TC) SKIPE USENBT## ;USE LARGER BYTES? IDIV TE,NBYTES## ; YES MOVE TC,SSMODE## ;GET MODE OF LOWEST LEVEL CAIG TC,DSMODE ;DISPLAY? POPJ PP, ;YES, KEEP BYTES MOVE TB,ESAVMD## ;NO, GET WORDS CAILE TB,DSMODE ;[606] THIS DISPLAY? JRST SIZTE1 ;[606] NO, DIVIDE BY 6 IDIV TE,BYTE.W(TB) POPJ PP, SIZTE1: IDIVI TE,6 ;[606] DEFAULT TO 6 BYTES/WORD, THIS GIVES POPJ PP, ;[606] US # OF WORDS ;ROUTINE TO GENERATE "MOVEI AC, GENMVI: SETZM SSMACF## ;CLEAR FLAG HRRZ CH,SSMACV ;GET CONST CAILE CH,77777 ;SMALL? SKIP