TITLE MACRO %53A(1152) 19-JUL-1979 SUBTTL EDIT BY MCHC/JBC/EGM ;COPYRIGHT (C) 1968, 1979 BY ;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. VMACRO==53 ;VERSION NUMBER VUPDATE==1 ;DEC UPDATE LEVEL VEDIT==1152 ;EDIT NUMBER VCUSTOM==0 ;NON-DEC UPDATE LEVEL LOC <.JBVER==137> B2+B11+B17+VEDIT RELOC COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO) SWITCHES ON (NON-ZERO) IN DEC VERSION PURESW GIVES TWO SEGMENT MACRO CCLSW GIVES RAPID PROGRAM GENERATION FEATURE TEMP TMPCOR UUO IS TO BE USED FORMSW USE MORE READABLE FORMATS FOR LISTING (ICCSW) DFRMSW DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON) KI10 GIVES KI10 OP-CODES KL10 GIVES KL10 OP-CODES POLISH GIVES EXTERNAL ARITHMETIC EXPRESSIONS SWITCHES OFF (ZERO) IN DEC VERSION FTPSEC GIVES .PSECT PSEUDO-OPS AND PSECT MULTIPLE RELOCATION COUNTERS STANSW GIVES STANFORD FEATURES LNSSW GIVES LNS VERSION IIISW GIVES III FEATURES OPHSH GIVES HASH SEARCH OF OPCODES F40 GIVES F40 UUOS TOPS20 PROCESSES LONG FILES, REMOVES TOPS10 SYMBOLS TSTCD GIVES LINK DEBUGGING SAND DEVELOPMENT DIRECTIVES OTHER SWITCHES UUOSYM DEFINES TOPS10 UUO'S, CALLI'S, TTCALL'S * SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS IFNDEF PURESW, IFNDEF STANSW, IFN STANSW, IFNDEF LNSSW, IFNDEF CCLSW, IFNDEF TEMP, IFNDEF IIISW, IFN IIISW,< IFNDEF DFRMSW,> IFNDEF DFRMSW, IFN DFRMSW, IFNDEF FORMSW, IFNDEF OPHSH, IFNDEF KI10, IFNDEF KL10, IFN KL10, IFNDEF POLISH, IFNDEF F40, IFNDEF TOPS20, IFNDEF UUOSYM, IFNDEF FTPSEC, IFN FTPSEC, IFNDEF TSTCD, ;DEFAULT LISTING CONTROL DIRECTIVES .DIRECTIVE FLBLST SUBTTL REVISION HISTORY ;START OF VERSION 53 ;552 DON'T SEARCH UNIVERSALS WHEN PROCESSING LABEL,FOO##,END, ; EXTERN,OPDEF,ASSIGN,SYN,INTEGER,ARRAY,.COMMON,& DEFINE. ;553 (22193) FLAG NON-SIXBIT IN SINGLE-QUOTE STRINGS WITH Q-ERROR ;554 (10382) DON'T REPLACE ^Z WITH LF UNLESS INPUT DEV IS TTY ;555 (10202) WARN USER IF CODE STORED BEFORE .COMMON ;556 (22425) ALLOW LEADING NUMERIC CHAR IN ARGUMENTS TO "SEARCH" ;557 (22491) GENERATE -X (WHERE X IS RELOCATABLE) PROPERLY ;560 (22488) PLACE ALL OCCURENCES OF FLAGS 'INASGN','INANGL' UNDER POLISH FEATURE TEST ;561 (22490) GENERATE -1^!X (WHERE X IS RELOCATABLE) PROPERLY ;562 (22544) FIX PAGE OFFSET AFTER PRGEND ;563 (22495) FIX ;; COMMENTS LISTING WHEN DEFINED UNDER LALL ;564 (22493) PREVENT "IO TO UNASSIGNED CHANNEL" ERROR AFTER "?POLISH TOO COMPLEX" ERROR MESSAGE ;565 (22489) PREVENT TERMINAL WAIT AFTER PRGEND AFTER BEING DETACHED OR CCONTED ;566 (22498) REMOVE EDIT 531; BROKE LISTING OF EMBEDDED MACRO CALLS UNDER XALL ;567 (22500) ENHANCEMENT EDIT/REQUEST REL:HELPER,LC SYMBOL TYPES,U-LC MONTHS ;570 (10570) PREVENT E-ERRORS AFTER PURGE OF UNDEF OR EXT SYMBOL ;571 (22676) FORCE HISEG TO START ON PAGE BOUNDARY, NOT K-BOUNDARY ;572 (22748) REPLACE EDIT 556 BY ALTERNATE EDIT ACCOMPLISHING SAME PURPOSE ;573 (22321) FIX LOC/RELOC IN TWOSEG RELOC PROGRAMS ;574 (22501) ADD "ILLEGAL SYNTAX IN MACRO DEFINITION" ERROR MESSAGE ;575 (22492) PUT ALL PSECT-RELATED CODE UNDER FTPSECT SWITCH ;576 (22485) FIX LABEL+OFFSET ACROSS SEGMENTS, AND WHEN OFFSET > 1000 ;577 (22187) FIX LISTING OF MACRO EXPANSION WITH ERRORS UNDER SALL ;600 TURN ON FTPSEC ;601 FIX TAGS IN LIT USED WITH PSECTS ;602 ALLOW .PSECT/.ENDPS IN LIT ;603 FORCE EXPRESSION EVALUATION IN CONDITIONAL. ;604 COMMENT OUT 1LINE @BOUT20+5 (NEEDS RE-WORK) ;605 FIX BUG WITH WRONG RELOC VALUE FOR PSECT @%SWSG2+6 ;606 E-ERROR IF FOO##=EXP @ASSIG3+6 ;607 GENERATE A WORD OF 0 FOR [SIXBIT\\] @SIXB20+ ;610 DO EXPRESSION OF POLISH SYMBOLS FROM UNV IN PASS2 @EVNUM+ ;611 ALPHABETIZE .IF/.IFN ATTRIBUTE TABLE. ;612 FIX BUG WITH "IOWD A##,FOO" WHEN USED WITH PSECT ;613 STORE CURRENT RADIX IN CURADX AND FREE UP RX AS FRR. ;614 OUTPUT "#" IN BINARY LISTING TO INDICATE POLISH FIXUP. ;615 OUTPUT NUMBER OF PAGES USED INSTEAD. ;616 DON'T ALLOW POLISH FOR "BLOCK" & "RELOC" PSEUDO-OPS. ;617 DON'T MAKE LTAGF SYMBOLS EXTERNALS AT END OF PASS1. ;620 Q-ERROR IF EXTERNALS PURGED. ;621 ADD .IF FOO,REFERENCED,<...> ;622 FIX BUG WITH OUTPUTTING "#" ;623 ALLOW EXPRESSIONS OF EXTERNALS AND PSECT-SYMBOLS. ;624 ALLOW POLISH WITH OPDEF ;625 GENERATE POLISH FWF FOR [A##] ;626 ADD .IF FOO,NEEDED,<...> ;627 UPDATE KL INSTRUCTIONS ;630 MORE ON EDIT 625 TO CHECK FOR LH=0,INDIRECT,INDEX,& POLISH ;631 GENERATE A SET OF BLOCK23'S BEFORE ALL THE SYMBOLS ;632 (SAME AS 577) ;633 OUTPUT "#" AND "*" FOR ASSIGNMENTS AND SYMBOL TABLES. ;634 ALLOW "A FOO##+1(1)". ;635 ADD SPECIAL CHARS \' AND \" IN A MACRO CALL. ;636 ALLOW POLSH AND INDEXING ;637 DON'T DO FWF FOR OPDEF A[B##] ;640 SAVE AC FR ON STACK BEFORE DOING EXPONENT IN NUMBER PROCESSING. ;641 CHECK FOR PSECT WHEN DOING FWF @OCTFW+ ;642 SET PSECT INDEX TO 0 BEFORE GENERATING BLOCK 5 ;643 FIX BUG WITH F00##(1) ;644 FIX BUG WITH EXP FOO##,FOO##,FOO## ;645 FWF FOR UNDEFINED SYMBOL IN OPERATOR FIELD. ;646 ILLEGAL TO USE PRGEND WITH PSECT, TREAT IT AS END ;647 OUTPUT PSECT INDEX IN LISTING ;650 (22327) FIX DISAPPEARING MACRO CALLS WITH FF UNDER SALL ;651 (22226) FIX VARIETY OF LISTING BUGS TIED TO ERROR-FLAGGING ;652 (22999) FIX "ENTRY FOO" WHERE FOO IS ALSO AN OPDEF ;653 (22497) FLAG "VERSION SKEW" IF OLD-STYLE UNV WITH SYN ;654 FIX TYPOGRAPHICAL ERROR IN PUBLISHED EDIT 564 ;655 (22482) FIX TOO MANY LINES/PAGE WITH XLIST INSIDE SALL MACRO ;656 (22499) FIX "?ILL MEM REF" WHILE EXPANDING MACRO CALLS WITH EMBEDDED COMMAS ;657 (Q1382) EXTEND NEW MACRO ARG HANDLING TO PARENTHESIZED ARG STRING ;660 (23098) RESTORE IFE/IFN A## HANDLING TO OLD (PRE-52) WAY ;661 (22515) PREVENT ILL MEM REF ON UNCLOSED TEXT IN MULTI-LINE ASSIGNMENT ;662 SIMPLIFY EDIT 561 ;663 (23170) FIX LOST ERRORS IN PASS1 DURING LINE "IMAGE" TYPEOUT ;664 SPEED AND EFFICIENCY ENHANCEMENTS;ROUTINES:GETCHR,PRINT,CHARAC,READ1A ;665 (23246) DON'T TREAT LEADING COMMAS AS SEMICOLONS ;666 FIX VARIOUS BUGS TIED TO "LABEL+OFFSET" TYPEOUT ;667 FIX BAD ASCIZ IN LITERALS (SIDE-EFFECT OF EDIT 661) ;670 ALLOW .NODDT OF OPDEF (I.E. .NODDT PJRST,CALL,ETC.) ;671 REMOVE EDIT 657 (I.E. TAKE FAMILIAR PATH OF LEAST RESISTANCE ; WITH REGARD TO EXISTING PROGRAMS) ;672 IGNORE REDUNDANT SEARCH ARGS, ADD "SEARCH TABLE OVERFLOW" ERROR MESSAGE ;673 (Q1286) LIST CRLFS IN PARENTHESIZED MACRO ARGS CORRECTLY ;674 GIVE E-ERROR FOR EXTERNAL ARRAY NAME ;675 HANDLE INTERN OF MIXED ARG TYPES CORRECTLY ;676 PREVENT THE USE OF ARGUMENTS < 4 TO /NNL ;677 ALLOW .IF EXPRESSION,QUALIFIER (OMITTING COMMA) ;700 ALTER "CORE ALLOCATION PROBLEM" ERROR MESSAGE, FORCE ; REALLOCATION UNLESS /U (MEMORY-RESIDENT UNIVERSALS) ;701 FLAG NON-SIXBIT IN SIXBIT PSEUDO-OP CORRECTLY, TERMINATING STRING ;702 REPLACE MBR,MBC,MBI MESSAGES WITH ISR,ISC,ISI (SYNTAX CHECKS) ;703 (22939) HANDLE COMPLEX FORWARD REF OF SYM WHERE SYM=POLISH CORRECTLY ;704 FIX BAD CREF OUTPUT WHEN LISTING MACRO ARGS W/CRLFS AND "\" ;705 (23527) FIX ILL MEM REF WITH IFX (SIDE EFFECT OF 660) ;706 (22484) MAKE ,, WORK ;707 FIX BUG WITH LITERAL PC WHEN DOING PSECT CHANGES AT END. ;710 GET CORRECT RELOCATION WHEN EVALUATING "!". ;711 ENTER PSECT-NAMES AS EXTERNAL SYMBOLS. ;712 COLLAPSE 2 INSTRUCTIONS INTO EXTRN2 ROUTINE ;713 MOVE NO UNV SEARCH FLAG INTO AC FRR. ;714 RESET SYMBOL TABLE POINTER WHEN A TAG HAS OTHER USE IN DIFF PSECTS ;715 SEARCH ONLY CURRENT SYMBOL TABLE IN LOOKING FOR VARS. ;716 RESET REL1P POINTER AT PASS INITIALIZATION ;717 BUG FIX WITH PSECT OUTPUT FORMAT ;720 FLAG .DIREC NO NO ARG WITH Q-ERROR ;721 FIX BUG IN EDIT 573 WITH RELOC/RELOC/LOC/RELOC ARG ;722 (10945) FLAG IOWD A,B WHERE A IS RELOC WITH R-ERROR ;723 (10929) FIX TRUNCATING OR GARBLING OF LONG PRINTX TEXT ;724 (23826) GIVE "UNASSIGNED" ERROR MESSAGE FOR UNDEFINED SYMBOLS ; WITH UNRESOLVED 36BIT VALUES (E.G. B=B+1000000). ;725 (23588) DON'T COLLAPSE LITERALS WHICH CONTAIN LABELS. THIS EDIT ; SHOULD BE REMOVED WHEN A FACILITY IS ADDED TO UPDATE ; LABEL VALUES AFTER LITERAL POOLING. ;726 IMPLEMENT "LTL LITERAL TOO LONG" ERROR MESSAGE. ;727 GENERATE CORRECT POLISH FOR -. ;730 GENERATE CORRECT POLISH FOR ;731 BBN BUG FIX WITH GETCHR ;732 INCLUDE S-ERROR IN DEFINITION OF ERRORS. ;733 (24065) FIX BAD ENTRY BLOCK CAUSED BY BAD SEARCH/ENTRY INTERACTION ;734 (23987) HANDLE NEGATIVE RELOCATION CORRECTLY WITH POLISH ;735 ALLOW FORWARD-REF OF TAGS IN LIT(GENERATE 10-BLOCKS). ;736 FIXUP SYMTAB AFTER FORWARD-REF TO USER-DEFINED OPERATOR. ; (MACRO,OPDEF,SYN) ;737 FIX BUG WITH THE NEW IOWD CODE. ;740 CHECK FOR NON-REFERENCED LITERAL TAGS. ;741 A-ERROR WHEN LH-TRUNCATED WITH RELOC. ;742 VARF (TREF) USED WITH LTAGF MEAN TAG REFERENCED ;743 SUPPRESS PASS1 IFX V-ERROR. ;744 (Q2191) MAKE SURE LTGSW GETS CLEARED EACH TIME. ;745 CHECK FOR SPTR BEFORE UPDATE IN ASSIGN. ;746 GIVE ERRMSG WHEN MRP POINTS TO 0 DUE TO MACRO EXPANSION ERR. ;747 GENERATE CORRECT POLISH FOR ,, & . ;750 FIX BUG WITH @POL(K). ;751 TO USE ANGFP ROUTINES. ;752 RESOLVE EDITS 736 &675 CONFLICT IN OPDEF HANDLING. ;753 (18606) PREVENT EXTRA LINE LISTING WITH FF INSIDE REPEAT 0 OR ; FAILING CONDITIONAL. ;754 (22804) CLEAR XLIST AFTER END/PRGEND (DOESN'T AFFECT LITS,ETC.). ;755 (22442) OUTPUT TITLE ".MAIN" FOR UNTITLED PRGEND MODULES DURING RPG ASSEMBLY. ;756 (24473) FIX TOO FEW LINES/LISTING-PAGE WITH PRINTX ;757(REMOVED) MAKE SURE ^- HAS HIGHER PRECEDENCE OVER BINARY OPERATORS. ;760 OUTPUT BINARY ON BLOCK STATEMENT IN A LONG LINE INSIDE MACRO. ;761 (Q2201) FIX BUG IN EOUT THAT GENERATED WRONG COUNT FOR BLOCK 4. ;762 (Q2204) E-ERROR FOR BYTE (N)...POL... WHERE N .NE. ^D36. ;763 (Q2211) GENERATE BLOCK22 WITH SYMBOL TABLE INSTEAD OF BLOCK23. ;764 CHECK FOR INTERNAL OPDEF AT IFDEF. ;765 (Q2195) DON'T GENERATE EMPTY ENTRY BLOCK.(REMOVED) ;766 SAME AS 761 ;767 (Q2185) RE-DO CALCULATION OF RC IN EVADR ;770 (Q2210) FIX BUG WITH FLAGGING MULTIPLY DEFINED TAGS IN DIFFERENT PSECTS. ;771 TEST FOR NOPSW AT CLOSING ANGLE BRACKET ;772 FIX BUG WITH REFERENCING POLISH OPDEF ;773 REPLACE EDIT 747 ;774 MAKE LABEL+OFFSET HANDLING CONSISTANT ;775 (Q2200) CHECK CPU VALUE BEFORE TYPEOUT OF SIZE INFO. ;776 DON'T DO PSECT CHECK FOR PHASED LABEL. ;777 ALLOW BYTE(18) OF POLISH IF HALF WORD ALIGNED. ;1000 ADD 2 CELLS FOR BUILDING OPDEF CODE TO AVOID PROBLEM WITH NESTED LITERALS. ;1001 DON'T LET MACRO EXPANSIONS CHANGE LABEL+OFFSET SETTINGS. ;1002 (Q2235) DON'T STORE UNV NAME UNTIL IT'S VERIFIED. ;1003 (24751) MAKE FF LIST CORRECTLY (SUPERSEDES EDIT 753) ;1004 MINOR SOURCE CHANGES: TABS IN LONG LINE, PAGE, ETC. ;1005 DON'T GENERATE GLOBAL REQUEST FOR A SYMBOL WHERE SYMBOL=UND. ;1006 SAVE INOPDF @SQBRK+ TO ALLOW LITERAL IN OPDEF DEFINITION. ;1007 GIVE EPP MESSAGE DUE TO TYPOS CAUSING ILLEGAL POLISH. ;1010 ADD A WORDS TO DIFFERENCIATE <0,,POL> WITH ;1011 (Q2276) SAVE INOPDF @ANGLB+ TO ALLOW NESTED <...> IN OPDEF DEFINITION. ;1012 RECOVER EXTPNT IF NEEDED AT OP3. ;1013 MOVE LEFT POLISH TO FREE SPACE BEFORE STORING THE PTR IN XWDANG. ;1014 ALLOW ENTRY,INTER STATEMENTS TO APPEAR IN DIFF. PSECT THEN THE TAG. ;1015 FIX BUG WITH SETTING UP CORRECT MP FOR MACROS NEXTED IN CONDTIONALS. ;1016 DEFINE A RELOCATABLE PSECT BIT FOR PSECTS WITH NO FIXED ORIGIN. ;1017 CARRY UNDEFINED BIT ACROSS ASSIGMENT DURING PASS1. ;1020 MODIFY BLOCK 22'S AND BLOCK 23'S AND ADD BLOCK 24'S. ; MACRO 53 RELEASE IN SPRING 1978 ;START OF VERSION 53A ;FOLLOWING 3 PATCHES ARE DOCUMENTED IN THE MACRO 53 BWR FILE ;1021 WHEN MULTIPLE .PSECT STMNTS EXIST FOR THE SAME PSECT, ORIGIN NEED ONLY BE IN ONE. ;1022 IN ARRAY PSEUDO OP, ALLOW UNV-SEARCHING OF SYMBOLS USED IN DIMENSION ARGUMENT. ;1023 CORRECT ASSEMBLY OF STMNTS LIKE: "FOO=IFNB <>,". ;1024 SOME CLEANUP ;1025 DON'T GO POLISH CALCULATING "REPEAT" COUNT ;1026 FIX BUG CAUSED BY EDIT 1010 ( ) ;1027 MAKE SURE UOUT ROUTINE SEARCHES ALL PSECT SYMBOL TABLES. ;1030 AC0 TO AC2 IN PART OF EDIT1021; CAUSE P-ERROR IN PSECT PROGAM ;1031 TURN OFF FLAG IN RC TO INDICATE UNDEF IN LITERAL IN STOLIT ;1032 (25358) FIX .XTABM WITH PARENTHESIZED MACRO CALL ARG LISTS ;1033 (25358) CLEAR MACMPD AND .XTABM/.ITABM SETTINGS ACROSS PASSES ;1034 (25555) FIX FATAL ERRORS CAUSED BY BAD RECOVERY FROM N-ERRORS. ;1035 (26078) FIX OPDEF WITH TEXT PSEUDO-OPS AND INSIDE LITS (REWORK ; EDIT 1000) ;1036 UP CTLSIZ TO 1000 CHARACTERS ;1037 ADD CODE TO USE FORCEP FOR B WHEN NOT IN LARGER EXP. ;1040 MOVE EMBEDDED POLISH INTO FREE SPACE WHEN DOING POLPSH. ;1041 ADD .DIRECTIVE .NOUUO ;1042 CALCULATE TOTAL SYMBOL COUNT BEFORE TURNING ON ATTRIBUTE BITS ; (MOVE EDIT 1021 ONE INSTRUCTION LOWER AND REMOVE EDIT 1027) ;1043 CHANGE .DIRECTIVE .NOUUO TO .DIRECTIVE .NOCALLIS ;1044 (25015) FIX BAD LOAD-TIME RELOCATION FOR EXPRESSIONS OF THE FORM ; "A+B" OR "A-B" WHERE A OR B IS RELOCATABLE. ;1045 (25581) PRESERVE SYMBOL CHARACTERISTICS ACROSS NESTED ; ASSIGNMENTS (E.G., A==:) ;1046 (11716) FIX "ILL MEM REF" TO ADDR 777777 DUE TO BAD MACRO ; CALL SYNTAX ;1047 MAKE EXPRESSIONS OF THE FORM WHERE POLISH ; IS A POLISH EXPRESSION ASSEMBLE CORRECTLY ;1050 FIX "?MCREPP" ERROR DURING PROCESSING OF EXPRESSIONS ; WITH COMPLEX EXTERNAL LEFT HALVES (E.G., ) ;1051 FIX "?ILL MEM REF" AFTER "?MCREPP" (EXPAND EDIT 1007) ;1052 (26137) FIX "?ILL MEM REF" WITH LARGE PRGENDED FILES ;1053 GENERATE X-ERROR IF EXCEEDED MAX OF CREATED SYMBOL (..7777); ; START OVER FROM ..0000 RATHER THAN CREATING ./0000 ;1054 (25910) GIVE UNARY OPERATORS PRECEDENCE OVER SHIFT OPERATORS AND ; LOGICAL OPERATORS. ;1055 (26428) DON'T GENERATE POLISH FOR REL-ABS IN SINGLE-SEGMENT, ; NON-HISEG, NON-PSECT PROGRAM. ;1056 (25357) MAKE MACRO MORE FLEXIBLE IN HANDLING ANGLE-BRACKETED ; ARGS TO .IF/.IFN; IMPLEMENT "EXPRESSION" ATTRIBUTE. ;1057 (12055) RESTORE CORRECT .PSECT/.ORG INTERACTION IN WAKE OF EDIT 573 ;1060 (25477) IMPROVE "?MCRPTC POLISH TOO COMPLEX" ERROR MESSAGE BY ; APPENDING "FOR SYMBOL XXXXXX" OR "FOR LOCATION XXXXXX" ;1061 (25715) RE-DO "ERROR WHILE EXPANDING" ERROR-TRAPPING (SUPERSEDES ; EDITS 1046,746) ;1062 (25907) FIX LISTING OF LIT INSIDE SALL MACRO EXPANSION ;1063 (25777) MAKE .XCREF, .CREF WORK INSIDE LITERALS ;1064 (25777) FIX LISTING OF LALL INSIDE SALL MACRO ;1065 (25777) MAKE LALL, XALL, SALL, LIST, XLIST, .DIREC WORK INSIDE ; LITERALS (REQUIRES EDIT 1064) ;1066 (25838) MAKE MACRO OBSERVE THE SETTINGS OF MESSAGE LEVEL BITS DURING ; ERROR MESSAGE TYPEOUT (SEE GETTAB 35 MONITOR TABLE) ;1067 (26529) BYTE PSUEDO OP SPECIFYING EXTERNALS ON OTHER THAN FULL OR HALF ; WORD BOUNDARIES PRODUCES EPP ERRORS AND ILL MEM REF. ;1070 (26571) CORRECTLY INDICATE EXTERN/INTERN CONFLICTS AS E ERRORS INSTEAD ; OF P OR A ERRORS ;1071 (26690) SET POLISH FLAG IN CORRECT HALF OF FR WHEN DOING FORCED ; RIGHT HALF POLISH IN ANGLE BRACKETS ;1072 (26749) LIST COMPLETE MACRO CALL LINE WHEN XALL IS IN EFFECT ;1073 (26884) FIX ?ILL MEM REF AND E ERRORS DURING POLISH INDEXING ;1074 (12239) FORCE PAIRING OF LIT BRACKETS WITHIN .PSECT/.ENDPS ; MAKE END ILLEGAL WITHIN LITERAL OF ANY PSECT, NOT JUST CURRENT ; CORRECT ERROR MSG. TAG OFFSET IF WITHIN NESTED LITS WITH LABELS ;1075 (27082) LIST COMMENT ON MACRO CALL LINE WHEN XALL IS IN EFFECT ;1076 (27099) DO NOT ALLOW '@' IN AC FIELD, FLAG AS QUESTIONABLE ;1077 ALLOW RIGHT JUSTIFIED RELOCATABLES TO BE GTR. 18 BITS FOR BYTE ; MAKE BYTE ALLOW POLISH SYMBOLS ONLY FOR FULL AND HALF WORDS ; ENHANCEMENT TO EDIT 1067. ;1100 ELIMINATE PHASE ERRORS PRODUCED BY EDIT 1074 ;1101 FIX BAD POLISH FOR EXPRESSIONS INVOLVING INTER-PSECT REFERENCES ; OF RELOCATABLES. ADDITION TO EDIT 1040. ;1102 KEEP DDT SUPPRESS BITS WHEN SYMBOL DEFINED AS INTERNAL HAS AN ; EXTERNAL OR POLISH VALUE ;1103 REWORK REL+ABS, REL+REL, REL-ABS, REL-REL CODE ADDED BY EDITS ; 1044 AND 1055 TO HANDLE RH RELOCATABLES ONLY ;1104 (12505) DO NOT GENERATE POLISH FWF WHEN DOING POLISH INDEXING ;1105 (12506) MAKE OP AC,- GENERATE CORRECT RH FIXUP ;1106 (12637) DO NOT GENERATE FULLWORD FIXUP UNLESS EXTERNAL IS OF THE ; FORM 0,,EXT ;1107 (27389) DO NOT ALLOW POLISH IN INDEX FIELD, DO NOT ALLOW EXTERNALS IN OP ; CODE INDEX, MAKE PSUEDO-OP IN INDEX FIELD WORK IN ALL CASES ;1110 GENERATE CORRECT POLISH FOR V=EXT##+K WHEN V IS STILL DEFINED ; BY A SPECIAL EXTERNAL POINTER (NOT YET DEFINED IN PASS 2) ; MORE OF EDIT 703. ;1111 AUGMENT EDIT 1103 TO GENERATE LESS POLISH. CASES IMPROVED ; INVOLVE NEGATIVE RELOCATABLES AND RELOCATABLES SLIGHTLY LESS ; THAN HMIN (RANGE HMIN-400). ;1112 (27167) EXPAND .IF/.IFN FEATURE BY ADDING "NAME" ATTRIBUTE INDICATING ; A SINGLE RADIX50 NAME (SYMBOL) HAS BEEN PASSED AS AN ARGUMENT. ;1113 (27418) ELIMINATE OPDEF PROCESSING INCONSISTENCIES ;1114 (27388) ADD THE SWAPPED LEFT HALF VALUE OF THE INDEX TO THE POLISH ; GENERATED FOR STATEMENTS OF THE FORM 'OPCODE AC,POLISH(LH,,RH)' ;1115 (27544) FOR DEC/EXP/OCT, GIVE Q ERROR FOR UNBRACKETED EXPRESSIONS ; INVOLVING '@'. FORCES USE OF BRACKETS FOR FULL ADDRESS CALC. ;1116 FIX INTER-PSECT REFERENCES TO SPECIAL POINTERS OF EXTERNALS ; SO THE EXTERNAL CHAIN DOES NOT CROSS PSECTS. ;1117 (27728) MAKE .PSECT HANDLE ATTRIBUTE SPECIFICATIONS CORRECTLY ;1120 (12962) RESET RP AND MP IN THE END CODE SINCE MACROS MUST BE COMPLETED ;1121 INCREASE THE NUMBER OF EXTRA (XTRA) LOCATIONS TO SAVE FOR PRGEND ; TO 8 TO PREVENT POSSIBLE ?ILL MEM REFS ;1122 (27813) DO NOT COPY NULLS INTO STATEMENT OUTPUT BUFFER ;1123 (27976) GENERATE Q ERROR FOR MULTIPLE TITLES/OR TITLE/UNIVERSAL ; CONFLICTS, INSTEAD OF M ERROR DURING ONLY PASS 1 ;1124 (Q3051) INCREASE .UNIV TO 50. ;1125 (Q3038) RE-INSTALL MACROS FOR DIRECTIVE ARGS AND ROUTINES ;1126 (Q3045) FLAG MOST ASSIGMENTS INVOLVING A LABEL DEFINED WITHIN A LITERAL ; AS L ERRORS. LABEL MAY NOT BE DEFINED TILL END OF PASS2. ;1127 (Q3053) GENERATE THE DESIRED ASCII STRING FOR MACRO CALL ARG ' \N ' ; WHEN N IS A SYMBOL OR EXPRESSION - BROKEN BY EDIT 137 ;1130 RESET ASSEMBLY MODE TO RELOCATABLE (1) AT PASS INITIALIZATION. ;1131 REMOVE EDIT 646, MAKE PRGEND WORK WITH PSECTS ;1132 FIX NUMEROUS PSECT BUGS - PSECT FOO,1000 / PSECT FOO LOSES ORIG. ; PSECT AND LOC INCONSISTENCIES, PSECT AND PHASE INCONSISTENCIES. ;1133 (Q3047) FIX RSW3 TO PROPERLY DETECT WHEN THE LISTING OUTPUT BUFFER IS ; FULL - HANDLE TABS PROPERLY AFTER THE 128 CHARACTER LIMIT ;1134 MAKE LOCO STAY IN SYNC. WITH LOCA DURING PASS 1. PSECTS NESTED ; WITHIN LITERALS CAUSE OUT-OF-SYNC. ;1135 (28104) DO 'OP' PROCESSING INSTEAD OF A FULL WORD FIXUP FOR CASES SUCH ; AS 'OP## AC,ADDR'. THIS AND POLISH OPCODES WILL NOT PRODUCE THE ; PROPER CODE FOR LEFT HALF EXTERNALS. ;1136 CLEAR PSECT NESTING COUNTER AND OTHER PSECT ITEMS AT PRGEND, ; PLUS CHECK FOR PRGEND INSIDE LITERALS ;1137 FLAG NON-ABSOLUTE PSECT ORIGINS AS AN 'A' ERROR ;1140 EDIT 1123 BROKE 5 CHARACTER TITLES IN PRGENED FILES, CLEAR OUT ; 2ND WORD OF TITLE WHEN LOADING DEFAULT TITLE OF .MAIN ;1141 (Q3085) FOR PRGENDED PROGRAMS, PRINT BREAK, CPU TIME, CORE USED DATA ; FOR EACH PROGRAM MODULE ;1142 (Q3181) REPEAT THE EOL CHAR. IF A TERMINATING ANGLE BRACKET IS MISSING. ;1143 SYN A,B WILL NOT CREF B AS DEFINING OCCURANCE ;1144 SAVE/CLEAR/AND RESTORE CPU TYPE OVER PRGENDS ;1145 EDIT 1135 STOPPED GENERATION OF FULL WORD FIXUP FOR [FOO##] ;1146 ALLOW NUL: AS CREF DEVICE ;1147 EDIT 1113 CAUSED THE OPDEF IN "EXP OPDEF AC,ADDR" TO BE ; PROCESSED AS AN ADDRESS, DISCARDING THE REMAINING FIELDS. ;1150 (Q3261) XLIST UNDER SALL PUTS EXTRA CHARACTERS IN THE LISTING FILE ;1151 DO NOT OUTPUT BLOCK 22'S AFTER THE END BLOCK FOR PRGEND. ;1152 (Q3410) EDIT 1143 CAUSED BAD CREF DATA TO BE GENERATED FOR A SYN ; SUCH AS "SYN IFE,IF". ;*****END OF REVISION HISTORY***** SUBTTL OTHER PARAMETERS .PDP==^D100 ;BASIC PUSH-DOWN POINTER IFN POLISH,<.PDP==^D250> ;BE GENEROUS WITH STACK IFNDEF LPTWID, ;DEFAULT WIDTH OF PRINTER .LPTWD==8* ;USEFUL WIDTH IN MAIN LISTING .CPL==.LPTWD-^D32 ;WIDTH AVAILABLE FOR TEXT WHEN ;BINARY IS IN HALFWORD FORMAT .CPLX==LPTWID-.LPTWD ;EXCESS SPACE IN LAST TAB STOP IFNDEF .LPP,< IFE STANSW,<.LPP==^D57> ;LINES/PAGE IFN STANSW,<.LPP==^D52> ;LINES/PAGE > .STP==^D100 ;STOW SIZE .TBUF==^D80 ;TITLE BUFFER .SBUF==^D80 ;SUB-TITLE BUFFER .IFBLK==^D20 ;IFIDN COMPARISON BLOCK SIZE .R1B==^D18 .UNIV==^D50 ;[1124] NUMBER OF UNIVERSAL SYMBOL TABLES ALLOWED .LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE .SFDLN==5 ;NUMBER OF SFD'S ALLOWED NCOLS==LPTWID/^D32 ;NUMBER OF COLUMNS IN SYMBOL TABLE IFN FTPSECT,< ;[575] SGNSGS==^D64 ;MAX # OF DISTINCT PSECTS ALLOWED ;IN ONE ASSEMBLY SGNDEP==^D16 ;MAX PSECT DEPTH ALLOWED > ;END IFN FTPSECT IFN CCLSW,> ;[1036] IFN OPHSH,> IFNDEF NUMBUF, ;NUMBER OF INPUT BUFFERS EXTERN .JBREL,.JBFF,.JBAPR,.JBSA,.JBERR EXTERN .HELPR IFE TOPS20,< IFDEF .REQUEST,<.REQUEST REL:HELPER >> ;[567] IFN TOPS20,< IFDEF .REQUEST,<.REQUEST SYS:HELPER >> ;[567] LOWL:! ;START OF LOW SEGMENT IFN PURESW, SALL ;SUPPRESS ALL MACROS ;SOME ASCII CHARACTERS HT==11 LF==12 VT==13 FF==14 CR==15 CZ==32 EOL==33 CLA==37 OBRCKT=="<" ;ACCUMULATORS AC0== 0 AC1= AC0+1 AC2= AC1+1 SDEL= 3 ;SEARCH INCREMENT SX= SDEL+1 ;SEARCH INDEX ARG= 5 ;ARGUMENT V= 6 ;VALUE C= 7 ;CURRENT CHARACTER CS= C+1 ;CHARACTER STATUS BITS RC= 11 ;RELOCATION BITS MWP= 12 ;MACRO WRITE POINTER MRP= 13 ;MACRO READ POINTER IO= 14 ;IO REGISTER (LEFT) ER== IO ;ERROR REGISTER (RIGHT) FR= 15 ;FLAG REGISTER (LEFT) FRR== FR ;[613] MOVE FLAGS (RIGHT) MP= 16 ;MACRO PUSHDOWN POINTER P= 17 ;BASIC PUSHDOWN POINTER %OP== 3 %MAC== 5 %DSYM== 2 %SYM== 1 %DMAC== %MAC+1 %ERR== %MAC OPDEF RESET [CALLI 0] OPDEF SETDDT [CALLI 2] OPDEF DDTOUT [CALLI 3] OPDEF DEVCHR [CALLI 4] OPDEF CORE [CALLI 11] OPDEF EXIT [CALLI 12] OPDEF UTPCLR [CALLI 13] OPDEF DATE [CALLI 14] OPDEF APRENB [CALLI 16] OPDEF MSTIME [CALLI 23] OPDEF PJOB [CALLI 30] OPDEF RUN [CALLI 35] OPDEF TMPCOR [CALLI 44] OPDEF MTWAT. [MTAPE 0] OPDEF MTREW. [MTAPE 1] OPDEF MTEOT. [MTAPE 10] OPDEF MTSKF. [MTAPE 16] OPDEF MTBSF. [MTAPE 17] ;FR FLAG REGISTER (FR/RX) IOSCR==000001 ;NO CR AFTER LINE POLSW==000002 ;DOING POLISH ON GLOBALS MTAPSW==000004 ;MAG TAPE ERRQSW==000010 ;IGNORE Q ERRORS LOADSW==000020 ;END OF PASS1 & NO EOF YET DCFSW==000040 ;DECIMAL FRACTION RIM1SW==000100 ;RIM10 MODE NEGSW==000200 ;NEGATIVE ATOM RIMSW==000400 ;RIM OUTPUT PNCHSW==001000 ;RIM/BIN OUTPUT WANTED CREFSW==002000 R1BSW==004000 ;RIM10 BINARY OUTPUT TMPSW==010000 ;EVALUATE CURRENT ATOM INDSW==020000 ;INDIRECT ADDRESSING WANTED RADXSW==040000 ;RADIX ERROR SWITCH FSNSW==100000 ;NON BLANK FIELD SEEN MWLFLG==200000 ;ON FOR DON'T ALLOW MULTI-WORD LITERALS P1==400000 ;PASS1 ;[613] FRR FLAGS (RIGHT HALF OF FR) NOPSW==400000 ;[613] NO-POLISH IN CONDITIONAL LHPSW==200000 ;[613] OUTPUT "#" AFTER LH OF BINARY LISTING RHPSW==100000 ;[613] OUTPUT "#" AFTER RH OF BINARY LISTING FWPSW==040000 ;[613] FULL WORD FORMAT + "#" IN BINARY LISTING WD2SW==020000 ;[607] PROCESSING 2ND WORD OF MULTIPLE WORD DATA EXPSW==010000 ;[634] DOING EXP, KEEP FULL WORD FIXUP PIDXSW==004000 ;[636] DOING POLISH AND INDEXING NOUNVS==002000 ;[713] DON'T SEARCH UNIVERSALS LTGSW==001000 ;[735] GOT A TAG IN LITERAL IDXSW==000400 ;[1107] DOING OP INDEXING ;IO FLAG REGISTER (IO/ER) FLDSW==400000 ;ADDRESS FIELD IOMSTR==200000 ARPGSW==100000 ;ALLOW RAPID PROGRAM GENERATION IOPROG==040000 ;SUPRESS LISTING (LIST/XLIST PSEUDO OP) NUMSW==020000 IOMAC==010000 ;MACRO EXPANSION IN PROGRESS IOPALL==004000 ;SUPRESS LISTING OF MACRO EXPANSIONS IONCRF==002000 ;SUPRESS OUTPUT OF CREF INFORMATION CRPGSW==001000 ;CURRENTLY IN PROGRESS ON RPG IOCREF==000400 ;WE ARE NOW OUTPUTTING CREF INFO IOENDL==000200 ;BEEN TO STOUT IOPAGE==000100 DEFCRS==000040 ;THIS IS A DEFINING OCCURANCE (MACROS) IOIOPF==000020 ;IOP INSTRUCTION SEEN MFLSW==000010 ;MULTI-FILE MODE,PRGEND SEEN IORPTC==000004 ;REPEAT CURRENT CHARACTER RSASSW==000002 ;REFERENCE IS TO A SYMBOL IN ANOTHER PSECT IOSALL==000001 ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED OPDEF CALL [PUSHJ P,] ;FUNCTIONAL MNEMONIC OPDEF RET [POPJ P,] ;FUNCTIONAL MNEMONIC OPDEF JUMP1 [JUMPL FR,] ;JUMP IF PASS 1 OPDEF JUMP2 [JUMPGE FR,] ;JUMP IF PASS 2 OPDEF JUMPOC [JUMPGE IO,] ;JUMP IF IN OP-CODE FIELD OPDEF JUMPAD [JUMPL IO,] ;JUMP IF IN ADDRESS FIELD OPDEF JUMPCM [JUMPL CS,] ;JUMP IF CURRENT CHAR IS COMMA OPDEF JUMPNC [JUMPGE CS,] ;JUMP IF CURRENT CHAR IS NON-COMMA OPDEF PJRST [JRST] ;JUMP TO RET ;RETURN OPDEF HALT [HALT] ;TO PUT IN CREF TABLE .NODDT PJRST,CALL ;ER ERROR REGISTERS (IO/ER) TTYSW==000001 LPTSW==000002 ERRF==000004 ;FAKE ERROR TO PREVENT LITERALS BEING COLLAPSED ERRS==000010 ;ILLEGAL PSECT USAGE ERRM==000020 ;MULTIPLY DEFINED SYMBOL ERRE==000040 ;ILLEGAL USE OF EXTERNAL ERRP==000100 ;PHASE DISCREPANCY ERRO==000200 ;UNDEFINED OP CODE ERRN==000400 ;NUMBER ERROR ERRV==001000 ;VALUE PREVIOUSLY UNDEFINED ERRU==002000 ;UNDEFINED SYMBOL ERRR==004000 ;RELOCATION ERROR ERRL==010000 ;LITERAL ERROR ERRD==020000 ;REFERENCE TO MULTIPLY DEFINED SYMBOL ERRA==040000 ;PECULIAR ARGUMENT ERRX==100000 ;MACRO DEFINITION ERROR ERRQ==200000 ;QUESTIONABLE, NON-FATAL ERROR ERROR1==ERRP!ERRM!ERRV!ERRX ;ERRORS THAT PRINT ON PASS 1 ERRORS==777770 ;[732] ;SYMBOL TABLE FLAGS SYMF==400000 ;SYMBOL !(LTAGF) TAGF==200000 ;TAG !(LTAGF) NOOUTF==100000 ;NO DDT OUTPUT WFW SYNF==040000 ;SYNONYM !(SIXF) MACF==SYNF_-1 ;MACRO OPDF==SYNF_-2 ;OPDEF PNTF==004000 ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE !(SIXF) UNDF==002000 ;UNDEFINED !(LTAGF) EXTF==001000 ;EXTERNAL INTF==000400 ;INTERNAL ENTF==000200 ;ENTRY VARF==000100 ;VARIABLE !(LTAGF, SIXF) NCRF==000040 ;DO NOT CREF THIS SYMBOL MDFF==000020 ;MULTIPLY DEFINED SPTR==000010 ;SPECIAL EXTERNAL POINTER SUPRBT==000004 ;SUPRESS OUTPUT TO REL AND LISTING LELF==000002 ;LEFT HAND RELOCATABLE RELF==000001 ;RIGHT HAND RELOCATABLE LTAGF==SYMF+TAGF+UNDF ;[601] TAG IN LITERAL DURING PASS 1 TREF==VARF ;[742] TREF+LTAGF MEANS TAG NOT REF'ED SIXF==SYNF+PNTF+VARF ;USED WITH SYN IN UNV FILE ;POINTER TO A SIXBIT OPERATOR LITF==200000 ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S ADDF==100000 ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES TNODE==200000 ;TERMINAL NODE FOR EVALEX ;FLAGS IN BLSW BLOFF==1B0 ;BINARY LISTING OFF (MUST BE B0) FLBLST==1B1 ;FIRST-LINE BINARY ONLY MODE ;POLISH FIXUP CODES POLRHF==-1 ;RIGHT-HALF FIXUP POLLHF==-2 ;LEFT-HALF FIXUP POLFWF==-3 ;FULL-WORD FIXUP ;UNIVERSAL VERSION BIT DEFINITION ;THE FIRST WORD OF A UNV FILE MUST CONTAIN: ; LEFT HALF 777 ; RIGHT HALF UNIVERSAL VERSION NUMBER ;WHEN WRITING A UNV FILE, MACRO WRITES OUT: ; 777,,UWVER FOR THE FIRST WORD ; .JBVER FOR THE SECOND WORD( MACRO VERSION NUMBER) ;WHEN READING A UNV FILE, MACRO READS THE FIRST WORD AND CHECKS FOR: ; 777 IN LEFT HALF, AND ; CHECKS THE RIGHT HALF AGAINST MASK .URVER ; WILL SKIP THE SECOND WORD IF A VERSION NUMBER IS EXPECTED THERE ; UMACV==000020 ;HAS MACRO VERSION IN 2ND WORD USYN==000010 ;NEW SYN HANDLING IN UNIVERSAL UBAS==000004 ;MUST HAVE THIS BASIC BIT ON ;SAME AS THE FIRST VERSION #4 UPOL==000002 ;POLISH INCLUDED UMAD==000001 ;MACRO ARG DEFAULT VALUE BUG FIXED UALL==UBAS+UMAD+UPOL+USYN+UMACV ;EVERYTHING IFN POLISH,<.URVER==^-UALL> ;WILL READ EVERY KIND OF UNV IFE POLISH,<.URVER==^-> ;WILL NOT READ POLISH STUFF IN UNV ;USEFUL MACROS DEFINE FORERR(AC,ABC)< MOVE AC,[PAGENO,,ABC'PG] BLT AC,ABC'PG+3 > DEFINE BITON(BIT,ADR)< PUSH P,0 MOVEI 0,BIT IORM 0,ADR POP P,0 > SUBTTL START ASSEMBLING ASSEMB: CALL INZ ;INITIALIZE FOR PASS SKIPA AC1,.+1 ;LOCALIZED CODE ASCII /.MAIN/ MOVEM AC1,TBUF SETZM TBUF+1 ;[1140] CLEAR 2ND WORD FOR ASCIZ TITLE SETZM TTLFND ;[1123] NO TITLE SPECIFIED YET MOVEI SBUF HRRM SUBTTX ASSEM1: CALL CHARAC ;TEST FOR FORM FEED SKIPGE LIMBO ;CRLF FLAG? JRST ASSEM1 ;YES ,IGNORE LF CAIN C,14 SKIPE SEQNO JRST ASSEM2 TLNE IO,IOSALL ;[650] IGNORE FF IF SALL IN MACRO JUMPN MRP,ASSEM1 ;[650] CALL OUTFF3 ;[774] JRST ASSEM1 ASSEM2: CAIN C,"\" ;BACK-SLASH? TLZA IO,IOMAC ;YES, LIST IF IN MACRO TLO IO,IORPTC CALL STMNT ;OFF WE GO TLZN IO,IOENDL ;WAS STOUT PRE-EMPTED? CALL STOUT ;NO, POLISH OFF LINE JRST ASSEM1 SUBTTL STATEMENT PROCESSOR STMNT: IFN POLISH,< SKIPLE POLTYP ;INIT POLISH SETZM POLTYP TRZ FRR,LTGSW!LHPSW!RHPSW!FWPSW> ;[744][614] TLZ FR,INDSW!FSNSW!POLSW SETZM UPARROW ;CLEAR SPECIAL REPEAT CHARACTER TLZA IO,FLDSW STMNT1: CALL LABEL STMNT2: CALL ATOM ;GET THE FIRST ATOM CAIN C,'=' ;"="? JRST ASSIGN ;YES CAIN C,':' ;":"? JRST STMNT1 ;YES JUMPAD STMNT9 ;NUMERIC EXPRESSION JUMPN AC0,STMN2A ;JUMP IF NON NULL FIELD CAIE C,EOL ;[665] END OF LINE? CAIN C,']' ;CLOSING LITERAL? RET ;YES JRST STMNT9 ;NO,AT LEAST SKIP ALL THIS NONSENSE STMN2A: SKIPE C TLO IO,IORPTC ;REPEAT TERMINATOR IF NOT BLANK CALL MSRCH ;SEARCH FOR MACRO/OPDEF/SYN JRST STMNT3 ;NOT FOUND, TRY OP CODE LDB SDEL,[POINT 3,ARG,5] JUMPE SDEL,ERRAX ;ERROR IF NO FLAGS SOJE SDEL,[ TLNE CS,(17B5) ;[1113] TERMINATED WITH OPERATOR (+,-..) JRST STMNT9 ;[1113] YES - TREAT AS SYMBOL JRST OPD1] ;[1113] NO - PROCESS OPDEF IF 1 SOJE SDEL,CALLM ;MACRO IF 2 JRST STMNT4 ;SYNONYM, PROCESS WITH OP-CODES STMNT3: CALL OPTSCH ;SEARCH OP CODE TABLE JRST STMNT5 ;NOT FOUND STMNT4: TLNE CS,(17B5) ;TERMINATED WITH OPERATOR? (+,-,ETC.) JRST [ HRRZ AC1,V ;YES TRZ AC1,ADDF+LITF CAIE AC1,OP ;REGULAR OPCODE? JRST .+1 ;NO, MUST EXECUTE IT JRST STMNT9] ;YES, TREAT AS SYMBOL HLLZ AC0,V ;PUT CODE IN AC0 TRZ V,ADDF ;CLEAR ADDRESS NON-VALID FLAG TRZE V,LITF ;VALID IN LITERAL? SKIPN LITLVL ;NO, ARE WE IN A LITERAL? JRST 0(V) ;EXECUTE APPROPRIATE PROCESSOR RET ;YES,EXIT STMNT5: CALL SSRCH ;TRY SYMBOLS JRST STMNT8 ;NOT FOUND STMNT9: IFN POLISH,< PUSH P,[0,,POLFWF] ;MARK AS TEMP FULL WORD FIXUP POP P,POLTYP ;IN CASE WE GO POLISH > TLO IO,FLDSW ;[636] MUST BE DOING ADDR FIELD(NOT OPTR) TLZ IO,IORPTC ;EVAL WILL HANDLE TERMINATOR IN C CALL EVALHA ;EVALUATE EXPRESSION IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM TLNE FR,FSNSW ;FIELD SEEN? JRST STOW ;YES,STOW THE CODE AND EXIT CAIE C,']' ;CLOSING LITERAL? CAIN C,'>' ;[1023] CLOSING ANGLE-BRACKET? RET ;[1023] YES, RETURN TRO ER,ERRQ ;NO, GIVE "Q" ERROR RET ;EXIT STMNT8: IFN UUOSYM,< ;ALL THIS ONLY IF TOPS10 SYMS WANTED SKIPE NOUUO ;[1043][1041] .DIRECTIVE .NOCALLIS SEEN? JRST STMN8A ;[1041] YES, JUMP OUT OF UUO SEARCH CODE MOVEI V,0 ;ALWAYS START SCAN WITH 0 CAIL V,CALNTH ;END OF TABLE? JRST STMN8C ;YES, TRY TTCALLS CAME AC0,CALTBL(V) ;FOUND IT? AOJA V,.-3 ;NO,TRY AGAIN SUBI V,NEGCAL ;CALLI'S START AT -1 HRLI V,(CALLI) ;PUT IN UUO STMN8D: MOVSI ARG,OPDF ;SET FLAG FOR OPDEF STMN8B: CALL INSERT ;PUT OPDEF IN TABLE JRST OPD ;AND TREAT AS OPDEF STMN8C: SETZ V, ;START WITH ZERO CAIL V,TTCLTH ;END OF TABLE? JRST STMN8E ;TRY MTAPES CAME AC0,TTCTBL(V) ;MATCH? AOJA V,.-3 ;NO, KEEP TRYING LSH V,5 ;PUT IN AC FIELD (RIGHT HALF) HRLZI V,<(TTCALL)>(V) ;PUT UUO IN LEFT HALF JRST STMN8D ;SET OPDEF FLAG STMN8E: SETZ V, ;START AT ZERO CAIL V,MTALTH ;END OF TABLE? JRST STMN8A ;YES, ERROR CAME AC0,MTATBL(V) ;MATCH AOJA V,.-3 ;NOT YET PUSH P,AC0 ;SAVE IT MOVE AC0,[POINT 9,MTACOD] IBP AC0 ;GET TO RIGHT ONE SOJGE V,.-1 ;EVENTUALLY LDB V,AC0 ;GET FUNCTION HRLI V,(MTAPE) ;FILL IN OPCODE POP P,AC0 JRST STMN8D STMN8A: > ;END UUOSYM IFN POLISH,< ;[645] JRST STMNT9 ;[645] > ;[645] IFE POLISH,< SETZB V,RC ;CLEAR VALUE AND RELOCATION TRO ER,ERRO ;FLAG AS UNDEFINED OP-CODE JUMP1 OPD ;TREAT AS STANDARD OP ON PASS1 MOVSI ARG,OPDF!UNDF!EXTF ;SET A FEW FLAGS JRST STMN8B ;[664] TO FORCE OUT A MESSAGE > SUBTTL LABEL PROCESSOR LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC JUMPE AC0,LABEL5 ;ERROR IF BLANK TLO IO,DEFCRS ;THIS IS A DEFINITION JUMPN MRP,LABL10 ;[1001] IF EXPANDING, DON'T RESET OFFSET SKIPN LITLVL ;LABEL IN LITERAL? JRST LABL10 ;NO SETOM LBLFLG ;SET FLAG PUSH P,TAGINC ;[774] POP P,LTGINC ;SET MARKER LABL10: TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL SSRCH ;SEARCH FOR OPERAND IFE FTPSECT,< ;[714] MOVSI ARG,SYMF!UNDF!TAGF ;[714] NOT FOUND > ;[714] IFN FTPSECT,< ;[714] JRST [ MOVSI ARG,SYMF!UNDF!TAGF ;[714] NOT FOUND SKIPE SGNMAX ;[714] DOING PSECTS? CAMN AC1,SGWFND ;[714] AC1 HAS CURENT PSECT# JRST LABL12 ;[714] JUMP IF ALREADY POINTS TO CURRENT TABLE CALL SRCHI ;[714] OTHERWISE, RESET SYMBOL PTR CALL SRCH ;[714] TO CURRENT PSECT TABLE JFCL ;[714] JRST LABL12] ;[714] > ;[714] LABL12: TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN TLZN ARG,EXTF ;WAS EXTERNAL? JRST LABEL0 ;NO TLON ARG,UNDF ;[735] YES, BECAUSE UNDEFINED? JUMP2 LABEL3 ;NO, ERROR LABEL0: TLZN ARG,UNDF!VARF ;WAS IT PREVIOUSLY DEFINED? JRST LABEL2 ;YES, CHECK EQUALITY MOVE V,LOCA ;WFW MOVE RC,MODA ;[601] LABL11: TLO ARG,TAGF CALL PEEK ;GET NEXT CHAR. CAIE C,":" ;SPECIAL CHECK FOR :: JRST LABEL1 ;NO MATCH TLO ARG,INTF ;MAKE IT INTERNAL CALL GETCHR ;PROCESS NEXT CHAR. CALL PEEK ;PREVIEW NEXT CHAR. LABEL1: CAIE C,"!" ;HALF-KILL SIGN JRST LABEL6 ;NO TLO ARG,NOOUTF ;YES, SUPPRESS IT CALL GETCHR ;AND GET RID OF IT LABEL6: SKIPN MRP ;[1001] IF EXPANDING, DON'T RESET TAG MOVEM AC0,TAG ;[774] SAVE FOR ERRORS SKIPN LITLVL ;[774] IN LITERAL? JRST [ JUMPN MRP,INSERT ;[1001] DON'T RESET IF EXPANDING SETZM TAGINC ;[774] NO RESET OFFSET JRST INSERT] ;[774] INSERT/UPDATE AND EXIT TRO ER,ERRF ;[774] YES, PREVENT COLLAPSING JUMP2 LBLFIX ;[774] RETURN TO STMNT PROCESSING MOVSI ARG,LTAGF ;[774] PASS1, SET FLAGS SETZ V, ;[774] MOVE RC,MODA ;[774] CURRENT RELOCATION JRST INSERT ;INSERT/UPDATE AND EXIT ;HERE IF TAGS ENCOUNTERED INSIDE A LITERAL ON PASS2 ;3-WORD-BLOCK PER TAG IS ADDED IN FRONT OF A CHAIN ;THE START OF THE CHAIN IS POINTED BY LBLPNT ; THE FORMAT OF THE 3-WORD-BLOCK IS: ; LITLVL,,POINTER TO NEXT BLOCK (OR 0 FOR END) ; NAME OF TAG IN SIXBIT ; ARG FLAGS,,OFFSET INTO CURRENT LITERAL ; LBLFIX: PUSH P,AC0 MOVE AC1,FREE ;GET 3 WORDS FROM FREE CORE ADDI AC1,3 CAML AC1,SYMBOL ;ENOUGH? CALL XCEEDS ;NO, GET MORE EXCH AC1,FREE ;UPDATE FREE HRR AC0,LBLPNT ;UPDATE THE NEXT BLOCK POINTER HRL AC0,LITLVL ;GET LITERAL LEVEL MOVEM AC0,0(AC1) ;STORE IN WORD1 MOVE AC0,STPX ;CURRENT DEPTH IN LITERAL SUB AC0,STPY ;MINUS THE START TLZ ARG,EXTF+PNTF ;[740] MAKE SURE THEY ARE OFF HLL AC0,ARG ;ARG FLAG IN LEFT HALF MOVEM AC0,2(AC1) ;STORE FLAGS,,OFFSET IN WORD 3 POP P,AC0 ;RESTORE TAG NAME MOVEM AC0,1(AC1) ;STORE IN WORD 2 MOVEM AC1,LBLPNT ;UPDATE START POINTER RET ;[735] RETURN TO STMNT PROCESSING ;HERE IF TAG ALREADY DEFINED LABEL2: SKIPE LITLVL ;IN LITERAL? JRST LABEL3 ;YES, DEFINITE ERROR HRLOM V,LOCBLK ;SAVE LIST LOCATION IFN FTPSECT,< ;[575] SKIPN SGNMAX ;[770] DOING PSECT? JRST LABEL8 ;[770] NO, DON'T NEED TO CHECK PSECTS SKIPN MODA ;[776] RELOCATABLE? JRST LABEL8 ;[776] NO, JUMP, DON'T DO PSECT CHECK MOVE AC1,SGNCUR ;[770] GET CURRENT PSECT CAME AC1,SGWFND ;[770] SAME PSECT? JRST LABEL3 ;[770] NO, FLAG MULTIPLY DEFINED LABEL8:> ;[770] CAMN V,LOCA ;DOES IT COMPARE WITH PREVIOUS? WFW CAME RC,MODA LABEL3: TLOA ARG,MDFF ;NO, FLAG MULTIPLY DEFINED AND SKIP JRST LABEL7 ;YES, GET RID OF EXTRA CHARS. TRO ER,ERRM ;FLAG MULTIPLY DEFINED ERROR CALL UPDATE ;UPDATE AND EXIT JRST LABEL9 ;GET RID OF EXTRA CHARS. ;HERE IF EXPRESSION PRECEEDING COLON LABEL4: CAMN AC0,LOCA ;DO THEY COMPARE? CAME RC,MODA LABEL5: TRO ER,ERRP ;NO, FLAG PHASE ERROR JRST LABEL9 ;GET RID OF EXTRA CHARS. LABEL7: JUMPN MRP,LABEL9 ;[1001] DON'T RESET OFFSET IF EXPANDING MOVEM AC0,TAG ;SAVE FOR ERRORS SKIPN LITLVL ;[774] DON'T RESET OFFSET IN LITERAL SETZM TAGINC ;[576] LABEL9: CALL PEEK ;INSPECT A CHAR. CAIN C,":" ;COLON? CALL GETCHR ;YES, DISPOSE OF IT CALL PEEK ;EXAMINE ONE MORE CHAR. CAIN C,"!" ;EXCLAMATION? JRST GETCHR ;YES, INDEED RET SUBTTL ATOM PROCESSOR ATOM: CALL CELL ;GET FIRST CELL SETZ PR, ;[747] TLNE IO,NUMSW ;IF NON-NUMERIC ATOM1: CAIE C,42 ;OR NOT A BINARY SHIFT, RET ;EXIT PUSH P,AC0 ;STACK REGISTERS, ITS A BINARY SHIFT PUSH P,AC1 PUSH P,RC PUSH P,CURADX ;[613] PUSH CURRENT RADIX HRRI AC0,^D10 ;[613] COMPUTE SHIFT IN RADIX 10 HRRZM AC0,CURADX ;[613] STORE IN CURRENT RADIX SETOM BSHFLG ;[1054] IN CASE B^-ARG CALL CELLSF ;GET SHIFT SETZM BSHFLG ;[1054] MOVE ARG,RC ;SAVE RELOCATION POP P,CURADX ;[613] RESTORE CURRENT RADIX POP P,RC POP P,AC1 MOVN SX,AC0 ;USE NEGATIVE OF SHIFT POP P,AC0 JUMPN ARG,NUMER2 ;IF NOT ABSOLUTE TLNN IO,NUMSW ;AND NUMERIC, JRST NUMER2 ;FLAG ERROR IFN POLISH,< CAME SX,[-^D35] ;SPECIAL TEST FOR B35 JUMPN RC,ATOM3 ;[1037] JUMP IF RELOCATABLE OR POLISH > LSHC AC0,^D35(SX) LSH RC,^D35(SX) JRST ATOM1 ;TEST FOR ANOTHER IFN POLISH,< ;HERE IF WE HAVE RELOCATABLE OR POLISH VALUES TO BE B-SHIFTED ;CONVERT TO A POLISH EXPRESSION USING UNDER-SCORE SHIFT ATOM3: HRRZ PS,(P) ;[1037] GET RETURN ADDRESS CAIN PS,EVATOM+1 ;[1037] IF IN EXPRESSION EVAL JRST ATOM2 ;[1037] YES PUSH P,CS ;[1037] PUSH P,C ;[1037] HRREI AC0,POLFWF ;[1037] MOVEM AC0,POLTYP ;[1037] MOVEI AC0,^D35(SX) ;[1037] NO MOVE PS,CSTAT+'_' ;[1037] TLNE CS,17000 ;[1037] PART OF LARGER EXPRESSION SETOM BSHIFT ;[1037] YES, FLAG IT CALL FORCEP ;[1037] POLISH OF _ SETZM BSHIFT ;[1037] POP P,C ;[1037] POP P,CS ;[1037] TLNE CS,170000 ;[1037] OPERATOR FOLLOWING, THUS PART OF EXP? CALL MOVSTK ;[1037] TLZ FR,POLSW ;[1037] JRST ATOM1 ;[1037] ATOM2: POP P,(P) ;REMOVE TOP ADDRESS MOVE PS,(P) ;GET NODE CAME PS,[TNODE,,0] ;NOTHING THERE YET? JRST .+3 ;YES, BYPASS INITIALIZATION MOVSI PS,4000 ;NO, FAKE IT ADDM PS,(P) ;PS PUSH P,AC0 ;CV PUSH P,RC ;RC PUSH P,CSTAT+'_' ;CS SETZB RC,EXTPNT MOVEI AC0,^D35(SX) ;SHIFT ARG JRST EVGETD ;EVALUATE > CELLSF: TLO IO,FLDSW CELL: SETZB AC0,RC ;CLEAR RESULT AND RELOCATION SETZB AC1,AC2 ;CLEAR WORK REGISTERS MOVEM P,PPTEMP ;SAVE PUSHDOWN POINTER TLZ IO,NUMSW TLZA FR,NEGSW!DCFSW!RADXSW CELL1: TLO IO,FLDSW AOSLE UPARRO ;SKIP GETCHR IF RE-EATING ^ CALL BYPASS ;[664] SKIPE .IFFLG ;[1112] DOING .IF/.IFN? JRST %IFCHK ;[1112] YES - DO "NAME" CHECKING CELL1A: ;[1112] AND POSSIBLY RESUME HERE LDB V,[POINT 4,CSTAT(C),14] ;GET CODE XCT .+1(V) ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE JRST CELL1 ;0; BLANK, (TAB OR "+") JRST LETTER ;1; LETTER ] $ % ( ) , ; > TLC FR,NEGSW ;2; "-" TLO FR,INDSW ;3; "@" JRST NUM1 ;4; NUMERIC 0 - 9 JRST ANGLB ;5; "<" JRST SQBRK ;6; "[" JRST QUOTES ;7; ""","'" JRST QUAL ;10; "^" JRST PERIOD ;11; "." TROA ER,ERRQ ;12; ERROR, FLAG AND TREAT AS DELIMITER ;12; ! # & * / : =? \ _ LETTER: TLOA AC2,(POINT 6,AC0,) ;SET BYTE POINTER LETTE1: CALL GETCHR ;GET CHARACTER TLNN CS,6 ;ALPHA-NUMERIC? JRST LETTE3 ;NO,TEST FOR VARIABLE TLNE AC2,770000 ;STORE ONLY SIX BYTES LETTE2: IDPB C,AC2 ;RETURN FROM PERIOD JRST LETTE1 LETTE3: CAIE C,03 ;"#"? RET SETZM .IFNAM ;[1112] NOT SIMPLE RADIX50 NAME JUMPE AC0,CPOPJ ;[664] TEST FOR NULL CALL PEEK ;PEEK AT NEXT CHAR. CAIN C,"#" ;IS IT 2ND #? JRST LETTE4 ;YES, THEN IT'S AN EXTERN TLO IO,DEFCRS CALL SSRCH ;YES, SEARCH FOR SYMBOL (OPERAND) MOVSI ARG,SYMF!UNDF ;NOT FOUND, FLAG AS UNDEFINED SYM. TLNN ARG,UNDF ;UNDEFINED? JRST LETTE5 ;NO, BUT SEE IF ALREADY DEFINED AS EXTERNAL TLC ARG,LTAGF ;[742] PART OF LTAGF? TLCN ARG,LTAGF ;[742] JRST GETCHR ;[742] YES, GET NEXT CHR AND RETURN TLO ARG,VARF ;YES, FLAG AS A VARIABLE TRO ER,ERRU ;SET UNDEFINED ERROR FLAG CALL INSERZ ;INSERT IT WITH A ZERO VALUE JRST GETDEL LETTE4: CALL GETCHR ;AND SCAN PAST IT TLZ IO,DEFCRS ;MAKE SURE NOT A DEFINITION TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL EXTER5 ;PUT IN SYMBOL TABLE JRST GETCHR ;GET RID OF # LETTE5: TLNE ARG,EXTF ;EXTERNAL TRO ER,ERRQ ;YES, FLAG WITH "Q" ERROR JRST GETCHR ;GET NEXT CHAR AND RETURN NUMER1: SETZB AC0,RC ;RETURN ZERO NUMER2: TROA ER,ERRN ;[1034] FLAG ERROR GETDEL: CALL GETCHR GETDE1: JUMPE C,.-1 MOVEI AC1,0 GETDE3: TLO IO,NUMSW!FLDSW ;FLAG NUMERIC TLNN FR,NEGSW ;IS ATOM NEGATIVE? RET ;NO, EXIT JUMPE AC1,GETDE2 MOVNS AC1 TDCA AC0,[-1] GETDE2: MOVNS AC0 ;YES, NEGATE VALUE MOVNS RC ;AND RELOCATION RET ;[664] EXIT QUOTES: CAIE C,"'"-40 ;IS IT "'" JRST QUOTE ;NO MUST BE """ JRST SQUOTE ;YES QUOTE0: TLNE AC0,376000 ;5 CHARACTERS STORED ALREADY? TRO ER,ERRQ ;YES, GIVE WARNING ASH AC0,7 IOR AC0,C QUOTE: CALL CHARAC ;GET 7-BIT ASCII CAIG C,15 ;TEST FOR LF, VT, FF OR CR CAIGE C,12 JRST .+2 ;NO, SO ALL IS WELL JRST QUOTE2 ;ESCAPE WITH Q ERROR CAIE C,42 JRST QUOTE0 CALL PEEK ;LOOK AT NEXT CHAR. CAIE C,42 JRST QUOTE1 ;RESTORE REPEAT LEVEL AND QUIT CALL CHARAC ;GET NEXT CHAR. JRST QUOTE0 ;USE IT QUOTE2: TRO ER,ERRQ ;SET Q ERROR QUOTE1: JRST GETDEL SQUOT0: CAIL C,"a" ;TEST FOR LOWER CASE CAILE C,"z" ;... JRST .+2 ;NO SUBI C," " TLNE AC0,770000 ;SIX CHARS. STORED ALREADY ? TRO ER,ERRQ ;YES LSH AC0,6 IORI AC0,-40(C) ;OR IN SIXBIT CHAR. SQUOTE: CALL CHARAC CAIGE C," " ;VALID SIXBIT? JRST QUOTE2 ;FLAG WITH "Q" ERROR CAIE C,"'" JRST SQUOT0 CALL PEEK CAIE C,"'" JRST QUOTE1 CALL CHARAC JRST SQUOT0 QUAL: CALL BYPASS ;[664] SKIP BLANKS, GET NEXT CHARACTER CAIN C,'B' ;"B"? JRST QUAL2 ;YES, RADIX=D2 CAIN C,'O' ;"O"? JRST QUAL8 ;YES, RADIX=D8 CAIN C,'F' ;"F"? JRST NUMDF ;YES, PROCESS DECIMAL FRACTION CAIN C,'L' ;"L"? JRST QUALL ;YES CAIN C,'-' ;"^-" IS NOT JRST QUALN CAIE C,'D' ;"D"? JRST NUMER1 ;NO, FLAG NUMERIC ERROR ADDI AC2,2 QUAL8: ADDI AC2,6 QUAL2: ADDI AC2,2 PUSH P,FR ;[613] PUSH CURRENT FLAGS PUSH P,CURADX ;[613] PUSH CURRENT RADIX HRRM AC2,CURADX ;[613] CALL CELLSF POP P,CURADX ;[613] RESTORE TO ORIGINAL RADIX QUAL2A: POP P,FR ;[613] RESTORE FLAGS TLNN IO,NUMSW JRST NUMER1 JRST GETDE1 QUALL: PUSH P,FR CALL CELLSF MOVE AC2,AC0 MOVEI AC0,^D36 SETZ RC, ;IN CASE ARG IS RELOCATABLE JUMPE AC2,QUAL2A LSH AC2,-1 SOJA AC0,.-2 QUALN: SKIPN BSHFLG ;[1054] DOING B-SHIFT? JRST QUALN1 ;[1054] NO, EVALUATE AT EXP-LEVEL ;[1054] THIS IS A KLUDGE TO ALLOW ^- TO INTERACT CORRECTLY WITH ;THE B-SHIFT OPERATOR. B-SHIFT OPERATIONS, UNLIKE UNDERSCORE-SHIFT ;OPERATIONS, MUST BE PERFORMED AT CELL-LEVEL (AS THEY ARE SEEN) ;SINCE NOT EVERY CASE CAN BE HANDLED AT EXPRESSION-EVALUATION ;LEVEL (E.G., ^F123.45B17, ^F123.45B17B35, B35, ;100B, ETC.). UNARY OPERATORS, HOWEVER, ARE SUPPOSED TO ;TAKE PRIORITY OVER SHIFT OPERATORS. THEREFORE, IF A UNARY ;OPERATOR IS SEEN DURING THE EVALUATION OF A B-SHIFT ;ARGUMENT, THE UNARY OPERATION MUST BE PERFORMED IMMEDIATELY. PUSH P,FR ;[1054] YES, HAVE TO DO IT NOW CALL CELLSF ;[1054] GET CELL SETCA AC0, ;[1054] COMPLEMENT IT JRST QUAL2A ;[1054] CONTINUE QUALN1: MOVE CS,CSTATN ;[1054] GET CHARACTERISTICS FOR "^-" JRST GETDE1 ;THEN GET DELIMITER SUBTTL LITERAL PROCESSOR SQBRK: PUSH P,LBLFLG ;[1074] SAVE PREVIOUS LABEL-IN-LIT FLAG SETZM LBLFLG ;[1074] CLEAR CURRENT LABEL-IN-LIT FLAG PUSH P,TAG ;[1074] SAVE CURRENT TAG PUSH P,FR PUSH P,EXTPNT ;ALLOW EXTERN TO PRECEDE LIT IN XWD SETZM EXTPNT PUSH P,INOPDF ;[1006] TO ALLOW LITERAL IN OPDEF DEFINITION SETZM INOPDF ;[1006] IFN FORMSW,< PUSH P,IOSEEN> ;SAVE I/O INSTRUCTION SEEN VALUE IFN POLISH,< ;[560] PUSH P,INANGL ;SAVE INANGL SETZM INANGL PUSH P,INASGN ;SAVE INASGN SETZM INASGN PUSH P,POLTYP ;SAVE AND INIT POLTYP SETZM POLTYP PUSH P,POLITS ;SAVE PTR TO LITS STILL TO FIXUP SETZM POLITS ;START AFRESH > SKIPE LITLVL ;FIRST TIME IN LIT? JRST SQB5 ;NO, ALREADY IN LIT, DOING NESTING FORERR (C,LIT) ;YES, FIRST TIME, SAVE SEQNO AND PAGE MOVE AC0,LITABX ;SAVE POINTER INTO LITERAL POOL MOVEM AC0,SQBST ;AS THE START OF LITERAL TAG FIXUP SQB5: AOS LITLVL ;BUMP NESTING OF LITERALS IFN FTPSECT,< ;[1074] AOS SGLITL ;[1074] BUMP 'ALL PSECT' NESTING LEVEL > ;[1074] PUSH P,STPX ;SAVE STATE OF BINARY BUFFER PUSH P,STPY PUSH P,LSTPY ;SAVE CURRENT LITERAL VARIABLES MOVE AC0,STPX MOVEM AC0,STPY MOVEM AC0,LSTPY PUSH P,[0] ;MAKE PLACE TO KEEP ERROR FLAG HRRM ER,0(P) ;SAVE CURRENT ERROR FLAGS TRZ ER,ERRF ;START WITH CLEAN SLATE SQB3: CALL STMNT TRNE ER,ERRORS+ERRF ;ANY ERRORS THIS WORD? HRROS 0(P) ;YES, REMEMBER FOR STOLIT TLO IO,IORPTC ;REPEAT TERMINATOR, UNLESS... CAIN C,75 ;IT WAS A CLOSE BKT TLZ IO,IORPTC MOVEI AC1,0 ;SAY "]" NOT SEEN, UNLESS... CAIE C,75 ;"]" TERMINATED STATMENT? TLNE FR,MWLFLG ;OR NO MULTI-LINE LITS? TRO AC1,1 ;YES, NOTE LITERAL TERMINATED SKIPN LITLST ;NEW FORMAT LISTING? JUMPN AC1,SQB2A ;NO, JUMP IF LITERAL DONE SKIPE AC1 ;LITERAL TERMINATED? SOS LITLVL ;YES, MUST NOT CONFUSE CHARAC SQB4: CALL CHARAC ;BYPASS NON-SIGNIFICANT CHARS CAIE C," " ;SPACE CAIN C,HT ;TAB JRST SQB4 CAIN C,";" ;COMMENT? JRST SQB6 ;YES, IGNORE SQUARE BRACKETS SQB4A: SKIPE AC1 ;LITLVL SOS'D ABOVE? AOS LITLVL ;YES, PUT IT BACK CAILE C,CR ;LOOK FOR END OF LINE JRST [ JUMPN AC1,SQB2 ;JUMP IF SOMETHING AFTER "]" CAIN C,"]" ;POSSIBLY A LITERAL TERM? JRST SQB2A ;YES TRO ER,ERRQ ;JUNK ON LINE, OTHER THAN "]" JRST SQB4] ;SKIP IT AND LOOK FOR EOL PUSH P,AC1 ;SAVE LITERAL TERMINATED FLAG CALL OUTIML ;DUMP SKIPN LITLVL ;[1134] NESTED IN PSECT WITH NO LITS? JRST [ JUMP2 .+1 ;[1134] YES - ONLY DURING PASS 1 AOS CS,STPX ;[1134] NO. OF LOCATIONS STOWED ADDM CS,LOCO ;[1134] UPDATE OUTPUT LOC CALL STOWI ;[1134] INITIALIZE FOR NEXT STOW JRST .+1] ;[1134] POP P,AC1 ;RECOVER FLAG JUMPN AC1,SQB1 ;JUMP IF LITERAL TERMINATED CALL CHARAC ;GET ANOTHER CHAR. SKIPGE LIMBO ;[1003] IF CRLF, CHECK FOR FF CALL [ CALL CHARAC ;[1003] CAIN C,FF ;[1003] JRST OUTFF3 ;[1003] RET] ;[1003] TLO IO,IORPTC ;[1003] SET REPEAT JRST SQB3 SQB6: CALL CHARAC ;GET A CHARACTER CAIG C,CR CAIN C,HT ;LOOK FOR END OF LINE CHAR. JRST SQB6 ;NOT YET JRST SQB4A ;GOT IT SQB1: TLNE IO,IOSALL ;SALL AND IN MACRO? JUMPN MRP,SQB2 ;IF SO, DON'T REPEAT TERMINATOR HRRZ C,LIMBO ;GET TERMINATOR SOSG CPL ;PUT IT IN IMAGE BUFFER CALL RSW5 IDPB C,LBUFP SQB2: TLO IO,IORPTC ;REPEAT TERMINATOR SQB2A: SKIPGE 0(P) ;ERROR ANYWHERE IN LITERAL? TRO ER,ERRF ;YES, PREVENT COMPRESSION MOVE AC1,LITNUM ;SAVE LITNUM BEFORE UPDATED IN MOVEM AC1,LITN ;STOLIT IN CASE NEEDED FOR SQBTGS CALL STOLIT SKIPE LBLPNT ;ANY TAGS IN LITERAL TO FIX UP? CALL SQBTGS ;YES, (ONLY ON PASS2) POP P,AC1 ;RECOVER ER AS BEFORE LIT TRNE AC1,ERRORS+ERRF ;ANY ERRORS? TRO ER,ERRF ;YES, KEEP ONLY ERRF POP P,LSTPY ;RESTORE LITERAL VARIABLES POP P,STPY ;RESTORE PREVIOUS STATE OF CODE BUFFER POP P,STPX SOS LITLVL ;ONE LESS NESTING OF LITERALS IFN FTPSECT,< ;[1074] SOS SGLITL ;[1074] ONE LESS 'ALL PSECT' LIT LEVEL > ;[1074] IFN POLISH,< SKIPE POLITS ;NEED TO FIXUP ANY POLISH? CALL SQBPOL ;YES POP P,POLITS ;RESTORE NEXT LEVEL PTR POP P,POLTYP ;RESTORE POLTYP POP P,INASGN ;RESTORE NEXT LEVEL INASGN POP P,INANGL ;RESTORE NEXT LEVEL INANGL > ;[560] IFN FORMSW,< POP P,IOSEEN> ;RESTORE IOSEEN FOR LISTING POP P,INOPDF ;[1006] RESTORE INOPDF SETTING POP P,EXTPNT POP P,FR POP P,TAG ;AND LABEL POP P,LBLFLG ;[1074] AND LABEL-IN-LITERAL FLAG SKIPE LITLVL ;WERE WE NESTED? JUMP1 SQB2F ;YES, FORCE ERROR IF PASS 1 JUMP2 GETDEL ;USE VALUE GIVEN IF PASS 2 TRO ER,ERRU ;VALUE IS UNDEFINED ON PASS 1 TDZA AC0,AC0 ;SO SET IT TO 0 SQB2F: TRO ER,ERRF ;SET FAKE ERROR FLAG JRST GETDEL ;HERE DURING PASS2 TO STORE REAL VALUES FOR TAGS IN LITERAL. ;IF NO REFERRENCES YET, THE TAG IS INSERTED INTO SYMTAB WITH REAL-V. ;IF THERE ARE FORWARD REFERENCES, A POINTER TO A 2-WORD LOCAL BLOCK ;REPLACES THE EXTERNAL NAME OF THE ORIGINAL 2WORD PAIR. LOCAL BLOCKS ;ARE CHAINED IN CHNLOC ROUTINE AT THE END OF PASS2, ;AND HAS THE FOLLOWING FORMAT WHEN IT IS FIRST CREATED HERE: ; ; TAG-REAL-VALUE,,TAG-FLAGS ; TAG-RELOCATION..0 ; ;ALL MEMORY LOCATIONS RELATED TO THE PROCESSING OF TAGS IN LITERALS ;ARE CLEARED WHEN THE OUTER MOST (LEVEL 1) LITERAL IS BEING CLOSED. ; SQBTGS: PUSH P,RC ;SAVE BUNCH OF ACS THAT WE NEED PUSH P,V PUSH P,AC0 PUSH P,AC1 PUSH P,ARG PUSH P,SX MOVE AC2,LITHDX ;GET HEADER BLOCK HLRZ RC,-1(AC2) ;GET BLOCK RELOCATION MOVEM RC,LITRC ;SAVE IT HRRZ AC0,-1(AC2) ADD AC0,LITN ;COMPUTE ACTUAL LOCATION MOVEM AC0,LITV ;ACTUAL START LOCATION OF THIS LITERAL MOVE AC1,LBLPNT ;GET START OF LITERAL TAG CHAIN SQBTG1: HRRZ AC0,(AC1) MOVEM AC0,LBLNXT ;ADDRESS OF NEXT BLOCK IN CHAIN HLRZ AC0,(AC1) ;GET LIT LEVEL CAME AC0,LITLVL ;SAME AS THE LITERAL BEING CLOSED? JRST [ MOVEM AC1,LBLPNT ;NO, UPDATE CHAINS STARTING ADDR JRST SQBTG3] ;GO RESTORE ACS AND RETURN MOVE AC0,1(AC1) ;YES, GET TAG NAME PUSH P,AC1 ;SSRCH USES AC1 CALL SSRCH ;SETUP POINTER INTO SYMBOL TABLE JFCL ;[740] SQBTG5: POP P,AC1 HRRZ V,2(AC1) ;GET OFFSET ADD V,LITV ;ADD IN THE START LOCATION MOVEI RC,-1 ;PUT -1 AS LIT LEVEL HRLM RC,(AC1) ;TO FLAG THIS TAG HAS BEEN PROCESSED MOVE RC,LITRC ;GET BLOCK RELOCATION TLZE ARG,TREF ;[740] WAS IT REFERENCED? CLEAR FLAG JRST [ PUSH P,AC2 ;[735] NEED AN AC FOR A WHILE MOVEI AC2,2 ;[735] GET 2 WORDS ADDB AC2,FREE ;[735] FROM FREE SPACE CAML AC2,SYMBOL ;[735] CHECK TO SEE IF ENOUGH CALL XCEEDS ;[735] SUBI AC2,2 ;[735] HRRZM AC2,1(ARG) ;[735] MAKE 2ND WORD POINT TO IT HLL V,2(AC1) ;[735] GET SYMBOL FLGS OF THE TAG MOVSM V,0(AC2) ;[735] STORE IN 1ST WORD OF NEW PAIR MOVE V,LITRC ;[735] GET RELOCATION OF TAG MOVSM V,1(AC2) ;[735] STORE IN 2ND WORD OF NEW PAIR POP P,AC2 ;[735] RESTURE AC2 JRST SQBTG2] ;[735] HLLZ ARG,2(AC1) ;[735] NO REFERRENCES, GET FLAGS TLZ ARG,EXTF+PNTF ;[740] MAKE SURE THEY ARE OFF CALL INSERT ;[735] JUST ADD TO SYMBOL TABLE SQBTG2: SKIPE AC1,LBLNXT ;ARE THERE ANY MORE TAGS TO FIXUP? JRST SQBTG1 ;YES, SQBTG3: MOVE SX,LITLVL ;OUTERMOST LITERAL BEING CLOSED? SOJG SX,SQBTG4 ;NO, JUMP SETZM LBLPNT ;YES, CLEAR MEMORY LOCATIONS SETZM LBLNXT SETZM LITV SQBTG4: POP P,SX ;NO, RESTORE ACS POP P,ARG POP P,AC1 POP P,AC0 POP P,V POP P,RC RET IFN POLISH,< ;HERE TO FIXUP POLISH EXPRESSIONS INSIDE CURRENT LIT ;AS EACH ONE IS FIXED MOVE IT TO POLIST SQBPOL: PUSH P,CS ;GET SOME FREE ACCS PUSH P,AC0 ;SAVE LOC SQBPL1: MOVE CS,@POLITS ;GET A BLOCK POINTER EXCH CS,POLITS ;SET FOR NEXT TIME MOVE AC0,CS ;GET A COPY EXCH AC0,POLIST ;STORE IN LIST OF "GOOD" POLISH MOVEM AC0,(CS) ;LINK IN SQBPL2: ADDI CS,1 ;FIRST WORD MOVE AC0,(CS) ;GET SOMETHING JUMPL AC0,SQBPL5 ;THIS IS AN OPERATOR JUMPE AC0,SQBPL4 ;18 BIT VALUE SOJE AC0,SQBPL3 ;36 BIT VALUE AOJA CS,SQBPL2 ;SYMBOL SQBPL3: ADDI CS,1 ;SKIP OVER 2 WORDS SQBPL4: AOJA CS,SQBPL2 ;GET NEXT SQBPL5: HRRZ AC0,AC0 ;GET OPERATOR ONLY CAIGE AC0,-6 ;CHECK FOR STORE OP JRST SQBPL2 ;ITS NOT MOVE AC0,0(P) ;GET ADDRESS ADDM AC0,1(CS) ;ADD TO OFFSET HRLM RC,1(CS) ;SET RELOCATION SKIPE POLITS ;MORE TO DO? JRST SQBPL1 ;YES POP P,AC0 ;RESTORE LOC POP P,CS ;AND SAVED AC RET > SUBTTL NUMBER PROCESSOR ANGLB: IFN POLISH,< PUSH P,XWDANG ;[706] PUSH PTR TO LH POL SETZM XWDANG ;[706] ZERO LH POL PUSH P,INANGL ;PUSH CURRENT STACK PTR OR MARKER SETOM INANGL ;NOTE STARTING ANG BKTS SETOM .IFANG ;[1056] SET FLAG FOR .IF(N) PUSH P,INXWD ;[1010] SAVE XWD SETTING SETZM INXWD ;[1010] AND CLEAR PUSH P,POLTYP ;[634] PUSH CURRENT POLISH FIXUP TYPE > PUSH P,INOPDF ;[1011] SAVE DOING OPDEF SETTING SETZM INOPDF ;[1011] SETZM BSHFLG ;[1054] CLEAR FLAG FOR QUALN PUSH P,FR TLZ FR,INDSW+POLSW CALL ATOM SKIPN .IFFLG ;[1112] DOING .IF/.IFN? JRST ANGLB7 ;[1112] NO SKIPN .IFNAM ;[1112] STILL LOOKING AT RADIX50 NAME? JRST ANGLB7 ;[1112] NO CAIE C,'>' ;[1112] MUST HAVE CLOSE BRACKET NEXT JRST ANGLB6 ;[1112] DON'T - NOT A "NAME" SKIPG .IFNAM ;[1112] NESTED ANGLE BRACKETS? JRST ANGLB5 ;[1112] NO - FIRST SET SKIPN AC0 ;[1112] "NAME" MUST BE THE ONLY ATOM JRST ANGLB7 ;[1112] IT IS - CONTINUE JRST ANGLB6 ;[1112] NOT JUST "NAME" ANGLB5: SKIPN AC0 ;[1112] MUST HAVE ATOM FOR "NAME" JRST ANGLB6 ;[1112] DON'T MOVNS .IFNAM ;[1112] "NAME" FOUND IN ANGLE BRACKETS SKIPA ;[1112] SKIP CLEAR ANGLB6: SETZM .IFNAM ;[1112] ELSE CAN'T BE A SIMPLE RADIX50 NAME ANGLB7: ;[1112] TLNN IO,NUMSW CAIE C,35 ;= JRST ANGLB1 CALL ASSIG1 MOVE AC0,V JRST ANGLB2 ANGLB1: CALL EVALHA ANGLB2: POP P,FR IFN POLISH,< JUMP1 ANGLB4 ;[747] JUMP OVER THESE CODE IN PASS1 TRNE FRR,NOPSW ;[771] DOING NO POLISH? JRST ANGLB4 ;[771] YES, JUMP OVER PUSH P,[0,,POLFWF] ;[706] SET POLTYP POP P,POLTYP ;[706] SETCM AC1,INANGL ;GET FLAG JUMPN AC1,[CALL ANGPOL ;[773] JUMP IF POLISH JRST ANGNEG] ;[773] TDNN RC,[-2,,-2] ;[747] NO POLISH, BUT ANY EXTERNALS? JRST ANGLB4 ;[747] NO EXTERNALS EITHER, JUMP CALL ANGEXT ;[773] NO POLISH BUT HAVE EXTERNALS ANGNEG: TLZN FR,NEGSW ;[747] NEGATIVE? JRST ANGLB3 ;[1105][727] NO, JUMP CALL FNEGP ;[727] YES, DO IT MOVE RC,INANGL ;[727] CALL MOVSTK ;[727] SETZM INANGL ;[727] TLO FR,POLSW ;[727] ANGLB3: TRZ FRR,FWPSW ;[1105] CLEAR FULLWORD FIXUP ANGLB4: POP P,INOPDF ;[1011] RESTORE POP P,POLTYP ;[727] RESTORE POLISH FIXUP TYPE TO BEFORE POP P,INXWD ;[1010] RESTORE XWD SETTING TO BEFORE POP P,INANGL ;GET CURRENT STATUS POP P,XWDANG ;[706] RESTORE PTR TO LH POL > CAIE C,36 ;CLOSE ANGBKT? JRST [ TRO ER,ERRN ;[1142] FLAG ERROR CAIN C,EOL ;[1142] END OF LINE SEEN? TLO IO,IORPTC ;[1142] YES - DO NOT DISCARD JRST .+1] ;[1142] JRST GETDEL ;HERE IF WE HAVE POLISH IN ANGLE BRACKETS-- MUST DECIDE WHICH CASE ;WE HAVE AND SETUP XWDLRC, XWDRRC, XWDLV, XWDRV: ; ; CASES RC XWDANG INANGL ; ----- -- ------ ------ ; 0 0 POL ; INXWD/0 DIFFERENCIATE FROM <0,,POL> ; 0,,0 POL1 POL2 ; 0,,0 POL1 POL1 ; XWDRRC/POL1 TO DIFFERENTCIATE FROM ; 0,,EXT POL1 POL1 ; 0,,0 POL1 POL1 ; 0,,1 POL1 POL1 ; EXT,,0 0 POL2 ; 0,,0 0 POL2 ; 1,,0 0 POL2 IFN POLISH,< ANGPOL: JUMPN CV,.+4 ;[1026] JUMP IF CURRENT VALUE NOT ZERO SKIPN INXWD ;[1010] DOING XWD? JRST ANGFW ;[1010] NO, JUMP SETZM INXWD ;[1010] YES, CLEAR FLAG FIRST AND PROCESS MOVEM CV,XWDRV ;[773] STORE RIGHT VALUE MOVEM CV,XWDLV ;[773] STORE LEFT VALUE PUSH P,RC ;[773] NEED AN AC TO WORK SKIPN RC,XWDANG ;[773] DO WE HAVE ? JRST [ POP P,RC ;[773] RESTORE ORIGINAL RC PUSH P,INANGL ;[773] SAVE RIGHT PTR CALL ANGEXL ;[773] GO CHECK LEFT EXTERNAL POP P,RC ;[773] GET RIGHT PTR JRST ANGPO1] ;[773] MOVEM RC,SAVRC ;[1013][773] MOVEM RC,SAVCV ;[773] PUSH P,INANGL ;[773] SAV RT PTR PUSH P,XWDRRC ;[773] SAVE ORIGINAL XWDRRC CALL ANGFPL ;[773] DO LEFT SHIFT POLISH POP P,XWDRRC ;[773] MOVEM RC,XWDLRC ;[773] TO FREE SPACE & UPDATE LEFT RC MOVEM RC,XWDLV ;[773] AND LEFT VALUE POP P,RC ;[773] GET INANGLE INTO RC CAMN RC,XWDANG ;[773] INANGLE = XWDANG? JRST [ CAMN RC,XWDRRC ;[773] YES, IS IT WHERE LEFT POL=RIGHT POL? JRST [ POP P,0(P) ;[773] YES, JRST ANGPO1+1] ;[773] POP P,RC ;[773] NO, THEN THERE IS NO RIGHT POL CALL ANGEXR ;[773] RESTORE RC & GO CHECK RIGHT EXT CALL ANGFPB ;[773] ADDING BOTH HALVES JRST ANGEND] ;[773] RETURN POP P,0(P) ;[773] NO, FIXUP STK PTR ANGPO1: CALL MOVSTK ;[773] WE HAVE RC/RT PTR MOVEM RC,SAVRC ;[773] MOVEM RC,SAVCV ;[773] CALL ANGFPR ;[773] DO AND RIGHT HALF POLISH MOVEM RC,XWDRV ;[773] UPDATE RT V MOVEM RC,XWDRRC ;[773] UPDATE RT RC CALL ANGFPB ;[773] GO ADD JRST ANGEND ;[773] ;HERE IF NO POLISH IN ANGLE BRACKETS, BUT EXTERNALS-- ;MUST ALSO SETUP XWDLRC, XWDRRC, XWDLV, XWDRV: ;THE CASES THAT COME THRU HERE ARE: ; ; ; ; ANGEXT: TLNN RC,-1 ;[773] DO WE HAVE <0,,EXT>? JUMPE CV,CPOPJ ;[773] YES, RETURN MOVEM CV,XWDLV ;[773] LEFT VALUE MOVEM CV,XWDRV ;[773] RIGHT VALUE PUSH P,RC ;[773] CALL ANGEXL ;[773] GO CHECK LEFT EXTERNAL POP P,RC ;[773] CALL ANGEXR ;[773] GO CHECK RIGHT EXTERNAL CALL ANGFPB ;[773] GO ADD ANGEND: SETZM XWDLRC ;[773] ALL ANGXXX ROUTINE RETURN THRU HERE SETZM XWDLV ;[773] ZERO ALL WORKING ADDRS SETZM XWDRRC ;[773] SETZM XWDRV ;[773] SETZM SAVRC ;[773] SETZM SAVCV ;[773] RET ;[773] ANGEXL: TLNN RC,-2 ;[773] JRST [ HLLZM RC,XWDLRC ;[773] JUMP IF LEFT NOT EXTERNAL RET] ;[773] HLRZM RC,SAVRC ;[773] SETZM SAVCV ;[773] CALL ANGFPL ;[773] FORCE LEFT POLISH MOVEM RC,XWDLV ;[773] UPDATE LEFT VALUE MOVEM RC,XWDLRC ;[773] SET UP LEFT RD RET ;[773] ANGEXR: TRNN RC,-2 ;[773] JRST [ HRRZM RC,XWDRRC ;[773] JUMP IF RIGHT NOT EXTERNAL RET] ;[773] HRRZM RC,SAVRC ;[773] SETZM SAVCV ;[773] CALL ANGFPR ;[773] GO FORCE RIGHT POLISH MOVEM RC,XWDRV ;[773] UPDATE RIGHT VALUE MOVEM RC,XWDRRC ;[773] SET UP RIGHT RC RET ;[773] ;HERE ARE ROUTINES TO DO FORCED POLISH FOR ;RIGHT HALF, LEFT HALF, AND ADDING BOTH HALVES: ANGFPL: TLO FR,POLSW ;[773] DOING POLISH MOVEI CV,^D18 ;[773] OPERAND2 SETZ RC, ;[773] MOVE PS,CSTAT+'_' ;[773] SHIFT OPERATOR PJRST ANGLFP ;[773] ANGFPR: TLO FR,POLSW ;[1071][773] DOING POLISH HRRZI CV,-1 ;[773] OPERAND2 SETZ RC, ;[773] MOVE PS,CSTAT+'&' ;[706] FORCE AND WITH EXISTING PJRST ANGLFP ;[706] ANGFPB: PUSH P,XWDRRC ;[773] RIGHT RC POP P,SAVRC ;[773] IN SAVRC PUSH P,XWDRV ;[773] GET RIGHT VALUE POP P,SAVCV ;[773] IN SAVCV MOVE CV,XWDLV ;[773] LEFT VALUE IN CV MOVE RC,XWDLRC ;[773] LEFT RC IN RC MOVE PS,CSTAT+'+' ;[706] FORCE ADD ANGLFP: PUSH P,CS ;[773] CALL FORCPP ;[773] POP P,CS ;[773] ANGFW: TLO FR,POLSW ;[1010][773] FLAG POLISH MOVE RC,INANGL ;[706] PJRST MOVSTK ;[706] FORCE FIXUP, EXIT THRU MOVSTK > ;[706] END IFN POLISH PERIOD: CALL GETCHR ;LOOK AT NEXT CHARACTER TLNN CS,2 ;ALPHABETIC? JRST PERNUM ;NO, TEST NUMERIC MOVSI AC0,'. ' ;YES, PUT PERIOD IN AC0 MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER JRST LETTE2 ;AND TREAT AS SYMBOL PERNUM: SETZM .IFNAM ;[1112] NOT SIMPLE RADIX50 NAME TLNE CS,4 ;IS IT A NUMBER JRST NUM32 ;YES MOVE AC0,LOCA ;NO. CURRENT LOC SYMBOL (.) MOVE RC,MODA ;SET TO CURRENT ASSEMBLY MODE JRST GETDE1 ;GET DELIMITER NUMDF: TLO FR,DCFSW ;SET DECIMAL FRACTION FLAG NUM: CALL GETCHR ;GET A CHARACTER TLNN CS,4 ;NUMERIC? JRST NUM10 ;NO NUM1: SETOM .IFNUM ;[1056] FLAG NUMBER SEEN FOR .IF(N) SUBI C,20 ;CONVERT TO OCTAL PUSH P,C ;STACK FOR FLOATING POINT SKIPE AC0 ;ARE WE ABOUT TO LOSE SOME DATA? TRO ER,ERRQ ;YES, AT LEAST WARN USER MOVE AC0,AC1 MUL AC0,CURADX ;[613] ADD AC1,C ;ADD IN LAST VALUE CAML C,CURADX ;[613] IS NUMBER LESS THAN CURRENT RADIX? TLO FR,RADXSW ;NO, SET FLAG AOJA AC2,NUM ;YES, AC2=NO. OF DECIMAL PLACES NUM10: CAIE C,'.' ;PERIOD? TLNE FR,DCFSW ;OR DECIMAL FRACTION? JRST NUM30 ;YES, PROCESS FLOATING POINT SETZ CS, ;AND CLEAR IT CAIN C,'K' ;SEE IF SUFFIX THERE MOVEI CS,3 CAIN C,'M' MOVEI CS,6 CAIN C,'G' MOVEI CS,9 JUMPE CS,NUM12 ;NO SUFFIX? MOVE AC0,AC1 ;SCALE THE NUMBER MUL AC0,CURADX ;[613] SOJG CS,.-2 CALL GETCHR ;SKIP THE SUFFIX NUM12: MOVE CS,CSTAT(C) ;RESTORE STATUS LSH AC1,1 ;NO, CLEAR THE SIGN BIT LSHC AC0,^D35 ;AND SHIFT INTO AC0 MOVE P,PPTEMP ;RESTORE P SOJE AC2,GETDE1 ;NO RADIX ERROR TEST IF ONE DIGIT TLNE FR,RADXSW ;WAS ILLEGAL NUMBER ENCOUNTERED? TRO ER,ERRN ;YES, FLAG N ERROR JRST GETDE1 NUM30: CAIE C,'B' ;IF "B" THEN MISSING "." NUM31: CALL GETCHR TLNN CS,4 ;NUMERIC? JRST NUM40 ;NO NUM32: SUBI C,20 PUSH P,C JRST NUM31 NUM40: PUSH P,CURADX ;[613] STACK VALUES PUSH P,FR ;[640] PUSH P,AC2 HRRI AC2,^D10 ;[613] HRRZM AC2,CURADX ;[613] PUSH P,PPTEMP CAIE C,45 ;[1034] 'E'? JRST [MOVEI AC0,0 ;[1034] NO, ZERO EXPONENT JRST NUM41] ;[1034] CALL PEEK ;[1034] YES, GET NEXT CHAR PUSH P,C ;[1034] SAVE NEXT CHAR CALL CELL ;[1034] GET EXPONENT POP P,C ;[1034] RESTORE FIRST CHAR AFTER E CAIE V,4 ;[1034] MUST HAVE NUMERIC STATUS CAIN C,"<" ;[1034] ALLOW JRST NUM41 ;[1034] SKIPN AC0 ;[1034] ERROR IF NON-ZERO EXPRESSION TROA ER,ERRQ ;[1034] ALLOW E+,E- SETOM RC ;[1034] FORCE NUMERICAL ERROR NUM41: POP P,PPTEMP ;[1034] UNSTACK VALUES POP P,SX POP P,FR ;[640] POP P,CURADX ;[613] HRRZ V,P MOVE P,PPTEMP JUMPN RC,NUMER1 ;EXPONENT MUST BE ABSOLUTE ADD SX,AC0 HRRZ ARG,P ADD SX,ARG SETZB AC0,AC2 TLNE FR,DCFSW JRST NUM60 JOV NUM50 ;CLEAR OVERFLOW FLAG NUM50: JSP SDEL,NUMUP ;FLOATING POINT JRST NUM52 ;END OF WHOLE NUMBERS FMPR AC0,[10.0] ;MULTIPLY BY 10 TLO AC1,233000 ;CONVERT TO FLOATING POINT FADR AC0,AC1 ;ADD IT IN JRST NUM50 NUM52: JSP SDEL,NUMDN ;PROCESS FRACTION FADR AC0,AC2 JOV NUMER1 ;TEST FOR OVERFLOW JRST GETDE1 TLO AC1,233000 TRNE AC1,-1 FADR AC2,AC1 ;ACCUMULATE FRACTION FDVR AC2,[10.0] JRST NUM52 NUM60: JSP SDEL,NUMUP JRST NUM62 IMULI AC0,^D10 ADD AC0,AC1 JRST NUM60 NUM62: LSHC AC1,-^D36 JSP SDEL,NUMDN LSHC AC1,^D37 CALL BYPAS2 JRST GETDE3 DIVI AC1,^D10 JRST NUM62 NUMUP: MOVEI AC1,0 CAML ARG,SX JRST 0(SDEL) CAMGE ARG,V MOVE AC1,1(ARG) AOJA ARG,1(SDEL) NUMDN: MOVEI AC1,0 CAMG V,SX JRST 0(SDEL) CAMLE V,ARG MOVE AC1,0(V) SOJA V,3(SDEL) SUBTTL GETSYM GETSYM: CALL BYPASS ;[664][572] SKIP LEADING BLANKS GETSY0: MOVEI AC0,0 ;CLEAR AC0 MOVSI AC1,(POINT 6,AC0) ;PUT POINTER IN AC1 TLNN CS,2 ;ALPHABETIC? JRST GETSY1 ;NO, ERROR CAIE C,16 ;PERIOD? JRST GETSY2 ;NO, A VALID SYMBOL IDPB C,AC1 ;STORE THE CHARACTER CALL GETCHR ;YES, TEST NEXT CHARACTER TLNN CS,2 ;ALPHABETIC? GETSY1: TROA ER,ERRA GETSY2: AOS 0(P) ;YES, SET SKIP EXIT GETSY3: TLNN CS,6 ;ALPHA-NUMERIC? JRST GETSY4 ;NO TLNE AC1,770000 ;YES, HAVE WE STORED SIX? IDPB C,AC1 ;NO, STORE IT CALL GETCHR JRST GETSY3 CALL GETCHR ;TRY AGAIN FOR TERMINATOR GETSY4: JUMPE C,.-1 ;BYPASS TRAILING TAB/SP TLNE CS,6 ;ALPHANUMERIC? TLO IO,IORPTC ;YES, PUT IT BACK RET SUBTTL EXPRESSION EVALUATOR CV==AC0 ;CURRENT VALUE PV==AC1 ;PREVIOUS VALUE RC=RC ;CURRENT RELOCATABILITY PR==AC2 ;PREVIOUS RELOCATABILITY CS=CS ;CURRENT STATUS PS==SDEL ;PREVIOUS STATUS EVALHA: TLO FR,TMPSW EVALCM: CALL EVALEX ;EVALUATE FIRST EXPRESSION JUMPCM EVALC3 ;[625] JUMP IF COMMA IFN POLISH,< JUMPOC EVALC2 ;[625] SKIP FULL WORD TEST IF IN OP FIELD JUMPL RC,EVALC2 ;[625] JUMP IF ALREADY POLISH CAIE C,']' ;[1145] CURRENTLY AT END OF LITERAL? CAIN C,EOL ;[1145] OR END OF LINE? SKIPA ;[1145] YES - TRY FULLWORD FIXUP JRST EVALC2 ;[1135] NO - MAY BE OPCODE, PROCESS IN OP TLNN RC,-1 ;[1106] IS LEFT HALF ABSOLUTE TRNN RC,-2 ;[1106] AND RIGHT HALF EXTERNAL JRST EVALC2 ;[1106] NO, DON'T WANT FULLWORD TLNE AC0,-1 ;[1106] IS LEFT HALF ABSOLUTE 0? JRST EVALC2 ;[630] NO, JUMP SKIPN INASGN ;[630] IF DOING EITHER ASSIGNMENT SKIPE INANGL ;[630] OR IN ANGLE BRACKETS JRST EVALC2 ;[630] JUMP TRZN FRR,LTGSW ;[735] DON'T DO FWF IF GOT A TAG IN LIT SKIPE INOPDF ;[637] IN OPDEF? JRST EVALC2 ;[637] YES, TLNN FR,INDSW ;[630] IF DOING INDIRECT OR CAIN C,'(' ;[630] INDEXING JRST EVALC2 ;[630] JUMP TRNE FRR,PIDXSW ;[1104] IF DOING POLISH INDEXING JRST EVALC2 ;[1104] JUMP TRNE FRR,IDXSW ;[1107] DOING OP INDEXING? JRST EVALC2 ;[1107] YES - JUMP PUSH P,[POLFWF] ;[630] PASS ALL TESTS, MAKE IT FWF POP P,POLTYP ;[625] INPOLTYP CALL OCTFW ;[625] AS IF WE DID A EXP SETZM POLTYP ;[630] CLEAR IT AFTERWARDS EVALC2: > PUSH P,[0] ;MARK PDL TLO IO,IORPTC ;IT'S NOT,SO REPEAT JRST OP ;PROCESS IN OP EVALC3: PUSH P,[0] ;[625] MARK PDL IFN POLISH,< TLNN FR,POLSW ;POLISH FIXUP SEEN? JRST EVALC4 ;NO SETOM POLTYP ;REST MUST BE RIGHT HALF TRZ FRR,FWPSW ;[614] TRO FRR,LHPSW ;[614] MOVNI AC2,2 ;CHANGE THIS TO LEFT HALF SKIPE INASGN ;BUT IF SYMBOLIC MOVNI AC2,4 ;USE CORRECT STORE OP MOVEM AC2,@LSTOPR EVALC4:> IFN FORMSW, ;PUT FORM WORD ON STACK PUSH P,[0] ;STORE ZERO'S ON PDL PUSH P,[0] ;....... MOVSI AC2,(POINT 4,(P),12) JRST OP1B ;PROCESS IN OP EVALEX: ;[634] IFN POLISH,< TLNN FR,TMPSW ;UNLESS FIRST ATOM ALREADY READ, TLZ FR,POLSW ;CLEAR EVALUATING POLISH FLAG > PUSH P,[TNODE,,0] ;MARK THE LIST 200000,,0 TLZN FR,TMPSW EVATOM: CALL ATOM ;GET THE NEXT ATOM JUMPE AC0,EVGETD ;TEST FOR NULL/ZERO TLOE IO,NUMSW ;SET NUMERIC, WAS IT PREVIOUSLY? JRST EVGETD+1 ;YES, TREAT ACCORDINGLY CALL SEARCH ;SEARCH FOR MACRO OR SYMBOL JRST EVOP ;NOT FOUND, TRY FOR OP-CODE JUMPGE ARG,EVAS1 ;JUMP IF HAVE OPERATOR CAME AC0,1(SX) ;HAVE SYMBOL, OPERATOR ALSO DEFINED? JRST EVAS2 ;NO, USE WHAT WE HAVE ADDI SX,2 ;CHECK OPERATOR FIRST CALL SRCH5 ;LOAD REGISTERS EVAS1: SKIPN MACPRF ;MACRO DEF PREFERRED? JRST EVAS3 ;NO TLNE ARG,MACF+SYNF ;MACRO OR SYN? JRST [ TLO IO,FLDSW ;[634] YES, USE IT AND SET FLAG JRST EVAS2] ;[634] EVAS3: CAME AC0,-3(SX) ;NO, PROBABLY OPDEF. SYMBOL ALSO DEFINED? JRST [ TLNE ARG,MACF+SYNF ;[1147] NO, USE WHAT WE HAVE TLO IO,FLDSW ;[634][1147] AND SET FLAG FOR JRST EVAS2] ;[634][1147] MACROS AND SYNS SUBI SX,2 ;YES, SYMBOL BEFORE OPDEFS HERE CALL SRCH5 ;LOAD REGISTERS EVAS2: SKIPE .IFFLG ;[1056] DOING .IF(N)? IORM ARG,IFSRCH ;[1056] MERGE ARG BITS WITH PREVIOUS CALL QSRCH ;CREF WHAT WE FOUND IFN POLISH,< JUMPL RC,[TRNN FRR,NOPSW ;[705] IF A FIXUP, FLAG IT UNLESS NOPSW TLO FR,POLSW ;[705] JRST .+1] ;[705] > JUMPG ARG,EVMAC ;BRANCH IF OPERATOR MOVE AC0,V ;SYMBOL, SET VALUE JRST EVTSTS ;TEST STATUS EVMAC: TLNE FR,NEGSW ;UNARY MINUS? JRST EVERRZ ;YES, INVALID BEFORE OPERATOR LDB SDEL,[POINT 3,ARG,5] ;GET MACF/OPDF/SYNF SOJL SDEL,EVERRZ ;ERROR IF NO FLAGS SKIPE C ;[664] NON-BLANK? TLO IO,IORPTC ;YES, REPEAT CHARACTER SOJE SDEL,EVMAC1 ;MACRO IF 2 JUMPG SDEL,EVOPS ;SYNONYM IF 4 MOVE AC0,V ;OPDEF MOVEI V,OP ;SET TRANSFER VECTOR JRST EVOPD EVMAC1: SKIPE .IFFLG ;[1056] DOING .IF(N)? JRST EVGETD ;[1056] YES, DON'T ALLOW EXPANSION SKIPL MACENL ;ALREADY IN CALLM? JRST CALLM ;NO, EVALUATE MACRO SETZB RC,AC0 ;ZERO VALUE TRO ER,ERRA ;SET "A" ERROR JRST EVGETD ;CONTINUE EVALUATION EVOP: CALL OPTSCH ;SEARCH OP TABLE JRST EVOPX ;NOT FOUND TLNE FR,NEGSW ;OPCODE, UNARY MINUS? JRST EVERRZ ;YES, ERROR EVOPS: TRZ V,LITF ;CLEAR LIT INVALID FLAG TRZE V,ADDF ;SYNONYM JRST EVOPX ;PSEUDO-OP THAT GENERATES NO DATA JUMPS HLLZ AC0,V EVOPD: JUMPCM .+3 ;[1113] TERMINATED WITH COMMA OR TLNN IO,FLDSW ;[1113] PART OF ADDRESS FIELD OR TLNE CS,(17B5) ;TERMINATED WITH OPERATOR? (+,-,ETC.) JRST [ HRRZ AC1,V ;YES CAIE AC1,OP ;REGULAR OP? JRST .+1 ;NO, MUST EXECUTE IT TLZ IO,IORPTC ;[1113] TERMINATOR HAS BEEN USED JRST EVTSTS] ;YES, TREAT AS SYMBOL TLO IO,FLDSW ;[1147] REST IS ADDRESS SKIPE C ;NON-BLANK DELIMITER? TLO IO,IORPTC ;YES, REPEAT CHARACTER PUSH P,LOCA ;SAVE CURRENT LOCATION PUSH P,STPX ;SAVE CURRENT CODE BUFFER STATE PUSH P,STPY MOVE AC1,STPX MOVEM AC1,STPY CALL 0(V) ;DO OP MOVE AC2,STPX ;SEE HOW MANY WORDS GENERATED SUB AC2,STPY ;AFTER EDIT 1035, THIS CHECK CAN PROBABLY BE REENABLED AS CAILE AC2,1. ; CAIE AC2,1 ;SHOULD BE ONE, BUT MANY PROGRAMS ; TRO ER,ERRQ ;USE <> TO TRUNCATE, E.G. ASCII JUMPE AC2,[SETZ AC0, ;[1023] SKIP IF NOTHING WAS GENERATED JRST .+3] ;[1023][1107] CALL DSTOW ;AC0 = WORD OF CODE GENERATED TLO FR,FSNSW ;[1107] SET FIELD SEEN FLAG POP P,STPY ;RESTORE CODE BUFFER POP P,STPX POP P,LOCA ;RESTORE CURRENT LOCATION TRNE RC,-2 HRRM RC,EXTPNT TLNE RC,-2 HLLM RC,EXTPNT JRST EVNUM EVOPX: MOVSI ARG,SYMF!UNDF CALL INSERZ EVERRZ: SETZB AC0,RC ;CLEAR CODE AND RELOCATION EVERRU: TRO ER,ERRU JRST EVGETD EVTSTS: TLNN ARG,UNDF ;[740] JRST EVTST1 ;[740] TLC ARG,LTAGF ;[740] IS IT A TAG IN LIT? TLCE ARG,LTAGF ;[740] TROA ER,ERRU ;[740] NO, UNDEFINED JRST [ TRO FRR,LTGSW ;[740] YES, FLAG IT JUMP1 EVGETD ;[740] TREAT AS UNDF ON PASS1 TLO ARG,TREF ;[740] FLAG IT REFERENCED HLLM ARG,(SX) ;[740] UPDATE SYMBOL TABLE AS REF'ED JRST EVTST1] ;[740] JUMP1 EVGETD ;TREAT AS UNDF ON PASS1 EVTST1: TLNN ARG,EXTF ;[740] JRST EVTSTR HRRZ RC,ARG ;GET ADRES WFW HRRZ ARG,EXTPNT ;SAVE IT WFW HRRM RC,EXTPNT ;WFW IFE POLISH,< ;NOT NEEDED SINCE POLISH WILL TAKE CARE OF EXTERNS TRNE ARG,-1 ;WFW TRO ER,ERRE > SETZB AC0,ARG EVTSTR: TLNE ARG,MDFF ;MULTIPLY DEFINED? TRO ER,ERRD ;YES, FLAG IT TLNN FR,NEGSW ;NEGATIVE ATOM? JRST EVGETD ;NO IFN POLISH,< JUMPN RC,NEGEXT> ;UNARY MINUS, JUMP IF NOT ABS CALL GETDE2 ;NO, JUST NEGATE EVGETD: TLNE IO,NUMSW ;NON BLANK FIELD TLO FR,FSNSW ;YES,SET FLAG CALL BYPAS2 TLNE CS,6 ;ALPHA-NUMERIC? TLO IO,IORPTC ;YES, REPEAT IT CAIN C,'^' ;IS THIS THE SPECIAL ESCAPE CHAR? JRST EVUPAR ;YES, SEE WHAT FOLLOWS EVUPAT: ;LABEL FOR RETURN FROM ^ IFN FTPSECT,< ;[575] TLZN IO,RSASSW ;INTER-PSECT REFERENCE? JRST EVNUM ;NO PUSH P,SGWFND ;INX OF PSECT REFERRED TO PUSH P,[-2] ;[613] DUMMY RELOCATION, DON'T USE -1 PUSH P,CSTATP> ;ADDITIVE PSECT OPERATION EVNUM: POP P,PS ;POP THE PREVIOUS DELIMITER/TNODE TLO PS,4000 IFN POLISH,< TLC PS,110000 ;TEST FOR BITS 2 AND 5 TLCN PS,110000 ;BOTH ON - MEANS ADDITIVE JRST EVXCT> ;PSECT OPERATION CAMGE PS,CS ;OPERATION REQUIRED? JRST EVPUSH ;NO, PUT VALUES BACK ON STACK TLNN PS,TNODE ;YES, HAVE WE REACHED TERMINAL NODE? JRST EVXCT ;NO, EXECUTION REQUIRED TLNE CS,170000 ;YES, ARE WE POINTING AT DEL? (& ! * / + - _) JRST EVPUSH ;NO,FALL INTO EVPUSH IFN POLISH,< TLNE FR,POLSW ;BEEN RESOLVING POLISH? JUMP2 POLPOP ;[610] YES, OUTPUT IT IN PASS2 > RET ;NO, EXIT ;HERE TO HANDLE "^!" EVUPAR: SETZM UPARRO ;CLEAR ^ COUNTER ONCE IN A WHILE CALL PEEK ;SEE WHAT CHARACTER AFTER ^ IS SETZ CS, ;AND CHECK FOR ! AFTER IT CAIN C,"!" ;IS IT ! FOR ^! SKIPA CS,CSTATX ;YES, GET SPECIAL POINTER JRST EVUPAN ;NOT ^! TLZ IO,IORPTC ;CLEAR REREAD SKIPE MRP ;IF IN A MACRO CALL MREAD ;BETTER DO THIS SUBI C,40 ;YES, CHANGE TO SIXBIT JRST EVNUM ;AND EVALUATE EVUPAN: CAIN C,"-" ;WAS IT ^- TRO ER,ERRQ ;GIVE A Q ERROR IF ^- IS USED AS BINARY OPTR MOVEI C,'^' ;RESTORE C MOVE CS,CSTAT(C) ;AND CS SETOM UPARRO ;SET FLAG FOR CELL1 TO RE-EAT ^ JRST EVUPAT ;AND CONTINUE FROM ^ EVPUSH: PUSH P,PS ;STACK VALUES PUSH P,CV PUSH P,RC PUSH P,CS JRST EVATOM ;GET NEXT ATOM EVXCT: POP P,PR ;POP PREVIOUS RELOCATABILITY POP P,PV ;AND PREVIOUS VALUE LDB PS,[POINT 4,PS,29] ;TYPE OF OPERATION TO PS IFE POLISH,< XCT EVTAB(PS) ;PERFORM PROPER OPERATION JUMPN RC,.+2 ;COMMON RELOCATION TEST EVXCT1: JUMPE PR,EVNUM TRO ER,ERRR ;BOTH MUST BE FIXED JRST EVNUM ;GO TRY AGAIN EVTAB: JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN JRST XMUL ;1; JRST XDIV ;2; JRST XADD ;3; JRST XSUB ;4; JRST XLRW ;5; "_" IOR CV,PV ;6; MERGE PV INTO CV AND CV,PV ;7; AND PV INTO CV XOR CV,PV ;10; XOR PV INTO CV SETCM CV,CV ;11; NOT (ONE'S COMPLIMENT) REPEAT 6, ;12-17; JUST IN CASE > IFN POLISH,< TRNE FRR,NOPSW ;[603] WANT POLISH? JRST EVXCT1 ;[603] NO, CAILE PS,11 ;OPS 12 AND 13 JRST POLPSH ; REQUIRE POLISH FIXUPS TDNN RC,[777700,,777700] ;CHECK FOR EXTERNALS IN EITHER TDNE PR,[777700,,777700] ;OPERAND -- .LE. 100 ALLOWED JRST [ SKIPN UWVER ;[603] WRITING UNV FILE? JRST POLPSH ;[603] NO, BITON UPOL,UWVER ;[603] YES, SET FLAG FIRST JRST POLPSH] ;[603] XCT PRTAB(PS) ;TEST PREVIOUS RELOCATION JUMPN RC,POLPSH ;GO POLISH IF BOTH OPERANDS RELOC'L EVXCT1: JFCL 17,.+1 ;CLEAR OVERFLOW FOR * AND / XCT EVTAB(PS) ;PERFORM PROPER OPERATION SKIPL OKOVFL ;OVERFLOW OK? JOV .+2 ;SKIP IF * OR / OVERFLOWED SKIPA ;IT'S OK TRO ER,ERRN ;SET N ERROR FOR OVERFLOW JRST EVNUM ;GO TRY AGAIN EVTAB: JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN IMULM PV,CV ;1; MUL IDIVM PV,CV ;2; DIV JRST XADD ;3; JRST XSUB ;4; CALL XLRW ;5; "_" IOR CV,PV ;6; MERGE PV INTO CV AND CV,PV ;7; AND PV INTO CV XOR CV,PV ;10; XOR PV INTO CV SETCM CV,CV ;11; NOT (ONE'S COMPLIMENT) MOVN CV,CV ;12; NEGATE (TWO'S COMPLEMENT) JFCL ;13; ADDITIVE PSECT OPERATION REPEAT 4, ;14-17; JUST IN CASE NEGEXT: MOVSI PS,4000 ;FAKE UP EVPUSH OF ADDM PS,(P) ; PS PUSH P,[0] ; CV PUSH P,[0] ; RC PUSH P,CSTATM ; CS TLZ FR,NEGSW ;CLEAR FLAG JRST EVGETD ;NOW EVALUATE PRTAB: JFCL ;0 JRST CHKPR ;1 MUL JRST CHKPRD ;2 DIV JRST CHKADD ;[1044] 3 ADD JUMPN PR,CHKSUB ;[734] 4 SUB JRST CHKPRD ;5 SHIFT JRST CHKIOR ;6 IOR JUMPN PR,POLPSH ;[662] 7 AND JUMPN PR,POLPSH ;[662] 10 XOR JFCL ;[662] 11 NOT ;CHECK RELOCATION WHERE SECOND OPERAND MUST BE ABSOLUTE CHKPRD: JUMPN RC,POLPSH ;GO POLISH IF SECOND ARG NOT ABSOLUTE ;CHECK RELOCATION FOR MULTIPLICATIVE OPERATORS CHKPR: SKIPN PR ;FIRST OPERAND RELOCATABLE? JRST [ JUMPE RC,EVXCT1 ;NO, JUMP IF SECOND ALSO NOT RELOC PUSH P,PV ;SAVE VALUES PUSH P,CV SETZ CV, ;CONSTRUCT EQUIVALENT RELOCATABLE VALUE TRNE RC,-1 ;RH? HRRI CV,-1 ;YES TLNE RC,-1 ;LH? HRLI CV,-1 ;YES JRST CHKPR2] ;DO OPERATION AND TEST RESULTS JUMPN RC,POLPSH ;POLISH REQUIRED IF BOTH RELOCATABLE PUSH P,PV ;SAVE VALUES PUSH P,CV SETZ PV, ;CONSTRUCT EQUIVALENT RELOCATABLE VALUE TRNE PR,-1 ;RH? HRRI PV,-1 ;YES TLNE PR,-1 ;LH? HRLI PV,-1 ;YES CHKPR2: XCT EVTAB(PS) ;DO OPERATION ON RELOCATION EQUIVALENT SETO RC, ;FIGURE OUT WHAT HAPPENED... TLCN CV,-1 ;LH 0? HRLI RC,0 ;YES TLCN CV,-1 ;LH 1? HRLI RC,1 ;YES TRCN CV,-1 ;RH 0? HRRI RC,0 ;YES TRCN CV,-1 ;RH 1? HRRI RC,1 ;YES POP P,CV ;RECOVER VALUES POP P,PV TDNN RC,[-2,,-2] ;RELOC COUNTS OTHER THAN 0 OR 1? JRST EVXCT1 ;ALL IS WELL, DO OPERATION SETZ RC, ;YES, GO POLISH JRST POLPSH ;CHECK RELOCATION FOR IOR CHKIOR: TDNE RC,PR ;ANY HALFWORDS IN COMMON? JRST POLPSH ;YES, GO POLISH ;CHECK EACH HALFWORD AGAINST THE RELOCATION COUNT IN THAT HALFWORD ;FOR THE OTHER OPERAND DEFINE TST (OP,RR,VV)< OP RR,-1 ;;RELOCATION NON-0? JRST [ OP VV,-1 ;;YES, VALUE NON-0? JRST POLPSH ;;YES, GO POLISH JRST .+1]> ;;NO, CONTINUE TST TRNE,RC,PV TST TLNE,RC,PV TST TRNE,PR,CV TST TLNE,PR,CV IOR RC,PR ;[710] GET RELOCATION JRST EVXCT1 ;PASSED ALL TESTS, DO OPERATION XLRW: EXCH PV,CV LSH CV,0(PV) RET ;HERE TO SEE IF POLISH IS REQUIRED FOR PROPER LOAD-TIME ;RELOCATION OF REL+ABS,REL+REL OR ABS+REL CHKADD: JUMPN PR,[ JUMPN RC,POLPSH ;[1103] REL+REL - GOES POLISH CALL CHKAD0 ;[1103] REL+ABS - POLISH NEEDED? JRST EVXCT1 ;[1103] NO JRST POLPSH] ;[1103] YES JUMPE RC,EVXCT1 ;[1103] ABS+ABS - NO POLISH EXCH PV,CV ;[1103] ABS+REL SWAP VALUES EXCH PR,RC ;[1103] AND RELOCATIONS CALL CHKAD0 ;[1103] REL+ABS - POLISH NEEDED? JRST [ EXCH PV,CV ;[1103] NO - SWAP BACK VALUES EXCH PR,RC ;[1103] RELOCATIONS... JRST EVXCT1] ;[1103] NO POLISH EXCH PV,CV ;[1103] POLISH - SWAP BACK VALUES EXCH PR,RC ;[1103] RELOCATIONS... JRST POLPSH ;[1103] GO POLISH ;[1103] ROUTINE TO SEE IF REL+ABS REQUIRES POLISH ;[1103] EXPECTS VALUE OF REL IN PV, VALUE OF ABS IN CV ;[1103] RETURNS +1 FOR NO POLISH, +2 FOR POLISH REQUIRED CHKAD0: JUMPL CV,[ MOVNS CV ;[1103] NEGATIVE ABS, NEGATE CALL CHKSB1 ;[1103] AND SEE IF REL-ABS NEEDS POLISH SKIPA ;[1103] NO AOS (P) ;[1103] YES - SKIP RETURN MOVNS CV ;[1103] RESTORE ABS RET] ;[1103] ;[1103] CHECKS REL+ABS, ENTRY FOR REL-(-ABS) CHKAD1: SKIPN HMIN ;[1103] TWOSEG PROG? RET ;[1103] NO - FORGET POLISH TLNE PR,1 ;[1111] YES - IS REL IN LH? JRST CPOPJ1 ;[1111] YES - GO POLISH TO BE SURE JUMPGE PV,.+3 ;[1111] DOES REL APPEAR TO BE NEGATIVE CAMLE PV,[-1,,0] ;[1111] IN RANGE -1 TO -262143 JRST CPOPJ1 ;[1111] YES - GO POLISH TO BE SURE CALL SRHMIN ;[1111] SETUP HMIN-400 BOUND PUSH P,PV ;[1103] SAVE REL VALUE PUSH P,CV ;[1103] AND ABS VALUE HRRZS PV ;[1103] GUARANTEE ONLY RH REL HRRZS CV ;[1103] ONLY RH ABS IS USEFUL CAMGE PV,RLHMIN ;[1111] IS REL HISEG OR LOWSEG? JRST [ ADD PV,CV ;[1111] LOW - NEED POLISH WHEN REL+ABS CAMGE PV,RLHMIN ;[1111] IS .GE. HISEG ORIGIN-400 JRST CHKAD3 ;[1103] FORGET POLISH JRST CHKAD2] ;[1103] POLISH NEEDED ADD PV,CV ;[1103] HISEG - NEED POLISH TLNE PV,1 ;[1103] WHEN REL+ABS .GT. 777777 CHKAD2: AOS -2(P) ;[1103] POLISH - SKIP RETURN CHKAD3: POP P,CV ;[1103] RESTORE ABS POP P,PV ;[1103] AND REL RET ;[1103] ;[1103] HERE TO SEE IF POLISH IS REQUIRED FOR PROPER LOAD-TIME ;[1103] RELOCATION OF REL-ABS CHKSUB: JUMPN RC,CHKSB4 ;[1103] REL-REL - SPECIAL CHECKS JUMPGE CV,[ CALL CHKSB1 ;[1103] REL-(+ABS) - NEED POLISH? JRST EVXCT1 ;[1103] NO JRST POLPSH] ;[1103] YES MOVNS CV ;[1103] -ABS, NEGATE CALL CHKAD1 ;[1103] SEE IF REL+ABS NEEDS POLISH JRST [ MOVNS CV ;[1103] NO - RESTORE ABS JRST EVXCT1] ;[1103] FORGET POLISH MOVNS CV ;[1103] POLISH - RESTORE ABS JRST POLPSH ;[1103] GO POLISH ;[1103] ROUTINE TO SEE IF REL-ABS REQUIRES POLISH ;[1103] EXPECTS VALUE OF REL IN PV, VALUE OF ABS IN CV ;[1103] RETURNS +1 FOR NO POLISH, +2 FOR POLISH REQUIRED CHKSB1: SKIPN HMIN ;[1103] TWOSEG PROG? JRST [ SKIPN HISNSW ;[1103] NO - HISEG OR SKIPE SGNMAX ;[1103] PSECT PROG JRST .+1 ;[1103] YES - CHECK FURTHER RET] ;[1103] NO - FORGET POLISH TLNE PR,1 ;[1111] IS REL IN LH? JRST CPOPJ1 ;[1111] YES - GO POLISH TO BE SURE JUMPGE PV,.+3 ;[1111] DOES REL APPEAR TO BE NEGATIVE CAMLE PV,[-1,,0] ;[1111] IN RANGE -1 TO -262143 JRST CPOPJ1 ;[1111] YES - GO POLISH TO BE SURE CALL SRHMIN ;[1111] SETUP HMIN-400 BOUND PUSH P,PV ;[1103] SAVE REL HRRZS PV ;[1103] ASSURE ONLY RH REL SKIPE HMIN ;[1103] TWOSEG PROG? CAMGE PV,RLHMIN ;[1111] YES - HISEG OR LOWSEG? JRST [ SKIPN HISNSW ;[1103] LOWSEG, OR NOT TWOSEG, IS SKIPE SGNMAX ;[1103] IT A HISEG OR PSECT PROG? CAMGE PV,CV ;[1103] YES - IS REL .GE. ABS AOS -1(P) ;[1103] NO - NEED POLISH SKIP RETURN POP P,PV ;[1103] RESTORE REL RET] ;[1103] SUB PV,CV ;[1111] HISEG - NEED POLISH WHEN REL-ABS CAMGE PV,RLHMIN ;[1111] IS .LT. HISEG ORIGIN-400 AOS -1(P) ;[1103] YES - POLISH NEEDED POP P,PV ;[1103] RESTORE REL RET ;[1103] ;[1103] ROUTINE TO SEE IF REL-REL REQUIRES POLISH CHKSB4: SKIPN HMIN ;[1103] TWOSEG PROG? JRST EVXCT1 ;[1103] NO - FORGET POLISH TLNN PR,1 ;[1103] DOES EITHER REL APPEAR IN THE TLNE RC,1 ;[1103] LH, OR AS LH,,RH? JRST POLPSH ;[1103] YES - GO POLISH TO BE SURE JUMPGE PV,.+3 ;[1111] DOES REL APPEAR TO BE NEGATIVE CAMLE PV,[-1,,0] ;[1111] IN RANGE -1 TO -262143 JRST POLPSH ;[1111] YES - GO POLISH TO BE SURE JUMPGE CV,.+3 ;[1111] DOES REL APPEAR NEG. CAMLE CV,[-1,,0] ;[1111] RANGE -1 TO -262143 JRST POLPSH ;[1111] YES - GO POLISH CALL SRHMIN ;[1111] SETUP HMIN-400 BOUND PUSH P,PV ;[1103] SAVE BOTH RELS PUSH P,CV ;[1103] ... HRRZS PV ;[1103] GUARANTEE RH ONLY HRRZS CV ;[1103] ... CAMGE PV,RLHMIN ;[1111] IS FIRST REL HISEG OR LOWSEG? JRST [ CAMGE CV,RLHMIN ;[1111] ARE BOTH RELS IN LOWSEG? JRST CHKSB5 ;[1103] YES - FORGET POLISH JRST CHKSB6] ;[1103] NO - POLISH NEEDED CAML CV,RLHMIN ;[1111] ARE BOTH RELS IN HISEG? CHKSB5: JRST [ POP P,CV ;[1103] BOTH RELS IN SAME SEGMENT POP P,PV ;[1103] RESTORE RELS JRST EVXCT1] ;[1103] FORGET POLISH CHKSB6: POP P,CV ;[1103] RELS IN DIFFERENT SEGMENTS POP P,PV ;[1103] RESTORE RELS JRST POLPSH ;[1103] GO POLISH ;[1111] ROUTINE TO SETUP HMIN-400 PRIOR TO CHECKING REL+ABS, REL-ABS, ;[1111] AND REL-REL TO SEE IF POLISH IS NEEDED SRHMIN: PUSH P,CV ;[1111] SAVE AC MOVE CV,HMIN ;[1111] GET HI SEG ORIGIN SUBI CV,400 ;[1111] REDUCE TO LOWEST BOUND MOVEM CV,RLHMIN ;[1111] SAVE FOR COMPARES POP P,CV ;[1111] RESTORE RET ;[1111] > ;HERE IF THERE IS PROBLEM WITH EXPRESSION PARSING AND EVALUATION ;GETTING ILLEGAL OPERATORS EVXERR: PUSH P,['MCREPP'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT/ EXPRESSION PARSING PROBLEM@/] ;[1066] JRST ERRNE4 ;[702] GIVE FATAL ERROR, CONTINUE XSUB: SUBM PV,CV SUBM PR,RC JRST EVNUM XADD: ADDM PV,CV ADDM PR,RC JRST EVNUM IFE POLISH,< XDIV: IDIV PR,CV ;CORRECT RELOCATABILITY JFCL 17,.+1 ;CLEAR OVERFLOW IDIVM PV,CV SKIPL OKOVFL ;SKIP IF OVERFLOW OK JOV .+2 ;SEE IF OVERFLOWED SKIPA ;NO TRO ER,ERRN ;YES, SET N ERROR XDIV1: EXCH PR,RC ;TAKE RELOCATION OF NUMERATOR JRST EVXCT1 XMUL: JUMPE PR,XMUL1 ;AT LEAST ONE OPERAND JUMPE RC,XMUL1 ;MUST BE FIXED TRO ER,ERRR XMUL1: IORM PR,RC ;GET RELOCATION TO RC CAMGE PV,CV ;FIND THE GREATER EXCH PV,CV ;FIX IN CASE CV=0,OR 1 IMULM PV,RC JFCL 17,.+1 ;CLEAR OVERFLOW IMULM PV,CV SKIPL OKOVFL ;SKIP IF OVERFLOW OK JOV .+2 ;SEE IF OVERFLOW SKIPA ;NO TRO ER,ERRN ;YES, SET N ERROR JRST EVNUM XLRW: EXCH PV,CV LSH CV,0(PV) LSH PR,0(PV) JRST XDIV1 > ;HERE FOR EXTERNAL ARITHMETIC ;CONVERS TO POLISH BLOCK TYPE 11 IFN POLISH,< POLPSH: JUMP1 [SKIPE LITLVL ;ONLY SAVE POLISH ON PASS2 TRO ER,ERRF ;SET FAKE FLAG IF IN LITERAL JRST EVXCT1] SKIPE INBYTE ;[762] DOING BYTE? JRST [ TRO ER,ERRE ;[762] YES, JRST EVXCT1] ;[762] CAN'T HANDLE POLISH TRNE FRR,LTGSW ;[735] DOING POLISH WITH LIT-TAG? TRO ER,ERRA ;[735] YES, A-ERROR TLO FR,POLSW ;SIGNAL STORING POLISH CAMN PR,[-1] ;DO WE HAVE A -1 RELOCATION? CALL POLPPR ;YES, CAMN RC,[-1] ;HOW ABOUT THE OTHER OPERAND? CALL POLPRC ;YES, JUMPL PR,[CAMN PR,[-2] ;[1040] PREVIOUS VALUE WAS A POLISH? JRST .+1 ;[1040] NO INTER-PSECT DUMMY RELOCATION PUSH P,RC ;[1040] YES, MOVE PV & PR INTO CV AND RC PUSH P,CV ;[1040] FOR MOVING THE ENBEDDED POLISH MOVE RC,PR ;[1040] INTO FREE SPACE MOVE CV,PV ;[1040] VIA MOVSTK CALL MOVSTK ;[1040] MOVE PR,RC ;[1040] THE NEW RC INTO FREE SPACE MOVE PV,RC ;[1040] BECOMES PR & PV POP P,CV ;[1040] RESTORE REAL CV & RC POP P,RC ;[1040] JRST .+1] ;[1040] JUMPL RC,[CAMN RC,[-2] ;[1040] JRST .+1 ;[1040] CALL MOVSTK ;[1040] JRST .+1] ;[1040] SKIPE SGNMAX ;[1101] IF NO PSECTS CAMN PR,[-2] ;[1101] OR DOING SIMPLE INTER-PSECT REF JRST POLPS2 ;[1101] SKIP RELOCATABLE CHECKS TDNN PR,[-2,,-2] ;[1101] IF PREVIOUS IS EXTERNAL SKIPN PR ;[1101] OR NOT RELOCATABLE JRST POLPS1 ;[1101] GO CHECK CURRENT PUSH P,CV ;[1101] PREVIOUS IS RELOCATABLE, SAVE ACS PUSH P,RC ;[1101] ..... MOVE CV,PV ;[1101] MAKE PREVIOUS CURRENT MOVE RC,PR ;[1101] .... CALL POLROR ;[1101] CREATE POLISH WITH PSECT OF ORIGIN MOVE PV,CV ;[1101] STORE NEW PREVIOUS MOVE PR,RC ;[1101] .... POP P,RC ;[1101] RESTORE CURRENT POP P,CV ;[1101] .... POLPS1: TDNN RC,[-2,,-2] ;[1101] IF CURRENT IS EXTERNAL SKIPN RC ;[1101] OR NOT RELOCATABLE SKIPA ;[1101] CONTINUE WITH POLISH GENERATION CALL POLROR ;[1101] ELSE CREATE POLISH WITH PSECT OF ORIGIN POLPS2: ;[1101] PUSH P,POLSTK ;[1040] SAVE STACK POINTER EXCH P,POLSTK ;[1040] SAVE P AND SET UP POLISH STACK PUSH P,POLTBL-1(PS) ;STACK OPERATOR PUSH P,PR ;STACK PREVIOUS RELOCATION PUSH P,PV ;AND VALUE PUSH P,RC ;STACK CURRENT PUSH P,CV EXCH P,POLSTK ;GET P BACK POP P,CV ;USE STACK POINTER FOR VALUE MOVE RC,CV ;AND RELOCATION (ENSURES EXTERNAL) CAILE PS,11 ;[1101] WAS THIS A FORCED POLISH OPERATION? CALL MOVSTK ;[1101] YES - MOVE POLISH TO SAFE PLACE JRST EVNUM POLPPR: CAIE PS,3 ;DOING +? JRST [ CAIN PS,4 ;NO, DOING -? MOVEI PS,3 ;YES, MAKE IT + JRST .+2] ;GO NEGATE THE VALUE MOVEI PS,4 ;ITS +, MAKE IT - MOVEI PR,1 ;MAKE RELOCATION 1 MOVNS PV,PV ;NEGATE VALUE RET POLPRC: CAIE PS,3 ;DOING +? JRST [ CAIN PS,4 ;NO, DOING -? MOVEI PS,3 ;YES, MAKE IT + JRST .+2] ;GO NEGATE THE VALUE MOVEI PS,4 ;ITS +, MAKE IT - MOVEI RC,1 ;MAKE RELOCATION 1 MOVNS CV,CV ;NEGATE VALUE RET ;[1101] HERE TO CREATE A POLISH BLOCK FOR THE CURRENT RELOCATABLE ATOM ;[1101] CONTAINING ITS PSECT OF ORIGIN - IN CASE THIS RELOCATABLE IS EVER ;[1101] IMBEDDED WITHIN POLISH DURING AN INTER-PSECT REFERENCE. POLROR: PUSH P,POLSTK ;[1101] SAVE STACK POINTER EXCH P,POLSTK ;[1101] SETUP POLISH STACK, SAVE P PUSH P,[15] ;[1101] OPERATOR IS PSECT OPERATOR PUSH P,[-2] ;[1101] INTER-PSECT DUMMY RELOC PUSH P,SGNCUR ;[1101] PSECT OF ORIGIN PUSH P,RC ;[1101] CURRENT RELOC PUSH P,CV ;[1101] AND VALUE EXCH P,POLSTK ;[1101] RESTORE P, SAVE POLISH STACK PTR POP P,RC ;[1101] NEW RELOC - POLISH CALL MOVSTK ;[1101] PUT POLISH BLOCK IN SAFE PLACE MOVE CV,RC ;[1101] USE STACK POINTER FOR VALUE RET ;[1101] ;TRY NEXT ITEM ;HERE TO STORE THE POLISH LIST ;RC (AND CV) HAVE POINTER TO TOP ITEM IN PUSHDOWN STACK POLPOP: CALL POLFRR ;[636] SET UP FRR POLISH FLAGS SKIPE INBYTE ;[1077] DOING BYTE? JRST [ TRO ER,ERRE ;[1077] YES - CAN'T BE POLISH RET] ;[1077] SKIPE BYTESW ;[1114] DOING BYTE PSEUDO-OP? TRNE FRR,FWPSW ;[1114] YES - SKIP IF NOT FULLWORD FIXUP TRNN FRR,FWPSW!RHPSW ;[1114] FULL OR RIGHT HALF POLISH FIXUP? JRST POLPO1 ;[636] NO, CAIN C,'(' ;[636] DOING INDEXING? JRST POLIDX ;[636] YES, JUMP CAIN C,')' ;[636] A CLOSE PARENT? JRST [ TRZE FRR,PIDXSW ;[636] YES, FINISHING UP INDEX CALC? CALL GETCHR ;[636] YES, JRST .+1] ;[636] TRNE FRR,RHPSW ;[1114] RIGHT HALF FIXUP? JRST POLPO1 ;[1114] YES - DO IT IN OP TLZE FR,INDSW ;INDIRECT? JRST POLIND ;YES, POLPO1: SKIPE INANGL ;STILL IN EVALUATION? JRST [ CAMN RC,XWDANG ;[773] WE HAVE LEFT POL, SUCH THAT LEFT POL=RIGHT POL? MOVEM RC,XWDRRC ;[773] FLAG IT MOVEM RC,INANGL ;YES, MARK STACK SETZB RC,CV ;0 SO OP NOT CONFUSED SETZM EXTPNT TLZ FR,POLSW RET] ;WILL MOVE LATER TRNE FRR,IDXSW ;[1107] DOING OP INDEXING? JRST [ SETZB RC,CV ;[1107] YES - CLEAR VALUE AND RELOC SETZM EXTPNT ;[1107] CLEAR ANY EXTERNALS TLZ FR,POLSW ;[1107] .... RET] ;[1107] RETURN WITH FRR FLAGS SKIPN BSHIFT ;[1037] JUST RETURN IF DOING B-SHIFT SKIPE INIOWD ;[730] DOING IOWD? RET ;[730] YES, RETURN SKIPN INASGN ;[624] IF DEFINING A SYMBOL JUST SAVE SKIPE INOPDF ;[624] DOING OPDEF? JRST POLASG ;[624] POLSYM: MOVE PV,FREE ;GET NEXT FREE LOCATION EXCH PV,POLIST ;SWAP STACK POINTER CALL POLSTR ;STORE POINTER TO NEXT POLISH BLOCK CALL POLOPF ;STORE FIRST OPERATOR CALL POLFST ;STORE FIRST PART CALL POLSND ;STORE SECOND PART POLOCT: CALL POLFRR ;[644][636] SET UP FRR POLISH FLAGS XCT 3+[SETZM EXTPNT ;FULL WORD HRRZS EXTPNT ;LEFT HALF HLLZS EXTPNT](PV) ;RIGHT HALF SKIPN INASGN ;[624] DEFINING A SYMBOL? SKIPE INOPDF ;[624] OPDEF? JRST POLSTS ;YES CALL POLSTO ;STORE IT SKIPE PHALVL ;INSIDE PHASE? JRST [ MOVE PV,LOCO ;YES, USE ORIGINAL LOC HRL PV,MODO ;AND MODE JRST POLOC1] MOVE PV,LOCA ;LOCATION HRL PV,MODA ;AND MODE POLOC1: SKIPN LITLVL ;HOWEVER IF IN A LITERAL JRST POLPOR MOVE PV,POLIST ;WE CAN NOT SUPPLY THE STORE ADDRESS YET MOVE CV,(PV) ;SO PUT IN A SPECIAL LIST MOVEM CV,POLIST ;REMOVE FROM REGULAR LIST EXCH PV,POLITS ;STORE IN POLIST LIT LIST MOVEM PV,@POLITS ;LINK TOGETHER MOVE PV,STPX ;STORE DEPTH IN THIS LIT SUB PV,STPY ;WITH NO RELOCATION YET TRO ER,ERRF ;SET FAKE FLAG POLPOR: CALL POLSTR SETZB RC,CV ;USE ZERO VALUE AND RELOCATION POLRET: MOVE PV,POLPTR ;RESET INITIAL POLISH POINTER MOVEM PV,POLSTK RET ;RETURN ;HERE FOR POLISH SYMBOL FIXUPS POLSTS: SUBI PV,3 ;DIFFERENT STORE OPERATOR CALL POLSTO ;STORE IT SKIPE INASGN ;[624] MOVE PV,INASGN ;GET RADIX-50 SYMBOL MOVE AC0,POLIST ;GET BLOCK JRST POLPOR ;STORE IT ;[636] HERE TO MOVE POLTYP INTO AC PV AND SET APPROPRIATE FLAGS IN FRR POLFRR: SKIPE PV,POLTYP ;USE PRESET TYPE JRST [JUMPL PV,POLFR1 ;SET AND PERMANENT HRRO PV,PV ;COMPLETE OPERATOR JRST POLFR1] ;FINALLY HRREI PV,POLRHF ;ASSUME RH FIXUP JUMPNC POLFR1 ;COMMA? HRREI PV,POLLHF ;YES, LH FIXUP POLFR1: XCT 3+[TRO FRR,FWPSW ;[614] FULL FOWRD TRO FRR,LHPSW ;[614] LEFT HALF TRO FRR,RHPSW](PV) ;[614] RIGHT HALF RET ;[636] ;HERE TO DO FULL WORD FIXUP OF POLISH AND INDIRECT POLIND: ;[750] SETZ AC0, ;ZERO VALUE TLO AC0,(Z @) ;TURN ON INDIRECT BIT MOVE PS,CSTAT+'!' ;FORCE IOR JRST FORCEP ;GO DO IT ;HERE TO DO FULL WORD FIXUP OF POLISH AND INDEX POLIDX: ;[750] TRO FRR,PIDXSW ;[636] FLAG IT TLZE FR,INDSW ;[1114] IF INDIRECTION, CLEAR FOR NOW SETOM PINDFL ;[1114] BUT REMEMBER IT FOR LATER PUSH P,RC ;[636] STORE AWAY RC FOR WHILE PUSH P,EXTPNT ;[1073] ALONG WITH EXTERNAL POINTERS SETZM EXTPNT ;[1073] CLEAR RELOC TRO FRR,NOPSW ;[1107] DO NOT ALLOW POLISH CALL EVALCM ;[636] GO DO INDEX CALCULATION TRZ FRR,NOPSW ;[1107] ALLOW POLISH AGAIN TRNN FRR,RHPSW ;[1114] RIGHT HALF POLISH FIXUP JRST POLID1 ;[1114] NO - DO FULL WORD SETOM PLHIDX ;[1114] INDICATE LH INDEX FROM POLISH HRRZM AC0,PIDXVL ;[1114] SAVE SWAPPED LH OF INDEX HLLZS AC0 ;[1114] KEEP RH HRRZM RC,PIDXRC ;[1114] SAVE SWAPPED RC OF LH HLLZS RC ;[1114] KEEP RH JRST POLID2 ;[1114] AND CONTINUE POLID1: PUSH P,[0,,POLFWF] ;[1114] MAKE SURE ITS FWF POP P,POLTYP ;[1114] ... POLID2: SKIPE PINDFL ;[1114] INDIRECTION SAVED? JRST [ TLO FR,INDSW ;[1114] YES - REPLACE IT SETZM PINDFL ;[1114] AND CLEAR FLAG JRST .+1] ;[1114] SKIPE RC ;[636] DO WE HAVE ABS VALUE? TRO ER,ERRR ;[636] NO, RELOCATION ERROR TLNE AC0,-1 ;[1107] IS THERE A LEFT HALF? TRO ER,ERRQ ;[1107] YES - FLAG ERROR MOVSS AC0 ;[1114] SWAP VALUE POP P,EXTPNT ;[1073] RESTORE EXTERNAL RELOC POP P,RC ;[636] GET BACK RC WHICH HAS POLISH PTR MOVE PS,CSTAT+'+' ;[1114] FORCE ADDITIONAL ADD JRST FORCEP ;[636] GO DO IT ;HERE TO STORE CURRENT POLISH STACK ;WE MUST MOVE IT TO A SAFE PLACE POLASG: CALL MOVSTK ;MOVE STACK JRST POLRET MOVSTK: JUMPGE RC,CPOPJ ;[1010] RETURN IF NOT POLISH PUSH P,SDEL ;SAVE ACC PUSH P,AC1 ;... HRRZ AC1,POLSTK ;GET TOP OF STACK HRRZ SDEL,RC ;GET RH OF RC CAMLE SDEL,AC1 ;RH(RC) .LE. RH(POLSTK)? JRST MOVNOT ;NO, JUMP, SINCE ADDITIONAL POLISH CAME RC,POLPTR ;[623] POLISH OF POLISH? HRRM AC1,POLPTR ;[623] YES, READ JUST BEGINNING POINTER SUBI AC1,(RC) ;GET + LENGTH - 1 HRRZI SDEL,1(AC1) ;+ LENGTH ADD SDEL,FREE ;NEW TOP CAML SDEL,SYMBOL ;WILL IT FIT CALL XCEED ;NOT YET EXCH SDEL,FREE ;BASE IN SDEL HRL SDEL,RC ;FROM HRR RC,SDEL ;NEW RELOC PTR MOVE CV,AC1 ;COPY LENGTH HRL CV,CV ;INTO BOTH HALVES MOVE AC1,FREE ;TOP +1 BLT SDEL,-1(AC1) ;MOVE IT MOVE AC1,POLSTK ;GET STACK PTR SUB AC1,CV ;BACKUP MOVEM AC1,POLSTK SETZ CV, ;[730] SET CURRENT VALUE TO 0 MOVNOT: POP P,AC1 ;RESTORE POP P,SDEL ;... RET ;THIS IS A KLUDGE TO PRODUCE ADDITIVE GLOBALS FOR THE FEW CASES THAT THEY ;CAN HANDLE. I.E. K+GLOBAL, GLOBAL+K, GLOBAL-K ;SO THAT OLD PROGRAMS WILL COMPIL THE SAME WAY AND LOAD WITH THE ;OLD LOADER WITHOUT THE FAILSW CODE ;APART FROM ADDITIVE SYMBOL FIXUPS POLISH BLOCKS ARE MORE POWERFUL ;***** REMOVE SOMEDAY POLOPF: SKIPE POLTYP ;IF ALREADY SETUP THEN JRST POLOPX ;WE MUST USE POLISH (EXP OR OCT) JUMPL RC,POLOPX ;TOO COMPLEX IF ALREADY A POINTER HRRZ PS,1(RC) ;GET FIRST OPERATOR CAIE PS,3 ;CAN ONLY HANDLE ADD CAIN PS,4 ;AND SUBTRACT JRST POLOP2 ;ITS ONE OF THOSE GIVE IT A TRY ;***** POLOPX: ;[575] IFN FTPSECT,< ;[575] SKIPN SGNMAX ;PSECTS USED? JRST POLOPR ;NO PUSH P,PV ;SAVE FIRST OP HRRO PV,SGNCUR ;GET CUR PSECT INX TRO PV,400000 ;MAKE POLISH OP CALL POLSTR ;STORE IT POP P,PV ;GET FIRST OP > ;END IFN FTPSECT POLOPR: HRRZ PV,RC ;[1051] GET RH OF RC CAMLE PV,.JBREL ;[1051] ABOUT TO ILL MEM REF? JRST [ TLO FR,LOADSW ;[1051] CALL EVXERR ;[1051][1007] YES, THIS SHOULDN'T HAPPEN. GIVE MSG. TLZ FR,LOADSW ;[1051] LOADSW ENSURED THAT WE RETURNED SETZB AC0,RC ;[1007] MUST HAVE TYPOS.. CLEAR AC'S JRST POLRET] ;[1007] JUST RETURN. HRRZ PV,1(RC) ;GET OPERATOR CAIL PV,OTLEN ;A VALID OPERATOR INDEX? JRST EVXERR ;NO, GIVE ERROR XCT OPRTBL-3(PV) ;ANYTHING SPECIAL? HRRO PV,1(RC) ;GET OPERATOR AND FLAG IT JRST POLSTR ;STORE IT AND EXIT POLAPO: AOS 0(P) ;SKIP FIRST OPERAND MOVE PV,3(RC) ;[1101] GET PSECT INDEX CAMN PV,SGNCUR ;[1101] SAME AS CURRENT (GLOBAL) PSECT? RET ;[1101] YES - NO NEED TO STORE IT TDO PV,[-1,,400000] ;[1101] NO - MAKE POLISH OP JRST POLSTR ;STORE AND EXIT ;***** MORE OF THIS KLUDGE POLOP2: SUBI PS,3 ;MAKES LIFE EASIER MOVE CV,4(RC) ;GET 2ND OPERAND JUMPL CV,POLOPX ;ITS A POINTER, THEREFORE TOO COMPLEX MOVE PV,2(RC) ;AND 1ST OPERAND JUMPL PV,POLOPX ;THIS IS A POINTER TDNN CV,[-2,,-2] ;TEST FOR EXTERN JRST [TRNE CV,1 ;TEST FOR BOTH RELOCATABLE TRNN PV,1 JRST POLOP3 ;THIS IS NOT EXTERN SO OTHER CAN BE JRST POLOPX] ;CANNOT HANDLE HERE, USE POLISH JUMPN PS,POLOPX ;CAN NOT HANDLE -GLOBAL TDNE PV,[-2,,-2] ;TEST FOR EXTERN HERE JRST POLOPX ;GLOBAL+GLOBAL TOO COMPLEX POLOP3: SOS FREE ;BACKUP FREE COUNTER MOVE PV,@FREE ;GET LAST POINTER MOVEM PV,POLIST ;SET POINTER BACK POP P,PV ;POP RETURN OFF STACK TLZ FR,POLSW ;CLEAR FLAG JUST IN CASE ;RELOAD RC, CV, PV, AND PR FROM STACK ;AND EXECUTE OPERATOR MOVE PR,2(RC) MOVE PV,3(RC) MOVE CV,5(RC) MOVE RC,4(RC) ;THIS ONE LAST OF COURSE JUMPN PS,POLOP5 ;DO MINUS ADDM PV,CV ADDM PR,RC JRST POLRET ;RESTORE STACK AND RETURN POLOP5: SUBM PV,CV SUBM PR,RC JRST POLRET ;***** END OF THIS KLUDGE ;HERE TO HANDLE FIRST OPERAND ;HIGHLY RECURSIVE POLFST: SKIPGE PV,2(RC) ;GET RELOCATION JRST POLFSR ;THIS IS ANOTHER POINTER TDNE PV,[-2,,-2] ;IS IT EXTERNAL? JRST [SKIPN 3(RC) ;[703] IF VALUE.NE.0, FUDGE IN CONSTANT JRST POLFS2 ;[703] HRRZ CV,3(RC) ;[703] GET VALUE HRROI PV,3 ;[703] CALL POLSTR ;[703] STORE CALL POLFS3 ;[703] USE COMMON CODE MOVE PV,2(RC) ;[703] GET BACK RELOCATION JRST POLFS2] ;[703] MOVE CV,3(RC) ;GET VALUE POLFS4: TLNN PV,-1 ;CHECK FOR LEFT HALF VALUE TLNE CV,-1 JRST POLFS1 ;YES, NEED FULL WORD HRL CV,PV ;XWD RELOC ,, VALUE POLFS3: SETZ PV, ;[703] OPERAND IS 0 FOR 18 BIT VALUE CALL POLSTR MOVE PV,CV JRST POLSTR ;STORE AND EXIT POLFS1: MOVEI PV,1 ;OPERAND IS 1 FOR 36 BIT VALUE CALL POLSTR MOVE PV,2(RC) ;RELOCATION CALL POLSTR MOVE PV,CV ;VALUE JRST POLSTR POLSN2: POLFS2: MOVE CV,1(PV) ;GET SIXBIT SYMBOL INTO AC0 MOVEI PV,2 ;OPERAND IN 2 FOR SYMBOL CALL POLSTR MOVEI ARG,4 ;MAKE GLOBAL REQUEST CALL SQOZE ;TO RADIX-50 MOVE PV,CV ;PUT IN RIGHT ACC JRST POLSTR ;STORE IT POLFSR:; CAME PV,3(RC) ;CHECK TO MAKE SURE IT REALLY IS A POINTER ; JRST POLFSN ;NO, ITS A NEGATIVE GLOBAL PUSH P,RC ;SAVE THIS POINTER MOVE RC,PV ;GET NEXT POINTER CALL POLOPR ;GET OPERATOR CALL POLFST ;GET FIRST OPERAND CALL POLSND ;GET SECOND OPERAND POP P,RC ;GET BACK PREVIOUS POINTER RET ;RETURN TO PREVIOUS LEVEL POLFSN: HRROI PV,14 ;TWO'S COMPLIMENT NEGATIVE CALL POLSTR ;STORE OPERATOR MOVN PV,2(RC) ;GET RELOCATION TDNE PV,[-2,,-2] ;CHECK FOR EXTERN JRST POLFS2 ;IT IS, CONVERT TO RADIX-50 MOVN CV,3(RC) ;GET VALUE JRST POLFS4 ;AND STORE IT ;HERE TO HANDLE 2ND OPERAND, ALSO RECURSIVE POLSNR:; CAME PV,5(RC) ;MAKE SURE IT REALLY IS ; JRST POLSNN ;ITS A NEGATIVE GLOBAL MOVE RC,PV ;GET NEXT POINTER CALL POLOPR ;STORE OPERATOR CALL POLFST ;GET 1ST OPERAND, THEN ON TO 2ND POLSND: SKIPGE PV,4(RC) ;GET RELOCATION JRST POLSNR ;THIS IS A POINTER TDNE PV,[-2,,-2] ;IS IT EXTERNAL? JRST [SKIPN 5(RC) ;[1110] IF VALUE.NE.0, FUDGE IN CONSTANT JRST POLSN2 ;[1110] HRRZ CV,5(RC) ;[1110] GET VALUE HRROI PV,3 ;[1110] CALL POLSTR ;[1110] STORE CALL POLSN3 ;[1110] USE COMMON CODE MOVE PV,4(RC) ;[1110] GET BACK RELOCATION JRST POLSN2] ;[1110] MOVE CV,5(RC) ;GET VALUE POLSN4: TLNN PV,-1 ;CHECK FOR LEFT HALF VALUE TLNE CV,-1 JRST POLSN1 ;YES, NEED FULL WORD HRL CV,PV ;XWD RELOC ,, VALUE POLSN3: SETZ PV, ;[1110] OPERAND IS 0 FOR 18 BIT VALUE CALL POLSTR MOVE PV,CV JRST POLSTR ;STORE AND EXIT POLSNN: HRROI PV,14 ;TWO'S COMPLIMENT NEGATIVE CALL POLSTR ;STORE OPERATOR MOVN PV,4(RC) ;GET RELOCATION TDNE PV,[-2,,-2] ;CHECK FOR EXTERN JRST POLSN2 ;IT IS, CONVERT TO RADIX-50 MOVN CV,5(RC) ;GET VALUE JRST POLSN4 ;AND STORE IT POLSN1: MOVEI PV,1 ;OPERAND IS 1 FOR 36 BIT VALUE CALL POLSTR MOVE PV,4(RC) ;RELOCATION CALL POLSTR MOVE PV,CV ;VALUE JRST POLSTR POLSTO: MOVE SDEL,FREE ;GET NEXT FREE WORD MOVEM SDEL,LSTOPR ;STORE POINTER TO STORE OP POLSTR: AOS SDEL,FREE ;GET A FREE WORD CAML SDEL,SYMBOL ;ENOUGH? CALL XCEED ;NO MOVEM PV,-1(SDEL) ;STORE ONE WORD RET ;TABLE OF CORRESPONDENCE BETWEEN MACRO-10 OPERATORS AND BLOCK 11 OPERATORS POLTBL: ;POLISH VALUE MACRO-10 OPERATOR 5 ;1 MULTIPLY 6 ;2 DIVIDE 3 ;3 ADD 4 ;4 SUBTRACT 11 ;5 LEFT SHIFT 10 ;6 LOGICAL IOR 7 ;7 LOGICAL AND 12 ;10 LOGICAL XOR 13 ;11 NOT 14 ;12 NEGATE 15 ;13 ADDITIVE PSECT OPERATION REPEAT 3, ;IN CASE OF BAD OPERATOR OPRTBL: JFCL ;3 ADD JFCL ;4 SUBTRACT JFCL ;5 MULTIPLY JFCL ;6 DIVIDE JFCL ;7 LOGICAL AND JFCL ;10 LOGICAL IOR JFCL ;11 LEFT SHIFT JFCL ;12 LOGICAL XOR AOS (P) ;13 NOT AOS (P) ;14 NEGATE JRST POLAPO ;15 ADDITIVE PSECT OPERATION OTLEN==.-OPRTBL+3 ;LENGTH OF THIS TABLE + 3 >;END OF IFN POLISH SUBTTL LITERAL STORAGE HANDLER STOLER: IFE FORMSW,< SETZB AC0,RC ;ERROR, NO CODE STORED CALL STOW> ;STOW ZERO IFN FORMSW,< MOVEI AC0,0 CALL STOWZ1> TRO ER,ERRL ;AND FLAG THE ERROR STOLIT: MOVE SDEL,STPX SUB SDEL,STPY ;COMPUTE NUMBER OF WORDS JUMPE SDEL,STOLER ;ERROR IF NONE STORED TRNN ER,ERRORS!ERRF ;ANY ERRORS? JRST STOL06 ;NO TRNN ER,ERRORS-ERRU ;ONLY ERRF!ERRU, THEN BRANCH JRST STOL22 JUMP2 STOL22 ;YES, NO SEARCH. BRANCH IF PASS2 ADDM SDEL,LITCNT ;PASS ONE, UPDATE COUNT TRZ ER,ERRF ;CLEAR FAKE FLAG JRST STOWI ;INITIALIZE STOW STOL06: MOVEI SX,LITAB ;PREPARE FOR SEARCH MOVE ARG,STPX ;SAVE IN THE EVENT OF MULTIPLE-WORD HRL ARG,STPY MOVE AC2,LITNUM MOVEI SDEL,0 STOL08: CALL DSTOW ;GET VALUE WFW STOL10: SOJL AC2,STOL24 ;TEST FOR END MOVE SX,0(SX) ;NO, GET NEXT STORAGE CELL MOVE V,-1(SX) ;GET RELOCATION BITS WFW CAMN AC0,-2(SX) ;DO CODES COMPARE? WFW CAME RC,V ;YES, HOW ABOUT RELOCATION? AOJA SDEL,STOL10 ;NO, TRY AGAIN SKIPGE STPX ;YES, MULTI-WORD? JRST STOL13 ;NO, JUST RETURN LOCATION MOVEM AC2,SAVBLK+AC2 ;YES, SAVE STARTING INFO MOVEM SX,SAVBLK+SX STOL12: SOJL AC2,STOL23 ;TEST FOR END CALL DSTOW ;GET NEXT WORD WFW MOVE SX,0(SX) ;UPDATE POINTER MOVE V,-1(SX) ;GET RELOCATION WFW CAMN AC0,-2(SX) ;COMPARE VALUE WFW CAME RC,V ;AND RELOCATION JRST STOL14 ;NO MATCH, TRY AGAIN SKIPL STPX ;MATCH, HAVE WE FINISHED SEARCH? JRST STOL12 ;NO, TRY NEXT WORD STOL13: ;YES, RETURN LOCATION IFN POLISH,< SETZM POLITS ;CLEAR ANY POLISH PENDING > JRST STOL26 STOL14: MOVE AC2,SAVBLK+AC2 ;RESTORE STOW POINTERS MOVE SX,SAVBLK+SX HRREM ARG,STPX HLREM ARG,STPY AOJA SDEL,STOL08 ;BETTER LUCK NEXT TIME STOL22: MOVE SDEL,LITNUM STOL23: CALL DSTOW ;DSTOW AND CONVERT STOL24: MOVE SX,LITABX ;GET CURRENT STORAGE CALL GETTOP ;GET NEXT CELL MOVEM AC0,-2(SX) ;STORE CODE WFW IFN POLISH,< JUMPN RC,STOL25 ;[1031] JUMP IF NOT ABS TRNN ER,ERRF ;[1031] FAKE ERROR FOR POLISH? JRST STOL25 ;[1031] NO, JUMP MOVSI AC0,(1B0) ;[1031] YES, FIX RC SO WE CAN TELL FROM [0] MOVEM AC0,-1(SX) ;[1031] USE AC0 TO KEEP AC RC AS IS JRST STOL25+1 ;[1031] STOL25: ;[1031] > MOVEM RC,-1(SX) ;WFW IFN FORMSW,< MOVE AC0,FORM MOVEM AC0,-3(SX)> MOVEM SX,LITABX ;SET POINTER TO CURRENT CELL AOS LITNUM ;INCREMENT NUMBER STORED AOS LITCNT ;INCREMENT NUMBER RESERVED SKIPL STPX ;ANY MORE CODE? JRST STOL23 ;YES STOL26: TRZ ER,ERRF ;CLEAR FAKE FLAG JUMP1 CPOPJ ;[664] EXIT IF PASS ONE MOVE SX,LITHDX ;GET HEADER BLOCK HLRZ RC,-1(SX) ;GET BLOCK RELOCATION HRRZ AC0,-1(SX) ADDI AC0,0(SDEL) ;COMPUTE ACTUAL LOCATION RET ;EXIT SUBTTL INPUT ROUTINES GETCHR: PUSH P,V ;[731] V IS USED IN MREAD -> DSEND CALL CHARAC ;GET ASCII CHARACTER IFN STANSW,< CAIN C,32 MOVEI C,136 ;^ CAIN C,30 MOVEI C,137 ;_ CAIN C,176 MOVEI C,134 ;~ CAIN C,140 MOVEI C,100> ;@ SUBI C,40 ;CONVERT TO SIXBIT CAIG C,77 ;CHAR GREATER THAN SIXBIT? JUMPGE C,GETCS ;TEST FOR VALID SIXBIT CAIL C,"A" ;[664] RETURN LOWERCASE AS SIXBIT CAILE C,"Z" ;[664] JRST GETCS3 ;[664] OTHERWISE SPECIAL HANDLING SUBI C,40 ;[664] JRST GETCS ;[664] GETCS3: ADDI C,40 ;[664] BACK TO ASCII CAIN C,HT ;CHECK FOR TAB JRST GETCS2 ;MAKE IT LOOK LIKE SPACE CAIG C,CR ;GREATER THAN CR CAIG C,HT ;GREATER THAN TAB JRST GETCS1 ;IS NOT FF,VT,LF OR CR MOVEI C,EOL ;LINE OR FORM FEED OR V TAB TLOA IO,IORPTC ;REPEAT CHARACTER GETCS2: MOVEI C,0 ;BUT TREAT AS BLANK GETCS: MOVE CS,CSTAT(C) ;GET STATUS BITS POP P,V ;[731] RESTORE TO ORIGINAL VALUE RET ;EXIT GETCS1: JUMPE C,GETCS ;IGNORE NULS TRC C,100 ;MAKE CHAR. VISIBLE MOVEI CS,"^" DPB CS,LBUFP ;PUT ^ IN OUTPUT CALL RSW2 ;ALSO MODIFIED CHAR. TRO ER,ERRQ ;FLAG Q ERROR JRST GETCHR+1 ;[731] BUT IGNORE CHAR. CHARAC: TLZE IO,IORPTC ;REPEAT REQUESTED? JRST [HRRZ C,LIMBO ;[664] GET LAST CHARACTER RET] ;[664] EXIT RSW0: JUMPN MRP,MREAD ;BRANCH IF TREE POINTER SET CALL READ RSW1: SKIPE RPOLVL ;ARE WE IN "REPEAT ONCE"? JRST REPO1 ;YES RSW2: CAIN C,LF ;LF? JRST [MOVE CS,LIMBO ;[664] YES, GET LAST CHAR CAIE CS,CR ;[664] CR? JRST .+1 ;[664] NO HRROM C,LIMBO ;[664] YES, FLAG RET] ;[664] AND EXIT MOVEM C,LIMBO ;STORE THIS CHAR. FOR RPTC RSW3: TLNE IO,IOSALL ;MACRO SUPPRESS ALL? JUMPN MRP,CPOPJ ;YES,DON'T LIST IN MACRO JUMPE C,CPOPJ ;[1122] DO NOT COPY NULS TO LINE BUFFER SKIPG CPL ;[1133] ANY ROOM IN THE IMAGE BUFFER? CALL RSW5 ;NO, BUT SEE IF ANY EXCESS WE CAN USE IDPB C,LBUFP ;YES, STORE IN PRINT AREA SOS CPL ;[1133] UPDATE BUFFER COUNT CAIE C,HT ;TAB? RET ;NO, EXIT MOVEI CS,7 ;TAB COUNT MASK ANDCAM CS,CPL ;MASK TO TAB STOP RET RSW5: CAIN C,HT ;[1133] TAB? JRST RSW6 ;[1133] YES - NOT ENOUGH ROOM MOVNI CS,.CPLX ;[1133][664] GET EXCESS SPACE CAMGE CS,CPL ;[664] ANY ROOM? RET ;[664] YES, JUST RETURN RSW6: SKIPN LITLVL ;[1133][664] IF IN LITERAL SKIPL STPX ;[664] OR CODE GENERATED JRST OUTIM ;[664] JUST OUTPUT THE IMAGE SKIPN ASGBLK ;[760]ASSIGNMENT SKIPE LOCBLK ;[760] OR A BLOCK RESERVATION? JRST .+2 ;[760] YES, GO OUTPUT BINARY JRST OUTIM ;[664] OTHERWISE OUTPUT IMAGE CALL SAVEXS ;[760] SAVE AC0 AND C MOVEI C,CR ;[664] IDPB C,LBUFP ;[664] CALL OUTLIN ;[664] OUTPUT PARTIAL LINE CALL RSTRXS ;[664] RESTORE ACS JRST OUTLI2 ;[664] INITIALIZE REST OF LINE CHARL: CALL CHARAC ;GET AND TEST 7-BIT ASCII CAIG C,FF ;LINE OR FORM FEED OR VT? CAIGE C,LF RET ;NO,EXIT CHARL1: CALL SAVEXS ;[667] SAVE REGISTERS SKIPE LITLVL ;[661] IN LITERAL? JRST [CALL OUTIML ;[667] YES JRST RSTRXS] ;[667] RESTORE ACS AND EXIT CALL OUTLIN ;NO, DUMP THE LINE JRST RSTRXS ;RESTORE REGISTERS AND EXIT ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT) ;UNTIL A LINE TERMINATOR IS SEEN. STOUTS: TLOA IO,IOENDL!IORPTC STOUT: TLO IO,IORPTC CALL BYPASS ;[664] CAIE C,EOL ;MOST LIKELY A ; OR EOL CH JRST STOUT2 ;IT WASN'T, SEE WHY! HRRZ C,LIMBO ;GET CHARACTER IN CASE EOL TLZE IO,IORPTC ;[1075] IF EOL JRST STOUT4 ;[1075] SKIP NEXT GET STOUT1: SKIPN MRP ;[1075] STILL IN A MACRO? TLZ IO,IOMAC ;[1075] NO - CLEAR OUTPUT SUPPRESSION CALL RSW0 ;[1075] STOUT4: CAIN C,CR ;[1075] NEED SPECIAL TEST FOR CR JRST STOUT3 ;IN CASE NOT FOLLOWED BY LF CAIG C,FF CAIGE C,LF JRST STOUT1 JRST OUTLIN ;OUTPUT THE LINE (BIN AND LST) STOUT2: CAIN C,14 ;COMMA? SKIPL STPX ;YES, ERROR IF CODE STORED TRO ER,ERRQ JRST STOUT1 ;PASS OUT TIL END OF LINE STOUT3: CALL RSW0 ;GET NEXT CHAR. CAIG C,FF ;GENUINE EOL CHARACTER? CAIGE C,LF TLOA IO,IORPTC ;NO, SO REPEAT IT JRST OUTLIN ;AND DUMP LINE IN ANY CASE REPEAT 0,< ;DON'T FLAG IT TRO ER,ERRQ ;FLAG EXTRA WITH "Q" ERROR > SETZ C, DPB C,LBUFP ;CLEAR LOOK-AHEAD CHAR OUT OF BUFFER CALL OUTLIN ;DUMP UPTO CR AS LINE HRRZ C,LIMBO ;GET C BACK JRST RSW3 ;AND PUT CHAR IN NEW BUFFER SUBTTL CHARACTER STATUS TABLE DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO) ;OPLVL PRIORITY OF BINARY OPERATORS ;ATOM INDEX TO JUMP TABLE AT CELL1 ;AN TYPE OF CHARACTER ; 1=OTHER, 2=ALPHA, 4=NUMERIC ;SQUOZ VALUE IN RADIX 50 ;OPTYPE INDEX TO JUMP TABLE AT EVXCT ;SEQNO VALUE IN SIXBIT CSTAT: GENCS 00,00,1,00,00,00 ;' ' GENCS 04,12,1,00,06,01 ;'!' GENCS 00,07,1,00,00,02 ;'"' GENCS 00,12,1,00,00,03 ;'#' GENCS 00,01,2,46,00,04 ;'$' GENCS 00,01,2,47,00,05 ;'%' GENCS 04,12,1,00,07,06 ;'&' GENCS 00,07,1,00,00,07 ;''' GENCS 00,01,1,00,00,10 ;'(' GENCS 00,01,1,00,00,11 ;')' GENCS 02,12,1,00,01,12 ;'*' GENCS 01,00,1,00,03,13 ;'+' GENCS 40,01,1,00,00,14 ;',' GENCS 01,02,1,00,04,15 ;'-' GENCS 00,11,2,45,00,16 ;'.' GENCS 02,12,1,00,02,17 ;'/' GENCS 00,04,4,01,00,20 ;'0' GENCS 00,04,4,02,00,21 ;'1' GENCS 00,04,4,03,00,22 ;'2' GENCS 00,04,4,04,00,23 ;'3' GENCS 00,04,4,05,00,24 ;'4' GENCS 00,04,4,06,00,25 ;'5' GENCS 00,04,4,07,00,26 ;'6' GENCS 00,04,4,10,00,27 ;'7' GENCS 00,04,4,11,00,30 ;'8' GENCS 00,04,4,12,00,31 ;'9' GENCS 00,12,1,00,00,32 ;':' GENCS 00,01,1,00,00,33 ;';' GENCS 00,05,1,00,00,34 ;'<' GENCS 00,12,1,00,00,35 ;'=' GENCS 00,01,1,00,00,36 ;'>' GENCS 00,12,1,00,00,37 ;'?' GENCS 00,03,1,00,00,40 ;'@' GENCS 00,01,2,13,00,41 ;'A' GENCS 00,01,2,14,00,42 ;'B' GENCS 00,01,2,15,00,43 ;'C' GENCS 00,01,2,16,00,44 ;'D' GENCS 00,01,2,17,00,45 ;'E' GENCS 00,01,2,20,00,46 ;'F' GENCS 00,01,2,21,00,47 ;'G' GENCS 00,01,2,22,00,50 ;'H' GENCS 00,01,2,23,00,51 ;'I' GENCS 00,01,2,24,00,52 ;'J' GENCS 00,01,2,25,00,53 ;'K' GENCS 00,01,2,26,00,54 ;'L' GENCS 00,01,2,27,00,55 ;'M' GENCS 00,01,2,30,00,56 ;'N' GENCS 00,01,2,31,00,57 ;'O' GENCS 00,01,2,32,00,60 ;'P' GENCS 00,01,2,33,00,61 ;'Q' GENCS 00,01,2,34,00,62 ;'R' GENCS 00,01,2,35,00,63 ;'S' GENCS 00,01,2,36,00,64 ;'T' GENCS 00,01,2,37,00,65 ;'U' GENCS 00,01,2,40,00,66 ;'V' GENCS 00,01,2,41,00,67 ;'W' GENCS 00,01,2,42,00,70 ;'X' GENCS 00,01,2,43,00,71 ;'Y' GENCS 00,01,2,44,00,72 ;'Z' GENCS 00,06,1,00,00,73 ;'[' GENCS 00,12,1,00,00,74 ;'\' GENCS 00,01,1,00,00,75 ;']' GENCS 00,10,1,00,00,76 ;'^' GENCS 06,12,1,00,05,77 ;[1054] '_' CSTATX: GENCS 04,12,1,00,10,01 ;'^!' CSTATN: GENCS 10,12,1,00,11,15 ;[1054] '^-' IFN POLISH,< CSTATM: GENCS 10,12,1,00,12,15 ;[1054] UNARY MINUS > ;END IFN POLISH IFN FTPSECT,< ;[575] CSTATP: GENCS 11,12,1,00,13,13 ;ADDITIVE PSECT OPERATION > SUBTTL LISTING ROUTINES OUTLIN: TRNN ER,ERRORS-ERRQ ;ANY ERRORS? TLNE FR,ERRQSW ;NO, IGNORE Q ERRORS? TRZ ER,ERRQ ;YES, ZERO THE Q ERROR HRLZ AC0,ER ;PUT ERROR FLAGS IN AC0 LEFT TLZ AC0,ERRF ;CLEAR FAKE FLAG TDZ ER,TYPERR JUMP1 OUTL30 ;BRANCH IF PASS ONE TLNE FR,IOSCR ;[663] GCHAR ERROR TYPEOUT? JRST OUTL02 ;[663] YES, FORCE PRINTING SKIPE LITLVL ;WITHIN NOLIST LITERAL? SKIPE LITLST JRST OUTL04 ;NO TLNE IO,IOSALL ;YES, SALL MODE? JUMPN MRP,OUTLI5 ;[1065] YES, EXIT IF IN MACRO EXPANSION OUTL04: JUMPN AC0,OUTL02 ;IF ANY ERRORS, FORCE PRINTING MOVE AC1,STPX CAME AC1,STPY ;ANY CODE GENERATED? JRST OUTL01 ;YES TLNN IO,IOSALL ;YES,SUPPRESS ALL? JRST OUTL03 ;NO MOVE AC1,IOFLGS ;[1150] IF SETTING XLIST AFTER OUTPUT TLNN AC1,IOPROG ;[1150] FORCE THE LINE OUT JUMPN MRP,OUTLI5 ;[1065] YES,EXIT IF IN MACRO LDB C,[XWD 350700,LBUF] CAIE C,CR ;FIRST CHAR CR? OUTL01: TLZ IO,IOMAC ;FORCE MACRO PRINTING OUTL03: TLNN IO,IOMSTR!IOPROG!IOMAC OUTL02: IOR ER,OUTSW ;FORCE IT. IDPB AC0,LBUFP ;STORE ZERO TERMINATOR AFTER ASCII SRC LINE TSO ER,AC0 ;RE-FLAG THE ERRORS FOR %....X TLNN FR,CREFSW ;CREF? CALL CLSCRF ;YES, WRITE END OF CREF DATA (177,003) MOVE C,TYPERR ;NOW RESTORE FLAGS AS ANDI C,ERRORS ;THEY WERE SO TTY LISTING IS TDZ ER,C ;WHAT THEY ASKED FOR JUMPE AC0,OUTL20 ;BRANCH IF NO ERRORS TLZE AC0,ERRM ;M ERROR? TLO AC0,ERRP ;M ERROR SET - SET P ERROR. CALL OUTLER ;PROCESS ERRORS OUTL20: TLNE FR,IOSCR ;[663] GCHAR ERROR TYPEOUT? JRST OUTL28 ;[663] YES, SKIP BINARY MOVE AC1,STPX SKIPN C,ASGBLK SKIPE CS,LOCBLK CAME AC1,STPY ;ANY CODE GENERATED? JRST OUTL23 ;YES, JUMP JUMPE C,OUTL22 ;SEQUENCE BREAK AND NO BINARY JUMPS ILDB C,TABP ;ASSIGNMENT FALLS THROUGH CALL OUTL ;OUTPUT A TAB. ILDB C,TABP ;OUTPUT 2ND TAB, LOCATION FIELD CALL OUTC ;NEXT IS BINARY LISTING FIELD IFN FTPSECT,< ;[647] SKIPE SGNMAX ;[647] DOING PSECTS? JRST [ MOVEI C," " ;[647] DO SPACES INSTEAD CALL OUTC ;[647] CALL OUTC ;[647] CALL OUTC ;[647] JRST .+1] ;[647] > ;[647] IFN POLISH,< JUMPL RC,[IBP TABP ;[647] FIX FOR OFF-CENTER FIXUP LISTING HRRZI CS,-1 ;[633] OUTPUT 6 ZEROS CALL ONC1 ;[633] HRRZI CS,-5 ;[633] NO TAB, 6 MORE ZEROS AND # CALL ONC1 ;[633] JRST OUTL33] ;[717] SKIP SINGLE QUOTE TEST > HLLO CS,LOCBLK ;LEFT HALF OF A 36BIT VALUE HLR C,ASGBLK ;[633] GET LEFT HALF RELOCATION SKIPL ASGBLK ;SKIP IF LEFT HALF IS NOT RELOC TRZA CS,0(C) ;[633] TLNE CS,-1 ;SKIP IF ITS A 18BIT VALUE, OTHERWISE JRST [ CALL ONC1 ;[647] PRINT LH OF A 36 BIT VALUE IN CS IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] IBP TABP ;[717] > ;[717] JRST OUTL2A] ;[647] IFN FTPSECT,< ;[647] SKIPN SGNMAX ;[647] DOING PSECT? JRST OUTL2A ;[647] NO, ILDB C,TABP ;[647] YES, EXTRA TAB CALL OUTC ;[647] MOVEI C," " ;[647] CALL OUTC ;[647] > ;[647] OUTL2A: HRLO CS,LOCBLK ;[647] PICK UP THE RIGHT (18BIT VALUE) MOVE C,ASGBLK ;GET RIGHT HALF RELOCATION TRZ CS,0(C) CALL ONC ;PRINT IT JRST OUTL23 ;SKIP SINGLE QUOTE TEST OUTL22: IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] JRST [ ILDB C,TABP ;[717] CALL OUTL ;[717] CALL ONC1 ;[717] JRST .+2] ;[774] > ;[717] CALL ONC ;TAB TO RH AND PRINT IT CALL OUTCSQ ;[717] GO OUTPUT "'" OUTL33: ;[717] IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] IBP TABP ;[717] > ;[717] OUTL23: MOVE AC1,STPX ;ANY BINARY CAMG AC1,STPY JRST [ MOVE AC1,NOTFL ;NO, CAMN AC1,[-2] ;LAST LINE? SETZM NOTFL ;YES, RE-SET TO FIRST JRST OUTL29] SKIPE INASGN ;[661] SKIP BINARY IF IN ASSIGNMENT JRST OUTL29 ;[661] MOVSI AC1,(BLOFF) ANDCAM AC1,BLSW ;ASSUME WE WANT BINARY LISTING SKIPE LITLVL ;IN LITERAL? JRST [ SKIPN LITLST ;YES, IS LITLST REQUESTED JRST OUTL21 ;NO, GO SUPPRESS BINARY LISTING JRST .+1] ;YES, SKIPL NOTFL ;NOT THE FIRST LINE? JRST OUTL27 ;FIRST LINE, GO OUTPUT BINARY MOVE AC1,NOTFL ;NOT FIRST, CAMN AC1,[-2] ;LAST LINE? SETZM NOTFL ;YES, RE-SET TO FIRST MOVSI AC1,(FLBLST) ;NOT FIRST LINE, TDNN AC1,BLSW ;FIRST LINE BINARY ONLY REQUESTED? JRST OUTL27 ;NO, FLBLST NOT REQUESTED OUTL21: MOVSI AC1,(BLOFF) ;YES IORM AC1,BLSW ;SUPPRESS BINARY LISTING OUTL27: CALL BOUT ;OUTPUT BINARY OUTL29: MOVE CS,[POINT 7,LBUF] OUTL24: ILDB C,CS CAILE C," " JRST OUTL28 ;FOUND A PRINTING CHARACTER JUMPN C,OUTL24 ;TRY AGAIN UNLESS TERMINAL 0 SKIPN SEQNO ;SEQUENCE NO. ARE WORTH PRINTING JRST OUTL25 ;BUT JUST TABS AREN'T OUTL28: MOVE CS,TABP CALL OUTASC ;OUTPUT TABS & SEQ. NO. OUTL25: MOVEI CS,LBUF CALL OUTAS0 ;DUMP THE LINE TLNE IO,IOSALL ;SUPPRESSING ALL JUMPN MRP,[CALL OUTCR ;YES, CR NOT OTHERWISE PROVIDED JRST .+1] TLNE FR,IOSCR ;[663] GCHAR ERROR TYPEOUT? JRST OUTLI1 ;[663] YES, READY TO CLEAN UP SKIPE INASGN ;[774] SKIP BINARY IF IN ASSIGNMENT JRST OUTLI ;[774] SKIPE LITLVL ;[774] IN NON-LITLSTED LITERAL? SKIPE LITLST ;[774] JRST .+2 ;[774] NO, JRST OUTLI ;[774] YES, CLEAN UP AND EXIT OUTL26: MOVE AC1,STPX ;[774] ANY BINARY? CAMG AC1,STPY JRST OUTLI ;NO, CLEAN UP AND EXIT MOVSI AC1,(FLBLST) TDNE AC1,BLSW ;FIRST LINE BINARY ONLY? JRST [ MOVSI AC1,(BLOFF) IORM AC1,BLSW ;YES, SWITCH OFF BINARY CALL BOUT ;OUTPUT TO REL ONLY JRST OUTL26] CALL OUTLI2 ;YES, INITIALIZE FOR NEXT LINE TLNN FR,CREFSW ;CREF REQUESTED? TLNE IO,IOPROG ;YES, THEN IS XLIST ON? JRST .+2 ;CREF NOT BEING PRINTED CALL CLSCRF ;CLOSE OUT THIS CREF LINE CALL BOUT ;YES, DUMP IT CALL OUTCR ;OUTPUT CARRIAGE RETURN JRST OUTL26 ;TEST FOR MORE BINARY ;HERE ON PASS 1 ONLY OUTL30: CAIN C,FF ;[1004] FORM-FEED? CALL OUTFF2 ;[1004] YES, COUNT PAGES FOR PASS1 ERROR TLNN FR,IOSCR ;[663] SKIP BOOKKEEPING IF FROM GCHAR CALL [AOS CS,STPX ;[663] PASS ONE ADDM CS,LOCO ;[663] INCREMENT OUTPUT LOCATION JRST STOWI] ;[663] INITIALIZE STOW AND CONTINUE TLZ AC0,ERRORS-ERROR1 JUMPN AC0,OUTL32 ;JUMP IF ERRORS OUTL31: TLNE IO,IOSALL ;SUPPRESSING ALL JUMPN MRP,CPOPJ ;YES,EXIT JRST OUTLI1 ;NO,INIT LINE OUTL32: IDPB AC0,LBUFP ;ZERO TERMINATOR IOR ER,OUTSW ;LIST ERRORS CALL OUTLER ;OUTPUT TAG AND FLAGS CALL OUTTAB MOVEI CS,SEQNO ;ADDRESS OF SEQUENCE NO. SKIPE SEQNO ;FILE NOT SEQUENCED CALL OUTAS0 ;OUTPUT IT JRST OUTL25 ;OUTPUT BASIC LINE ;OUTPUT ERROR HEADER AND SETUP ERROR FLAG LETTERS ; AC0/ ERROR FLAGS IN LH (NOTE: NOT RH LIKE ER) OUTLER: PUSH P,ER ;SAVE LISTING SWITCHES FOR LATER TRNE ER,TTYSW ;IF THIS IS ON, LISTING IS ON TTY TRZ ER,ERRORS ;SO SUPPRESS ON TTY TDZ ER,OUTSW ;BUT THIS SHOULD ONLY GO TO THE TTY MOVE CS,TAG CALL OUTSY1 MOVEI C,"+" CALL OUTL HRRZ C,TAGINC ;[774] GET OFFSET SKIPE LBLFLG ;[774] HAVE WE SEEN LABEL IN LIT? SUB C,LTGINC ;[774] YES, GET CORRECT OFFSET FROM IT CALL DNC ;[666][576] CONVERT INCREMENT TO DECIMAL CALL OUTTAB ;OUTPUT TAB MOVE CS,INDIR ;GET FILE NAME CAME CS,LSTFIL ;AND SEE IF SAME SETOM LSTPGN ;ISN'T, GET IT TYPED MOVE CS,PAGENO ;NOW CHECK PAGE NUMBER CAMN CS,LSTPGN ;SAME? JRST OUTLE8 ;YES, DON'T PRINT AGAIN MOVE CS,INDIR ;REMEMBER LAST FILE MOVEM CS,LSTFIL MOVEI CS,LSTFIL CALL OUTSIX ;TYPE FILE NAME MOVEI C," " CALL OUTL MOVE CS,PAGENO ;REMEMBER LAST PAGE NUMBER MOVEM CS,LSTPGN MOVEI CS,[ASCIZ /PAGE /] CALL OUTAS0 MOVE C,PAGENO CALL DNC ;TYPE PAGE NUMBER OUTLE8: CALL OUTCR ;CR AFTER TAG AND PAGE HLLM ER,(P) ;RESTORE ER BUT NOT IO (LEFT HALF OF AC) POP P,ER MOVE CS,[POINT 7,[ASCII / QXADLRUVNOPEMS/]] OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED CAIN C,"Q" ;"Q" ERROR? AOSA QERRS ;YES, JUST COUNT AS WARNING AOS ERRCNT ;INCREMENT ERROR COUNT CALL OUTL ;OUTPUT THE CHARACTER OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT JUMPN AC0,OUTLE2 ;TEST FOR END RET ;EXIT OUTIM1: TLOA FR,IOSCR ;SUPPRESS CRLF AFTER LINE OUTIM: TLZ FR,IOSCR ;DON'T FOR PARTIAL LINE TLNE IO,IOSALL ;SUPPRESSING ALL? JUMPN MRP,[TLZ FR,IOSCR ;[663] YES, EXIT IF IN MACRO PJRST OUTLI5] ;[1065] JUMP1 [ CAIN C,FF ;[1004] FORM-FEED? CALL OUTFF2 ;[1004] COUNT FOR PASS1 ERROR JRST OUTLI1] ;[1004] BYPASS IF PASS ONE PUSH P,ER TDZ ER,TYPERR TLNN IO,IOMSTR!IOPROG!IOMAC IOR ER,OUTSW PUSH P,C ;OUTPUT IMAGE TLNN FR,CREFSW CALL CLSCRF MOVE CS,TABP CALL OUTASC ;OUTPUT TABS IDPB C,LBUFP ;STORE ZERO TERMINATOR MOVEI CS,LBUF CALL OUTAS0 ;OUTPUT THE IMAGE TLZN FR,IOSCR ;CRLF SUPPRESS? CALL OUTCR ;NO,OUTPUT POP P,C HLLM ER,0(P) POP P,ER JRST OUTLI4 ;[774] GO INCREMENT LINE COUNT OUTLI: TLNE IO,IOSALL ;SUPPRESSING ALL JUMPN MRP,OUTLI3 ;YES,SET FLAG IN REPEATS ALSO TLNE IO,IOPALL ;MACRO EXPANSION SUPRESS REQUESTED? SKIPN MACLVL ;YES, ARE WE IN MACRO? TLZA IO,IOMAC ;NO, CLEAR MAC FLAG OUTLI3: TLO IO,IOMAC ;YES, SET FLAG OUTLI1: TRZ ER,ERRORS!LPTSW!TTYSW TLZ FR,IOSCR ;[663] ZERO IMAGE/CRLF FLAG OUTLI4: SKIPN MRP ;[1001] IF EXPANDING, DON'T BUMP OFFSET AOS TAGINC ;[774] BUMP OFFSET OUTLI2: SKIPE IOFLGS ;[1065] LISTING FLAG TO SET? CALL OUTLI5 ;[1065] YES MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS MOVEM CS,LBUFP IFN FORMSW, ;BUT IF ONLY HALF-WORD FORMAT MOVE CS,[POINT 7,TABI,6] MOVEM CS,TABP MOVEI CS,.CPL IFN FORMSW, ;BACK AS IT WAS SKIPE SEQNO ;A SEQUENCED FILE? SUBI CS,8 ;YES, SEQ NO TAKES UP SPACE MOVEM CS,CPLSAV ;[1003] SAVE VALUE FOR FF CHECK MOVEM CS,CPL MOVSI CS,(ASCII / /) SKIPE SEQNO ;HAVE WE SEQUENCE NUMBERS? MOVEM CS,SEQNO ;YES, STORE TAB IN CASE OF MACRO MOVEM CS,SEQNO+1 ;STORE TAB AND TERMINATOR SETZM ASGBLK SETZM LOCBLK RET OUTLI5: JUMP1 CPOPJ ;[1065] SKIPGE IOFLGS ;[1065] SETTING LALL UNDER SALL? JRST [TLZ IO,IOMAC!IOPALL!IOSALL ;[1065] YES, "SET" FLAGS SETZM IOFLGS ;[1065] SKIPN CRLFSN ;[1065] NEED CRLF STILL? PJRST OUTIM ;[1065] YES RET] ;[1065] TDO IO,IOFLGS ;[1065] NO, XALL,XLIST,SALL (OR NULL) SETZM IOFLGS ;[1065] RET ;[1065] OUTIML: JUMP2 [ PUSH P,STPX ;SAVE CURRENT BUFFER VARIABLES PUSH P,EXTPNT ;.. PUSH P,STPY ;.. MOVE AC0,STPX ;PRINT ONLY LITERALS SINCE EXCH AC0,LSTPY ;LAST TIME MOVEM AC0,STPY ;.. CALL OUTLIN ;LIST THE LINE POP P,STPY ;RESTORE CURRENT BUFFER VARIABLES POP P,EXTPNT ;.. POP P,STPX ;.. RET] TRNN ER,ERRORS-ERRQ TLNE FR,ERRQSW TRZ ER,ERRQ HRLZ AC0,ER TLZ AC0,ERRORS-ERROR1-ERRL+ERRF ;ANY ERRORS TO PRINT ON PASS1? CAIN C,FF ;[1004] FORM-FEED? CALL OUTFF2 ;[1004] COUNT FOR PASS1 ERROR JUMPE AC0,OUTL31 ;[664] NONE PUSH P,ER ;SAVE PUSH P,C ;SAVE THIS TDZ ER,TYPERR IOR ER,OUTSW CALL OUTLER ;DO NOT FORGET ERRORS CALL OUTTAB SETZ AC0, ;SET A ZERO TERMINATOR IDPB AC0,LBUFP ;IN THE OUTPUT BUFFER MOVEI CS,LBUF ;PRINT REST OF LINE CALL OUTCR0 ;[664] POP P,C POP P,ER JRST OUTLI1 SUBTTL OUTPUT ROUTINES UOUT: SETZM UNDCNT ;CLEAR UNDEFINED SYMBOL COUNT CALL LOOKUP ;SET FOR TABLE SCAN JUMP2 UOUT13 ;[735] GO CHECK FOR TAGS IN LIT TRNN ARG,PNTF ;WFW UOUT0: TRNN ARG,UNDF ;[735] RET ;[724] RECYCLE IF DEFINED OF PNTF SET ON PASS1 JUMP2 UOUT10 TLNN IO,IOIOPF ;ANY IOP'S SEEN JRST UOUT12 ;NO,MAKE EXTERNAL MOVSI CS,PRMTBL-PRMEND ;YES LOOKUP IN TABLE UOUT1: CAME AC0,PRMTBL(CS) ;HAVE WE A MATCH? AOBJN CS,UOUT2 ;NO,INCREMENT AND JUMP MOVE ARG,PRMTBL+1(CS) ;YES,GET VALUE MOVEM ARG,(SX) ;UPDATE SYMBOL TABLE RET ;EXIT UOUT2: AOBJN CS,UOUT1 ;TEST FOR END UOUT12: TRNE ARG,ENTF ;[735] SEE IF FORWARD DEFINED? RET ;[617] YES, DON'T MAKE IT EXTERNAL TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS TRC ARG,LTAGF ;[735] TAG IN LIT? TRCN ARG,LTAGF ;[735] JRST [ PUSH P,ARG ;[735] YES, SAVE ARG CALL EXTRN1 ;[735] SETUP AS IF EXTERNAL CALL EXTRN2 ;[735] POP P,ARG ;[735] MOVSS ARG,ARG ;[735] EXCEPT FLAGS NEED TO BE ADJUSTED IORM ARG,(SX) ;[735] TRZ FRR,NOUNVS ;[735] CAN SEARCH UNVS AGAIN RET] ;[735] CALL EXTRN1 ;[1070] SET UP EXTERN CALL EXTRN2 ;[1070] INSERT/UPDATE IT TRZ FRR,NOUNVS ;[1070] SEARCH UNIVERSALS AGAIN MOVSI ARG,UNDF ;BUT PUT UNDF BACK ON IORM ARG,(SX) ;SO MESSAGE WILL COME OUT RET ;GET NEXT SYMBOL UOUT10: AOS UNDCNT ;INCREMENT UNDEFINED SYMBOL COUNT CALL OUTSYM ;OUTPUT THE SYMBOL CALL OUTTAB ;THEN A TAB MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL@/] CALL OUTSIX JRST OUTCR ;POPJ FOR NEXT SYMBOL ;HERE TO UPDATE SYMBOL TABLE TO THE ACTUAL VALUE FOR TAGS IN LITERALS ;AND CHAIN LOCAL BLOCKS INTO A LIST. A LOCAL BLOCK FORMAT IS CONVERTED: ; ; FROM: VALUE,,FLAGS TO: VALUE,,CHAIN ; RELOC,,0 JOIN-RELOC,,NXT-LOCAL ; ; WHERE JOIN-RELOC IS: ; BIT16 - RELOC OF CHAIN ; BIT17 - RELOC OF VALUE ; UOUT13: CHNLOC: TRC ARG,LTAGF ;[735] TAG IN LIT? TRCE ARG,LTAGF ;[735] JRST UOUT0 ;[735] NO, HRRZ V,(SX) ;[735] GET VALUE(PTR TO FIRST PAIR) MOVE AC1,1(V) ;[735] GET PTR TO CURRENT LOCAL BLOCK TLNE AC1,-1 ;[735] ANYTHING IN LH? JRST UOUT0 ;[735] YESILL UNRESOLVED IFE FTPSECT,< ;[735] SETZ ARG, ;[735] CLEAR INDEX AC > IFN FTPSECT,< ;[735] SKIPN ARG,SGNMAX ;[735] DOING PSECTS? JRST UOUT15 ;[735] NO, JUMP MOVE ARG,SGNCUR ;[735] UOUT14: MOVEM ARG,SGNCUR ;[735] CALL SRCHI ;[735] GET PSECT SYMTAB BOUNDARY CAMG SX,SGSTOP ;[735] IN THE RANGE? CAMGE SX,SGSBOT ;[735] AOJA ARG,UOUT14 ;[735] NO, NEXT PSECT SYMTAB > ;[735] HRRZ AC1,1(V) ;[735] GET LOCAL BLOCK PTR AGAIN UOUT15: HLLZ AC2,0(V) ;[735] CHAIN-RELOC IN LH LSH AC2,1 ;[735] SHIFT TO LEFT BY 1 ON BIT16 MOVS AC0,0(AC1) ;[735] GET FLG,,VALUE IOR AC0,1(AC1) ;[735] OR IN RELOC WITH FLG,,VALUE MOVEM AC0,(SX) ;[735] UPDATE SYMTAB WITH REAL FLG,,V HRL AC0,0(V) ;[735] GET CHAIN,,V MOVSM AC0,0(AC1) ;[735] SWAP HALVES AND STORE IN WORD1 HRR AC2,LOCAL(ARG) ;[735] PTR OF PREVIOUS LOCAL IN RH ADDM AC2,1(AC1) ;[735] JOIN-RELOC,,NEXT-LOCAL IN WORD2 MOVEM AC1,LOCAL(ARG) ;[735] UPDATE LOCAL TO CURRENT PAIR HLRZ ARG,0(SX) ;[735] REAL FLAGS IN RH RET ;[735] ;OUTPUT THE ENTRIES EOUT: MOVEI C,0 ;INITIALIZE THE COUNT MOVE SX,SYMBOL MOVE SDEL,0(SX) EOUT1: SOJL SDEL,EOUT2 ;TEST FOR END ADDI SX,2 HLRZ ARG,0(SX) TRNE ARG,EXTF!SYNF ;[733] DON'T COUNT ILLEGAL ENTRY JRST EOUT1 ;[733] ANDCAI ARG,SYMF!INTF!ENTF JUMPN ARG,EOUT1 ;IF INVALID, DON'T COUNT AOJA C,EOUT1 ;BUMP COUNT EOUT2: ;(REMOVED) JUMPE C,CPOPJ ;[765] DON'T GENERATE EMPTY ENTRY BLOCK HRLI C,4 ;BLOCK TYPE 4 CALL OUTBIN SETZB C,ARG CALL OUTBIN MOVE SX,SYMBOL MOVE SDEL,0(SX) MOVEI V,^D18 EOUT3: SOJL SDEL,CPOPJ ;[664] ADDI SX,2 HLRZ C,0(SX) TRNE C,EXTF!SYNF ;[761][733] DON'T OUTPUT ILLEGAL ENTRY JRST EOUT3 ;[733] ANDCAI C,SYMF!INTF!ENTF JUMPN C,EOUT3 SOJGE V,EOUT4 ;TEST END OF BLOCK CALL OUTBIN MOVEI V,^D17 ;WFW EOUT4: MOVE AC0,-1(SX) CALL SQOZE MOVE C,AC0 CALL OUTBIN JRST EOUT3 ;HERE TO GENERATE BLOCK-10 FROM CHAIN LOCAL BLOCKS HAVING THE FORMAT: ; ; VALUE,,CHAIN-VALUE ; JOIN-RELOC,,NXT-LOCAL ; LSOUT: IFE FTPSECT,< ;[735] SETZ AC1, ;[735] CLEAR INDEX AC > ;[735] IFN FTPSECT,< ;[735] MOVE AC1,SGNCUR ;[735] ONLY FOR CURRENT PSECT > ;[735] SKIPN C,LOCAL(AC1) ;[725] ANY LOCAL FIXUPS REQUIRED? RET ;NO MOVS AC0,(C) ;GET VALUE RIGHT WAY ROUND MOVS RC,1(C) ;AND RELOCATION HLRZM RC,LOCAL(AC1) ;[735] STORE NEXT POINTER CALL COUT ;OUTPUT THIS WORD JRST LSOUT ;LOOK FOR MORE ;OUTPUT THE SYMBOLS SOUT: SKIPN IONSYM ;SKIP IF NOSYM SEEN TRNN ER,LPTSW!TTYSW ;A LISTING REQUIRED? JRST SOUT2 ;NO MOVEI [ASCIZ /SYMBOL TABLE/] HRRM SUBTTX ;SET NEW SUB-TITLE MOVEI ARG,NCOLS ;SET UP FOR NCOLS ACROSS SYMBOL TABLE TRNE ER,TTYSW ;IS TTY LISTING DEVICE? MOVEI ARG,2 ;YES,ONLY 2 COLLUMNS MOVEM ARG,NCOLLS ;STORE ANSWER IFE FTPSECT,< ;[575] MOVE SX,SYMBOL ;START OF TABLE MOVE SDEL,(SX) ;COUNT OF SYMBOLS > IFN FTPSECT,< ;[575] MOVE SX,SGSBOT ;START OF TABLE MOVE SDEL,SGNCUR ;CUR PSECT INX JUMPE SDEL,SOUTBS ;IS THIS THE BLANK PSECT? MOVE ARG,[XWD SGTTLB,SGLIST] BLT ARG,SGTTLE-SGTTLB+SGLIST-1 ;MOVE SUBTTL MOVE AC1,SGTTLE ;'TO' POINTER MOVE AC2,SGTTLF ;'FROM' POINTER SGTTLL: ILDB AC0,AC2 ;GET A SIXBIT CHAR ADDI AC0,40 ;FORM ASCII IDPB AC0,AC1 ;PUT IN SUBTTL TLNE AC2,770000 ;DONE SIX CHARS? JRST SGTTLL ;NOT DONE YET SETZ AC0, ;TERMINATE SUBTTL IDPB AC0,AC1 ;WITH NULL BYTE MOVEI AC0,SGLIST ;POINTER TO HRRM AC0,SUBTTX ;NEW SUBTTL SOUTBS: HRRZ SDEL,SGSCNT(SDEL) ;COUNT OF SYMBOLS > ;END OF FTPSECT ADDI SX,2 ;SKIP COUNT MOVEM SX,SXSV ;SAVE PLACE MOVEM SDEL,SDELSV MOVE SX,PAGEN. ;GET LAST PAGE-OFFSET MOVEM SX,SPAGN. ;AND SAVE IN CASE PRGEND MOVE SX,SPAGNO ;GET LAST SYMBOL PAGE NUMBER EXCH SX,PAGENO ;SWAP WITH OUTPUT PAGE NUMBER MOVEM SX,SPAGNO ;AND STORE IT MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0] IORM SX,DBUF+4 ;FIXUP TITLE SOUT0: CALL SOUTP ;GET PAGE SET UP JRST SOUT1 ;NOTHING TO OUTPUT CALL SOUTF ;DUMP ONE PAGE JRST SOUT1 ;DIDN'T FILL PAGE-DONE JRST SOUT0 IFN FTPSECT,< ;[575] SGTTLB: ASCII /SYMBOL TABLE FOR PSECT / SGTTLE: POINT 7,SGTTLE-SGTTLB+SGLIST SGTTLF: POINT 6,SGNAME(SDEL) > SOUTT: MOVE ARG,(SX) ;GET FLAGS TLNE ARG,SUPRBT ;SURPRESSED? RET ;YES TLNN ARG,SYMF ;SYMBOL IS OK TLNN ARG,SYNF!MACF ;BUT MACRO OR SYNONYM AREN'T AOS (P) RET SOUTP: MOVE AC1,NCOLLS ;GET COLUMN COUNT MOVE SX,SXSV ;GET POSITION MOVE SDEL,SDELSV ;AND COUNT SOUTP0: MOVEM SX,SYMBLK(AC1) HRLM SDEL,SYMBLK(AC1) ;SAVE IN TABLE MOVE AC0,..LPP ;LINE COUNT SOUTP1: JUMPE SDEL,SOUTP2 ;IF NONE LEFT, GO ELSEWHERE CALL SOUTT ;SYMBOL OK? TDZA RC,RC ;NO SETO RC, ;YES ADDI SX,2 ;SET UP FOR NEXT NOW SUBI SDEL,1 JUMPGE RC,SOUTP1 ;SKIP SYMBOL SOJG AC0,SOUTP1 ;COUNT IN SYMBOL SOJG AC1,SOUTP0 ;START NEXT COLUMN MOVEM SX,SXSV ;SAVE POSITION MOVEM SDEL,SDELSV JRST CPOPJ1 ;[664] SKIP EXIT SOUTP2: CLEARM SDELSV ;FLAG DONE CAME AC1,NCOLLS ;IF ON 1ST COLUMN JRST .+3 CAMN AC0,..LPP ;AND FIRST LINE RET ;THEN SKIP PRINTING SOJLE AC1,CPOPJ1 ;ALREADY GOT THIS LINE CLEARM SYMBLK(AC1) SOJG AC1,.-1 ;ZERO ALL OTHERS JRST CPOPJ1 SOUTF: CALL OUTFF ;GET TO TOP OF PAGE MOVE AC1,..LPP MOVEM AC1,COLSIZ SOUTF1: CALL SOUTL ;DUMP ONE LINE RET ;WAS BLANK SOSLE COLSIZ ;ONE MORE DONE JRST SOUTF1 ;MORE TO GO SOUTF2: JRST CPOPJ1 SOUTL: MOVE AC1,NCOLLS ;SET COLUME COUNT SOUTL0: HRRZ SX,SYMBLK(AC1) HLRZ SDEL,SYMBLK(AC1);GET POSITION IN TABLE JUMPE SDEL,SOUTL3 ;NOTHING THERE SOUTL1: CALL SOUTT ;SYMBLE PRINTABLE? JRST SOUTL2 ;CENCOR!! CALL SOUTE ;DUMP OUT ENTRY ADDI SX,2 SUBI SDEL,1 ;UP TP NEXT ONE HRL SX,SDEL ;SAVE OUR PLACE MOVEM SX,SYMBLK(AC1) SOJG AC1,SOUTL0 ;NEXT! AOS (P) JRST OUTCR ;POLISH OFF LINE SOUTL2: ADDI SX,2 SOJG SDEL,SOUTL1 ;KEEP SEARCHING SOUTL3: CAME AC1,NCOLLS ;BLANK LINE? AOS (P) ;NO JRST OUTCR SOUTE: MOVE AC0,-1(SX) CALL OUTSYM ;DUMP SYMBOL OUT CALL OUTTAB ;THEN A TAB CALL SRCH7 ;GET VALUE JUMPL RC,[HRRZI CS,-1 ;[633] IF POLISH, OUTPUT 6 ZEROS CALL ONC1 ;[633] HRRZI CS,-5 ;[633] NO TAB, 6 MORE ZEROS, AND # CALL ONC1 ;[633] CALL OUTTAB ;[633] A TAB MOVEI CS,[ASCII\pol\] ;[633] SYMBOL TYPE CALL OUTAS0 ;[633] JRST OUTTAB] ;[633] LAST TAB TLNN ARG,EXTF ;EXTERNAL? JRST .+5 HLRZ RC,V ;YES, NEED FIXUP TRNE RC,-2 MOVS RC,(RC) HLL V,RC HLLO CS,V TLNE RC,-1 TRZ CS,1 TLNE RC,-2 TRZ CS,EXTF TLNN V,-1 TLNE RC,-1 CALL ONC1 CALL OUTTAB HRLO CS,V TRNE RC,-1 TRZ CS,1 TRNE RC,-2 TRZ CS,EXTF CALL ONC1 CALL OUTTAB ;AND TAB, OF COURSE CALL SOUTE8 ;ABBREVIATION FOR TYPE JRST OUTTAB ;FINAL TAB SOUTE8: TLNN ARG,INTF!EXTF!ENTF!UNDF!NOOUTF RET ;SKIP JUNK FOR SIMPLE STUFF SETZ CS, TLNE ARG,INTF ;INTERNAL MOVEI CS,1 TLNE ARG,EXTF ;EXTERNAL MOVEI CS,-1 TLNE ARG,ENTF ;ENTRY MOVEI CS,-5 TLNE ARG,NOOUTF ;DDT SURPRESSED ADDI CS,3 TLNE ARG,UNDF ;UNDEFINED MOVEI CS,-3 ;SET FOR UDF MOVEI CS,SOUTC(CS) ;GET ABREVIATION JRST OUTAS0 SOUT1: MOVE SX,PAGENO ;GET LAST SYMBOL PAGE NUMBER EXCH SX,SPAGNO ;SWAP WITH OUTPUT PAGE NUMBER MOVEM SX,PAGENO ;AND STORE IT MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0] ANDCAM SX,DBUF+4 ;FIXUP TITLE SOUT2: CALL SGLKUP ;SET FOR TABLE SCAN TRNN ARG,SYMF TRNN ARG,MACF!SYNF TDZA MRP,MRP ;SKIP AND CLEAR MRP RET ;NO, TRY AGAIN TRNE ARG,INTF MOVEI MRP,1 TRNE ARG,EXTF MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL TRNE ARG,SYNF ;SYNONYM? JUMPL MRP,CPOPJ ;[664] YES, DON'T OUTPUT IF EXTERNAL TRNE ARG,SUPRBT ;IF SUPRESSED RET ;DO NOT OUTPUT JUMPGE MRP,SOUT10 ;BRANCH IF NOT EXTERNAL HLRZ RC,V ;PUT POINTER/FLAGS IN RC TRNE RC,-2 ;POINTER? MOVS RC,0(RC) ;YES HLL V,RC ;STORE LEFT VALUE SOUT10: PUSH P,RC ;SAVE FOR LATER MOVEI AC1,0 JUMPLE MRP,SOUT15 ;SET DEFFERRED BITS IF INTERN=EXTERN IFN POLISH,< JUMPL RC,.+3 ;ONLY SET RHS FIXUP FLAG IF POLISH > TLNE RC,-2 ;CHECK FOR LEFT FIXUP IORI AC1,40 ;AND SET BITS TRNE RC,-2 ;CHECK FOR RIGHT FIXUP IORI AC1,20 ;AND SET BITS SOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL HRRZS RC TRNE RC,-2 HLLZS RC TLZE RC,-1 TRO RC,2 HRL MRP,RC MOVEI RC,0 TRNE ARG,ENTF ;ENTRY DMN HRRI MRP,-5 TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW ADDI MRP,3 ;YES WFW TRNE ARG,UNDF ;UNDEFINED IS EXTERNAL HRRI MRP,2 ;SO FLAG AS UDF IOR AC1,SOUTC(MRP) MOVE ARG,AC1 CALL NOUT2 ;SQUOZE AND DUMP THE SYMBOL MOVEM AC0,SVSYM ;SAVE IT MOVE AC0,V ;GET THE VALUE HLRZ RC,MRP ;AND THE RELOCATION CALL COUT POP P,RC ;GET BACK RELOC AND CHECK EXTERNAL TRNN RC,-2 ;IS IT? JRST SOUT50 ;NO IFN POLISH,< JUMPL RC,SOUT70 ;SPECIAL POLISH SYMBOL FIXUP > MOVE AC0,1(RC) ;GET NAME MOVEI ARG,60 ;EXTERNAL REQ CALL SQOZE HLLZS RC ;NO RELOC CALL COUT ;OUTPUT IT MOVE AC0,SVSYM ;GET SYMBOL NAME TLO AC0,500000 ;SET AS ADDITIVE SYMBOL TLZ AC0,200000 ;BUT NOT LEFT HALF ETC CALL COUT SOUT50: MOVSS RC ;CHECK LEFT HALF TRNN RC,-2 RET MOVE AC0,1(RC) MOVEI ARG,60 CALL SQOZE MOVEI RC,0 CALL COUT MOVE AC0,SVSYM TLO AC0,700000 JRST COUT IFN POLISH,< SOUT70: CALL COUTD ;DUMP CURRENT BLOCK PUSH P,SYMBOL ;SAVE CURRENT SYMBOL TABLE ORIGIN PUSH P,FREE ;SAVE FREE STORAGE ORIGIN PUSH P,BLKTYP ;SAVE CURRENT BLOCK TYPE MOVEI AC0,11 ;SET TO POLISH MOVEM AC0,BLKTYP PUSH P,POLIST ;SAVE REAL LIST SETZM POLIST ;INITIALIZE SKIPE (RC) JFCL MOVNI AC0,3 ;ASSUME FULL WORD FIXUP MOVEM AC0,POLTYP MOVE AC0,SVSYM ;RADIX-50 SYMBOL TLZ AC0,740000 ;CLEAR CODE BITS MOVEM AC0,INASGN ;FLAG SYMBOL FIXUP CALL POLSYM ;NOW CONVERT CALL POUT ;DUMP THIS BLOCK CALL COUTD ;FORCE BLOCK OUT MOVSI AC0,(POINT 2) ;RESET BYTE FIELD HLLM AC0,COUTP POP P,POLIST ;PUT LIST BACK POP P,BLKTYP ;PREVIOUS BLOCK TYPE POP P,FREE ;GIVE BACK FREE STG USED BY POLSYM POP P,AC0 ;RECOVER SYMTAB ORIGIN SUB AC0,SYMBOL ;COMPUTE DIFFERENCE IN CASE SYMTAB MOVED SUB SX,AC0 ;ADJUST LOCAL PTR ACCORDINGLY RET > !04 ;DMN 0 !60 ;UNDEFINED EXTERNAL !44 ;SUPRESSED ENTRY !60 SOUTC: EXP 10 !04 !60 ;SUPPRESSED EXTERNAL (NOT USED YET) !50 !44 ;DMN ;OUTPUT THE BINARY BOUT: HRRZ CS,LOCA ;PICKUP THE LOCATION SUB CS,STPX ;MINUS START ADD CS,STPY ;PLUS END HRLO CS,CS ;TO GET ASSEMBLY LOCATION SKIPGE BLSW ;BINARY LISTING OFF? JRST BOUT1 ;YES ILDB C,TABP ;DO A TAB CALL OUTL SKIPLE LITLVL ;IN LITERAL? JRST BOUT1 ;YES, DON'T LIST LOCATION CALL ONC1 ;OUTPUT IT TO THE LISTING FILE CALL OUTCSQ ;[717] GO OUTPUT "'" BOUT1: CALL DSTOW ;GET THE CODE IFN POLISH,< JUMPL RC,[TLO FR,POLSW ;[614] WE HAVE A POLISH FIXUP TRO FRR,LHPSW ;[614] HRRZS RC ;[614] CLEAR LH(RC) JRST .+1] ;[614] RETURN PUSH P,RC ;[614] STORE AWAY RC HRRES RC ;[614] BEFORE CHECKING RH JUMPL RC,[TLO FR,POLSW ;[614] DOING POLISH TRO FRR,RHPSW ;[614] POP P,RC ;[614] RESTORE RC HLLZS RC ;[614] CLEAR RH(RC) JRST .+2] ;[614] SKIP RETURN POP P,RC ;[614] > PUSH P,RC ;SAVE RELOC PUSH P,RC ;AND AGAIN TLNE RC,-2 ;CHECK LEFT EXTERNAL HRRZS RC ;MAKE LEFT NON-RELOC SKIPG LITLVL ;NOT IN LITERAL? TRNN RC,-2 ;RIGHT EXT? JRST BOUT30 ;NO HRRZ AC1,AC0 ;YES JUMPE AC1,BOUT20 ;PROCESS IF ZERO CODE THERE HLLZS RC ;MAKE NON-RELOC JRST BOUT30 ;PROCESS BOUT20: HRRM AC1,-1(P) ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0) HRR AC0,0(RC) ;NO, SET ADDRESS LINK MOVE AC1,LOCO ;GET CURRENT LOCATION HRRM AC1,0(RC) ;SET NEW LINK HLRZ AC1,0(RC) ;GET FLAGS/POINTER ;[604] TRNN AC1,-2 ;POINTER? HRR AC1,RC ;NO, SET TO FLAGS HLR RC,0(AC1) ;PUT FLAGS IN RC HRL AC1,MODO ;GET CURRENT MODE TRZE RC,-2 ;LEFT HALF RELOCATABLE+ TLO AC1,2 ;YES, SET FLAG HLLM AC1,0(AC1) ;STORE NEW FLAGS BOUT30: HLLO CS,AC0 TLZE RC,1 ;PACK RELOCATION BITS TRO RC,2 TRNE RC,2 ;LEFT HALF RELOCATABLE? TRZ CS,1 ;YES, RESET BIT SKIPGE BLSW ;BINARY LISTING OFF? JRST BOUT3I ;YES PUSH P,AC0 ;NEED AN AC HLRZ AC0,-1(P) ;AC0 = LEFT RELOCATION CAILE AC0,1 ;EXTERNAL? XORI CS,EXTF!1 ;YES, SET SWITCH IFN FORMSW,< OR AC0,HWFMT JUMPN AC0,BOUT3H ;EDIT IN HALF WORD FORMAT IF NOT 0 MOVE AC0,FORM ;GET FORM WORD MOVEI C,0 ;ZERO FIELD SIZE BOUT3A: JFFO AC0,BOUT3B ;AC1 = FIELD SIZE -1 JRST BOUT3C ;NO FIELDS LEFT, JUMP BOUT3B: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD MOVEI AC1,6(AC1) IDIVI AC1,3 ;AC1 = COLUMNS USED + 1 ADDI C,(AC1) ;INCREMENT FIELD SIZE CAIG C,^D23 ;IS FIELD SIZE GTR 23? JRST BOUT3A ;NO. CONTINUE MOVE AC1,HWFORM ;USE STANDARD FORM MOVEM AC1,FORM MOVEI C,^D13 ;SET FIELD SIZE TO 13 BOUT3C: MOVEM C,FLDSIZ ;STORE FIELD SIZE MOVE AC0,FORM ;AC0 = FORM WORD TRNN RC,2 ;IS LEFT HALF RELOCATED? CAMN AC0,HWFORM ;NO. IS FORM HALF WORD? JRST BOUT3H ;YES. EDIT IN OLD WAY IBP TABP CAIL C,^D16 IBP TABP IFN FTPSECT,< ;[647] SKIPE SGNMAX ;[647] DOING PSECTS? JRST [ CAIL C,^D16 ;[717] IBP TABP ;[717] MOVEI C," " ;[647] USE 2 SPACES INSTEAD OF A TAB CALL OUTC ;[647] CALL OUTC ;[647] IBP TABP ;[647] JRST BOUT01] ;[647] > ;[647] ILDB C,TABP ;GET A TAB CALL OUTL ;OUTPUT IT BOUT01: MOVE AC2,(P) ;[647] AC2 = INFO TO BE EDITED PUSH P,CS ;SAVE CS = C+1 BOUT3D: JFFO AC0,BOUT3E ;AC1 = FIELD LENGTH - 1 BOUT3E: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD MOVEI C,3(AC1) MOVEI AC1,0 LSHC AC1,-2(C) ;AC1 = FIELD INFO IDIVI C,3 ;C = # OF OCTAL DIGITS MOVE C+1,AC0 ;SAVE AC0 IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] IBP TABP ;[717] > ;[717] SKIPE IOSEEN ;IS THIS A I/O INST. CALL BOUT3J ;YES,SET FIELDS CORRECTLY MOVNS C ROT AC1,(C) ROT AC1,(C) ROT AC1,(C) MOVNS C BOUT3F: MOVEI AC0,6 ;EDIT A DIGIT LSHC AC0,3 EXCH AC0,C CALL OUTC ;OUTPUT IT MOVE C,AC0 SOJG C,BOUT3F ;IF MORE DIGITS, GO BACK JUMPE C+1,BOUT3G ;JUMP IF END OF WORD MOVE AC0,C+1 ;RESTORE AC0 MOVEI C," " CALL OUTC ;OUTPUT A SPACE JRST BOUT3D ;PROCESS NEXT FIELD BOUT3G: POP P,CS ;RESTORE CS = C+1 MOVEI C," " TRNE RC,1 ;RELOCATABLE? MOVEI C,"'" ;YES HRRZ AC0,-1(P) ;AC0 = RIGHT RELOCATION CAILE AC0,1 ;EXTERNAL? MOVEI C,"*" ;YES TLNE FR,POLSW ;POLISH? MOVEI C,"#" ;YES, CALL ONC2 ;STORE POSSIBLE INDICATOR POP P,AC0 JRST BOUT3I ;CONTINUE BOUT3H: IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] IBP TABP ;[717] > ;[717] MOVEI C,^D15 ;SET SIZE TO 15 MOVEM C,FLDSIZ SETZM IOSEEN ;CLEAR IN CASE HWFMT WAS SET > POP P,AC0 ;RESTORE IFN POLISH,< TRZE FRR,LHPSW ;[614] LEFT HALF POLISH? HRRI CS,-5 ;[614] YES, WE WANT A "#" > CALL ONC HRLO CS,AC0 TDZ CS,RC ;SET RELOCATION HRRZ C,(P) ;C = RIGHT RELOCATION CAILE C,1 ;EXTERNAL XORI CS,EXTF!1 ;YES, SET SWITCH IFN POLISH,< TRZE FRR,RHPSW ;[614] RIGHT HALF POLISH? HRRI CS,-5 ;[614] YES, MAKE SURE WE GET "#" > CALL ONC BOUT3I: POP P,CS ;GET RID OF ENTRY ON STACK SKIPLE LITLVL ;IN LITERAL? JRST [ POP P,RC ;YES, CLEAR STACK RET] ;DON'T OUTPUT TO REL HRRZ CS,LOCO TLNE FR,RIMSW!RIM1SW!R1BSW ;RIM OUTPUT? JRST ROUT ;YES, GO PROCESS HRL CS,MODO CAME CS,MODLOC ;SEQUENCE OR RELOCATION BREAK? CALL COUTD ;YES, DUMP THE BUFFER SKIPL COUTX ;NEW BUFFER? JRST BOUT40 ;NO, STORE CODE AND EXIT MOVEM CS,MODLOC ;YES, STORE NEW VALUES EXCH AC0,LOCO EXCH RC,MODO CALL COUT ;STORE BLOCK LOCATION AND MODE EXCH RC,MODO ;RESTORE CURRENT VALUES EXCH AC0,LOCO BOUT40: CALL COUT ;EMIT CODE POP P,RC ;RETRIEVE EXTERNAL BITS TRNN RC,-2 ;RIGHT EXTERNAL? JRST BOUT50 ;TRY FOR LEFT CALL COUTD PUSH P,BLKTYP ;TERMINATE TYPE AND SAVE MOVEI AC0,2 ;BLOCK TYPE 2 MOVEM AC0,BLKTYP MOVE AC0,1(RC) ;GET SYMBOL MOVEI ARG,60 ;CODE BITS CALL SQOZE ;CONVERT TO RADIX 50 HLLZS RC ;SYMBOL HAS NO RELOCATION CALL COUT ;EMIT MOVE AC0,LOCO ;GET CURRENT LOC HRLI AC0,400000 ;ADDITIVE REQ HRR RC,MODO ;CURRENT MODE CALL COUT ;EMIT MOVSS RC ;NOW FOR LEFT TRNN RC,-2 JRST BOUT60 JRST BOUT70 BOUT50: MOVSS RC ;CHECK OTHER HALF TRNN RC,-2 ;LEFT HALF EXTERNAL? JRST BOUT80 ;NO, FALSE ALARM CALL COUTD ;CHANGE MODE PUSH P,BLKTYP MOVEI AC0,2 MOVEM AC0,BLKTYP BOUT70: MOVE AC0,1(RC) TLNN AC0,-1 ;[735] EXTERNAL NAME? JRST [ MOVEI AC0,10 ;[735] NO, LH=0 MUST BE PTR TO LOCAL BLK MOVEM AC0,BLKTYP ;[735] GENERATE A BLOCK 10 MOVE ARG,RC ;[735] SETZ RC, ;[735] SETO AC0, ;[735] CALL COUT ;[735] OUTPUT -1 FOR LEFT MOVE AC1,1(ARG) ;[735] GET LOCAL BLK PTR HLRZ AC0,0(AC1) ;[735] VALUE IN RH HRL AC0,LOCO ;[735] FIXUP ADDR IN LH MOVE RC,MODO ;[735] FIXUP RELOC LSH RC,1 ;[735] SHIFT ONE MOVS ARG,1(AC1) ;[735] GET RELOC IN RH ADD RC,ARG ;[735] MAKE IT JOIN-RELOC CALL COUT ;[735] EMIT JRST BOUT60] ;[735] MOVEI ARG,60 CALL SQOZE HLLZS RC CALL COUT MOVE AC0,LOCO HRLI AC0,600000 ;LEFT HALF ADD HRR RC,MODO CALL COUT ;EMIT BOUT60: CALL COUTD ;CHANGE MODE POP P,BLKTYP ;TO OLD ONE BOUT80: AOS LOCO AOS MODLOC IFN POLISH,< TLZ FR,POLSW ;[761] TRZ FRR,LTGSW!LHPSW!RHPSW!FWPSW> ;[761] RET IFN FORMSW,< BOUT3J: MOVSS IOSEEN ;SWAP SKIPGE IOSEEN ;SKIP IF NOT FIRST FIELD JRST [HLLZS IOSEEN ;CLEAR RIGHT HALF RET] ;AND RETURN MOVSS IOSEEN ;SWAP BACK LSH AC1,2 ;CORRECT MNEMONIC AND OP CODE CAIE C,1 ;IS IT OP CODE? RET ;NO,JUST RETURN MOVEI C,2 ;TWO CHAR. WIDE NOW SETZM IOSEEN ;DON'T COME AGAIN RET ;RETURN > ;HERE TO OUTPUT "'" FOR RELOCATABLE ADDRESSES OUTCSQ: MOVEI C,"'" ;[717] IFN FTPSECT,< ;[717] SKIPE SGNMAX ;[717] JRST OUTIDX ;[717] > SKIPE MODA ;[717] SKIP IF ABSOLUTE PJRST OUTC ;[717] NO RET ;[717] ;HERE TO OUTPUT PSECT INDES IFN FTPSECT,< OUTIDX: SKIPN MODA ;[717] ABSOLUTE? JRST [ MOVEI C,40 ;[717] YES, CALL OUTC ;[717] 3 SPACES INSTEAD CALL OUTC ;[717] PJRST OUTC] ;[717] CALL OUTC ;[717] OUT WITH "'" MOVE C,SGNCUR ;[647] GET CURRENT PSECT INDES CAIL C,100 ;[647] DO WE HAVE A 3-DIGIT INDEX#? PJRST OUTOCT ;[647] YES, USE OUTOCT MOVE CS,[POINT 3,SGNCUR,29] ;[647] NO, LESS ILDB C,CS ;[647] PICK UP FIRST DIGIT ADDI C,"0" ;[647] CONVERT TO ASCII CALL OUTC ;[647] AND OUTPUT IT ILDB C,CS ;[647] SECOND DIGIT ADDI C,"0" ;[647] PJRST OUTC ;[647] > NOUT: MOVE V,[POINT 7,TBUF] ;POINTER TO ASCII LINE MOVSI CS,(POINT 6,AC0) ;POINTER TO SIXBIT AC0 SETZB ARG,AC0 NOUT1: ILDB C,V ;GET ASCII CAIL C,"A"+40 CAILE C,"Z"+40 JRST .+2 TRZA C,100 ;LOWER CASE TO SIXBIT SUBI C,40 ;CONVERT TO SIXBIT JUMPLE C,NOUT3 ;TEST FORM NON-SIXBIT CAILE C,77 ;AND NOT GREATER THAN SIXBIT JRST NOUT3 ;... LDB AC1,[POINT 6,CSTAT(C),23] ;INDEX TO CSTAT SKIPN AC1 ;RADIX 50? JRST NOUT3 ;NO, ASSUME TERMINATOR IDPB C,CS ;DEPOSIT IN AC0 TLNE CS,770000 ;TEST FOR SIX CHARACTERS JRST NOUT1 ;NO, GET ANOTHER NOUT3: SKIPGE UNIVSN ;IF A UNIVERSAL PROG RET ;RETURN TO PUT IT IN THE TABLE CALL NOUT2 ;DUMP NAME MOVSI AC0,11 ;TYPE MARKER IOR AC0,CPUTYP ;CPU TYPE PJRST COUT ;DUMP AND EXIT NOUT2: CALL SQOZE ;CONVERT TO SIXBIT JRST COUT ;DUMP AND EXIT HOUT: IFN FTPSECT,< ;[575] SETZB AC0,SGNCUR ;[642] FORCE TO PSECT 0 SKIPE SGNMAX ;NO PSECTS CALL SGOUTN ;PUT IT OUT > MOVEI RC,1 ;RELOCATABLE MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS JUMPE AC0,.+2 ;NOT TWO SEGMENTS CALL COUT ;OUTPUT IT MOVE AC0,SGATTR SKIPE HHIGH ;ANY TWOSEG HIGH STUFF JRST COUT ;YES,SO NO ABS. CALL COUT ;OUTPUT THE HIGHEST LOCATION MOVE AC0,ABSHI ;PUT OUT ABS PORTION OF PROGRAM BREAK SOJA RC,COUT ;OUTPUT A WORD OF ZERO AND EXIT IFN POLISH,< ;HERE TO OUTPUT BLOCK TYPE 11 POUT: SKIPN POLIST ;ANY POLISH TO OUTPUT? RET ;NO TLO FR,POLSW ;SET FLAG CALL COUTD ;DUMP BUFFER UNLESS EMPTY MOVE CS,@POLIST ;GET A BLOCK POINTER EXCH CS,POLIST ;SET FOR NEXT TIME SKIPE SGNMAX ;[1060] ANY PSECTS? JRST [HRRZ AC0,1(CS) ;[1060] YES, SAVE INDEX OF CURRENT TRZ AC0,400000 ;[1060] (SEE POLOPF:) MOVEM AC0,POLPS0 ;[1060] JRST .+1] ;[1060] POUTA: ADDI CS,1 ;FIRST WORD MOVE AC0,(CS) ;GET SOMETHING SETZ RC, ;CLEAR RELOCATION JUMPL AC0,POUTOP ;THIS IS AN OPERATOR CALL PCOUT ;STORE THIS HALF WORD JUMPE AC0,POUT0 ;18 BIT VALUE SOJE AC0,POUT1 ;36 BIT VALUE HLRZ AC0,1(CS) ;GET HALF OF SYMBOL CALL PCOUT HRRZ AC0,1(CS) ;GET OTHER HALF CALL PCOUT AOJA CS,POUTA POUT0: HLRZ RC,1(CS) ;GET RELOCATION HRRZ AC0,1(CS) ;AND VALUE CALL PCOUT AOJA CS,POUTA ;GET NEXT POUT1: HLRZ RC,1(CS) ;GET LEFT HALF HLRZ AC0,2(CS) CALL PCOUT HRRZ RC,1(CS) ;RIGHT HALF HRRZ AC0,2(CS) CALL PCOUT ADDI CS,2 ;SKIP OVER 2 WORDS JRST POUTA POUTOP: HRRZ AC0,AC0 ;GET OPERATOR ONLY CALL PCOUT ;OUTPUT CAIGE AC0,-6 ;CHECK FOR STORE OP JRST POUTA ;ITS NOT CAIGE AC0,-3 ;CHECK FOR SYMBOL FIXUP JRST POUTSY ;IT IS HLRZ RC,1(CS) ;GET RELOCATION HRRZ AC0,1(CS) ;AND STORE ADDRESS HRLM RC,POLAD0 ;[1060] SAVE ADDR AND RELOCATION HRRM AC0,POLAD0 ;[1060] IN CASE ERROR POUTOQ: CALL PCOUT SKIPE POLERR ;[1060] PROCESSING ERROR? CALL [MOVEI C,POLLIM ;[1060] YES, FORCE TERMINATION IN MOVEM C,POLERR ;[1060] CASE WE HAVE GARBAGE PJRST POLER4] ;[1060] GIVE MESSAGE AND RETURN POUTQ1: TLZ FR,POLSW ;[1060] CLEAR FLAG IN CASE END SETZM POLAD0 ;[1060] CLEAR ERROR INFO SETZM POLSY0 ;[1060] JRST POUT ;SEE IF MORE TO GO POUTSY: PUSH P,1(CS) ;[1060] SAVE SYMBOL NAME IN POP P,POLSY0 ;[1060] CASE OF ERROR HLRZ AC0,1(CS) ;GET LHS SYMBOL SETZ RC, ;NO RELOCATION CALL PCOUT ;OUTPUT IT HRRZ AC0,1(CS) ;GET RHS CALL PCOUT SETZ AC0, ;FOLLOW WITH 0 FOR BLOCK LEVEL (FAIL COMPATIBLE) CALL PCOUT ;LHS PJRST POUTOQ ;RHS PCOUT: MOVE C,COUTP ;GET POINTER TLNE C,010000 ;LEFT OR RIGHT HALF? JRST PCOUTR ;JUST THE RIGHT HALF AOS C,COUTX ;INCREMENT INDEX HRLZM AC0,COUTDB(C) ;STORE LEFT HALF IDPB RC,COUTP ;AND RELOCATION RET PCOUTR: MOVE C,COUTX ;GET CURRENT INDEX HRRM AC0,COUTDB(C) ;STORE RIGHT HALF IDPB RC,COUTP ;AND RELOCATION CAIE C,^D17 ;IS THE BUFFER FULL RET ;NO ;HERE TO GIVE BEST ERROR MESSAGE POSSIBLE FOR POLISH BLOCK ;EXCEEDING 18 WORDS (OR CURRENT LIMIT) POLLIM==1 ;[1060] THIS VALUE DENOTES THE NUMBER OF 18-WORD ;[1060] BLOCKS (BEYOND THE FIRST) WE ARE WILLING ;[1060] TO PERUSE FOR A FIXUP TYPE; ;[1060] CAN BE CHANGED FOR DEBUGGING PURPOSES. POLER4: SKIPN POLERR ;[1066] FIRST TIME THROUGH? JRST [PUSH P,['MCRPTC'] ;[1066] YES, SET PREFIX POP P,PREFIX ;[1066] SETZ RC, ;[1066] ZERO RC FOR TEST AFTER CALL PUSH P,CS ;[1066] SAVE PTR TO LIST CALL EFATAL ;[1066] FATAL ERROR POP P,CS ;[1066] RESTORE CS CAMN RC,[-1] ;[1066] TEXT TO BE SUPPRESSED? PJRST POLER6 ;[1066] YES, GIVE CRLF AND EXIT JRST .+1] ;[1066] NO, CONTINUE SKIPE POLAD0 ;[1060] LOCATION FIXUP? JRST POLER1 ;[1060] YES, GIVE APPROPRIATE MESSAGE SKIPE POLSY0 ;[1060] SYMBOL FIXUP? JRST POLER2 ;[1060] GIVE APPROPRIATE MESSAGE MOVE C,POLERR ;[1060] WE DON'T KNOW FIXUP TYPE YET, CAIL C,POLLIM ;[1060] CAN WE LOOK FURTHER? JRST POLER5 ;[1060] NO, GIVE UP AOS POLERR ;[1060] YES, INITIALIZE FOR NEXT BLOCK PJRST COUTI ;[1060] AND LOOK FOR FIXUP TYPE POLER5: HRROI RC,[SIXBIT / POLISH TOO COMPLEX@/] ;[1066][1060] CALL TYPMSG ;PRINT MESSAGE POLER0: SUB P,[1,,1] ;[1060][654] ADJUST STACK POINTER AND SETZM POLERR ;[1060] CLEAR ERROR-PROCESSING COUNT SETOM COUTX ;[1060] RE-INIT WORD COUNT JRST POUTQ1 ;[1060] FORGET ABOUT THIS BLOCK POLER1: HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR LOCATION@/] ;[1066] CALL TYPM2 ;[1060] HRRZ AC0,POLAD0 ;[1060] TYPE OUT ADDRESS CALL TYPOCT ;[1060] HLRZ C,POLAD0 ;[1060] GET RELOCATION CAIN C,1 ;[1060] APPEND "'" IF NECESSARY CALL [MOVEI C,"'" ;[1060] CALL TYO ;[1060] MOVE AC0,POLPS0 ;[1060] APPEND PSECT INDEX IF JUMPE AC0,CPOPJ ;[1060] NECESSARY CAIL AC0,10 ;[1060] PJRST TYPOCT ;[1060] MOVEI C,"0" ;[1060] CALL TYO ;[1060] MOVE C,POLPS0 ;[1060] ADDI C,"0" ;[1060] PJRST TYO] ;[1060] POLER6: CALL CRLF ;[1066][1060] AND CRLF JRST POLER0 ;[1060] COMMON EXIT DEFINE R50CHR(CHR),> R50TAB: R50CHR( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% ) POLER2: HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR SYMBOL@/] ;[1066] CALL TYPM2 ;[1060] MOVE C,POLSY0 ;[1060] GET RADIX-50 OF SYMBOL TLZ C,740000 ;[1060] CLEAR 4-BIT SYMBOL CODE SETZ RC, ;[1060] CLEAR RELOCATION MOVEI AC0,5 ;[1060] SET ITERATION COUNT POLER3: IDIVI C,50 ;[1060] CONVERT TO SIXBIT SKIPE CS,R50TAB(CS) ;[1060] LSHC CS,-6 ;[1060] CAILE C,50 ;[1060] SOJG AC0,POLER3 ;[1060] LOOP BACK IF MORE SKIPE CS,R50TAB(C) ;[1060] LSHC CS,-6 ;[1060] LAST CHAR MOVE CS,RC ;[1060] TYPE RESULT CALL TYPSYM ;[1060] PJRST POLER6 ;[1066] > ;END IFN POLISH IFN FTPSECT,< ;[575] ;HERE TO OUTPUT BLOCK TYPE 24 - PSECT NAME, ATTRIBUTE AND ORIGIN SGOUTN: CALL COUTD ;FINISH OFF CURRENT BLOCK PUSH P,BLKTYP ;SAVE CURRENT BLOCK TYPE SKIPL BLK24 ;[1020] FIRST TIME? JRST SGOUTS ;[1020] NO, OUTPUT BLOCK 22 SETZM BLK24 ;[1020] CLEAR BLOCK 24 FLAG MOVEI AC0,24 ;BLOCK TYPE 22 IS A MOVEM AC0,BLKTYP ;PSECT NAME MOVE C,SGNCUR ;GET CUR PSECT INX MOVE AC0,SGNAME(C) ;GET PSECT NAME SETZ RC, ;CLEAR RELOCATION CALL COUT ;OUTPUT THE BLOCK MOVE C,SGNCUR ;[1020] GET CURRENT PSECT INDEX HLLZ AC0,SGATTR(C) ;[1020] GET ATTRIBUTE HRR AC0,C ;[1020] PSECT INDEX IN RIGHT HALF SETZ RC, ;[1020] CLEAR RELOCATION SKIPGE AC0 ;[1020] RELOCATABLE PSECT? JRST SGOUT1 ;[1020] YES, DON'T BOTHER WITH ORIGIN CALL COUT ;[1020] OUTPUT ATTRIBUTE MOVE C,SGNCUR ;INDEX AGAIN HRRZ AC0,SGORIG(C) ;GET ORIGIN IF SPECIFIED SGOUT1: CALL COUT ;[1020] CALL COUTD ;FINISH IT OFF POP P,BLKTYP ;RESTORE CURRENT BLOCK TYPE RET ;RETURN ;HERE TO OUTPUT BLOCK TYPE 22 - SWITCH CURRENT RELOC COUNTER TO THE PSECT SGOUTS: MOVEI AC0,22 ;[1020] BLOCK 24 MOVEM AC0,BLKTYP ;[1020] MOVE AC0,SGNCUR ;[1020] CURRENT PSECT INDEX SETZ RC, ;[1020] CLEAR RELOCATION JRST SGOUT1 ;[1020] THAT'S IT ;HERE TO OUTPUT BLOCK TYPE 23 - PSECT LENGTH SGOUTL: CALL COUTD ;FINISH OFF CURRENT BLOCK PUSH P,BLKTYP ;SAVE CURRENT BLOCK TYPE MOVEI AC0,23 ;BLOCK TYPE 23 IS A MOVEM AC0,BLKTYP ;PSECT LENGTH MOVE RC,SGNCUR ;GET CUR PSECT INX MOVE AC0,SGNAME(RC) ;GET PSECT NAME SETZ RC, ;CLEAR RELOCATION CALL COUT ;OUTPUT THE NAME MOVE RC,SGNCUR ;GET CUR PSECT INX HRRZ AC0,SGATTR(RC) ;GET PSECT LENGTH MOVEI RC,1 ;BREAK IS RELOCATED CALL COUT ;OUTPUT THE LENGTH AND ATTRS CALL COUTD ;FINISH IT OFF POP P,BLKTYP ;RESTORE CURRENT BLOCK TYPE RET ;RETURN > HSOUT: SETZM HISNSW ;CLEAR FOR PASS2 MOVE AC0,SVTYP3 ;GET HISEG ARG JUMPGE AC0,.+4 ;JUMP IF ONLY HISEG HRL AC0,HIGH1 ;GET BREAK FROM PASS 1 JUMPL AC0,.+2 ;OK IF GREATER THAN 400000 HRLS AC0 ;SIGNAL TWO SEGMENT TO LOADER MOVEI RC,1 ;ASSUME RELOCATABLE JRST COUT ;OUTPUT THE WORD VOUT: SKIPN RC,VECREL ;IS VECTOR ABSOLUTE ZERO? SKIPE VECTOR ;ALSO CHECK RELOCATION JRST .+3 SKIPN VECSYM ;SEE IF SYMBOLIC RET ;YES, EXIT IFN FTPSECT,< ;[575] MOVE AC0,VECFND ;GET START ADR PSECT INX MOVEM AC0,SGNCUR ;POINT CUR PSECT THERE SKIPE SGNMAX ;IF PSECTS WERE USED CALL SGOUTN ;THEN PUT OUT PSECT BLOCK MOVE RC,VECREL> ;GET RELOCATION MOVE AC0,VECTOR ;AC0 SHOULD BE FLAGS SKIPN VECSYM ;2 WORDS IF SYMBOLIC JRST COUT CALL COUT ;OUTPUT CONSTANT MOVE AC0,VECSYM ;GET SYMBOL MOVEI ARG,60 ;MAKE REQUEST CALL SQOZE ;IN RADIX-50 SETZ RC, COUT: AOS C,COUTX ;INCREMENT INDEX MOVEM AC0,COUTDB(C) ;STORE CODE IDPB RC,COUTP ;STORE RELOCATION BITS CAIE C,^D17 ;IS THE BUFFER FULL? RET ;NO, EXIT COUTD: AOSG C,COUTX ;DUMP THE BUFFER JRST COUTI ;BUFFER WAS EMPTY HRL C,BLKTYP ;SET BLOCK TYPE COUTT: ;ENTER FROM .TEXT PSEUDO-OP CALL OUTBIN ;OUTPUT COUNT AND TYPE SETOB C,COUTY ;INITIALIZE INDEX COUTD2: MOVE C,COUTDB(C) ;GET RELOCATION BITS/CODE CAMN SDEL,[XWD 440000,0] ;IF .TEXT, ONLY OUTPUT THE RELOCATION TRZN C,1 ;WORD IF HAS DATA OR NEEDED FOR NULL STR TERMINATOR CALL OUTBIN ;DUMP IT AOS C,COUTY ;INCREMENT INDEX CAMGE C,COUTX ;TEST FOR END JRST COUTD2 ;NO, GET NEXT WORD COUTI: SETOM COUTX ;INITIALIZE BUFFER INDEX SETZM COUTRB ;ZERO RELOCATION BITS IFN POLISH,< HRRZ C,BLKTYP ;IF WE ARE OUTPUTING CAIN C,11 ;POLISH BLOCK TYPE 11 SKIPA C,[POINT 1,COUTRB] ; USE HALF WORDS > MOVE C,[POINT 2,COUTRB] MOVEM C,COUTP ;INITIALIZE BIT POINTER RET ;EXIT STOWZ1: IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM STOWZ: MOVEI RC,0 STOW: IFN FORMSW,< MOVEM AC1,FORM> ;STORE FORM WORD IFN TSTCD,< SKIPE TCDFLG ;TESTING NEW LINK CODES? JRST STOWTC ;YES. > JUMP1 STOW20 ;SKIP TEST IF PASS ONE IFN POLISH,< JUMPL RC,STOW20 ;[624] JUMP IF POLISH > TRNE RC,-2 ;RIGHT HALF ZERO OR 1? CALL STOWT ;NO, HANDLE EXTERNAL TLNN RC,-2 ;LEFT HALF ZERO OR 1? WFW JRST STOW10 ;YES, SKIP TEST MOVSS RC ;SWAP HALVES CALL STOWT1 ;HANDLE EXTERNAL WFW MOVSS RC ;RESTORE VALUES STOW10: SKIPE EXTPNT ;ANY EXTERNALS REMAINING? TRO ER,ERRE ;YES, SET EXTERNAL ERROR FLAG STOW20: SKIPN INOPDF ;[1035] OPDEF OR ASSIGN? SKIPE INASGN ;[1035] JRST [MOVE AC1,STPX ;[1035] YES, STOW FIRST WORD ONLY SUB AC1,STPY ;[1035] JUMPLE AC1,.+1 ;[1035] KEEP FIRST RET] ;[1035] IGNORE REST AOS AC1,STPX ;[667][661] OTHERWISE INCREMENT POINTER MOVEM AC0,STCODE(AC1) ;STOW CODE IFN POLISH,< TRNN FRR,PIDXSW ;[1073] DOING POLISH INDEXING OR SKIPE INANGL ;[751] STILL IN EXP EVALUATION? JRST STOW23 ;[751] YES, NOT FINAL STOW, SO JUMP TLNE RC,-1 ;[614] ONLY IF LH(RC)=0 JRST STOW2R ;[614] OTHERWISE, JUMP TRZE FRR,LHPSW ;[614] CHECK FOR LEFT HALF FIXUP HRLI RC,-2 ;[614] STORE -2 FOR RELOC STOW2R: TRNE RC,-1 ;[614] ONLY IF RH(RC)=0 JRST STOW2F ;[614] OTHERWISE, JUMP TRZE FRR,RHPSW ;[614] CHECK FOR RIGHT HALF FIXUP HRRI RC,-2 ;[614] STORE -2 FOR RELOC STOW2F: JUMPN RC,STOW23 ;[614] RC=0? , JUMP IF NOT TRZN FRR,FWPSW ;[614] FULL WORD FIXUP? JRST STOW23 ;[614] NO, FINISH CHECKING HRRZI RC,-2 ;[614] -2 FOR RELOCATION SETZM STFORM(AC1) ;[614] AOS STFORM(AC1) ;[614] MOVEM RC,STOWRC(AC1) ;[614] SETZ RC, ;[614] JRST STOW22 ;[614] > STOW23: MOVEM RC,STOWRC(AC1) ;[614] STOW RELOCATION BITS IFN FORMSW,< PUSH P,FORM POP P,STFORM(AC1) ;STORE FORM WORD > STOW22: SKIPN LITLVL ;[614] ARE WE IN LITERAL? JRST [AOS LOCA ;NO, INCREMENT ASSEMBLY LOCATION SETOM BNSN ;AND FLAG CODE STORED JRST .+1] ;[555] CAIGE AC1,.STP-1 ;OVERFLOW? RET ;NO, EXIT SKIPN LITLVL ;[726] ARE WE IN A LITERAL? JRST CHARL1 ;NO, SAVE REGISTERS AND DUMP THE BUFFER PUSH P,['MCRLTL'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / LITERAL TOO LONG@/] ;[1066][726] YES, ERROR CALL ERRNE4 ;[726] DON'T DUMP THE BUFFER JRST STOWI ;INITIALIZE BUFFER ;GET ONE WORD FROM CODE BUFFER DSTOW: AOS AC1,STPY ;INCREMENT POINTER MOVE AC0,STCODE(AC1) ;FETCH CODE MOVE RC,STOWRC(AC1) ;FETCH RELOCATION BITS IFN FORMSW,< PUSH P,STFORM(AC1) POP P,FORM ;GET FORM WORD > CAMGE AC1,STPX ;IS THIS THE END? RET ;NO, EXIT STOWI: SETOM STPX ;INITIALIZE FOR INPUT SETOM STPY ;INITIALIZE FOR OUTPUT SETZM EXTPNT RET ;EXIT ;EXTERNAL RIGHT STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER CAIE AC1,(RC) ;DOES IT MATCH CALL QEXT ;EXTERNAL OR RELOCATION ERROR HLLZS EXTPNT RET ;EXIT ;EXTERNAL LEFT STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF CAIE AC1,(RC) ;SEE ABOVE CALL QEXT HRRZS EXTPNT RET ;EXIT IFN TSTCD,< STOWTC: SKIPE RC ;RELOCATABLE OR EXTERNAL? CALL QEXT ;YES, FLAG ERROR JUMP1 CPOPJ ;IF PASS 1, RETURN MOVE C,AC0 ;GET VALUE JRST OUTBIN ;DEPOSIT INTO REL FILE AND RETURN > ONC: ILDB C,TABP ;ENTRY TO ADVANCE TAB POINTER IFN FTPSECT,< ;[647] SKIPE SGNMAX ;[647] DOING PSECTS? JRST [ MOVEI C," " ;[647] YES, 2 SPACES INSTEAD OF A TAB CALL OUTC ;[647] CALL OUTC ;[647] JRST ONC1] ;[647] > CALL OUTL ;OUTPUT A TAB ;OUTPUT 6 OCT NUMBERS FROM CS LEFT ONC1: MOVEI C,6 ;CONVERT TO ASCII LSHC C,3 ;SHIFT IN OCTAL CALL OUTL ;OUTPUT ASCII FROM C TRNE CS,-1 ;ARE WE THROUGH? JRST ONC1 ;NO, GET ANOTHER MOVEI C,0 ;CLEAR C TLNN CS,1 ;RELOCATABLE? MOVEI C,"'" ;YES TLNN CS,EXTF ;OR EXTERNAL MOVEI C,"*" ;YES IFN POLISH,< TLNN CS,4 ;[614] POLISH? MOVEI C,"#" ;[614] YES > ONC2: JUMPN C,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE IFN FORMSW,< SOS FLDSIZ> ;DECREMENT FIELD SIZE RET ;EXIT DNC: IDIVI C,^D10 HRLM CS,0(P) JUMPE C,.+2 CALL DNC ;RECURSE IF NON-ZERO HLRZ C,0(P) ADDI C,"0" ;FORM ASCII JRST PRINT ;DUMP AND TEST FOR END ;OCTAL OUTPUT FROM C OUTOCT: IDIVI C,^D8 HRLM CS,0(P) SKIPE C CALL OUTOCT ;RECURSE UNTIL QUOTIENT 0 HLRZ C,0(P) ADDI C,"0" ;CONVERT TO ASCII JRST PRINT OUTAS0: HRLI CS,(POINT 7,,) ;ENTRY TO SET POINTER OUTASC: ILDB C,CS ;GET NEXT BYTE JUMPE C,CPOPJ ;[664] EXIT ON ZERO DELIMITER CALL PRINT JRST OUTASC OUTSIX: HRLI CS,(POINT 6,,) ;OUTPUT SIXBIT ILDB C,CS ;GET SIXBIT CAIN C,40 ;"@" DELIMITER? RET ;YES, EXIT ADDI C,40 ;NO, FORM ASCII CALL OUTL ;OUTPUT ASCII CHAR FROM C JRST OUTSIX+1 OUTSYM: MOVE CS,AC0 ;PLACE NAME IN CS OUTSY1: MOVEI C,0 ;CLEAR C LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN JUMPE C,CPOPJ ;TEST FOR END ADDI C,40 ;CONVERT TO ASCII CALL OUTL ;OUTPUT JRST OUTSY1 ;LOOP OUTSET: AOS SX,0(P) ;GET RETURN LOCATION MOVE SX,-1(SX) ;GET XWD CODE HLRM SX,BLKTYP ;SET BLOCK TYPE SETZB ARG,RC CALL 0(SX) ;GO TO PRESCRIBED ROUTINE JRST COUTD ;TERMINATE BLOCK AND EXIT ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE LOOKUP: POP P,LOOKX ;INTERCEPT RETURN POP MOVE SX,SYMBOL PUSH P,0(SX) ;SET FOR TABLE SCAN LOOKL: SOSGE 0(P) ;TEST FOR END JRST [POP P,AC0 ;DONE, EXIT RET] ;[575] ADDI SX,2 MOVE AC0,-1(SX) CALL SRCH7 ;LOAD REGISTERS HLRZS ARG CALL @LOOKX ;RETURN TO CALLING ROUTINE JRST LOOKL ;TRY AGAIN IFE FTPSECT, ;[575] IFN FTPSECT,< ;[575] SGLKUP: POP P,LOOKX ;INTERCEPT RETURN POP MOVE SX,SGNCUR ;GET CUR PSECT INX PUSH P,SGSCNT(SX) ;SAVE SYM CNT HRRZS 0(P) ;DON'T WANT LEFT HALF MOVE SX,SGSBOT ;GET INIT SYM TAB PTR JRST LOOKL ;REST IS SAME AS FOR FULL CASE > SUBTTL END ROUTINES END0: IFN FTPSECT,< ;[575] SKIPE SGLITL ;[1074] ANY LITERALS UNTERMINATED IN ANY PSECT? RET ;[1074] YES - ILLEGAL IN ANY LITERAL HRROS SGNCUR ;FORCE EVALUATION IN ITS OWN PSECT > CALL EVALCM ;GET A WORD IFN FTPSECT,< ;[575] HRRZS SGNCUR ;BACK TO NORMAL > SKIPN V,AC0 ;NON-ZERO? JUMPE RC,.+2 ;OR RELOC? CALL ASSIG7 ;YES, LIST THE VALUE SETZM VECSYM ;IN CASE NOT SYMBOLIC SKIPN EXTPNT ;EXTERNAL? JRST END00 ;NO CAME RC,EXTPNT ;MAKE SURE SAME JRST [SETZB AC0,VECSYM ;NO, CLEAR TRO ER,ERRE ;FLAG ERROR JRST .+3] MOVE RC,1(RC) ;GET SIXBIT NAME MOVEM RC,VECSYM ;STORE SYMBOL NAME SETZB RC,EXTPNT ;AND CLEAR RELOC END00: MOVEM AC0,VECTOR MOVEM RC,VECREL IFN FTPSECT,< ;[575] MOVE AC1,SGWFND ;GET START ADR PSECT INX MOVEM AC1,VECFND ;SAVE IT > SKIPN LITNUM ;LITERALS TO FOLLOW? CALL VARP ;NO, DO EARLY CHECK FOR VAR AREA SETOM ENDSN ;FLAG BEEN HERE AND CALL STOUTS ;DUMP THE LINE END01: TLZ IO,IOPROG ;[754] SHOULDN'T BE XLISTED AND SETZ MRP, ;SHOULDN'T BE IN A MACRO BY NOW MOVE MP,SAVERP ;[1120] GET SAVED MACRO CALL PTR. MOVEM MP,RP ;[1120] RESET RP MOVE MP,SAVEMP ;[1120] RESET REPEAT PTR. ALSO IFN FTPSECT,< ;[575] MOVE AC1,SGNMAX ;GET HIGHEST PSECT USED PUSH P,AC1 ;SAVE IT CAME AC1,SGNCUR ;[715] IF NOT CURRENT END02: CALL %SWSEG ;[715] SWAP IT > SKIPE ENDSN ;HAVE WE CHECKED VAR AREA SKIPE LITNUM ;PHASE ERRORS? CALL VARP ;NO, DO SO CALL VARA ;FILL OUT SELF-DEFINED VARIABLES SETZM ENDSN ;RESET ENDSN IFE IIISW, ;XLIST LITS CALL LIT1 ;RETURN VALUE IN AC2 IFE IIISW, ;GET FLAG BACK IFN FTPSECT,< ;[575] SOSL AC1,0(P) ;DONE YET? JRST END02 ;NO POP P,AC1 ;GET JUNK OFF STACK > JUMP2 ENDP2 MOVE HHIGH ;GET HIGH SEG BREAK MOVEM HIGH1 ;SAVE FOR TWOSEG/HISEG BLOCK TYPE 3 CALL UOUT ;[1042] TLNN IO,MFLSW ;SKIP IF ONLY PSEND CALL REC2 MOVE INDIR ;SET UP FIRST AS LAST MOVEM LSTFIL ;PRINTED SETZM LSTPGN CALL INZ1 SKIPN TTLFND ;[1123] HAVE WE SEEN A TITLE YET? CALL PRNAM ;[1123] NO - PRINT DEFAULT TITLE SETZM TTLFND ;[1123] CLEAR TITLE SPECIFIED FLAG TLNE IO,MFLSW ;IF PSEND RET ;BACK TO PSEND0 SKIPE PRGPTR ;HAVE ANY PRGEND'S BEEN SEEN CALL PSEND3 ;YES,GO SET UP AGAIN PASS20: SETZM CTLSAV CALL COUTI CALL EOUT ;OUTPUT THE ENTRIES CALL OUTSET XWD 6,NOUT ;OUTPUT THE NAME (BLKTYP-6) SKIPN HISNSW ;PUT OUT BLOCK TYPE 3? JRST PASS21 ;NO CALL OUTSET XWD 3,HSOUT ;OUTPUT THE HISEG BLOCK PASS21: IFN FTPSECT,< SETZM SGNCUR ;[1020] SKIPN SGNMAX ;[1020] DOING PSECTS JRST PASS22 ;[1020] NO, JUMP PASS23: SETOM BLK24 ;[1020] GENERATE A SET OF BLOCK 24'S AOS SX,SGNCUR ;[1020] SKIP BLANK PSECT CALL SGOUTN ;[1020] CAMGE SX,SGNMAX ;[1020] FINISHED? JRST PASS23 ;[1020] NO, LOOP SETZM SGNCUR ;[1020] RESET PSECT TO 0 PASS22: > MOVEI 1 HRRM BLKTYP ;SET FOR TYPE 1 BLOCK TLZ FR,P1 ;SET FOR PASS 2 AND TURN OFF FLAG TLO IO,IOPALL ;PUT THESE BACK TLZ IO,IOPROG!IOCREF!DEFCRS!IONCRF ; SO LISTINGS WILL BE THE WAY THEY SHOULD TLNN FR,R1BSW JRST STOWI MOVE CS,[XWD $ST-1-$CKSM,R1BLDR] MOVE C,0(CS) CALL PTPBIN AOBJN CS,.-2 CALL R1BI JRST STOWI ENDP2: CALL COUTD ;DUMP THE BUFFER MOVE AC0,LOCO ;CHECK TO SEE IF LIT DIFFERED SKIPN MODO ;AND USE SMALLER SINCE AT END JRST [CAMN AC0,ABSHI HRRZM AC2,ABSHI JRST ENDP2W] SKIPE HHIGH ;SKIP IF NOT TWO SEGMENTS JRST [CAMN AC0,HHIGH HRRZM AC2,HHIGH JRST ENDP2W] ENDP2W: IFE FTPSECT,< ;[575] CAMN AC0,HIGH HRRZM AC2,HIGH > IFN FTPSECT,< ;[575] MOVE AC1,SGNCUR CAMN AC0,HIGH HRRM AC2,SGATTR(AC1) > REPEAT 1, ;CLOSE CREF IF NECESSARY REPEAT 0, ;NEEDS FIX TO CREF CALL CLSCR2 ;CLOSE IT UP ENDP2Q: HRR ER,OUTSW ;[1042] SET OUTPUT SWITCH SKIPN TYPERR ;[1042] TRO ER,TTYSW ;[1042] CALL UOUT ;[1042] OUTPUT UNDEFINEDS TRO ER,TTYSW MOVE C,CTOBUF+2 ;SKIP OUTPUT IF BUFFER EMPTY CAIE C,120 ;[565] OUTPUT CTL, ;CLEAR JUNK OUT OF BUFFER SKPINC C ;SEE IF WE CAN INPUT A CHAR. JFCL ;BUT ONLY TO DEFEAT ^O SKIPG C,QERRS ;ANY Q ERRORS SEEN? JRST ENDPER ;NO, TRY REAL ERRORS CALL OUTCR ;NEW LINE MOVEI C,"%" ;WARNING CHARACTER CALL OUTL MOVE C,QERRS ;GET COUNT CAIN C,1 ;1 IS SPECIAL JRST ONERQ CALL DNC ;OUTPUT IT SKIPA CS,[EXP ERRMQ2] ONERQ: MOVEI CS,ERRMQ1 CALL OUTSIX ENDPER: MOVE C,ERRCNT ;GET ERROR COUNT CAMGE C,UNDCNT ;.GE. UNDEFINED SYMBOL COUNT? MOVE C,UNDCNT ;USE UND SYMBOL COUNT INSTEAD JUMPE C,NOERW ;ZERO COUNT, PRINT NO ERR MSG IFN CCLSW, ;REMEMBER ERROR COUNT FOR EXECUTION DELETION PUSH P,C ;STORE ERROR COUNT FOR A WHILE CALL OUTCR MOVEI C,"?" ;? FOR BATCH CALL OUTL ;... POP P,C ;RESTORE ERROR COUNT FROM STACK CAIN C,1 ;1 IS A SPECIAL CASE JRST ONERW ;PRINT MESSAGE CALL DNC SKIPA CS,[EXP ERRMS1] ;LOAD TO PRINT ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DETECTED ONERW1: CALL OUTSIX ;PRINT JRST ENDP2A NOERW: SKIPE QERRS ;IF "Q" ERRORS CALL OUTCR ;CLOSE LINE NOW MOVEI CS,ERRMS3 IFN CCLSW,< ;[1141] TLNE IO,CRPGSW ;[1141] IF RPG TRZ ER,TTYSW ;[1141] NO TTY OUTPUT > ;[1141] IOR ER,OUTSW ;UNLESS NEEDED FOR LISTING SKIPN QERRS ;ALREADY DONE CALL OUTCR JRST ONERW1 ENDP2A: CALL OUTCR IFN CCLSW,< ;[1141] TLNE IO,CRPGSW ;[1141] ONLY IF RPG JRST [ MOVE C,QERRS ;[1141] TOTAL UP ADD C,ERRCNT ;[1141] ANY ERRORS THAT ADD C,UNDCNT ;[1141] WERE FOUND JUMPE C,ENDP2D ;[1141] IF NONE - SUPPRESS PROGRAM NAME JRST .+1] ;[1141] ELSE OK TO TYPE IT > ;[1141] SKIPE PGENDF ;[1141] HAVE WE SEEN ANY PRGENDS? JRST [ MOVE C,OUTSW ;[1141] YES - GET OUTPUT SWITCHS CAIN C,TTYSW ;[1141] LISTING GOING TO TTY? JRST .+1 ;[1141] YES - NO NEED TO PRINT PROGRAM NAME PUSH P,OUTSW ;[1141] SAVE OUTPUT SWITCHS PUSH P,ER ;[1141] AND CURRENT OUTPUT SETTING HRRI ER,TTYSW ;[1141] OUTPUT TO TTY ONLY HRRM ER,OUTSW ;[1141] IN ALL CASES MOVEI CS,[ASCIZ /PROGRAM /] ;[1141] CALL OUTAS0 ;[1141] TYPE PREFIX MOVEI CS,TBUF ;[1141] TITLE BUFFER CALL OUTAS0 ;[1141] TYPE IT CALL OUTCR ;[1141] END LINE POP P,ER ;[1141] RESTORE ERROR AND OUTPUT SETTINGS POP P,OUTSW ;[1141] RESTORE OUTPUT SWITCHS JRST .+1] ;[1141] ENDP2D: IFN CCLSW, ;... IFE CCLSW,< SKIPA> ;SO PRGEND CODE CAN WORK IOR ER,OUTSW ;... CALL OUTCR MOVEI CS,[SIXBIT /HI-SEG. BREAK IS @/] SKIPN HHIGH ;DON'T PRINT IF ZERO JRST ENDP2C ;IT WAS CALL OUTSIX HRLO CS,HHIGH ;GET THE BREAK CALL ONC1 CALL OUTCR ENDP2C: MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/] CALL OUTSIX ;OUTPUT PROGRAM BREAK HRLO CS,SGATTR ;GET PROGRAM BREAK CALL ONC1 CALL OUTCR IFN FTPSEC,< SKIPN AC1,SGNMAX ;GET PSECT CNT JRST ENDP2E ;PSECTS NOT USED? MOVEI AC2,1 ENDP2F: MOVEI CS,[SIXBIT /PSECT @/] ;[647] CALL OUTSIX ;OUTPUT PSECT BREAK MOVE C,AC2 ;[647] GET PSECT INDEX CALL OUTOCT ;[647] OUTPUT IT MOVEI CS,[SIXBIT / BREAK IS @/] ;[647] CALL OUTSIX ;[647] HRLO CS,SGATTR(AC2) ;GET PSECT BRK CALL ONC1 MOVE CS,[SIXBIT / FOR /] MOVEM CS,SGLIST MOVE CS,SGNAME(AC2) ;GET PSECT NAME MOVEM CS,SGLIST+1 MOVSI CS,SIXBIT/ @ / MOVEM CS,SGLIST+2 MOVEI CS,SGLIST CALL OUTSIX CALL OUTCR AOS AC2 SOJG AC1,ENDP2F ;LOOP THRU PSECT.S ENDP2E:> HRRZ CS,ABSHI ;GET ABS. BREAK CAIG CS,140 ;ANY ABS. CODE JRST ENDP2B ;NO, SO DON'T PRINT MOVEI CS,[SIXBIT /ABSOLUTE BREAK IS @/] CALL OUTSIX HRLO CS,ABSHI CALL ONC1 CALL OUTCR ENDP2B: MOVEI CS,[SIXBIT /CPU TIME USED @/] CALL OUTSIX ;PRINT THE TIME IT TOOK TO ASSEMBLE SETZ C, ;SO AS TO GET THE RIGHT TIME RUNTIM C, ;GET THE TIME NOW SUB C,RTIME ;MINUS TIME WHEN STARTED IDIVI C,^D1000 ;GET MS. PUSH P,C+1 ;SAVE IDIVI C,^D60 ;GET SEC. IN C+1, MIN. IN C PUSH P,C+1 ;SAVE SECONDS IDIVI C,^D60 ;GET HOURS IN C, MINS. IN C+1 PUSH P,C+1 ;SAVE MINS JUMPE C,NOHOUR ;SKIP IF LESS THAN 1 HOUR CALL DNC ;PRINT HOURS MOVEI C,":" ;SEPARATOR CALL OUTC NOHOUR: POP P,CS ;GET MINS CALL DECPT2 ;PRINT THEM MOVEI C,":" CALL OUTC POP P,CS ;A LITTLE DIFFERENT FOR MS CALL DECPT2 ;PRINT SECONDS MOVEI C,"." ;A POINT FOR MS. CALL OUTC POP P,CS ;GET MS. CALL DECPT3 ;PRINT MS. CALL OUTCR ;AND A CRLF TLNE FR,RIMSW!R1BSW ;RIM MODE? CALL RIMFIN ;YES, FINISH IT IFN CCLSW, ;[1141] IF NOT IN CCL MODE TRO ER,TTYSW ;PRINT SIZE CALL OUTCR MOVE C,CPUV ;[775] GET CPU VALUE CAIGE C,3 ;[775] KI-10 = 3 JRST [ MOVE C,.JBREL ;[775] LSH C,-^D10 ;[775] ADDI C,1 ;[775] CALL DNC ;[775] MOVEI CS,[SIXBIT /K CORE USED@/] ;[775] JRST CORSIZ] ;[775] MOVE C,.JBREL LSH C,-^D9 ;[615] ADDI C,1 CALL DNC MOVEI CS,[SIXBIT /P CORE USED@/] ;[615] CORSIZ: CALL OUTSIX ;[775] CALL OUTCR HRR ER,OUTSW IFN FTPSECT,< ;[575] SETZM SGNCUR ;SET TO BLANK PSECT SKIPN SGNMAX ;WERE PSECTS USED? JRST ENDP2H ;NO ENDP23: CALL SGOUTL ;[631] OUTPUT A SET OF BLOCK 23'S FIRST AOS SX,SGNCUR ;[631] NEXT ONE CAMG SX,SGNMAX ;[631] ALL DONE? JRST ENDP23 ;[631] NO, LOOP SETZM SGNCUR ;[631] YES, RESET TO BLANK PSECT ENDP2G: CALL SRCHI ;SET UP SRCHX,SGSBOT,SGSTOP CALL SGOUTN ;[762] BLOCK-24 BEFORE ITS SYMBOLS ENDP2H: > CALL OUTSET ;[735] BLOCK-10 FOR EACH PSECT XWD 10,LSOUT ;[735] OUTPUT THE LOCALS (..-10) CALL OUTSET XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2) IFN FTPSECT,< ;[575] AOS SX,SGNCUR ;INCR PSECT INX CAMG SX,SGNMAX ;LAST PSECT DONE? JRST ENDP2G ;NO, DO NEXT PSECT SETZM SGNCUR ;SET TO BLANK PSECT > ;[575] IFN POLISH,< ;[575] CALL OUTSET XWD 11,POUT ;OUTPUT THE POLISH (..-11) MOVSI SX,(POINT 2) ;RESET BYTE COUNT HLLM SX,COUTP ;AFTER END OF POLISH > CALL OUTSET XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7) CALL OUTSET XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5) CALL COUTD TLNN IO,MFLSW ;IS IT PRGEND? JRST FINIS ;ALAS, FINISHED MOVEI CS,SBUF ;RESET SBUF POINTER HRRM CS,SUBTTX ;TO SUBTTL SETZM PASS2I ;CLEAR PASS2 VARIABLES MOVE [XWD PASS2I,PASS2I+1] PUSH P,PAGENO ;SAVE PAGE NUMBER IN CASE PRGEND BLT PASS2Z-1 ;BUT NOT ALL OF VARIABLES POP P,PAGENO ;RESTORE IT MOVE CS,SPAGN. ;RESTORE PAGE OFFSET MOVEM CS,PAGEN. ;[562] ; JRST INZ ;RE-INITIALIZE FOR NEXT PROG ;FALL THROUGH SUBTTL PASS INITIALIZE INZ: SETZ C, ;GET CURRENT JOB NUMBER RUNTIM C, ;GET RUNTIME FOR LATER MOVEM C,RTIME ;SAVE INZ1: MOVEI AC1,1 ;[1130] RELOCATABLE MODE IS 1 MOVEM AC1,MODA ;[1130] RESET ADDRESS MODE MOVEM AC1,MODO ;[1130] AND OUTPUT MODE IFN FTPSECT,< ;[575] TLNE IO,MFLSW ;[1151] IF RESETTING FOR PRGEND JUMP2 INZ3 ;[1151] DURING PASS2 - SKIP PSECT INIT MOVE AC1,SGNMAX MOVSI AC0,1 MOVEM AC0,SGRELC(AC1) SOJGE AC1,.-1 MOVE AC1,SGNMAX ;GET HIGHEST PSECT USED PUSH P,AC1 ;SAVE IT INZ2: CAME AC1,SGNCUR ;IF NOT CURRENT CALL %SWSEG ;SWAP IT > MOVEI VARHD MOVEM VARHDX MOVEI LITHD MOVEM LITHDX CALL LITI IFN FTPSECT,< ;[575] SOSL AC1,0(P) ;DONE YET? JRST INZ2 ;NO POP P,AC1 ;GET JUNK OFF STACK INZ3: ;[1151] > MOVEI AC1,RELLOC ;[716] RESET POINTER MOVEM AC1,REL1P+1 ;[716] SETZM SEQNO PUSH P,[^D8] ;[613] INIT TO DEFAULT RADIX POP P,CURADX ;[613] CALL STOWI IFN FORMSW,< SETZM IOSEEN ;[717] CLEAR IO FORMAT SWITCH HRRES HWFMT> ;SET DEFAULT VALUE BACK CALL OUTLI ;[774] INIT NEW LINE SETZM LBLFLG ;[1074] CLEAR LABEL-IN-LITERAL FLAG SETZM TAGINC ;[774] REINIT TAG OFFSET RET ;[774] ; ROUTINE TO PRINT CPU TIME USED DECPT3: MOVEI C,"0" ;FILL WITH ZERO CAIG CS,^D99 ;3 DIGITS? CALL OUTC ;NO DECPT2: MOVEI C,"0" ;FILL WITH ZERO CAIG CS,^D9 ;2 DIGITS? CALL OUTC ;NO MOVE C,CS ;GET VALUE PJRST DNC ;OUTPUT IN DECIMAL AND RETURN RIMFIN: TLNE FR,R1BSW CALL R1BDMP SKIPN C,VECTOR MOVSI C,(JRST 4,) TLNN C,777000 TLO C,(JRST) CALL PTPBIN MOVEI C,0 JRST PTPBIN SUBTTL PSEUDO-OP HANDLERS TAPE0: CALL STOUTS ;FINISH THIS LINE SETZM EOFFLG ;CLEAR END OF FILE FLAG CALL PEEK ;LOOK AT NEXT CHARACTER CAIE C,VT ;PRINT IF V TAB CAIN C,FF ;OR FORM FEED CALL STOUTS SKIPE EOFFLG ;EOF SEEN DURING PEEKING? RET ;YES TLZ IO,IORPTC ;NO, CLEAR CHARACTER FROM LOOK-AHEAD CALL OUTLI2 ;AND FROM LINE BUFFER JRST GOTEND ;IGNORE THE REST OF THIS FILE %NOBIN: TLZE FR,PNCHSW ;IS REL FILE OPEN? CLOSE BIN,40 ;YES, GET RID OF IT RET RADIX0: CALL EVAL10 ;EVALUATE RADIX D10 CAIG AC0,^D10 ;IF GREATER THAN 10 CAIG AC0,1 ;OR LESS THAN 2, ERRAX: TROA ER,ERRA ;FLAG ERROR AND SKIP HRRZM AC0,CURADX ;[613] SET NEW RADIX RET XALL0: JUMP1 CPOPJ ;[664] IGNORE ON PASS 1 TLZN IO,IOSALL ;TURN OFF MACRO SUPPRESS ALL JRST IOSET ;NOT SALL ON SO NOTHING TO WORRY ABOUT CAIE C,EOL ;END OF LINE SEEN? JRST IOSET ;[1150] NO LDB C,LBUFP ;GET LAST CHARACTER CAIN C,CR ;UNDER SPECIAL CIRCUMSTANCES IT GETS REMOVED JRST IOSET ;[1150] NO, ALL IS WELL SOSG CPL ;ANY ROOM? CALL RSW5 ;NO, SEE IF ANY EXCESS IN IT MOVEI C,CR ;NOW FOR TERMINATOR IDPB C,LBUFP ;WILL GET REMOVED LATER IOSET: JUMP1 .+2 ;[1065] EXIT IN PASS1 HLLZM AC0,IOFLGS ;[1065] SAVE FLAGS FOR OUTLI5 RET ;[1065] OUTPUT LINE BEFORE SETTING FLAGS IOLSET: JUMP1 CPOPJ ;[664] SPECIAL FOR LALL, TO SEE IF IN MACRO UNDER SALL TLNE IO,IOSALL ;SEE IF SALL JUMPN MRP,IOLSE1 ;AND IN MACRO IORSET: TDZ IO,AC0 ;NO, SET FLAG RET ;AND RETURN IOLSE1: SKIPE CRLFSN ;[1065] HAVE WE SEEN A CRLF? TLZA IO,IOPALL!IOSALL ;[1065] YES, SET FLAGS AND EXIT SETOM IOFLGS ;[1065] WAIT TO SET LALL TILL RET ;[1065] LINE IS OUTPUT BLOCK0: CALL HIGHQ IFN POLISH,< TRO FRR,NOPSW> ;[616] DON'T ALLOW POLISH CALL EVALEX ;EVALUATE IFN POLISH,< TRZ FRR,NOPSW> ;[616] UNDO NO POLISH SWITCH TLNE AC0,-1 ;SEE IF VALID ARG TYPE JRST ERRAX ;NO, GIVE ERROR TRZE RC,-1 ;EXTERNAL OR RELOCATABLE? CALL QEXT ;YES, DETERMINE TYPE ADDM AC0,LOCO ;UPDATE ASSEMBLY LOCATION BLOCK1: EXCH AC0,LOCA ;SAVE START OF BLOCK ADDM AC0,LOCA ;UPDATE OUTPUT LOCATION BLOCK2: HRLOM AC0,LOCBLK JUMP2 CPOPJ ;[664] TRNE ER,ERRU TRO ER,ERRV RET PRNTX0: CALL BYPASS ;[664] GET FIRST CHAR. TLOA IO,IORPTC ;REPEAT IT AND SKIP PRNTX4: CALL PRINT ;PRINT THE CHAR. TRZ ER,TTYSW!LPTSW ;[723] IN CASE OF LONG LINE CALL CHARAC ;GET ASCII CHAR. TRO ER,TTYSW ;[723] SET OUTPUT TO TTY JUMP2 .+2 ;[723] BUT NOT ON PASS2 IF LSTDEV=TTY TDOA ER,OUTSW ;[723] SET OUTPUT TO LSTDEV ANDCM ER,OUTSW ;[723] CAIG C,CR ;IF GREATER THAN CR CAIG C,HT ;OR LESS THAN LF JRST PRNTX4 ;THEN CONTINUE CALL OUTCR ;OUTPUT A CRLF TRZ ER,TTYSW!LPTSW ;[664] TURN OFF OUTPUT RET ;[664] EXIT REMAR0: CALL GETCHR ;GET A CHARACTER REMAR1: CAIE C,EOL JRST REMAR0 RET ;EXIT PAGE0: CALL STOUTS ;PAGE PSEUDO-OP PAGE1: TLNE IO,IOCREF ;CURRENTLY DOING CREF? TLNE IO,IOPROG ;AND NOT XLISTED? JRST PAGE2 ;NO HRR ER,OUTSW CALL CLSCRF CALL OUTCR HRRI ER,0 PAGE2: TLO IO,IOPAGE RET LIT0: CALL BLOCK1 CALL STOUTS LIT1: JUMP2 LIT20 IFN FTPSECT,< ;[707] SKIPN SGNMAX ;[707] DOING PSECTS? JRST LIT2 ;[707] NO, JUMP MOVE V,HIGH ;[707] CHECK PC WITH HIGHEST ADDR CAMG V,LOCA ;[707] HIGH IS LARGER? JRST LIT2 ;[707] NO, JUMP MOVEM V,LOCA ;[707] YES, UPDATE PC MOVEM V,LOCO ;[707] LIT2: ;[707] > ;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR MOVE AC0,LITCNT MOVE SX,LITHDX HRLM AC0,0(SX) MOVE V,LOCA HRL V,MODA MOVEM V,-1(SX) JRST LIT24 LIT20: PUSH P,LOCA PUSH P,LOCO SKIPN LITNUM JRST LIT20A MOVE SX,LITHDX HRRZ AC0,-1(SX) CAME AC0,LOCA TRO ER,ERRP LIT20A: MOVE SX,LITAB LIT21: SOSGE LITNUM JRST LIT22 IFN FORMSW,< MOVE AC0,-3(SX) MOVEM AC0,FORM > MOVE AC0,-2(SX) ;WFW MOVE RC,-1(SX) ;WFW IFN POLISH,< CAMN RC,[1B0] ;SPECIAL FAKE RELOC? SETZ RC, ;YES > MOVE SX,(SX) ;WFW POINTER TO THE NEXT LIT CALL STOW20 ;STOW CODE TLNE IO,IOSALL ;[1062] IF IN SALL MACRO, FORGET JUMPN MRP,.+3 ;[1062] LINE-FEED (SEE OUTL25+2) MOVEI C,12 ;SET LINE FEED IDPB C,LBUFP CALL OUTLIN ;OUTPUT THE LINE JRST LIT21 LIT22: HRRZ AC2,LOCO POP P,LOCO POP P,LOCA MOVE SX,LITHDX HLRZ AC0,0(SX) SUB AC2,LOCO ;COMPUTE LENGTH USED CAMGE AC0,AC2 ;USE LARGER MOVE AC0,AC2 ADD AC2,LOCO LIT24: ADDM AC0,LOCA ADDM AC0,LOCO CALL GETTOP HRRM SX,LITHDX LITI: SETZM LITCNT SETZM LITNUM MOVEI LITAB MOVEM LITABX JRST HIGHQ GETTOP: HRRZ AC1,SX ;VARHD HRRZ SX,0(SX) JUMPN SX,CPOPJ ;[664] IFE FORMSW,< MOVEI SX,3> ;WFW IFN FORMSW,< MOVEI SX,4> ;ICC ADDB SX,FREE CAML SX,SYMBOL CALL XCEED SUBI SX,1 ;MAKE SX POINT TO LINK SETZM 0(SX) ;CLEAR FORWARD LINK HRRM SX,0(AC1) ;STORE ADDRESS IN LAST LINK RET VAR0: CALL BLOCK1 ;PRINT LOCATION CALL VARP ;CHECK VAR AREA FOR PHASE ERROR CALL VARA JRST STOUTS VARP: JUMP1 CPOPJ ;[664] DO NOT CHECK START ON PASS1 SKIPN VARCNT ;ANY VARIABLE? RET ;NO, RETURN MOVE SX,VARHDX MOVE AC0,LOCA ;GET LOCATION FOR CHECK CAMN AC0,-1(SX) ;SAME START FOR BOTH PASSES? RET ;YES, CAML AC0,-1(SX) ;NO,BIGGER IN PASS2 JRST [ TRO ER,ERRP ;GIVE P ERROR RET] HLRZ AC0,0(SX) ;SMALLER ON PASS2 JUMPE AC0,CPOPJ ;[664] RETURN IF NO VAR MOVE AC0,-1(SX) ;OTHERWISE, ADJUST LOCA & LOCO MOVEM AC0,LOCA ;TO PASS1 VALUES MOVEM AC0,LOCO RET ;AND RETURN VARA: MOVE SX,VARHDX MOVE AC0,LOCA ;GET LOCATION FOR CHECK MOVEM AC0,-1(SX) ;SAVE START FOR PASS 2 HLRZ AC0,0(SX) ADDM AC0,LOCA ADDM AC0,LOCO CALL GETTOP HRRM SX,VARHDX JUMP2 CPOPJ ;[664] SETZM VARCNT ;CLEAR VARIABLE COUNTER IFN FTPSECT,< ;[715] SKIPE SGNMAX ;[715] DOING PSECTS? JRST [ CALL SGLKUP ;[715] YES, LOOKUP ONLY CURRENT TABLE TRNN ARG,VARF ;[715] GOT A VARIABLE? RET ;[715] NO, EXIT JRST VARA2] ;[715] MAYBE, CHECK MORE > ;[715] CALL LOOKUP ;SET FOR TABLE SCAN TRNN ARG,VARF ;GOT A VARIABLE? RET ;NO, E EXIT VARA2: TRC ARG,LTAGF ;[742] MAKE SURE NOT USED WITH LTAGF TRCN ARG,LTAGF ;[742] RET ;[742] TRC ARG,SIXF ;MAKE SURE VARF IS NOT PART OF SIXF TRCN ARG,SIXF RET ;IT'S SIXF, SO IGNORE THIS ONE AOS VARCNT ;INCREMENT VARIABLE COUNTER TRZ ARG,UNDF+VARF ;TURN OFF FLAGS NOW MOVSI AC0,1(V) ;NUMBER TO ADD TO ADDM AC0,0(AC1) ;UPDATE COUNT VARA1: ADDI V,1 ;GET LENGTH OF DESIRED BLOCK ADDM V,LOCO EXCH V,LOCA ADDM V,LOCA HRL ARG,V ;GET STARTING LOCATION AND UPDAT PCS IOR ARG,MODA ;SET TO ASSEMBLY MODE MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY JRST HIGHQ1 IF: PUSH P,AC0 ;SAVE AC0 PUSH P,IO IFN POLISH,< TRO FRR,NOPSW> ;[613] DON'T WANT POLISH HERE CALL EVALXQ ;EVALUATE AND TEST EXTERNAL POP P,AC1 JUMP2 .+2 ;[743] TRZ ER,ERRV ;[743] SUPRESS V-ERROR IF PASS1 IORI ER,(AC1) ;RESTORE PREVIOUS ERROR FLAGS JUMPL AC1,IFPOP TLZ IO,FLDSW IFPOP: POP P,AC1 ;RETRIEVE SKIP INSTRUCTION IFSET: TLO IO,IORPTC ;REPEAT CHARACTER IFXCT: XCT AC1 ;[660] EXECUTE INSTRUCTION IFXF: TDZA AC0,AC0 ;FALSE IFXT: MOVEI AC0,1 ;TRUE IFEXIT: SETZM EXTPNT ;JUST IN CASE IFN POLISH,< TRZ FRR,NOPSW> ;[613] UNDO NO-POLISH SWITCH IFN FTPSECT,< TLZ IO,RSASSW> ;[575] JUMPAD IFEX1 ;[664] BRANCH IF IN ADDRESS FIELD IFDO: CALL BYPASS ;[664] GET NEXT NON-BLANK CAIN C,EOL ;AT EOL? JRST REPEA1 ;YES, USE OLD METHOD CAIE C,',' ;ARE WE AT THE COMMA? CAIN C,'<' ;OR START OF CONDITIONAL? CAIA ;YES JRST IFDO ;NOT YET AT COMMA OR ANGLE BRKT CAIN C,',' ;IGNORE THE COMMA CALL BYPASS ;[664] AND GET SOMETHING ELSE TLO IO,IORPTC ;REPEAT LAST CHAR. CAIE C,'<' ;OLD METHOD USED ANGLES CAIN C,EOL ;ALSO OLD IF NEW LINE SEEN JRST REPEA1 ;ASSEMBLE CODE BETWEEN ANGLES JUMPLE AC0,REMAR0 ;FALSE, TREAT AS COMMENT JRST STMNT ;TRUE, ASSEMBLE IT IFPASS: HRRI AC0,P1 ;MAKE IT TLNX IO,P1 MOVE AC1,AC0 ;PLACE IT IN AC1 JRST IFSET ;EXECUTE INSTRUCTION IFB0: HLLO AC1,AC0 ;FORM AND STORE TEST INSTRUCTION IFB1: CALL CHARL ;GET FIRST NON-BLANK CAIE C," " CAIN C,HT JRST IFB1 ;SKIP BLANKS AND TABS CAIG C,CR ;CHECK FOR CARRET AS DELIM. CAIGE C,LF CAIA JRST ERRAX FORERR (SX,CND) SETOM INCND ;SAVE INFO. FOR PASS 1 ERRORS CAIN C,"<" ;LEFT BRACKET? SETZB C,RC ;YES, PREPARE FOR OLD FORMAT SKIPA SX,C ;SAVE FOR COMPARISON IFB3: TRO AC0,1 ;SET FLAG IFB2: CALL CHARL ;GET ASCII CHARACTER AND LIST CAMN C,SX ;TEST FOR DELIMITER JRST IFXCT ;FOUND CAIE C," " ;BLANK? CAIN C,HT ;OR TAB? JRST IFB2 ;YES JUMPN SX,IFB3 ;JUMP IF NEW FORMAT CAIN C,"<" ;" ;>? SOJL RC,IFXCT ;YES, DECREMENT AND EXIT IF DONE JRST IFB3 ;GET NEXT CHARACTER IFDEF0: HRRI AC0,UNDF ;MAKE IT TLNX ARG,UNDF PUSH P,AC0 ;STACK IT IFN FTPSECT,< ;[575] HRROS SGNCUR ;DON'T COPY IF FOUND > CALL GETSYM ;TAKES SKIP RETURN IF SYM NAME IS LEGAL TROA ER,ERRA ;ILLEGAL! CALL SEARCH ;ANYTHING IN THE SYMBOL TABLE? JRST [CALL OPTSCH ;NO, HOW ABOUT OP TABLE? TLO ARG,UNDF JRST IFDEF1] ;[764] FINISH CHECKING JUMPG ARG,[CAME AC0,-3(SX) ;[764] IF OPDEF, GO CHECK FOR SYMBOL JRST IFDEF1 ;[764] NO SYMBOL SUBI SX,2 ;[764] SYMBOL ALSO CALL SRCH5 ;[764] SYMBOL PREFERRED, SO POINT TO SYMBOL JRST .+1] ;[764] TLNE ARG,UNDF ;[764] UNDEFINED SYMBOL? CAME AC0,1(SX) ;[764] YES, WAS IT AN OPDEF TOO? JRST IFDEF1 ;[764] NO, FINISH CHECKING ADDI SX,2 ;[764] HERE IF BOTH OPDEF AND UNDEFINED SYMBOL CALL SRCH5 ;[764] IN THIS CASE, OPDEF IS PREFERED TLNE ARG,UNDF ;[764] BUT WAS IT UNDEFINED OPDEF? CALL [ SUBI SX,2 ;[764] UNDEFINED OPDEF & UNDEFINED SYMBOL PJRST SRCH5] ;[764] THEN POINT TO UNDEFINED SYMBOL IFDEF1: ;[664] IFN FTPSECT,< ;[575] HRRZS SGNCUR ;CLEAR FLAG > CALL SSRCH3 ;EMIT TO CREF ANYWAY JRST IFPOP ;POP AND EXECUTE INSTRUCTION IFIDN0: HLRZS AC0 MOVEI V,2*.IFBLK-1 SETZM IFBLK(V) ;CLEAR COMPARISON BLOCK SOJGE V,.-1 SETZM .TEMP ;CLEAR STORED DELIMETER MOVEI RC,IFBLK ;SET FOR FIRST BLOCK CALL IFCL ;GET FIRST STRING MOVEI RC,IFBLKA CALL IFCL ;GET SECOND STRING MOVEI V,.IFBLK-1 MOVE SX,IFBLK(V) ;GET WORD FROM FIRST STRING CAMN SX,IFBLKA(V) ;COMPARE WITH SECOND STRING SOJGE V,.-2 ;EQUAL, TRY NEXT WORD JUMPL V,IFEXIT ;DID WE FINISH STRING XORI AC0,1 ;NO, TOGGLE REQUEST JRST IFEXIT ;DO NOT TURN ON IORPTC WFW IFCL: CALL CHARAC ;GET AND LIST CHARACTER CAIE C," " ;SKIP SPACES CAIG C,CR ;ALSO SKIP CR-LF CAIGE C,HT ;AND TAB JRST .+2 ;NOT ONE OF THEM JRST IFCL ;SO LONG COMPARISONS WILL WORK ;*** A CROCK SO THAT IFIDN ,, WILL WORK *** CAIE C,"," ;IS IT A COMMA? JRST .+3 ;NO SKIPN .TEMP ;YES, WAS PREVIOUS FIELD OLD METHOD? JRST IFCL ;YES, IGNORE COMMA AND SPACES ; *** CAIN C,"<" ;WAS IT LEFT BRACKET? SETO C, ;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET MOVEM C,.TEMP ;STORE TERMINATOR FOR COMPARISON MOVEI SX,5*.IFBLK-1 ;LIMIT SEARCH HRLI RC,(POINT 7,,) ;SET UP BYTE IN RC IFCLR: CALL CHARAC SKIPLE .TEMP ;NEW METHOD? JRST IFCLR1 ;YES, IGNORE ANGLE BRACKET COUNTING CAIN C,"<" ;ANOTHER LEFT ANGLE? SOS .TEMP ;YES, KEEP COUNT CAIN C,">" ;CLOSING ANGLE AOSGE .TEMP ;MATCHING COUNT? IFCLR1: CAMN C,.TEMP ;TEST FOR DELIMITER RET ;EXIT ON RIGHT DELIMITER SOJG SX,.+2 ;ANY ROOM IN COMPARISON BLOCK? TROA ER,ERRA ;NO, FLAG ERROR BUT KEEP ON GOING IDPB C,RC ;DEPOSIT BYTE JRST IFCLR IFEX1: CALL GETCHR ;SEARCH FOR "<" CAIN C,EOL ;ERROR IF END OF LINE JRST ERRAX CAIE C,'<' JRST IFEX1 JUMPE AC0,IFEX2 ;TEST FOR 0 TLO IO,IORPTC ;NO, PROCESS AS CELL CALL CELL IFN FORMSW, ;USE STANDARD FORM SETZM INCND ;NOT ANY MORE JRST STOW ;STOW CODE AND EXIT IFEX2: CALL GETCHR CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE JRST ERRAX CAIN C,34 ;"<"? AOJA AC0,IFEX2 ;YES, INCREMENT COUNT CAIE C,36 ;">"? JRST IFEX2 ;NO, TRY AGAIN SOJGE AC0,IFEX2 ;YES, TEST FOR MATCH CALL BYPASS ;[664] YES, MOVE TO NEXT DELIMITER SETZM INCND ;OUT OF CONDITIONAL NOW AOJA AC0,STOWZ1 ;STOW ZERO INTER0: HLLZM AC0,INTENT ;AC0 CONTAINS INTF/ENTF FLAGS INTER1: CALL GETSYM ;GET A SYMBOL JRST INTER3 ;INVALID, SKIP JUMP1 INTER2 ;[675] IF PASS1 INSERT AS UNDF SYM MOVE AC1,INTENT ;[675] GET INTF/ENTF FLAGS TLNE AC1,ENTF ;[675] CAN'T "ENTRY" OPDEF JRST INTER2 ;[675] CALL SSRCH ;[675] IN SYMBOL TABLE? JRST [CALL MSRCH ;[675] NO, CHECK OPDEF IN CASE NO PASS1 SKIPA ;[675] ELSE FLAG AS UNDF SYM TLNN ARG,OPDF ;[675] MOVSI ARG,SYMF!UNDF ;[675] JRST INTER4] ;[675] TLNN ARG,UNDF ;[675] YES, UNDEFINED? JRST INTER4 ;[675] NO, ALL IS FINE PUSH P,SX ;[675] UHOH, SAVE SX FOR REMOVE CALL MSRCH ;[675] IF OPDEF, PHYSICALLY REMOVE UNDF SYM JRST INTER5 ;[675] TLNN ARG,OPDF ;[675] JRST INTER5 ;[675] EXCH SX,(P) ;[675] GET OLD SX, SAVE NEW FOR CONTINUE PUSH P,AC0 ;[675] SAVE NAME CALL REMOVE ;[675] REMOVE UNDF SYM POP P,AC0 ;[675] INTER5: POP P,SX ;[675] RESTORE OPDEF TABLE PTR INTER4: CALL SUPSYM ;[675] SEE IF "!" SEEN TLNN ARG,UNDF ;ALLOW FORWARD REFERENCE JRST [TLNN ARG,SYNF!EXTF ;[1070][733] GIVE ERROR IF ARG IS EXTERN JRST .+1 ;[733] OR SYN MOVE AC1,INTENT ;[733] TLNN AC1,ENTF ;[733] JRST INTER8 ;[1070][733] ERROR TRO ER,ERRA ;[733] JUMP1 .+1 ;[733] IF ENTRY, SET ENTF IN CASE FIXED UP LATER TDZ ARG,INTENT ;[733] ON PASS2, TURN OFF ENTF IF ILLEGAL JRST INTER6] ;[733] UPDATE SYMTAB TDO ARG,INTENT ;[1014] SET APPROPRIATE FLAGS IFN FTPSECT,< INTER6: SKIPE SGNMAX ;[1014] DOING PSECTS? TLNE ARG,UNDF!VARF ;[1024][1014] UNDEFINED? JRST [ CALL INSERQ ;[1014] NOT DOING PSECT, OR SYMBOL UNDEFINED JRST INTER7] ;[1014] NEXT SYMBOL PUSH P,SGNCUR ;[1014] DEFINED AND DOING PSECTS MOVE AC1,SGWFND ;[1014] MAKE PSECT OF THE LABEL CURRENT PSECT MOVEM AC1,SGNCUR ;[1014] SO, THE SYMBOL WON'T CHANGE PSECT CALL INSERQ ;[1024][1014] JUST FOR INSERT/UPDATE POP P,SGNCUR ;[1014] RECOVER THE REAL CURRENT PSECT > IFE FTPSECT,< INTER6: CALL INSERQ ;[1014] INSERT/UPDATE > INTER7: JUMPCM INTER1 ;[1014] LOOP BACK SETZM EXTPNT ;JUST IN CASE, SO AS NOT TO CONFUSE WORLD IFN FTPSECT,< ;[575] TLZ IO,RSASSW ;... > RET ;NO, EXIT INTER2: CALL SSRCH ;[675] SEE IF IN SYM TAB MOVSI ARG,SYMF!UNDF!INTF ;[675] ELSE FLAG AS UNDF JRST INTER4 ;[675] INTER8: TLNE ARG,EXTF ;[1070] DEFINED AS EXTERNAL? TROA ER,ERRE ;[1070] YES - GIVE E-ERROR INSTEAD INTER3: TRO ER,ERRA ;[1014] FLAG ARG EROR AND SKIP JRST INTER7 ;[1014] GO CHECK FOR NEXT SYMBOL ;.IF/.IFN SYMBOL ATTRIBUTE NUMF==1B18 ;LOCAL FLAG - ATOM IS A NUMBER OPCF==1B19 ;LOCAL FLAG - ATOM IS AN OPCODE NOTF==1B20 ;[621] NOT FOUND IN SYMBOL TABLE %IF: TDZA AC0,AC0 ;.IF = 0 %IFN: MOVEI AC0,1 ;.IFN = 1 PUSH P,AC0 ;STORE WHICH PUSH P,IO ;SAVE CURRENT FLAGS TRZ ER,ERRORS ;RESET ERROR FLAGS SETOM .IFFLG ;[1056] FLAG "EVALUATING .IF(N) ARG" SETZM .IFNUM ;[1056] ZERO APPROPRIATE FLAGS SETZM IFSRCH ;[1056] SETZM .IFANG ;[1056] SETOM .IFNAM ;[1112] ASSUME THIS IS A SIMPLE RADIX50 NAME CALL ATOM ;GET THE ATOM TO BE TESTED SETZM .IFFLG ;[1056] CLEAR ".IF(N)" FLAG MOVE AC1,IO ;GET FLAGS FOR THE ATOM POP P,IO ;RESTORE PREVIOUS FLAGS TLNE AC1,IORPTC ;[1056] ALLOW .IF,... TLO IO,IORPTC ;[1056] JUMPNC IFERRA ;MAKE SURE TERMINATOR WAS A COMMA TLNE AC1,NUMSW ;WAS IT A NUMBER? JRST %IF2 ;[1056] DO NUMERIC CHECKS CALL SEARCH ;GENERAL SEARCH JRST [CALL OPTSCH ;NOT SYMBOL, SEE IF OPCODE SKIPA ARG,[UNDF+NOTF] ;[621] NOT OPCODE, ATOM UNDEFINED MOVE ARG,[SYMF,,OPCF] ;OPCODE, IS ALSO SYMBOL JRST %IF1] ;GO GET TYPE AND TEST JUMPL ARG,IFS1 ;JUMP IF HAVE SYMBOL DEFINITION CAME AC0,-3(SX) ;HAVE OPDEF, SYMBOL ALSO PRESENT? JRST IFS2 ;NO SUBI SX,2 ;YES, POINT TO IT CALL SRCH5 ;RESET REGISTERS IFS1: CAMN AC0,1(SX) ;HAVE SYMBOL, OPDEF ALSO PRESENT? IOR ARG,2(SX) ;YES, MERGE FLAGS IFS2: HRRI ARG,0 ;NO RH LOCAL FLAGS IF SYMBOL %IF1: CALL GETSYM ;GET ATTRIBUTE JRST IFERRA ;MUST BE A SYMBOL CAIE C,'<' ;[677] IF "<", SET REPEAT AND CONTINUE JUMPNC IFERRA ;[677] ELSE TERMINATE WITH COMMA TLO IO,IORPTC ;[677] CALL %IFSTM ;SETUP MASK MOVSI AC2,-IFLEN ;AOBJN PTR IFLOOP: MOVE SDEL,IFATAB(AC2) ;GET NAME ANDCM SDEL,AC1 ;MASK CAMN AC0,SDEL ;MATCH JRST IFOUND ;GOT IT AOBJN AC2,IFLOOP ;LOOP JRST IFERRA ;[611] NOT FOUND, A-ERROR ;SETUP MASK TO LOOK AT ONLY AS MANY LETTERS AS USER TYPED. ALLOWS ;ATTRIBUTE TO BE UNIQUELY ABBREVIATED. %IFSTM: SETO AC1, ;START WITH ALL TDNE AC0,AC1 ;STILL SEEING USERS CHARS? JRST [LSH AC1,-6 ;YES, SHIFT OUT ONE SIXBIT CHAR JRST .-1] ;TRY AGAIN RET ;MASK NOW IN AC1 ;ANY DETECTED ERROR IN THIS PSEUDOOP GIVES "A" ERROR IFERRA: POP P,AC0 ;CLEAR STACK JRST ERRAX ;ERROR "A" IFOUND: MOVE SDEL,IFATAB+1(AC2) ;[611] CHECK NEXT ENTRY IN TABLE ANDCM SDEL,AC1 ;[611] MASK CAMN AC0,SDEL ;[611] MATCH? JRST IFERRA ;[611] YES, ABBR. NOT UNIQUE, A-ERROR POP P,AC0 ;[611] GET WHICH JUMPN AC0,IFNTST ;[611] .IFN ; JRST IFTST ;[611] .IF IFTST: XCT IFJTAB(AC2) ;MAKE TEST JRST IFXF ;FALSE JRST IFXT ;TRUE IFNTST: XCT IFJTAB(AC2) ;MAKE TEST JRST IFXT ;TRUE JRST IFXF ;FALSE %IF2: TRNE AC1,ERRORS ;[1056] ERRORS IN ATOM? JRST [MOVEI ARG,UNDF+NOTF ;[1056] JRST %IF1] ;[1056] SKIP SEARCH SKIPN IFSRCH ;[1056] SEARCH PERFORMED ALREADY? JRST [MOVEI ARG,NUMF ;[1056] NO, IT'S REALLY A NUMBER JRST %IF1] ;[1056] SKIP SEARCH HLLZ ARG,IFSRCH ;[1056] GET MERGED ARG BITS SKIPE .IFNUM ;[1056] NUMBER SEEN TOO? TRO ARG,NUMF ;[1056] YES, MERGE IT IN TDNE RC,[-2,,-2] ;[1056] DO RELOCATION CHECKS JRST [TLO ARG,EXTF ;[1056] ANY FIXUP RETURNS EXTERNAL JRST %IF1] ;[1056] (ALONG WITH MERGED BITS) TLNE RC,1 ;[1056] LH RELOCATABLE? TLOA ARG,LELF ;[1056] SET FLAG TLZ ARG,LELF ;[1056] ELSE FORCE FLAG OFF TRNE RC,1 ;[1056] SAME TEST FOR RIGHT-HALF TLOA ARG,RELF ;[1056] TLZ ARG,RELF ;[1056] JRST %IF1 ;[1056] GET ATTRIBUTE ;[611] KEEP ATTRIBUTE TABLE ALPHABETICAL DEFINE IFATRIB < XX ABSOLUTE, XX ASSIGNMENT XX ENTRY, XX EXPRESSION, ;;[1056] ANGLE-BRACKET SEEN? XX EXTERNAL, XX GLOBAL, XX INTERNAL, XX LABEL, XX LOCAL XX LRELOCATABLE, XX MACRO, XX NAME, ;;[1112] SINGLE RADIX50 NAME SEEN? XX NEEDED XX NUMERIC, XX OPCODE, XX OPDEF, XX REFERENCED XX RELOCATABLE, XX RRELOCATABLE, XX SYMBOL, XX SYNONYM, > DEFINE XX (A,B)< > IFATAB: IFATRIB IFLEN==.-IFATAB DEFINE XX (A,B)< IFB ,< CALL %IF'A > IFNB ,< B >> IFJTAB: IFATRIB %IFLOCAL: TLNN ARG,EXTF!SPTR!UNDF!MACF!SYNF TLNN ARG,SYMF ;NOT EXTERNAL, BUT MUST BE SYMBOL RET JRST CPOPJ1 %IFASSIGNMENT: TLNE ARG,SYMF TLNE ARG,TAGF!UNDF!MACF!SYNF RET JRST CPOPJ1 %IFREFERENCED: CAMN ARG,[UNDF+NOTF] ;[621] NOT FOUND? RET ;[621] JRST CPOPJ1 ;[621] %IFNEEDED: CAME ARG,[UNDF+NOTF] ;[626] NOT FOUND? TLNN ARG,UNDF ;[626] FOUND, BUT UNDEFINED? RET ;[626] JRST CPOPJ1 ;[626] CONDITION SATISFIED ;[1112] HERE FROM CELL LEVEL TO RULE OUT CASES WHERE THE CURRENT ;[1112] ATOM CANNOT BE A SIMPLE RADIX50 NAME (I.E. SYMBOL) %IFCHK: CAIN C,' ' ;[1112] SPACE OR TAB? JRST CELL1 ;[1112] KEEP SCANNING CAIN C,'.' ;[1112] PERIOD JRST PERIOD ;[1112] CHECK IT OUT CAIE C,'$' ;[1112] DOLLAR SIGN CAIN C,'%' ;[1112] OR PERCENT SIGN JRST LETTER ;[1112] VALID NAME CHARACTER CAIL C,'A' ;[1112] LETTERS ARE ALSO CAILE C,'Z' ;[1112] VALID NAME CHARACTERS SKIPA ;[1112] BUT OTHERS AREN'T JRST LETTER ;[1112] HANDLE LETTERS CAIN C,'<' ;[1112] NAME MAY BE BRACKETED JRST ANGLB ;[1112] HANDLE EXPRESSIONS CAIN C,'>' ;[1112] END OF EXPRESSION JRST LETTER ;[1112] SCAN FURTHER SETZM .IFNAM ;[1112] OTHER THAN RADIX50 NAME JRST CELL1A ;[1112] CONTINUE USUAL DISPATCH ;ASSIGN PSEUDO-OP ;ASSIGN SYM1,SYM2,INCR ASGN: CALL COUTD ;DUMP BUFFER PUSH P,BLKTYP ;SAVE BLOCK TYPE MOVEI AC0,100 ;ASSIGN BLOCK TYPE MOVEM AC0,BLKTYP CALL GETSYM ;HERE TO ASGN6 COPIED FROM EXTERN JRST ASGN2 TLO IO,DEFCRS ;FLAG AS DEFINITION CALL SSRCH JRST ASGN1 TLNN ARG,EXTF!VARF!UNDF JRST ASGN2 TLNE ARG,EXTF JRST [JUMP1 ASGN6 TLZN ARG,UNDF JRST ASGN6 ANDM ARG,(SX) JRST ASGN1] ASGN1: CALL EXTRN1 ;[664] CALL EXTRN2 ;[664][712] ASGN6: MOVE AC0,-1(SX) SETZ ARG, CALL SQOZE ;CONVERT TO SQUOZE CALL COUT ;OUTPUT FIRST SYMBOL JUMPNC ASGN2 ;MUST BE COMMA HERE CALL GETSYM ;SECOND SYMBOL JRST ASGN2 MOVEI SDEL,%SYM ;OUTPUT TO CREF CALL CREF SETZ ARG, CALL SQOZE ;CONVERT TO SQUOZE CALL COUT JUMPNC ASGN3 ;COMMA? CALL EVALXQ ;YES, EVALUATE INCREMENT ASGN4: CALL COUT JUMP1 ASGN7 ;DON'T OUTPUT IF PASS1 CALL COUTD ;OUTPUT 3 WORDS ASGN5: POP P,BLKTYP ;RESTORE BLOCK TYPE RET ASGN3: MOVEI AC0,1 ;INCREMENT IS 1 IF NOT SPECIFIED JRST ASGN4 ASGN2: TRO ER,ERRE ;INDICATE ASGN7: CALL COUTI ;CLEAR OUTPUT BUFFER JRST ASGN5 EXTER0: TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL GETSYM ;GET A SYMBOL JRST [ TRO ER,ERRA ;[712] FLAG AS ERROR JRST EXTERC] ;[1070][712] EXTER1: TLO IO,DEFCRS ;FLAG THIS AS A DEFINITION EXTER5: CALL SSRCH ;OK, SEARCH SYMBOL TABLE JRST EXTER2 ;NOT THERE, INSERT IT TLNN ARG,INTF ;[1070] PREVIOUSLY DEFINED AS INTERNAL TLNN ARG,EXTF!VARF!UNDF ;[1070] BUT NOT EXTERNAL OR UNDEFINED JRST [ TRO ER,ERRE ;[1070] FLAG ERROR JRST EXTERC] ;[1070] AND BYPASS TLNE ARG,EXTF ;VALID, ALREADY DEFINED? JRST [JUMP1 EXTER3 ;YES, BYPASS TLZN ARG,UNDF ;SKIP IF UNDEFINED ALSO JRST EXTER3 ;CONTINUE ANDM ARG,(SX) ;CLEAR UNDF ON PASS 2 JRST EXTER2] ;SET UP EXTERNAL NOW EXTER2: CALL EXTRN1 ;[664] SET UP EXTERNAL CALL SUPSYM ;SEE IF "!" SEEN CALL EXTRN2 ;[664] [712] INSERT/UPDATE IT MOVE ARG,AC0 ;[712] EXTER3: ;[1070] IFN FTPSECT,< ;[575] IF PSECT MUST SEARCH FOR ALL OCCURANCES SKIPN SGNMAX ;ANY PSECTS? JRST EXTER9 ;NO PUSH P,SGNCUR ;SAVE CURRENT PSECT SETOM SGSRCH ;[1070] SEARCH ONLY CURRENT PSECT SETZB AC1,SGNCUR ;[1070] START WITH BLANK PSECT EXTER6: CAMN AC1,0(P) ;[1070] SAME AS CURRENT PSECT? JRST EXTER7 ;[1070] YES - SKIP IT CALL SSRCH ;LOOK FOR EXTERN JRST EXTER7 ;[1070] NOT FOUND IN THIS PSECT TLNE ARG,EXTF ;ALREADY EXTERN? JRST [JUMP1 EXTER7 ;YES, BYPASS TLZN ARG,UNDF ;UNDEF ALSO JRST EXTER7 ;NO ANDM ARG,(SX) ;YES, CLEAR FLAG JRST .+1] ;AND SETUP AS EXTERN CALL EXTRN1 ;[664] SET UP EXTERN CALL EXTRN2 ;[664] INSERT/UPDATE IT MOVE ARG,AC0 ;[712] EXTER7: AOS AC1,SGNCUR ;NEXT PSECT CAMG AC1,SGNMAX ;ALL DONE? JRST EXTER6 ;NO SETZM SGSRCH ;[1070] SEARCH ALL PSECTS POP P,SGNCUR ;[1070] BACK TO NORMAL EXTER9:> ;[575] END IFN FTPSECT EXTERC: CALL SUPSYM ;[1070] SEE IF "!" SEEN JUMPCM EXTER0 TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN RET ;NO, EXIT EXTRN1: MOVEI V,2 ;[664] GET 2 CELLS FROM TREE ADDB V,FREE ;[664] CAML V,SYMBOL ;[664] HAVE WE RUN OUT OF CORE CALL XCEEDS ;[664] YES, TRY TO BORROW SOME MORE SUBI V,2 ;[664] GET RIGHT CELL FOR POINTER SETZB RC,0(V) ;[664] ALL SET, ZERO VALUES MOVSI ARG,SYMF!EXTF ;[664] RET ;[664] RETURN TO INSERT/UPDATE EXTRN2: CALL INSERT ;[664] INSERT/UPDATE MOVSI ARG,PNTF ;[664] IORM ARG,0(SX) ;[664] MOVE AC0,-1(SX) ;[712] GET THE SIXBIT FOR THE NAME MOVEM AC0,1(V) ;[712] STORE IT FOR ADDITIVE GLOBAL FIXUPS RET ;[664] RETURN TO GET SIXBIT EVAL10: PUSH P,CURADX ;[613] PUSH CURRENT RADIX PUSH P,[^D10] ;[613] MAKE IT RADIX 10 POP P,CURADX ;[613] CALL EVALEX ;EVALUATE POP P,CURADX ;[613] RESET RADIX JUMPE RC,CPOPJ ;[664] EXIT IF ABSOLUTE QEXT: IFN POLISH,< TLNE FR,POLSW ;ANY POLISH EXTERNAL EXPRESSIONS JRST QPOL ;YES, REMOVE AND FLAG ERROR > SKIPE EXTPNT ;ANY POSSIBILITIES? TROA ER,ERRE ;YES, FLAG EXTERNAL ERROR TRO ER,ERRR ;NO, FLAG RELOCATION ERROR HLLZS RC ;CLEAR RELOCATION/EXTERNAL RET IFN POLISH,< QPOL: TRO ER,ERRE ;FLAG EXTERNAL ERROR PUSH P,AC1 ;GET AN AC SKIPE LITLVL ;IN A LITERAL? SKIPA AC1,POLITS ;YES, USE LAST LIT ITEM MOVE AC1,POLIST ;GET LAST ITEM IN LIST JUMPE AC1,QPOL1 ;IF ZERO, DON'T GO BACK MOVEM AC1,FREE ;RESET FREE CORE POINTER MOVE AC1,(AC1) ;GET PREVIOUS ITEM SKIPE LITLVL ;IN A LITERAL? JRST [MOVEM AC1,POLITS ;YES JRST .+2] MOVEM AC1,POLIST ;MAKE IT TOP OF LIST QPOL1: POP P,AC1 RET > EVALXQ: PUSH P,IO ;SAVE ERROR STATUS TRZ ER,-1 ;START AFRESH CALL EVALQ ;EVALUATE EXPRESSION TRNE ER,ERRU ;TEST FOR UNDEF TRO ER,ERRV ;FLAG "V" ERROR HLLM IO,(P) ;STORE STATUS FLAGS IORM ER,(P) ;COMPOUND ERRORS POP P,IO ;RESTORE THEM RET EVALQ: ;[1025] IFN POLISH,< TRO FRR,NOPSW > ;[1025] DON'T ALLOW POLISH CALL EVALEX ;EVALUATE EXPRESSION IFN POLISH,< TRZ FRR,NOPSW > ;[1025] REST FLAG TDZE RC,[-2,,-2] ;WAS AN EXTERNAL FOUND? TRO ER,ERRE ;YES, FLAG ERROR RET ;RETURN OPDEF0: CALL GETSYM ;GET THE FIRST SYMBOL RET ;ERROR IF INVALID SYMBOL CAIE C,73 ;"["? JRST ERRAX ;NO, ERROR MOVEM AC0,INOPDF ;[624] PUSH P,AC0 ;STACK MNEMONIC AOS LITLVL ;SHORT OUT LOCATION INCREMENT PUSH P,STPY ;[1035] SAVE CODE BUFFER SETTINGS AND PUSH P,STPX ;[1035] POINT OUTPUT SETTING AT CURRENT PUSH P,STPX ;[1035] INPUT SETTING POP P,STPY ;[1035] CALL STMNT ;EVALUATE STATEMENT MOVE AC1,STPX ;[1035] MAKE SURE CODE WAS GENERATED SUB AC1,STPY ;[1035] SKIPG AC1 ;[1035] TROA ER,ERRA ;[1035] ELSE FLAG ERROR CALL DSTOW ;[1035] POP P,STPX ;[1035] RESTORE CODE BUFFER SETTINGS POP P,STPY ;[1035] SOS LITLVL SETZM INOPDF ;[624] EXCH AC0,0(P) ;EXCHANGE VALUE FOR MNEMONIC PUSH P,RC ;STACK RELOCATION TLO IO,DEFCRS ;SAY WE ARE DEFINING IT TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL SSRCH ;[752] SEE IF FORW-REFED JRST OPDEF1 ;[752] NO, JUMP TLNN ARG,UNDF ;[752] JRST OPDEF1 ;[752] TLNN ARG,INTF ;[752] CALL OPCFX1 ;[752] OPDEF1: ;[752] CALL MSRCH ;SEARCH SYMBOL TABLE MOVSI ARG,OPDF ;[675] OPDEF TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN POP P,RC ;RESTORE VALUES POP P,V TLNE ARG,SYNF!MACF TRO ER,ERRA ;YES "A" ERROR TRNN ER,ERRA ;ERROR? CALL INSERT ;NO, INSERT/UPDATE CALL ASSIGL ;LIST VALUE LIKE = TLZ IO,DEFCRS ;JUST IN CASE CALL BYPASS ;[664] SETZM EXTPNT ;[1000] CLEAR EXTERNAL POINTER RET ;[1000] NO LONGER NEEDED TO RESET STOW OPCFIX: CALL SSRCH ;[736] SEE IF WAS FORW-REF'ED RET ;[736] NO, CONTINUE TLNN ARG,UNDF ;[736] RET ;[736] NO, CONTINUE OPCFX1: PUSH P,AC0 ;[752] YES, IT WAS UNDEFINED, DO REMOVE CALL REMOVE ;[736] POP P,AC0 ;[736] RET ;[736] CONTINUE WITH NAME IN AC0 DEPHA0: SETZM PHALVL ;NOT IN PHASE MOVE AC0,LOCO MOVE RC,MODO ;SET TO OUTPUT VALUES AND SKIP JRST PHASE1 PHASE0: SETOM PHALVL ;IN PHASE CALL EVALXQ ;EVALUATE AND CHECK FOR EXTERNAL PHASE1: MOVEM AC0,LOCA ;SET ASSEMBLY LOCATION COUNTER MOVEM RC,MODA JRST BLOCK2 ASSIGN: JUMPAD ERRAX ;NO, ERROR JUMPE AC0,ERRAX ;NO SYMBOL ON THE LEFT OF= CALL ASSIG1 ASSIGL: TLNE IO,IOSALL ;SUPPRESS ALL? JUMPN MRP,CPOPJ ;IF IN MACRO ASSIG7: MOVEM RC,ASGBLK JUMP1 CPOPJ ;[633] DON'T NEED THIS FOR PASS1 IFN POLISH,< JUMPL RC,CPOPJ ;[633] DON'T NEED THIS FOR POLISH ASSIGN > PUSH P,AC0 ;[633] NEED AN AC FOR A WHILE MOVEI AC0,EXTF ;[633] EXTERNAL FLAG TRNE RC,-2 ;[633] RIGHT HALF EXTERNAL? HRRM AC0,ASGBLK ;[633] YES, USE THE FLAG TLNE RC,1 ;[633] LEFT HALF NOT RELOC? JRST [ TLNE RC,-2 ;[633] NO, EXTERNAL? HRLM AC0,ASGBLK ;[633] YES, SET FLAG JRST .+2] ;[633] SKIP RETURN HRROS ASGBLK ;[633] LEFT HALF NOT RELOC, MAKT IT -1 POP P,AC0 ;[633] RESTORE AC MOVEM V,LOCBLK RET ASSIG1: PUSH P,AC0 ;SAVE SYMBOL IFN POLISH,< MOVEM AC0,INASGN ;IN CASE POLISH FIXUP REQUIRED > SETZB AC0,EXTPNT ;SPECIAL CHECK FOR == WFW ASSIG4: CALL PEEK ;IS THE NEXT ON = CAIE C,"=" CAIN C,"!" CAIA ;WANT TO SUPRESS SYMBOL JRST ASSIG5 ;NOT "=" OR "!", SO SEE IF COLON TLOE AC0,NOOUTF ;TURN ON "NO-OUTPUT" FLAG TRO ER,ERRQ ;IF ALREADY ON, GIVE ERROR CALL GETCHR ;PROCESS THE CHAR. CALL PEEK ;CHECK FOR ==: DMN ASSIG5: CAIE C,":" ;IS IT JRST ASSIG6 ;NO TLOE AC0,INTF ;FLAG AS INTERNAL TRO ER,ERRQ ;IF ALREADY ON, ITS AN ERROR CALL GETCHR ;REPEAT IT JRST ASSIG4 ;TRY AGAIN (MIGHT BE =:!) ASSIG6: PUSH P,AC0 ;[1045] SAVE SYMTAB BITS ACROSS CALL IFN POLISH,< HRREI AC0,POLFWF ;ASSUME FULL WORD FIXUP MOVEM AC0,POLTYP ;UNLESS OTHERWISE SPECIFIED > CALL EVALCM ;EVALUATE EXPRESSION POP P,HDAS ;[1045] RESTORE SYMTAB BITS FOR LATER MERGE TRNE FRR,LTGSW ;[1126] ASSIGNMENT INVOLVING LABEL IN LITERAL? TRO ER,ERRL ;[1126] YES - FLAG ERROR SINCE MAY BE UNDEFINED TDNN RC,[-2,,-2] ;RC IS 0 OR 1? JRST ASSIG0 ;YES, CAIGE RC,100 ;NO, RC HAVING VALUES BETWEEN -100 AND CAMG RC,[-100] ;100 GETS R ERROR SKIPA ;SINCE IT IS NOT PART OF A LARGER EXP TRO ER,ERRR ;GIVE R ERROR ASSIG0: EXCH AC0,0(P) ;SWAP VALUE FOR SYMBOL PUSH P,RC IFN POLISH,< JUMPL RC,ASSIG3 ;POLISH, BYPASS EXTERN TESTS > TRNN RC,-2 ;CHECK EXTERNAL AGREEMENT JRST ASSIG2 HRRZS RC HRRZ ARG,EXTPNT CAME RC,ARG CALL QEXT ;EXTERNAL OR RELOCATION ERROR ASSIG2: HLRZ RC,(P) TRNN RC,-2 JRST ASSIG3 HLRZ ARG,EXTPNT CAME RC,ARG CALL QEXT ASSIG3: TLO IO,DEFCRS TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL SSRCH MOVSI ARG,SYMF TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN TLC ARG,EXTF+PNTF ;[606] REAL EXTERNAL UP TIL NOW? TLCE ARG,EXTF+PNTF ;[606] SKIPA ;[606] NO, JRST [ TLNN ARG,UNDF ;[606] NOT BECAUSE UNDEFINED? TRO ER,ERRE ;[606] YES, E-ERROR, CAN'T DO FOO##= JRST .+1] ;[606] UNDEFINED TLZ ARG,^- ;[745] KEEP THESE IOR ARG,HDAS ;SET BITS DETERMINED ABOVE SETZM EXTPNT ;FOR REST OF WORLD IFN POLISH,< SETZM INASGN ;FINISHED WITH POLISH BY NOW SETZM POLTYP > ;[575] IFN FTPSECT,< ;[575] TLZ IO,RSASSW ;... > POP P,RC TRNE ER,ERRORS-ERRQ-ERRU ;[1005] SETZ RC, ;CLEAR RELOCATION POP P,V JUMP2 .+3 ;[1017] DON'T CARRY UNDF ACROSS IN PASS 2 TRNE ER,ERRU ;WAS VALUE UNDEFINED? TLO ARG,UNDF ;YES,SO TURN UNDF ON TLNE ARG,TAGF JRST ERRAX TLNN ARG,SPTR ;[745] WAS SPTR ON? JRST INSERT ;[745] NO, JUMPL RC,INSERT ;[745] YES, AND STILL GOOD TLZ ARG,SPTR ;[745] NO LONGER NEEDED JRST INSERT ;LOC, RELOC, AND ORG COME HERE %ORG: MOVEM AC0,MODN ;SAVE TYPE CALL HIGHQ ;GET LATEST PC CALL BYPASS ;[664] SKIP BLANKS TLO IO,IORPTC ;REPEAT LAST CAIN C,EOL ;USE PREVIOUS VALUE IF NULL ARGUMENT JRST [HRRZ AC0,ORGMOD ;GET PREV MODE IN CASE ORG SKIPGE MODN ;ORG? HRLM AC0,MODN ;YES, SAVE IT HLRZ AC1,MODN ;NEW MODE MOVE AC0,@REL1P(AC1) ;GET PREV VALUE JRST ORG01] ;[573] IFN POLISH,< TRO FRR,NOPSW> ;[616] DON'T ALLOW POLISH CALL EVALXQ ;GET EXPRESSION AND TEST EXTERNAL IFN POLISH,< TRZ FRR,NOPSW> ;[616] UNDO NO-POLISH SWITCH TLNE AC0,-1 ;[714] STUFF IN LH? TRO ER,ERRA ;[741] YES, A-ERROR SKIPGE MODN ;ORG? HRLM RC,MODN ;YES, SAVE RELOC OF ARG SETOM RELARG ;[721] FLAG EXPLICIT ARGUMENT ORG01: HRRM AC0,MODN ;STORE NEW VALUE HLRZ AC0,MODN ;AC0=NEW MODE MOVE AC1,MODO ;AC1=OLD MODE SKIPN AC1 ;[721] OLD=LOC? CALL [ JUMPE AC0,CPOPJ1 ;[721] YES, SKIPE IF NEW=LOC SKIPE RELARG ;[721] OR IF NEW=RELOC AOS (P) ;[721] RET] ;[721] CALL ORG02 ;[721] ELSE ADJUST RELOC BLOCK PTR SETZM RELARG ;[721] ZERO EXPLICIT ARG FLAG HRRZ AC0,LOCO ;GET LAST PC TO PROPER BLOCK MOVEM AC0,@REL1P(AC1) ;[573] MOVEM AC1,ORGMOD ;SAVE OLD MODE IFN FTPSECT,< ;[575] MOVE AC1,SGNCUR ;CURRENT PSECT INDEX MOVE AC0,HIGH ;SAVE PSECT BREAK HRRM AC0,SGATTR(AC1) CALL ORG03 ;ADJUST RELOC PTR IF NECESSARY HRR AC0,@REL1P+1 ;SAVE PSECT REL PC HRL AC0,ORGMOD ;SAVE PSECT MODE MOVEM AC0,SGRELC(AC1) CALL ORG03 ;READJUST PTR IF NECESSARY > MOVE AC0,MODN ;GET RESULT HLRZM AC0,MODA ;SET MODES HLRZM AC0,MODO HRRZM AC0,LOCA ;AND LOCATIONS HRRZM AC0,LOCO JRST BLOCK2 ORG02: MOVE AC0,REL1P+1 ;ADJUST RELOC BLOCK PTR CAIN AC0,RELLOC ;[573] AOSA REL1P+1 ;[573] SOS REL1P+1 ;[573] RET ;[573] IFN FTPSECT,< ;[575][573] ORG03: HLRZ AC0,MODN ;[573] SKIPE AC0 ;IF LOC TO RELOC SKIPE MODO ;[573] RET ;[573] JRST ORG02 ;ADJ REL PTR > ;[575][573] END IFN FTPSECT ; .PSECT NAME /ATTRIB,ORIGIN IFN FTPSEC,< %SEGME: SKIPN HISNSW ;CAN'T HAVE PSECTS WITH SKIPE UNIVSN ;HISEG, TWOSEG OR JRST ERRSX ;UNIVERSAL MOVE AC2,SGDMAX ;CHECK IF MAX PSECT CAILE AC2,SGNDEP-1 ;NESTING DEPTH EXCEEDED JRST ERRSX ;YES SETZM SGSWPT ;[1074] INDICATE .PSECT FOR PSECT SWAP CALL GETSYM ;GET PSECT NAME CALL [SETZ AC0, ;NONE SPECIFIED, BLANK NAME TRZ ER,ERRA ;UNDO GETSYM'S ERR FLAG RET] MOVE AC1,SGNMAX ;GET PSECT COUNT %SEGM1: CAMN AC0,SGNAME(AC1) ;SEEN THIS NAME BEFORE? JRST %SEGM2 ;YES SOJGE AC1,%SEGM1 ;LOOP THRU KNOWN NAMES MOVE AC1,SGNMAX ;CHECK IF MAX DISTINCT PSECT CAILE AC1,SGNSGS-1 ;LIMIT EXCEEDED JRST ERRSX ;YES AOS AC1,SGNMAX ;INCR PSECT COUNT SETOM BLK24 ;[1020] FIRST TIME, OUTPUT BLOCK 24 MOVEM AC0,SGNAME(AC1) ;STORE PSECT NAME MOVSI AC2,1 ;SET MODE TO RELOC MOVEM AC2,SGRELC(AC1) ;AND PC TO ZERO HRRZS SGORIG(AC1) ;[1131] INCASE NOT GIVEN %SEGM4: MOVE SDEL,SYMBOL ;ROOM TO INIT SUBI SDEL,LENGTH ;SYM TAB CAMLE SDEL,FREE ;FOR NEW PSECT? JRST %SEGM3 ;YES CALL XCEEDS ;TRY FOR MORE CORE JRST %SEGM4 ;START OVER %SEGM3: MOVEM SDEL,SYMBOL ;NEW SYM TAB BOT HRLI SDEL,LENGTH(SDEL) ;OLD SYM TAB BOT MOVE SX,SYMTOP ;SYM TAB TOP BLT SDEL,-LENGTH(SX) ;MOVE SYM TAB DOWN HRLI SDEL,SYMNUM+1 ;PTR TO PERM SYM TAB HRRI SDEL,1-LENGTH(SX) ;PERM SYMS GO HERE BLT SDEL,0(SX) ;MOVE PERM SYMS TO NEW PSECT MOVE AC2,SYMNUM ;PERM SYM CNT MOVEM AC2,SGSCNT(AC1) ;SET SYM CNT ADDM AC2,@SYMBOL ;[1042] ADJUST TOTAL SYM CNT MOVSI AC2, ;[1042][1021] SET RELOC PSECT BIT MOVEM AC2,SGATTR(AC1) ;[1042][1021] DEFAULT PSECT BRK AND ATTRS TLO IO,DEFCRS ;[711] FLAG AS DEFINITION PUSH P,AC1 ;[711] SAVE AC1 FOR A WHILE CALL SSRCH ;[711] ADD PSECT-NAME AS EXTERN SYMBOL JRST %SEG10 ;[711] COPIED FROM EXTERN CODE TLNN ARG,EXTF!VARF!UNDF ;[711] JRST [ TRO ER,ERRE ;[711] JRST %SEG11] ;[711] TLNE ARG,EXTF ;[711] JRST [ JUMP1 %SEG11 ;[711] TLZN ARG,UNDF JRST %SEG11 ;[711] ANDM ARG,(SX) ;[711] JRST %SEG10] ;[711] %SEG10: CALL EXTRN1 ;[711] CALL EXTRN2 ;[711] %SEG11: POP P,AC1 ;[711] RESTORE AC1 %SEGM2: AOS AC2,SGDMAX ;INCR PSECT DEPTH MOVEM AC0,SGLIST(AC2) ;STORE PSECT NAME SETZM SGLTLV(AC2) ;[1074] CLEAR PSECT ENTRY LITERAL LEVEL %SEGM5: CAIE C,'/' ;ATTRIBUTES SPECIFIED? JRST %SEGM9 ;NO, TRY VALUE PUSH P,AC1 ;SAVE PSECT INX CALL GETSYM ;GET ATTRIBUTE JRST %SEGM8 ;TOO BAD ; THE BELOW ATTRIBUTES ARE PAIRED; A CONFLICT IS ; FLAGGED IF BOTH OF ANY PAIR ARE SEEN (CUMMULATIVELY) MOVE AC1,AC0 ;ATRIB NAME SETO AC2, ;MASK LSH AC1,6 ;SHIFT UP 1 CHAR AT A TIME LSH AC2,-6 ;[1117] SAME FOR MASK JUMPN AC1,.-2 ;UNTIL CHAR ALL GONE, MASK LEFT PUSH P,[-1] ;[1117] STACK NO TABLE MATCH FOUND PUSH P,AC2 ;[1117] AND ATTRIBUTE MASK MOVSI AC1,-%SGATL ;[1117] SETUP AOBJN COUNTER %SEGM6: CAMN AC0,%SGATN(AC1) ;[1117] EXACT MATCH ON ATTRIBUTE? JRST %SEGM7 ;[1117] YES, CHECK IT OUT MOVE AC2,%SGATN(AC1) ;[1117] GET TABLE ATTRIBUTE ANDCM AC2,0(P) ;[1117] MASK IT CAME AC0,AC2 ;[1117] MATCH YET? JRST %SEG12 ;[1117] NO - KEEP CHECKING SKIPL -1(P) ;[1117] HAS IT BEEN FOUND BEFORE? JRST %SEG13 ;[1117] ERROR BECAUSE AMBIGUOUS HRRZM AC1,-1(P) ;[1117] SAVE INDEX WHERE FOUND %SEG12: AOBJN AC1,%SEGM6 ;[1117] LOOP THRU TABLE MOVE AC1,-1(P) ;[1117] GET INDEX WHERE FOUND JUMPGE AC1,%SEGM7 ;[1117] OK IF FOUND %SEG13: SUB P,[2,,2] ;[1117] ERROR - CLEAN UP STACK POP P,AC1 ;[1117] RESTORE PSECT INDEX TRO ER,ERRQ ;[1117] FLAG QUESTIONABLE ERROR JRST %SEGM5 ;[1117] AND TRY AGAIN %SEGM7: SUB P,[2,,2] ;[1117] DISCARD MASK AND INDEX MOVE AC2,%SGATB(AC1) ;[1117] GET ATTRIBUTE DEF AND CONFLICT BITS MOVE AC1,0(P) ;[1117] GET PSECT INDEX HLRZ AC0,SGATTR(AC1) ;[1117] AND CURRENT ATTRIBUTES AND AC0,AC2 ;[1117] SEE IF ANY CONFLICTS SKIPE AC0 ;[1117] SKIP IF NONE JRST [ TRO ER,ERRQ ;[1117] FLAG QUESTIONABLE ERROR JRST %SEGM8] ;[1117] AND IGNORE CONFLICT HLLZS AC2 ;[1117] CLEAR RIGHT HALF IORM AC2,SGATTR(AC1) ;MERGE ATTRIBUTES %SEGM8: POP P,AC1 ;RESTORE PSECT INX JRST %SEGM5 ;[1117] CHECK FOR MORE ATTRIBUTES %SEGM9: JUMPNC %SWSEG ;[1021] NO VALUE PUSH P,AC1 ;SAVE INDEX CALL EVALCM ;GET IT TRNN FRR,RHPSW!LHPSW!FWPSW ;[1137] IS ORIGIN POLISH SKIPE RC ;[1137] OR EXTERNAL OR RELOC? TRO ER,ERRA ;[1137] YES - FLAG ARG ERROR POP P,AC1 ;RESTORE INDEX HRRM AC0,SGORIG(AC1) ;STORE IT SKIPL AC2,SGATTR(AC1) ;[1030][1021] RELOCATABLE PSECT? JRST %SWSEG ;[1030][1021] NO, TLZ AC2,SG.RP ;[1030][1021] YES, NO LONGER TRUE MOVEM AC2,SGATTR(AC1) ;[1030][1021] MAKE IT FIX-ORIGIN JRST %SWSEG ;SWAP PC AND MODE ;[1117] PSECT ATTRIBUTE DEFINITION ;[1117] VALS: ATTRIBUTE NAME - SIXBIT ;[1117] ATTRIBUTE SYMBOL - DEFINED FROM BIT 17 TO BIT 1 ;[1117] CONFLICTING ATTRIBUTE SYMBOLS - ORED TOGETHER DEFINE %SGATD,< ;[1117] %SGATV RWRITE,AT.RW,AT.RO ;[1117] READ-WRITE %SGATV RONLY,AT.RO,AT.RW ;[1117] READ-ONLY %SGATV OVERLAID,AT.OV,AT.CN ;[1117] OVERLAY %SGATV CONCATENATED,AT.CN,AT.OV ;[1117] CONCATENATE %SGATV PALIGNED,AT.PA ;[1117] PAGE-ALIGNED > ;[1117] DEFINE %SGATV(ATB,DEF,CON),< ;[1117] ;[1117] DEF==1B ;[1117] ATC==ATC-1> ;[1117] ATC==^D17 ;[1117] START FROM BIT 17 %SGATN: %SGATD ;[1117] NAMES AND ASSIGNMENTS %SGATL==.-%SGATN ;[1117] PURGE ATC ;[1117] DEFINE %SGATV(ATB,DEF,CON<0>),< ;[1117] DEF+> ;[1117] %SGATB: %SGATD ;[1117] VALUES,,CONFLICT VALUES %ENDSE: SKIPN HISNSW ;CAN'T HAVE PSECTS WITH SKIPE UNIVSN ;HISEG, TWOSEG OR JRST ERRSX ;UNIVERSAL MOVE AC2,SGDMAX ;IF DEPTH IS ALREADY ZERO JUMPE AC2,ERRSX ;THEN .ENDPS IS ILLEGAL SETOM SGSWPT ;[1074] INDICATE .ENDPS FOR PSECT SWAP CALL GETSYM ;GET PSECT NAME JRST %ENDS1 ;NONE SPECIFIED, IGNORE CHECK CAME AC0,SGLIST(AC2) ;DOES IT MATCH CORRES .PSECT NAME TRO ER,ERRQ ;NO, FLAG WARN AND DO IT ANYWAY %ENDS1: TRZ ER,ERRA ;UNDO GETSYM'S ERR FLAG MOVE AC1,LITLVL ;[1074] IS CURRENT LITERAL LEVEL CAME AC1,SGLTLV(AC2) ;[1074] THE SAME AS AT PSECT ENTRY? JRST [ TRO ER,ERRL ;[1074] NO - FLAG LIT LEVEL MISMATCH PUSH P,AC0 ;[1074] AND SAVE SPECIFIED PSECT NAME JRST .+1] ;[1074] SOS AC2,SGDMAX ;DECR PSECT DEPTH MOVE AC0,SGLIST(AC2) ;NAME OF PSECT TO RESUME MOVE AC1,SGNMAX ;GET PSECT COUNT CAME AC0,SGNAME(AC1) ;NAME MATCH? SOJGE AC1,.-1 ;NO, TRY NEXT TRNN ER,ERRL ;[1074] ANY PSECT LIT LEVEL MISMATCH? JRST %SWSEG ;[1074] NO - CONTINUE SWAP SETZM LITLVL ;[1074] YES - CLEAR LIT LEVEL CALL %SWSEG ;[1074] LET SWAP HAPPEN MOVE AC0,['MCRLNI'] ;[1074] SETUP FOR ERROR MOVEM AC0,PREFIX ;[1074] ..... CALL EFATAL ;[1074] SEND PREFIX HRRZI CS,[SIXBIT / LITERAL NESTING INCORRECT AT END OF PSECT@/] ;[1074] CALL TYPM2 ;[1074] SEND TEXT POP P,CS ;[1074] GET PSECT NAME CALL TYPSYM ;[1074] SEND PSECT NAME IF ANY CALL CRLF ;[1074] TYPE ERROR PUSH P,PAGENO ;[1074] SETUP 4 WORD BLOCK PUSH P,SEQNO2 ;[1074] FOR ERROR LOC TYPEOUT PUSH P,TAG ;[1074] ..... MOVE AC0,TAGINC ;[1074] GET CURRENT OFFSET SKIPE LBLFLG ;[1074] FOUND A LABEL IN THIS LITERAL? SUB AC0,LTGINC ;[1074] YES - CORRECT OFFSET PUSH P,AC0 ;[1074] COMPLETE 4 WORD BLOCK HRLI V,[SIXBIT /@/] ;[1074] SETUP NO ERROR TEXT HRRI V,-3(P) ;[1074] AND POINTER TO ERROR BLOCK JRST ERRNE3 ;[1074] FINISH OFF ERROR ;HERE TO SWAP TO NEW PSECT ;ENTER WITH OLD PSECR IN SGNCUR, NEW PSECT IN AC1 %SWSEG: PUSH P,AC1 ;SAVE NEW PSECT INX MOVE AC2,SGNCUR ;GET OLD PSECT INX HLRZ SDEL,SGORIG(AC2) ;ALREADY SETUP LIT/VAR BLOCK JUMPN SDEL,%SWSG1 ;YES MOVEI SDEL,.SGLVL ;[1131] NO ADDB SDEL,FREE ;TRY TO GET IT CAML SDEL,SYMBOL ;WILL IT FIT? CALL XCEED ;NO, XPAND SUBI SDEL,.SGLVL ;[1131] GET ORIGIN HRLM SDEL,SGORIG(AC2) ;NOW STORE IT %SWSG1: MOVSI AC0,.SGLVZ ;START OF LIT/VAR AREA HRR AC0,SDEL ;[1131] SAVE AREA BLT AC0,.SGLVL-1(SDEL) ;[1131] STORE IT MOVE AC0,LITLVL ;GET LITLVL MOVEM AC0,(SDEL) ;STORE IT SKIPE LITLVL ;[602] IN A LITERAL? JRST [ MOVE AC0,STPX ;[602] YES, SAVE DEPTH MOVEM AC0,1(SDEL) ;[602] MOVE AC0,STPY ;[602] MOVEM AC0,2(SDEL) ;[602] JRST .+1] HLLZ AC0,SGORIG(AC1) ;RESTORE NEW LIT/VAR JUMPE AC0,[MOVE AC0,[.SGLVZ,,.SGLVZ+1] ;NOT YET SETUP SETZM .SGLVZ ;CLEAR FIRST WORD BLT AC0,.SGLVZ+.SGLVL-1 ;[1131] PLUS REST MOVEI AC0,VARHD ;SET UP AREA MOVEM AC0,VARHDX MOVEI AC0,LITHD MOVEM AC0,LITHDX SETZM LITLVL CALL LITI CALL STOWI ;[602] JRST %SWSG2] ;JOIN COMMON CODE TLNE FR,P1 ;[1134] ONLY DURING PASS 1 CALL STOWI ;[1134] RESET STOW COUNTERS HRRI AC0,.SGLVZ ;TO LIT/VAR AREA ADD AC0,[3,,3] ;[1131] BYPASS FIRST 3 WORDS BLT AC0,.SGLVZ+.SGLVL-1 HLRZ SDEL,SGORIG(AC1) ;POINTER TO LIT INFO MOVE AC0,(SDEL) ;GET LITLVL MOVEM AC0,LITLVL ;WE ARE NOW IN SKIPN SGSWPT ;[1074] SWAPPING DUE TO .ENDPS JRST [ MOVE AC1,SGDMAX ;[1074] NO - .PSECT, GET DEPTH MOVEM AC0,SGLTLV(AC1) ;[1074] SAVE ENTRY LITERAL LEVEL MOVE AC1,0(P) ;[1100] RESTORE CURRENT PSECT NO. JRST .+1] ;[1074] SKIPE LITLVL ;[602] IN A LITERAL PREVIOUSLY? JRST [ MOVE AC0,1(SDEL) ;[602] YES, RESTORE DEPTH MOVEM AC0,STPX ;[602] MOVE AC0,2(SDEL) ;[602] MOVEM AC0,STPY ;[602] JRST .+1] ;[602] CALL HIGHQ ;SET CURRENT PROG BRK %SWSG2: HRRZ AC0,LOCO ;[1132] GET OUTPUT LOC MOVE AC1,MODO ;[1132] AND MODE MOVEM AC0,@REL1P(AC1) ;[1132] SAVE OLD VALUE MOVE AC1,SGNCUR ;CURRENT PSECT INDEX MOVE AC0,HIGH ;SAVE PSECT BREAK HRRM AC0,SGATTR(AC1) HRR AC0,@REL1P+1 ;[1057] SAVE PSECT REL PC HRL AC0,MODO ;[1132] GET OUTPUT MODE MOVEM AC0,SGRELC(AC1) ;[1132] SAVE MODE AND PC MOVE AC1,(P) ;[1132] GET NEW PSECT IDX. MOVE AC0,SGRELC(AC1) ;[1132] GET NEW MODE AND PC TLNE AC0,-1 ;[1132] IS NEW MODE ABSOLUTE? JRST %SWSG3 ;[1132] NO HRRM AC0,@REL1P+1 ;[1132] YES - SAVE RELOC PC HRR AC0,ABSLOC ;[1132] AND USE CURRENT ABSOLUTE PC %SWSG3: PUSH P,AC0 ;[1132] SAVE NEW MODE AND PC MOVEM AC1,SGNCUR ;[1132] SET NEW CURRENT PSECT JUMP1 .+2 ;IF PASS 2 THEN CALL SGOUTN ;OUTPUT PSECT NAME BLOCK POP P,AC0 ;GET RESULT HLRZM AC0,MODA ;SET MODES HLRZM AC0,MODO HRRZM AC0,LOCA ;AND LOCATIONS HRRZM AC0,LOCO POP P,SGNCUR ;STORE NEW PSECT INX MOVE AC1,SGNCUR ;NEW PSECT INX HRRZ AC0,SGATTR(AC1) ;GET PSECT BRK MOVEM AC0,HIGH ;RESTORE IT JRST SRCHI ;[664] SET UP SRCHX, EXIT ERRSX: TRO ER,ERRS ;FLAG PSECT USAGE ERROR RET ;DONE > ;END IFN FTPSECT HISEG1: IFN FTPSECT,< ;[575] SKIPE SGNMAX ;IF PSECTS USED THEN CAN'T USE JRST ERRSX ;HISEG OR TWOSEG > CALL HIGHQ ;SET CURRENT PROGRAM BREAK CALL COUTD ;DUMP CURRENT TYPE OF BLOCK SKIPN HISNSW ;IF WE HAVE SEEN IT BEFORE SKIPE HIGH ;OR ANY RELOC CODE PUT OUT TRO ER,ERRQ ;FLAG AS AN ERROR CALL BYPASS ;[664] GO GET EXPRESSION TLO IO,IORPTC CALL EVALXQ ;CHECK FOR EXTERNAL ANDCMI AC0,777 ;ONLY ALLOWED TO START ON NEW P BOUND HRRZM AC0,LOCA ;SET LOC COUNTERS HRRZM AC0,LOCO MOVEI RC,1 ;ASSUME RELOCATABLE RET TWSEG0: CALL HISEG1 ;COMMON CODE JUMPN AC0,.+2 ;ARGUMENT SEEN MOVEI AC0,400000 ;ASSUME 400000 HRRZM AC0,HMIN ;SET OFSET OF HIGH SEG. HRRZM AC0,HHIGH ;IN CASE NO HISEG CODE TLOA AC0,(1B0) ;SIGNAL TWO SEGMENTS AND SKIP HISEG0: CALL HISEG1 ;COMMON CODE HISEG2: MOVEM AC0,SVTYP3 ;SAVE THE HISEG ARG MOVEM RC,MODA ;SET MODES MOVEM RC,MODO SETOM HISNSW ;WE HAVE ALREADY PUT ONE OUT JRST BLOCK2 ;MAKE LISTING HAPPEN RIGHT IFN FORMSW,< ONFORM: HRRES HWFMT ;ALLOW MULTI-FORMAT LISTING RET OFFORM: HRROS HWFMT ;HALF-WORD FORMAT ONLY RET > IFE FORMSW,< SYN CPOPJ,ONFORM SYN CPOPJ,OFFORM> HIGHQ: HIGHQ1: MOVE V,LOCO ;GET ASSEMBLY LOCATION SKIPN MODO ;IF ASSEMBLY MODE IS ABSOLUTE JRST [CAMLE V,ABSHI ;RECORED ABS HIGHEST ALSO MOVEM V,ABSHI RET] SKIPE HMIN ;IS IT A TWO SEGMENT PROGRAM? JRST [CAMGE V,HMIN ;YES,IS THIS HIGH SEG.? JRST .+1 ;NO,STORE LOW SEGMENT CAMLE V,HHIGH ;YES,IS IT GREATER THAN "HHIGH"? MOVEM V,HHIGH ;YES,REPLACE WITH LARGER VALUE RET] CAMLE V,HIGH ;IS IT GREATER THAN "HIGH"? MOVEM V,HIGH ;YES, REPLACE WITH LARGER VALUE RET ONML: TLZA FR,MWLFLG ;MULTI-WORD LITERALS OK OFFML: TLO FR,MWLFLG ;NO RET OFFSYM: SETOM IONSYM ;SUPRESS SYMBOL TABLE LISTING RET SUPRE0: CALL GETSYM ;GET A SYMBOL TO SUPRES JRST SUPRE1 ;ERROR CALL SSRCH ;SYMBOL ONLY JRST SUPRE1 ;GIVE ERROR MESSAGE CALL SUPSYM ;SEE IF "!" SEEN TLOA ARG,SUPRBT ;SET THE SUPRESS BIT SUPRE1: TROA ER,ERRA IORM ARG,(SX) ;PUT BACK JUMPCM SUPRE0 ;ANY MORE? JRST SUPRS1 SUPRSA: CALL LOOKUP ;SUPRESS ALL MOVSI ARG,SUPRBT IORM ARG,(SX) SUPRS1: SETZM EXTPNT ;JUST IN CASE WE LOOKED ONE UP IFN FTPSECT,< ;[575] TLZ IO,RSASSW ;... > RET XPUNG0: JUMP1 CPOPJ ;[664] CALL LOOKUP MOVE ARG,(SX) ;GET SYMBOL FLAGS TLNN ARG,INTF!ENTF!EXTF!SPTR TLOA ARG,SUPRBT ;LOCAL SYMBOL,SO SUPPRESS IT SETZM EXTPNT IFN FTPSECT,< ;[575] TLZ IO,RSASSW ;... > MOVEM ARG,(SX) ;RESTORE FLAGS RET NODDT0: CALL GETSYM ;GET A SYMBOL TO SUPRES JRST NODDT1 ;ERROR CALL SSRCH ;SYMBOL ONLY JRST [CALL MSRCH ;[670] ALLOW OPDEF JRST NODDT1 ;[670] OTHERWISE GIVE ERROR TLNE ARG,OPDF ;[670] JRST .+1 ;[670] JRST NODDT1] ;[670] CALL SUPSYM ;SEE IF "!" SEEN TLOA ARG,NOOUTF ;SET THE NO-DDT BIT NODDT1: TROA ER,ERRA IORM ARG,(SX) ;PUT BACK JUMPCM NODDT0 ;ANY MORE? JRST SUPRS1 SUPSYM: CAIE C,'!' ;WANT NO DDT OUTPUT FOR THIS SYMBOL? RET ;NO TLO ARG,NOOUTF ;YES, SET FLAG PJRST BYPASS ;[664] SKIP "!" AND RETURN ; .CREF SYMBOL,SYMBOL,ETC ONCRF: CALL GETSYM ;SEE IF A SYMBOL SPECIFIED JRST [MOVSI AC0,IONCRF ;NO, PUT FLAG BACK TRZ ER,ERRA ;CLEAR "A" ERROR TLZ IO,DEFCRS ;CLEAR ANY WAITING DEFINING OCCURENCES JRST IORSET] ONCRF0: CALL SEARCH ;GENERAL SEARCH JRST ONCRFE ;ERROR MOVSI ARG,NCRF ;NO CREF FLAG IN ARG ANDCAM ARG,(SX) ;TURN OFF NO CREF BIT CAMN AC0,1(SX) ;OTHER ENTRY IN SYMBOL TABLE? ANDCAM ARG,2(SX) ;TURN OFF NCRF CAMN AC0,-3(SX) ;OTHER ENTRY IN SYMBOL TABLE ANDCAM ARG,-2(SX) ;TURN OFF NCRF CAIA ONCRFE: TRO ER,ERRA ;SET ERROR CONDITION JUMPNC SUPRS1 ;GIVE UP IF NO MORE CALL GETSYM ;GET NEXT SYMBOL JRST ONCRFE ;ERROR JRST ONCRF0 ; .XCREF SYMBOL,SYMBOL,ETC OFFCRF: CALL GETSYM ;SEE IF A SYMBOL SPECIFIED JRST [MOVSI AC0,IONCRF ;PUT FLAG BACK TRZ ER,ERRA ;CLEAR "A" ERROR JUMP1 CPOPJ ;[1063] EXIT ON PASS1 TDO IO,AC0 ;[1063] SET APPROPRIATE FLAGS RET] ;[1063] OFCRF0: CALL SEARCH ;GENERAL SEARCH JRST OFCRFE ;ERROR MOVSI ARG,NCRF ;NO CREF FLAG IN ARG IORM ARG,(SX) ;SET NO CREF BIT CAMN AC0,1(SX) ;OTHER ENTRY IN SYMBOL TABLE? IORM ARG,2(SX) ;SET BIT CAMN AC0,-3(SX) ;OTHER ENTRY IN SYMBOL TABLE? IORM ARG,-2(SX) ;SET BIT CAIA OFCRFE: TRO ER,ERRA ;FLAG ERROR JUMPNC SUPRS1 ;GIVE UP IF NO MORE SYMBOLS CALL GETSYM ;GET NEXT SYMBOL JRST OFCRFE ;ERROR JRST OFCRF0 TITLE0: SKIPE TTLFND ;[1123] TITLE ALREADY SEEN FOR THIS MODULE? JRST [ TRO ER,ERRQ ;[1123] YES - GENERATE Q ERROR JRST REMAR0] ;[1123] AND IGNORE THE REST MOVEI SX,.TBUF HRRI AC0,TBUF CALL SUBTT1 ;GO READ IT MOVEM SX,TCNT ;SAVE COUNT OF CHARS. WRITTEN SETOM TTLFND ;[1123] INDICATE TITLE SEEN JUMP2 REMAR0 ;[1123] SKIP REST DURING PASS 2 SKIPE UNIVSN ;[1123] WAS IT A UNIVERSAL? CALL ADDUNV ;[1123] YES - ADD TO TABLE IFN CCLSW, ;PRINT NAME IF FIRST ONE IFE CCLSW, ;EXIT OTHERWISE SUBTT0: JUMP1 [SKIPE SBUF ;PASS1, FIRST SUBTTL? JRST REMAR0 ;NO, MOVE SX,PAGENO ;YES, CHECK PAGE NUMBER CAIE SX,1 ;PAGE 1? JRST REMAR0 ;NO, JRST .+1] ;YES, MOVEI SX,.SBUF HRRI AC0,SBUF SUBTT1: CALL BYPASS ;[664] BYPASS LEADING BLANKS TLO IO,IORPTC SUBTT3: CALL CHARAC ;GET ASCII CHARACTER IDPB C,AC0 ;STORE IN BLOCK CAIGE C,40 ;TEST FOR TERMINATOR CAIN C,HT SOJG SX,SUBTT3 ;TEST FOR BUFFER FULL DPB RC,AC0 ;END, STORE TERMINATOR SOJA SX,REMAR1 ;COUNT NULL AND EAT UP ANY REMAINING CHARS. IFN CCLSW,< PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG RET PUSH P,AC0 ;SAVE AC0 DMN PUSH P,RC ;AND RC MOVE AC0,[POINT 7,TBUF] MOVE SX,[POINT 7,OTBUF] MOVEI RC,6 ;MAX OF SIX CHRS MOVEI C,HT ;START WITH A TAB IDPB C,SX PN1: ILDB C,AC0 CAILE C," " ;CHECK FOR LEGAL CAILE C,"Z"+40 ;CHECK AGAINST LOWER CASE Z JRST PN2 PUSH P,C ;SAVE CHAR CAILE C,137 ;GET RADIX-50 VALUE FROM CSTAT SUBI C,40 SUBI C,40 LDB CS,[POINT 6,CSTAT(C),23] POP P,C SKIPN CS ;RADIX-50? JRST PN2 ;NO, TREAT AS TERMINATOR IDPB C,SX ;PUT IN OUTPUT BUFFER SOJG RC,PN1 ;GET MORE PN2: MOVEI C,CR ;END WITH CR-LF IDPB C,SX MOVEI C,LF IDPB C,SX SETZ C, ;TERMINATOR IDPB C,SX TTCALL 3,OTBUF POP P,RC POP P,AC0 ;RESTORE AC0 DMN RET > SYN0: CALL GETSYM ;GET THE FIRST SYMBOL JRST ERRAX ;ERROR, EXIT CALL MSRCH ;TRY FOR MACRO/OPDEF JRST SYN3 ;NO, TRY FOR OPERAND SYN1: MOVEI SX,MSRCH ;YES, SET FLAG SYN2: JUMPNC ERRAX ;ERROR IF NO COMMA PUSH P,ARG ;SAVE SOME REGISTERS PUSH P,RC PUSH P,V PUSH P,SX ;SAVE SEARCH ROUTINE CALL GETSYM ;GET THE SECOND SYMBOL JRST [SUB P,[4,,4] ;PUT STACK BACK RET] ;AND GIVE UP TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS TLO IO,IONCRF ;[1143] DO NOT CREF FIRST SEARCH CALL OPCFIX ;[736] FIX UP SYMTAB IF FORW-REF'ED TLZ IO,IONCRF ;[1143] ALLOW CREFFING AGAIN TLO IO,DEFCRS ;[1143] INDICATE DEFINITION POP P,SX ;RESTORE SEARCH ROUTINE CALL @SX ;SEARCH FOR SECOND SYMBOL JFCL TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN POP P,V ;RESTORE VALUES POP P,RC POP P,ARG TLNE ARG,MACF ;MACRO? CALL REFINC ;YES, INCREMENT REFERENCE JRST INSERT ;INSERT AND EXIT SYN3: CALL SSRCH ;SEARCH FOR OPERAND JRST SYN4 ;NOT FOUND, TRY OP CODE TLO ARG,SYNF ;FLAG AS SYNONYM TLNE ARG,EXTF ;EXTERNAL? HRRZ V,ARG ;YES, RELPACE WITH POINTER MOVEI SX,SSRCH ;SET FLAG TLNN ARG,VARF ;DO NOT LET HIM SYN A VARIABLE JRST SYN2 JRST ERRAX SYN4: CALL OPTSCH ;SEARCH FOR OP-CODE JRST ERRAX ;NOT FOUND, EXIT WITH ERROR MOVSI ARG,SYNF ;FLAG AS SYNONYM SKIPN UWVER ;WRITING A UNIVERSAL FILE? JRST SYN1 ;NO, MOVE AC1,FREE ;YES, GET A FREE WORD ADDI AC1,1 CAML AC1,SYMBOL ;NO MORE ROOM? CALL XCEEDS ;GET MORE ROOM EXCH AC1,FREE ;UPDATE FREE MOVEM AC0,(AC1) ;KEEP THE SIXBIT OPERATOR MOVE V,AC0 HRR ARG,AC1 ;KEEP THE POINTER TLO ARG,SIXF ;SET FLAGS FOR POINTER TO SIXBIT BITON USYN,UWVER ;SET NEW-SYN-HANDLING BIT IN UNV VERSION # JRST SYN1 ;CONTINUE... PURGE0: CALL GETSYM ;GET A MNEMONIC JRST [TRZ ER,ERRA ;CLEAR ERROR RET] ;AND RETURN CALL MSRCH ;SEARCH MACRO SYMBOL TABLE JRST PURGE2 ;NOT FOUND, TRY SYMBOLS PUSH P,CS ;SAVE CS AS IT MAY GET GARBAGED TLNE ARG,MACF ;MACRO? CALL REFDEC ;YES, DECREMENT THE REFERENCE POP P,CS JRST PURGE4 ;REMOVE SYMBOL FROM TABLE PURGE2: CALL SSRCH ;TRY OPERAND SYMBOL TABLE JRST PURGE5 ;NOT FOUND GET NEXT SYMBOL PURGE4: CALL REMOVE ;REMOVE FROM THE SYMBOL TABLE SETZM EXTPNT ;IN CASE UNDEF OR EXT SYMBOL PURGE5: JUMPCM PURGE0 RET ;EXIT OPD1: TLNE ARG,UNDF ;IF OPDEF IS UNDEFINED TRO ER,ERRO ;GIVE "O" ERROR OPD: MOVE AC0,V ;PUT VALUE IN AC0 IFE POLISH,< JRST OP> ;[772] IFN POLISH,< ;[772] JUMPGE RC,OP ;[772] PUSH P,[POLFWF] ;[772] HERE ONLY IF POLISH OPDEF REFC'ED POP P,POLTYP ;[772] MUST BE FULL WORD FIXUP CALL POLPOP ;[772] GO FINISH UP THE POLISH STACK SETZB RC,EXTPNT ;[772] CLEAR RELOCATION AND EXTERNAL PTR JRST STOW> ;[772] EXIT THRU STOW IOP: MOVSI AC2,(POINT 9,0(P),11) IFE FORMSW,< TLOA IO,IOIOPF> ;SET "IOP SEEN" AND SKIP IFN FORMSW,< PUSH P,IOFORM ;USE I/O FORM JUMPAD .+2 ;IF IN ADDRESS FIELD, SKIP SETOM IOSEEN ;SIGNAL FOR BOUT TO ADJUST FIELDS TLO IO,IOIOPF ;SET "IOP" SEEN JRST OP+2> OP: MOVSI AC2,(POINT 4,0(P),12) IFN FORMSW,< PUSH P,INFORM> ;USE INST. FORM IFN POLISH,< TRZN FRR,EXPSW ;[634] SKIPE IF DOING EXP SETOM POLTYP ;[634] REST MUST BE RIGHT HALF FIXUP > TLO IO,FLDSW ;[634] WE HAVE A OPTR, REST IS ADDR. PUSH P,RC PUSH P,AC0 ;STACK CODE PUSH P,AC2 CALL EVALEX ;EVALUATE FIRST EXPRESSION POP P,AC2 JUMPNC OP2 OP1B: CALL GETCHR ;GET A CHARACTER IFE FORMSW, ;PROCESS COMMA COMMA IN XWD IFN FORMSW, ;PROCESS COMMA COMMA IN XWD TLO IO,IORPTC ;NOT A COMMA,REPEAT IT TLZE FR,INDSW ;[1076] HAS '@' BEEN SEEN? TRO ER,ERRQ ;[1076] YES - CLEAR AND GIVE 'Q' ERROR LDB AC1,AC2 ADD AC1,AC0 DPB AC1,AC2 IFN POLISH,< TLNN FR,POLSW ;DON'T ALLOW EXTERNAL ACS > JUMPE RC,OP1A ;EXTERNAL OR RELOCATABLE? CALL QEXT ;YES, DETERMINE WHICH AND FLAG AN ERROR OP1A: CALL EVALEX ;GET ADDRESS PART OP2: CALL EVADR ;EVALUATE STANDARD ADDRESS OP3: POP P,AC0 ;PUT IN AC0 POP P,RC JUMPL RC,OP3A ;[1012] JUMP IF POLISH TLNN RC,-2 ;[1012] LEFT EXTERNAL? SKIPA ;[1012] NO, HLLM RC,EXTPNT ;[1047][1012] YES, RECOVER EXTPNT FROM RC OP3A: ;[1012] IFN FORMSW,< POP P,AC1> ;GET FORM WORD IFN POLISH,< JUMPGE RC,OP4 ;[624] JUMP IF NOT POLISH SKIPN INOPDF ;[624] OPDEF? JRST OP4 ;[624] NO, JUMP MOVE PS,CSTAT+'+' ;[624] YES, ADD OP FIELD AND ADR FILED CALL CFORCP ;[706][624] IN A POLISH BLOCK > OP4: SETZ PR, ;[747] SKIPE (P) ;[624] CAME FROM EVALCM? JRST STOW ;NO,STOW CODE AND EXIT POP P,AC1 ;YES,EXIT IMMEDIATELY RET IFN FORMSW,< INFORM: BYTE (9) 1 (4) 1 (1) 1 (4) 1 (18) 1 IOFORM: BYTE (3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1 > EVADR: ;EVALUATE STANDARD ADDRESS IFE IIISW, ;NO,FLAG Q ERROR ADD AC0,-1(P) ;ADD ADDRESS PORTIONS HLL AC0,-1(P) ;GET LEFT HALF TLZE FR,INDSW ;INDIRECT BIT? TLO AC0,(Z @) ;YES, PUT IT IN MOVEM AC0,-1(P) ;RE-STACK CODE JUMPE RC,[MOVE RC,-2(P) ;[767] UPDATE RELOCATION JRST EVADR4] ;[767] SKIPE -2(P) ;[767] MAKE SURE ONE OF THEM IS ZERO JRST [ TDNE RC,-2(P) ;[767] OTHERWISE ,MAKE SURE NOT IN THE SAME HALF TROA ER,ERRR ;[767] STUFF IN SAME HALF, RELOCATION ERROR ADD RC,-2(P) ;[767] DIFFERENT HALVES, ADD THEM JRST .+1] ;[767] MOVEM RC,-2(P) ;[767] EVADR4: ;[767] IFN POLISH,< JUMPGE RC,EVADR1 ;[634] JUMP IF NOT POLISH JUMPE AC0,EVADR2 ;[634] DOING POLISH, JUMP IF NO CODE SKIPE INANGL ;[730] IN <...>? JRST EVADR2 ;[730] YES, PUSH P,RC ;[634] THERE IS SOMETHING, WE NEED AN AC HRRZ RC,POLTYP ;[634] FOR THE TYPE OF FIXUPS CAIN RC,-3 ;[634] FULLWORD? JRST [TRO ER,ERRQ ;[634] YES, ERROR JRST EVADR3] ;[634] JUMP CAIN RC,-1 ;[634] RIGHT HALF FIXUP? TRNN AC0,-1 ;[634] AND STUFF IN RIGHT HALF? SKIPA ;[634] NO, O.K. THEN JRST [TRO ER,ERRQ ;[634] YES, ERROR JRST EVADR3] ;[634] JUMP CAIN RC,-2 ;[634] LEFT HALF FIXUP? TLNN AC0,-1 ;[634] AND STUFF IN LEFT HALF? SKIPA ;[634] NO, TRO ER,ERRQ ;[634] YES, ERROR EVADR3: POP P,RC ;[634] RESTORE AC RC EVADR2: SKIPN INOPDF ;[634] POLISH IN OPDEF? SKIPE INASGN ;[634] NO, DOING ASSIGN? MOVEM RC,-2(P) ;[634] YES, USED POLISH PTR > EVADR1: ;[634] IFN POLISH,< ;[1114] SKIPE PLHIDX ;[1114] LH INDEX VALUE SAVED FROM POLISH? JRST [ MOVE AC0,PIDXVL ;[1114] YES - GET VALUE MOVE RC,PIDXRC ;[1114] AND RC TRNE RC,-2 ;[1114] EXTERNAL PTR? HRLM RC,EXTPNT ;[1114] YES - FIXUP EXTERN PTR JRST EVADR6] ;[1114] REJOIN INDEX CODE > ;[1114] CAIE C,10 ;"("? RET ;NO, EXIT TRO FRR,IDXSW ;[1107] SET OP INDEXING IFN POLISH,< ;[1107] PUSH P,POLTYP ;[1107] SAVE FIXUP TYPE PUSH P,[POLFWF] ;[1107] DO FULL WORD FIXUP POP P,POLTYP ;[1107] IN CASE OF POLISH > ;[1107] MOVSS EXTPNT ;WFW CALL EVALCM ;EVALUATE MOVSS EXTPNT ;WFW IFN POLISH,< ;[1107] POP P,POLTYP ;[1107] RESTORE FIXUP TYPE TRNE FRR,FWPSW ;[1107] WAS POLISH GENERATED? TRO ER,ERRR ;[1107] YES - FLAG ERROR > ;[1107] TRZ FRR,IDXSW ;[1107] CLEAR OP INDEXING EVADR6: ;[1114] HANDLE THE INDEXING EXPRESSION MOVSS V,AC0 ;SWAP HALVES IFE IIISW, ;NO, SWAP RC INTO ARG IFN IIISW, ADD V,-1(P) ;ADD RIGHT HALVES ADD ARG,-2(P) HRRM V,-1(P) ;UPDATE WITHOUT CARRY HRRM ARG,-2(P) HLLZS AC0 ;PREPARE LEFT HALVES HLLZS RC IFE IIISW, ;RETURN TO ADD ADDM AC0,-1(P) ;MERGE WITH PREVIOUS VALUE ADDM RC,-2(P) IFN POLISH,< ;[1114] SKIPE PLHIDX ;[1114] LH INDEX SAVED FROM POLISH? JRST [ SETZM PLHIDX ;[1114] YES - CLEAR FLAG TLO IO,IORPTC ;[1114] NEXT CHAR MAY BE SIGNIFICANT JRST BYPASS] ;[1114] AND SKIP CHECK > ;[1114] CAIE C,11 ;")"? JRST ERRAX ;NO, FLAG ERROR ;YES, BYPASS PARENTHESIS BYPASS: CALL GETCHR ;[664] BYPAS2: JUMPE C,.-1 ;SKIP TRAILING BLANKS RET ;EXIT IFE IIISW,< OP2A1: EXCH RC,-2(P) ;GET STORED CODE TLNN RC,-1 ;OK IF ALL ZERO JRST OP2A2 ;OK SO RETURN TLC RC,-1 ;CHANGE ALL ONES TO ZEROS TLCE RC,-1 ;OK IF ALL ONES TRO ER,ERRQ ;OTHERWISE A "Q" ERROR OP2A2: EXCH RC,-2(P) ;GET RC,BACK RET> ;AND RETURN EXPRES: HRLZ AC0,CURADX ;[613] FUDGE FOR OCT0 OCT0: PUSH P,CURADX ;[613] PUSH CURRENT RADIX HLRM AC0,CURADX ;[613] IFN POLISH,< HRREI AC0,POLFWF ;PRESET POLISH TYPE SINCE WE MOVEM AC0,POLTYP ;NEED FULL WORD FIXUPS IF POLISH TRO FRR,EXPSW ;[634] FLAG FOR DOING EXP, DON'T CHANGE FWF > OCT1: CALL EVALEX ;EVALUATE TLZE FR,INDSW ;[1115] INDIRECT DANGLING? TRO ER,ERRQ ;[1115] ERROR IF NOT ENCLOSED IN BRACKETS IFN POLISH,< TLNN RC,-1 ;[1106] DO WE HAVE ABSOLUTE LEFT HALF TRNN RC,-2 ;[1106] AND EXTERNAL RIGHT HALF JRST OCT1A ;[1106] NO - DON'T DO FULLWORD TLNN AC0,-1 ;[1106] WAS ABSOLUTE SPECIFIED CALL OCTFW ;[1106] NO - CAN DO FULL WORD FIXUP OCT1A: ;[1106] > IFN FORMSW,< MOVE AC1,HWFORM> CALL STOW ;STOW CODE JUMPCM OCT1 POP P,CURADX ;[613] YES, RESTORE RADIX IFN POLISH,< SETZM POLTYP ;CLEAR FLAG > RET ;EXIT ;HERE TO GENERATE FULL WORD FIXUPS FOR EXP EXTERN ;NOTE THIS GENERATES BLOCK TYPE 11 POLISH FIXUPS ;THESE CANNOT BE LOADER BY LOADER UNLESS FAILSW IS ON IFN POLISH,< OCTFW: JUMP1 [ TRO ER,ERRF RET] ;IGNORE ON PASS1 MOVE PV,FREE ;COPY CODE FROM POLPOP EXCH PV,POLIST ;TO SET UP A NEW BLOCK CALL POLSTR ;STORE POINTER TO LAST IFN FTPSECT,< ;[641] SKIPN SGNCUR ;[641] DOING PSECTS? JRST OCTFW1 ;[641] NO, HRRO PV,SGNCUR ;[641] YES, GET CURRENT PSECT NUMBER TRO PV,400000 ;[641] MAKE IT INTO PSECT INDEX CALL POLSTR ;[641] AND STORE IN BLOCK OCTFW1: > SKIPE CV ;[1110] IF EXTERNAL + VALUE JRST [ HRROI PV,3 ;[1110] POLISH ADD OPERATION CALL POLSTR ;[1110] STORE IT MOVEI PV,1 ;[1110] 36 BIT VALUE CALL POLSTR ;[1110] STORE SETZ PV, ;[1110] ABSOLUTE RELOCATION CALL POLSTR ;[1110] STORE MOVE PV,CV ;[1110] VALUE CALL POLSTR ;[1110] STORE IT JRST .+1] ;[1110] MOVE PV,EXTPNT ;GET POINTER TO EXTERNAL SYMBOL CALL POLFS2 ;STORE EXTERNAL JRST POLOCT ;FIXUP ADDRESS, AND RETURN > SIXB10: MOVSI RC,(POINT 6,AC0) ;SET UP POINTER MOVEI AC0,0 ;CLEAR WORD SIXB20: CALL CHARL ;GET NEXT CHARACTER CAMN C,SX ;IS THIS PRESET DELIMITER? IFE FORMSW,< JRST ASC60> ;YES IFN FORMSW,< JRST [ CALL BYPASS ;[664] ANDCM RC,STPX MOVE AC1,SXFORM SETZM INTXT ;NO LONGER IN TEXT TRZN FRR,WD2SW ;[607] DOING 2ND WORD? JRST STOWZ ;[607] NO, GENERATE A NULL WORD JUMPGE RC,STOWZ RET]> CAIL C,"A"+40 CAILE C,"Z"+40 JRST .+2 ;[701] TRZA C,100 ;[701] CONVERT LOWER CASE TO SIXBIT SUBI C,40 ;[701] CONVERT UC TO SIXBIT JUMPL C,SIXB30 ;[701] IF NOT LEGAL SIXBIT, CAILE C,77 ;[701] FLAG A-ERROR AND TERMINATE JRST SIXB30 ;[701] IDPB C,RC ;NO, DEPOSIT THE BYTE TLNE RC,770000 ;IS THE WORD FULL? JRST SIXB20 ;NO, GET NEXT CHARACTER IFN FORMSW,< SKIPA AC1,SXFORM ;SIXBIT FORM SXFORM: BYTE (6) 1,1,1,1,1,1 > CALL STOWZ ;YES, STORE TRO FRR,WD2SW ;[607] SECOND WORD JRST SIXB10 ;GET NEXT WORD SIXB30: TRO ER,ERRA ;[701] TRZ FRR,WD2SW ;[1024] CLEAR 2ND-WORD SWITCH TDZ CS,CS ;[701] IN CASE NESTED MOVE AC1,SXFORM ;[701] JRST ASC51 ;[701] %TEXT1: TLC AC0,240000 ;CONVERT .TEXT TO COMMENT ON PASS1 ASCII0: HLLZ SDEL,AC0 ;STORE ASCII/ASCIZ FLAG ASC10: CALL CHARL ;GET FIRST NON-BLANK SETZM NOTFL ;INITIALIZE TO FIRST LINE CAIE C," " CAIN C,HT JRST ASC10 CAIG C,CR ;CHECK FOR CRRET AS DELIM CAIGE C,LF CAIA JRST ERRAX FORERR (SX,TXT) SETOM INTXT MOVE SX,C ;SAVE FOR COMPARISON JUMPG SDEL,SIXB10 ;BRANCH IF SIXBIT ASC20: MOVSI RC,(POINT 7,AC0) ;SET UP POINTER TLNE SDEL,200000 ;THIS BIT (AND BIT0) IN FOR COMMENT MOVSI RC,440000 ;SO NOTHING WILL BE DEPOSITED IFE IIISW, ;CLEAR WORD IFN IIISW,;YES, A WORD FULL OF BACKSPACES ASC30: CALL CHARL ;GET ASCII CHARACTER AND LIST JUMP1 ASC31 ;JUMP ON PASS1 SKIPL NOTFL ;FIRST LINE? AOS NOTFL ;YES, COUNT CHARS IF FIRST LINE CAIG C,FF ;LF, FF, OR VT? CAIGE C,LF JRST ASC31 ;JUMP IF NO SKIPE LITLVL ;JUMP IF LITERAL AND NOT LITLST SKIPE LITLST JRST .+2 ;ELSE JRST ASC31 EXCH C,NOTFL ;EXCHANGE TEMPORARILY CAILE C,5 ;WE HAVE AT LEAST 5 CHARS? SETO C, ;YES, NO LONGER FIRST LINE EXCH C,NOTFL ;RESTORE FROM THE EXCHANGE ASC31: CAMN C,SX ;TEST FOR DELIMITER JRST ASC50 ;FOUND IDPB C,RC ;DEPOSIT BYTE TLNE RC,760000 ;HAVE WE FINISHED WORD? JRST ASC30 ;NO,GET NEXT CHARACTER IFN FORMSW,< SKIPA AC1,ASCIIF ;USE ASCII FORM WORD ASCIIF: BYTE (7) 1,1,1,1,1 > TLNE SDEL,040000 ;.TEXT ? JRST [CALL STOTXT ;YES, STORE IN REL FILE JRST ASC20] ;CONTINUE CALL STOWZ ;YES, STOW IT JRST ASC20 ;GET NEXT WORD ASC50: TDZ RC,SDEL ;TEST FOR ASCIIZ IFE FORMSW, ;[1024] CALL BYPASS ;[664] POLISH OFF TERMINATOR SKIPGE NOTFL ;FIRST LINE? SOS NOTFL ;NO, MAKE IT LAST LINE IFN FORMSW,< MOVE AC1,ASCIIF> ;USE ASCII FORM WORD IFN IIISW, ;NO EXTRA WORDS FOR ASCID ASC51: ANDCM RC,STPX ;[701] STORE AT LEAST ONE WORD SETZM INTXT ;[701] FLAG OUT OF IT TLNN SDEL,200000 ;GET OUT WITHOUT STORING JUMPGE RC,[TLNN SDEL,040000 ;.TEXT? JRST STOWZ ;NO, STOW JRST STOTXT] ;YES, STORE IN REL FILE RET ;ASCII, NO BYTES STORED, SO EXIT ; .TEXT PSEUDO-OP %TEXT0: JUMP1 %TEXT1 ;IGNORE ON PASS1 PUSH P,BLKTYP ;SAVE CURRENT TYPE CALL COUTD ;DUMP CURRENT BLOCK HLLZ SDEL,AC0 ;FLAG BITS FOR ASCII SETZM BLKTYP ;DON'T KNOW IT YET CALL ASC10 ;START PROCESSING CALL STOTXD ;FINISH BLOCK POP P,BLKTYP ;RESTORE PREVIOUS RET STOTXT: SKIPN BLKTYP ;FIRST WORD? JRST [MOVEM AC0,BLKTYP RET] ;SAVE AS BLOCK TYPE SKIPN COUTRB ;2ND WORD JRST [MOVEM AC0,COUTRB RET] AOS C,COUTX ;NO, JUST STORE AS NORMAL MOVEM AC0,COUTDB(C) CAIE C,^D17 ;BUFFER FULL? RET ;NO STOTXD: SKIPN C,BLKTYP ;SEE IF ANY TEXT TO OUTPUT JRST COUTI ;NO JUST CLEAR COUNTS AOS COUTX ;ACCOUNT FOR STARTING FROM -1 SETZM BLKTYP ;CLEAR BLOCKTYPE WORD FOR NEXT BLOCK TRNN C,177_1 ;SEE IF RELOCATION WORD IS NEEDED AOS COUTRB ;FIRST WORD OF BLOCK WAS NOT FULL, ;2ND WAS 0, PUT THE LSN BIT ON FOR ;COUTD2 TO CHECK SO THERE WON'T BE ;AN EXTRA 0 WORD IN THE FILE JRST COUTT ;DUMP BLOCK POINT0: IFN FORMSW,< PUSH P,BPFORM> ;USE BYTE POINTER FORM WORD PUSH P,RC ;STACK REGISTERS PUSH P,AC0 IFN POLISH,< TRO FRR,NOPSW> ;[751] NO POLISH FOR SIZE CALL EVAL10 ;EVALUATE RADIX 10 IFN POLISH,< TRZ FRR,NOPSW> ;[751] DPB AC0,[POINT 6,0(P),11] ;STORE BYTE SIZE JUMPNC POINT2 IFN POLISH,< SETOM POLTYP> ;FORCE RIGHT-HALF FIXUP IF POLISH CALL EVALEX ;NO, GET ADDRESS CALL EVADR ;EVALUATE STANDARD ADDRESS IFN POLISH,< SETZM POLTYP> ;BACK TO NORMAL JUMPNC POINT2 IFN POLISH,< TRO FRR,NOPSW> ;[751] NO POLISH FOR BYTE POSITION CALL EVAL10 ;EVALUATE RADIX 10 IFN POLISH, ;[751] CLEAR FLAG TLNE IO,NUMSW ;IF NUMERIC TDCA AC0,[-1] ;POSITION=D35-RHB POINT2: MOVEI AC0,0 ;OTHERWISE SET TO D36 ADDI AC0,^D36 LSH AC0,^D30 ADDM AC0,0(P) ;UPDATE VALUE JRST OP3 IFN FORMSW,< BPFORM: BYTE (6) 1,1 (2) 1 (4) 1 (18) 1 > IFN POLISH,< ;USE TO FORCE POLISH OPERATION CONTAINED IN PS ; RC/ POL PTR ; AC0/ CONSTANT ; PS/ OPERATOR ; FORCEP: MOVEM RC,SAVRC ;[773] SETZB RC,SAVCV ;[773] ; JRST FORCPP ;[733] ;THIS IS A GENERALIZE FORCEP-- ;ASSUMES CV,RC,SAVCV, SAVRC ARE SETUP FORCPP: PUSH P,[TNODE,,0] ;[706] PUSH P,SAVCV ;[706] POPPED AS PV PUSH P,SAVRC ;[773] POPPED AS PR PUSH P,PS ;[733] MOVE CS,[11,33] ;[733] FAKE END JRST EVGETD ;[733] CFORCP: PUSH P,CS ;[706] CS GETS DESTROYED CALL FORCEP ;[706] POP P,CS ;[706] RET ;[706] ;HERE TO NEGATE A POLISH ; RC/ POL PTR ;SETS UP: ; AC0/ 0 ; PS/ '-' ; FNEGP: SETZB AC0,SAVCV ;[773] SETZM SAVRC ;[773] MOVE PS,CSTAT+'-' ;[727] PUSH P,CS ;[727] CALL FORCPP ;[773] POP P,CS ;[727] RET ;[727] > XWD0: IFN FORMSW,< PUSH P,HWFORM> ;USE HALF WORD FORM PUSH P,RC PUSH P,AC0 ;STORE ZERO ON STACK IFN POLISH,< MOVNI AC0,2 ;FORCE LEFT HALF STORE MOVEM AC0,POLTYP ;IF POLISH > CALL EVALEX ;EVALUATE EXPRESSION XWD5: ;[614] IFN POLISH,< SETOM INXWD ;[1010] DOING XWD TLNN FR,POLSW ;[614] USED POLISH? JRST XWD1 ;[614] NO, SETZM EXTPNT ;CLEAR RHS NOW TRZ FRR,FWPSW ;[614] NOT FULL WORD TRO FRR,LHPSW ;[614] MAKE IT LEFT HALF FIXUP XWD1: SKIPE INANGL ;[706] IF IN ANGBRKTS, SEE IF POL CALL [ PUSH P,RC ;[1013][706] NEED AN AC MOVE RC,INANGL ;[1013][706] IF INANGL IS A PTR, CAMN RC,[-1] ;[1013][706] JRST [ POP P,RC ;[1013] -1, RECOVER RC RET] ;[1013] AND RETURN CALL MOVSTK ;[1013] MOVE TO FREE SPACE MOVEM RC,INANGL ;[1050] RECOVER PREVIOUS INANGL MOVEM RC,XWDANG ;[1013][706] AND SAVE IN XWDANG (FOR ANGPOL) POP P,RC ;[1013][706] RET] ;[706] XWD2:> ;[706] END IFN POLISH JUMPNC OP2 ;[706][614] SKIPN (P) ;ANY CODE YET? JRST XWD10 ;NO,USE VALUE IN AC0 JUMPE AC0,.+2 ;ANYTHING IN AC0? TRO ER,ERRQ ;YES,FLAG "Q"ERROR MOVE AC0,(P) ;USE PREVIOUS VALUE MOVE RC,-1(P) ;AND RELOCATION XWD10: TLNN AC0,-1 ;LEFT HALF SHOULD BE ZERO JRST XWD11 ;IT IS TLC AC0,-1 ;OR AT LEST ALL ONES TLCE AC0,-1 ;FOR XWD -1,-2 ETC TRO ER,ERRQ ;NO, WARN USER XWD11: HRLZM AC0,0(P) ;SET LEFT HALF HRLZM RC,-1(P) MOVSS EXTPNT ;WFW IFN POLISH,< SETOM POLTYP ;FORCE RHS FIXUP > JRST OP1A ;EXIT THROUGH OP IOWD0: IFE POLISH,< CALL EVALQ > ;EVALUATE AND TEST FOR EXTERNAL IFN POLISH,< SKIPN INANGL ;[730] IN ANGLE-BRACKETS? SETOM INIOWD ;[730] NO, MOVNI AC0,2 ;FORCE LEFT HALF STORE MOVEM AC0,POLTYP ;IF POLISH CALL EVALEX ;EVALUATE ALLOWING EXTERNS > ;[730] CAIN RC,1 ;[730] RELOCATABLE VALUE IFN POLISH,< ;[730] JRST IOWD02 ;[730] GO SET R-ERROR SKIPN AC1,INANGL ;[730] IN ANGLE-BRACKETS? JRST IOWD01 ;[730] NO, AOJGE AC1,IOWD01 ;[730] JUMP IF NOT POLISH MOVE RC,INANGL ;[730] UPDATE RC IOWD01: JUMPE RC,IOWD1 ;[730] DON'T BOTHER IF ABSOLUTE JUMP1 IOWD1 ;[730] DON'T BOTHER IN PASS1 CALL FNEGP ;[730] NEGATE EXTERNAL OR POLISH SKIPN INANGL ;[730] IN ANGLE-BRACKETS? JRST [ CALL POLSYM ;[730] NO, COMPLETE LH POLISH JRST IOWD1] ;[730] MOVE RC,INANGL ;[730] CALL MOVSTK ;[730] YES, MOVE TO FREE SPACE MOVEM RC,XWDANG ;[730] SAVE LH POLISH PTR MOVEM RC,INANGL ;[730] UPDATE INANGL SETZ RC, ;[730] JRST IOWD1 ;[730] IOWD02:> ;[730] TRO ER,ERRR ;[730] R-ERROR IOWD1: JUMPNC [TRZ ER,ERRR ;[730] IN CASE SET BEFORE SKIPN AC0 ;IF NZERO AND NO "," SEEN TRO ER,ERRQ ;TREAT AS Q ERROR IFN FORMSW,< MOVE AC1,HWFORM> ;USE HALF WORD FORM SOJA AC0,STOW] ;NO, TREAT AS RIGHT HALF MOVNS AC0 ;[730] NEGATE LEFT HALF PUSH P,AC0 ;YES, STACK LEFT HALF ;[730] FALL THRU ;HERE FOR RIGHT HALF SETZM EXTPNT ;[730] CLEAR EXTERNAL POINTER IFN POLISH,< SETZM POLTYP> ;RIGHT HALF STORE BY DEFAULT CALL EVALEX ;WFW IFN POLISH,< SKIPN AC1,INANGL ;[730] IN ANGLE BRACKETS? JRST IOWD11 ;[730] NO, CAMN AC1,XWDANG ;[730] YES, JRST IOWD12 ;[730] JUMP IF LH POLISH AOJGE AC1,IOWD12 ;[730] JUMP IF NOT POLISH MOVE RC,INANGL ;[730] GET POLISH PTR SKIPA ;[730] AND SKIP IOWD11: TLZE FR,POLSW ;[730] DOING POLISH? JRST [ CALL MOVSTK ;[730] YES, MOVE CURRENT POLISH TO FREE SPACE JRST IOWDRP] ;[730] DO RH-1 POLISH IOWD12: SKIPE RC ;[730] ABSOLUTE? JUMP2 [ SKIPN INANGL ;[730] NO, MUST BE REL OR EXT JUMPN AC0,.+1 ;[730] JUMP IF ADDITIVE GLOBAL NOT IN <> CAIN RC,1 ;[730] JUMP IF JRST .+1 ;[730] RELOCATABLE SETZM EXTPNT ;[730] EXTERNAL JRST IOWDRP] ;[730] GO DO RH-1 > SUBI AC0,1 IOWD2: POP P,AC1 ;RETRIEVE LEFT HALF HRL AC0,AC1 IFN FORMSW,< SKIPA AC1,HWFORM ;USE HALF WORD FORM HWFORM: BYTE (18) 1,1> ;END IFN FORMSW IFN POLISH,< SETZM INIOWD> ;[730] CLEAR IOWD FLAG JRST STOW ;STOW CODE AND EXIT ;HERE IF IOWD K,E OR IOWD K,POL SO THAT POLISH OF RH-1 IS NEEDED ; IFN POLISH,< ;[730] IOWDRP: MOVEI AC0,1 ;[730] MOVE PS,CSTAT+'-' ;[730] CALL CFORCP ;[730] GO DO IT SKIPE INANGL ;[730] MOVE RC,INANGL ;[730] CALL MOVSTK ;[730] SKIPN INANGL ;[730] IN ANGLE-BRACKETS? JRST IOWDR1 ;[730] NO, MOVEM RC,INANGL ;[730] SKIPA ;[737] CLEAR RC AND RETURN IOWDR1: CALL POLSYM ;[730] COMPLETE RH POLISH SETZ RC, ;[737] CLEAR RC JRST IOWD2 ;[730] > ;[730] BYTE0: CALL BYPASS ;[664] GET FIRST NON-BLANK IFN POLISH,< SETZM BYTEAC> ;[777] ACCUMULATED BYTE SIZE SO FAR CAIE C,10 ;"("? JRST ERRAX ;NO, FLAG ERROR AND EXIT SETOM BYTESW ;[1114] DOING BYTE PSEUDO-OP IFN FORMSW,< PUSH P,[1] MOVEI AC0,0> PUSH P,RC PUSH P,AC0 ;INITIALIZE STACK TO ZERO MOVSI ARG,(POINT -1,(P)) BYTE1: PUSH P,ARG CALL EVAL10 ;EVALUATE RADIX 10 POP P,ARG CAIG AC0,^D36 ;TEST SIZE JUMPGE AC0,.+2 TRO ER,ERRA DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE IFN POLISH,< ;[1067] MOVEM AC0,BYTESZ ;[1067] STORE CURRENT BYTE SIZE JRST BYTE2A ;[1067] FIRST TIME THROUGH > ;[1067] BYTE2: IFN POLISH,< MOVE AC0,BYTESZ ;[777] GET CURRENT BYTE SIZE BYTE2A: CAIN AC0,^D36 ;[1067] FULL WORD? JRST [ HRREI AC1,POLFWF ;[1067] YES, MAKE SURE FWF INCASE POLISH MOVEM AC1,POLTYP ;[1067] SETZM INBYTE ;[1067] POLISH ALLOWED JRST BYTE2B] ;[1067] CALL HWCHK ;[1067] NOT FULL WORD, GO CHECK HALF WORD SETOM INBYTE ;[1067] NO POLISH BYTE2B:> ;[1067] IBP ARG ;INCREMENT BYTE TRZN ARG,-1 ;OVERFLOW? JRST BYTE3 ;NO SETZB AC0,RC ;YES EXCH AC0,0(P) ;GET CURRENT VALUES EXCH RC,-1(P) ;AND STACK ZEROS IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM EXCH AC1,-2(P) ;GET FORM WORD > CALL STOW ;STOW FULL WORD BYTE3: PUSH P,ARG CALL EVALEX ;COMPUTE NEXT BYTE POP P,ARG IFN POLISH,< ;[1067] SKIPN INBYTE ;[1067] POLISH ALLOWED? JRST BYTE3A ;[1067] YES TDNN RC,[-1,,-1] ;[1067][1077] RELOC OR EXTERN? JRST BYTE3A ;[1067] NEITHER TDNE RC,[-1,,-2] ;[1077] RH RELOCATABLE? JRST BYTE3B ;[1077] NO - ERROR FOR ANYTHING ELSE MOVE AC1,BYTESZ ;[1077] GET RELOC BYTE SIZE CAIG AC1,^D18 ;[1077] MUST BE MORE THAN 18 BITS JRST BYTE3B ;[1077] TOO SMALL ADD AC1,BYTEAC ;[1077] ADD IN BYTE SIZE SO FAR CAIN AC1,^D36 ;[1077] MUST BE RIGHT JUSTIFIED TLNE AC0,-1 ;[1077] AND LH MUST BE ZERO BYTE3B: CALL QEXT ;[1067][1077] ERROR BYTE3A:> ;[1067] DPB AC0,ARG ;STORE BYTE HLLO AC0,ARG DPB RC,AC0 ;STORE RELOCATION IFN FORMSW,< MOVEI AC0,1 HRRI ARG,-2 DPB AC0,ARG ;STORE FORM BYTE HRRI ARG,0 > IFN POLISH,< ;[777] MOVE AC1,BYTEAC ;[777] GET ACCUMULATED BYTE SIZE SO FAR ADD AC1,BYTESZ ;[777] ADD CURRENT BYTE SIZE CAIL AC1,^D36 ;[777] EXCEEDED WORD SIZE? SUBI AC1,^D36 ;[777] YES, ADJUST TO BYTE SIZE IN A WORD MOVEM AC1,BYTEAC ;[777] USED TO TEST HALFWORD ALIGNMENT > ;[777] JUMPCM BYTE2 IFN POLISH,< SETZM INBYTE> ;[761] FLAG NO LONGER IN BYTE CAIN C,10 ;"("? JRST BYTE1 ;YES, GET NEW BYTE SIZE SETZM BYTESW ;[1114] DONE WITH BYTE JRST OP3 ;NO, EXIT ;HERE TO CHECK IF WE HAVE HALF WORD BYTE AND IF IS HALF WORD ALIGNED ;SKIP RETURN IF OK, AND NON-SKIP RETURN IF NO POLISH IFN POLISH,< HWCHK: CAIE AC0,^D18 ;[777] NOT FULL WORD, BUT HALF WORD? RET ;[777] NOT HALF WORD SKIPN AC1,BYTEAC ;[777] YES, BUT ALIGNED? JRST [ HRREI AC1,POLLHF ;[777] YES, IN LEFT HALF JRST HWCHK1] ;[777] CAIE AC1,^D18 ;[777] RET ;[777] NO, NOT ALIGNED HRREI AC1,POLRHF ;[777] YES, IN RIGHT HALF HWCHK1: MOVEM AC1,POLTYP ;[777] UPDATE FIXUP TYPE IN CASE POLISH SETZM INBYTE ;[777] POLISH ALLOWED AOS 0(P) ;[777] SKIP RETURN RET ;[777] > RADX50: CALL EVALEX ;EVALUATE CODE JUMPN RC,ERRAX ;ERROR IF NOT ABSOLUTE JUMPNC ERRAX TDZE AC0,[EXP ^-74] ;MAKE SURE ONLY 74 BITS ON TRO ER,ERRQ ;NOPE, LIGHT Q ERROR PUSH P,AC0 ;SAVE CODE BITS CALL GETSYM ;YES, GET SYMBOL TRZ ER,ERRA ;CLEAR ERROR POP P,ARG ;PUT CODE INTO ARG CALL SQOZE ;SQUOZE SIXBIT AND ADD CODE IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM JRST STOW ;STOW CODE AND EXIT SQOZE: MOVE AC1+1,AC0 ;PUT SIXBIT IN AC1+1 MOVEI AC0,0 ;CLEAR RESULT SQOZ1: MOVEI AC1,0 LSHC AC1,6 ;PUT 6-BIT CHARACTER IN AC1 LDB AC1,[POINT 6,CSTAT(AC1),23] ;CONVERT TO RADIX50 IMULI AC0,50 ;MULTIPLY PREVIOUS RESULT ADD AC0,AC1 ;ADD NEW CHARACTER JUMPN AC1+1,SQOZ1 ;TEST FOR END LSH ARG,^D30 ;LEFT-JUSTIFY CODE IOR AC0,ARG ;MERGE WITH RESULT RET %LINK: PUSH P,BLKTYP ;SAVE BLOCK TYPE PUSH P,AC0 JUMP1 LINK1 ;SKIP CODE GEN IF P1 CALL COUTD MOVEI AC0,12 ;LINK TYPE MOVEM AC0,BLKTYP LINK1: CALL EVALEX ;EVAL CHECK EXT POP P,AC1 ;GET BITS BACK JUMPN RC,LNKERR ;MUST BE ABS JUMPNC LNKERR ;GRNTEE COMMA TLNE AC1,400000 ;LNKEND? MOVN AC0,AC0 ;YES, NEGATE RESULT JUMP1 LINK2 ;SKIP IF P1 CALL COUT LINK2: CALL EVALXQ ;NO EXTERNALS JUMPNC LINK2A ;THIRD ARGUMENT SPECIFIED? HRL AC0,RC ;YES, MUST FIRST SAVE THE PUSH P,AC0 ;OLD VALUES OF RC, AC0 CALL EVALXQ ;READ IN THIRD ARGUMENT MOVS AC0,AC0 ;LINK EXPECTS LNKNXT IN THE MOVS RC,RC ;LEFT HELF OF SECOND WORD HRR AC0,(P) ;RESTORE LNKLOC VALUE HLR RC,(P) ;AND ITS RELOCATION BIT TLNE RC,1 ;LNKXNT RELOCATABLE? TRO RC,2 ;YES, SET FOR COUT TO DEPOSIT SUB P,[1,,1] ;"POP" BOGUS WORD OF STACK LINK2A: JUMP1 LINK3 CALL COUT ;DUMP LOC CALL COUTD ;FINISH BLOCK LINK3: POP P,BLKTYP ;RESTORE BLKTYP RET LNKERR: POP P,BLKTYP ;RESTORE BLOCK TYPE PJRST ERRAX ;GIVE ERROR RETURN %INTEG: TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL GETSYM ;GET A SYMBOL JRST INTG2 ;BAD SYMBOL ERROR TLO IO,DEFCRS ;THIS IS A DEFINTION CALL SSRCH ;SEE IF THERE MOVSI ARG,SYMF!UNDF ;SET SYMBOL AND UNDEFINED IF NOT TLNN ARG,UNDF ;IF ALREADY DEFINED JRST INTG1 ;JUST IGNORE TLOA ARG,VARF ;SET VARIABLE FLAG INTG2: TROA ER,ERRA ;SYMBOL ERROR CALL INSERZ ;PUT IN WITH ZERO VALUE (LENGTH OF 1) INTG1: JUMPCM %INTEG TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN RET %ARAY: MOVEM P,ARAYP ;SAVE PUSHDOW POINTER ARAY2: CALL GETSYM JRST ARAY1 ;BAD SYMBOL GIVE ERROR AND ABORT PUSH P,AC0 ;SAVE NAME JUMPCM ARAY2 ;AND GO ON IF A COMMA CAIE C,"["-40 ;MUST BE A [ JRST ARAY1 CALL BYPASS ;[664] OH, WELL TLO IO,IORPTC CALL EVALXQ ;GET A SIZE CAIE C,"]"-40 ;MUST END RIGHT JRST ARAY1 CALL BYPASS ;[664] ?? HRRZ V,AC0 ;GET VALUE SUBI V,1 NXTVAL: POP P,AC0 PUSH P,V ;SAVE OVER SEARCH TLO IO,DEFCRS TRO FRR,NOUNVS ;[1022][713] DON'T SEARCH UNIVERSALS CALL SSRCH ;FIND IT MOVSI ARG,SYMF!UNDF TRZ FRR,NOUNVS ;[1022][713] SEARCH UNIVERSALS AGAIN POP P,V ;GET VALUE BACK TLNE ARG,EXTF ;[674] E-ERROR IF EXTERNAL TRO ER,ERRE ;[674] TLNN ARG,UNDF JRST ARAY3 TLO ARG,VARF MOVEI RC,0 ;NO RELOC CALL INSERT ARAY3: CAME P,ARAYP JRST NXTVAL ;STILL NAMES STACKED JUMPCM ARAY2 RET ARAY1: TRO ER,ERRA ;ERROR EXIT MOVE P,ARAYP TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN RET ;RESET PDL AND GO ; .COMMON SYMBOL [SIZE] SYN ARAYP,COMMP ;SAVE SPACE COMM0: JUMP1 COMM1 ;WASTE OF TIME ON PASS1 CALL COUTD ;DUMP CURRENT BLOCK PUSH P,BLKTYP ;SAVE TYPE MOVEI AC0,20 ;COMMON BLOCK TYPE MOVEM AC0,BLKTYP ;SET NEW COMM1: MOVEM P,COMMP ;SAVE PUSHDOWN POINTER COMM2: CALL GETSYM ;GET A 6-BIT SYMBOL NAME JRST COMM7 ;BAD SYMBOL, GIVE UP PUSH P,AC0 ;SAVE SYMBOL NAME JUMPCM COMM2 ;AND GET ANOTHER IF COMMA CAIE C,'[' ;MUST BE A [ JRST COMM7 ;YOU LOSE CALL BYPASS ;[664] SKIP ANY LEADING SPACES TLO IO,IORPTC ;BUT NOT LAST CHAR CALL EVALXQ ;GET SIZE OF COMMON CAIE C,']' ;MUST END RIGHT JRST COMM7 HRRZ V,AC0 ;GET VALUE ;PUSHDOWN STACK IS IN WRONG ORDER, REVERSE IT HRRZ RC,P ;TOP ITEM HRRZ ARG,COMMP ;BOTTOM ITEM ADDI ARG,1 ;WELL ALMOST COMM6: CAIG RC,(ARG) ;ANYTHING TO MOVE? JRST COMM3 ;NO MOVE 0,(RC) ;MOVE TOP EXCH 0,(ARG) ;TO BOTTOM MOVEM 0,(RC) SUBI RC,1 ;DECREMENT AOJA ARG,COMM6 ;AND TRY AGAIN COMM3: MOVE AC0,0(P) ;GET SYMBOL JUMP2 COMM3B ;DIFF CHECKS FOR EACH PASS CALL SEARCH ;PERFORM GENERAL SEARCH JRST COMM3A ;NOT FOUND, GOOD JUMPL ARG,CMNERR ;FOUND, OPERAND, WARN CAME AC0,-3(SX) ;MACRO, LOOK ONE SLOT BELOW JRST COMM3A ;NOT FOUND, CONTINUE JRST CMNERR ;WARNING COMM3B: SKIPE BNSN ;CODE STORED? JRST CMNERR ;YES, WARN USER COMM3A: POP P,AC0 ;GET SYMBOL JUMP1 .+2 ;IGNORE V ON PASS 1 PUSH P,V ;SAVE VALUE TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL EXTER1 ;DEFINE AS EXTERNAL(CLEAR NOUNVS) ;NOTE, CS IS NOT ON A COMMA, SO WILL RETURN JUMP1 COMM4 ;ALL DONE IF PASS1 SETZ RC, ;NO RELOCATION MOVEI ARG,4 ;FORM RADIX50 04,SYMBOL CALL SQOZE ;IN AC0 CALL COUT ;OUTPUT SYMBOL POP P,V ;GET VALUE BACK MOVE AC0,V ;AND INTO AC0 CALL COUT ;SECOND PART OF PAIR COMM4: CAME P,COMMP ;FINISHED WITH STACKED SYMBOLS JRST COMM3 ;NO MORE TO GO CALL BYPASS ;[664] GET NEXT DELIMITER JUMPCM COMM2 ;MORE TO GO IF COMMA NEXT COMM5: JUMP1 CPOPJ CALL COUTD ;DUMP THIS BLOCK POP P,BLKTYP ;RESTORE LAST RET COMM7: TRO ER,ERRA ;FLAG ERROR MOVE P,COMMP ;RESET PUSHDOWN POINTER JRST COMM5 ;RESTORE BLKTYP AND EXIT CMNERR: PUSH P,['MCRSOC'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / STATEMENT OUT OF ORDER .COMMON@/] ;[1066] SYMBOL IN AC0 CALL EWARN ;[1066] WARNING CALL TYPMSG AOS QERRS ;COUNT AS WARNING JRST COMM3A ;CONTINUE ; .REQUEST DEV:FILENAME[PPN] REQUIR: SKIPA CS,[16] ;BLOCK TYPE 16 REQUES: MOVEI CS,17 ;BLOCK TYPE 17 JUMP1 REMAR0 ;IGNORE ON PASS 1 CALL COUTD ;DUMP CURRENT PUSH P,BLKTYP ;SAVE LAST BLOCK TYPE MOVEM CS,BLKTYP ;SET NEW REQU0: REPEAT 3, ;STACK A NULL SPEC IN CASE OF ERROR CALL BYPASS ;[664] FLUSH EXTRA TABS AND SPACES TLO IO,IORPTC ;BACK OFF BECAUSE SCHGET CALL SCHGET ;GET PART OF A FILE SPEC JUMPE AC0,REQUER ;ERROR IF NOTHING CAIE C,':' ;WAS THERE A DEVICE JRST REQU1 ;NO, GOOD GUESS MOVEM AC0,-2(P) ;SAVE DEVICE CALL SCHGET ;GET THE FILE NAME JUMPE AC0,REQUER ;ERROR IF NOTHING REQU1: MOVEM AC0,(P) ;STORE FILE NAME CAIN C,'.' ;SEE IF AN EXTENSION GIVEN JRST REQU4 ;YES, GO SKIP IT AND MAKE SURE IT'S REQU3: ;A .REL FILE, CAUSE THAT'S ALL IT CAN BE CAIE C,'[' ;WAS THERE A PPN JRST REQU2 ;NO, AS EXPECTED CALL BYPASS ;[664] SKIP ANY BLANKS TLO IO,IORPTC CALL EVALXQ ;GET HALF A PPN HRLM AC0,-1(P) ;STORE IT CALL EVALXQ ;GET OTHER HALF HRRM AC0,-1(P) ;STORE IT CAIE C,']' ;MUST END ON ] JRST REQUER ;IT DIDN'T CALL BYPASS ;[664] SCAN AFTER RIGHT BRACKET REQU2: SETZ RC, ;NO RELOCATION POP P,AC0 ;GET FILE NAME CALL COUT POP P,AC0 ;AND PPN CALL COUT POP P,AC0 ;FINALLY DEVICE CALL COUT JUMPCM REQU0 ;MORE TO COME CALL COUTD ;DUMP BLOCK POP P,BLKTYP ;RESTORE BLOCK TYPE RET ;NO REQU4: CALL SCHGET ;GO SCAN OUT EXTENSION HLRZ AC0,AC0 ;SWAP FOR CAIE CAIE AC0,'REL' ;SEE IF IT'S FOR .REL TRO ER,ERRQ ;NOPE, TELL HIM ABOUT IT JRST REQU3 ;BACK TO LOOK FOR PPN REQUER: SUB P,[3,,3] ;REMOVE THE THREE ITEMS POP P,BLKTYP ;RESTORE BLOCK TYPE JRST ERRAX ;AND GIVE UP ; NEW .DIRECTIVE PSEUDO-OP ; ARGS ARE FUNCTIONS TO BE DONE %DIREC: MOVEI AC2,0 ;INIT FLAG TO 'YES' DIREC1: CALL GETSYM ;GET THE SYMBOL JRST ERRAX ;MISSING, GIVE ERROR CAMN AC0,[SIXBIT /NO/] ;'NO ...' ? JRST [ SKIPE AC2 ;[720] FLAG NO NO ...WITH Q-ERROR TROA ER,ERRQ ;[720] SETO AC2, ;REVERSE FLAG JRST DIREC1] ;TRY AGAIN FOR FUNCTION MOVSI ARG,-DIRLEN ;AOBJN WORD CAMN AC0,DIRARG(ARG) ;LOOK FOR MATCH JRST DIRFND ;GOT IT AOBJN ARG,.-2 ;LOOP FOR ALL OF TABLE JRST ERRAX ;NOT FOUND, GIVE ERROR DIRFND: XCT DIRXCT(ARG) ;DO FUNCTION JUMPCM %DIREC ;MORE IF COMMA RET ;OTHERWISE RETURN ;[1125] DEFINITION OF THE .DIRECTIVE PSEUDO-OP ;[1125] ARGS: SIXBIT NAME OF ARGUMENT ;[1125] INSTRUCTION TO EXECUTE WHEN THAT DIRECTIVE IS SPECIFIED DEFINE DIRMAK,< ;;[1125] X (.NOBIN,) ;;[1125] DON'T GENERATE REL FILE X (.ITABM,) ;;[1125] INCLUDE TAB/SPACE IN MACRO ARGS X (.XTABM,) ;;[1125] EXCLUDE TAB/SPACE IN MACRO ARGS X (SFCOND,) ;;[1125] XLIST IN IF (FALSE) X (LITLST,) ;;[1125] LIST BINARY IN LITERALS X (FLBLST,) ;;[1125] FIRST LINE BINARY LISTING ONLY X (MACPRF,) ;;[1125] MACRO DEF PREFERED OVER SYMBOL X (MACMPD,) ;;[1125] NEW MACRO ARG HANDLING X (KA10,) ;;[1125] PUT KA10 TYPE IN HEADER BLOCK X (KI10,) ;;[1125] PUT KI10 TYPE IN HEADER BLOCK X (KL10,) ;;[1125] PUT KL10 TYPE IN HEADER BLOCK X (.OKOVL,) ;;[1125] ALLOW /,* OVERFLOW X (.EROVL,) ;;[1125] DON'T ALLOW /,* OVERFLOW X (.NOCAL,) ;;[1125][1043][1041] DON'T SEARCH UUO TABLES IFN TSTCD,< ;;[1125] X (.TCDON,) ;;[1125][575] SET LINK DEBUGGING FLAG X (.TCDOF,) ;;[1125] TURN LINK DEBUGGING OFF > ;END OF IFN TSTCD ;;[1125] > ;END OF DIRMAK ;;[1125] DEFINE X(A,B),< ;;[1125] SIXBIT \A\> ;;[1125] ;[1125] GENERATE THE .DIRECTIVE ARGUMENT NAME TABLE DIRARG: DIRMAK ;[1125] DIRLEN==.-DIRARG ;[1125] DEFINE X(A,B),< ;;[1125] B> ;;[1125] ;[1125] GENERATE THE .DIRECTIVE INSTRUCTION TABLE (FOR XCT) DIRXCT: DIRMAK ;[1125] SETKA: SKIPA ARG,[1B5] SETKI: MOVSI ARG,(2B5) SKIPA ;SET FOR KI OR KA SETKL: MOVSI ARG,(4B5) ;KA=1 KI=2 KL=4 IORM ARG,CPUTYP ;MAKE INCLUSIVE WITH WHAT IS THERE RET ;THEN RETURN ;SET FLBLST SWITCH. WHEN ON, IT CAUSES ONLY ONE LINE OF BINARY TO BE ;LISTED FOR MULTI-WORD STATEMENTS, E.G. ASCIZ. SETFLB: MOVSI AC1,(FLBLST) ANDCAM AC1,BLSW SKIPN AC2 ;USER WANTS IT? IORM AC1,BLSW ;YES, SET FLAG RET ;[1125] SET NO BINARY SWITCH - GENERATES NO REL FILE SETNOB: JUMPE AC2,%NOBIN ;[1125] 'NO' GIVEN? TRO ER,ERRQ ;[1125] YES, ILLEGAL RET ;[1125] ;[1125] SET MACRO ARG HANDLING SWITCH - MATCH PAIRED DELIMITERS SETMPD: MOVEM AC2,MACTAB ;[1125] SET MACRO ARG DELIMITER FLAG MOVEM AC2,ITABM ;[1125] IMPLIES ITABM ALSO RET ;[1125] IFN TSTCD,< TCDSET: SETCAM AC2,TCDFLG ;SET FLAG ON JRST COUTD ;[664] BIND OFF LAST BLOCK, EXIT > ; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY ; HERE IF PRGEND (PASS 1) PSEND0: IFN FTPSECT,< ;[1136] SKIPE SGLITL ;[1136] INSIDE A LITERAL OF ANY PSECT? RET ;[1136] YES - JUST RETURN > ;[1136] TLO IO,MFLSW ;[1131] PSEND SEEN SETOM PGENDF ;[1141] INDICATE PRGEND SEEN CALL END0 ;AS IF END STATEMENT HLLZS IO ;CLEAR ER(RH) SETZM ERRCNT ;CLEAR ERROR COUNT FOR EACH PROG. SETZM QERRS ;... JUMP2 PSEND2 ;DIFFERENT ON PASS2 SKIPE UNIVSN ;SEEN A UNIVERSAL CALL UNISYM ;YES, STORE SYMBOLS CALL PSEND4 ;SAVE SYMBOLS, POINTERS AND TITLE MOVE AC0,[ASCII /.MAIN/] ;GET DEFAULT TITLE MOVEM AC0,TBUF ;AND MAKE IT CURRENT TITLE SETZM TBUF+1 ;[1140] CLEAR 2ND WORD FOR ASCIZ TITLE SETZM TTLFND ;[1123] MAKE SURE TITLE FLAG IS CLEARED SETZM RELLOC ;CLEAR TO PREVENT EFFECTS ACROSS PRGEND SETZM RELLOC+1 ;[573] PSEND1: TLZ IO,MFLSW ;FOR NEXT FILE SETZM UNISCH ;CLEAR UNIVERSAL SEARCH TABLE MOVE AC0,[UNISCH,,UNISCH+1] BLT AC0,UNISCH+.UNIV-1 TLO IO,IOPAGE ;SIGNAL NEW PAGE BUT DON'T CHANGE NUMBER MOVSI AC0,1 ;SET SO RELOC 0 WORKS HRRZM AC0,LOCA ;SET ASSEMBLY LOCATION HRRZM AC0,LOCO ;AND OUTPUT LOCATION HLRZM AC0,MODA ;SET MODE HLRZM AC0,MODO RET ; HERE IF PRGEND (PASS 2) PSEND2: SETZM SBUF ;SO SUBTTL IS NOT WRONG SETZM UNIVSN ;IN CASE IN UNIVERSAL TLZ FR,R1BSW!RIMSW!RIM1SW CALL PSEND5 ;PUT TITLE BACK CALL PSEND1 ;COMMON CODE JRST PASS20 ;OUTPUT THE ENTRIES ; HERE IF END (PASS 1) PSEND3: CALL PSEND4 ;SAVE LAST PROGRAM HLRS PRGPTR ;REINITIALIZE POINTER PJRST PSEND5 ;READ BACK FIRST PROGRAM ;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS XTRA==^D9 ;[1144] NUMBER OF OTHER LOCATIONS TO SAVE PSEND4: MOVE V,FREE ;GET NEXT FREE LOCATION ADDI V,LENGTH+.TBUF/5+XTRA IFN FTPSECT,< ;[575] ADDI V,1 ;[1052] ALLOW FOR PSECT COUNT SKIPN SGNMAX ;[1052] IF COUNT IS 0, WILL LOOP ONCE JRST [ADDI V,5 ;[1131][1052] SO ALLOW FOR IT JRST PSEND7] ;[1052] ADD V,SGNMAX ;[1131] SAVE 5 PSECT TABLES ADD V,SGNMAX ADD V,SGNMAX ADD V,SGNMAX ADD V,SGNMAX PSEND7: ;[1052] > CAML V,SYMBOL ;WILL WORST CASE FIT? CALL XCEED ;NO, EXPAND MOVS V,FREE HRR V,PRGPTR ;LAST PRGEND BLOCK HLRM V,(V) ;LINK THIS BLOCK SKIPN PRGPTR ;IF FIRST TIME HLLZM V,PRGPTR ;SET LINK TO START OF CHAIN HLRM V,PRGPTR ;POINTER TO IT SETZM @FREE ;CLEAR LINK WORD AOS FREE ;THIS LOCATION USED NOW MOVS AC0,SYMBOL ;BOTTOM OF SYMBOL TABLE HRR AC0,FREE ;FREE SPACE MOVE V,@SYMBOL ;GET NUMBER OF SYMBOLS ASH V,1 ;TWO WORDS PER SYMBOL ADDI V,1 ;ONE MORE FOR COUNT ADDB V,FREE ;END OF TABLE WHEN MOVED BLT AC0,(V) ;MOVE TABLE HRRZ AC0,.JBREL ;TOP OF CORE SUBI AC0,1 MOVEM AC0,SYMTOP ;FOR NEXT SYMBOL TABLE SUBI AC0,LENGTH ;LENGTH OF INITIAL SYMBOLS MOVEM AC0,SYMBOL ;SET POINTER TO COUNT OF SYMBOLS HRLI AC0,SYMNUM ;BLT POINTER BLT AC0,@SYMTOP ;SET UP INITIAL SYMBOL TABLE CALL SRCHI ;SET UP SEARCH POINTER MOVEI AC0,.TBUF ;MAX NUMBER OF CHARS. IN TITLE SUB AC0,TCNT ;ACTUAL NUMBER IDIVI AC0,5 ;NUMBER OF WORDS SKIPE AC1 ;REMAINDER? ADDI AC0,1 ;YES MOVEM AC0,@FREE ;STORE COUNT AOS FREE ;THIS LOCATION USED NOW EXCH AC0,FREE ;SET UP AC0 FOR BLT ADDM AC0,FREE ;WILL BE AFTER TITLE MOVES HRLI AC0,TBUF ;BLT POINTER BLT AC0,@FREE ;MOVE TITLE IFN FTPSECT,< ;[575] MOVE AC2,SGNMAX ;PSECT COUNT MOVE AC0,AC2 CALL STORIT ;SAVE PSECT COUNT PSEND8: MOVE AC0,SGNAME(AC2) ;[1052] START OF STORE LOOP CALL STORIT ;SAVE PSECT NAME MOVE AC0,SGRELC(AC2) CALL STORIT ;SAVE MODE AND PC MOVE AC0,SGSCNT(AC2) CALL STORIT ;SAVE SYM CNT MOVE AC0,SGATTR(AC2) CALL STORIT ;SAVE BREAK AND ATTRS MOVE AC0,SGORIG(AC2) ;[1131] SAVE LIT PTR,,ORIGIN CALL STORIT ;[1131] HRRZS SGORIG(AC2) ;[1131] CLEAR LIT PTR. FOR NEXT PROG SOJGE AC2,PSEND8 ;[1052] SETZM SGNMAX ;ZERO PSECT CNT SETZM SGNCUR ;[1136] ZERO CURRENT PSECT SETZM SGDMAX ;[1136] ZERO PSECT NESTING COUNT SETZM SGLIST ;[1136] FIRST PSECT IS ALWAYS THE BLANK PSECT SETZM SGNAME ;BLANK PSECT NAME MOVSI AC0,1 ;SET RELOCATION MOVEM AC0,SGRELC ;TO RELATIVE ZERO SETZM SGATTR ;[1131] CLEAR PSECT BREAK MOVE AC0,@SYMBOL ;GET SYM CNT MOVEM AC0,SGSCNT ;SAVE PSECT SYM CNT CALL SRCHI ;SET UP SEARCH POINTER > MOVE AC0,LITHD ;LENGTH ,, START CALL STORIT MOVE AC2,LITHDX ;POINTER TO LIT INFO. MOVE AC0,-1(AC2) ;SIZE OF PASS1 LOCO CALL STORIT ;SAVE IT IN SYMBOL TABLE MOVE AC2,VARHDX ;SAME FOR VARS MOVE AC0,-1(AC2) CALL STORIT MOVE AC0,(AC2) CALL STORIT SETZM (AC2) ;CLEAR NUMBER OF VARIABLES SEEN MOVE AC0,CPUTYP ;[1144] CPU TYPE BITS CALL STORIT ;[1144] SAVE SETZM CPUTYP ;[1144] CLEAR MOVE AC0,HISNSW ;GET TWOSEG/HISEG FLAG HRR AC0,HIGH1 ;AND PASS1 BREAK CALL STORIT SETZM HISNSW ;CLEAR HISEG FLAG FOR NEXT PROGRAM SETZM HIGH ;[1131] CLEAR LOW SEG BREAK JUMPGE AC0,PSEND6 ;NOT TWOSEG MOVE AC0,SVTYP3 ;HIGH SEGMENT OFFSET CALL STORIT ;SAVE IT ALSO PSEND6: MOVE AC0,FREE ;GET NEXT FREE LOCATION SUBI AC0,1 ;LAST ONE USED HRRZ V,PRGPTR ;POINTER TO START OF DATA BLOCK HRLM AC0,(V) ;LINK TO END OF BLOCK RET ;RETURN PSENDX: CALL XCEED ;NEED TO EXPAND CORE FIRST PSEND5: HRRZ V,.JBREL ;GET TOP OF CORE SETZM (V) ;CLEAR OR GET ILL MEM REF MOVEI AC0,-1(V) MOVEM AC0,SYMTOP ;TOP OF NEW SYMBOL TABLE HRRZ V,PRGPTR ;ADDRESS OF THIS BLOCK JUMPE V,PSNDER ;ERROR LINK NOT SET UP MOVE AC1,(V) ;NEXT LINK MOVE V,1(V) ;GET ITS SYMBOL COUNT ASH V,1 ;NUMBER OF WORDS ADDI V,1 ;PLUS ONE FOR COUNT SUBI AC0,(V) ;START OF NEW SYMBOL TABLE CAMG AC0,FREE ;WILL IT FIT JRST PSENDX ;NO, NEED TO EXPAND AND RESET AC0 ADD V,PRGPTR ;POINT TO END OF SYMBOL TABLE MOVEI V,1(V) ;THEN TO BEG OF TITLE MOVEM AC0,SYMBOL ;BOTTOM OF NEW TABLE HRL AC0,PRGPTR ;ADDRESS OF FIRST WORD OF BLOCK ADD AC0,[1,,0] ;MAKE BLT POINTER HRRM AC1,PRGPTR ;POINT TO NEXT BLOCK BLT AC0,@SYMTOP ;MOVE TABLE CALL SRCHI ;SET UP POINTER MOVE AC1,(V) ;NUMBER OF WORDS OF TITLE MOVEI AC0,1(V) ;START OF STORED TITLE ADD V,AC1 ;INCREMENT PAST TITLE ADDI AC1,TBUF-1 ;END OF TITLE HRLI AC0,TBUF ;WHERE TO PUT IT MOVSS AC0 ;BLT POINTER BLT AC0,(AC1) ;MOVE TITLE SETZM TTLFND ;[1123] INDICATE TITLE NOT YET SEEN IFN FTPSECT,< ;[575] CALL GETIT ;GET PSECT COUNT MOVE AC2,AC0 MOVEM AC2,SGNMAX PSEND9: CALL GETIT ;[1052] GET PSECT NAME MOVEM AC0,SGNAME(AC2) CALL GETIT ;GET MODE AND PC MOVEM AC0,SGRELC(AC2) CALL GETIT ;GET SYM CNT MOVEM AC0,SGSCNT(AC2) CALL GETIT ;GET BREAK AND ATTRS MOVEM AC0,SGATTR(AC2) CALL GETIT ;[1131] GET LIT PTR,,ORIGIN MOVEM AC0,SGORIG(AC2) ;[1131] SOJGE AC2,PSEND9 ;[1052] SETZM SGNCUR ;SET TO BLANK PSECT CALL SRCHI ;SET UP POINTER > CALL GETIT MOVEM AC0,LITHD MOVE AC2,LITHDX ;INVERSE OF ABOVE CALL GETIT MOVEM AC0,-1(AC2) MOVE AC2,VARHDX ;SAME FOR VARS CALL GETIT MOVEM AC0,-1(AC2) CALL GETIT MOVEM AC0,(AC2) ;RESTORE COUNT OF VARS CALL GETIT ;[1144] CPU TYPE BITS MOVEM AC0,CPUTYP ;[1144] CALL GETIT ;GET TWO HALF WORDS HRRZM AC0,HIGH1 ;PASS1 BREAK HLLEM AC0,HISNSW ;TWOSEG/HISEG FLAG JUMPGE AC0,CPOPJ ;NOT TWOSEG CALL GETIT MOVEM AC0,SVTYP3 ;BLOCK 3 WORD RET STORIT: MOVEM AC0,@FREE ;STORE IT IN DATA BLOCK AOS FREE ;ADVANCE POINTER RET GETIT: MOVE AC0,1(V) ;FILL AC0 OUT OF PRGEND BLOCK AOJA V,CPOPJ ;INCREMENT AND RETURN PSNDER: PUSH P,['MCRPGE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / PRGEND ERROR@/] ;[1066] JRST ERRFIN ;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS UNIV0: JUMP2 UNIV2 ;DO PROPER PASS2 STUFF BITON UBAS+UMACV,UWVER ;WRITING UNV, INCLUDE UBAS AND VERSION HRRZ SX,UNIVNO ;GET NUMBER OF UNIVERSALS SEEN CAIL SX,.UNIV ;ALLOW ONE MORE? JRST UNVERR ;NO, GIVE FATAL ERROR SETOM UNIVSN ;AND SET SEEN A UNIVERSAL JRST TITLE0 ;CONTINUE AS IF TITLE UNIV2: HLLOS UNIVSN ;ENSURE SET UP FOR UNIVERSAL JRST TITLE0 ;[1123] AND CONTINUE AS IF TITLE ADDUNV: PUSH P,RC ;AN AC TO USE CALL NOUT ;CONVERT TO SIXBIT HRRZ RC,UNIVNO ;GET ENTRY INDEX MOVEM AC0,UNITBL+1(RC) ;STORE SIXBIT NAME IN TABLE MOVEM AC0,UNVDIR ;AND FOR ENTER LATER HRRZS UNIVSN ;ONLY DO IT ONCE POP P,RC ;RESTORE RC RET ;AND RETURN UNVERR: PUSH P,['MCRTMU'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / TOO MANY UNIVERSALS@/] ;[1066] JRST ERRFIN UNISYM: CALL SUPRSA ;TURN ON SUPPRESS BIT SKIPE UNVSKP ;[700] IF /U, SET FLAG FOR JRST [SETOM MRUNV ;[700] LATER ASSEMBLIES JRST .+2] ;[700] AND SKIP .UNV FILE CALL UNVOUT ;OUTPUT SYMBOL TABLE TLNN IO,MFLSW ;ALSO IN PRGEND? JRST UNISYN ;NO MOVE AC0,@SYMBOL ;GET NO. OF SYMBOLS LSH AC0,1 ;2 WORDS EACH ADDI AC0,1 ;PLUS COUNT ADD AC0,FREE ;HOW MUCH WE WILL NEED CAML AC0,SYMBOL ;WILL IT FIT IN WHAT WE HAVE UNISYK: CALL XCEED ;NO, EXPAND CAML AC0,SYMBOL ;ENOUGH? JRST UNISYK ;NO, EXPAND UNISYN: PUSH P,SYMBOL ;NEED TO SAVE IN CASE PRGEND MOVE AC0,SYMTOP ;TOP OF TABLE SUB AC0,SYMBOL ;GET LENGTH OF TABLE HRL ARG,SYMBOL ;BOTTOM OF TABLE HRR ARG,FREE ;WHERE TO GO HRRZ RC,UNIVNO ;GET TABLE INDEX HRRM ARG,SYMBOL ;WILL BE THERE SOON HRRZM ARG,UNIPTR+1(RC) ;STORE IN CORRESPONDING PLACE ADDB AC0,FREE ;WHERE TO END HRLM AC0,UNIPTR+1(RC) ;SAVE NEW SYMTOP BLT ARG,@FREE ;MOVE TABLE HRRZM AC0,UNITOP ;SAVE TOP OF TABLES+1 CAMLE AC0,MACSIZ ;IN CASE OVER A K BOUND MOVEM AC0,MACSIZ ;DON'T REDUCE SO FAR NOW MOVE AC0,SRCHX ;SAVE OLD SEARCH POINTER CALL SRCHI ;GET SEARCH POINTER EXCH AC0,SRCHX MOVEM AC0,UNISHX+1(RC) ;SAVE IT POP P,SYMBOL ;RESTORE OLD VALUE SETZM UNIVSN ;CLEAR FLAG IN CASE PRGEND AOS UNIVNO ;SIGNAL ANOTHER UNIVERSAL SAVED RET ;RETURN SERCH0: CALL BYPASS ;[664][572] SKIP LEADING BLANKS TLNE CS,4 ;FIRST CHAR NUMERIC? TLO CS,2 ;YES, FIX UP FOR GETSYM CALL GETSY0 ;GET A SYMBOL JRST ERRAX ;ERROR IF NOT VALID MOVE RC,UNIVNO ;NUMBER OF UNIVERSALS AVAILABLE JUMPE RC,UNVINP ;TRY TO READ SYMBOLS FROM DSK CAME AC0,UNITBL(RC) ;LOOK FOR MATCH SOJA RC,.-2 ;NOT FOUND YET SERCH1: MOVE AC0,RC ;STORE TABLE ENTRY NUMBER MOVEI RC,1 ;START AT ENTRY ONE SERCH5: CAIL RC,.UNIV ;[672] CHECK FOR CONSISTENCY ERROR JRST SCHOVL ;[672] GIVE ERROR SKIPN UNISCH(RC) ;[672] LOOK FOR AN EMPTY SLOT JRST [MOVEM AC0,UNISCH(RC) ;[672] STORE INDEX IN TABLE JRST SERCH6] ;[672] CAME AC0,UNISCH(RC) ;[672] SAME INDEX? AOJA RC,SERCH5 ;[672] NO, NOT FOUND YET SERCH6: CAIE C,'(' ;[672] GIVING FILE SPEC? JRST SERCH4 ;NO SERCH2: CALL GETCHR ;YES, GET RID OF IT CAIN C,')' ;LOOK FOR END JRST SERCH3 ;FOUND IT CAIE C,EOL ;REACHED END OF LINE? JRST SERCH2 ;NO, KEEP LOOKING TROA ER,ERRQ ;GIVE UP AND FLAG ERROR SERCH3: CALL GETCHR ;GET NEXT CHAR SERCH4: JUMPCM SERCH0 ;LOOK FOR MORE NAMES RET ;FINISHED VERSKW: PUSH P,['MCRUVS'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / UNIVERSAL VERSION SKEW, REASSEMBLE UNIVERSAL@/] ;[1066] JRST ERRFIN ;NAME IN AC0 SCHERR: PUSH P,['MCRCFU'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / CANNOT FIND UNIVERSAL@/] ;[1066] JRST ERRFIN ;NAME IN AC0 SCHOVL: PUSH P,['MCTSTO'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / SEARCH TABLE OVERFLOW, CANNOT SEARCH UNIVERSAL@/] ;[1066][672] MOVE AC0,UNVDIR ;[672] JRST ERRFIN ;[672] ;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL UNIERR: PUSH P,['MCRCAP'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / CORE ALLOCATION PROBLEM WITH MEMORY-RESIDENT UNIVERSAL(S)@/] ;[1066][700] MOVEI P,JOBFFI ;[1004] GET SAFE TEMP PDL PTR JRST ERRFIN SCHGET: SETZ AC0, ;INITIALIZE MOVSI AC1,(POINT 6,AC0) SCHGNX: CALL GETCHR ;GET NEXT CHARACTER CAIE C,'.' ;SPECIAL TEST FOR END OF NAME TLNN CS,6 ;OR ANY NON-ALPHANUMERIC PJRST BYPAS2 ;SKIP ALL SPACES AND QUIT TLNE AC1,770000 ;ALL SIX IN YET? IDPB C,AC1 ;NO, STORE THIS ONE JRST SCHGNX ;GET NEXT SCHOCT: SETZ AC0, ;INITIALIZE SCHONX: CALL GETCHR ;GET NEXT CHAR TLNN CS,4 ;NUMBER PJRST BYPAS2 ;NO, SKIP TRAILING SPACES LSH AC0,3 ;MAKE SPACE ADDI AC0,-'0'(C) ;AND STOW DIGIT JRST SCHONX ;GET NEXT SUBTTL MACRO/REPEAT HANDLERS REPEA0: CALL EVALXQ ;EVALUATE REPEAT EXP, EXTERNS ARE ILL. JUMPNC ERRAX SETZM NESTED ;ASSUME NOT NESTED SKIPN LITLVL ;IN LITERAL? SKIPE MACLVL ;IN MACRO? SKIPA SKIPE RPOLVL ;IN REPEAT 1 OR IF'S? SETOM NESTED ;YES, IT IS NESTED IN ONE OF THEM REPEA1: SETZM COMSW ;SET COMMENT SWITCH JUMPLE AC0,REPZ ;PASS THE EXP., DONT PROCESS SOJE AC0,REPO ;REPEAT ONCE REPEA2: CALL GCHARQ ;GET STARTING "<" CALL COMTST ;IGNORE COMMENTS SKIPN COMSW ;INSIDE A COMMENT? CAIG C," " ;TEXT FORMATTING CHARACTER? JRST REPEA2 ;YES, GET NEXT CAIE C,"<" ;"<"? JRST REPMAB ;NO, ERROR CALL SKELI1 ;INITIALIZE SKELETON PUSH MP,REPEXP MOVEM AC0,REPEXP PUSH MP,REPPNT ;STACK PREVIOUS REPEAT POINTER MOVEM ARG,REPPNT ;STORE NEW POINTER TDZA SDEL,SDEL ;YES, INITIALIZE BRACKET COUNT AND SKIP REPEA4: CALL WCHAR ;[664] WRITE A CHARACTER CALL GCHARQ ;GET A CHARACTER CAIN C,"<" ;"<"? AOJA SDEL,REPEA4 ;YES, INCREMENT AND WRITE CAIE C,">" ;">"? JRST REPEA4 ;NO, WRITE THE CHARACTER SOJGE SDEL,REPEA4 ;YES, WRITE IF NON-NEGATIVE COUNT MOVSI CS,(BYTE (7) 177,3) ;SET "REPEAT" END CALL WWRXE ;WRITE END SKIPE NESTED ;NESTED? JRST REPEA5 ;YES, REST OF LINE, SOMETHING ELSE MAY END HERE CALL BYPASS ;[664] CALL STOUTS ;POLISH OF LINE BEFORE PROCESSING REPEAT SOS TAGINC ;[1001] RECOVER CORRECT OFFSET ;(NOTE: THIS IS NECESSARY FOR MRP IS NOT YET NON-ZERO WHEN THE EARLY CALL ; TO STOUT OCCURS. THIS FOULS UP THE CHECK AT OUTLI4.) REPEA5: PUSH MP,MRP ;STACK PREVIOUS READ POINTER PUSH MP,RCOUNT ;SAVE WORD COUNT HRRZ MRP,REPPNT ;SET UP READ POINTER ADDI MRP,1 ;BYPASS ARG COUNT SKIPE NESTED ;NESTED? JRST REPEA8 ;YES RET ;[664] NO REPEA7: HRRZ MRP,REPPNT ;SET UP READ POINTER ADDI MRP,1 ;BYPASS ARG COUNT REPEA8: MOVEI C,LF JRST RSW2 REPEND: SOSL REPEXP JRST REPEA7 HRRZ V,REPPNT ;GET START OF TREE CALL REFDEC ;DECREMENT REFERENCE POP MP,RCOUNT POP MP,MRP POP MP,REPPNT POP MP,REPEXP SKIPE NESTED ;NESTED? JRST RSW0 ;YES, FINISH OF LINE NOW JRST REPEA8 REPMAB: PUSH P,['MCRISR'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT \ ILLEGAL SYNTAX IN REPEAT@\] ;[1066][702] JRST ERRNE4 ;[702] REPZ: FORERR (SDEL,REP) PUSH P,IO ;SAVE STATE OF IOPROG SETOM INREP REPZ0: CALL GCHAR0 ;[1003][753] GET STARTING < CALL COMTST ;IGNORE COMMENTS SKIPN COMSW ;INSIDE A COMMENT? CAIG C," " ;TEXT-FORMATING CHAR? JRST REPZ0 ;YES, GET NEXT CAIE C,"<" ;" ;">"? SOJLE SDEL,REPZ2 ;YES, EXIT IF MATCHING JRST REPZ1 ;NO, RECYCLE REPZ2: POP P,AC1 ;RECOVER ORIGINAL IOPROG TLNN AC1,IOPROG ;ORIGINALLY 0? TLZ IO,IOPROG ;YES, RESTORE IT SETZM INREP ;FLAG OUT OF IT SETZM INCND ;AND CONDITIONAL ALSO JRST STMNT ;AND EXIT REPO: CALL GCHAR ;GET "<" CALL COMTST ;IGNORE COMMENTS SKIPN COMSW ;INSIDE A COMMENT? CAIG C," " ;TEXT-FORMATTING CHAR? JRST REPO ;YES, GET NEXT CAIE C,"<" ;" AOSE RPOLVL JRST RSW2 POP MP,RPOLVL CALL RSW2 JRST RSW0 CORMAB: PUSH P,['MCRISC'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / ILLEGAL SYNTAX IN CONDITIONAL OR REPEAT@/] ;[1066][702] JRST ERRNE4 ;[702] COMTST: CAIG C,FF ;SEARCH FOR END OF LINE CAIGE C,LF ;LF, VT OR FF? JRST .+2 ;WASN'T ANY OF THEM SETZM COMSW ;RESET COMMENT SWITCH CAIN C,";" ;COMMENT? SETOM COMSW ;YES, SET COMMENT SWITCH RET SUBTTL MACRO PROCESSOR COMMENT \ THE FOLLOWING IS A PARTIAL DESCRIPTION OF THE DATA STRUCTURES USED BY THE MACRO PROCESSOR. FREE STORAGE IS OBTAINED IN GROUPS OF .LEAF (4 PRESENTLY) WORDS. SUCH A BLOCK IS CALLED A 'LEAF' AND IS FORMATTED AS FOLLOWS FOR STORING TEXT: !-------------------------------------------! ! LINK TO NEXT LEAF !//! CHAR 0 ! CHAR 1 ! !-------------------------------------------! ! CHAR 2 ... ! !-------------------------------------------! ! ! !-------------------------------------------! ! ! !-------------------------------------------! THE FIRST LEAF OF A MACRO DEFINITION CONTAINS SOME ADDITIONAL INFORMATION ABOUT THE MACRO: 1. DEFAULT ARGUMENT POINTER 2. ARGUMENT COUNT 3. REFERENCE COUNT !-------------------------------------------! ! LINK ! ! !-------------------------------------------! ! DEF ARG PTR ! ARG CNT ! REF CNT! !-------------------------------------------! ! CHAR 0 ! CHAR 1 ! ... ! !-------------------------------------------! ! ! !-------------------------------------------! THE FIRST LEAF OF A MACRO ARGUMENT ALSO CONTAINS A REF COUNT: !-------------------------------------------! ! LINK ! ! !-------------------------------------------! ! ! 1 ! REF CNT ! !-------------------------------------------! ! ! !-------------------------------------------! ! ! !-------------------------------------------! MP - POINTER TO STACK USED FOR REPEATS RP - POINTER TO STACK USED FOR MACRO CALLS MACPNT - POINTER TO LIST OF ARG POINTERS (I.E. RP AT FIRST ARG) A MACRO CALL PRODUCES THE FOLLOWING STACK FRAME: MACPNT/ ---) PTR TO MACRO DEFINITION BODY ARG 1 ARG 2 .. 0 OLD MACPNT OLD C OLD RCOUNT RP/ ---) OLD MRP IRP VARIABLES: IRPARP POINTER TO ORIGINAL MACRO ARG IRPCF B0: 0=IRP, 1=IRPC IRPSW IRPARG ORIGINAL MACRO ARG IRPCNT READ COUNT IRPPOI ORIGIN OF BODY OF IRP RANGE \ ;END OF COMMENT DEFIN0: SKIPN UWVER ;WRITING UNV FILE? JRST DEF01 ;NO BITON UMAD,UWVER ;MACRO ARG DEF VALUE FIXED BIT DEF01: CALL GETSYM ;GET MACRO NAME JRST ERRAX ;EXIT ON ERROR MOVEM P,PPTMP1 ;SAVE POINTER MOVEM AC0,PPTMP2 ;SAVE NAME TLO IO,IORPTC FORERR (SX,DEF) SETOM INDEF ;AND FLAG IN DEFINE SETZB SX,.TEMP ;SET ARGUMENT AND REFERENCE COUNT SETZM COMSW ;AND COMMENT SWITCH DEF02: CALL GCHAR0 ;[1003] SEARCH FOR "(" OR "<" CALL COMTST ;IGNORE COMMENTS SKIPE COMSW ;INSIDE A COMMENT? JRST DEF02 ;YES, IGNORE CHARACTER CAIE C,")" ;MISSING "("? CAIN C,">" ;OR "<"? JRST DEFERR ;YES, GIVE ERROR, GET OUT OF DEF CAIN C,"<" ;"<"? JRST DEF20 ;YES CAIE C,"(" ;"("? JRST DEF02 ;NO DEF10: CALL GETSYM ;YES, GET DUMMY SYMBOL TRO ER,ERRA ;FLAG ERROR ADDI SX,1 ;INCREMENT ARG COUNT PUSH P,AC0 ;STACK IT JUMPCM DEF10 ;GET NEXT DUMMY SYMBOL IF COMMA CAIN C,'<' ;A DEFAULT ARGUMENT COMING UP? JRST DEF80 ;YES, STORE IT AWAY CAIE C,11 ;")"? JRST DEFERR ;NO, SYNTAX ERROR DEF12: CALL GCHAR0 ;[1003] CALL COMTST ;IGNORE COMMENTS SKIPE COMSW ;GET NEXT IF INSIDE COMMENT JRST DEF12 ;[574] CAIN C,">" ;MISSING "<"? JRST DEFERR ;YES, GIVE ERROR, LEAVE DEFINITION CAIE C,"<" ;"<"? JRST DEF12 ;NO DEF20: PUSH P,[0] ;YES, MARK THE LIST LSH SX,9 ;SHIFT ARG COUNT AOS ARG,SX CALL SKELI ;INITIALIZE MACRO SKELETON MOVE AC0,PPTMP2 ;GET NAME TLO IO,DEFCRS TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS CALL OPCFIX ;[736] FIX UP SYMTAB IF FORW-REF'ED CALL MSRCH ;SEARCH THE TABLE JRST DEF24 ;NOT FOUND TLNN ARG,MACF ;FOUND, IS IT A MACRO? TROA ER,ERRX ;NO, FLAG ERROR AND SKIP CALL REFDEC ;YES, DECREMENT THE REFERENCE DEF24: TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN HRRZ V,WWRXX ;GET START OF TREE SKIPN .TEMP ;ANY DEFAULT ARGUMENTS TO TAKE CARE OF? JRST DEF25 ;NO HRRZ C,1(V) ;GET SHIFTED ARG COUNT LSH C,-9 ;GET ARG COUNT BACK ADDI C,1 ;ONE MORE FOR TERMINAL ZERO ADD C,.TEMP ;NUMBER OF ITEMS IN STACK HRLS C ;MAKE XWD MOVE SDEL,.TEMP ;NUMBER OF WORDS NEEDED ADDI SDEL,1 ;PLUS THE 0 AT THE END ADDB SDEL,FREE ;FROM FREE CORE CAML SDEL,SYMBOL ;MORE CORE NEEDED CALL XCEEDS ;YES, TRY TO GET IT SUB SDEL,.TEMP ;FORM POINTER SUBI SDEL,1 ;MINUS THE 0 SUB P,C ;BACK UP STACK TO START OF ARGS HRLM SDEL,1(V) ;STORE IT WITH ARG COUNT IN MACRO SUBI SDEL,1 ;TO USE FOR PUSHING POINTER INTO STORAGE MOVEI C,1(P) ;POINT TO START OF STACK DEF26: MOVE ARG,(C) ;GET AN ITEM OFF STACK TLNN ARG,-40 ;A POINTER? JUMPN ARG,[PUSH SDEL,ARG ;YES, STORE IT AOJA C,DEF26] ;GET NEXT PUSH P,ARG ;RESTACK ARGUMENT SKIPE ARG ;FINISHED IF ZERO AOJA C,DEF26 ;GET NEXT PUSH SDEL,ARG ;STORE ZERO IN DEFAULT LIST ALSO DEF25: MOVSI ARG,MACF MOVEM P,PPTMP2 ;STORE TEMP STORAGE POINTER CALL INSERT ;INSERT/UPDATE TLZ IO,DEFCRS ;JUST IN CASE SETZM ARGF ;NO ARGUMENT SEEN SETZM SQFLG ;AND NO ' SEEN TDZA SDEL,SDEL ;CLEAR BRACKET COUNT DEF30: CALL WCHAR ;WRITE CHARACTER DEF31: CALL GCHAR0 ;[1003] GET A CHARACTER DEF32: MOVE CS,C ;GET A COPY CAIN C,";" ;IS IT A COMMENT JRST CPEEK ;YES CHECK FOR ;; DEF33: CAIG CS,"Z"+40 ;CONVERT LOWER CASE CAIGE CS,"A"+40 JRST .+2 SUBI CS,40 CAIGE CS,40 ;TEST FOR CONTROL CHAR. JRST [SKIPN SQFLG ;HAS SINGLE QUOTE BEEN SEEN? JRST DEF30 ;NO, OUTPUT THIS CHAR. PUSH P,C ;YES, SAVE CURRENT CHAR MOVEI C,47 ;SET UP QUOTE CALL WCHAR ;WRITE IT POP P,C ;GET BACK CURRENT CHAR. SETZM SQFLG ;RESET FLAG JRST DEF30] ;AND CONTINUE CAILE CS,77+40 JRST DEF30 ;TEST FOR SPECIAL MOVE CS,CSTAT-40(CS) ;GET STATUS BITS TLNE CS,6 ;ALPHA-NUMERIC? JRST DEF40 ;YES SKIPN SQFLG ;WAS A ' SEEN? JRST DEF36 ;NO, PROCESH PUSH P,C ;YES, SAVE CURRENT CHARACTER MOVEI C,47 ;AND PUT IN A ' CALL WCHAR ;... POP P,C ;RESTORE CURRENT CHARACTER SETZM SQFLG ;AND RESET FLAG DEF36: CAIE C,47 ;IS THIS A '? JRST DEF35 ;NOPE SKIPN ARGF ;YES, WAS LAST THING SEEN AN ARG? SETOM SQFLG ;IF NOT, SET SNGL QUOT FLAG SETZM ARGF ;BUT NOT ARGUMENT IN ANY CASE JRST DEF31 ;GO GET NEXT CHARACTER DEF35: SETZM ARGF ;THIS IS NOT AN ARGUMENT CAIN C,"<" ;"<"? AOJA SDEL,DEF30 ;YES, INCREMENT COUNT AND WRITE CAIN C,">" ;">"? SOJL SDEL,DEF70 ;YES, TEST FOR END JRST DEF30 ;NO, WRITE IT CPEEK: PUSH P,CS ;NEED TO SAVE CS, SINCE CHARAC MAY DESTROY IT CALL PEEK ;LOOK AT NEXT CHAR. POP P,CS ;RESTORE CS CAIN C,";" ;IS IT ;;? JRST CPEEK0 ;YES, GO SCAN LINE MATCHING ANGLE BRACKETS MOVE C,CS ;RESTORE C JRST DEF33 ;AND RETURN CPEEK0: SETZM CPEEKC ;CLEAR MATCHING ANGLE COUNTER CPEEK1: CALL GCHAR ;GET A CHARACTER CAIN C,"<" ;SEE IF LEFT ANGLE AOJA SDEL,CPEEKL ;YES, GO ADD TO COUNT CAIN C,">" ;SEE IF RIGHT ANGLE SOJA SDEL,CPEEKR ;YES, GO SUBTRACT FROM COUNT CAIG C,CR ;SEE IF AN CAIGE C,LF ;END OF LINE CHARACTER JRST CPEEK1 ;NO, CONTINUE CPEK1A: SKIPL CPEEKC ;YES, SEE IF UNMATCHED ANGLES JRST CPEEK3 ;NO, GO SEE IF END OF MACRO PUSH P,C ;SAVE EOL CHARACTER CPEEK2: MOVEI C,">" ;SET TO PUT IN SOME RIGHTS CALL WCHAR ;GO DO ONE AOSGE CPEEKC ;SEE IF ENOUGH JRST CPEEK2 ;NO, LOOP POP P,C ;RECOVER EOL CHARACTER CPEEK3: JUMPL SDEL,DEF70 ;IF END OF MACRO, LEAVE COMPLETELY JRST DEF32 ;AND GET OUT OF LINE CPEEKL: AOS CPEEKC ;ADD IN LEFT ANGLE BRACKET JRST CPEEK1 ;TO NEXT CHARACTER CPEEKR: JUMPL SDEL,CPEK1A ;JUMP IF END OF MACRO SOS CPEEKC ;SUBTRACT OUT RIGHT BRACKET JRST CPEEK1 ;CONTINUE DEF40: MOVEI AC0,0 ;CLEAR ATOM MOVSI AC1,(POINT 6,AC0) ;SET POINTER DEF42: PUSH P,C ;STACK CHARACTER TLNE AC1,770000 ;HAVE WE STORED 6? IDPB CS,AC1 ;NO, STORE IN ATOM CALL GCHAR ;GET NEXT CHARACTER MOVE CS,C CAIG CS,"Z"+40 CAIGE CS,"A"+40 JRST .+2 SUBI CS,40 ;CONVERT LOWER TO UPPER CAIL CS,40 CAILE CS,77+40 JRST DEF44 ;TEST SPECIAL MOVE CS,CSTAT-40(CS) ;GET STATUS TLNE CS,6 ;ALPHA-NUMERIC? JRST DEF42 ;YES, GET ANOTHER DEF44: PUSH P,[0] ;NO, MARK THE LIST MOVE SX,PPTMP1 ;GET POINTER TO TOP DEF46: SKIPN 1(SX) ;END OF LIST? JRST DEF50 ;YES CAME AC0,1(SX) ;NO, DO THEY COMPARE? AOJA SX,DEF46 ;NO, TRY AGAIN SUB SX,PPTMP1 ;YES, GET DUMMY SYMBOL NUMBER LSH SX,4 MOVSI CS,<(BYTE (7) 177,101)>(SX) ;SET ESCAPE CODE MACEND LSH AC0,-^D30 CAIN AC0,5 ;"%"? TLO CS,1000 ;YES, SET CRESYM FLAG CALL WWORD ;WRITE THE WORD SETOM ARGF ;SET ARGUMENT SEEN FLAG SETZM SQFLG ;AND IGNORE ANY ' WAITING TO GET INTO STRING DEF48: MOVE P,PPTMP2 ;RESET PUSHDOWN POINTER TLO IO,IORPTC ;ECHO LAST CHARACTER JRST DEF31 ;RECYCLE DEF50: SKIPN SQFLG ;HAVE WE SEEN A '? JRST DEF51 ;NOPE MOVEI C,47 ;YES, PUT IT IN CALL WCHAR ;... SETZM SQFLG ;AND CLEAR FLAG DEF51: MOVE C,2(SX) ;GET CHARACTER JUMPE C,DEF48 ;CLEAN UP IF END CALL WCHAR ;WRITE THE CHARACTER AOJA SX,DEF51 ;GET NEXT DEF70: MOVE P,PPTMP1 ;RESTORE PUSHDOWN POINTER MOVSI CS,(BYTE (7) 177,1) CALL WWRXE ;WRITE END SETZM INDEF ;OUT OF IT JRST BYPASS ;[664] ; HERE TO STORE DEFAULT ARGUMENTS DEF80: AOS .TEMP ;COUNT ONE MORE CALL SKELI1 ;INITIALIZE SKELETON HRL V,SX ;SYMBOL NUMBER PUSH P,V ;STORE POINTER TDZA SDEL,SDEL ;ZERO BRACKET COUNT DEF81: CALL WCHAR ;[664] WRITE A CHARACTER CALL GCHAR0 ;[1003] GET A CHARACTER CAIN C,"<" ;ANOTHER "<"? AOJA SDEL,DEF81 ;YES, INCREMENT AND WRITE CAIE C,">" ;CLOSING ANGLE? JRST DEF81 ;NO, JUST WRITE THE CHAR. SOJGE SDEL,DEF81 ;YES, WRITE IF NOT END MOVSI CS,(BYTE (7) 177,2) CALL WWRXE ;WRITE END OF DUMMY ARGUMENT CALL GCHAR ;READ AT NEXT CHAR. CAIE C,")" ;END OF ARGUMENT LIST? JRST DEF10 ;NO, GET NEXT SYMBOL JRST DEF12 ;YES, LOOK FOR "<" DEFERR: PUSH P,['MCRISD'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN MACRO DEFINITION@/] ;[1066][574] MOVE AC0,PPTMP2 ;GET MACRO NAME SETZM INDEF ;[702] WANT MORE USEFUL INFO JRST ERRNE4 ;[702] GIVE ERROR, RESET STACK, LEAVE DEF SUBTTL MACRO CALL PROCESSOR CALLM: SKIPGE MACENL ;ARE WE TRYING TO RE-ENTER? JRST ERRAX ;YES, BOMB OUT WITH ERROR SETZM CRLFSN ;[1064] INIT FLAG IN CASE WE SEE LALL HRROS MACENL ;FLAG "CALLM IN PROGRESS" EXCH MP,RP PUSH MP,V ;STACK FOR REFDEC EXCH MP,RP MOVEM AC0,CALNAM ;SAVE MACRO NAME IN CASE OF ERROR FORERR (SDEL,CAL) ADDI V,1 ;POINT TO DUMMY SYMBOL COUNT AOS SDEL,0(V) ;INCREMENT ARG COUNT HLLZM SDEL,.TEMP ;DEFAULT ARG POINTER IF NON-ZERO LDB SX,[POINT 9,SDEL,26] ;GET ARG COUNT MOVEI SDEL,0 ;INIT PAREN COUNTER SKIPE .TEMP ;IF AT LEAST ONE DEFAULT ARG HRRM SX,.TEMP ;STORE COUNT OF ARGS PUSH P,V ;STACK FOR MRP PUSH P,RP ;STACK FOR MACPNT JUMPE SX,MAC20 ;TEST FOR NO ARGS MAC13: CALL CHARAC SKIPN MACTAB ;IF MACTAB=0..NEW ARG HANDLING V51 JRST .+3 ;ASSUME ITABM=0 SKIPE ITABM ;NEW FORMAT ARG HANDLING? JRST MAC13A ;NO, DON'T FLUSH TAB/SP CAIE C," " ;FLUSH LEADING TABS AND SPACES CAIN C,HT JRST MAC13 MAC13A: CAIE C,"(" ;"(" TLOA SDEL,-1 ;NO, FUDGE PAREN COUNT AND SKIP MAC10: CALL GCHAR ;GET A CHARACTER, LOOK FOR AN ARG JUMPGE SDEL,MAC11 ;SKIP TEST IF IN () CAIG C,CR CAIGE C,LF CAIN C,";" ;";"? JRST MAC21 ;YES, END OF ARGUMENT STRING MAC11: SKIPN MACTAB ;IF MACTAB=0..NEW ARG HANDLING V51 JRST [JUMPL SDEL,.+3 ;[1032] .XTABM IF NOT IN (), JRST MAC11A] ;[1032] .ITABM IF IN (). SKIPE ITABM ;MAC51 ARG HANDLING? JRST MAC11A ;NO CAIE C," " ;YES, ELIMINATE LEADING TABS AND SPACES CAIN C,HT JRST MAC10 ;[1032] MAC11A: SKIPLE SX ;SKIP IF NO ARGS LEFT CALL SKELI1 ;NO, INITIALIZE SKELETON CAIN C,"<" ;"<"? JRST MAC30 ;YES, PROCESS AS SPECIAL CAIE C,176 CAIN C,134 ;"\" JRST MAC40 ;YES, PROCESS SYMBOL ;.. MAC14: CAIN C,"," ;","? JRST [JUMPG SDEL,MAC14B ;[656] YES, IGNORE IF PART OF ARG JRST MAC16] ;[656] OTHERWISE END OF ARG JUMPGE SDEL,[CAIN C,"(" ;IF IN (), CHECK AND COUNT AOS SDEL ;.. CAIN C,")" ;.. SOJL SDEL,MAC16 ;JUMP IF END OF ARGLIST SKIPE MACTAB ;[1032] IF NOT MACMPD, JRST MAC14C ;[1032] DO .XTABM/.ITABM TEST JRST MAC14B] ;[1032] ELSE FORCE .ITABM IN () SKIPN MACTAB ;[671] NEW ARG HANDLING IF MACTAB=0 JRST .+3 ;[671] ASSUME ITABM=0 MAC14C: SKIPE ITABM ;[1032] OLD FORMAT WANTED? JRST MAC14B ;YES, NO FURTHER CHECKS CAIE C," " ;SPACE OR TAB? CAIN C,HT JRST MACTB ;YES, GO SEE WHAT FOLLOWS SKIPE MACTAB ;[671] SKIP REST IF OLD FORMAT JRST MAC14B ;NO JUMPGE SDEL,MAC14B ;[1032] IF IN PARENS NO FURTHER CHECKS CAIN C,42 ;A QUOTE MARK? JRST MAC12B ;YES, GO QUOTE TIL ANOTHER QUOTE CAIN C,"<" ;OPEN ANG BKT? JRST MAC12 ;YES, QUOTE TO CLOSE CAIE C,"(" CAIN C,"[" ;CHECK FOR BKTS AND PARENS JRST MAC12 ;OPEN BKT, GO SCAN TO CLOSE BKT CALL SKPNTM ;CHECK FOR UNMATCHED TERMINATORS JRST MAC9 ;FOUND ONE, END OF ARG LIST MAC14B: SKIPLE SX ;IGNORE IF NO ARGS LEFT CALL WCHAR ;WRITE INTO SKELETON MAC14A: JUMPGE SDEL,[CALL GCHAR ;[673] IF IN (), LIST CRLFS CORRECTLY JRST .+2] ;[673] THEN SKIP LOCAL CALL CALL CHARAC ;GET NEXT CHARACTER CAIE C,177 ;RUB-OUT? JRST MAC14E ;NO, MOVSI CS,(BYTE (7) 177,5) ;YES, A REAL RUBOUT, PUT INTO SKELETON CALL WWRXE ;(177,5) JRST MAC14A MAC14E: JUMPGE SDEL,MAC14 ;IGNORE TEST IF IN () CAIG C,CR CAIGE C,LF CAIN C,";" JRST MAC15 JRST MAC14 ;JUMP IF NOT END OF LINE MAC9: SETOM SDEL ;FORCE END OF ARG LIST MAC15: TLO IO,IORPTC MAC16: JUMPLE SX,MAC17 ;SKIP IF NO ARGS LEFT MOVSI CS,(BYTE (7) 177,2) CALL WWRXE ;WRITE END EXCH MP,RP PUSH MP,WWRXX EXCH MP,RP MAC17: SUBI SX,1 ;DECREMENT ARG COUNT JUMPGE SDEL,MAC10 ;IF IN () KEEP LOOKING TRNN SDEL,1B18 ;SKIP LOOKING IF SEEN ")" JUMPG SX,MAC10 ;NO, BUT MORE ARGS TO COME MAC20: TLZN IO,IORPTC CALL CHARAC MAC21: EXCH MP,RP JUMPE SX,MAC21B ;NO MISSING ARGS MAC21A: PUSH MP,[-1] ;FILL IN MISSING ARGS SKIPN .TEMP ;ANY DEFAULT ARGS? JRST MAC21C ;NO HRRZ C,.TEMP ;GET ARG COUNT SUBI C,-1(SX) ;ACCOUNT FOR THOSE GIVEN HRLZS C ;PUT IN LEFT HALF HLRZ SDEL,.TEMP ;ADDRESS OF TABLE MAC21D: SKIPN (SDEL) ;END OF LIST JRST MAC21C ;YES XOR C,(SDEL) ;TEST FOR CORRECT ARG TLNN C,-1 ;WAS IT? JRST MAC21E ;YES XOR C,(SDEL) ;BACK THE WAY IT WAS AOJA SDEL,MAC21D ;AND TRY AGAIN MAC21E: MOVEM C,(MP) ;REPLACE -1 WITH TREE POINTER AOS 1(C) ;INCREMENT REFERENCE MAC21C: SOJG SX,MAC21A MAC21B: PUSH MP,[0] ;SET TERMINAL EXCH MP,RP ;[1015] HRRZ C,LIMBO TLNN IO,IOSALL ;SUPPRESSING ALL? JRST MAC23 ;NO JUMPN MRP,MAC27 ;IN MACRO? CALL SEMSRC ;CHECK FOR IMMEDIATE COMMENT JRST MAC26 ;NOT FOUND, CONTINUE MAC22: CALL CHARAC ;YES,GET IT INTO THE LBUF CAIG C,CR ;LESS THAN CR? CAIGE C,LF ;AND GREATER THAN LF? JRST MAC22 ;NO GET ANOTHER MAC26: CALL DECLBP ;DECREMENT LINE BUFFER POINTER MAC27: HRLI C,-1 ;SET FLAG JRST MAC25 MAC23: SKIPN MRP ;[1072] INSIDE A MACRO? TLZ IO,IOMAC ;[1072] NO - CLEAR EXPANSION FLAG FOR LISTING MOVEI SX,"^" DPB SX,LBUFP ;SET ^ INTO LINE BUFFER JUMPAD MAC25 ;BRANCH IF ADDRESS FIELD JUMPN MRP,MAC25 ;BRANCH IF ALREADY IN A MACRO SKIPN LITLVL ;BRANCH IF WITHIN A LITERAL SKIPE RPOLVL ;OR IN A REPEAT JRST MAC25 CALL RSW3 ;OUTPUT C AGAIN (OVERWRITTEN BY "^") CALL SEMSRC ;LOOK FOR A COMMENT JRST MAC24 ;NO COMMENT CONTINUE CALL STOUT ;LIST COMMENT OR CR-LF TLNE IO,IOPALL ;MACRO EXPANSION SUPPRESSION? TLO IO,IOMAC ; NO, SET TEMP BIT TDOA C,[-1] ;FLAG LAST CHARACTER MAC24: CALL DECLBP ;DECREMENT BYTE POINTER MAC25: EXCH MP,RP ;[1015] PUSH MP,MACPNT POP P,MACPNT PUSH MP,C PUSH MP,RCOUNT ;STACK WORD COUNT PUSH MP,MRP ;STACK MACRO POINTER POP P,MRP ;SET NEW READ POINTER EXCH MP,RP AOS MACLVL HRRZS MACENL ;RESET "CALLM IN PROGRESS" JUMPOC STMNT2 ;OP-CODE FIELD JRST EVATOM ;ADDRESS FIELD ;ROUTINE TO LOOK FOR A SEMICOLON, IGNORING SPACES AND TABS ; SKIP IF FOUND CALL CHARAC ;FETCH ANOTHER CHARACTER SEMSRC: CAIE C," " ;SPACE? CAIN C,HT ;OR TAB? JRST .-3 ;YES, GET ANOTHER CHARACTER CAIN C,";" ;NO, SEMICOLON? CPOPJ1: AOS (P) ;[664] YES, SKIP RETURN CPOPJ: RET ;[664] ;ROUTINE TO DECREMENT BYTE POINTER LBUFP DECLBP: HRLZI SX,70000 ;INCREASE P FIELD BY 1 BYTE ADDB SX,LBUFP JUMPGE SX,CPOPJ ;RETURN IF NO OVERFLOW HRLOI SX,347777 ;OVERFLOW, BACKUP ONE WORD ADDM SX,LBUFP RET ;HERE WHEN ENCOUNTERED UNQUOTED TAB OR SPACE IN MACRO ARGUMENT. ;"LOOK AHEAD" TO SEE IF END OF ARG LIST COMING UP. ;IF ARG LIST END FOUND, FLUSH TRAILING TABS/SPACES, OTHERWISE ;KEEP THEM. BUFFER TAB/SPACE STRING ON STACK. MACTB: MOVE AC2,P ;SAVE CURRENT STACK PTR HRRZ AC1,AC2 ;CONSTRUCT BYTE PTR TO STACK HRLI AC1,() ;.. MOVEI AC0,0 ;INIT CHAR COUNT MACTB1: TLNN AC1,(76B5) ;NEED ANOTHER STACK WORD? PUSH P,[0] ;YES, GET IT IDPB C,AC1 ;BUILD TEMP STRING AOS AC0 ;COUNT CHARS STORED CALL CHARAC ;GET NEXT CHAR CAIE C," " ;ANOTHER SPACE OR TAB? CAIN C,HT ;.. JRST MACTB1 ;YES, KEEP SCANNING PUSH P,C ;NO, SAVE IT JUMPGE SDEL,[CAIE C,"," ;[1032] SPECIAL CHECKS FOR PARENS CAIN C,")" ;[1032] ARG TERMINATORS ARE JRST MACTB2 ;[1032] COMMA AND CLOSE PAREN JRST MACTB4] ;[1032] ELSE RETAIN TAB/SPACE CAIG C,CR ;END OF LINE? CAIGE C,LF ;.. CAIN C,";" ;OR SEMICOLON? JRST MACTB2 ;YES, FLUSH TEMP STRING CAIE C,"," ;END OF ARGUMENT? CALL [SKIPE MACTAB ;[664] OR ARG LIST TERMINATOR? JRST CPOPJ1 ;[664] (SKIP RETURN IF OLD FORMAT) PJRST SKPNTM] ;[664] JRST MACTB2 ;YES MACTB4: HRRZ AC1,AC2 ;[1032] NO, MUST KEEP TEMP STRING HRLI AC1,() ;REINIT BYTE PTR MACTB3: ILDB C,AC1 ;COPY TEMP STRING TO SKELETON SKIPLE SX ;UNLESS HAVE ALL ARGS NOW CALL WCHAR ;.. SOJG AC0,MACTB3 ;.. MACTB2: POP P,C ;RECOVER LAST CHAR MOVEM AC2,P ;FLUSH TEMP STRING FROM STACK JRST MAC14E ;CONTINUE PROCESSING ;TEST FOR UNMATCHED BRACKETING PAIR - TERMINATES ARG LIST IF NOT ;QUOTED. SKPNTM: CAIE C,")" ;[664] PAIRS ARE PARENS, BRACKETS, AND CAIN C,"]" ;ANG BKTS RET ;TERMINATOR, NOSKIP CAIE C,">" AOS 0(P) ;[664] NON-TERMINATOR, SKIP RET ;HERE ON OPEN ANG BKT AS FIRST CHAR IN ARG MAC30: MOVEI AC0,0 ;INITIALIZE BRACKET COUNTER MAC31: CALL GCHAR ;GET A CHARACTER CAIN C,"<" ;"<"? ADDI AC0,1 ;YES, INCREMENT COUNT CAIN C,">" ;">"? SOJL AC0,MAC14A ;YES, EXIT IF MATCHING SKIPLE SX ;IGNORE IF NO ARGS LEFT CALL WCHAR ;WRITE INTO SKELETON JRST MAC31 ;GO BACK FOR ANOTHER ;HERE IF ENCOUNTERED UNQUOTED "<", "[", OR "(". SCAN TO MATCHING ;CLOSE WITHOUT TERMINATING ARG. MAC12: MOVEI AC0,0 ;INIT BKT COUNT PUSH P,C ;SAVE CHAR CAIN C,"<" ;GET MATCHING CLOSE CHARACTER MOVEI C,">" CAIN C,"[" MOVEI C,"]" CAIN C,"(" MOVEI C,")" PUSH P,C ;SAVE TERMINATOR MOVE C,-1(P) ;GET ORIG CHAR MAC12A: SKIPLE SX ;FLUSH CHAR IF NO ARGS LEFT CALL WCHAR ;STOR CHAR CAMN C,-1(P) ;ANOTHER OPEN? AOS AC0 ;YES, COUNT UP CAMN C,0(P) ;A CLOSE? SOJLE AC0,[SUB P,[2,,2] ;YES. IF MATCH, CLEAR STACK JRST MAC14A] ;AND RESUME NORMAL SCAN CALL GCHAR ;GET NEXT CHAR JRST MAC12A ;CONTINUE SCAN ;HERE IF ENCOUNTERED UNQUOTED QUOTED MARK. ;SCAN TO ANOTHER QUOTE MARK WITHOUT TERMINATING ARG. MAC12B: PUSH P,C ;SAVE THE QUOTE MARK MAC12C: SKIPLE SX ;FLUSH CHAR IS NO ARGS LEFT CALL WCHAR ;WRITE IT OUT CALL GCHAR ;GET NEXT CHAR CAME C,0(P) ;ANOTHER QUOTE MARK? JRST MAC12C ;NO, LOOP SKIPLE SX ;YES, DECIDE TO WRITE OR SKIP CALL WCHAR ;WRITE QUOTE MARK OUT POP P,0(P) ;CLEAR STACK JRST MAC14A ;RESUME NORMAL SCAN ;HERE ON BACKSLASH AS FIRST CHAR IN ARG MAC40: PUSH P,SX ;STACK REGISTERS PUSH P,SDEL PUSH P,IO ;SAVE IO FLAGS PUSH P,CURADX ;[635] DEFAULT VALUES POP P,MACDVR ;[635] FOR DIVISOR MOVEI AC1,"0" ;[635] AND ADDER MOVEM AC1,MACADR ;[635] CALL PEEK ;[635] CHECK NEXT CHAR CAIN C,47 ;[635] SINGLE-QUOTE? JRST [ CALL GETCHR ;[635] YES, MOVEI AC1,100 ;[635] MOVEM AC1,MACDVR ;[635] MOVEI AC1,40 ;[635] MOVEM AC1,MACADR ;[635] JRST MAC43] ;[635] CAIN C,42 ;[635] DOUBLE-QUOTE? JRST [ CALL GETCHR ;[635] YES, MOVEI AC1,200 ;[635] MOVEM AC1,MACDVR ;[635] SETZM MACADR ;[635] JRST MAC43] ;[635] MAC43: CALL CELL ;[635] GET AN ATOM MOVE V,AC0 ;ASSUME NUMERIC TLNE IO,NUMSW ;GOOD GUESS? JRST MAC41 ;YES CALL SSRCH ;SEARCH THE SYMBOL TABLE TROA ER,ERRX ;NOT FOUND, ERROR MAC41: CALL MAC42 ;FORM ASCII STRING TLNE IO,IOCREF ;[704] IOCREF SET DURING CALL TO SSRCH? JRST [HLL IO,0(P) ;[704] YES, DON'T LOSE IT TLO IO,IOCREF ;[704] JRST .+2] ;[704] HLL IO,0(P) ;RESTORE IO FLAGS POP P,0(P) ;FLUSH TEMP POP P,SDEL POP P,SX TLO IO,IORPTC ;REPEAT LAST CHARACTER JRST MAC14A ;RETURN TO MAIN SCAN MAC42: MOVE SX,-3(P) ;[1127] GET ARG COUNT JUMPLE SX,CPOPJ ;[1127] NO ARGS LEFT MOVE C,V MAC44: LSHC C,-^D35 LSH CS,-1 DIV C,MACDVR ;[635] DIVIDE BY THE RIGHT DIVISOR HRLM CS,0(P) JUMPE C,.+2 ;TEST FOR END CALL MAC44 HLRZ C,0(P) ADD C,MACADR ;[635] ADD THE RIGHT ADDER TO FORM TEXT JRST WCHAR ;WRITE INTO SKELETON MACEN0: SOS MACENL MACEND: HRRZ C,0(P) ;GET TOP ADDRESS CAIN C,MAC14E ;WERE WE LOOKING FOR CLOSE PAREN? JUMPGE SDEL,MPAERR ;YES, GIVE USEFUL ERROR MESSAGE SKIPGE C,MACENL ;TEST "CALLM IN PROGRESS" AOS MACENL ;INCREMENT END LEVEL AND EXIT JUMPL C,REPEA8 EXCH MP,RP POP MP,MRP ;RETRIEVE READ POINTER POP MP,RCOUNT ;AND WORD COUNT MOVEI C,"^" SKIPL 0(MP) ;TEST FLAG CALL RSW2 ;MARK END OF SUBSTITUTION POP MP,C POP MP,ARG SKIPA MP,MACPNT ;RESET MP AND SKIP MACEN1: CALL REFDEC ;DECREMENT REFERENCE MACEN2: AOS V,MACPNT ;GET POINTER MOVE V,0(V) JUMPG V,MACEN1 ;IF >0, DECREMENT REFERENCE JUMPL V,MACEN2 ;IF <0, BYPASS POP MP,V ;IF=0, RETRIEVE POINTER CALL REFDEC ;DECREMENT REFERENCE MOVEM ARG,MACPNT EXCH MP,RP SOS MACLVL SKIPN MACENL ;CHECK UNPROCESSED END LEVEL JRST MACEN3 ;NONE TO PROCESS TRNN MRP,-1 ;MRP AT END OF TEXT JRST MACEN0 ;THEN POP THE MACRO STACK NOW MACEN3: TRNN C,77400 ;SALL FLAG? HRLI C,0 ;YES,TURN IT OFF JUMPL C,REPEA8 ;IF FLAG SET SUBSTITUTE JRST RSW2 IRP0: SKIPN MACLVL ;ARE WE IN A MACRO? JRST ERRAX ;NO, BOMB OUT IRP10: CALL MREADS ;YES, GET DATA SPEC CAIE C,40 ;SKIP LEADING BLANKS CAIN C,"(" ;"("? JRST IRP10 ;YES, BYPASS CAIE C,"<" CAIN C,11 JRST IRP10 CAIE C,177 ;NO, IS IT SPECIAL? JRST ERRAX ;NO, ERROR CALL MREADS ;YES TRZN C,100 ;CREATED? JRST ERRAX CAIL C,40 ;TOO BIG? JRST ERRAX ADD C,MACPNT ;NO, FORM POINTER TO STACK PUSH MP,IRPCF ;STACK PREVIOUS POINTERS PUSH MP,IRPSW PUSH MP,IRPARP PUSH MP,IRPARG PUSH MP,IRPCNT PUSH MP,0(C) PUSH MP,IRPPOI HRRZM C,IRPARP MOVEM AC0,IRPCF ;IRPC FLAG FOUND IN AC0 SETOM IRPSW ;RESET IRP SWITCH MOVE CS,0(C) MOVEM CS,IRPARG IRP15: CALL MREADS ;GET A CHARACTER LOOKING FOR "<" CAIE C,"<" ;"<"? JRST [ CAIE C,"," ;ALLOW COMMA CAIG C," " ;ALLOW TEST FORMATTING CHARS JRST IRP15 ;IT WAS ONE, JUST GET ANOTHER CAIE C,")" ;ALLOW ) CAIN C,">" ;ALLOW RIGHT ANGLE BRACKET JRST IRP15 ;GO BACK FOR ANOTHER JRST IRPMBI] ;CAN'T FIND BRACKET, IT'S AN ERROR CALL SKELI1 ;INITIALIZE NEW STRING MOVEM ARG,IRPPOI ;SET NEW POINTER TDZA SDEL,SDEL ;ZERO BRACKET COUNT AND SKIP IRP20: CALL WCHAR ;[664] CALL MREADS CAIN C,"<" ;"<"? AOJA SDEL,IRP20 ;YES, INCREMENT COUNT AND WRITE CAIE C,">" ;">"? JRST IRP20 ;NO, JUST WRITE IT SOJGE SDEL,IRP20 ;YES, WRITE IF NOT MATCHING MOVE CS,[BYTE (7) 15,177,4] CALL WWRXE ;WRITE END PUSH MP,MRP ;STACK PREVIOUS READ POINTER PUSH MP,RCOUNT ;AND WORD COUNT SKIPG CS,IRPARG JRST IRPPOP ;EXIT IF NOT VALID ARGUMENT MOVEI C,1(CS) ;INITIALIZE POINTER MOVEM C,IRPARG IRPSET: EXCH MRP,IRPARG ;SWAP READ POINTERS MOVE SX,RCOUNT ;SWAP COUNT OF WORDS TO READ EXCH SX,IRPCNT MOVEM SX,RCOUNT CALL SKELI1 ;INITIALIZE SKELETON FOR DATA HRRZM ARG,@IRPARP ;STORE NEW DS POINTER SETZB SX,SDEL ;ZERO FOUND FLAG AND BRACKET COUNT LDB C,MRP ;GET LAST CHAR CAIN C,"," SKIPE IRPCF ;IN IRPC JRST IRPSE1 ;NO MOVEI SX,1 ;FORCE ARGUMENT IRPSE1: CALL MREADS CAIE C,177 ;SPECIAL? AOJA SX,IRPSE2 ;NO, FLAG AS FOUND CALL PEEKM ;LOOK AT NEXT CHARACTER SETZM IRPSW ;SET IRP SWITCH JUMPG SX,IRPSE4 ;IF ARG FOUND, PROCESS IT JRST IRPPOP ;NO, CLEAN UP AND EXIT IRPSE2: SKIPE IRPCF ;IRPC? JRST IRPSE3 ;YES, WRITE IT CAIN C,"," ;NO, IS IT A COMMA? JUMPE SDEL,IRPSE4 ;YES, EXIT IF NOT NESTED CAIN C,"<" ;"<"? ADDI SDEL,1 ;YES, INCREMENT COUNT CAIN C,">" ;">"? SUBI SDEL,1 ;YES, DECREMENT COUNT IRPSE3: CALL WCHAR SKIPN IRPCF ;IRPC? JRST IRPSE1 ;NO, GET NEXT CHARACTER IRPSE4: MOVSI CS,(BYTE (7) 177,2) CALL WWRXE ;WRITE END MOVEM MRP,IRPARG ;SAVE POINTER MOVE MRP,RCOUNT ;SAVE COUNT MOVEM MRP,IRPCNT HRRZ MRP,IRPPOI ;SET FOR NEW SCAN AOJA MRP,REPEA8 ;ON ARG COUNT IRPMBI: PUSH P,['MCRISI'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] SKIPN IRPCF ;IRPC? JRST [MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN IRP INSIDE MACRO@/] ;[1066][702] JRST IRPERR] MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN IRPC INSIDE MACRO@/] ;[1066][702] IRPERR: MOVE AC0,CALNAM ;[702] FETCH MACRO NAME CALL EFATAL ;[1066] FATAL ERROR, TYPE PREFIX CALL TYPMSG ;OUTPUT MESSAGE JUMP1 .+2 ;ONLY COUNT ERROR ONCE AOS ERRCNT ;DO DURING PASS 2 JRST ERRNE2 ;COMMON MESSAGE STOPI0: SKIPN IRPARP ;IRP IN PROGRESS? JRST ERRAX ;NO, ERROR SETZM IRPSW ;YES, SET SWITCH RET IRPEND: MOVE V,@IRPARP CALL REFDEC SKIPE IRPSW ;MORE TO COME? JRST IRPSET ;YES IRPPOP: MOVE V,IRPPOI CALL REFDEC ;DECREMENT REFERENCE POP MP,RCOUNT POP MP,MRP ;RESTORE CELLS POP MP,IRPPOI POP MP,@IRPARP POP MP,IRPCNT POP MP,IRPARG POP MP,IRPARP POP MP,IRPSW POP MP,IRPCF JRST REPEA8 GETDS: ;GET DUMMY SYMBOL NUMBER MOVE CS,C ;USE CS FOR WORK REGISTER ANDI CS,37 ;MASK ADD CS,MACPNT ;ADD BASE ADDRESS MOVE V,0(CS) ;GET POINTER FLAG JUMPG V,GETDS1 ;BRANCH IF POINTER TRNN C,40 ;NOT POINTER, SHOULD WE CREATE? JRST RSW0 ;NO, FORGET THIS ARG PUSH P,WWRXX PUSH P,MWP ;STACK MACRO WRITE POINTER PUSH P,WCOUNT ;SAVE WORD COUNT CALL SKELI1 ;INITIALIZE SKELETON MOVEM ARG,0(CS) ;STORE POINTER MOVE CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL ADD CS,LSTSYM ;LSTSYM= # OF LAST CREATED TDZ CS,[BYTE (7) 0,170,170,170,170] MOVEM CS,LSTSYM TLZE CS,774000 ;[1053] ZERO ANY OVERFLOW INTO ".." FIELD TRO ER,ERRX ;[1053] X-ERROR FOR EXCEEDING "..7777" IOR CS,[ASCII /.0000/] MOVEI C,"." CALL WCHAR CALL WWORD ;WRITE INTO SKELETON MOVSI CS,(BYTE (7) 177,2) CALL WWRXE ;WRITE END CODE POP P,WCOUNT ;RESTORE WORD COUNT POP P,MWP ;RESTORE MACRO WRITE POINTER POP P,WWRXX MOVE V,ARG ;SET UP FOR REFINC GETDS1: CALL REFINC ;INCREMENT REFERENCE HRL V,RCOUNT ;SAVE WORD COUNT PUSH MP,V ;STACK V FOR DECREMENT PUSH MP,MRP ;STACK READ POINTER MOVEI MRP,1(V) ;FORM READ POINTER JRST RSW0 ;EXIT DSEND: POP MP,MRP POP MP,V HLREM V,RCOUNT ;RESTORE WORD COUNT HRRZS V ;CLEAR COUNT CALL REFDEC ;DECREMENT REFERENCE JRST RSW0 ;EXIT SKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG SKELI: SETZ MWP, ;SIGNAL FIRST TIME THROUGH CALL SKELWL ;GET POINTER WORD HRRZM MWP,WWRXX ;SAVE FIRST ADDRESS HRRZM MWP,LADR ;SAVE START OF LINKED LIST HRRZM ARG,1(MWP) ;STORE COUNT SOS WCOUNT ;ACCOUNT FOR WORD HRRZ ARG,WWRXX ;SET FIRST ADDRESS ADDI MWP,2 ;BUMP POINTER HRLI MWP,(POINT 7) ;SET FOR 5 ASCII BYTES ;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT) SKELW: SOSLE WCOUNT ;STILL SOME SPACE IN LEAF? RET ;YES, RETURN SKELWL: SKIPE V,NEXT ;GET FIRST FREE ADDRESS JRST SKELW1 ;IF NON-ZERO, UPDATE FREE MOVE V,FREE ;GET FREE ADDI V,.LEAF ;INCREMENT BY LEAF SIZE CAML V,SYMBOL ;OVERFLOW? CALL XCEED ;YES, BOMB OUT EXCH V,FREE ;UPDATE FREE SETZM (V) ;CLEAR LINK SKELW1: HLL V,0(V) ;GET ADDRESS HLRM V,NEXT ;UPDATE NEXT SKIPE MWP ;IF FIRST TIME HRLM V,1-.LEAF(MWP) ;STORE LINK IN FIRST WORD OF LEAF MOVEI MWP,.LEAF ;SIZE OF LEAF MOVEM MWP,WCOUNT ;STORE FOR COUNT DOWN MOVEI MWP,(V) ;SET UP WRITE POINTER TLO MWP,(POINT 7,,20) ;2 ASCII CHARS RET ;WWRXX POINTS TO END OF TREE ;MWP IDPB POINTER TO NEXT HOLE ;NEXT FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES) ;FREE POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE ;LADR POINTS TO BEG OF LINKED PORTION. GCHARQ: JUMPN MRP,MREADS ;IF GETTING CHAR. FROM TREE GCHAR0: CALL CHARAC ;[1003] GET ASCII CHAR CAIE C,FF ;[1003] FF? JRST GCHAR1 ;[1003] NO, CHECK RANGE PUSH P,C ;[1003] YES, SET IF AT START OF LINE MOVE C,CPL ;[1003] ADDI C,1 ;[1003] COMPENSATE FOR FF CAME C,CPLSAV ;[1003] JRST [ POP P,C ;[1003] NO, ALL IS OK JRST GCHAR2] ;[1003] CHECK FOR ERRORS, LIST POP P,C ;[1003] OUTFF3: CALL OUTFF1 ;[1003] COMMON ROUTINE TO SET IOPAGE CALL OUTLI ;[1003] CLEAR LBUF SOS TAGINC ;[1003] RECOVER CORRECT OFFSET RET ;[1003] RETURN WITH FF IN C GCHAR: CALL CHARAC ;GET ASCII CHARACTER GCHAR1: CAIG C,FF ;[753] TEST FOR LF, VT OR FF CAIGE C,LF RET ;NO GCHAR2: TRNN ER,ERRORS ;[1003][663] YES, ERRORS? JRST OUTIM1 ;[663] NO, NORMAL IMAGE TRNN ER,ERROR1 ;[663] ONLY PASS1 ERRORS IN PASS1 JUMP1 OUTIM1 ;[663] TLO FR,IOSCR ;[663] SET IMAGE/CRLF FLAG JRST OUTLIN ;[663] OUTPUT LINE, EXIT BY OUTLI1 WCHAR: TLNN MWP,760000 ;[664] END OF WORD? CALL SKELW ;YES, GET ANOTHER IDPB C,MWP ;STORE CHARACTER RET WWORD: LSHC C,7 ;MOVE ASCII INTO C CALL WCHAR ;[664] STORE IT JUMPN CS,WWORD ;TEST FOR END RET ;YES, EXIT WWRXE: CALL WWORD ;WRITE LAST WORD ADD MWP,WCOUNT ;GET TO END OF LEAF SUBI MWP,.LEAF ;NOW POINT TO START OF IT HRRZS (MWP) ;ZERO LEFT HALF OF LAST LEAF HRRM MWP,@WWRXX ;SET POINTER TO END RET MREAD: CALL MREADS ;READ ONE CHARACTER CAIE C,177 ;SPECIAL? JRST RSW1 ;NO, EXIT CALL MREADS ;YES, GET CODE WORD TRZE C,100 ;SYMBOL? JRST GETDS ;YES CAILE C,5 ;POSSIBLY ILLEGAL JRST ERRAX ;YUP HRRI MRP,0 ;NO, SIGNAL END OF TEXT JRST .+1(C) CALL XCEED JRST MACEND ;1; END OF MACRO JRST DSEND ;2; END OF DUMMY SYMBOL JRST REPEND ;3; END OF REPEAT JRST IRPEND ;4; END OF IRP JRST RSW1 ;5; RUBOUT MREADI: HRLI MRP,700 ;SET UP BYTE POINTER MOVEI C,.LEAF-1 ;NUMBER OF WORDS MOVEM C,RCOUNT MREADS: TLNN MRP,-1 ;FIRST TIME HERE? JRST MREADI ;YES, SET UP MRP AND RCOUNT TRNN MRP,400000 ;[1061] IF MRP IS ZERO, NEGATIVE OR TRNN MRP,-1 ;[1061] GREATER THAN 400000, JRST DECERR ;[1061] CONFUSED WHILE EXPANDING (E.G., ;[1061] UNQUOTED, UNMATCHED "[","(",ETC) TLNN MRP,760000 ;HAVE WE FINISHED WORD? SOSLE RCOUNT ;YES, STILL ROOM IN LEAF? JRST MREADC ;STILL CHAR. IN LEAF HLRZ MRP,1-.LEAF(MRP) ;YES, GET LINK HRLI MRP,(POINT 7,,20) ;SET POINTER MOVEI C,.LEAF ;RESET COUNT MOVEM C,RCOUNT MREADC: ILDB C,MRP ;GET CHARACTER RET ;[1061] PEEK: JUMPN MRP,PEEKM ;THIS IS A MACRO READ CALL CHARAC ;READ AN ASCII CHAR. TLO IO,IORPTC ;REPEAT FOR NEXT RET ;AND RETURN PEEKM: PUSH P,MRP ;SAVE MACRO READ POINTER PUSH P,RCOUNT ;SAVE WORD COUNT CALL MREADS ;READ IN A CHAR. POP P,RCOUNT ;RESTORE WORD COUNT POP P,MRP ;RESET READ POINTER RET ;IORPTC IS NOT SET REFINC: AOS 1(V) ;INCREMENT REFERENCE RET REFDEC: TRNN V,400000 ;[1061] IF V IS 0, NEGATIVE OR TRNN V,-1 ;[1061] GREATER THAN 400000, JRST DECERR ;[1061] CATASTROPHIC ERROR SOMEWHERE SOS CS,1(V) ;DECREMENT REFERENCE TRNE CS,000777 ;IS IT ZERO? RET ;NO, EXIT CAMGE V,UNITOP ;IS THIS IN UNIV AREA? JRST REFINC ;YES, PUT IT BACK, DON'T DELETE HRRZ CS,0(V) ;YES, GET POINTER TO END HRL CS,NEXT ;GET POINTER TO NEXT RE-USABLE HLLM CS,0(CS) ;SET LINK HRRM V,NEXT ;RESET NEXT RET DECERR: PUSH P,['MCREWE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / ERROR WHILE EXPANDING@/] ;[1066] JRST IRPERR ;[702] COMMON MESSAGE MPAERR: PUSH P,['MCRMPA'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / MISSING CLOSE PAREN AROUND ARG LIST OF@/] ;[1066] JRST IRPERR ;[702] COMMON MESSAGE A== 0 ;ASCII MODE AL== 1 ;ASCII LINE MODE IB== 13 ;IMAGE BINARY MODE B== 14 ;BINARY MODE ; == 0 ;USED BY HELPER AND GETSEGS CTL== 1 ;CONTROL DEVICE NUMBER IFN CCLSW, ;INPUT DEV FOR CCL FILE BIN== 2 ;BINARY DEVICE NUMBER CHAR== 3 ;INPUT DEVICE NUMBER LST== 4 ;LISTING DEVICE NUMBER UNV== 6 ;SYMBOL TABLE FILE (UNIVERSAL) ; COMMAND STRING ACCUMULATORS ACDEV== 1 ;DEVICE ACFILE==2 ;FILE ACEXT== 3 ;EXTENSION ACPPN== 4 ;PPN ACDEL== 4 ;DELIMITER ACPNTR==5 ;BYTE POINTER TIO== 6 TIORW== 1000 TIOLE== 2000 TIOCLD==20000 DIRBIT==4 ;DIRECTORY DEVICE TTYBIT==10 ;TTY MTABIT==20 ;MTA DTABIT==100 ;DTA DISBIT==2000 ;DISPLAY CONBIT==20000 ;CONTROLING TTY LPTBIT==40000 ;LPT DSKBIT==200000 ;DSK ;GETSTS ERROR BITS IOIMPM==400000 ;IMPROPER MODE (WRITE LOCK) IODERR==200000 ;DEVICE DATA ERROR IODTER==100000 ;CHECKSUM OR PARITY ERROR IOBKTL== 40000 ;BLOCK TOO LARGE ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL SYN .TEMP,PPN SUBTTL I/O ROUTINES BEG: IFN CCLSW, ;ALLOW RAPID PROGRAM GENERATION IFN PURESW,< MOVE MRP,[XWD LOWL,LOWL+1] ;START OF DATA SETZM LOWL ;ZERO FIRST WORD BLT MRP,LOWEND ;AND THE REST MOVE MRP,[XWD LOWH,LOWL] ;PHASED CODE BLT MRP,LOWL+LENLOW> ;MOVE IT IN HRRZ MRP,.JBREL ;GET LOWSEG SIZE MOVEM MRP,MACSIZ ;SAVE CORE SIZE ;DECODE VERSION NUMBER MOVEI P,JOBFFI ;TEMP PUSH DOWN STACK PUSH P,[0] ;MARK BOTTOM OF STACK LDB 0,[POINT 3,.JBVER,2] ;GET USER BITS JUMPE 0,GETE ;NOT SET IF ZERO ADDI 0,"0" ;FORM NUMBER PUSH P,0 ;STACK IT MOVEI 0,"-" ;SEPARATE BY HYPHEN PUSH P,0 ;STACK IT ALSO GETE: HRRZ 0,.JBVER ;GET EDIT NUMBER JUMPE 0,GETU ;SKIP ALL THIS IF ZERO MOVEI 1,")" ;ENCLOSE IN PARENS. PUSH P,1 GETED: IDIVI 0,8 ;GET OCTAL DIGITS ADDI 1,"0" ;MAKE ASCII PUSH P,1 ;STACK IT JUMPN 0,GETED ;LOOP TIL DONE MOVEI 0,"(" ;OTHER PAREN. PUSH P,0 GETU: LDB 0,[POINT 6,.JBVER,17] ;UPDATE NUMBER JUMPE 0,GETV ;SKIP IF ZERO IDIVI 0,^D26 ;MIGHT BE TWO DIGITS ADDI 1,"@" ;FORM ALPHA PUSH P,1 JUMPN 0,GETU+1 ;LOOP IF NOT DONE GETV: LDB 0,[POINT 9,.JBVER,11] ;GET VERSION NUMBER IDIVI 0,8 ;GET DIGIT ADDI 1,"0" ;TO ASCII PUSH P,1 ;STACK JUMPN 0,GETV+1 ;LOOP MOVE 1,[POINT 7,VBUF+1,20] ;POINTER TO DEPOSIT IN VBUF POP P,0 ;GET CHARACTER IDPB 0,1 ;DEPOSIT IT JUMPN 0,.-2 ;KEEP GOING IF NOT ZERO IFN FORMSW,> ;HALF WORD UNLESS CHANGED BY SWITCH IFN CCLSW,< TLZA IO,CRPGSW ;SET TO INIT NEW COMMAND FILE M: TLNN IO,CRPGSW> ;CURRENTLY DOING RPG? IFE CCLSW, RESET ;INITIALIZE PROGRAM SETZM LITLST ;NOLIST LITERALS INLINE UNLESS CHANGED SETZM BLSW SETZM IFXLSW SETZM MACPRF ;DEFAULT IS OLD WAY SETZM BINDEV ;CLEAR IN CASE NOT USED NEXT TIME SETZM LSTDEV ;SAME REASON SETZM INDEV ;IN CASE OF ERROR IFN TOPS20,< ;FOR LONG FILES SETZM DINDEV ;NO STICKY DEVICE SETZM DINDIR ;NO STICKY INPUT DIRECTORY > ;[1024] HRRZ MRP,MACSIZ ;GET INITIAL SIZE CORE MRP, ;BACK TO ORIGINAL SIZE JFCL ;SHOULD NEVER FAIL SKIPE UNIFLG ;[700] DOING RESCAN? JRST [SETZB MRP,PASS1U ;[700] YES, SAVE CTLBUF, CLEAR UNIVS SETZM UNISIZ ;[700] MOVE [XWD UNISIZ,UNISIZ+1] ;[700] BLT UWVER ;[700] MOVE [XWD PASS1U,PASS1U+1] ;[700] JRST CTLS0] ;[700] SETZB MRP,PASS1I MOVE [XWD PASS1I,PASS1I+1] CTLS0: BLT PASS2X-1 ;[700] ZERO THE PASS1 AND PASS2 VARIABLES ; IFE TOPS20,< ;TOPS20 DEFAULT IS NEW WAY ; SETOM MACTAB> ;TOPS10 DEFAULT IS OLD WAY MOVEI P,JOBFFI ;SET TEMP PUSH-DOWN POINTER IFN FORMSW,< MOVE CS,PHWFMT ;GET DEFAULT VALUE (PERMANENT) MOVEM CS,HWFMT> ;SET IT (TEMP) MOVE CS,[POINT 7,DBUF,6] ;INITIALIZE FOR DATE MSTIME 2, ;GET TIME FROM MONITOR CALL TIMOUT ;TIME FORMAT OUTPUT DATE 1, ;GET DATE IBP CS ;PASS OVER PRESET SPACE CALL DATOUT ;DATE FORMAT OUTPUT MOVSI FR,P1!CREFSW IFN CCLSW, ;IN CASE OF LOOKUP FAILURE IFE CCLSW, MOVSI IO,IOPALL ;ZERO FLAGS INIT CTL,AL ;INITIALIZE USER CONSOLE SIXBIT /TTY/ XWD CTOBUF,CTIBUF EXIT ;NO TTY, NO ASSEMBLY MOVSI C,'TTY' DEVCHR C, ;GET CHARACTERISTICS TLNN C,10 ;IS IT REALLY A TTY EXIT ;NO INBUF CTL,1 ;INITIALIZE SINGLE CONTROL OUTBUF CTL,1 ;BUFFERS SKIPE UNIFLG ;[700] DOING RESCAN? JRST [MOVE AC2,CTL2SV ;[700] YES, GET CHAR COUNT SETZM UNIFLG ;[700] JRST CTLS3] ;[700] SET PTRS CALL CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED MOVEI C,"*" IDPB C,CTOBUF+1 OUTPUT CTL, MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND MOVEI AC2,1 ;INITIALIZE CHARACTER COUNT CTLS2: SOSGE CTIBUF+2 ;USUAL SOSG LOOP ON TTY INPUT INPUT CTL, ;GET NEXT BUFFER ILDB 0,CTIBUF+1 ;GET CHARACTER CAIL AC2,CTLSIZ ;NUMBER OF CHARS. ALLOWED JRST COMERR ;COMMAND LINE TOO LONG CAIN 0,CZ ;TEST FOR ^Z JRST CZSTOP ;MONRET TYPE EXIT IDPB 0,AC1 ;STORE CHAR. CAIE 0,33 ;TEST FOR ALTMODE CAIG 0,FF ;TEST FOR EOL CHAR CAIGE 0,LF ;ONE OF FF, VT, OR LF AOJA AC2,CTLS2 ;NOT END OF LINE YET MOVEM AC2,CTL2SV ;[700] SAVE CHAR COUNT IN CASE UNIERR CTLS3: MOVEM AC2,CTIBUF+2 ;[700] RESET CHAR. COUNT MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND MOVEM AC1,CTIBUF+1 ;RESET BYTE POINTER IFN CCLSW, ;JUST IN CASE INIT CTL2,AL ;LOOK FOR DISK SIXBIT /DSK/ ;... XWD 0,CTLBLK ;... JRST CTLSET ;DSK NOT THERE HRLZI 3,'MAC' ;###MAC MOVEI 3 ;COUNT PJOB AC1, ;RETURNS JOB NO. TO AC1 RPGLUP: IDIVI AC1,12 ;CONVERT ADDI AC2,"0"-40 ;SIXBITIZE IT LSHC AC2,-6 SOJG 0,RPGLUP ;3 TIMES MOVEM 3,CTLBUF ;###MAC HRLZI 'TMP' MOVEM CTLBUF+1 ;TMP SETZM CTLBUF+3 ;PROG-PRO LOOKUP CTL2,CTLBUF ;COMMAND FILE JRST CTLSET ;NOT THERE HLRM EXTMP ;SAVE THE EXTENSION RPGS2: INBUF CTL2,1 ;SINGLE BUFFERED RPGS2A: INIT CTL,AL ;TTY FOR CONSOLE MESSAGES SIXBIT /TTY/ ;... XWD CTOBUF,0 ;... EXIT ;NO TTY, NO ASSEMBLY OUTBUF CTL,1 ;SINGLE BUFFERED MOVE .JBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN MOVEM SAVFF ;... HRRZ .JBREL ;TOP OF CORE CAMLE MACSIZ ;SEE IF IT HAS GROWN MOVEM MACSIZ ;PREVENTS ADDRESS CHECK ON EXIT TLNE IO,CRPGSW ;ARE WE ALREADY IN RPG MODE? JRST M ;MUST HAVE COME FROM @ COMMAND, RESET GOSET: MOVSI IO,IOPALL!CRPGSW ;SET INITIAL FLAGS SKIPE UNIFLG ;[700] IF UNIERR DO RESCAN JRST [MOVE AC1,[POINT 7,CTLBUF] ;[700] PTR TO STRING MOVEM AC1,CTIBUF+1 ;[700] MOVE AC2,CTL2SV ;[700] GET COUNT MOVEM AC2,CTIBUF+2 ;[700] SETZM UNIFLG ;[700] JRST GOSET3] ;[700] MOVEI CS,CTLSIZ ;MAXIMUM CHARS IN A LINE MOVE AC1,CTLBLK+2 ;NUMBER OF CHARACTERS MOVEM AC1,CTIBUF+2 ;SAVE FOR PASS 2 MOVE AC1,[POINT 7,CTLBUF] ;WHERE TO STASH CHARS MOVEM AC1,CTIBUF+1 ;... GOSET1: SOSG CTLBLK+2 ;ANY MORE CHARS? CALL [IFN TEMP, ;YES EXIT IN CTL2, ;READ ANOTHER BUFFERFUL RET ;EVERYTHING OK, RETURN STATO CTL2,20000 ;EOF? JRST [PUSH P,['MCRECF'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / ERROR READING COMMAND FILE@/] ;[1066] JRST ERRFIN] ;GO COMPLAIN CALL DELETE ;CMD FILE EXIT] ;EOF AND FINISHED ILDB C,CTLBLK+1 ;GET NEXT CHAR MOVE RC,@CTLBLK+1 ;CHECK FOR SEQUENCE NUMBERS TRNE RC,1 ;... JRST [AOS CTLBLK+1 ;SKIP OVER ANOTHER 5 CHARS MOVNI RC,5 ;... ADDM RC,CTLBLK+2 ;... JRST GOSET1 ] ;GO READ ANOTHER CHAR JUMPE C,GOSET1 ;IGNORE NULLS CAIE C," " ;IGNORE SPACES CAIN C,HT ;AND TABS JRST GOSET1 ;ALSO, SAVES SPACE AND COMMAND ERROR IDPB C,CTIBUF+1 ;STASH AWAY AOS CTIBUF+2 ;INCREMENT CHAR. COUNT CAIE C,12 ;LINE FEED OR CAIN C,175 ;ALTMODE? JRST GOSET2 ;YES, FINISHED WITH COMMAND CAIE C,176 CAIN C,33 JRST GOSET2 ;ALTMODE. SOJG CS,GOSET1 ;GO READ ANOTHER JRST COMERR ;GO COMPLAIN GOSET2: MOVEI C,12 ;MAKE SURE THERE'S A LF IDPB C,CTIBUF+1 ;... MOVEM AC1,CTIBUF+1 ;SET POINTER TO BEGINNING AOS CTIBUF+2 ;ADD I TO COUNT MOVE CTIBUF+2 ;[700] SAVE IN CASE UNIERR MOVEM CTL2SV ;[700] GOSET3: MOVE SAVFF ;[700] RESET JOBFF FOR NEW BINARY MOVEM .JBFF ;... JRST BINSET RPGS1: CALL DELETE ;DELETE COMMAND FILE IFE TOPS20,< ;FOR SHORT FILES MOVEM ACDEV,RPGDEV ;GET SET TO INIT OPEN CTL2,RPGINI ;DO IT JRST EINIT ;ERROR MOVEM ACFILE,INDIR ;USE INPUT BLOCK MOVEM ACPPN,INDIR+3 ;SET PPN HLLZM ACEXT,INDIR+1 ;SET FILE EXTENSION JUMPN ACEXT,RPGS1A ;EXPLICIT EXTENSION GIVEN, USE IT IFE STANSW, ;IF BLANK TRY CCL IFN STANSW, ;IF BLANK TRY RPG HLLZM ACEXT,INDIR+1 ;STORE DEFAULT EXT LOOKUP CTL2,INDIR SKIPA ACEXT,INDIR+1 ;FAILED, PICKUP EXT AND ERROR CODE JRST RPGS1B ;SUCCESS TRNE ACEXT,-1 ;CHECK FOR ERROR CODE OTHER THAN 0 JRST RPGLOS ;YES, YOU LOSE SETZB ACEXT,INDIR+1 ;TRY NULL EXT RPGS1A: LOOKUP CTL2,INDIR JRST RPGLOS ;TOTAL FAILURE > ;END OF TOPS20 EQ CONDITIONAL IFN TOPS20,< ;FOR LONG FILES SKIPN FILNAM ;HAVE A NAME YET? CALL NAME1 ;NO GO GET THE NAME JFCL ;LET COMPT GENERATE THE ERROR MOVE ACPPN,[10,,RPGADR] ;TO GET THE FILE COMPT. ACPPN, ;GO GET IT JRST RPGLOS ;NOT THERE > ;END OF TOPS20 NE CONDITIONAL RPGS1B: HLRM ACEXT,EXTMP ;SAVE THE EXTENSION HLRZ .JBSA ;RESET JOBFF TO ORIGINAL MOVEM .JBFF TLO IO,CRPGSW ;TURN ON SWITCH SO WE RESET WORLD JRST RPGS2 ;AND GO RPGLOS: RELEAS CTL2,0 TLZ IO,CRPGSW ;STOPS IO TO UNASGD CHAN JRST ERRCF ;NO FILE FOUND > BINSET: CALL NAME1 ;GET FIRST NAME JRST BINSE3 ;NO FILE HERE HLLZ ACEXT,ACEXT ;DISALLOW NULL EXTENSION IFN CCLSW, TLNN FR,CREFSW ;CROSS REF REQUESTED? JRST LSTSE1 ;YES, SKIP BINARY IFN TOPS20,< ;CODE FOR LONG FILE NAMES LDB ACDEV,[POINT 7,FILNAM,6] ;GET FIRST ASCII BYTE JUMPE ACDEV,[ CAIN C,"," ;IF NULL AND TERM WITH COMMA JRST LSTSET ;THEN GO READ LISTING FILE CAIN C,"_" ;IF NULL AND TERM WITH _ JRST GETSEN ;THEN GO READ INPUT FILE JRST M] ;ELSE, START OVER CAIE C,CR ;NOT NULL. END IN CR? CAIN C,LF ;OR LF? JRST GETSET ;YES. IT IS AN INPUT FILE > ;END OF TOPS20 CONDITIONAL IFE TOPS20,< ;CONDITIONAL FOR TOPS10 FILES CAIN C,"," ;COMMA? JUMPE ACDEV,LSTSET ;YES, SKIP BINARY IF NO DEVICE SPECIFIED CAIN C,"_" ;LEFT ARROW? JUMPE ACDEV,LSTSE1 ;YES, SKIP BINARY IF NO DEVICE SPECIFIED JUMPE ACDEV,M ;IGNORE IF JUST CR-LF > ;END OF TOPS20 EQ CONDITIONAL TLO FR,PNCHSW ;OK, SET SWITCH IFN TOPS20,< ;CONDITIONAL FOR LONG FILES MOVE ACDEV,[10,,BINADR] ;COMPT. ARGS COMPT. ACDEV, ;DO UUO JRST EINIT1 ;REL FILE OPEN ERROR > ;END OF CONDITIONAL NE TOPS20 IFE TOPS20,< ;FOR SHORT FILES MOVEM ACDEV,BINDEV ;STORE DEVICE NAME MOVEM ACFILE,BINDIR ;STORE FILE NAME IN DIRECTORY JUMPN ACEXT,.+2 ;EXTENSION SPECIFIED? MOVSI ACEXT,'REL' ;NO, ASSUME RELOCATABLE BINARY MOVEM ACEXT,BINDIR+1 ;STORE IN DIRECTORY CAIE ACPPN,SFDADD ;SFD? JRST BINSE4 MOVE ACPPN,[0,,BINSFD] ;RESET POINTER AND MOVE AC0,[SFDADD,,BINSFD] ;BLT TO APPROPRIATE BLOCK BLT AC0,BINSFD+2+.SFDLN ; BINSE4: MOVEM ACPPN,BINDIR+3 ;SET PPN OPEN BIN,BININI ;INITIALIZE BINARY JRST EINIT ;ERROR > ;END OF EQ TOPS20 CONDITIONAL IFN TOPS20,< ;FOR LONG FILES SETZM FILNAM ;CLEARED MOVEI ACDEV,BIN ;CHANNEL MOVEM BINDEV ;FOR DEVCHR > TLZE TIO,TIOLE ;SKIP TO EOT MTEOT. BIN, TLZE TIO,TIORW ;REWIND REQUESTED? MTREW. BIN, ;YES JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE MTBSF. BIN, ;BACK-SPACE A FILE AOJL CS,.-1 ;TEST FOR END MTWAT. BIN, STATO BIN,1B24 ;LOAD POINT? MTSKF. BIN, ;NO, GO FORWARD ONE BINSE2: SOJG CS,.-1 ;TEST FORWARD SPACING TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED? UTPCLR BIN, ;YES, CLEAR IT OUTBUF BIN,2 ;SET UP TWO RING BUFFER BINSE3: CAIN C,"_" JRST GETSET ;NO LISTING LSTSET: CALL NAME1 ;GET NEXT DEVICE JRST GETSET ;NO FILE HERE HLLZ ACEXT,ACEXT ;DISALLOW NULL EXTENSION LSTSE1: CAIE C,"_" JRST ERRCM IFN TOPS20,< ;CONDITIONAL FOR LONG FILE NAMES SETZM LSTNAM ;NO DEFAULT LISTING NAME HRROI ACDEV,[ASCIZ /LST/] ;DEFAULT EXTENSION MOVEM ACDEV,LSTEXT ;TO ARG BLOCK > ;END OF NE CONDITIONAL TLNE FR,CREFSW ;CROSS-REF REQUESTED? IFE TOPS20,< ;FOR SHORT FILES JRST LSTSE2 ;NO, BRANCH JUMPN ACDEV,.+2 ;YES, WAS DEVICE SPECIFIED? MOVSI ACDEV,'DSK' ;NO, ASSUME DSK JUMPN ACFILE,.+2 MOVE ACFILE,[SIXBIT /CREF/] JUMPN ACEXT,.+2 MOVSI ACEXT,'CRF' LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED MOVE AC0,ACDEV > ;END OF EQ TOPS20 CONDITIONAL IFN TOPS20,< ;FOR LONG FILES JRST [ LDB ACDEV,[POINT 7,FILNAM,6] ;GET FIRST ASCII BYTE JUMPE ACDEV,GETSET ;IF NONE, GO DO INPUT JRST LSTSE2] ;IF ONE, USE IT HRROI ACDEV,[ASCIZ /CREF/] ;XREF REQUESTED MOVEM ACDEV,LSTNAM ;SET UP DEFAULT NAME HRROI ACDEV,[ASCIZ /CRF/] ;EXTENSION NAME MOVEM ACDEV,LSTEXT ;TO ARG BLOCK LSTSE2: MOVE ACDEV,[10,,LSTARG] ;[1024] COMPT. ARGS COMPT. ACDEV, ;OPEN FILE JRST EINIT2 ;BAD, LST FILE OPEN ERROR SETZM FILNAM ;MADE IT MOVEI AC0,LST MOVEM AC0,LSTDEV ;FOR OTHER GUYS > ;END OF CONDITIONAL DEVCHR AC0, ;GET CHARACTERISTICS TLNE AC0,LPTBIT!DISBIT!TTYBIT JRST [ TLNE FR,CREFSW ;[1146] CROSS-REF REQUESTED? JRST .+1 ;[1146] NO TLC AC0,DSKBIT+MTABIT ;[1146] IF BOTH DSK: AND MTA: THEN TLCE AC0,DSKBIT+MTABIT ;[1146] DEVICE IS OK (NUL:) JRST ERRCM ;[1146] CAN'T CREF IF NO DIRECTORY JRST .+1] ;[1146] DEV WAS NULL, CARRY ON AOSA OUTSW+0*TTYSW ;NO, ASSUME TTY JRST ERRCM ;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY TLNE AC0,CONBIT ;CONTROLING TELETYPE LISTING? JRST GETSET ;YES, BUFFER ALREADY SET MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME AOS OUTSW+0*LPTSW ;SET FOR LPT IFE TOPS20,< ;FOR SHORT FILES MOVEM ACFILE,LSTDIR ;STORE FILE NAME JUMPN ACEXT,.+2 MOVSI ACEXT,'LST' MOVEM ACEXT,LSTDIR+1 CAIE ACPPN,SFDADD ;SFD? JRST LSTSE5 MOVE ACPPN,[0,,LSTSFD] ;YES, REST POINTER AND MOVE AC0,[SFDADD,,LSTSFD] ;BLT TO APPROPRIATE BLT AC0,LSTSFD+2+.SFDLN ; LSTSE5: MOVEM ACPPN,LSTDIR+3 ;SET PPN OPEN LST,LSTINI ;INITIALIZE LISTING OUTPUT JRST EINIT ;ERROR > ;END OF EQ CONDITIONAL TLZE TIO,TIOLE MTEOT. LST, TLZE TIO,TIORW ;REWIND REQUESTED? MTREW. LST, ;YES JUMPGE CS,LSTSE3 MTBSF. LST, AOJL CS,.-1 MTWAT. LST, STATO LST,1B24 MTSKF. LST, LSTSE3: SOJG CS,.-1 TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED? UTPCLR LST, ;YES, CLEAR IT OUTBUF LST,2 ;SET UP A TWO RING BUFFER IFN TOPS20,< GETSEN: SETZM FILNAM ;INIT CODE FOR LONG FILES > GETSET: MOVEI 3,PDPERR HRRM 3,.JBAPR ;SET TRAP LOCATION MOVEI 3,1B19 ;SET FOR PUSH-DOWN OVERFLOW APRENB 3, SOS 3,PDP ;GET PDP REQUEST MINUS 1 IMULI 3,.PDP ;COMPUTE SIZE (50*) HRLZ MP,3 HRR MP,.JBFF ;SET BASIC POINTER MOVE P,MP SUB P,3 MOVEM P,RP ;SET RP MOVEM P,SAVERP SUB P,3 IFN POLISH,< MOVEM P,POLSTK ;SAVE INITIAL POLISH FIXUP STACK MOVEM P,POLPTR ;ONLY CHANGE IF STACK MOVES SUB P,3 > ASH 3,1 ;DOUBLE SIZE OF BASIC POINTER HRL P,3 MOVEM P,SAVEPP MOVEM MP,SAVEMP SUBM P,3 ;COMPUTE TOP LOCATION SKIPN UNITOP ;IF ANY UNIVERSALS HAVE BEEN SEEN JRST GETSE0 ;NO HRRZS 3 ;GET TOP OF BUFFERS AND STACKS CAMLE 3,UNISIZ ;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE JRST [SKIPE MRUNV ;[700] IT WAS, GIVE ERROR IF JRST UNIERR ;[700] DISK-RESIDENT UNIVS SETOM UNIFLG ;[700] ELSE FORCE REALLOCATION JRST M] ;[700] SKIPA 3,UNITOP ;DON'T LOSE THEM GETSE0: HRRZM 3,UNISIZ ;STORE UNTIL A UNIVERSAL IS SEEN HRRZM 3,LADR ;SET START OF MACRO TREE HRRZM 3,FREE GETSE1: HRRZ .JBREL SUBI 1 MOVEM SYMTOP ;SET TOP OF SYMBOL TABLE SUBI LENGTH ;SET POINTER FOR INITIAL SYMBOLS CAMLE LADR ;HAVE WE ROOM? JRST GETSE2 ;YES HRRZ 2,.JBREL ;NO, TRY FOR MORE CORE ADDI 2,2000 CORE 2, JRST XCEED2 ;NO MORE, INFORM USER JRST GETSE1 ;TRY AGAIN GETSE2: MOVEM SYMBOL ;SET START OF SYMBOL TABLE HRLI SYMNUM BLT @SYMTOP ;STORE SYMBOLS IFN FTPSECT,< ;[575] MOVE @SYMBOL ;SYMBOL COUNT MOVEM SGSCNT ;FOR THIS PSECT > CALL SRCHI ;INITIALIZE TABLE ; ;HERE TO TEST FOR CPU AND SET VALUE IN .CPU. ;PDP-6 = 1 ;KA-10 = 2 ;KI-10 = 3 ;KL-10 = 4 MOVEI V,1 ;START WITH PDP-6 JFCL 1,.+1 ;CLEAR PC CHANGE FLAG JRST .+1 ;THEN CHANGE PC JFCL 1,.PDP6. ;IF FLAG ON, ITS A PDP6 HRLOI 1,-2 ;CHECK FOR KA-10 AOBJP 1,.KA10. ;CHECK CARRY BETWEEN HALVES SETZ 1, ;CLEAR AC BLT 1,0 ;AND TRY BLT, KI WILL BE 0 AND JUMPE 1,.KI10. ;LK WILL HAVE 1,,1 ; JRST .KL10. .KL10.: AOS V .KI10.: AOS V .KA10.: AOS V .PDP6.: MOVE AC0,['.CPU. '] MOVEM V,CPUV ;[775] SAVE IT FOR CORE SIZE TYPEOUT CALL SSRCH ;SEE IF THERE ALREADY AND IF NOT CALL [MOVSI ARG,SYMF!NOOUTF!SUPRBT SETZ RC, JRST INSERT] ;PUT IT IN TABLE GETPPN V, ;GET LOGGED IN PPN JFCL ;ALT. RETURN MOVEM V,MYPPN ;AND REMEMBER IR ; END OF EDIT IFN FTPSECT,< ;[575] SETZM SGNMAX ;INIT TO ONE .PSECT SETZM SGNCUR ;IT IS THE CURRENT .PSECT SETZM SGNAME ;IT IS THE BLANK .PSECT MOVSI 1 MOVEM SGRELC ;SET THE RELOCATION COUNTER SETZM SGATTR ;ZERO PSECT BRK AND ATTRS SETZM SGDMAX ;ONE .PSECT DEEP SETZM SGLIST ;IT IS THE BLANK .PSECT > MOVE [XWD CTIBUF+1,CTLSAV] ;SAVE CONTROL INPUT BUFFER BLT CTLS1 ;FOR RESCAN ON PASS 2 MOVSI 'DSK' ;SET INPUT TO TAKE DSK AS DEV MOVEM ACDEVX CALL COUTI ;INIT OUTPUT JUST IN CASE CALL INSET ;GET FIRST INPUT FILE JRST GETSE3 ;ERROR IFN CCLSW,;PUBLISH COMPILER NAME MOVE CS,INDIR ;SET UP NAME OF FIRST FILE MOVEM CS,LSTFIL ;AS LAST PRINTED SETZM LSTPGN JRST ASSEMB ;START ASSEMBLY GETSE3: CALL ERRNE JRST ERRFN2 ;[1066] START OVER FINIS: CLOSE BIN, ;DUMP BUFFER TLNE FR,PNCHSW ;PUNCH REQUESTED? CALL TSTBIN ;YES, TEST FOR ERRORS RELEAS BIN, CLOSE LST, SOSLE OUTSW+0*LPTSW ;LPT TYPE OUTPUT? CALL TSTLST ;YES, TEST FOR ERRORS RELEAS LST, RELEAS CHAR, MOVE C,CTOBUF+2 ;SKIP OUTPUT IF BUFFER EMPTY CAIE C,120 ;[565] OUTPUT CTL,0 ;FLUSH TTY OUTPUT SKIPE UNIVSN ;SKIP IF NOT ASSEMBLING UNIVERSAL CALL UNISYM ;STORE SYMBOLS ETC. FIRST JRST M ;RETURN FOR NEXT ASSEMBLY IFN CCLSW,< IFE TOPS20,< ;FOR SHORT FILES NUNSET: JUMPN ACDEV,.+2 MOVSI ACDEV,'SYS' ;USE SYS IF NONE SPECIFIED MOVEM ACDEV,RUNDEV MOVEM ACFILE,RUNFIL ;STORE FILE NAME SKIPN SFDADD ;ANY SFD'S? JRST NUNPP ;NO HRLI ACPPN,RUNSFD ;FORM BLT WORD MOVSS ACPPN ;BUT WRONG WAY ROUND BLT ACPPN,RUNSFD+2+.SFDLN MOVEI ACPPN,RUNSFD ;SET UP ADDRESS AGAIN NUNPP: MOVEM ACPPN,RUNPP ;IN PPN CALL DELETE ;COMMAND FILE SETZM RUNFIL+1 ;LET MONITOR CHOOSE EXT SETZM RUNFIL+2 ;CLEAR ALSO SETZM RUNPP+1 ;ZERO CORE ARG MOVEI 16,RUNDEV ;XWD 0,RUNDEV TLNE IO,CRPGSW ;WAS RPG IN PROGRESS? HRLI 16,1 ;YES. START NEXT AT C(.JBSA)+1 ;REDUCE THE LOW SEGMENT TO 1K AND DELETE THE HIGH ;BEFORE THE RUN UUO, SAVES CORE AND TIME MOVE 1,[1,,RUNEND-1] ;DELETE HIGH & LOW MOVE 2,[RUNHI,,RUNLO] BLT 2,RUNDEV-1 ;BLT CODE DOWN JRST RUNLO ;GO TO IT RUNHI: PHASE LOWL RUNLO:! CORE 1, ;CUT DOWN TO 1K JFCL ;TOO BAD RUN 16, ;DO "RUN DEV:NAME" HALT ;SHOULDN'T RETURN. HALT IF IT DOES RUNDEV:! BLOCK 1 RUNFIL:! BLOCK 3 RUNPP:! BLOCK 2 RUNSFD:! BLOCK 3+.SFDLN RUNEND:! DEPHASE > ;END OF CONDITIONAL IFN TOPS20,< ;FOR LONG FILES NUNSET: CALL DELETE ;GET RID OF COMMAND FILE MOVE ACDEV,[4,,RUNARG] ;FOR COMPT. COMPT. ACDEV, ;DO IT HALT ;LET PA1050 COMPLAIN > ;END OF CONDITIONAL DELETE: HRRZ EXTMP ;IF THE EXTENSION CAIE 'TMP' ;IS .TMP RET ;RETURN. CLOSE CTL2, ;DELETE SETZB 4,5 ;THE COMMAND FILE. SETZB 6,7 RENAME CTL2,4 JFCL RET > INSET: MOVEI JOBFFI ;POINTER TO INPUT BUFFER HRRM .JBFF ;INFORM SYSTEM OF BUFFER AREA IFN TOPS20,< ;FOR LONG FILES SKIPE FILNAM ;ALREADY HAVE A NAME? JRST INSET9 ;YES. GO USE IT > CALL NAME2 ;GET NEXT COMMAND NAME RET ;ERROR RETURN IF NONE LEFT INSET9: AOS (P) ;SUCCESS IFE TOPS20,< ;FOR SHORT FILES MOVEM ACDEV,INDEV ;STORE DEVICE MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY MOVEM ACPPN,INDIR+3 ;STORE PPN BEFORE WE LOSE IT OPEN CHAR,INDEVI > ;END OF EQ TOPS20 CONDITIONAL IFN TOPS20,< ;FOR LONG FILES MOVE ACDEV,[10,,INARG] ;COMPT. ARGS COMPT. ACDEV, ;OPEN THE FILE > ;END OF NE TOPS20 JRST EINIT ;ERROR IFN TOPS20,< ;FOR LONG FILES MOVEI ACDEV,CHAR ;THE CHANNEL MOVEM ACDEV,INDEV ;FAKE THIS AS THE DEVICE CODE > DEVCHR ACDEV, ;TEST CHARACTERISTICS TLNN ACDEV,MTABIT ;MAG TAPE? JRST INSET3 ;NO TLZN FR,MTAPSW ;FIRST MAG TAPE IN PASS 2? JRST INSET1 ;NO TLNN TIO,TIORW ;YES, REWIND REQUESTED? SUB CS,RECCNT ;NO, PREPARE TO BACK-SPACE TAPE INSET1: AOS RECCNT ;INCREMENT FILE COUNTER ADDM CS,RECCNT ;UPDATE COUNT TLZE TIO,TIOLE MTEOT. CHAR, TLZE TIO,TIORW ;REWIND? MTREW. CHAR, ;YES JUMPGE CS,INSET2 MTBSF. CHAR, MTBSF. CHAR, AOJL CS,.-1 MTWAT. CHAR, STATO CHAR,1B24 MTSKF. CHAR, INSET2: SOJGE CS,.-1 INSET3: INBUF CHAR,1 MOVEI ACPNTR,JOBFFI EXCH ACPNTR,.JBFF SUBI ACPNTR,JOBFFI MOVEI ACDEL,NUMBUF*203+1 IDIV ACDEL,ACPNTR INBUF CHAR,(ACDEL) IFN TOPS20,< ;FOR LONG FILES SETZM FILNAM ;CLEAR THIS FOR NEXT TRY > IFE TOPS20,< ;FOR SHORT FILES JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK MOVSI ACEXT,'MAC' ;BLANK, TRY .MAC FIRST CALL INSETI INSET4: CALL INSETI JUMPE ACEXT,ERRCF ;ERROR IF ZERO TLNE ACDEV,TTYBIT ;TELETYPE? SETSTS CHAR,AL ;YES, CHANGE TO ASCII LINE ;DO ALL ENTERS HERE FOR LEVEL D SKIPE ENTERS ;HAVE ENTERS BEEN DONE ALREADY? > ;END OF EQ TOPS20 JRST ENTRDN ;YES, DON'T DO TWICE SKIPN ACEXT,LSTDEV ;IS THERE A LIST DEVICE? JRST BINSE5 ;NO SO DON'T DO ENTER SKIPE ACFILE,LSTDIR ;GET FILE NAME IN CASE OF ERROR JRST LSTSE4 DEVCHR ACEXT, TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY? JRST LSTSE4 ;YES, GIVE UP BEFORE HARM IS DONE SKIPE ACFILE,INDIR ;USE INPUT FILE NAME MOVEM ACFILE,LSTDIR ;TOO BAD IF ZERO ALSO LSTSE4: HLLZS ACEXT,LSTDIR+1 ;EXT ALSO ENTER LST,LSTDIR ;SET UP DIRECTORY JRST ERRCL ;ERROR BINSE5: SKIPN ACEXT,BINDEV ;A BINARY DEVICE THEN ? JRST ENTRDN ;NO SKIPE ACFILE,BINDIR ;IN CASE OF ERROR JRST BINSE6 DEVCHR ACEXT, TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY? JRST BINSE6 ;YES, GIVE UP BEFORE HARM IS DONE SKIPE ACFILE,INDIR ;USE INPUT FILE NAME MOVEM ACFILE,BINDIR ;TOO BAD IF ZERO ALSO BINSE6: HLLZS ACEXT,BINDIR+1 ENTER BIN,BINDIR ;ENTER FILE NAME JRST ERRCB ;ERROR ENTRDN: SETOM ENTERS ;MAKE SURE ONLY DONE ONCE MOVE CS,[POINT 7,DEVBUF] PUSH P,1 ;SAVE THE ACCS PUSH P,2 PUSH P,3 IFE TOPS20,< ;FOR SHORT FILES SKIPN 2,INDIR ;GET INPUT NAME JRST FINDEV ;FINISHED WITH DEVICE SETZ 1, ;CLEAR FOR RECEIVING LSHC 1,6 ;SHIFT ONE CHAR. IN ADDI 1,40 ;FORM ASCII IDPB 1,CS ;STORE CHAR. JUMPN 2,.-4 ;MORE TO DO? > ;END OF EQ TOPS20 IFN TOPS20,< ;FOR LONF FILES MOVE 1,[3,,[ CHAR,,5 ;GET FILE NAME -1,,BIGBUF 1B8+1B11+1]] ;NAME AND EXTENSION COMPT. 1, ;GET THEM JFCL MOVE 1,[POINT 7,BIGBUF] DONME: ILDB 2,1 JUMPE 2,NOEXT ;ALL DONE THE NAME CAIN 2,"." ;TO THE EXT? JRST EXXT ;YES IDPB 2,CS ;STORE IT JRST DONME EXXT: MOVEI 3,HT ;SEPARATOR IDPB 3,CS ;FOR THE EXTENSION DOEXT: ILDB 2,1 ;THE EXTENSION JUMPE 2,NOEXT IDPB 2,CS ;TO THE OUTPTU JRST DOEXT NOEXT: DMOVE 1,INRIB+3 ;THE DATE DMOVEM 1,INDIR+1 ;FOR THE REST MOVEI 1,HT IDPB 1,CS > ;END OF CONDITIONAL IFE TOPS20,< MOVEI 1,HT ;SEPARATE BY TAB IDPB 1,CS HLLZ 2,INDIR+1 ;GET EXT JUMPE 2,FINEXT ;NO EXT SETZ 1, LSHC 1,6 ;SAME LOOP AS ABOVE ADDI 1,40 IDPB 1,CS JUMPN 2,.-4 MOVEI 1,HT IDPB 1,CS ;SEPARATE BY TAB > ;END OF CONDITIONAL FINEXT: LDB 1,[POINT 12,INDIR+2,35] ;GET LOW 12 BITS OF DATE LDB 2,[POINT 3,INDIR+1,20] ;GET HIGH 3 BITS OF DATE DPB 2,[POINT 3,1,23] ;MERGE TO BITS JUMPE 1,FINDEV ;NO DATE? CALL DATOUT ;STORE IT LDB 2,[POINT 11,INDIR+2,23] ;GET CREATION TIME JUMPE 2,FINDEV ;NO TIME (DECTAPE) MOVEI 1," " ;SEPARATE BY SPACE IDPB 1,CS CALL TIMOU1 ;STORE TIME FINDEV: SETZ 1, MOVEI 2,HT ;FINAL TAB IDPB 2,CS IDPB 1,CS ;TERMINATE FOR NOW POP P,3 ;RESTORE ACCS POP P,2 POP P,1 SKIPN PAGENO ;IF FIRST TIME THRU JRST OUTFF ;START NEW PAGE SETZM PAGENO ;ON NEW FILE, RESET PAGES JRST OUTFF2 ;DON'T START NEW PAGE UNLESS FF INSETI: HLLZM ACEXT,INDIR+1 ;STORE EXTENSION MOVE ACPPN,INDIR+3 ;SAVE PPN LOOKUP CHAR,INDIR SKIPA ACEXT,INDIR+1 ;GET ERROR CODE JRST CPOPJ1 ;SKIP-RETURN IF FOUND TRNE ACEXT,-1 ;ERROR CODE OF 0 IS FILE NOT FOUND JRST ERRCF ;FILE THERE BUT NOT READABLE SETZ ACEXT, ;CLEAR EXT AND TRY AGAIN MOVEM ACPPN,INDIR+3 ;RESTORE PPN RET REC2: MOVS [CTIBUF+1,,CTLSAV] ;RESCAN CONTROL (FROM PASS1 END STMNT) BLT CTIBUF+2 ;INPUT BUFFER MOVEI "_" HRLM ACDELX ;FUDGE PREVIOUS DELIMITER SETZM PASS2I MOVE [XWD PASS2I,PASS2I+1] BLT PASS2X-1 ;ZERO PASS2 VARIABLES TLO FR,MTAPSW!LOADSW ;SET FLAGS GOTEND: MOVE INDEV ;GET LAST DEVICE DEVCHR ;GET ITS CHARACTERISTICS TLNE 4 ;TEST FOR DIRECTORY (DSK OR DTA) JRST EOT ;YES, SO DON'T WASTE TIME JRST .+3 ;NO, INPUT BUFFER BY BUFFER IN CHAR, JRST .-1 ;NO ERRORS STATO CHAR,1B22 ;TEST FOR EOF JRST .-3 ;IGNORE ERRORS EOT: CALL SAVEXS ;SAVE REGISTERS SETOM EOFFLG ;GOING THRU EOF PROCEDURE CALL INSET ;GET THE NEXT INPUT DEVICE JRST EOT0 ;ERROR PUSH P,['MCREP1'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / END OF PASS 1]@/] ;[1066] ASSUME END OF PASS TLZN FR,LOADSW ;ZERO ONLY ON END OF PASS 1 JRST [HRROI RC,[SIXBIT / LOAD THE NEXT FILE]@/] ;[1066] NOT END OF PASS PUSH P,['MCRLNF'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] JRST .+1] ;[1066] TLNE ACDEV,(1B13!1B15) ;WAS ALL THAT WORK NECESSARY? JRST RSTRXS ;NO CALL EINFO ;CR-LF [ CAMN RC,[-1] ;[1066] IF TEXT SUPPRESSED, HRROI RC,[SIXBIT /]@/] ;[1066] FUDGE IN CLOSE BRACKET CALL TYPMSG ;YES RSTRXS: MOVSI RC,SAVBLK ;SET POINTER BLT RC,RC-1 ;RESTORE REGISTERS MOVE RC,SAVERC ;RESTORE RC RET ;EXIT SAVEXS: MOVEM RC,SAVERC ;SAVE RC MOVEI RC,SAVBLK ;SET POINTER BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW RC RET ;EXIT EOT0: JUMP1 [TLON FR,LOADSW ;PRINT MESSAGE ONCE CALL ERRNE ;ON PASS1 JRST EOT1] TLO FR,LOADSW ;USED TO SIGNAL POPJ RET FROM ERRNE CALL ERRNE ;PRINT ERROR MESSAGE EOT1: TLZ IO,IORPTC MOVE P,SAVEPP ;RESTORE STACKS MOVE MP,SAVERP MOVEM MP,RP ;[774] MOVE MP,SAVEMP CALL END01 ;[774] FAKE END SEEN JRST ASSEM1 ;[774] CONTINUE ASSEMBLY AT START OF LINE NAME1: SETZM ACDEVX ;ENTRY FOR DESTINATION NAME2: SETZB ACDEV,INDIR+2 ;ENTRY FOR SOURCE SETZB ACFILE,PPN ;CLEAR FILE AND PPN HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER SETZB TIO,CS IFE TOPS20,< ;FOR SHORT FILES SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR SETZM SFDADD ;CLEAR FIRST WORD OF SFD BLOCK MOVE AC0,[SFDADD,,SFDADD+1] BLT AC0,SFDADD+2+.SFDLN ;AND REST OF IT NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER > ;END OF EQ TOPS20 IFN TOPS20,< ;FOR LONG FILES NAME3: MOVE ACPNTR,[POINT 7,FILNAM] ;ASCII POINTER SETZ ACPPN, ;NOT IN A PPN TO START > SETZ AC0, ;CLEAR SYMBOL JRST GETIOC ;GO GET INPUT CHARACTER SLASH: SETO CS, ;CS=-1 GET RID OF ALPHAS AT END CALL SW0 GETIOC: CALL TTYIN ;GET INPUT CHARACTER CAIN C,"/" JRST SLASH CAIN C,"(" JRST [ SETZ CS, ;CS=0 EVERY CHAR COUNT JRST SWITCH] IFE TOPS20,< ;FOR SHORT FILES CAIN C,":" JRST DEVICE CAIN C,"." JRST NAME > ;END OF EQ TOPS20 CALL TRMTST ;TERMINATOR? JRST TERM ;YES, IFE TOPS20,< ;FOR SHORT FILES CAIE C,OBRCKT ;AN OPEN BRACKET? CAIN C,"[" JRST PROGNP ;GET PROGRAMER NUMBER PAIR > ;END OF CONDITIONAL IFN TOPS20,< ;FOR LONG FILES CAIN C,"," ;A COMMA? JUMPL ACPPN,INPPN ;YES. IN A PPN? > ;END OF EQ TOPS20 CAIN C,"=" ;EQUALS IS SAME AS LEFT ARROW TRCA C,142 ;SO MAKE IT A "_" AND SKIP CAIE C,"," CAIN C,"_" JRST TERM JUMPL C,TERME ;ERROR RETURN FROM TTYIN? IFE TOPS20,< ;FOR SHORT FILES CAIGE C,40 ;VALID AS SIXBIT? JRST [CAIN C,CZ ;NO,IS IT ^Z JRST CZSTOP ;YES,EXIT FOR BATCH JRST GETIOC] ;JUST IGNORE CAIL C,"0" ;ERROR IF NOT ALPHANUMERIC CAILE C,"Z" JRST ERRCM CAILE C,"9" CAIL C,"A" CAIA JRST ERRCM SUBI C,40 ;CONVERT TO 6-BIT TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES? IDPB C,ACPNTR ;NO, STORE IT JRST GETIOC ;GET NEXT CHARACTER > ;END OF EQ TOPS20 IFN TOPS20,< ;FOR LONG FILES CAIN C,"[" ;START OF A PPN? SETOM ACPPN ;YES. REMEMBER THUIS CAIN C,"]" ;END OF A PPN? SETZ ACPPN, ;YES. REMEMBER THIS CAIN C,CZ ;^Z? JRST CZSTOP ;YES INPPN: IDPB C,ACPNTR ;NO. SAVE BYTE JRST GETIOC ;AND GO GET MORE > ;END OF NE TOPS20 TRMTST: ;TERMINATOR TEST IFN CCLSW, ;YES, GO DO IT CAIE C,33 ;CHECK FOR THREE FLAVORS OF ALT-MODE CAIN C,176 ;... RET CAIG C,CR ;LESS THAN CR? CAIGE C,LF ;AND GREATER THAN LF? CAIN C,175 ;OR 3RD ALTMOD RET CAIN C,";" ;SEMI-COLON? RET ;YES, JRST CPOPJ1 ;NOT A TERMINATOR, SKIP RETURN DEVICE: JUMPN ACDEV,ERRCM ;ERROR IF ALREADY SET MOVE ACDEV,AC0 ;DEVICE NAME JRST DEVNAM ;COMMON CODE NAME: JUMPN ACFILE,ERRCM ;ERROR IF ALREADY SET MOVE ACFILE,AC0 ;FILE NAME DEVNAM: MOVE ACDEL,C ;SET DELIMITER JRST NAME3 ;GET NEXT SYMBOL TERME: TLZA C,-1 ;MAKE INTO 33 BUT GIVE ERROR RET TERM: AOS (P) ;GIVE SKIP RETURN ON VALID TERMINATOR IFN TOPS20,< ;FOR LONG FILES SETZ ACDEV, ;GET A NULL IDPB ACDEV,ACPNTR ;TIE OFF ASCII STRING > JUMPE ACDEL,TERM1 ;IF NO PREVIOUS TERMINATOR, THEN FILENAME CAIN ACDEL,"_" ;... JRST TERM1 ;... CAIE ACDEL,":" ;IF PREVIOUS DELIMITER CAIN ACDEL,"," ;WAS COLON OR COMMA TERM1: MOVE ACFILE,AC0 ;SET FILE CAIN ACDEL,"." ;IF PERIOD, HLLO ACEXT,AC0 ;SET EXTENSION HRLM C,ACDELX ;SAVE PREVIOUS DELIMITER IFN TOPS20, ;ALL DONE IF LONG FILES JUMPN ACDEV,.+2 ;IF DEVICE SET USE IT SKIPA ACDEV,ACDEVX ;OTHERWISE USE LAST DEVICE MOVEM ACDEV,ACDEVX ;AND DEVICE SKIPN ACPPN,PPN ;PUT PPN IN RIGHT PLACE SKIPN PPPN ;DO WE HAVE A DEFAULT? JRST TERM2 ;PPN IS SETUP MOVE ACPPN,[PSFD,,SFDADD] ; MOVE DEFAULT SFD BLT ACPPN,SFDE MOVE ACPPN,PPPN ;AND PPN TERM2: CAIN C,"!" ;IMPERATIVE? RET ;YES, DON'T ASSUME DEV JUMPE ACFILE,CPOPJ ;IF THERE IS A FILE, JUMPN ACDEV,.+2 ;BUT NO DEVICE MOVSI ACDEV,'DSK' ;THEN ASSUME DISK RET ;EXIT CZSTOP: EXIT 1, ;MONRET JRST M ;CONTINUE ERRCM: PUSH P,['MCRCME'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / COMMAND ERROR@/] ;[1066] JRST ERRFIN PROGNP: CALL GETOCT ;GET AN OCTAL NUMBER IN RC SKIPN RC ;IF ITS 0, USE HLRZ RC,MYPPN ;USE LOGGED IN PROJECT NUMBER HRLZM RC,PPN ;STORE IT CAIE C,"," ;MORE? JRST PPNTST ;NO, GIVE UP CALL GETOCT ;GET AN OCTAL NUMBER SKIPN RC ;IF ITS 0, USE HRRZ RC,MYPPN ;MY PROGRAMMER NUMBER HRRM RC,PPN ;STORE IT CAIE C,"," ;SFD'S? JRST PPNTST ;NO MOVEI C,SFDADD ;POINT TO DDDSFD BLOCK EXCH C,PPN ;SWAP WITH PPN MOVEM C,SFDADD+2 ;STORE IT MOVEI RC,SFDADD+3 ;START OF SFD AREA SFD1: HRRZS RC ;CLEAR BYTE POINTER CAILE RC,SFDADD+2+.SFDLN JRST ERRCM ;PATH TOO LONG HRLI RC,(POINT 6) ;BYTE POINTER SETUP SFD2: CALL TTYIN ;GET CHAR CAIE C,">" ;ALT FORM CAIN C,"]" ;END? JRST PPNTST ;YES CALL TRMTST ;OR TERMINATOR? JRST PPNTST ;YES CAIN C,"," ;NEXT SFD AOJA RC,SFD1 ;YES, INCREMENT STORE ADDRESS SUBI C,40 ;CONVERT TO SIXBIT JUMPL C,ERRCM ;ERROR TLNE RC,770000 ;SPACE IN WORD IDPB C,RC ;YES, STORE CHAR. JRST SFD2 ;GET NEXT CHAR GETOCT: SETZ RC, ;START WITH ZERO GETOC1: CALL TTYIN CAIE C,"," ;TEST FOR COMMA CAIN C,"]" ;AND CLOSE SQB RET ;YES, WEVE GOT SOMETHING CAIN C,">" ;ALSO ALT FORM RET CALL TRMTST RET IFE STANSW,< CAIL C,"0" ;CHECK FOR VALID NUMBERS CAILE C,"7" JRST ERRCM ;NOT VALID LSH RC,3 ;SHIFT PREVIOUS RESULT ADDI RC,-"0"(C)> ;ADD IN NEW NUMBER IFN STANSW, ;PUT IN NEW CHARACTER JRST GETOC1 ;GET NEXT CHARACTER ; HERE TO TEST FOR DEFAULT PPN PPNTST: SKIPN ACFILE ;SEEN FILE NAME YET? SKIPE AC0 ;OR PENDING JRST PPNTS1 ;NO PUSH P,AC0 ;GET AN AC MOVE AC0,PPN ;GET PPN MOVEM AC0,PPPN ;MAKE IT PERMANENT MOVE AC0,[SFDADD,,PSFD] BLT AC0,PSFDE ;SAME FOR SFDS POP P,AC0 PPNTS1: CALL TRMTST JRST TERM JRST GETIOC ; END OF EDIT SWITC0: CALL SW1 ;PROCESS CHARACTER SWITCH: CALL TTYIN ;GET NEXT CHARACTER CAIE C,")" ;END OF STRING? JRST SWITC0 ;NO JRST GETIOC ;YES SW0: CALL TTYIN SW1: HRREI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC JUMPL C,SEELPP ;NUMERIC VALUE MAYBE? CAILE C,"Z"-"A" ;WITHIN BOUNDS? (IS IT ALPHA?) JRST ERRCM ;NO, LT. Z, ERROR MOVE RC,[POINT 5,BYTAB] IBP RC SOJGE C,.-1 ;MOVE TO PROPER BYTE LDB C,RC ;PICK UP BYTE JUMPE C,ERRCM ;TEST FOR VALID SWITCH CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE? JUMPL P,ERRCM ;NO, TEST FOR SOURCE LDB RC,[POINT 4,SWTAB-1(C),12] CAIN RC,IO SKIPN CTLSAV ;IF PASS2 OR IO SWITCH, XCT SWTAB-1(C) ;EXECUTE INSTRUCTION SKIPA TLZ IO,IOSALL ;TAKE CARE OF /X JUMPN CS,SW2 ;DOING A SLASH? IF YES, JUMP RET SW2: SETZ CS, CALL TTYIN ;NEXT CHAR CAIL C,"A" CAILE C,"z" JRST CPOPJ1 ;SKIP RETURN, SO NOT TO DO ANOTHER TTYIN CAILE C,"Z" ;HERE IS BETWEEN A AND z CAIL C,"a" ;NOW, IS IT BETWEEN Z AND a? JRST SW2+1 ;NO, IT'S ALPHA JRST CPOPJ1 ;YES, NOT ALPHA, SKIP RETURN HELP: PUSH P,.JBFF ;SAVE REAL .JBFF MOVE 1,.JBREL ;USE JOBREL MOVEM 1,.JBFF ;SO HELPER DOESN'T DESTROY SYMBOL TABLE MOVE 1,['MACRO '] ;GET MACRO.HLP CALL .HELPR ;CALL HELPER POP P,.JBFF ;RESTORE JOBFF IN CASE CCL MODE JRST M ;RESTART ; HERE FOR /nnL SWITCH TO SET LINES/PAGE SEELPP: ADDI C,"A"-"0" ;TO NUMERIC RANGE CAIG C,9 ;IS IT JUMPGE C,.+2 JRST ERRCM ;NO, BARF MOVE RC,C ;MOVE VALUE SEELP1: CALL TTYIN ;GET NEXT CAIG C,"9" ;IS IT NUMERIC CAIGE C,"0" ;... JRST SEELP2 ;NO, CHECK END IMULI RC,^D10 ;MAKE SPACE ADDI RC,-"0"(C) ;AND PUT DIGIT JRST SEELP1 ;AND CONTINUE SEELP2: CAIE C,"L" ;END PROPERLY? JRST ERRCM ;NO, BARF SUBI RC,4 ;EASIER FOR SYMBOL OUTPUT ROUTINES JUMPL RC,[PUSH P,['MCRATS'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT \ LINES/PAGE ARGUMENT TOO SMALL@\] ;[1066] JRST ERRFIN] ;[676] PREVENT INFINITE LOOP MOVEM RC,..LPP ;SAVE IN "READ-ONLY" RET ;ALL DONE DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION J= <"LETTER"-"A">-7*/7> SETCOD \I,J> DEFINE SETCOD (I,J) B<5*J+4>> BYTAB0= 0 ;INITIALIZE TABLE BYTAB1= 0 BYTAB2= 0 BYTAB3= 0 SWTAB: SETSW Z, SETSW C, SETSW P, SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY SETSW A, SETSW B, SETSW E, IFN FORMSW,< SETSW F, SETSW G,> SETSW H, SETSW L, SETSW M, SETSW N, SETSW O, SETSW Q, SETSW S, SETSW T, SETSW U, SETSW W, SETSW X, IFG .-SWTAB-37, BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB ;IT CONSIST OF 7 5BIT BYTES/WORD ;OR ONE BYTE FOR EACH LETTER +BYTAB0 ;A-G BYTE = 1 THROUGH 17 = INDEX +BYTAB1 ;H-N BYTE = 0 = COMMAND ERROR +BYTAB2 ;O-U +BYTAB3 ;V-Z IF2, TTYIN: SOSGE CTIBUF+2 ;ENUF CHAR.? JRST TTYERR ;NO ILDB C,CTIBUF+1 ;GET CHARACTER CAIE C," " ;SKIP BLANKS CAIN C,HT ;AND TABS JRST TTYIN CAIN C,15 ;CR? SETZM CTIBUF+2 ;YES,IGNORE REST OF LINE CAIG C,"Z"+40 ;CHECK FOR LOWER CASE CAIGE C,"A"+40 RET ;NO,EXIT SUBI C,40 RET ;YES, EXIT COMERR: PUSH P,['MCRCTL'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / COMMAND LINE TOO LONG@/] ;[1066] JRST ERRFIN TTYERR: SKIPN INDEV ;INPUT DEVICE SEEN? JRST ERRCM ;NO, SO MISSING "_" HRROI C,EOL ;SIGNAL ERROR RET ;AND RETURN ERRNE: PUSH P,['MCRNES'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / NO END STATEMENT ENCOUNTERED ON INPUT FILE@/] ;[1066] ERRNE4: JUMP1 .+2 ;[702] COUNT ERROR ON PASS2 AOS ERRCNT ;[702] ERRNE0: CALL EFATAL ;OUTPUT CR-LF ?MCR CALL TYPMSG ;OUTPUT IT SKIPE LITLVL ;SEE IF IN LITERAL SKIPN LITPG ;PAGE 0 MEANS NOT IN A LITERAL REALLY JRST ERRNE1 ;NO, TRY OTHERS MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG] CAME RC,[-1] ;[1066] SUPPRESS INFO IF REQUIRED BY ;[1066] MESSAGE LEVEL BITS CALL PRNUM ;GO PRINT INFORMATION ERRNE1: MOVEI V,0 ;CHECK FOR OTHER PLACES SKIPE INDEF MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG] SKIPE INTXT MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG] SKIPE INREP MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG] SKIPE INCND MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG] SKIPGE MACENL ERRNE2: MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG] SETOM UNVSKP ;SET /U IN CASE CONTINUE ASSEMBLY JUMPN V,ERRNE3 MOVE V,[XWD [SIXBIT /@/],PAGENO] ;BETTER THAN NOTHING SKIPE LITLVL ;HAD ONE PAGE NUMBER ALREADY RET ERRNE3: CAME RC,[-1] ;[1066] SUPPRESS TEXT IF REQUIRED BY ;[1066] MESSAGE LEVEL BITS CALL PRNUM TLNE FR,LOADSW ;SEEN END OF FILE YET? RET ;YES MOVE P,SAVEPP ;NO RESET STACK MOVE MP,SAVERP MOVEM MP,RP MOVE MP,SAVEMP SETZ MRP, SETZM LBLFLG ;[1074] CLEAR LABEL-IN-LITERAL FLAG JRST ASSEM2 ;AND CONTINUE ERRMS1: SIXBIT / ERRORS DETECTED@/ ERRMS2: SIXBIT /1 ERROR DETECTED@/ ERRMS3: SIXBIT /NO ERRORS DETECTED@/ ERRMQ1: SIXBIT /1 WARNING GIVEN@/ ERRMQ2: SIXBIT / WARNINGS GIVEN@/ IFE TOPS20,< ;FOR SHORT FILES EINIT: PUSH P,['MCRDNA'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE @/]] CALL EFATAL ;[1066] OUTPUT PREFIX MOVEI C," " ;[1066] FORCE A SPACE CALL TYO ;[1066] JRST ERRFN1 ;REST OF MESSAGE > ;END OF EQ TOPS20 IFN TOPS20,< ;FOR LONG FILES EINIT: OUTSTR [ASCIZ / ?MCRFNF FILE NOT FOUND-/] EINIT0: OUTSTR FILNAM ;AND THE FILE NAME OUTSTR [ASCIZ / /] JRST M ;AND START OVER EINIT1: OUTSTR [ASCIZ/ ?MCRRFO REL FILE OPEN ERROR - /] JRST EINIT0 EINIT2: OUTSTR [ASCIZ/ ?MCRLFO LST FILE OPEN ERROR - /] JRST EINIT0 > ;END OF NE TOPS20 CONDITIONAL ERRCL: HRRZ RC,LSTDIR+1 ;GET LST DEV ERROR CODE JRST .+2 ;GET ERROR MESSAGE ERRCB: HRRZ RC,BINDIR+1 ;GET BIN DEV ERROR CODE JUMPN RC,ERRTYP SOJA RC,ERRTYP ;SPECIAL CASE IF ERROR CODE 0 ERRCF: HRRZ RC,INDIR+1 ;GET INPUT DEV ERROR CODE HLLZ ACEXT,INDIR+1 ;SET UP EXT ERRTYP: CAIL RC,TABLND-TABLE ;IS ERROR CODE LEGAL? SKIPA RC,TABLND ;NO, GIVE CATCH ALL MESSAGE MOVE RC,TABLE(RC) ;YES, PICK UP MESSAGE PUSH P,['MCRLRE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] ERRFIN: CALL EFATAL ERRFN1: CALL TYPMSG ERRFN2: CLOSE LST, ;[1066] GIVE USER A PARTIAL LISTING CLOSE BIN,40 ;BUT NEVER A BUM REL FILE JRST M EFATAL: ;[1066] IFN CCLSW, ;RECORD ERROR SO EXECUTION DELETED MOVEI CS,"?" ;[1066] ECOMMN: SKPINC C ;[1066] SEE IF WE CAN INPUT A CHAR. JFCL ;[1066] BUT ONLY TO DEFEAT ^O CALL CRLF ;[1066] MOVE C,CS ;[1066] GET LEADING CHARACTER CALL TYO ;[1066] OUTPUT IT IFE TOPS20,< ;[1066] FORCE DEFAULT ON TOPS20 HRROI C,35 ;[1066] GET MESSAGE LEVEL BITS GETTAB C, ;[1066] RETURN THEM IN C MOVEI C,0 ;[1066] RETURN ZERO IF ERROR TLNN C,700 ;[1066] IF NO BITS SET, TLO C,300 ;[1066] SET DEFAULT (PREFIX!FIRST) TLNE C,400 ;[1066] IF CONTINUATION, TLO C,200 ;[1066] FORCE FIRST TLNN C,200 ;[1066] WANT MESSAGE? SETOM RC ;[1066] NO, OBLITERATE IT TLNN C,100 ;[1066] WANT PREFIX? RET ;[1066] NO, EXIT NOW > ;[1066] END IFE TOPS20 MOVE CS,PREFIX ;[1066] OUTPUT PREFIX PJRST TYPSYM ;AND RETURN EWARN: MOVEI CS,"%" ;[1066] JRST ECOMMN ;[1066] JOIN COMMON ROUTINE EINFO: MOVEI CS,"[" ;[1066] JRST ECOMMN ;[1066] JOIN COMMON ROUTINE [SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE TABLE: [SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE [SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE [SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE [SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE [SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE [SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE [SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE [SIXBIT /(7) NOT A SAV FILE@/],,ACFILE [SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE [SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE [SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE [SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE [SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE [SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE [SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE [SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE [SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE [SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE [SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE [SIXBIT /(23) SFD NOT FOUND@/],,ACFILE [SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE [SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE [SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE TABLND: [SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE TYPMSG: HLRZ CS,RC ;GET FIRST MESSAGE CAIE CS,-1 ;SKIP IF MINUS ONE CALL TYPM2 ;TYPE MESSAGE HRRZ CS,RC ;GET SECOND HALF CAIE CS,-1 ;[1066] SKIP IF -1 CALL TYPM2 CRLF: MOVEI C,CR ;OUTPUT CARRIAGE RETURN CALL TYO MOVEI C,LF ;AND LINE FEED TYO: SOSG CTOBUF+2 ;BUFFER FULL? OUTPUT CTL,0 ;YES, DUMP IT IDPB C,CTOBUF+1 ;STORE BYTE CAIG C,FF ;FORM FEED? CAIGE C,LF ;V TAB OR LINE FEED? RET ;NO OUTPUT CTL,0 ;YES RET ;AND EXIT TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD CAIN CS,ACFILE ;FILE NAME ? JRST [JUMPE ACEXT,.+1 ;YES, TEST FOR EXT LSH ACEXT,-6 ;MAKE SPACE FOR "." IOR ACEXT,[SIXBIT /. @/] JRST TYPM2A] CAIG CS,17 ;IS IT? MOVEM C,1(CS) TYPM2A: HRLI CS,(POINT 6,,) ;FORM BYTE POINTER TYPM3: ILDB C,CS ;GET A SIXBIT BYTE CAIN C,40 ;"@"? JRST TYO ;YES, TYPE SPACE AND EXIT ADDI C,40 ;NO, FORM 7-BIT ASCII CALL TYO ;OUTPUT CHARACTER JRST TYPM3 TYPSYM: MOVEI C,0 ;CLEAR C LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN JUMPE C,CPOPJ ;TEST FOR END ADDI C,40 ;CONVERT TO ASCII CALL TYO ;OUTPUT JRST TYPSYM ;LOOP ;TYPE OUT OCTAL NUMBER (SEE DP1:) TYPOCT: IDIVI AC0,^D8 ;[1060] HRLM AC1,(P) ;[1060] JUMPE AC0,.+2 ;[1060] CALL TYPOCT ;[1060] HLRZ C,(P) ;[1060] ADDI C,"0" ;[1060] JRST TYO ;[1060] XCEEDS: ADDI SX,2000 ;ADJUST SYMBOL POINTER XCEED: CALL SAVEXS ;SAVE THE REGISTERS HRRZ 1,.JBREL ;GET CURRENT TOP MOVEI 0,2000(1) CORE 0, ;REQUEST MORE CORE JRST XCEED2 ;ERROR, BOMB OUT HRRZ 2,.JBREL ;GET NEW TOP XCEED1: MOVE 0,0(1) ;GET ORIGIONAL MOVEM 0,0(2) ;STORE IN NEW LOCATION SUBI 2,1 ;DECREMENT UPPER CAMLE 1,SYMBOL ;HAVE WE ARRIVED? SOJA 1,XCEED1 ;NO, GET ANOTHER MOVEI 1,2000 ADDM 1,SYMBOL ADDM 1,SYMTOP CALL SRCHI ;RE-INITIALIZE SYMBOL TABLE JRST RSTRXS ;RESTORE REGISTERS AND EXIT XCEED2: PUSH P,['MCRNEC'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT / INSUFFICIENT CORE@/] ;[1066] XCEED3: TLO FR,LOADSW ;MAKE SURE IT COMES BACK CALL ERRNE0 ;GO PRINT HERE JRST ERRFN2 ;[1066] START OVER PDPERR: PUSH P,['MCRPDL'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] HRROI RC,[SIXBIT . PDP OVERFLOW, TRY /P@.] ;[1066] MOVE P,SAVEPP ;GET A VALID STACK POINTER JRST XCEED3 ;DON'T CONTINUE ASSEMBLY PRNUM: HLRZ CS,V ;GET MESSAGE CALL TYPM2 MOVEI CS,[SIXBIT /ON PAGE@/] CALL TYPM2 MOVE AC0,(V) ;GET PAGE CALL DP1 ;PRINT NUMBER MOVEI C,40 CALL TYO SKIPN AC1,1(V) ;GET SEQ NUM IF THERE JRST PRNUM1 ;NO, TRY FOR TAG MOVEM AC1,OUTSQ MOVEI CS,[SIXBIT /LINE@/] CALL TYPM2 OUTPUT CTL,0 ;TO MAKE THINGS PRINT IN RIGHT ORDER OUTSTR OUTSQ ;PRINT SEQUENCE NUMBER MOVEI C," " ;ADD SPACE CALL TYO PRNUM1: MOVEI CS,[SIXBIT /AT@/] CALL TYPM2 MOVE CS,2(V) CALL TYPSYM ;PRINT TAG MOVEI CS,[SIXBIT / +@/] CALL TYPM2 HRRZ AC0,3(V) ;[666] CALL DP1 ;PRINT DECIMAL INCREMENT PJRST CRLF ;END LINE DP1: IDIVI AC0,^D10 HRLM AC1,(P) JUMPE AC0,.+2 CALL DP1 HLRZ C,(P) ADDI C,"0" JRST TYO RIM0: TDO FR,AC0 ;SET RIM/RIM10 FLAG TLNE FR,PNCHSW ;FORGET IT IF PUNCH RESET SETSTS BIN,IB ;SET TO IMAGE BINARY MODE RET ROUT: EXCH CS,RIMLOC SUB P,[XWD 1,1] ;CLEAR OUT STACK WFW TLNE FR,R1BSW JRST ROUT6 TLNN FR,RIM1SW JRST ROUT1 JUMPE CS,ROUT1 ;RIM10 OUTPUT SUB CS,RIMLOC JUMPE CS,ROUT1 JUMPG CS,ERRAX MOVEI C,0 CALL PTPBIN AOJL CS,.-1 ROUT1: MOVSI C,(DATAI PTR,) ;RIM OUTPUT HRR C,LOCO ;GET ADDRESS TLNE FR,RIM1SW ;NO DATAI IF RIM10 AOSA RIMLOC CALL PTPBIN ;OUTPUT MOVE C,AC0 ;CODE AOSA LOCO ;INCREMENT CURRENT LOCATION OUTBIN: TLNN FR,RIMSW!RIM1SW!R1BSW ;EXIT IF RIM MODE PTPBIN: TLNN FR,PNCHSW ;EXIT IF PUNCH NOT REQUESTED RET SOSG BINBUF+2 ;TEST FOR BUFFER FULL CALL DMPBIN ;YES, DUMP IT IDPB C,BINBUF+1 ;DEPOSIT BYTE RET ;EXIT DMPBIN: OUT BIN,0 ;DUMP THE BUFFER RET ;NO ERRORS TSTBIN: GETSTS BIN,C ;GET STSTUS BITS TRNN C,ERRBIT ;ERROR? RET ;NO, EXIT MOVE AC0,BINDEV ;YES, GET TAG JRST ERRLST ;TYPE MESSAGE AND ABORT DMPLST: OUT LST,0 ;OUTPUT BUFFER RET ;NO ERRORS TSTLST: GETSTS LST,C ;ANY ERRORS? TRNN C,ERRBIT RET ;NO, EXIT MOVE AC0,LSTDEV ERRLST: PUSH P,['MCRWLE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / OUTPUT WRITE-LOCK ERROR DEVICE@/] ;[1066] TRNE C,IOIMPM ;IMPROPER MODE? JRST ERRFIN ;YES PUSH P,['MCRODE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / OUTPUT DATA ERROR DEVICE@/] ;[1066] TRNE C,IODERR ;DEVICE DATA ERROR? JRST ERRFIN ;YES PUSH P,['MCROCP'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/] ;[1066] TRNE C,IODTER ;IS IT JRST ERRFIN ;YES MOVE CS,AC0 ;GET DEVICE DEVCHR CS, ;FIND OUT WHAT IT IS PUSH P,['MCROQE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / OUTPUT QUOTA EXCEEDED ON DEVICE@/] ;[1066] TLNN CS,DSKBIT ;SKIP IF DSK OUTPUT PUSH P,['MCROBL'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / OUTPUT BLOCK TOO LARGE DEVICE@/] ;[1066] JRST ERRFIN R1BDMP: SETCM CS,R1BCNT JUMPE CS,R1BI HRLZS C,CS HRR C,R1BLOC HRRI C,-1(C) MOVEM C,R1BCHK CALL PTPBIN HRRI CS,R1BBLK R1BDM1: MOVE C,0(CS) ADDM C,R1BCHK CALL PTPBIN AOBJN CS,R1BDM1 MOVE C,R1BCHK CALL PTPBIN R1BI: SETOM R1BCNT PUSH P,LOCO POP P,R1BLOC RET ROUT6: CAME CS,RIMLOC CALL R1BDMP AOS C,R1BCNT MOVEM AC0,R1BBLK(C) AOS LOCO CAIN C,.R1B-1 CALL R1BDMP AOS RIMLOC RET R1BLDR: PHASE 0 IOWD $ADR,$ST $ST: CONO PTR,60 HRRI $A,$RD+1 $RD: CONSO PTR,10 JRST .-1 DATAI PTR,@$TBL1-$RD+1($A) XCT $TBL1-$RD+1($A) XCT $TBL2-$RD+1($A) $A: SOJA $A, $TBL1: CAME $CKSM,$ADR ADD $CKSM,1($ADR) SKIPL $CKSM,$ADR $TBL2: JRST 4,$ST AOBJN $ADR,$RD $ADR: JRST $ST+1 $CKSM: DEPHASE IF2,< PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM> READ0: CALL EOT ;END OF TAPE READ: SOSGE IBUF+2 ;BUFFER EMPTY? JRST READ3 ;YES READ1: ILDB C,IBUF+1 ;PLACE CHARACTER IN C MOVE CS,@IBUF+1 ;CHECK FOR SEQUENCE NUMBER TRNN CS,1 JRST READ1A CAMN CS,[+1] ; HOWEVER IF AN SOS PAGE MARK SETZ CS, ;CLEAR SEQ NO. SO LINE NOT COUNTED MOVEM CS,SEQNO MOVEM CS,SEQNO2 MOVNI CS,4 ADDM CS,IBUF+2 ;ADJUST WORD COUNT REPEAT 4,< IBP IBUF+1> ;SKIP SEQ NO CALL READ ;AND THE TAB JRST READ ;GET NEXT CHARACTER READ1A: JUMPE C,READ ;IGNORE NULL CAIG C,CLA ;[664] CHECK RANGE CAIGE C,CZ ;[664] RET ;[664] FAST EXIT FOR TYPICAL CASE CAIE C,CZ ;IF IT'S A "^Z" JRST READ1B ;[554] MOVE CS,INDEV ;CHECK DEVICE DEVCHR CS, ;[554] TLNE CS,10 ;IF TTY, MOVEI C,LF ;TREAT IT AS A "LF" RET ;EXIT READ1B: CAIE C,CLA ;CONTROL _ RET MOVEI C,"^" ;MAKE CONTROL _ VISIBLE CALL RSW2 MOVEI C,"_" CALL RSW2 CALL PEEK ;LOOK AT NEXT CHAR CAIG C,CR ;IF IT IS END OF LINE CAIGE C,LF JRST [POP P,CS ;GET RETURN ADDRESS PUSH P,LIMBO ;SAVE NEXT CHAR,RSW1 DESTROYS IT MOVEI C,CLA ;RESTORE ^_ CALL (CS) ;RETURN TO LIST CHAR ETC POP P,LIMBO ;SAFE TO STORE NOW RET] ;RETURN TO PROGRAM TLZ IO,IORPTC ;USE THE CHAR IN C NOW JRST READ2A ;BUT DON'T LIST TWICE READ2: CALL READ ;YES, TEST FOR LINE FEED CALL RSW2 ;LIST IN ANY EVENT READ2A: CAIG C,FF ;IS IT ONE OF CAIGE C,LF ;LF, VT, OR FF? JRST READ2 ;NO CALL OUTIM1 ;YES, DUMP THE LINE JRST READ ;RETURN NEXT CHARACTER READ3: IN CHAR,0 ;GET NEXT BUFFER JRST READ ;NO ERRORS GETSTS CHAR,C TRNN C,ERRBIT!2000 ;ERRORS? JRST READ0 ;EOF MOVE AC0,INDEV READ4: PUSH P,['MCRPET'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / INPUT PHYSICAL END OF TAPE DEVICE@/] ;[1066] TRNE C,2000 JRST ERRFIN ;E-O-T PUSH P,['MCRMDE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/] ;[1066] TRNE C,IOIMPM ;IMPROPER MODE? JRST ERRFIN ;YES PUSH P,['MCRIDE'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / INPUT DATA ERROR DEVICE@/] ;[1066] TRNE C,IODERR ;DEVICE DATA ERROR? JRST ERRFIN ;YES PUSH P,['MCRICP'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / INPUT CHECKSUM OR PARITY ERROR DEVICE@/] ;[1066] TRNN C,IODTER PUSH P,['MCRIBL'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / INPUT BLOCK TOO LARGE DEVICE@/] ;[1066] JRST ERRFIN OUTTAB: MOVEI C,HT JRST OUTL ;[664] AVOID CHECKS PRINT: CAIG C,CR ;[664] RANGE CHECK CAIGE C,LF ;[664] JRST OUTL JRST @PRINTB-12(C) ;[664] CALL PROPER ROUTINE PRINTB: EXP OUTCR,OUTVT,OUTFF0,OUTCR ;[1003][664] OUTVT: PUSH P,C+1 ;NEED ADJACENT ACC MOVEI C,.LPP ;NO. OF LINES WE STARTED WITH SUB C,LPP ;MINUS NO. OF LINES LEFT IDIVI C,^D20 ;HOW MANY WILL VT TAKE SUBI C+1,^D20 ;TO GET TO NEXT TAB STOP ADDM C+1,LPP ;ACCOUNT FOR THEM POP P,C+1 MOVEI C,VT ;PUT CHAR BACK SKIPLE LPP ;DID WE END PAGE? JRST OUTL ;NO, OUTPUT IT TLO IO,IOPAGE ;YES, NEXT TIME CALL OUTC ;[1003] YES, OUTPUT CHAR SETOM CRFLG ;[1003] PAGE NEXT, ADDING CRLF RET ;[1003] OUTCR0: CALL OUTAS0 ;[664] OUTCR: TRNN ER,ERRORS!LPTSW!TTYSW RET SETOM CRLFSN ;[1064] SET FLAG IN CASE WE SEE LALL MOVEI C,CR ;CARRIAGE RETURN, LINE FEED CALL OUTL TRNE ER,LPTSW ;[756] GOING TO LISTING? JRST OUTCR1 ;[756] YES, COUNT THIS LINE TRNN ER,TTYSW ;[756] GOING TO TTY? JRST OUTCR2 ;[756] NO, DON'T COUNT IT MOVE C,OUTSW ;[756] SEE IF TTY IS LIST DEV CAIN C,TTYSW ;[756] IF SO, COUNT IT OUTCR1: SOSL LPP ;[756] END OF PAGE? JRST OUTCR2 ;[756] TLO IO,IOPAGE ;[756] YES, SET FLAG SETOM INTPGR ;[756] AND FLAG INTERNAL PAGE REQUEST OUTCR2: MOVEI C,LF ;[756] SET LF, EXIT THRU OUTC PJRST OUTC ;[756] OUTL: TLZN IO,IOPAGE ;NEW PAGE REQUESTED? JRST OUTC ;NO JUMP1 OUTC ;YES, BYPASS IF PASS ONE TLNE IO,IOMSTR+IOPROG ;XLIST IN EFFECT JRST [ SKIPN INTPGR ;[655] BYPASS UNLESS IN SALL MACRO AND JRST OUTC ;[655] PAGE REQUEST WAS INTERNAL TLNE IO,IOSALL ;[655] JUMPN MRP,.+1 ;[655] SETZM INTPGR ;[655] JRST OUTC] ;[655] SETZM INTPGR ;[655] CLEAR INT PAGE-REQUEST JUST IN CASE PUSH P,C ;SAVE C AND CS PUSH P,CS PUSH P,ER HRR ER,OUTSW TLNE IO,IOCREF ;IF DOING CREF OUTPUT NOW TLNE FR,CREFSW ;AND CREFFING (JUST IN CASE) JRST .+2 CALL CLSC3 ;CLOSE IT OUT HLLM IO,(P) ;SAVE THIS NEW STATE OF IO MOVE C,..LPP ADDI C,2 ;PUT BACK THE 2 LINES MOVEM C,LPP ;SET NEW COUNTER SKIPE CRFLG ;[1003] CRLF NEEDED? CALL OUTCR ;[1003] YES, MOVEI C,FF CALL OUTC ;OUTPUT FORM FEED MOVEI CS,TBUF CALL OUTAS0 ;OUTPUT TITLE MOVEI CS,VBUF CALL OUTAS0 ;OUTPUT VERSION MOVEI CS,DBUF CALL OUTAS0 ;AND DATE MOVE C,PAGENO CALL DNC ;OUTPUT PAGE NUMBER AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER? JRST OUTL1 ;YES MOVEI C,"-" ;NO, PUT OUT MODIFIER CALL OUTC MOVE C,PAGEN. CALL DNC OUTL1: CALL OUTCR MOVEI CS,DEVBUF CALL OUTAS0 HRRZ CS,SUBTTX ;SWITCH FOR SUB-TITLE SKIPE 0(CS) ;IS THERE A SUB-TITLE? CALL OUTTAB ;YES, OUTPUT A TAB CALL OUTCR0 ;[664] OUTPUT ASCII WITH CARRIAGE RETURN CALL OUTCR POP P,ER POP P,CS ;RESTORE REGISTERS POP P,C OUTC: SETZM CRFLG ;[1003] CLEAR CRLF REQUEST TRNE ER,ERRORS!TTYSW CALL TYO TRNN ER,LPTSW RET OUTLST: SOSG LSTBUF+2 ;BUFFER FULL? CALL DMPLST ;YES, DUMP IT IFN STANSW,< CAIN C,"@" MOVEI C,140 CAIN C,"_" MOVEI C,30 CAIN C,"^" MOVEI C,32 CAIE C,"\" JRST OUTLSS MOVEI C,177 IDPB C,LSTBUF+1 JRST OUTLST OUTLSS: > IDPB C,LSTBUF+1 ;STORE BYTE RET ;EXIT OUTFF0: SETOM CRFLG ;[1003] CRLF WILL BE NEEDED OUTFF: TLOA IO,IOPAGE OUTFF1: CALL PAGE1 ;CLOSE CREF OUTFF2: SETOM PAGEN. AOS PAGENO RET TIMOUT: IDIVI 2,^D60*^D1000 TIMOU1: IDIVI 2,^D60 PUSH P,3 ;SAVE MINUTES CALL OTOD ;STORE HOURS MOVEI 3,":" ;SEPARATE BY COLON IDPB 3,CS POP P,2 ;STORE MINUTES OTOD: IDIVI 2,^D10 ADDI 2,60 ;FORM ASCII IDPB 2,CS ADDI 3,60 IDPB 3,CS RET DATOUT: IDIVI 1,^D31 ;GET DAY ADDI 2,1 CAIG 2,^D9 ;TWO DIGITS? ADDI 2,7760*^D10 ;NO, PUT IN SPACE CALL OTOD ;STORE DAY IDIVI 1,^D12 ;GET MONTH MOVE 2,DTAB(2) ;GET MNEMONIC IDPB 2,CS ;DEPOSIT RIGHT MOST 7 BITS LSH 2,-7 ;SHIFT NEXT IN JUMPN 2,.-2 ;DEPOSIT IFIT EXISTS MOVEI 2,^D64(1) ;GET YEAR JRST OTOD ;STORE IT DTAB: "-naJ-" ;[567] "-beF-" "-raM-" "-rpA-" "-yaM-" "-nuJ-" "-luJ-" "-guA-" "-peS-" "-tcO-" "-voN-" "-ceD-" ; BINARY UNIVERSALS ;HERE TO WRITE OUT UNIVERSAL SYMBOL FILE ;SYMBOL TABLE PLUS MACROS UNVOUT: HRRZ AC0,FREE ;GET HIGHEST FREE LOCATION MOVEM AC0,.JBFF ;INTO JOBFF INIT UNV,B ;INIT DSK FOR OUTPUT SIXBIT /DSK/ XWD UNVBUF,0 ;OUTPUT ONLY JRST UNVINT ;ERROR MOVSI AC0,'UNV' ;STANDARD EXT MOVEM AC0,UNVDIR+1 SETZM UNVDIR+2 SETZM UNVDIR+3 ;CLEAR PPN ENTER UNV,UNVDIR ;ENTER FILE JRST UNVENT ;ERROR MOVEI SDEL,2*203 ;STANDARD DOUBLE BUFFERING ADD SDEL,FREE ;FROM FREE CORE CAML SDEL,SYMBOL ;MORE CORE NEEDED? CALL XCEED ;YES SUBI SDEL,2*203 ;BACK TO START OF BUFFER MOVEM SDEL,.JBFF ;SETUP FOR BUFFERS OUTBUF UNV,2 ;SET THEM UP MOVSI AC1,777 ;SPECIAL MARKER FIRST WORD HRR AC1,UWVER ;STORE VERSION NUMBER CALL UNVBIN ;LOADER BLOCK 777? MOVE AC1,.JBVER ;GET MACRO VERSION NUMBER CALL UNVBIN ;AND OUTPUT IT AS THE SECOND WORD MOVE AC1,@SYMBOL ;GET NUMBER OF SYMBOLS MOVN SDEL,AC1 HRLZS SDEL HRR SDEL,SYMBOL ;FORM AOBJN POINTER CALL UNVBIN ;OUTPUT NUMBER OF SYMBOLS ADDI SDEL,1 ;BYPASS COUNT UNVLUP: MOVE AC1,(SDEL) ;GET SYMBOL CALL UNVBIN ADDI SDEL,1 MOVE AC1,(SDEL) ;GET VALUE TLNE AC1,SPTR ;SPECIAL EXTERNAL POINTER? JRST UNVSPT ;YES TLNE AC1,EXTF ;EXTERNAL (BUT NOT SPTR)? JRST UNVEXT ;YES, OUTPUT 2 WORDS TLNE AC1,MACF ;MACRO JRST UNVMAC ;YES, SAVE MACRO TEXT ALSO TLNE AC1,PNTF ;ONLY A POINTER TO VALUE? JRST UNVPTF ;YES CALL UNVBIN ;OUTPUT VALUE UNVNXT: AOBJN SDEL,UNVLUP ;FOR ALL SYMBOLS RELEASE UNV, RET UNVINT: PUSH P,['MCRUWU'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] AOS QERRS ;INCREMENT WARNING COUNT MOVE AC0,UNVDIR ;FILNAM IN AC0 MOVSI RC,[SIXBIT / UNABLE TO WRITE UNIVERSAL FILE@/] ;[1066] CALL EWARN ;[1066] NOT FATAL PJRST TYPMSG ;TYPE MESSAGE AND EXIT UNVENT: AOS QERRS ;INCREMENT WARNING COUNT PUSH P,['MCREFU'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] SETZ RC, ;[1066] ZERO RC FOR TEST AFTER CALL CALL EWARN ;[1066] GIVE WARNING CAMN RC,[-1] ;[1066] SUPPRESS REST IF REQUIRED BY PJRST CRLF ;[1066] MESSAGE LEVEL BITS HRRZ RC,UNVDIR+1 ;GET ERROR BITS SKIPN RC SOS RC ;=0 SPECIAL CASE CAIL RC,TABLND-TABLE ;WITHIN BOUND? JRST [ HLRZ CS,TABLND ;CATCH-ALL ERR MESS JRST .+2] HLRZ CS,TABLE(RC) ;REFERENCE TABLE CALL TYPM2 ;GIVE APPROPRIATE MESSAGE MOVE AC0,UNVDIR ;FILENAME MOVSI RC,[SIXBIT /UNIVERSAL FILE@/] PJRST TYPMSG ;FINISH OFF AND EXIT ;HERE FOR EXTERNAL (NOT SPTR) UNVEXT: MOVE AC2,AC1 ;GET POINTER HLLZ AC1,AC1 ;CLEAR POINTER CALL UNVBIN ;OUTPUT FLAGS MOVE AC1,0(AC2) ;GET FIRST WORD (VALUE) CALL UNVBIN MOVE AC1,1(AC2) ;GET SECOND WORD (SYMBOL) CALL UNVBIN JRST UNVNXT ;HERE FOR 36 BIT VALUE UNVPTF: MOVE AC2,AC1 ;GET COPY HLLZ AC1,AC1 ;CLEAR POINTER CALL UNVBIN ;OUTPUT FLAGS MOVE AC1,(AC2) ;GET VALUE CALL UNVBIN ;OUTPUT IT JRST UNVNXT ;HERE FOR SPECIAL EXTERNAL SYMBOL UNVSPT: MOVE AC2,AC1 ;COPY POINTER HLLZ AC1,AC1 ;CLEAR POINTER CALL UNVBIN ;OUTPUT FLAGS MOVE AC1,(AC2) ;GET FIRST WORD CALL UNVBIN ;STORE VALUE MOVE AC1,1(AC2) ;GET RELOCATION WORD MOVE AC2,AC1 ;COPY IT CALL UNVBIN IFN POLISH,< JUMPL AC2,UNVWPL ;IF POLISH JUMP > TRNN AC2,-1 ;RIGHT HALF RELOCATION? JRST .+5 ;NO MOVE AC1,(AC2) ;GET VALUE CALL UNVBIN MOVE AC1,1(AC2) ;EXTERNAL SYMBOL CALL UNVBIN TLNN AC2,-1 ;LEFT HALF RELOCATION? JRST UNVNXT ;NO HLRZS AC2 ;YES, SWAP JRST .-7 ;AND OUTPUT IFN POLISH,< ;HERE IF POLISH UNVWPL: PUSH P,SDEL ;SAVE ORIGINAL SDEL PUSH P,AC2 ;SAVE ORIGINAL AC2 PUSH P,[-1] ;TO INDICATE THE END OF SAVED POINTERS UNVWP1: MOVEM AC2,UNVPOL ;SAVE THE POLISH PTR AT THE BEG OF STACK SETZ AC1, ;OUTPUT ZERO FOR 1ST WORD OF OPERATOR PAIR CALL UNVBIN ;WRITE IT OUT MOVE AC1,1(AC2) ;GET 2ND WORD -- THE OPERATOR CALL UNVBIN ;WRITE IT OUT MOVE SDEL,DESTB-3(AC1) ;GET # OF OPERANDS FOR THAT OPERATOR UNVWP2: ADDI AC2,2 ;NEXT 2 WORDS PAIR MOVE AC1,(AC2) ;GET FIRST WORD CALL UNVBIN ;WRITE IT OUT JUMPN AC1,[ PUSH P,AC1 ;NOT ZERO, MUST BE A POINTER; SAVE IT SETZ AC1, ;ZERO FOR 2ND WORD JRST UNVWP5] MOVE AC1,1(AC2) ;GET 2ND WORD OF THE PAIR UNVWP5: CALL UNVBIN SOJG SDEL,UNVWP2 ;ANY MORE OPERAND? SETZ AC1, CALL UNVBIN MOVE AC1,UNVPOL CALL UNVBIN UNVWP3: POP P, AC2 ;NO, ANY PTRS SAVED ON STACK? CAME AC2,[-1] ;END OF SAVED PTRS? JRST UNVWP4 ;NO, GO CHECK PTR POP P, AC2 ;YES, RESTORE ORIGINAL AC2 COMING INTO UNVWPL POP P,SDEL ;RESTORE ORIGINAL SDEL JRST UNVNXT UNVWP4: JUMPL AC2,UNVWP1 ;IF IT'S POLISH JUMP MOVE AC1,(AC2) ;GET 1ST WORD CALL UNVBIN SKIPE AC1 PUSH P,AC2 MOVE AC1,1(AC2) CALL UNVBIN JRST UNVWP3 ;NUMBER OF OPERANDS FOR EACH OPERATOR DESTB: EXP 2,2,2,2,2,2,2,2,1,2,1,2,1,100 > ;HERE FOR MACRO UNVMAC: MOVE AC2,AC1 ;GET POINTER TO TEXT HLLZ AC1,AC1 ;CLEAR POINTER CALL UNVBIN ;OUTPUT FLAGS HLRZ AC1,1(AC2) ;GET DEFAULT VALUES, IF ANY MOVEM AC1,UNVDFA ;SAVE STARTING ADRESS CALL UNVMCP ;GO DUMP MACRO ITSELF SKIPN AC2,UNVDFA ;SEE IF ANY DEFAULT VALUES (LEFT) JRST UNVNXT ;NO, CONTINUE WITH NEXT SYMBOL HRROI AC1,(AC2) ;SET UP AOBJP POINTER FOR # OF DEFAULTS SKIPE (AC1) ;ARE THERE ANY MORE? AOBJP AC1,.-1 ;YES, COUNT AND TRY NEST CALL UNVBIN ;OUTPUT COUNT WORD UNVMC1: HLRZ AC1,(AC2) ;GET THE AGUMENT # OF THIS DEFAULT CALL UNVBIN ;OUTPUT THE ARGUMENT NUMBER MOVE AC2,(AC2) ;GET ADDRESS OF DEFAULT CALL UNVMCP ;GO OUTPUT, IT LOOKS LIKE MACRO AOS AC2,UNVDFA ;UP POINTER TO DEFAULT BLOCK SKIPE (AC2) ;SEE IF ANY MORE JRST UNVMC1 ;YES, GO WRITE THEM OUT JRST UNVNXT ;NO, GO DO NEXT SYMBOL UNVMCP: HLL AC2,(AC2) ;PUT ADDRESS OF NEXT BLOCK IN LEFT QQ==0 REPEAT .LEAF,< MOVE AC1,QQ(AC2) CALL UNVBIN QQ==QQ+1> HLRZS AC2 JUMPN AC2,UNVMCP ;MORE LEAFS TO PROCESS RET ;RETURN UNVBIN: SOSG UNVBUF+2 CALL DMPUNV IDPB AC1,UNVBUF+1 RET DMPUNV: OUT UNV,0 RET GETSTS UNV,C ;GET STATUS BITS TRNN C,ERRBIT ;ERRORS? RET ;NO, EXIT MOVSI AC0,'DSK' ;DEVICE ALWAYS DSK JRST ERRLST ;GIVE ERROR MESSAGE ;HERE TO READ IN UNIVERSAL SYMBOL TABLE UNVINP: MOVEM AC0,UNVDIR ;FILE WE NEED PUSH P,AC0 ;SAVE REAL NAME OF UNV MOVSI AC1,'DSK' ;DEFAULT DEVICE MOVEM AC1,UNVDEV MOVSI AC1,'UNV' ;REQUIRED EXT MOVEM AC1,UNVDIR+1 SETZM UNVDIR+2 SETZM UNVDIR+3 CAIE C,'(' ;SEE IF USER SUPPLIED FILE SPEC JRST UNVOPN ;NO, USE DEFAULT CALL SCHGET ;GET A NAME CAIE C,':' ;IS IT A DEVICE? JRST UNVCKN ;NO TRY NAME MOVEM AC0,UNVDEV ;YES, SAVE DEVICE CALL SCHGET ;TRY NEXT NAME UNVCKN: MOVEM AC0,UNVDIR ;SAVE NAME CAIE C,'.' ;DOES EXT FOLLOW? JRST .+3 ;NO CALL SCHGET ;YES, GET IT MOVEM AC0,UNVDIR+1 ;AND STORE IT CAIE C,'[' ;A DIRECTORY SPECIFIED? JRST SCHCLP ;NO CALL SCHOCT ;GET PPN HRLZM AC0,UNVDIR+3 ;AND SAVE IT CAIE C,',' ;CHECK PROG NO. TROA ER,ERRQ ;WARN USER CALL SCHOCT ;GET IT HRRM AC0,UNVDIR+3 CAIE C,',' ;AN SFD GIVEN? JRST SCHCLB ;NO MOVEI AC0,UNVPTH ;GET PATH PTR EXCH AC0,UNVDIR+3 ;SWAP WITH PPN MOVEM AC0,UNVPTH+2 ;AND PUT IN PATH MOVSI RC,-.SFDLN ;AOBJN PTR FOR SFDS SCHSFD: CALL SCHGET ;GET SFD NAME AOBJP RC,SCHCLB+1 ;SEE IF ENOUGH ROOM MOVEM AC0,UNVPTH+2(RC) ;YES, STORE CAIN C,',' ;DOES PATH CONTINUE ON? JRST SCHSFD ;YES SCHCLB: CAIE C,']' ;DOES PATH FINISH PROPERLY? TROA ER,ERRQ ;NO CALL BYPASS ;[664] EAT UP THE "]" SCHCLP: CAIE C,')' ;FILE SPEC END PROPERLY? TROA ER,ERRQ ;NO CALL BYPASS ;[664] EAT IT UNVOPN: POP P,AC0 ;UNV NAME BACK IN 0 OPEN UNV,UNVINI ;TRY USER SPECIFICATION JRST UNVUNV ;FAILED LOOKUP UNV,UNVDIR ;SEE IF THERE JRST UNVUNV ;TRY UNV: MOVEM AC0,UNVDIR ;RESTORE NAME OF UNV UNVFND: MOVE RC,UNIVNO ;[1002] GET NUM OF CURRENT UNIV TABLES IN CORE CAILE RC,.UNIV-1 ;[1002] SEE IF ROOM IN TABLES JRST UNVERR ;NO, GIVE ERROR SKIPN UNIVSN ;IS CURRENT PROG A UNIVERSAL JRST UNVNOT ;NO CAIL RC,.UNIV-1 ;[1002] YES, ROOM FOR IT AS WELL? JRST UNVERR ;NO MOVE AC1,UNITBL+1(RC) ;[1002] GET CURRENT NAME MOVEM AC1,UNITBL+2(RC) ;[1002] STORE IT IN NEXT SLOT UNVNOT: PUSH P,AC0 ;[1002] SAVE NAME HLRE SDEL,UNVDIR+3 ;GET SIZE OF FILE MOVMS SDEL ;IN WORDS ADD SDEL,FREE ;AT TOP OF FREE CORE HRRZM SDEL,UNIPTR+1(RC) ;[1002] SAVE NEW SYMTOP (IN WRONG HALF) ADDI SDEL,2*203 ;PLUS 2 BUFFERS CAML SDEL,SYMBOL ;WILL IT FIT? CALL XCEED ;NO, TRY FOR MORE CAML SDEL,SYMBOL ;DID WE GET ENOUGH? JRST .-2 ;NO TRY AGAIN SUBI SDEL,2*203 ;START OF BUFFERS MOVEM SDEL,.JBFF INBUF UNV,2 ;STANDARD DOUBLE BUFFERING CALL UNVREAD ;READ TLC AC1,777 ;[1002] LEFT HALF OF FIRST WORD OF UNV FILE TLCE AC1,777 ;[1002] MUST BE A 777 MARKER JRST UNVFAKE ;[1002] ERROR FOR FAKE UNV TLNE AC1,777000 ;[1002] JRST UNVFAKE ;[1002] ERROR AOS RC,UNIVNO ;[1002] BUMP COUNT OF UNIVERSALS POP P,UNITBL(RC) ;[1002] ADD NAME TO TABLE HRRZS AC1 ;GET UNV VERSION # SETOM UNVER% ;KLUDGE SWITCH TO ALLOW VERSION 4 CAIE AC1,4 ;SEE IF 4 (MIGHT BOMB DEFAULT ARGUMENTS) AOS UNVER% ;NO, UNVER% IS 0 FOR GOOD FILES TRNE AC1,.URVER ;MAKE SURE EXTRA BITS ARE NOT ON JRST VERSKW ;YOU LOSE TRNE AC1,UMACV ;MACRO VERSION EXPECTED? CALL UNVREAD ;YES, SKIP OVER IT CALL UNVREAD ;READ SYMBOL COUNT (SECOND WORD) MOVE SDEL,AC1 ;GET COPY LSH SDEL,1 ;TWO WORDS PER SYMBOL ADDI SDEL,1 ;PLUS ONE FOR COUNT MOVNS SDEL ;NEGATE MOVE AC2,SDEL ;STORE IT ADD AC2,UNIPTR(RC) ;ADD SYMTOP HRLM AC2,UNIPTR(RC) ;TO FORM SYMBOL MOVSS UNIPTR(RC) ;NOW PUT IN CORRECT HALVES MOVN SDEL,AC1 ;GET NO. OF SYMBOLS HRLZ SDEL,SDEL ;TO FORM AOBJN POINTER HRR SDEL,AC2 ;POINT TO WHERE TO STORE THEM MOVEM AC1,(SDEL) ;STORE COUNT ADDI SDEL,1 ;AND GET PAST IT UNVRLO: CALL UNVREAD ;GET A SYMBOL MOVEM AC1,(SDEL) ;STORE IT ADDI SDEL,1 ;INCREMENT PAST IT CALL UNVREAD ;GET VALUE MOVEM AC1,(SDEL) ;STORE IT TLNE AC1,SPTR ;SPECIAL EXTERNAL POINTER? JRST UNVRSP ;YES TLNE AC1,EXTF ;EXTERNAL (NOT SPTR)? JRST UNVREX ;YES TLNE AC1,MACF ;MACRO? JRST UNVRMC ;YES TLNE AC1,PNTF ;36 BIT VALUE JRST UNVRPT ;YES UNVRNX: AOBJN SDEL,UNVRLO ;GET NEXT RELEASE UNV, MOVE RC,UNIVNO ;POINT TO LAST ENTRY MOVE AC1,UNITBL+1(RC) ;GET NAME IN CASE IN UNIV NOW SKIPE UNIVSN ;ARE WE? MOVEM AC1,UNVDIR ;YES, RESET NAME OF OUTPUT FILE IFN FTPSECT,< ;[575] PUSH P,SGSBOT PUSH P,SGSTOP PUSH P,SGSCNT PUSH P,SGNCUR > PUSH P,SYMBOL PUSH P,SYMTOP ;SAVE EXISTING VALUES PUSH P,SRCHX MOVE AC1,UNIPTR(RC) ;GET SYMTOP,,SYMBOL HLRZM AC1,SYMTOP HLRZM AC1,FREE ;DON'T FORGET TO SET FREE BEYOND SYMTOP HRRZM AC1,SYMBOL HLRZ AC1,AC1 ;TOP LOCATION MOVEM AC1,UNITOP ;SAVE NEW TOP FOR UNIVERSALS CAMLE AC1,MACSIZ ;HAVE WE INCREASED? MOVEM AC1,MACSIZ ;YES, STOP ILL MEM REFS IFN FTPSECT,< ;[575] SETZM SGNCUR MOVE AC0,@SYMBOL MOVEM AC0,SGSCNT > CALL SRCHI ;SETUP SEARCH POINTER MOVE AC1,SRCHX ;LOAD IT MOVEM AC1,UNISHX(RC) ;SAVE IT POP P,SRCHX ;RESTORE POP P,SYMTOP POP P,SYMBOL IFN FTPSECT,< ;[575] POP P,SGNCUR POP P,SGSCNT POP P,SGSTOP POP P,SGSBOT > JRST SERCH1 ;AND RETURN ;HERE FOR 36 BIT VALUE UNVRPT: CALL UNVREAD AOS AC2,FREE ;GET A FREE LOC SUBI AC2,1 MOVEM AC1,(AC2) ;STORE IT HRRM AC2,(SDEL) ;FIXUP SYMBOL POINTER JRST UNVRNX ;GET NEXT ;HERE FOR EXTERNAL (NOT SPTR) UNVREX: MOVEI AC2,2 ;NEED 2 LOCS ADDB AC2,FREE SUBI AC2,2 ;POINT TO START OF 2 WORDS CALL UNVREAD ;GET VALUE MOVEM AC1,0(AC2) ;MOST LIKELY 0 CALL UNVREAD ;GET NAME MOVEM AC1,1(AC2) HRRM AC2,(SDEL) ;POINT TO VALUE JRST UNVRNX ;GET NEXT ;HERE FOR SPECIAL EXTERNAL SYMBOL UNVRSP: CALL UNVR2W ;GET 2 LOCATIONS CALL UNVREAD ;GET VALUE MOVEM AC1,(AC2) CALL UNVREAD ;GET RELOCATION HRRM AC2,(SDEL) ;STORE POINTER MOVEI RC,1(AC2) ;POINT TO RELOCATION WORD SETZM (RC) ;CLEAR RELOCATION IFN POLISH,< JUMPL AC1,UNVRPL ;JUMP IF IT'S POLISH > MOVE AC2,AC1 ;STORE PREVIOUS RELOCATION TRNN AC2,-1 ;RIGHT HALF RELOCATION? JRST UNVRS2 ;NO HRR AC2,FREE ;POINT TO NEXT 2 WORD BLOCK HRRM AC2,(RC) ;POINT TO BLOCK (RELOCATION) UNVRS1: CALL UNVREAD ;GET VALUE MOVEM AC1,(AC2) CALL UNVREAD ;GET EXTERNAL SYMBOL MOVEM AC1,1(AC2) HRRI AC2,2(AC2) ;INCREMENT RIGHT HALF BY 2 WORDS USED HRRZM AC2,FREE ;INCREMENT FREE UNVRS2: TLZN AC2,-1 ;LEFT HALF RELOCATION? JRST UNVRNX ;NO, GET NEXT SYMBOL HRLM AC2,(RC) ;FIX LEFT RELOCATION JRST UNVRS1 ;AND FILL IN VALUE UNVR2W: MOVEI AC2,2 ;GET 2 LOCATIONS ADDB AC2,FREE ;FROM FREE CORE SUBI AC2,2 ;POINT TO START OF 2 WORDS RET IFN POLISH,< ;HERE FOR POLISH UNVRPL: PUSH P,[-1] ;END OF LOCATIONS TO BE ADJUSTED MOVEM AC1,UNVPOL ;STORE PTR, USED TO FIND END OF POL STK CALL UNVR2W ;GET 2 LOCATIONS UNVRP0: SETOM (RC) ;-1 IN LEFT HALF HRRM AC2,(RC) ;TO SET UP A NEW POLISH POINTER MOVE AC1,(RC) MOVEM AC1,UNVNPL ;SAVE THE NEW POLISH POINTER UNVRP1: CALL UNVREAD ;READ 1ST WORD OF THE PAIR MOVEM AC1,(AC2) JUMPE AC1,UNVRP2 SKIPG AC1 ;SKIP IF NOT POLISH PUSH P,AC1 ;STORE POLISH PTR WITH ORIGINAL ADDR MOVEI RC,(AC2) HLL RC,AC1 PUSH P,RC ;STORE LOCATIONS TO BE ADJUSTED ON STACK UNVRP2: CALL UNVREAD ;READ 2ND WORD OF THE PAIR CAME AC1,UNVPOL ;END OF POLISH STACK? JRST [ MOVEM AC1,1(AC2) CALL UNVR2W JRST UNVRP1] ;GET 2 LOCATIONS AND LOOP BACK MOVE AC1,UNVNPL ;ADJUSTED NEW POL STR IN 2ND WORD MOVEM AC1,1(AC2) ;HERE AT END OF POLISH STACK READ UNVRP3: POP P,AC1 ;GET LOCATION TO BE ADJUSTED CAMN AC1,[-1] ;NO MORE? JRST UNVRNX CALL UNVR2W ;GET 2 LOCATIONS HRRM AC2,(AC1) ;SO ADJUST IT JUMPL AC1,[POP P, AC1 ;GET POL PTR WITH ORIGINAL ADDR MOVEM AC1,UNVPOL ;SAVE IT SETZM (AC2) ;ZERO THE FIRST WORD MOVEI RC,1(AC2) JRST UNVRP0] MOVEI RC,(AC2) CALL UNVREAD ;READ 1ST WORD MOVEM AC1,(AC2) JUMPE AC1,UNVRP4 HLL RC,AC1 PUSH P,RC UNVRP4: CALL UNVREAD MOVEM AC1,1(AC2) JRST UNVRP3 > ;HERE FOR MACRO UNVRMC: MOVE AC2,FREE ;FREE LOC COUNTER HRRM AC2,(SDEL) ;IS WHERE MACRO STARTS MOVEM AC2,UNVDFA ;SAVE STARTING ADDRESS OF MACRO CALL UNVRML ;GO READ IN MACRO DEFINITION MOVE AC1,UNVDFA ;GET STARTING ADDRESS BACK HLRZ AC2,1(AC1) ;GET POINTER FOR ANY DEFAULTS JUMPE AC2,UNVRNX ;NONE, GO DO NEXT SYMBOL SKIPE UNVER% ;MAKE SURE WE WROTE THEM ON DISK JRST UNVRER ;NO, TELL USER PUSH P,SDEL ;SAVE AOBJN POINTER MOVE AC2,FREE ;GET NEXT FREE ADDRESS HRLM AC2,1(AC1) ;POINT TO IT IN MACRO BODY CALL UNVREAD ;GO READ COUNT OF DEFAULTS MOVN SDEL,AC1 ;COPY COUNT TO AOBJN POINTER HRRI SDEL,(AC2) ;SET AOBJN ADDRESS INTO SDEL HLRZ AC2,AC1 ;GET COUNT-1 OF DEFAULTS ADDI AC2,2 ;CHANGE TO COUNT+1 (+0 WORD) ADDB AC2,FREE ;BUMP FREE BY DEFAULT POINTER BLOCK LENGTH UNVRM1: CALL UNVREAD ;GO READ ARGUMENT NUMBER HRLM AC1,(SDEL) ;SAVE IN POINTER BLOCK HRRM AC2,(SDEL) ;SAVE START OF VALUE (MAY BE SET UP BY UNVRML) CALL UNVRML ;GO COPY DEFAULT VALUE AOBJN SDEL,UNVRM1 ;DO ALL DEFAULTS SETZM (SDEL) ;CLEAR END OF BLOCK WORD POP P,SDEL ;RESTORE BIG AOBJN WORD JRST UNVRNX ;GO DO NEXT SYMBOL UNVRML: QQ==0 REPEAT .LEAF,< CALL UNVREAD MOVEM AC1,QQ(AC2) ;STORE QQ==QQ+1> MOVE AC1,(AC2) ;SEE WHAT FIRST WORD WAS TLNN AC1,-1 ;IF ZERO THEN FINISHED JRST UNVRMF ;SET LAST BLOCK POINTER MOVEI AC1,.LEAF(AC2) ;POINT TO NEXT BLOCK HRLM AC1,(AC2) ;FILL IT IN ADDI AC2,.LEAF ;POINT TO IT JRST UNVRML ;AND LOOP UNVRMF: MOVE AC1,(SDEL) ;GET FIRST BLOCK HRRM AC2,(AC1) ;POINT TO LAST ADDI AC2,.LEAF ;POINT TO NEXT FREE MOVEM AC2,FREE RET ;RETURN UNVRER: PUSH P,['MCROUF'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / UNIVERSAL FILE DEFAULT ARGUMENTS LOST, REASSEMBLE@/] ;[1066] JRST ERRFIN ;PRINT THAT HAD DEFAULTS WHICH WERE LOST UNVFAKE: PUSH P,['MCRNUF'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / NOT A REAL UNIVERSAL FILE@/] ;[1066] JRST ERRFIN ;NAME IN AC0 UNVREA: SOSG UNVBUF+2 CALL UNVRIN ILDB AC1,UNVBUF+1 RET UNVRIN: IN UNV, RET GETSTS UNV,C ;GET STATUS BITS TRNN C,ERRBIT!2000 ;ERRORS? JRST [PUSH P,['MCRERU'] ;[1066] SET UP PREFIX POP P,PREFIX ;[1066] MOVSI RC,[SIXBIT / UNEXPECTED END-OF-FILE READING UNIVERSAL FILE@/] ;[1066] JRST ERRFIN] ;GIVE ERROR MESSAGE,NAME IN AC0 MOVE AC0,UNVDEV ;GET DEVICE JRST READ4 ;GIVE I/O ERROR MESSAGE UNVUNV: MOVEM AC0,UNVDIR ;RESTORE REAL NAME MOVSI AC1,'UNV' ;AND DEFAULT EXT MOVEM AC1,UNVDIR+1 SETZM UNVDIR+2 SETZM UNVDIR+3 ;DEFAULT PATH INIT UNV,B SIXBIT /UNV/ UNVBUF JRST UNVSYS LOOKUP UNV,UNVDIR JRST UNVSYS JRST UNVFND UNVSYS: INIT UNV,B SIXBIT /SYS/ UNVBUF JRST SCHERR LOOKUP UNV,UNVDIR ;SEE IF THERE JRST SCHERR ;NO JRST UNVFND ;GOT IT SUBTTL MACHINE INSTRUCTION SEARCH ROUTINES IFE OPHSH,< OPTSCH: MOVEI RC,0 MOVEI ARG,1B^L ;SET UP INDEX MOVEI V,1B^L/2 ;SET UP INCREMENT OPT1A: CAMN AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL? JRST OPT1D ;YES, GET THE CODE JUMPE V,CPOPJ ;[664] TEST FOR END CAML AC0,OP1TOP(ARG) ;NO, SHOULD WE MOVE DOWN? TDOA ARG,V ;NO, INCREMENT OPT1B: SUB ARG,V ;YES, DECREMENT ASH V,-1 ;HALVE INCREMENT CAIG ARG,OP1END-OP1TOP ;ARE WE OUT OF BOUNDS? JRST OPT1A ;NO, TRY AGAIN JRST OPT1B ;YES, BRING IT DOWN A PEG > IFN OPHSH,< OPTSCH: MOVE ARG,AC0 ;GET SIXBIT NAME TLZ ARG,400000 ;CLEAR SIGN BIT IDIVI ARG,PRIME ;REM. GOES IN V CAMN AC0,OP1TOP(V) ;ARE WE POINTING AT SYMBOL? JRST OPT1D ;YES SKIPN OP1TOP(V) ;TEST FOR END JRST OPT1B ;SYMBOL NOT FOUND HLRZ RC,ARG ;SAVE LHS OF QUOTIENT SKIPA ARG,RC ;GET IT BACK OPT1A: ADDI ARG,(RC) ;INCREMENT ARG ADDI V,(ARG) ;QUADRATIC INCREASE TO V CAIL V,PRIME ;V IS MODULO PRIME JRST [SUBI V,PRIME JRST .-1] CAMN AC0,OP1TOP(V) ;IS THIS IT? JRST OPT1D ;YES SKIPE OP1TOP(V) ;END? JRST OPT1A ;TRY AGAIN OPT1B: SETZ RC, ;CLEAR RELOCATION IN CASE IMPLICIT OPDEF RET ;FAILED > OPT1D: IFN OPHSH,< SETZ RC, ;CLEAR RELOCATION MOVE ARG,V> ;GET INDEX IN RIGHT ACC. IDIVI ARG,4 ;ARG HAS INDEX USED IN OPTTAB LDB V,OPTTAB(V) ;V HAS INDEX TO OPTTAB CAIL V,700 ;PSEUDO-OP OR IO INSTRUCTION? JRST OPT1G ;YES ROT V,-^D9 ;LEFT JUSTIFY HRRI V,OP ;POINT TO BASIC FORMAT OPT1F: AOS 0(P) ;SET FOR SKIP EXIT MOVEI SDEL,%OP ;SET OP-CODE CROSS-REF FLAG JRST CREF ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE OPT1G: JUMPG AC0,[CAME AC0,['.XCREF'] ; DON'T CREF .XCREF JRST .+3 ;IF ".","$",OR "%" USE TABLE 1 MOVE V,OP1TAB-700(V) ; USE TABLE 1 JRST CPOPJ1] ;AND BYPASS CREF TLNN AC0,200000 ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE SKIPA V,OP2TAB-700(V) ;2ND TABLE, FIRST LETTER IS "A" TO "O" MOVE V,OP1TAB-700(V) ;1ST TABLE, ..."P" TO "Z" JRST OPT1F ;EXIT OPTTAB: IFE OPHSH,< POINT 9,OP1COD-1(ARG),35> POINT 9,OP1COD (ARG), 8 POINT 9,OP1COD (ARG),17 POINT 9,OP1COD (ARG),26 IFN OPHSH,< POINT 9,OP1COD (ARG),35> .XCREF ;DON'T CREF THIS MESS IFE OPHSH,< RELOC .-1 OP1TOP: RELOC IF1,> ; IF2, < N2=^D36 CC=0 RELOC OP1COD RELOC DEFINE X (SYMBOL,CODE) IFE N2, > DEFINE OUTLIT < RELOC +CC RELOC N2=^D36+>> > IFN OPHSH,< OP1TOP: IF1,< BLOCK PRIME> IF1,> IF2,< DEFINE OPSTOR (RM)<.$'RM=.$'RM+>>> DEFINE X (SB,CD)< SXB= Q=SXB&-1_-1/PRIME R=SXB&-1_-1-Q*PRIME H=Q_-22&777 TRY=1 OPCODE=CD ITEM Q,\R IFL PRIME-TRY,> DEFINE ITEM (QT,RM)< IFN .%'RM, H=H+Q_-22&777 IFGE PRIME-,> IFE .%'RM,<.%'RM=SXB OPSTOR \>>> IF1,< DEFINE GETSYM (N)<.%'N=0> N=0 XLIST REPEAT PRIME, DEFINE GETSYM (N)<.$'N=0> N=0 REPEAT , > LIST> ;MACRO TO HANDLE KI10 OP-CODES IFE KI10,< DEFINE XK (SB,CD) <>> ;NUL MACRO IFN KI10, ;USUAL X MACRO ;MACRO TO HANDLE KL10 OP-CODES IFE KL10,< DEFINE XL (SB,CD) <>> ;NUL MACRO IFN KL10, ;USUAL X MACRO ;MACRO TO HANDLE F40 UUOS IFE F40,< DEFINE XF (SB,CD) <>> ;NUL MACRO IFN F40, ;USUAL X MACRO X ADD , 270 X ADDB , 273 X ADDI , 271 X ADDM , 272 XL ADJBP , 133 XL ADJSP , 105 X AND , 404 X ANDB , 407 X ANDCA , 410 X ANDCAB, 413 X ANDCAI, 411 X ANDCAM, 412 X ANDCB , 440 X ANDCBB, 443 X ANDCBI, 441 X ANDCBM, 442 X ANDCM , 420 X ANDCMB, 423 X ANDCMI, 421 X ANDCMM, 422 X ANDI , 405 X ANDM , 406 X AOBJN , 253 X AOBJP , 252 X AOJ , 340 X AOJA , 344 X AOJE , 342 X AOJG , 347 X AOJGE , 345 X AOJL , 341 X AOJLE , 343 X AOJN , 346 X AOS , 350 X AOSA , 354 X AOSE , 352 X AOSG , 357 X AOSGE , 355 X AOSL , 351 X AOSLE , 353 X AOSN , 356 X ARG , 320 X ARRAY , 771 IFN IIISW, X ASCII , 700 X ASCIZ , 701 X ASH , 240 X ASHC , 244 X ASUPPR, 705 X BLKI , 702 X BLKO , 703 X BLOCK , 704 X BLT , 251 X BYTE , 707 X CAI , 300 X CAIA , 304 X CAIE , 302 X CAIG , 307 X CAIGE , 305 X CAIL , 301 X CAILE , 303 X CAIN , 306 X CALL , 040 X CALLI , 047 X CAM , 310 X CAMA , 314 X CAME , 312 X CAMG , 317 X CAMGE , 315 X CAML , 311 X CAMLE , 313 X CAMN , 316 X CLEAR , 400 X CLEARB, 403 X CLEARI, 401 X CLEARM, 402 X CLOSE , 070 XL CMPSE , 002 XL CMPSG , 007 XL CMPSGE, 005 XL CMPSL , 001 XL CMPSLE, 003 XL CMPSN , 006 X COMMEN, 770 X CONI , 710 X CONO , 711 IFN STANSW, X CONSO , 712 X CONSZ , 713 XL CVTBDO, 012 XL CVTBDT, 013 XL CVTDBO, 010 XL CVTDBT, 011 XL DADD , 114 XF DATA. , 020 X DATAI , 714 X DATAO , 715 XL DDIV , 117 X DEC , 716 X DEFINE, 717 X DEPHAS, 720 XK DFAD , 110 XK DFDV , 113 XK DFMP , 112 X DFN , 131 XK DFSB , 111 X DIV , 234 X DIVB , 237 X DIVI , 235 X DIVM , 236 XK DMOVE , 120 XK DMOVEM, 124 XK DMOVN , 121 XK DMOVNM, 125 XL DMUL , 116 X DPB , 137 XL DSUB , 115 XL EDIT , 004 X END , 721 X ENTER , 077 X ENTRY , 722 X EQV , 444 X EQVB , 447 X EQVI , 445 X EQVM , 446 X EXCH , 250 X EXP , 723 XL EXTEND, 123 X EXTERN, 724 X FAD , 140 X FADB , 143 X FADL , 141 X FADM , 142 X FADR , 144 X FADRB , 147 X FADRI , 145 X FADRM , 146 X FDV , 170 X FDVB , 173 X FDVL , 171 X FDVM , 172 X FDVR , 174 X FDVRB , 177 X FDVRI , 175 X FDVRM , 176 XF FIN. , 021 IFN STANSW, IFE STANSW, XK FIXR , 126 XK FLTR , 127 X FMP , 160 X FMPB , 163 X FMPL , 161 X FMPM , 162 X FMPR , 164 X FMPRB , 167 X FMPRI , 165 X FMPRM , 166 X FSB , 150 X FSBB , 153 X FSBL , 151 X FSBM , 152 X FSBR , 154 X FSBRB , 157 X FSBRI , 155 X FSBRM , 156 X FSC , 132 X GETSTS, 062 X HALT , 725 X HISEG , 706 X HLL , 500 X HLLE , 530 X HLLEI , 531 X HLLEM , 532 X HLLES , 533 X HLLI , 501 X HLLM , 502 X HLLO , 520 X HLLOI , 521 X HLLOM , 522 X HLLOS , 523 X HLLS , 503 X HLLZ , 510 X HLLZI , 511 X HLLZM , 512 X HLLZS , 513 X HLR , 544 X HLRE , 574 X HLREI , 575 X HLREM , 576 X HLRES , 577 X HLRI , 545 X HLRM , 546 X HLRO , 564 X HLROI , 565 X HLROM , 566 X HLROS , 567 X HLRS , 547 X HLRZ , 554 X HLRZI , 555 X HLRZM , 556 X HLRZS , 557 X HRL , 504 X HRLE , 534 X HRLEI , 535 X HRLEM , 536 X HRLES , 537 X HRLI , 505 X HRLM , 506 X HRLO , 524 X HRLOI , 525 X HRLOM , 526 X HRLOS , 527 X HRLS , 507 X HRLZ , 514 X HRLZI , 515 X HRLZM , 516 X HRLZS , 517 X HRR , 540 X HRRE , 570 X HRREI , 571 X HRREM , 572 X HRRES , 573 X HRRI , 541 X HRRM , 542 X HRRO , 560 X HRROI , 561 X HRROM , 562 X HRROS , 563 X HRRS , 543 X HRRZ , 550 X HRRZI , 551 X HRRZM , 552 X HRRZS , 553 X IBP , 133 X IDIV , 230 X IDIVB , 233 X IDIVI , 231 X IDIVM , 232 X IDPB , 136 X IF1 , 726 X IF2 , 727 X IFB , 730 X IFDEF , 731 X IFDIF , 732 X IFE , 733 X IFG , 734 X IFGE , 735 X IFIDN , 736 X IFL , 737 X IFLE , 740 X IFN , 741 X IFNB , 742 X IFNDEF, 743 X ILDB , 134 X IMUL , 220 X IMULB , 223 X IMULI , 221 X IMULM , 222 X IN , 056 XF IN. , 016 X INBUF , 064 XF INF. , 026 X INIT , 041 X INPUT , 066 X INTEGE, 772 X INTERN, 744 X IOR , 434 X IORB , 437 X IORI , 435 X IORM , 436 X IOWD , 745 X IRP , 746 X IRPC , 747 X JCRY , 750 X JCRY0 , 751 X JCRY1 , 752 X JEN , 753 X JFCL , 255 X JFFO , 243 X JFOV , 765 X JOV , 754 X JRA , 267 X JRST , 254 X JRSTF , 755 X JSA , 266 X JSP , 265 X JSR , 264 X JSYS , 104 X JUMP , 320 X JUMPA , 324 X JUMPE , 322 X JUMPG , 327 X JUMPGE, 325 X JUMPL , 321 X JUMPLE, 323 X JUMPN , 326 X LALL , 756 X LDB , 135 X LIST , 757 X LIT , 760 X LOC , 761 X LOOKUP, 076 X LSH , 242 X LSHC , 246 XK MAP , 257 X MLOFF , 767 X MLON , 766 X MOVE , 200 X MOVEI , 201 X MOVEM , 202 X MOVES , 203 X MOVM , 214 X MOVMI , 215 X MOVMM , 216 X MOVMS , 217 X MOVN , 210 X MOVNI , 211 X MOVNM , 212 X MOVNS , 213 X MOVS , 204 X MOVSI , 205 XL MOVSLJ, 016 X MOVSM , 206 XL MOVSO , 014 XL MOVSRJ, 017 X MOVSS , 207 XL MOVST , 015 X MTAPE , 072 XF MTOP. , 024 X MUL , 224 X MULB , 227 X MULI , 225 X MULM , 226 XF NLI. , 031 XF NLO. , 032 X NOSYM , 762 X OCT , 763 X OPDEF , 764 X OPEN , 050 X OR , 434 X ORB , 437 X ORCA , 454 X ORCAB , 457 X ORCAI , 455 X ORCAM , 456 X ORCB , 470 X ORCBB , 473 X ORCBI , 471 X ORCBM , 472 X ORCM , 464 X ORCMB , 467 X ORCMI , 465 X ORCMM , 466 X ORI , 435 X ORM , 436 X OUT , 057 XF OUT. , 017 X OUTBUF, 065 XF OUTF. , 027 X OUTPUT, 067 X PAGE , 700 X PASS2 , 701 X PHASE , 702 X POINT , 703 X POP , 262 X POPJ , 263 X PORTAL, 760 X PRGEND, 714 X PRINTX, 704 X PURGE , 705 X PUSH , 261 X PUSHJ , 260 X RADIX , 706 X RADIX5, 707 XL RDCLK , 052 X RELEAS, 071 X RELOC , 710 X REMARK, 711 X RENAME, 055 X REPEAT, 712 XF RESET., 015 X RIM , 715 X RIM10 , 735 X RIM10B, 736 X ROT , 241 X ROTC , 245 X RSW , 716 XF RTB. , 022 X SALL , 720 X SEARCH, 721 X SETA , 424 X SETAB , 427 X SETAI , 425 X SETAM , 426 X SETCA , 450 X SETCAB, 453 X SETCAI, 451 X SETCAM, 452 X SETCM , 460 X SETCMB, 463 X SETCMI, 461 X SETCMM, 462 X SETM , 414 X SETMB , 417 X SETMI , 415 X SETMM , 416 X SETO , 474 X SETOB , 477 X SETOI , 475 X SETOM , 476 X SETSTS, 060 X SETZ , 400 X SETZB , 403 X SETZI , 401 X SETZM , 402 X SIXBIT, 717 X SKIP , 330 X SKIPA , 334 X SKIPE , 332 X SKIPG , 337 X SKIPGE, 335 X SKIPL , 331 X SKIPLE, 333 X SKIPN , 336 XF SLIST., 025 X SOJ , 360 X SOJA , 364 X SOJE , 362 X SOJG , 367 X SOJGE , 365 X SOJL , 361 X SOJLE , 363 X SOJN , 366 X SOS , 370 X SOSA , 374 X SOSE , 372 X SOSG , 377 X SOSGE , 375 X SOSL , 371 X SOSLE , 373 X SOSN , 376 IFN STANSW, X SQUOZE, 707 X STATO , 061 X STATUS, 062 X STATZ , 063 X STOPI , 722 X SUB , 274 X SUBB , 277 X SUBI , 275 X SUBM , 276 IF2,> X SUBTTL, 723 X SUPPRE, 713 X SYN , 724 X TAPE , 725 X TDC , 650 X TDCA , 654 X TDCE , 652 X TDCN , 656 X TDN , 610 X TDNA , 614 X TDNE , 612 X TDNN , 616 X TDO , 670 X TDOA , 674 X TDOE , 672 X TDON , 676 X TDZ , 630 X TDZA , 634 X TDZE , 632 X TDZN , 636 X TITLE , 726 X TLC , 641 X TLCA , 645 X TLCE , 643 X TLCN , 647 X TLN , 601 X TLNA , 605 X TLNE , 603 X TLNN , 607 X TLO , 661 X TLOA , 665 X TLOE , 663 X TLON , 667 X TLZ , 621 X TLZA , 625 X TLZE , 623 X TLZN , 627 X TRC , 640 X TRCA , 644 X TRCE , 642 X TRCN , 646 X TRN , 600 X TRNA , 604 X TRNE , 602 X TRNN , 606 X TRO , 660 X TROA , 664 X TROE , 662 X TRON , 666 X TRZ , 620 X TRZA , 624 X TRZE , 622 X TRZN , 626 X TSC , 651 X TSCA , 655 X TSCE , 653 X TSCN , 657 X TSN , 611 X TSNA , 615 X TSNE , 613 X TSNN , 617 X TSO , 671 X TSOA , 675 X TSOE , 673 X TSON , 677 X TSZ , 631 X TSZA , 635 X TSZE , 633 X TSZN , 637 X TTCALL, 051 X TWOSEG, 731 X UFA , 130 X UGETF , 073 X UJEN , 100 X UNIVER, 737 X USETI , 074 X USETO , 075 X VAR , 727 XF WTB. , 023 X XALL , 732 XL XBLT , 020 X XCT , 256 XL XJEN , 761 XL XJRSTF, 762 X XLIST , 733 X XOR , 430 X XORB , 433 X XORI , 431 X XORM , 432 XL XPCW , 763 X XPUNGE, 730 XL XSFM , 764 X XWD , 734 X Z , 000 X .ASSIG, 751 X .COMMO, 747 X .CREF , 740 X .DIREC, 750 IFN FTPSECT,< ;[575] X .ENDPS, 766 > X .HWFRM, 742 X .IF , 756 X .IFN , 757 X .LINK , 753 X .LNKEN, 754 X .MFRMT, 743 X .NODDT, 746 X .ORG , 752 IFN FTPSECT,< ;[575] X .PSECT, 765 > X .REQUE, 744 X .REQUI, 745 X .TEXT , 755 X .XCREF, 741 IFE OPHSH,< IF1, < BLOCK N1> OP1END: -1B36 OP1COD: BLOCK N1/4 CC IF2,< PURGE N1,N2> > IFN OPHSH,< IF2,< DEFINE SETVAL (N) N=0 XLIST REPEAT PRIME, LIST > OP1COD: IF1,< BLOCK > IF2,< DEFINE SETVAL (N) N=0 XLIST REPEAT , > LIST> .CREF ;START CREFFING AGAIN SUBTTL PERMANENT SYMBOLS SYMNUM: EXP LENGTH/2 ;NUMBER OF PERMANENT SYMBOLS DEFINE PSYM (A,B)< XLIST SIXBIT /A/ XWD SYMF!NOOUTF,B LIST> PSYM @, 0(SUPRBT) PSYM ??????, 0(SUPRBT) LENGTH= .-SYMNUM-1 ;LENGTH OF INITIAL SYMBOLS PRMTBL: ;PERMANENT SYMBOLS PSYM ADC, 24 PSYM ADC2, 30 PSYM APR, 0 PSYM CCI, 14 PSYM CDP, 110 PSYM CDR, 114 PSYM CLK, 70 PSYM CLK2, 74 PSYM CPA, 0 PSYM CR, 150 PSYM CR2, 154 PSYM DC, 200 PSYM DC2, 204 PSYM DCSA, 300 PSYM DCSB, 304 PSYM DDC, 270 PSYM DDC2, 274 PSYM DF, 270 PSYM DIS, 130 PSYM DIS2, 134 PSYM DLB, 60 PSYM DLB2, 160 PSYM DLC, 64 PSYM DLC2, 164 PSYM DLS, 240 PSYM DLS2, 244 PSYM DPC, 250 PSYM DPC2, 254 PSYM DPC3, 260 PSYM DPC4, 264 PSYM DSI, 464 PSYM DSI2, 474 PSYM DSK, 170 PSYM DSK2, 174 PSYM DSS, 460 PSYM DSS2, 470 PSYM DTC, 320 PSYM DTC2, 330 PSYM DTS, 324 PSYM DTS2, 334 PSYM LPT, 124 PSYM LPT2, 234 PSYM MDF, 260 PSYM MDF2, 264 PSYM MTC, 220 PSYM MTM, 230 PSYM MTS, 224 PSYM PAG, 10 PSYM PI, 4 PSYM PLT, 140 PSYM PLT2, 144 PSYM PTP, 100 PSYM PTR, 104 PSYM TMC, 340 PSYM TMC2, 350 PSYM TMS, 344 PSYM TMS2, 354 PSYM TTY, 120 PSYM UTC, 210 PSYM UTS, 214 PRMEND: ;END OF PERMANENT SYMBOLS OPDEF ZL [Z LITF] ;INVALID IN LITERALS OPDEF ZA [Z ADDF] ;INVALID IN ADDRESSES OPDEF ZAL [Z ADDF!LITF] OP1TAB: ZA PAGE0 ;PAGE ZAL PASS20 ;PASS2 ZAL PHASE0 ;PHASE Z POINT0 ;POINT ZA PRNTX0 ;PRINTX ZA PURGE0 ;PURGE ZA RADIX0 ;RADIX Z RADX50 ;RADIX50,SQUOZE ZAL %ORG (1) ;RELOC ZAL REMAR0 ;REMARK ZA REPEA0 ;REPEAT ZA SUPRE0 ;SUPRESS ZAL PSEND0 ;PRGEND ZAL RIM0 (RIMSW) ;RIM DATAI 0,IOP ;RSW Z ASCII0 (1) ;SIXBIT ZA IOSET (IOPALL!IOSALL) ;[1065] SALL ZAL SERCH0 ;SEARCH ZA STOPI0 ;STOPI ZA SUBTT0 (Z (POINT 7,,)) ;SUBTTL ZA SYN0 ;SYN ZAL TAPE0 ;TAPE ZA TITLE0 (Z (POINT 7,,)) ;TITLE ZAL VAR0 ;VAR Z XPUNG0 ;XPUNGE ZAL TWSEG0 ;TWOSEGMENTS ZA XALL0 (IOPALL) ;[1065] XALL ZA IOSET (IOPROG) ;[1065][1150] XLIST Z XWD0 ;XWD ZAL RIM0 (RIM1SW) ;RIM10 ZAL RIM0 (R1BSW) ;RIM10B ZA UNIV0 (Z (POINT 7,,)) ;UNIVERSAL ZA ONCRF (IONCRF) ;[1063] .CREF ZA OFFCRF (IONCRF) ;[1063] .XCREF ZA OFFORM ;.HWFRMT ZA ONFORM ;.MFRMT ZAL REQUEST ;.REQUEST ZAL REQUIRE ;.REQUIRE ZA NODDT0 ;.NODDT ZAL COMM0 ;.COMMON ZA %DIREC ;[1065] .DIRECTIVE ZA ASGN ;.ASSIGN ZAL %ORG (1B18) ;.ORG ZAL %LINK (0) ;.LINK ZAL %LINK (1B18) ;.LNKEND Z %TEXT0 (1B18+1B21) ;.TEXT Z %IF ;.IF Z %IFN ;.IFN JRST 1,OP ;PORTAL JRST 6,OP ;XJEN JRST 5,OP ;XJRSTF JRST 7,OP ;XPCW JRST 14,OP ;XSFM IFN FTPSECT,< ;[575] ZA %SEGME ;.PSECT ZA %ENDSE ;.ENDPS > OP2TAB: Z ASCII0 (0) ;ASCII Z ASCII0 (1B18) ;ASCIZ BLKI IOP ;BLKI BLKO IOP ;BLKO ZAL BLOCK0 ;BLOCK ZA SUPRSA ;ASUPPRESS ZAL HISEG0 ;HISEG Z BYTE0 ;BYTE CONI IOP ;CONI CONO IOP ;CONO CONSO IOP ;CONSO CONSZ IOP ;CONSZ DATAI IOP ;DATAI DATAO IOP ;DATAO Z OCT0 (^D10) ;DEC ZA DEFIN0 ;DEFINE ZAL DEPHA0 ;DEPHASE ZAL END0 ;END ZA INTER0 (INTF!ENTF) ;ENTRY Z EXPRES ;EXP ZA EXTER0 ;EXTERN JRST 4,OP ;HALT TLNN FR,IFPASS ;IF1 TLNE FR,IFPASS ;IF2 TRNE AC0,IFB0 ;IFB TLNE ARG,IFDEF0 ;IFDEF Z IFIDN0 (0) ;IFDIF SKIPE IF ;IFE SKIPG IF ;IFG SKIPGE IF ;IFGE Z IFIDN0 (1) ;IFIDN SKIPL IF ;IFL SKIPLE IF ;IFLE SKIPN IF ;IFN TRNN AC0,IFB0 ;IFNB TLNN ARG,IFDEF0 ;IFNDEF ZA INTER0 (INTF) ;INTERN Z IOWD0 ;IOWD Z IRP0 (0) ;IRP Z IRP0 (400000) ;IRPC JFCL 6,OP ;JCRY JFCL 4,OP ;JCRY0 JFCL 2,OP ;JCRY1 JRST 12,OP ;JEN JFCL 10,OP ;JOV JRST 2,OP ;JRSTF ZA IOLSET (IOPALL!IOSALL) ;[1065] LALL ZA IORSET (IOPROG) ;[1065] LIST ZAL LIT0 ;LIT ZAL %ORG (0) ;LOC ZA OFFSYM ;NOSYM Z OCT0 (^D8) ;OCT ZA OPDEF0 ;OPDEF JFCL 1,OP ;JFOV ZA ONML ;MLON ZA OFFML ;MLOFF Z ASCII0 (3B19) ;COMMENT ZAL %ARAY ;ARRAY ZAL %INTEG ;INTEGER IFN IIISW,< Z ASCII0 (5B20)> ;ASCID IFN UUOSYM,< CALTBL: ;USER DEFINED CALLI'S GO HERE SIXBIT /LIGHTS/ ;-1 CALLI0: SIXBIT /RESET/ ;0 SIXBIT /DDTIN/ ;1 SIXBIT /SETDDT/ ;2 SIXBIT /DDTOUT/ ;3 SIXBIT /DEVCHR/ ;4 SIXBIT /DDTGT/ ;5 SIXBIT /GETCHR/ ;6 SIXBIT /DDTRL/ ;7 SIXBIT /WAIT/ ;10 SIXBIT /CORE/ ;11 SIXBIT /EXIT/ ;12 SIXBIT /UTPCLR/ ;13 SIXBIT /DATE/ ;14 SIXBIT /LOGIN/ ;15 SIXBIT /APRENB/ ;16 SIXBIT /LOGOUT/ ;17 SIXBIT /SWITCH/ ;20 SIXBIT /REASSI/ ;21 SIXBIT /TIMER/ ;22 SIXBIT /MSTIME/ ;23 SIXBIT /GETPPN/ ;24 SIXBIT /TRPSET/ ;25 SIXBIT /TRPJEN/ ;26 SIXBIT /RUNTIM/ ;27 SIXBIT /PJOB/ ;30 SIXBIT /SLEEP/ ;31 SIXBIT /SETPOV/ ;32 SIXBIT /PEEK/ ;33 SIXBIT /GETLIN/ ;34 SIXBIT /RUN/ ;35 SIXBIT /SETUWP/ ;36 SIXBIT /REMAP/ ;37 SIXBIT /GETSEG/ ;40 SIXBIT /GETTAB/ ;41 SIXBIT /SPY/ ;42 SIXBIT /SETNAM/ ;43 SIXBIT /TMPCOR/ ;44 SIXBIT /DSKCHR/ ;45 SIXBIT /SYSSTR/ ;46 SIXBIT /JOBSTR/ ;47 SIXBIT /STRUUO/ ;50 SIXBIT /SYSPHY/ ;51 SIXBIT /FRECHN/ ;52 SIXBIT /DEVTYP/ ;53 SIXBIT /DEVSTS/ ;54 SIXBIT /DEVPPN/ ;55 SIXBIT /SEEK/ ;56 SIXBIT /RTTRP/ ;57 SIXBIT /LOCK/ ;60 SIXBIT /JOBSTS/ ;61 SIXBIT /LOCATE/ ;62 SIXBIT /WHERE/ ;63 SIXBIT /DEVNAM/ ;64 SIXBIT /CTLJOB/ ;65 SIXBIT /GOBSTR/ ;66 0 ;67 0 ;70 SIXBIT /HPQ/ ;71 SIXBIT /HIBER/ ;72 SIXBIT /WAKE/ ;73 SIXBIT /CHGPPN/ ;74 SIXBIT /SETUUO/ ;75 SIXBIT /DEVGEN/ ;76 SIXBIT /OTHUSR/ ;77 SIXBIT /CHKACC/ ;100 SIXBIT /DEVSIZ/ ;101 SIXBIT /DAEMON/ ;102 SIXBIT /JOBPEK/ ;103 SIXBIT /ATTACH/ ;104 SIXBIT /DAEFIN/ ;105 SIXBIT /FRCUUO/ ;106 SIXBIT /DEVLNM/ ;107 SIXBIT /PATH./ ;110 SIXBIT /METER./ ;111 SIXBIT /MTCHR./ ;112 SIXBIT /JBSET./ ;113 SIXBIT /POKE./ ;114 SIXBIT /TRMNO./ ;115 SIXBIT /TRMOP./ ;116 SIXBIT /RESDV./ ;117 SIXBIT /UNLOK./ ;120 SIXBIT /DISK./ ;121 SIXBIT /DVRST./ ;122 SIXBIT /DVURS./ ;123 SIXBIT /XTTSK./ ;124 SIXBIT /CAL11./ ;125 SIXBIT /MTAID./ ;126 SIXBIT /IONDX./ ;127 SIXBIT /CNECT./ ;130 SIXBIT /MVHDR./ ;131 SIXBIT /ERLST./ ;132 SIXBIT /SENSE./ ;133 SIXBIT /CLRST./ ;134 SIXBIT /PIINI./ ;135 SIXBIT /PISYS./ ;136 SIXBIT /DEBRK./ ;137 SIXBIT /PISAV./ ;140 SIXBIT /PIRST./ ;141 SIXBIT /IPCFR./ ;142 SIXBIT /IPCFS./ ;143 SIXBIT /IPCFQ./ ;144 SIXBIT /PAGE./ ;145 SIXBIT /SUSET./ ;146 SIXBIT /COMPT./ ;147 SIXBIT /SCHED./ ;150 SIXBIT /ENQ./ ;151 SIXBIT /DEQ./ ;152 SIXBIT /ENQC./ ;153 SIXBIT /TAPOP./ ;154 SIXBIT /FILOP./ ;155 SIXBIT /CAL78./ ;156 SIXBIT /NODE./ ;157 SIXBIT /ERRPT./ ;160 SIXBIT /ALLOC./ ;161 SIXBIT /PERF./ ;162 CALNTH==.-CALTBL NEGCAL==CALLI0-CALTBL ;NUMBER OF NEGATIVE CALLI'S TTCTBL: SIXBIT /INCHRW/ ;0 INPUT A CHAR. AND WAIT SIXBIT /OUTCHR/ ;1 OUTPUT A CHAR. SIXBIT /INCHRS/ ;2 INPUT A CHAR. AND SKIP SIXBIT /OUTSTR/ ;3 OUTPUT A STRING SIXBIT /INCHWL/ ;4 INPUT CHAR., WAIT, LINE MODE SIXBIT /INCHSL/ ;5 INPUT CHAR., SKIP, LINE MODE SIXBIT /GETLCH/ ;6 GET LINE CHARACTERISTICS SIXBIT /SETLCH/ ;7 SET LINE CHARACTERISTICS SIXBIT /RESCAN/ ;10 RESET INPUT STREAM TO COMMAND SIXBIT /CLRBFI/ ;11 CLEAR TYPEIN BUFFER SIXBIT /CLRBFO/ ;12 CLEAR TYPEOUT BUFFER SIXBIT /SKPINC/ ;13 SKIPS IF A CHAR. CAN BE INPUT SIXBIT /SKPINL/ ;14 SKIPS IF A LINE CAN BE INPUT SIXBIT /IONEOU/ ;15 OUTPUT AS AN IMAGE CHAR. TTCLTH==.-TTCTBL MTATBL: SIXBIT /MTWAT./ ; 0 SIXBIT /MTREW./ ; 1 SIXBIT /MTEOF./ ; 3 SIXBIT /MTSKR./ ; 6 SIXBIT /MTBSR./ ; 7 SIXBIT /MTEOT./ ;10 SIXBIT /MTUNL./ ;11 SIXBIT /MTBLK./ ;13 SIXBIT /MTSKF./ ;16 SIXBIT /MTBSF./ ;17 SIXBIT /MTDEC./ ;100 SIXBIT /MTIND./ ;101 MTALTH==.-MTATBL MTACOD: BYTE (9) 0,1,3,6 BYTE (9) 7,10,11,13 BYTE (9) 16,17,100,101 > ;END UUOSYM SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES ;SEARCH FOR OPERATOR DEFINITION (MACRO, SYN, OPDEF) MSRCH: CALL SEARCH ;PERFORM GENERAL SEARCH RET ;NOT FOUND, EXIT JUMPG ARG,MSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND CAME AC0,1(SX) ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE RET ;NO, EXIT ADDI SX,2 ;YES, POINT TO IT SETZM EXTPNT ;RESET EXTERNAL POINTER WORD CALL SRCH5 ;LOAD REGISTERS MSRCH2: AOSA 0(P) ;SET SKIP-EXIT QSRCH: JUMPL ARG,SSRCH3 ;BRANCH IF OPERAND TLC ARG,SIXF ;DO WE HAVE A SIXF? TLCN ARG,SIXF CALL SYNFIX ;YES, GO TAKE CARE OF IT FIRST QSRCH1: MOVEI SDEL,%MAC ;SET OPERATOR FLAG TLZE IO,DEFCRS ;IS IT A DEFINITION? MOVEI SDEL,%DMAC ;YES JRST CREF ;CROSS-REF AND EXIT ;HERE IF WE HAVE A SYN AND ITS VALUE IS A POINTER TO A SIXBIT OPERATOR NAME SYNFIX: PUSH P,AC0 ;SAVE CURRENT SYMBOL PUSH P,IO ;[1152] SAVE CURRENT SYN BITS TLZ IO,DEFCRS ;[1152] THIS IS NOT A DEFINITION MOVE AC0,(ARG) ;AND GET SIXBIT SYMBOL NAME PUSH P,ARG ;SAVE SIXBIT POINTER CALL OPTSCH ;GET ITS VALUE JRST [TRO ER,ERRA ;GIVE A-ERROR JRST SYNFI1] POP P,ARG ;RESTORE POINTER SKIPE UWVER ;WRITING A UNV FILE? JRST SYNFI1 ;YES, JUMP, DON'T UPDATE SYMBOL TABLE MOVEM V,(ARG) ;NO, REPLACE SIXBIT WITH OPERATOR VALUE MOVSI ARG,SYNF+PNTF ;SET FLAGS HLLM ARG,(SX) ;UPDATE IN SYMBOL TABLE SYNFI1: POP P,AC0 ;[1152] RETRIEVE SYN BITS TLNE AC0,DEFCRS ;[1152] IS THIS A DEFINITION? TLO IO,DEFCRS ;[1152] YES - TURN BIT BACK ON POP P,AC0 ;[1152] RESTORE SYMBOL NAME RET ;SEARCH FOR SYMBOL DEFINITION SSRCH: CALL SEARCH ;PERFORM GENERAL SEARCH RET ;NOT FOUND, EXIT JUMPL ARG,SSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND SSRCH1: CAME AC0,-3(SX) ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW RET ;NO DICE, EXIT SUBI SX,2 ;YES, POINT TO IT SETZM EXTPNT ;RESET EXTERNAL POINTERS WORD CALL SRCH5 ;LOAD REGISTERS SSRCH2: AOS 0(P) ;SET FOR SKIP-EXIT SSRCH3: MOVEI SDEL,%SYM ;SET OPERAND FLAG CREF: TLNE ARG,NCRF ;.XCREF SEEN? JRST [TLZ IO,DEFCRS ;CLEAR DEFINITION FLAG RET] ;AND DON'T CREF TLNN IO,IONCRF ;NO CREFFING FOR THIS SYMBOL? TLNE FR,P1!CREFSW ;PASS ONE OR CROSS-REF SUPPRESSION? RET ;YES, EXIT EXCH SDEL,C ;PUT FLAG IN C, SACE C PUSH P,CS TLNE IO,IOCREF ;HAVE WE PUT OUT THE 177,102 JRST CREF3 ;YES PUSH P,C ;START OF CREF DATA REPEAT 0,< ;NEEDS CHANGE TO CREF MOVEI C,177 CALL OUTLST MOVEI C,102 CALL OUTLST TLO IO,IOCREF ;WE NOW ARE IN THAT STATE POP P,C ;WE HAVE NOW CREF3: JUMPE C,NOFLG ;JUST CLOSE IT CALL OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM) MOVSI CS,770000 ;COUNT CHRS TDZA C,C ;STARTING AT 0 LSH CS,-6 ;TRY NEXT TDNE AC0,CS ;IS THAT ONE THERE? AOJA C,.-2 ;YES CALL OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS MOVE CS,AC0 CREF2: MOVEI C,0 LSHC C,6 ADDI C,40 CALL OUTLST ;THE ASCII SYMBOL JUMPN CS,CREF2 MOVEI C,%DSYM TLZE IO,DEFCRS CALL OUTLST ;MARK IT AS A DEFINING OCCURENCE NOFLG: MOVE C,SDEL POP P,CS RET CLSCRF: TRNN ER,LPTSW RET ;LEAVE IF WE SHOULD NOT BE PRINTING CLSCR2: MOVEI C,177 CALL PRINT TLZE IO,IOCREF ;WAS IT OPEN? JRST CLSCR1 ;YES, JUST CLOSE IT MOVEI C,102 ;NO, OPEN IT FIRST CALL OUTLST ;MARK BEGINNING OF CREF DATA MOVEI C,177 CALL OUTLST CLSCR1: MOVEI C,103 JRST OUTLST ;MARK END OF CREF DATA CLSC3: TLZ IO,IOCREF MOVEI C,177 CALL OUTLST MOVEI C,104 JRST OUTLST ;177,104 CLOSES IT FOR NOW > ;END OF REPEAT 0 REPEAT 1,< ;WORKS WITH EXISTING CREF TLNE IO,IOPAGE CALL CRFHDR ;GET CORRECT SUBTTL MOVEI C,177 CALL OUTLST MOVEI C,102 CALL OUTLST TLO IO,IOCREF ;WE NOW ARE IN THAT STATE POP P,C ;WE HAVE NOW CREF3: CALL OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM) MOVSI CS,770000 ;COUNT CHRS TDZA C,C ;STARTING AT 0 LSH CS,-6 ;TRY NEXT TDNE AC0,CS ;IS THAT ONE THERE? AOJA C,.-2 ;YES CALL OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS MOVE CS,AC0 CREF2: MOVEI C,0 LSHC C,6 ADDI C,40 CALL OUTLST ;THE ASCII SYMBOL JUMPN CS,CREF2 MOVEI C,%DSYM TLZE IO,DEFCRS CALL OUTLST ;MARK IT AS A DEFINING OCCURENCE MOVE C,SDEL POP P,CS RET IFN OPHSH,< SUBTL: SIXBIT /SUBTTL/> CRFHDR: CAME AC0,SUBTL ;IS FIRST SYMBOL "SUBTTL" JRST CRFHD1 ;NO HLLZ AC0,V CALL SUBTT0 ;UPDATE SUBTTL MOVE AC0,SUBTL ;RESTORE ARG. MOVEI V,CPOPJ CRFHD1: MOVEI C,0 JRST OUTL CLSC3: CLSCRF: TRNN ER,LPTSW RET ;LEAVE IF WE SHOULD NOT BE PRINTING CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE JRST CLSCR1 MOVEI C,0 TLNE IO,IOPAGE ;NEW PAGE? CALL OUTL ;YES,GIVE IT A ROUSING SENDOFF! MOVEI C,177 CALL OUTLST MOVEI C,102 CALL OUTLST ;MARK BEGINNING OF CREF DATA CLSCR1: TRNN ER,ERRORS ;ANY ERRORS TO CREF JRST CLSCR6 ;NO, JUST CLOSE OUT MOVE C,[POINT 6,[SIXBIT /QXADLRUVNOPEMS/]] PUSH P,ER ;SAVE ANDI ER,ERRORS ;ONLY LOOK AT THESE HRLZ ER,ER ;PUT FLAGS IN LEFT HALF CLSCR4: ILDB CS,C ;GET NEXT ERROR CODE LSH ER,1 ;SHIFT FLAG IN JUMPE ER,CLSCR5 ;FINISHED JUMPG ER,CLSCR4 ;NOT YET PUSH P,C ;SAVE BYTE POINTER TDO CS,['%.... '] ;MAGIC SYMBOL MOVEI C,%ERR ;TYPE CALL OUTLST MOVEI C,6 ;NO OF CHARS. CALL OUTLST SETZ C, ;CLEAR RECEIVING ACC LSHC C,6 ;SHIFT IN CHAR ADDI C,40 ;TO ASCII CALL OUTLST JUMPN CS,.-4 ;MORE TO DO POP P,C ;BYTE POINTER BACK JUMPN ER,CLSCR4 ;GET NEXT CLSCR5: POP P,ER ;RESTORE ER CLSCR6: MOVEI C,177 CALL OUTLST MOVEI C,103 JRST OUTLST ;MARK END OF CREF DATA > ;END OF REPEAT 1 RCPNTR: POINT 1,ARG,^L-18 ;POINT 1,ARG,22 SEARCH: CALL SRCHI ;SET UP SRCHX IFN FTPSECT,< ;[575] TLZ IO,RSASSW ;CLR INTER-PSECT REF SWITCH HRRZ AC1,SGNCUR ;GET CUR PSECT INX MOVEM AC1,SGWFND ;SET PSECT WHERE FOUND > ;END IFN FTPSECT CALL SRCH ;SEARCH CURRENT PSECT IFE FTPSECT,< JRST SRCHU ;SEE IF THERE ARE UNIVERSALS TO SEARCH JRST SRCH4S ;COMMON SUCCESSFUL EXIT > IFN FTPSECT,< JRST [SKIPN SGSRCH ;[1070] SEARCHING ONLY CURRENT PSECT? JRST SRCHSG ;[1070] NO -TRY OTHERS CALL SRCHI ;[1070] YES - RESET SRCHX JRST SRCHU] ;[1070] AND CHECK UNIVERSALS JRST SRCH4S ;COMMON SUCCESSFUL EX SRCHSG: PUSH P,V ;SAVE V PUSH P,SX ;SAVE SX VALUE PUSH P,SGNCUR ;SAVE SGNCUR PUSH P,SGNMAX ;INIT PSECT INX SRCHSL: MOVE V,0(P) ;GET PSECT INX CAMN V,-1(P) ;DON'T SEARCH CURRENT JRST SRCHSC ;PSECT AGAIN MOVEM V,SGNCUR ;FUDGE CUR PSECT CALL SRCHI ;SET UP SRCHX CALL SRCH ;SEARCH THIS PSECT JRST SRCHSC ;NOT HERE EITHER MOVE AC1,SGNCUR ;GET RELEVANT PSECT INX MOVEM AC1,SGWFND ;SET PSECT WHERE FOUND SKIPGE -1(P) ;WANT TO EVALUATE IN THIS PSECT? JRST SRCH4 ;YES, JUST EXIT MOVE ARG,0(SX) ;GET FLAGS TLNE ARG,EXTF ;[1116] EXTERNAL? JRST SRCHEX ;[1116] YES - STORE IN REQUESTING PSECT TLNE ARG,SPTR ;[1116] SPECIAL POINTER TO EXTERNAL? JRST SRCHSP ;[1116] YES - CHECK FOR INTER-PSECT EXTERNAL TLNE ARG,LELF!RELF ;IF RELOCATABLE THEN TLO IO,RSASSW ;SET INTER-PSECT REF SWITCH JRST SRCH4 ;COMMON SUCCESSFUL EXIT SRCHEX: POP P,AC1 ;INDEX POP P,SGNCUR ;RESTORE POP P,SX ;WHERE IT SHOULD BE POP P,V MOVEI SDEL,2 ;NEEDS 2 WORDS ADDB SDEL,FREE CAML SDEL,SYMBOL ;WILL IT FIT? CALL XCEEDS ;NO SETZM -2(SDEL) ;VALUE MOVEM AC0,-1(SDEL) ;NAME MOVEI V,-2(SDEL) ;POINTER HLLZ ARG,ARG ;KEEP FLAGS BUT NOT POINTER CALL INSERT ;PUT IT IN JRST SEARCH ;TRY AGAIN ;[1116] A SYMBOL REFERENCED IN THE CURRENT PSECT IS DEFINED IN ANOTHER ;[1116] PSECT AS A SPECIAL EXTERNAL POINTER (I.E. FOO=BAR##). IF THE SYMBOL ;[1116] WILL NOT GO POLISH, THEN BOTH IT AND THE EXTERNAL IT POINTS TO MUST ;[1116] BE COPIED INTO THE CURRENT PSECT TO KEEP THE EXTERNAL CHAIN FROM ;[1116] CROSSING PSECTS SRCHSP: SKIPL 1(ARG) ;[1116] POINTER TO POLISH DEFINITION? SKIPE (ARG) ;[1116] OR EXT+N WHICH WILL GO POLISH JRST SRCH4 ;[1116] YES - NO NEED TO COPY SYMBOLS POP P,AC1 ;[1116] DISCARD INDEX POP P,SGNCUR ;[1116] NEED PSECT INDEX POP P,AC1 ;[1116] DISCARD SYMBOL TABLE PTR. POP P,AC1 ;[1116] AND VALUE PUSH P,AC0 ;[1116] SAVE SYMBOL PUSH P,(ARG) ;[1116] SAVE VALUE ( SHOULD BE 0) PUSH P,ARG ;[1116] AND SYMBOL FLAGS HRRZ AC1,1(ARG) ;[1116] GET POINTER TO EXTERNAL BLOCK MOVE AC0,1(AC1) ;[1116] GET EXTERNAL SYMBOL NAME CALL SEARCH ;[1116] FIND EXTERNAL IN SOME OTHER PSECT JFCL ;[1116] AND PUT IN CURRENT PSECT (CAN'T FAIL) HRRZ RC,ARG ;[1116] USE EXTERNAL POINTER AS RELOCATION POP P,ARG ;[1116] RESTORE SYMBOL FLAGS POP P,V ;[1116] SYMBOL VALUE POP P,AC0 ;[1116] AND SYMBOL NAME CALL SRCHI ;[1116] SETUP FOR INSERT CALL SRCH ;[1116] FIND PLACE WHERE SYMBOL GOES JFCL ;[1116] CANNOT FAIL CALL INSERT ;[1116] ADD SYMBOL TO CURRENT PSECT MOVE AC1,SGNCUR ;[1116] GET CURRENT INDEX MOVEM AC1,SGWFND ;[1116] AND SAVE AS PSECT WHERE FOUND JRST SRCH4S ;[1116] COMMON SUCCESSFUL EXIT SRCHSC: SOS V,0(P) ;BUMP PSECT INX JUMPGE V,SRCHSL ;LOOP IF MORE PSECTS POP P,AC1 ;THROW AWAY PSECT INX POP P,SGNCUR ;RESTORE SGNCUR CALL SRCHI ;RESET SRCHX POP P,SX ;RESTORE SX VALUE POP P,V ;RESTORE V > SRCHU: TRNN FRR,NOUNVS ;[713] WANT TO SEARCH UNVS? SKIPN UNISCH+1 ;ARE THERE ANY? RET ;NO, JUST RETURN HRLM SX,UNISCH ;SAVE SX AND SET FLAG MOVE ARG,SRCHX ;SEARCH POINTER MOVEM ARG,UNISHX ;TO A SAFE PLACE IFE FTPSECT,< ;[575] HRR ARG,SYMBOL HRL ARG,SYMTOP > ;END IFE FTPSECT IFN FTPSECT,< ;[575] HRR ARG,SGSBOT HRL ARG,SGSTOP > ;END IFN FTPSECT MOVEM ARG,UNIPTR ;STORE ALSO SRCHUL: AOS V,UNISCH ;GET NEXT INDEX TO TABLE MOVE V,UNISCH(V) ;GET TRUE INDEX JUMPE V,SRCHKO ;IF ZERO ALL TABLE SCANNED MOVE ARG,UNISHX(V) ;NEW SRCHX MOVEM ARG,SRCHX ;SET IT UP MOVE ARG,UNIPTR(V) ;SGSTOP,,SGSBOT IFE FTPSECT,< ;[575] HRRZM ARG,SYMBOL HLRZM ARG,SYMTOP > ;END IFE FTPSECT IFN FTPSECT,< ;[575] HRRZM ARG,SGSBOT HLRZM ARG,SGSTOP > ;END IFN FTPSECT CALL SRCH ;SEARCH UNIV SYM TAB JRST SRCHUL ;NOPE, TRY NEXT ONE IFN FTPSECT,< JRST SRCH4S ;COMMON SUCCESSFUL EXIT SRCH4: POP P,AC1 ;THROW AWAY PSECT INX POP P,SGNCUR ;RESTORE SGNCUR POP P,AC1 ;THROW AWAY SX VALUE POP P,AC1 ;THROW AWAY V > SRCH4S: AOS 0(P) ;SET FOR SKIP EXIT SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT ANDCAM ARG,(SX) ;IN THE TABLE SRCH7: MOVE ARG,0(SX) ;FLAG AND VALUE TO ARG SKIPE UNISCH ;[653] FOUND IN UNV? JRST [ TLC ARG,SYNF!PNTF ;[653] YES, CHECK FOR SYN FIXUP TLCE ARG,SYNF!PNTF ;[653] JRST .+1 ;[653] TLNE ARG,VARF ;[653] YES, OLD STYLE UNV FILE? JRST .+1 ;[653] MOVE AC0,UNITBL(V) ;[653] JRST VERSKW] ;[653] YES, REASSEMBL UNV LDB RC,RCPNTR ;POINT 1,ARG,17 TLNE ARG,LELF ;CHECK LEFT RELOCATE TLO RC,1 HRRZ V,ARG TLNE ARG,SPTR ;CHECK SPECIAL EXTESN POINTER JRST SRCH6 TLNE ARG,PNTF MOVE V,0(ARG) ;36BIT VALUE TO V JRST SRCHOK SRCH6: MOVE V,0(ARG) ;VALUE MOVE RC,1(ARG) ;AND RELOC JUMPL RC,SRCHOK ;[773] JUMP IF POLISH TLNE RC,-2 ;CHECK AND SET EXTPNT HLLM RC,EXTPNT TRNE RC,-2 HRRM RC,EXTPNT JRST SRCHOK SRCHKO: SETZ ARG, ;CLEAR ARG SO ZERO STORED SRCHOK: SKIPN UNISCH ;HAVE WE SEARCH OTHER TABLES RET ;NO, JUST RETURN SYMBCK: HLRZ SX,UNISCH ;RESTORE SX SETZM UNISCH ;CLEAR SYMBCK FLAG MOVE SDEL,UNISHX ;SRCHX MOVEM SDEL,SRCHX ;RESTORE ORIGINAL IFE FTPSECT,< ;[575] MOVE SDEL,UNIPTR ;SYMTOP,,SYMBOL HRRZM SDEL,SYMBOL HLRZM SDEL,SYMTOP JUMPE ARG,CPOPJ ;TOTALLY UNDEFINED > IFN FTPSECT,< ;[575] MOVE SDEL,UNIPTR ;SGSTOP,,SGSBOT HRRZM SDEL,SGSBOT HLRZM SDEL,SGSTOP JUMPE ARG,CPOPJ ;TOTALLY UNDEFINED PUSH P,SGNCUR ;SAVE CUR PSECT SETZM SGNCUR ;SET TO BLANK PSECT SETZM SGWFND ;SET PSECT WHERE FOUND CALL SRCHI ;SET UP SRCHX CALL SRCH ;SET UP SX JFCL > TLNE ARG,SPTR ;SPECIAL EXTERNAL? JRST SYMBKS ;YES TLNE ARG,EXTF ;EXTERNAL? JRST SYMBKX ;YES, NEED 2 MORE CELLS TLNN ARG,PNTF ;36 BIT VALUE FLAG SET? JRST .+3 ;NO, PUT IN TABLE AND RETURN TLNN V,-1 ;BUT IS IT ONLY 18 BIT VALUE? TLZ ARG,PNTF ;YES, SO ONLY USE 18 BITS IFE FTPSECT,< ;[575] JRST INSERT SYN CPOPJ,SYMBKR > IFN FTPSECT,< ;[575] CALL INSERT ;STILL HAVE 0 PSECT SYMBKR: POP P,SGNCUR ;RESTORE CUR PSECT RET > SYMBKX: PUSH P,[EXP SYMBKR] ;RETURN ADDRESS PUSH P,1(ARG) ;SAVE SIXBIT NAME MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS ;PUT 2 WORDS IN CORE SYMBKY: CALL INSERZ ;INSERT SYMBOL IN TABLE MOVEI SDEL,2 ;GET 2 CELLS FROM FREE CORE ADDB SDEL,FREE CAML SDEL,SYMBOL ;MORE CORE NEEDED? CALL XCEEDS ;YES HRRI ARG,-2(SDEL) ;POINTER TO VALUE SETZM (ARG) ;AND CLEAR IT POP P,1(ARG) ;STORE SIXBIT VALUE MOVEM ARG,(SX) ;SET FLAGS AND VALUE AS IT SHOULD BE RET ;RETURN SYMBKS: PUSH P,V ;SAVE ADDITIVE VALUE PUSH P,[Z SYMBKZ] ;SET UP RETURN ADDRESS FOR PJRST PUSH P,ARG ;SAVE SYMBOL'S FLAGS TRO FRR,NOUNVS ;[713] DON'T SEARCH UNIVERSALS PUSH P,AC0 ;SAVE SYMBOL WE REALLY WANT MOVE ARG,1(ARG) ;GET POINTER TO DEFINING SYMBOL IFN POLISH,< JUMPL ARG,SYMBKP ;JUMP IF POLISH > MOVE AC0,1(ARG) ;AND FINALLY SYMBOL CALL SEARCH ;SEE IF DEFINING GLOBAL IS IN TABLE CALL [PUSH P,1(ARG) ;SAVE SIXBIT NAME MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS JRST SYMBKY] ;NO, PUT IN SYMBOL TABLE SYMBS1: POP P,AC0 ;GET SYMBOL BACK CALL SEARCH ;SETUP SX AGAIN JFCL ;WILL ALWAYS FAIL TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN HLL ARG,0(P) ;RECOVER FLAGS HRRZM ARG,0(P) ;STACK POINTER TO GLOBAL JRST SYMBKY ;AND DO DUMMY PUSHJ SYMBKZ: ;FAKE RETURN ADDRESS POP P,V ;GET OFFSET MOVEM V,0(ARG) ;STORE OFFSET JRST SYMBKR ;RETURN IFN POLISH,< ;HERE IF POLISH SYMBKP: PUSH P,ARG PUSH P,SDEL ;SAVE SDEL PUSH P,[-1] ;END OF LOWER LEVEL POLISH TO BE CHECKED SYMBP4: MOVE AC1,1(ARG) ;GET THE OPERATOR MOVE SDEL,DESTB-3(AC1) ;AND NUMBER OF OPERANDS SYMBP0: ADDI ARG,2 ;GET 1ST OPERAND HRRZM ARG,UNVNPL ;REMEMBER CURRENT ADDRESS MOVE AC0,(ARG) ;GET 1ST WORD OF THE PAIR JUMPE AC0,SYMBP1 ;IF 1ST WORD IS 0, GO ONTO NEXT PAIR JUMPL AC0,[PUSH P,AC0 ;1ST WORD IS POLISH JRST SYMBP1] ;STORE LOWER LEVEL POLISH PTR ON STACK MOVE ARG,AC0 MOVE AC0,1(ARG) ;GET SIXBIT SYMBOL PUSH P,SDEL ;SAVE NUMBER OF OPERANDS LEFT CALL SEARCH CALL [PUSH P,1(ARG) ;NOT FOUND, GO INSERT IT TLO ARG,SYMF!EXTF!PNTF JRST SYMBKY] POP P,SDEL ;RESTORE NUMBER OF OPERANDS LEFT SYMBP1: MOVE ARG,UNVNPL ;GET CURRENT LOCATION SOJG SDEL,SYMBP0 ;ANY MORE OPERANDS? IF YES, GO BACK POP P,ARG ;NO, ANY LOWER LEVEL POLISH? CAMN ARG,[-1] ;END? JRST SYMBP3 ;YES, JRST SYMBP4 SYMBP3: POP P,SDEL ;RESTORE ORIGINAL SDEL POP P,ARG ;RECOVER ORIGINAL ARG POP P,AC0 ;AND SYMBOL CALL SEARCH ;SET UP SX AGAIN JFCL ;WILL ALWAYS FAIL TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN MOVEM ARG,0(P) ;STACK POINTER TO POLISH SETZ ARG, TLO ARG,SPTR!SYMF ;SET ONLY THE REQUIRED FLAGS JRST SYMBKY ;GO INSERT > SRCH: HLRZ SX,SRCHX HRRZ SDEL,SRCHX SRCH1: CAML AC0,-1(SX) JRST SRCH3 SRCH2: SUB SX,SDEL LSH SDEL,-1 IFE FTPSECT,< ;[575] CAMG SX,SYMTOP > ;[575] IFN FTPSECT,< ;[575] CAMG SX,SGSTOP > ;[575] JUMPN SDEL,SRCH1 JUMPN SDEL,SRCH2 SOJA SX,CPOPJ ;NOT FOUND SRCH3: CAMN AC0,-1(SX) JRST CPOPJ1 ;NORMAL / FOUND EXIT ADD SX,SDEL LSH SDEL,-1 IFE FTPSECT,< ;[575] CAMG SX,SYMTOP > ;[575] IFN FTPSECT,< ;[575] CAMG SX,SGSTOP > ;[575] JUMPN SDEL,SRCH1 JUMPN SDEL,SRCH2 SOJA SX,CPOPJ ;NOT FOUND INSERQ: TLNE ARG,UNDF!VARF INSERZ: SETZB RC,V INSERT: CAME AC0,-1(SX) ;ARE WE LOOKING AT MATCHING MNEMONIC? JRST INSRT2 ;NO, JUST INSERT JUMPL ARG,INSRT1 ;YES, BRANCH IF OPERAND SKIPL 0(SX) ;OPERATOR, ARE WE LOOKING AT ONE? JRST UPDATE ;YES, UPDATE JRST INSRT2 ;NO, INSERT INSRT1: SKIPG 0(SX) ;OPERAND, ARE WE LOOKING AT ONE? JRST UPDATE ;YES, UPDATE SUBI SX,2 ;NO, MOVE UNDER OPERATOR AND INSERT INSRT2: MOVE SDEL,SYMBOL SUBI SDEL,2 CAMLE SDEL,FREE JRST INSRT3 CALL XCEEDS ADDI SDEL,2000 INSRT3: MOVEM SDEL,SYMBOL ;MAKE ROOM FOR A TWO WORD ENTRY HRLI SDEL,2(SDEL) BLT SDEL,-2(SX) ;PUSH EVERYONE DOWN TWO LOACTIONS IFN FTPSECT,< ;[575] MOVE AC1,SGNCUR ;CURRENT PSECT INDEX AOS SGSCNT(AC1) ;INCREMENT PSECT SYM COUNT > AOS @SYMBOL ;INCREMENT THE SYMBOL COUNT TDNE RC,[-2,,-2] ;SPECIAL LEFT OR RIGHT EXTERNAL? JRST INSRT5 ;YES, JUMP TLNN V,-1 ;SKIP IF V IS A 36BIT VALUE JRST INSRT4 ;JUMP, ITS A 18BIT VALUE AOS SDEL,FREE ;36BIT, SO GET A CELL FROM FREE CORE CAML SDEL,SYMBOL ;MORE CORE NEEDED? CALL XCEEDS ;YES HRRI ARG,-1(SDEL) ;POINTER TO ARG MOVEM V,0(ARG) ;36BIT VALUE TO FREE CORE TLO ARG,PNTF ;NOTE THAT ARG IS A POINTER, NOT A 18BIT VALUE JRST INSRT7 ;STORE SYMBOL INSRT4: HRR ARG,V ;18 BIT VALUE ARG TLNN ARG,EXTF ;POSSIBLE TO BE EXT WITH 0 RELOC SO DON'T TLZ ARG,PNTF ;CLEAR POINTER FLAG IN CASE SET INSRT7: DPB RC,RCPNTR ;FIX RIGHT RELOCATION TLNE RC,1 TLO ARG,LELF ;FIX LEFT RELOCATION INSRT6: MOVEM ARG,0(SX) ;INSERT FLAGS AND VALUE. MOVEM AC0,-1(SX) ;INSERT SYMBOL NAME. CALL SRCHI ;INITILIAZE SRCHX JRST QSRCH ;EXIT THROUGH CREF INSRT5: MOVEI SDEL,2 ;GET TWO CELLS FROM FREE CORE ADDB SDEL,FREE CAML SDEL,SYMBOL ;MORE CORE NEEDED? CALL XCEEDS ;YES MOVEM RC,-1(SDEL) HRRI ARG,-2(SDEL) ;POINTER TO ARG MOVEM V,0(ARG) TLO ARG,SPTR ;SET SPECIAL POINTER, POINTS TO TWO CELLS JRST INSRT6 REMOVE: IFN FTPSECT,< ;[575] MOVEI AC2,0(SX) ;ADDRESS OF THE SYMBOL SUB AC2,SYMBOL ;- BASE OF SYMBOL TABLE LSH AC2,-1 ;/ 2 = SYMBOL ORDINAL TDZA AC1,AC1 ;INIT PSECT INDEX ADDI AC1,1 ;INCREMENT PSECT INDEX HRRZ AC0,SGSCNT(AC1) ;WITHIN THIS PSECT? SUB AC2,AC0 JUMPG AC2,.-3 ;TRY NEXT PSECT IF NOT SOS SGSCNT(AC1) ;DECREMENT PSECT SYM COUNT > SUBI SX,2 ;MOVE EVERYONE UP TWO LOCATIONS REMOV1: MOVE 0(SX) MOVEM 2(SX) ;OVERWRITE THE DELETED SYMBOL CAME SX,SYMBOL ;SKIP WHEN DONE SOJA SX,REMOV1 ADDI SX,2 MOVEM SX,SYMBOL SOS 0(SX) ;DECREMENT THE SYMBOL COUNT SRCHI: MOVEI AC2,0 ;THIS CODE SETS UP SRCHX IFE FTPSECT,< ;[575] FAD AC2,@SYMBOL > IFN FTPSECT,< ;[575] HRRZ AC1,SGNCUR HRRZ AC1,SGSCNT(AC1) FAD AC2,AC1 > LSH AC2,-^D27 MOVEI AC1,1000 LSH AC1,-357(AC2) HRRM AC1,SRCHX LSH AC1,1 IFE FTPSECT,< ;[575] ADD AC1,SYMBOL HRLM AC1,SRCHX > IFN FTPSECT,< ;[575] HRLM AC1,SRCHX MOVE AC1,SYMBOL MOVEM AC1,SGSBOT HRRZ AC2,SGNCUR JUMPE AC2,SRCHI2 SRCHI1: HRRZ AC1,SGSCNT-1(AC2) LSH AC1,1 ADDB AC1,SGSBOT SOJG AC2,SRCHI1 SRCHI2: MOVS AC2,AC1 ADDM AC2,SRCHX MOVE AC2,SGNCUR SRCHI3: HRRZ AC1,SGSCNT(AC2) LSH AC1,1 ADD AC1,SGSBOT MOVEM AC1,SGSTOP > RET ;SRCHX=XWD ,LENGTH/4 UPDATE: ;[745] TEST SPTR BEFORE DOING R-RELOC TLNE ARG,SPTR ;SKIP IF THERE IS NO SPECIAL POINTER JRST UPDAT4 ;YES, USE THE TWO CELLS IFN POLISH,< ;[1101] SKIPL RC ;[1101] SKIP FIXUP IF POLISH > ;[1101] TDNE RC,[-2,,-2] ;NEED TO CHANGE ANY CURRENT EXTERNS JRST UPDAT5 ;YES ,JUMP DPB RC,RCPNTR ;[1116][745] FIX RIGHT RELOCATION TLZ ARG,LELF ;CLEAR LELF TLNE RC,1 ;LEFT RELOCATABLE? TLO ARG,LELF ;YES, SET THE FLAG TLNE ARG,PNTF ;WAS THERE A 36BIT VALUE? JRST UPDAT2 ;YES, USE IT. TLNE V,-1 ;NO,IS THERE A 36BIT VALUE? JRST UPDAT1 ;YES, GET A CELL HRR ARG,V ;NO, USE RH OF ARG UPDAT3: MOVEM ARG,0(SX) ;OVERWRITE THE ONE IN THE TABLE IFE FTPSECT,< ;[575] RET ;AND EXIT > IFN FTPSECT,< ;[575] JRST UPDAT6 ;AND EXIT > UPDAT1: AOS SDEL,FREE ;GET ONE CELL CAML SDEL,SYMBOL ;NEED MORE CORE? CALL XCEEDS ;YES HRRI ARG,-1(SDEL) ;POINTER TO ARG TLO ARG,PNTF ;AND NOTE IT. UPDAT2: TLNE ARG,EXTF ;IS THERE A EXTERNAL? JRST UPDAT3 ;YES, - JUST SAVE A LOCATION MOVEM ARG,0(SX) ;NO, OVERWRITE THE POINTER IN THE TABLE MOVEM V,0(ARG) ;STORE VALUE AS A 36BIT VALUE IFE FTPSECT,< ;[575] RET ;AND EXIT > IFN FTPSECT,< ;[575] JRST UPDAT6 ;AND EXIT > UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM MOVEM V,0(ARG) ;SAVE AS 36BIT VALUE MOVEM RC,1(ARG) ;SAVE RELOCATION BITS RET ;AND EXIT UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL ADDB SDEL,FREE ;SO WE NEED TWO LOACTIONS CAML SDEL,SYMBOL ;NEED MORE CORE? CALL XCEEDS ;YES MOVEM RC,-1(SDEL) ;SAVE RELOCATION BITS HRRI ARG,-2(SDEL) ;SAVE THE POINTER IN ARG MOVEM V,0(ARG) ;SAVE A 36BIT VALUE TLO ARG,SPTR ;SET SPECIAL PNTR FLAG TLZ ARG,PNTF ;CLEAR POINTER FLAG IFN POLISH,< TLZE ARG,OPDF ;[624] OPDEF? TLO ARG,SYMF ;[624] MAKE IT INTO SYMBOL > JRST UPDAT3 ;SAVE THE POINTER AND EXIT IFN FTPSECT,< ;[575] UPDAT6: TLNN IO,DEFCRS ;DEFINING OCCURANCE? RET ;NO, RETURN TLNE ARG,EXTF ;EXTERNAL? RET ;YES, RETURN MOVE SDEL,SYMBOL ;GET START OF SYM TAB SETZ AC1, ;ZERO PSECT INX UPDAT7: HRRZ AC2,SGSCNT(AC1) ;PSECT SYM CNT LSH AC2,1 ;DOUBLE IT ADD SDEL,AC2 ;END OF PSECT CAMGE SDEL,SX ;SYM IN THIS PSECT? AOJA AC1,UPDAT7 ;NO, TRY NEXT PSECT CAMN AC1,SGNCUR ;IF IT'S IN THE CUR PSECT RET ;THEN RETURN PUSH P,AC1 ;SAVE PRESENT PSECT INX PUSH P,0(SX) ;SAVE SYMBOL STUFF PUSH P,-1(SX) ;AND NAME PUSH P,SX ;SAVE PRESENT SYM INX CALL SRCHI ;SET UP SRCHX CALL SRCH ;SET UP NEW SX JFCL POP P,SDEL ;RESTORE PRESENT SYM INX MOVE AC1,-2(P) ;GET PRESENT PSECT INX CAMG AC1,SGNCUR ;WHICH WAY TO MOVE? JRST UPDAT9 ;DOWN ADDI SX,2 ;MUST MOVE THIS ONE ALSO UPDAT8: MOVE AC2,-2(SDEL) ;MOVE PART OF MOVEM AC2,0(SDEL) ;SYMBOL TABLE CAILE SDEL,0(SX) ;ENOUGH MOVED? SOJA SDEL,UPDAT8 ;NO JRST UPDT10 ;COMMON EXIT UPDAT9: HRLI AC2,1(SDEL) ;FROM HERE HRRI AC2,-1(SDEL) ;TO HERE BLT AC2,-2(SX) ;UNTIL HERE, MOVE! UPDT10: POP P,-1(SX) ;RESTORE SYMBOL NAME POP P,0(SX) ;AND STUFF POP P,AC1 ;OLD PSECT INX SOS SGSCNT(AC1) ;DECR ITS SYM CNT MOVE AC1,SGNCUR ;CUR PSECT INX AOS SGSCNT(AC1) ;INCR ITS SYM CNT JRST SRCHI ;[664] SET UP SRCHX, RETURN > SUBTTL PHASED CODE IFN PURESW, IFN TEMP, LSTFIL: BLOCK 1 SIXBIT /@/ ;SYMBOL TO STOP PRINTING TABI: IFE FORMSW,< BYTE (7) 0, 11, 11, 11, 11> IFN FORMSW,< BYTE (7) 11,11, 11, 11, 11> SEQNO: BLOCK 1 ASCIZ / / BININI: EXP B BINDEV: BLOCK 1 XWD BINBUF,0 LSTINI: EXP AL LSTDEV: BLOCK 1 XWD LSTBUF,0 IFN CCLSW,< RPGINI: EXP AL RPGDEV: BLOCK 1 XWD 0,CTLBLK > INDEVI: EXP A INDEV: BLOCK 1 XWD 0,IBUF UNVINI: EXP B ;OPEN BLOCK FOR BINARY UNV UNVDEV: BLOCK 1 ;SO USER CAN SPECIFY EXP UNVBUF ..LPP: EXP .LPP-2 ;"READ-ONLY" LINES/PAGE REL1P: EXP ABSLOC ;[573] EXP RELLOC ;PTR TO RELLOC BLOCK ;DATA AREA FOR COMPT. UUO'S IFN TOPS20,< DEFDIR: BLOCK ^D8 ;DEFAULT DIRECTORY NAME DEFDEV: BLOCK ^D8 ;DEFAULT DEVICE NAME BIGBUF: BLOCK ^D17 FILNAM: BLOCK ^D26 RUNARG: 4 ;RUN ARG RUNBLK ;LONG FORM -1,,FILNAM 1 RUNBLK: 100001,,0 377777,,377777 -1,,[ASCIZ /SYS/] 0 0 -1,,[ASCIZ /EXE/] ;DEFAULT EXT BLOCK 3 ;THAT'S ALL INARG: CHAR,,1 INBLK -1,,FILNAM 440000,,200000 0 IBUF 0 .+1 INRIB: 5 ;SIZE OF RIB BLOCK 5 ;DUMMY INBLK: 100001,,0 377777,,377777 DINDEV: 0 DINDIR: 0 0 -1,,[ASCIZ /MAC/] BLOCK 3 LSTARG: LST,,1 LSTBLK -1,,FILNAM 070000,,100000 1 0 LSTBUF .+1 BLOCK 4 ;DUMMY RIB LSTBLK: 400001,,0 377777,,377777 0 0 LSTNAM: 0 ;NAME LSTEXT: 0 ;EXTENSION BLOCK 3 BINADR: BIN,,1 BINSTK ;LONG FORM -1,,FILNAM 440000,,100000 ;WRITE ACCESS 14 0 BINBUF .+1 BLOCK 4 ;DUMMY RIB BINSTK: 400001,,0 ;FLAGS 377777,,377777 0 0 0 -1,,[ASCIZ /REL/] ;DEFAULT EXTENSION BLOCK 3 ;ALL REST ARE ZERO RPGADR: CTL2,,1 ;BLOCK FO COMMADN FILE RPGBLK -1,,FILNAM 440000,,200000 ;OPENF BITS 0 CTLBLK 0 .+1 ;RIB ADDRESS 5 ;SIZE OF BLOCK WHICH FOLLOWS BLOCK 5 RPGBLK: 100001,,0 ;OLD FILE 377777,,377777 BLOCK 3 ;NO DEFAULTS HERE -1,,[ASCIZ /CCL/] ;DEFAULT EXTTENSION BLOCK 3 > ;END OF TOPS20 CONDITIONAL DBUF: ASCIZ / TI:ME DY-MON-YR Page / VBUF: ASCIZ / MACRO %/ ;MUST BE LAST LOCATIONS IN BLOCK IFE PURESW,< BLOCK 3> ;ALLOW FOR LONG TITLE IFN PURESW,< DEPHASE LENLOW==.-LOWH> SUBTTL STORAGE CELLS IFN PURESW,< RELOC LOWL LOWL: BLOCK LENLOW+3 > PASS1I: CTLBUF: BLOCK /5 ;[700] PASS1U: ;[700] RP: BLOCK 1 IFN POLISH,< POLSTK: BLOCK 1 POLPTR: BLOCK 1 > LSTBUF: BLOCK 3 BINBUF: BLOCK 3 IBUF: BLOCK 3 UNVBUF: BLOCK 3 LSTDIR: BLOCK 4 BINDIR: BLOCK 4 INDIR: BLOCK 4 UNVDIR: BLOCK 4 UNVPTH: BLOCK 2+.SFDLN ;PATH FOR UNV LOOKUP MYPPN: BLOCK 1 ;LOGGED IN PPN ACDELX: ;LEFT HALF BLKTYP: BLOCK 1 ;RIGHT HALF COUTX: BLOCK 1 COUTY: BLOCK 1 COUTP: BLOCK 1 COUTRB: BLOCK 1 COUTDB: BLOCK ^D18 CURADX: BLOCK 1 ;[613] CURRENT RADIX MACDVR: BLOCK 1 ;[635] STORE DIVISOR FOR BACKSLASH MACRO ARG MACADR: BLOCK 1 ;[635] STORE ADDER FOR BACKSLASH MACRO ARG UPARRO: BLOCK 1 ;-1 == RE-EAT ^ IF NOT FOLLOWED BY ! / - OKOVFL: BLOCK 1 ;-1 == * OR / OVERFLOW OK EOFFLG: BLOCK 1 ;END OF FILE SEEN, NEXT FILE OPENED NOUUO: BLOCK 1 ;[1041] -1 MEANS NO UUO SEARCH IFN TSTCD,< TCDFLG: BLOCK 1 ;-1 MEANS TEST MODE, 0 REGULAR MODE > UNDCNT: BLOCK 1 ;UND SYMBOL COUNT--CLEARED AND INCREMENTED IN UOUT ERRCNT: BLOCK 1 QERRS: BLOCK 1 ;COUNT OF "Q" ERRORS FREE: BLOCK 1 HIGH1: BLOCK 1 HISNSW: BLOCK 1 SVTYP3: BLOCK 1 HMIN: BLOCK 1 ;START OF HIGH SEG. IN TWO SEG. PROG. RLHMIN: BLOCK 1 ;[1111] LOWER BOUND FOR HI SEG WHEN COMPARING ;[1111] RELOCATABLES... HMIN-400. SXSV: BLOCK 1 SDELSV: BLOCK 1 COLSIZ: BLOCK 1 SYMBLK: BLOCK 1 IFBLK: BLOCK .IFBLK IFBLKA: BLOCK .IFBLK LADR: BLOCK 1 NCOLLS: BLOCK 1 LIMBO: BLOCK 1 LBUFP: BLOCK 1 LBUF: BLOCK <.CPL+5>/5 .SGLVZ==. ;START OF LIT /VAR AREA BLOCK 1 ;[602] CURRENT LITLVL BEFORE PSECT SWITCH .SGX: BLOCK 1 ;[602] CURRENT STPX BEFORE PSECT SWITCH .SGY: BLOCK 1 ;[602] CURRENT STPY BEFORE PSECT SWITCH VARHD: BLOCK 1 VARHDX: BLOCK 1 VARCNT: BLOCK 1 ;VARIABLE COUNTER LITAB: BLOCK 1 LITABX: BLOCK 1 BLOCK 1 LITHD: BLOCK 1 LITHDX: BLOCK 1 LITCNT: BLOCK 1 LITNUM: BLOCK 1 .SGLVL==.-.SGLVZ ;LENGTH OF LIT/VAR AREA ENDSN: BLOCK 1 ;-1 IF CHECKED VAR AREA BEFORE LISING END LOOKX: BLOCK 1 NEXT: BLOCK 1 OUTSW: BLOCK 1 PDP: BLOCK 1 RECCNT: BLOCK 1 SAVBLK: BLOCK RC SAVERC: BLOCK 1 SBUF: BLOCK .SBUF/5 SRCHX: BLOCK 1 SUBTTX: BLOCK 1 SVSYM: BLOCK 1 SYMBOL: BLOCK 1 SYMTOP: BLOCK 1 SYMCNT: BLOCK 1 IFN FTPSECT,< ;[575] SGNMAX: BLOCK 1 SGNAME: BLOCK SGNSGS+1 SGRELC: BLOCK SGNSGS+1 SGSCNT: BLOCK SGNSGS+1 SGATTR: BLOCK SGNSGS+1 SGORIG: BLOCK SGNSGS+1 ;LIT/VAR AREA ,, ORIGIN OF PSECT SGSBOT: BLOCK 1 SGSTOP: BLOCK 1 SGWFND: BLOCK 1 > STPX: BLOCK 1 STPY: BLOCK 1 STCODE: BLOCK .STP STOWRC: BLOCK .STP IFN FORMSW,< STFORM: BLOCK .STP FORM: BLOCK 1 HWFMT: BLOCK 1 FLDSIZ: BLOCK 1 IOSEEN: BLOCK 1 > TABP: BLOCK 1 TCNT: BLOCK 1 ;COUNT OF CHARS. LEFT IN TBUF TBUF: BLOCK .TBUF/5 TTLFND: BLOCK 1 ;[1123] -1 IF TITLE/UNIVERSAL SEEN IN MODULE DEVBUF: BLOCK 12 ;STORE NAME.EXT CREATION DATE AND TIME TYPERR: BLOCK 1 PRGPTR: BLOCK 1 ;POINTER TO CHAIN OF PRGEND BLOCKS PGENDF: BLOCK 1 ;[1141] -1 IF PRGEND FOUND ENTERS: BLOCK 1 ;-1 WHEN ENTERS HAVE BEEN DONE UNIVSN: BLOCK 1 ;-1 WHEN A UNIVERSAL SEEN UNVSKP: BLOCK 1 ;-1 IF /U SEEN (DON'T SAVE UNIV) CPUTYP: BLOCK 1 ;CPU TYPE FOR HEADER BLOCK PASS2I: ABSHI: BLOCK 1 HIGH: BLOCK 1 HHIGH: BLOCK 1 ;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG. IFN FTPSECT,< ;[575] BLK24: BLOCK 1 ;[1020] -1 IF TO OUTPUT BLOCK 24 SGNCUR: BLOCK 1 SGDMAX: BLOCK 1 SGLIST: BLOCK SGNDEP+1 SGSRCH: BLOCK 1 ;[1070] -1 IF SEARCHING ONLY CURRENT PSECT SGLTLV: BLOCK SGNDEP+1 ;[1074] PSECT ENTRY LITERAL LEVEL SGSWPT: BLOCK 1 ;[1074] PSECT SWAP TYPE, 0 = .PSECT, -1 = .ENDPS SGLITL: BLOCK 1 ;[1074] TOTAL LITERALS OPEN IN ALL PSECTS > ACDEVX: BLOCK 1 CPL: BLOCK 1 CTLSAV: BLOCK 1 CTLS1: BLOCK 1 EXTPNT: BLOCK 1 INTENT: BLOCK 1 INREP: BLOCK 1 INDEF: BLOCK 1 INTXT: BLOCK 1 INCND: BLOCK 1 CALNAM: BLOCK 1 COMSW: BLOCK 1 ;-1 IF IN COMMENT WHILE SCANNING FOR ANG.BRKT. ;DO NOT SPLIT THIS BLOCK OF 4 WORDS PAGENO: BLOCK 1 SEQNO2: BLOCK 1 TAG: BLOCK 1 TAGINC: BLOCK 1 CALPG: BLOCK 4 DEFPG: BLOCK 4 LITPG: BLOCK 4 REPPG: BLOCK 4 TXTPG: BLOCK 4 CNDPG: BLOCK 4 IRPCNT: BLOCK 1 IRPARG: BLOCK 1 IRPARP: BLOCK 1 IRPCF: BLOCK 1 IRPPOI: BLOCK 1 IRPSW: BLOCK 1 LSTPY: BLOCK 1 ;SAVED STPY IN LITERAL LITLVL: BLOCK 1 LBLFLG: BLOCK 1 ;-1 IF LABEL HAS OCCURRED INSIDE CURRENT LITERAL LTGINC: BLOCK 1 ;DEPTH OF LABEL IN LITERAL LBLPNT: BLOCK 1 ;POINTS TO THE START OF TAGS IN LITERAL CHAIN LBLNXT: BLOCK 1 ;POINTS TO THE NEXT BLOCK IN CHAIN LITV: BLOCK 1 ;ACTUAL ADDR OF THIS LITERAL LITRC: BLOCK 1 ;BLOCK RELOCATION FOR THIS LITERAL LITN: BLOCK 1 ;SAVE LITNUM BEFORE IT GETS UPDATED IN STOLIT SQBST: BLOCK 1 ;START OF LIT SCOPE FOR CHECKING TAG FIXUPS IN LITERAL POOL SQBRC: BLOCK 1 ;KEEP THE FAKE EXT PTR , WHEN DOING LIT TAG FIXUPS ASGBLK: BLOCK 1 LOCBLK: BLOCK 1 LOCA: BLOCK 1 LOCO: BLOCK 1 BNSN: BLOCK 1 ;-1 IF CODE STORED RELLOC: BLOCK 2 ;[573] ABSLOC: BLOCK 1 LPP: BLOCK 1 ORGMOD: BLOCK 1 MODA: BLOCK 1 MODLOC: BLOCK 1 MODO: BLOCK 1 MODN: BLOCK 1 ;NEW MODE,,NEW PC NESTED: BLOCK 1 ;-1 IF IN LITERAL, MACRO, REPEAT 1 OR IF'S IFN CCLSW, OUTSQ: BLOCK 2 PAGEN.: BLOCK 1 PPTEMP: BLOCK 1 PPTMP1: BLOCK 1 PPTMP2: BLOCK 1 REPCNT: BLOCK 1 REPEXP: BLOCK 1 REPPNT: BLOCK 1 RPOLVL: BLOCK 1 R1BCNT: BLOCK 1 R1BCHK: BLOCK 1 R1BBLK: BLOCK .R1B R1BLOC: BLOCK 1 RIMLOC: BLOCK 1 VECREL: BLOCK 1 VECTOR: BLOCK 1 VECSYM: BLOCK 1 ;GLOBAL SYMBOLIC START ADDRESS IFN FTPSECT,< ;[575] VECFND: BLOCK 1 > .TEMP: BLOCK 1 ;TEMPORARY STORAGE UNISCH: BLOCK .UNIV+1 ;SEARCH TABLE FOR UNIVERSALS SQFLG: BLOCK 1 ARGF: BLOCK 1 CPEEKC: BLOCK 1 ;ANGLE COUNT AFTER ;; IN MACRO MACENL: BLOCK 1 MACLVL: BLOCK 1 MACPNT: BLOCK 1 WWRXX: BLOCK 1 RCOUNT: BLOCK 1 ;COUNT OF WORDS STILL TO READ IN LEAF WCOUNT: BLOCK 1 ;COUNT OF WORDS STILL FREE IN LEAF IONSYM: BLOCK 1 ;-1 SUPRESS LISTING OF SYMBOLS LOCAL: BLOCK 1 ;LINKED LIST OF LOCAL FIXUPS IFN FTPSECT,< ;[735] BLOCK SGNSGS ;[735] ADDITIONAL LOCALS (ONE PER PSECT) > ;[735] INOPDF: BLOCK 1 ;[624] POLISH FIXUP NEEDED FOR THIS OPDEF IFN POLISH,< POLTYP: BLOCK 1 ;PRESET IF POLISH FIXUP TYPE KNOWN POLIST: BLOCK 1 ;LINKED LIST OF POLISH FIXUP BLOCKS POLITS: BLOCK 1 ;LINKED LIST OF POLISH FIXUPS TO LITS (TEMP) BYTEAC: BLOCK 1 ;[777] KEEP ACCUMULATED BYTE SIZE BYTESZ: BLOCK 1 ;[777] TO KEEP CURRENT BYTE SIZE BSHIFT: BLOCK 1 ;[1037] -1 IF DOING B-SHIFT & WITH POLISH EXP BSHFLG: BLOCK 1 ;[1054] -1 IF EVALUATING 2ND ARG TO BSHIFT INBYTE: BLOCK 1 ;[761] -1 IF DOING BYTE & POLISH NOT ALLOWED INIOWD: BLOCK 1 ;[730] -1 WHEN DOING IOWD(NOT IN ANGLE-BRACKETS) INANGL: BLOCK 1 ;-1 WHEN INSIDE ANGLE BRACKETS INASGN: BLOCK 1 ;HOLDS SYMBOL NAME DURING ASSIGN IN CASE NEEDS POLISH INXWD: BLOCK 1 ;[1010] -1 IF DOING XWD LSTOPR: BLOCK 1 ;POINTER TO STORE OP FOR LAST POLISH PINDFL: BLOCK 1 ;[1114] -1 IF SAVING INDIRECTION DURING POLISH INDEXING PLHIDX: BLOCK 1 ;[1114] -1 IF INDEX VALUE SAVED FROM POLIDX FOR OP PIDXVL: BLOCK 1 ;[1114] INDEX VALUE SAVED FROM POLIDX PIDXRC: BLOCK 1 ;[1114] INDEX RELOCATION SAVED FROM POLIDX > SFDADD: BLOCK 3+.SFDLN ;FOR LOOKUP/ENTER OF SFD PATH SFDE==.-1 ;END OF SFD PPPN: BLOCK 1 ;DEFAULT PPN PSFD: BLOCK 3*.SFDLN ;DEFAULT SFD PSFDE==.-1 ;LAST ADDRESS IN SFD BINSFD: BLOCK 3+.SFDLN LSTSFD: BLOCK 3+.SFDLN LITLST: BLOCK 1 ;LIST BINARY IN LITERALS IF NON-0 BLSW: BLOCK 1 ;BINARY LISTING CONTROL SWITCHES NOTFL: BLOCK 1 ;-1 IF NOT FIRST LINE. ;-2 IF LAST LINE. ;0 OR +N FOR CHAR COUNT OF FIRST LINE. IFXLSW: BLOCK 1 ;XLIST IN IF SWITCH INTPGR: BLOCK 1 ;[655] -1 IF INTERNAL PAGE REQUEST XWDANG: BLOCK 1 ;[706] PTR TO LH POL IN SAVCV: BLOCK 1 ;[773] OPERAND VALUE WHEN DOING FORCED POLISH SAVRC: BLOCK 1 ;[773] OPERAND RC WHEN DOING FORCED POLISH XWDLRC: BLOCK 1 ;[773] RELOCATION FOR LEFT HALF OF XWD IN ANGLE BRACKETS XWDLV: BLOCK 1 ;[773] VALUE FOR LEFT HALF OF XWD IN ANGLE BRACKETS XWDRRC: BLOCK 1 ;[773] RELOCATION FOR RIGHT HALF XWDRV: BLOCK 1 ;[773] VALUE FOR RIGHT HALF RELARG: BLOCK 1 ;[721] -1 IF RELOC OR LOC HAS EXPLICIT ARG CPLSAV: BLOCK 1 ;[1003] CRFLG: BLOCK 1 ;[1003] -1 TO REQUEST CRLF AFTER FF MACTAB: BLOCK 1 ;[1033] -1 == OLD FORMAT MACRO ARGS ITABM: BLOCK 1 ;[1033] INCLUDE TABS IN MACRO ARGS IF NON-0 IFSRCH: BLOCK 1 ;[1056] NONZERO IF SEARCH DONE DURING .IF(N) .IFFLG: BLOCK 1 ;[1056] -1 IF EVALUATING .IF(N) ARG .IFNUM: BLOCK 1 ;[1056] -1 IF SAW NUMBER DURING .IF(N) .IFANG: BLOCK 1 ;[1056] -1 IF SAW ANGLE-BRACKETED EXP DURING .IF(N) .IFNAM: BLOCK 1 ;[1112] NON 0 IF WE HAVE A SINGLE RADIX50 NAME DURING .IF(N) POLAD0: BLOCK 1 ;[1060] FIXUP ADDRESS FOR ?MCRPTC POLSY0: BLOCK 1 ;[1060] FIXUP SYMBOL FOR ?MCRPTC POLPS0: BLOCK 1 ;[1060] FIXUP PSECT FOR ?MCRPTC POLERR: BLOCK 1 ;[1060] POLISH BLOCK COUNT FOR ERROR ;[1060] ROUTINE (SEE PCOUTR) CRLFSN: BLOCK 1 ;[1064] -1 IF DON'T NEED CRLF FOR LALL IN SALL IOFLGS: BLOCK 1 ;[1065] LISTING FLAGS TO BE SET AFTER LINE OUTPUT PREFIX: BLOCK 1 ;[1066] PREFIX FOR ERROR MESSAGE (MCRxxx) BYTESW: BLOCK 1 ;[1114] -1 IF DOING BYTE PSEUDO-OP PASS2Z: ;ONLY CLEAR TO HERE ON PRGEND LSTSYM: BLOCK 1 SPAGNO: BLOCK 1 ;PAGE NUMBER FOR SYMBOL TABLES SPAGN.: BLOCK 1 ;PAGE OFFSET STORAGE DURING SYMBOL OUTPUT PASS2X: SUBTTL MULTI-ASSEMBLY STORAGE CELLS SAVEPP: BLOCK 1 ;SAVE P IN CASE NO END STATEMENT SAVEMP: BLOCK 1 ;MACRO PNTR FOR SAME REASON SAVERP: BLOCK 1 ;MACRO READ POINTER LSTPGN: BLOCK 1 ARAYP: BLOCK 1 HDAS: BLOCK 1 IFN CCLSW, CTLBLK: BLOCK 3 CTIBUF: BLOCK 3 CTOBUF: BLOCK 3 IFN TEMP, IFN FORMSW, UNIFLG: BLOCK 1 ;[700] -1 IF UNIERR CTL2SV: BLOCK 1 ;[700] COMMAND LINE CHAR COUNT MRUNV: BLOCK 1 ;[700] -1 IF MEM-RES UNVS IN ASSEMBLY MACSIZ: BLOCK 1 ;INITIAL SIZE OF LOW SEG UNISIZ: BLOCK 1 ;TOP OF BUFFERS AND STACKS UNITOP: BLOCK 1 ;TOP OF UNIVERSAL SYMBOL TABLE UNIVNO: BLOCK 1 ;NUMBER OF UNIVERSALS SEEN UNITBL: BLOCK .UNIV+1 ;TABLE OF UNIVERSAL NAMES UNIPTR: BLOCK .UNIV+1 ;TABLE OF SYMBOL POINTERS UNISHX: BLOCK .UNIV+1 ;TABLE OF SRCHX POINTERS UNVDFA: BLOCK 1 ;DEFAULT ARGUMENT POINTER FOR UNIVERSAL I/O UNVER%: BLOCK 1 ;OLD UNIVERSAL FILE IF -1, MAY HAVE LOST DEFAULT ARGUMENTS UNVPOL: BLOCK 1 ;STORE POLISH PTR, USED TO FIND THE END OF POLISH STACK UNVNPL: BLOCK 1 ;NEW(ADJUSTED) POLISH PTR WHEN READING UNV FILE UWVER: BLOCK 1 ;ACCUMULATE FEATURE BITS FOR WRITING UNV FILE RTIME: BLOCK 1 ;CPU TIME AT START OF PASS1 CPUV: BLOCK 1 ;[775] CPU VALUE MACPRF: BLOCK 1 ;MACRO DEF PREFERRED OVER SYMBOL IF NON-0 PHALVL: BLOCK 1 ;-1 IN PHASE, 0 NOT IN PHASE VAR ;CLEAR VARIABLES IFE FTPSECT, ;[575] JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONE IFN PURESW, END BEG