github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-03 15:12:41 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/macro/macro.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

15301 lines
454 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE MACRO %53B(1247) 29-AUG-86
SUBTTL EDIT BY MCHC/JBC/EGM/MFB/PY/HD/TL
DEFINE COPYRIGHT<
ASCIZ /
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1988. ALL RIGHTS RESERVED.
/> ;[1247]
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1985,1986,1987,1988.
; ALL RIGHTS RESERVED.
;
;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==2 ;DEC UPDATE LEVEL
VEDIT==1247 ;EDIT NUMBER
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
LOC <.JBVER==137>
<VCUSTOM>B2+<VMACRO>B11+<VUPDATE>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,<PURESW==1>
IFNDEF STANSW,<STANSW==0>
IFN STANSW,<CCLSW==1>
IFNDEF LNSSW,<LNSSW==0>
IFNDEF CCLSW,<CCLSW==1>
IFNDEF TEMP,<TEMP==1>
IFNDEF IIISW,<IIISW==0>
IFN IIISW,<
IFNDEF DFRMSW,<DFRMSW==0>>
IFNDEF DFRMSW,<DFRMSW==1>
IFN DFRMSW,<FORMSW==1>
IFNDEF FORMSW,<FORMSW==1>
IFNDEF OPHSH,<OPHSH==0>
IFNDEF KI10,<KI10==1>
IFNDEF KL10,<KL10==1>
IFN KL10,<KI10==1> ;[1214]
IFNDEF POLISH,<POLISH==1>
IFNDEF F40,<F40==0>
IFNDEF TOPS20,<TOPS20==0>
IFNDEF UUOSYM,<UUOSYM==^-TOPS20>
IFNDEF FTPSEC,<FTPSEC==1>
IFN FTPSEC,<POLISH==1>
IFNDEF TSTCD,<TSTCD==0>
;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<CODE> (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 <POLISH SYMBOL> (SIDE EFFECT OF 660)
;706 (22484) MAKE <LH,,POLISH>,<POLISH,,RH>,<POLISH,,POLISH> 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 -<POL>.
;730 GENERATE CORRECT POLISH FOR <IOWD POL,POL>
;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 <E,,K>,<K,,E>, & <E,,E>.
;750 FIX BUG WITH @POL(K).
;751 <POINT K,POL,POL> 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 <POL>
;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
;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 <>,<BAR=5>".
;1024 SOME CLEANUP
;1025 DON'T GO POLISH CALCULATING "REPEAT" COUNT
;1026 FIX BUG CAUSED BY EDIT 1010 ( <POINT K,POL> )
;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 <POLISH>B<EXP> 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==:<B==2>)
;1046 (11716) FIX "ILL MEM REF" TO ADDR 777777 DUE TO BAD MACRO
; CALL SYNTAX
;1047 MAKE EXPRESSIONS OF THE FORM <A##,,POLISH> WHERE POLISH
; IS A POLISH EXPRESSION ASSEMBLE CORRECTLY
;1050 FIX "?MCREPP" ERROR DURING PROCESSING OF EXPRESSIONS
; WITH COMPLEX EXTERNAL LEFT HALVES (E.G., <EXT##+1,,0>)
;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,-<POL> 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".
;Start of Version 53B
;1153 MFB 5-Sep-80 (QAR 3465)
; Fix assignment of: external "operator" assignment
; ( X=B##+<N=N+1>-2 ) to generate correct code.
;1154 MFB 5-Sep-80
; Fix phase errors in literals caused by finding Polish
; in universal files.
;1155 MFB 10-Sep-79
; Set inter-psect reference bit on in IO if switching from
; macro to symbol at EVAS3.
;1156 MFB 17-Sep-80
; Make sure a macro definition is an absolute value.
;1157 MFB 27-Sep-80 SPR 10-28746
; Fix "?MCREPP EXPRESSION PARSING PROBLEM" involving
; ^! (the exclusive or operator) while expanding macros.
;1160 MFB 28-Sep-80
; Get rid of extra <CR><LF> due to XLIST inside a macro under
; SALL (refer to edit 1150).
;1161 MFB 9-Oct-79 SPR 10-28753
; Allow MACRO to write out Polish blocks (block type 11)
; that are more than 18 words long.
;1162 MFB 24-Oct-79 (SPR 10-28820)
; If the maximum number of arguments for a macro definition
; is exceeded, give an error message.
;1163 MFB 1-Nov-79 SPR 20-13664
; Fix bad code generated by Bshift of a relocatable.
;1164 MFB 1-Nov-79
; Fix bad Polish generated by X=<<FOO##+2>B8+17>
;1165 MFB 25-Jan-80 SPR 10-28821
; Allow name: .LOW. to imply the global psect (i.e. .PSECT .LOW.)
;1166 MFB 31-Jan-80 SPR 10-28979
; Fix bad store operator for Polish expression in literal
; that is inside phased code.
;1167 MFB 21-Feb-80
; Edit 1151 broke more than one lit in the last program
; of a PRGENDed file.
;1170 MFB 7-Mar-80
; Reset EXTPNT in STMNT9 in case MACRO cleared it while
; trying to parse the rest of the line. Fixes writing a
; blank symbol name out in a Polish block.
;1171 MFB 7-Mar-80 SPR 20-14030
; Fix phase errors generated by macro call inside a literal
; with created symbol argument missing.
;1172 MFB 14-Mar-80 SPR 10-29346
; Do not generate V errors for forward reference of store
; address for .LINK psuedo-op.
;1173 MFB 24-Mar-80
; Allow KS10 as argument to .DIRECTIVE pseudo-op.
;1174 MFB 2-May-80
; Fix bug with external symbol becoming relocatable after
; specifying .NODDT for that symbol.
;1175 MFB 5-Jun-80
; Make "E" errors only apply to line where error occured
; and not the next binary producing line as well.
;1176 MFB 5-Jun-80
; Reset CTIBUF if TOPS20 version and only an input file
; was specified. (fixes loop at end of pass 1).
;1177 MFB 10-Jun-80 SPR 10-29621
; If in remark, do not change "}","|","{" to strange control char.
;1200 MFB 16-Jul-80 SPR 10-29754
; Assemble statements like: "HRLI (HRRZ ,(15))" correctly.
; Broken by edit 1113.
;1201 PY 4-Sep-80 SPR 10-29907
; Flag error when symbol is referenced as external in universal
; file but local in program.
;1202 PY 30-Sep-80
; Change revision history, starting with version 53B. Add
; date of edit, author's initials, and 10- or 20- to SPR
; number. Also change history to lower case.
;1203 PY 1-Oct-80 SPR 10-30018
; Remove edit 653, as it is possible to generate UNV files
; with synonyms that do not have VARF set.
;1204 PY 2-Oct-80 SPR 10-29908, 10-30021
; Test for inter-PSECT references involving special pointers
; with additive fixups that will not go Polish. These consist
; of LEFT,,0 where LEFT is non-zero.
;1205 PY 3-Oct-80 SPR 10-30043
; If processing the END statement, and the start address label
; has the same name as a macro, do not incorrectly set the
; inter-PSECT reference bit. Broken by Edit 1155.
;1206 PY 14-Oct-80 SPR 10-30104
; MCROBL message is printed instead of MCROQE error, prefix
; is printed as garbage.
;1207 PY 16-Oct-80 SPR 10-30103
; Fix skewed listing when BYTE or SIXBIT psuedo-ops are used
; in Psected programs.
;1210 PY 5-Nov-80 SPR 20-15019
; Do not clobber the size of an ARRAY during pass 1 if the array
; is being made INTERNAL.
;1211 PY 4-Feb-81 SPR 10-30309
; Remove code which does not allow semicolons or CRLFs in some
; failing conditionals.
;1212 PY 11-Feb-81 SPR 20-15625
; Fix handling of constants to give Q error in more cases
; of integer overflow. Also fix code so that floating point
; numbers will not get erroneous Q errors when the part before
; the decimal point is too large to fit in an integer.
;1213 PY 17-Feb-81
; Fix edit 1204 so that special pointers with zero fixups will
; always be copied. The only fixup that should not be copied
; is one which has a non-zero right half. This is because it
; is legal to say SKIPE ABC where ABC is a special pointer with
; a zero addition and this case will not go Polish.
;1214 PY 24-Mar-81 SPR 10-30814
; An incorrect feature test flag could allow KL symbols
; to be defined without KI symbols being defined.
;1215 PY 27-Apr-81
; If a fullword expression containing an external is in
; angle brackets it will go polish on pass 2. Therefore,
; do not fold it if it is in a literal in pass 1.
;1216 PY 1-Sep-81
; Make DEFINE A(B,,C) take a more severe error, so that
; the universal file writer will not be confused by a bad
; definition.
;1217 EGM/PY 27-Jan-81 SPR 20-17083
; Change the way negation is done to fix cases such as
; <-.> and negation of relocatables in general.
;1220 EGM 3-Feb-82 10-31828
; Eliminate large number of causes of ?Ill mem refs for address 777777.
; Convert fake Polish relocations back to listing flags at proper points.
;1221 EGM 3-Feb-82
; Flag cases of bad Polish fixup chains with E errors.
;1222 EGM 3-Feb-82
; Add code to report pass 1 only Polish as a new type of undefined
; variable, which is declared as external at the end of pass 2.
;1223 EGM 4-Feb-82
; Eliminate longstanding bogus E error for BYTE (18) EXT##.
;1224 EGM 4-Feb-82
; Allow use of Variables/VAR with PSECTs. Broken by edit 602.
;1225 EGM 4-Feb-82
; Prevent Polish data on temporary stack from being destroyed during
; complex expression evaluation.
;1226 EGM 15-Feb-82
; Alter type 2 .REL block symbol codes for partially defined globals to
; eliminate confusion at LINK time. Right half deferred = 24 (same),
; left half deferred = 30 (new), both halves deferred = 34 (new).
; Also eliminate extra bit (04) in second symbol bits for 60/50, 60/70
; pairs, to conform to documentation. Requires LINK edit 1330.
;1227 EGM 17-Feb-82
; Eliminate bad .REL files for left half Polish in OPDEFs and assignments
; that are not enclosed in angle brackets. Also correct edit 767 to catch
; relocatable left halves with Polish right halves.
;1230 PY 16-Feb-82
; Allow expressions of the form A=B##,,0 in UNIVERSAL files.
; This edit supercedes edit 1201.
;1231 EGM 18-Feb-82
; Eliminate spurious listing header to TTY:, and wrong elapsed times
; during PRGEND processing (edit 1141). Also cleanup edit 1146.
;1232 PY 17-Jun-82
; Allow assignments or opdefs before .COMMON statements.
;1233 PY 12-Jul-82
; Fix typo in edit 1222.
;1234 EGM 28-Sep-82 SPR:10-32977
; Finish up job started by 1113/1147 treating OPDEFs at all levels
; in a consistent manner. Re-instate useful deviation from documented
; behavior that essentially causes entry into an angle-bracketed
; expression to revert to opcode field processing to allow
; processing Opcodes/OPDEFs as operators and not symbols.
;1235 PY 30-Sep-82 SPR 20-18269
; Allow PSECT origins to be greater than 18 bits.
;1236 PY 8-Dec-82 SPR 10-33238
; Add G-floating instructions, XMOVEI, and XHLLI.
;1237 PY 26-Apr-83 SPR 10-33691
; Fix typo in edit 1236
;1240 PY 10-May-83
; Fix external in END statement. Broken by edit 1234.
;1241 PY 27-May-83 SPR 20-19194
; Dont increment count twice for psect indices when counting
; for long polish blocks.
;1242 PY 3-Aug-83 SPR 20-19096
; Fix problem with CREFing psected programs. Don't use
; DEFCRS when updating a symbol, since the cref code turns
; it off.
;1243 HD 22-Feb-85 SPR 10-35085
; IOWD constant,external will go polish on pass 2, therefore don't
; fold it in if it is in a litteral, during pass 1.
;1244 HD 13-Nov-85 SPR 20-20963
; Flag LOC value greater than 18 bits as an error.
;1245 TL 23-Aug-86 Abott/7.03 monitor
; EXTER5 call on SSRCH could find a MACRO definition in another PSECT,
; resulting in new EXTERNAL symbol being placed in the wrong PSECT's
; symbol table. Look only in current PSECT.
;1246 TL 29-Aug-86 DPM
; Add PMOVE and PMOVEM opcodes to the PST.
;1247 RJF 10-Feb-88
; Update copyright to 1988, and make sure the copyright
; gets into the .EXE file.
;*****End of Revision History*****
SUBTTL OTHER PARAMETERS
.PDP==^D100 ;BASIC PUSH-DOWN POINTER
IFN POLISH,<.PDP==^D250> ;BE GENEROUS WITH STACK
IFNDEF LPTWID,<LPTWID==^D132> ;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/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,<IFNDEF CTLSIZ,<CTLSIZ==^D1000>> ;[1036]
IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>
IFNDEF NUMBUF,<NUMBUF==5> ;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,<TWOSEGMENTS
RELOC 400000>
COPYRIGHT ;[1247] PUT COPYRIGHT IN .EXE FILE
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
P1PF==UNDF+PNTF+EXTF+MDFF ;[1222] PASS1 ONLY POLISH
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==^-<UALL-UPOL>> ;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
SETZM EXTPNT ;[1175] DO NOT PROPAGATE E ERRORS
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
>
JUMPL RC,STMN9A ;[1170] IF ALREADY POLISH, SKIP THIS
TDNN RC,[-2,,-2] ;[1170] ANY EXTERNALS?
JRST STMN9A ;[1170] NO
SKIPE EXTPNT ;[1170] EXTPNT ALREADY SET UP?
JRST STMN9A ;[1170] YES
TRNE RC,-2 ;[1170] NO, IF RIGHT HALF EXTERNAL
HRRM RC,EXTPNT ;[1170] RESET VALUE OF EXTPNT
TLNE RC,-2 ;[1170] DO THE SAME FOR THE LEFT HALF
HLLM RC,EXTPNT ;[1170]
STMN9A: TLO IO,FLDSW ;[1170][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 <ARG>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 <EXP>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]
CAIN RC,1 ;[1163] IS IT RELOCATABLE?
MOVEM AC0,SAVCV ;[1163] YES, SAVE CURRENT VALUE
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
CAIE RC,1 ;[1163] IS IT RELOCATABLE?
JRST ATOM3A ;[1163] NO, SKIP THIS
MOVEM RC,SAVRC ;[1163] YES, SAVE RC
SETZ RC, ;[1163] AND CLEAR IT
CALL FORCPP ;[1163] FORCE IT TO GO POLISH
SKIPA ;[1163] SKIP THE CALL TO FORCEP
ATOM3A: CALL FORCEP ;[1163][1037] POLISH OF <RC>_<AC>
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
SKIPN RC ;[1217] IS IT RELOCATABLE?
TLZN FR,NEGSW ;[1217] 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, <EXT##>B35,
;100B<EXT##>, 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
SKIPE PHALVL ;[1166] INSIDE PHASED CODE?
JRST [MOVE CS,LITHDX ;[1166] YES, GET PTR TO BLOCK INFO
PUSH P,-2(CS) ;[1166] GET MODO & LOCO OF LITERAL ADDR
HLRZ RC,0(P) ;[1166] SET UP THE RELOCATION
POP P,AC0 ;[1166] AND THE LOCATION
HRRZS AC0 ;[1166]
JRST .+1] ;[1166]
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
AOJ CS, ;[1161] SKIP OVER COUNT
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
SKIPE PHALVL ;[1166] INSIDE PHASED CODE?
JRST [MOVE CS,LITHDX ;[1166] YES, RETURN ORIGINAL VALUES
HRRZ AC0,-1(CS) ;[1166] OF AC0 AND RC
HLRZ RC,-1(CS) ;[1166]
JRST .+1] ;[1166]
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
TLZ IO,FLDSW ;[1234] ALLOW OPCODE PROCESSING AGAIN
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
PUSH P,INASGN ;[1153] SAVE ORIGINAL VALUES OF INASGN
PUSH P,EXTPNT ;[1153] AND EXTPNT AROUND CALL TO ASSIG1
CALL ASSIG1
POP P,EXTPNT ;[1153] RESTORE THE VALUES OF EXTPNT
POP P,INASGN ;[1153] AND INASGN
MOVE AC0,V
JRST ANGLB2
ANGLB1: CALL EVALHA
ANGLB2: POP P,FR
IFN POLISH,<
JUMP1 [TDNN RC,[-2,,-2] ;[1215] CHECK FOR EXTERNAL
JRST ANGLB4 ;[1215] BECAUSE IT WILL GO POLISH
SKIPE LITLVL ;[1215] IF IN LITERAL
TRO ER,ERRF ;[1215] PREVENT FOLDING IN PASS 1
JRST ANGLB4] ;[1215] SINCE IT CANNOT FOLD IN PASS 2
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
; ----- -- ------ ------
; <POL> 0 0 POL
; INXWD/0 DIFFERENCIATE FROM <0,,POL>
; <POL1,,POL2> 0,,0 POL1 POL2
; <POL1,,POL1> 0,,0 POL1 POL1
; XWDRRC/POL1 TO DIFFERENTCIATE FROM <POL1,,0>
; <POL1,,EXT> 0,,EXT POL1 POL1
; <POL1,,K> 0,,0 POL1 POL1
; <POL1,,REL> 0,,1 POL1 POL1
; <EXT,,POL2> EXT,,0 0 POL2
; <K,,POL2> 0,,0 0 POL2
; <REL,,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 <POL,,..>?
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 <POL,,POL> 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 <POL1,,POL2> 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:
;
; <EXT1,,EXT2>
; <EXT1,,K> <K,,EXT2>
; <EXT1,,REL> <REL,,EXT2>
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?
HRROS AC2 ;[1212] YES, WARN USER IF INTEGER
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
TLZE AC1,400000 ;[1212] DID THE ADD OVERFLOW?
AOS AC0 ;[1212] YES, CARRY INTO AC0
TLZN AC2,-1 ;[1212] WAS THERE AN OVERFLOW
TDNE AC0,[777777,,777776] ;[1212] OR MORE THAN 36 BITS?
TRO ER,ERRQ ;[1212] YES, WARN USER
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?
NUM11: MOVE AC0,AC1 ;[1212] SCALE THE NUMBER
MUL AC0,CURADX ;[613]
TDNE AC0,[777777,,777776] ;[1212] MORE THAN 36 BITS?
TRO ER,ERRQ ;[1212] YES, WARN USER
SOJG CS,NUM11 ;[1212] REPEAT
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: HRRZS AC2 ;[1212] RESET POSSIBLE INTEGER OVERFLOW
CAIE C,'B' ;[1212] 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 <EXP>
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
TRNN FRR,NOPSW ;[1240] CHECK FOR POLISH NOT ALLOWED
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]
SKIPN INASGN ;[1227] DOING ASSIGNMENT?
SKIPE INOPDF ;[1227] OR OPDEF?
JRST EVALC4 ;[1227] YES - NOTHING STORED YET
MOVNI AC2,2 ;CHANGE THIS TO LEFT HALF
MOVEM AC2,@LSTOPR
EVALC4:>
IFN FORMSW,<PUSH P,INFORM> ;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 ;[1217] 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 [TLO IO,FLDSW ;[1234] NO, NOW IN ADDRESS FIELD
JRST EVAS2] ;[1234] 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
PUSH P,SX ;[1155] SAVE SX ON STACK
HRRZ SX,SGNCUR ;[1205] GET CURRENT PSECT NUMBER
CAMN SX,SGWFND ;[1155] SYMBOL FOUND IN CURRENT PSECT?
JRST EVAS3A ;[1155] YES, CONTINUE
TLNE ARG,LELF!RELF ;[1155] NO, RELOCATION BITS ON?
TLO IO,RSASSW ;[1155] YES, SET INTER-PSECT REF BIT
EVAS3A: POP P,SX ;[1155] RESTORE SX
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: TRNE FRR,IDXSW ;[1200] ARE WE IN THE INDEX FIELD?
JRST EVOPD1 ;[1200] YES, SKIP THIS TEST
JUMPCM .+3 ;[1113] TERMINATED WITH COMMA OR
TLNN IO,FLDSW ;[1113] PART OF ADDRESS FIELD OR
EVOPD1: TLNE CS,(17B5) ;[1200] 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
IFN POLISH,< ;[1220]
TLNN FR,P1 ;[1220] SKIP IF PASS 1
CALL DSTWRC ;[1220] FIX POLISH RELOCATION
>; END IFN POLISH ;[1220]
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
TLO IO,FLDSW ;[1234] DEFAULT TO ADDRESS FIELD
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
EVGETD: TLNN FR,NEGSW ;[1217] NEGATIVE ATOM?
JRST EVGETP ;NO
IFN POLISH,< JUMPN RC,NEGEXT> ;UNARY MINUS, JUMP IF NOT ABS
CALL GETDE2 ;NO, JUST NEGATE
EVGETP: TLNE IO,NUMSW ;[1217] 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?
JUMPA POLPOP ;[1154][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
JUMPE MRP,EVUPA1 ;[1157] IF IN A MACRO
PUSH P,CS ;[1157] SAVE CS ON THE STACK
CALL MREAD ;BETTER DO THIS
POP P,CS ;[1157] RESTORE CS
EVUPA1: SUBI C,40 ;[1157] 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: ;[1225]
IFN POLISH,< ;[1225]
TLNE FR,POLSW ;[1225] GONE POLISH?
CALL MOVSTK ;[1225] PROTECT TEMP POLISH STACK
>; END IFN POLISH ;[1225]
PUSH P,PS ;[1225] 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,<CALL EVXERR> ;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,<CALL EVXERR> ;14-17; JUST IN CASE
EVXCTP: XCT EVPTAB(PS) ;[1222] MARK PASS1 POLISH RELOCATIONS
JRST EVXCT1 ;[1222] OR CONTINUE WITH NORMAL OPERATION
EVPTAB: ;[1222]
REPEAT 3,< JFCL ;[1222] 0-2;>
JRST XPADD ;[1222] 3; ADD
JRST XPSUB ;[1222] 4; SUB
REPEAT 5,<JFCL ;[1222] 5-11;>
JRST XPSET ;[1222] 12; NEGATE
JFCL ;[1222] 13; ADDITIVE PSECT OPERATION
REPEAT 4,<JFCL ;[1222] 14-17;>
XPADD: JUMPE RC,EVXCT1 ;[1222] CURR RELOC ABS - ADD OK
JUMPE PR,EVXCT1 ;[1222] PREV RELOC ABS - ADD OK
TRNE RC,-1 ;[1222] CURR RELOC ?,,ABS
JRST XPADD1 ;[1222] NO - CHECK OTHERS
TLNN PR,-1 ;[1222] AND PREV RELOC ABS,,?
JRST EVXCT1 ;[1222] YES - ADDITIVE OK
XPADD1: TLNE RC,-1 ;[1222] CURR RELOC ABS,,?
JRST XPSET ;[1222] NO - POLISH
TRNN PR,-1 ;[1222] AND PREV RELOC ?,,ABS
JRST EVXCT1 ;[1222] YES - ADDITIVE OK
JRST XPSET ;[1222] GO POLISH
XPSUB: JUMPE RC,EVXCT1 ;[1222] CURR RELOC ABS - SUB OK
CAIE RC,1 ;[1222] CURR RELOC ABS,,REL
JRST XPSUB1 ;[1222] NO - CHECK MORE
CAIN RC,(PR) ;[1222] AND PREV RELOC ?,,REL
JRST EVXCT1 ;[1222] YES - SUBTRACTIVE OK
XPSUB1: MOVSS RC ;[1222] FLIP CURR RELOC
MOVSS PR ;[1222] FLOP PREV RELOC
CAIE RC,1 ;[1222] CURR RELOC REL,,ABS
JRST XPSUB2 ;[1222] NO - CHECK OTHER
CAIN RC,(PR) ;[1222] AND PREV RELOC REL,,?
MOVSS RC ;[1222] YES - FLIP BACK CURR RELOC
MOVSS PR ;[1222] AND PREV RELOC
JRST EVXCT1 ;[1222] SUBTRACTIVE OK
XPSUB2: CAME RC,[1,,1] ;[1233] CURR RELOC REL,,REL
JRST XPSET ;[1222] NO - POLISH
CAMN RC,PR ;[1222] AND PREV RELOC REL,,REL
JRST EVXCT1 ;[1222] YES - SUBTRACTIVE OK
XPSET: SETZB CV,PV ;[1222] PASS 1 POLISH - VALUES WORTHLESS
SETZ PR, ;[1222] AS IS PREV RELOC
MOVEI RC,377777 ;[1222] IMPOSSIBLE CURRENT RELOC
HRRM RC,EXTPNT ;[1222] AND EXTERNAL VALUES
JRST EVNUM ;[1222]
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 EVXCTP] ;[1222] NO POLISH
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: JUMP1 [ SKIPE LITLVL ;[1154] INSIDE A LITERAL?
TRO ER,ERRF ;[1154] YES, PREVENT COLLAPSING
RET] ;[1154]
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 BSHIFT ;[1164] DOING BSHIFT?
RET ;[1164] YES, JUST RETURN
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
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: PUSH P,MWP ;[1161] SAVE MWP ON THE STACK
SETZ MWP, ;[1161] AND CLEAR IT
MOVE PV,FREE ;GET NEXT FREE LOCATION
EXCH PV,POLIST ;SWAP STACK POINTER
CALL POLSTR ;STORE POINTER TO NEXT POLISH BLOCK
SETO PV, ;[1161] SET PV TO ONES
CALL POLSTR ;[1161] STORE PV AS PLACE HOLDER FOR COUNT OF WORDS NEEDED
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
ADDI MWP,2 ;[1161] ADD 2 TO COUNT FOR STORE OP
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
AOJ MWP, ;[1161] INCREMENT COUNT OF WORDS NEEDED
ASH MWP,-1 ;[1161] DIVIDE BY TWO
PUSH P,AC0 ;[1161] SAVE AC0 ON THE STACK
MOVEI AC0,@POLIST ;[1161] GET STARTING ADDRESS OF THE POLISH
AOJ AC0, ;[1161] WE WANT THE SECOND WORD OF THE POLISH
MOVEM MWP,@AC0 ;[1161] STORE THE COUNT HERE
POP P,AC0 ;[1161] RESTORE AC0
POP P,MWP ;[1161] RESTORE MWP
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
CALL POLSTR ;[1161] STORE RELOCATION AND MODE
SETZB RC,CV ;[1161] USE ZERO VALUE AND RELOCATION
JRST POLAS1 ;[1161] GO RESET POLISH POINTER
POLPOR: CALL POLSTR
SETZB RC,CV ;USE ZERO VALUE AND RELOCATION
POLRET: MOVE PV,POLPTR ;RESET INITIAL POLISH POINTER
MOVEM PV,POLSTK
AOJ MWP, ;[1161] INCREMENT COUNT OF WORDS NEEDED
ASH MWP,-1 ;[1161] DIVIDE BY TWO
PUSH P,AC0 ;[1161] SAVE AC0 ON THE STACK
MOVEI AC0,@POLIST ;[1161] GET STARTING ADDRESS OF THE POLISH
AOJ AC0, ;[1161] WE WANT THE SECOND WORD OF THE POLISH
MOVEM MWP,@AC0 ;[1161] STORE THE COUNT HERE
POP P,AC0 ;[1161] RESTORE AC0
POP P,MWP ;[1161] RESTORE MWP
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
ADDI MWP,5 ;[1161] ADD 5 TO COUNT FOR SYMBOL FIXUP
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
POLAS1: MOVE PV,POLPTR ;[1161] RESET INITIAL POLISH POINTER
MOVEM PV,POLSTK ;[1161]
RET ;[1161]
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,POLPTR ;[1225] GET ORIGIN OF STACK
CAMN AC1,SDEL ;[1225] ANY CHANGE?
JRST MOVNOT ;[1225] NO - GET OUT
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
AOJ MWP, ;[1161] INCR COUNT FOR PSECT INDEX
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
CAIE PV,15 ;[1241] IS IT PSECT (NOT REAL OP?)
AOJ MWP, ;[1161] INCR COUNT FOR OP
CAIGE PV,-6 ;[1161] STORE OP?
JRST POLOPA ;[1161] NO
CAIGE PV,-3 ;[1161] SYMBOL FIXUP?
ADDI PV,3 ;[1161] ITS A SYMBOL FIXUP, ADD 3 THEN ADD 1
AOJ MWP, ;[1161] ADD ONE FOR STORE OP
POLOPA: XCT OPRTBL-3(PV) ;[1161]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
AOJ MWP, ;[1161] INCR COUNT FOR PSECT INDEX
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]
AOJ MWP, ;[1161] INCR COUNT FOR OPERATOR
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
ADDI MWP,2 ;[1161] ADD 2 TO COUNT FOR 0 AND HALF WORD
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
ADDI MWP,3 ;[1161] ADD 3 TO COUNT FOR 1 AND FULL WORD 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
ADDI MWP,3 ;[1161] ADD 3 TO COUNT FOR 2 AND SYMBOL
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
AOJ MWP, ;[1161] INCR COUNT FOR OPERATOR
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]
AOJ MWP, ;[1161] INCR COUNT FOR OPERATOR
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
ADDI MWP,2 ;[1161] ADD 2 TO COUNT FOR 0 AND HALF WORD VALUE
JRST POLSTR ;STORE AND EXIT
POLSNN: HRROI PV,14 ;TWO'S COMPLIMENT NEGATIVE
AOJ MWP, ;[1161] INCR COUNT FOR OPERATOR
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
ADDI MWP,3 ;[1161] ADD 3 TO COUNT FOR 1 AND FULL WORD 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,<CALL EVXERR> ;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,<
HRRZ AC0,RC ;[1222] RIGHT RELOC
CAIN AC0,377777 ;[1222] PASS1 ONLY POLISH?
JRST STOL2P ;[1222] YES - USE FAKE RC
HLRZ AC0,RC ;[1222] LEFT RELOC
CAIN AC0,377777 ;[1222] PASS1 ONLY POLISH?
JRST STOL2P ;[1222] YES - FAKE RC
JUMPN RC,STOL25 ;[1031] JUMP IF NOT ABS
TRNN ER,ERRF ;[1031] FAKE ERROR FOR POLISH?
JRST STOL25 ;[1031] NO, JUMP
STOL2P: MOVSI AC0,(1B0) ;[1222][1031] 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
SKIPE INRMRK ;[1177] COME FROM REMAR0?
JRST GETCHR+1 ;[1177] YES, DO NOT COMPLAIN
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 <CR> 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)
<BYTE (6)OPLVL (9)ATOM (3)AN (6)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 IO,IOMAC ;[1160] HAS LINE ALREADY BEEN LISTED?
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,<MOVE CS,[POINT 7,TABI]
MOVSS HWFMT ;PUT FLAG IN LEFT HALF
SKIPGE HWFMT> ;BUT IF ONLY HALF-WORD FORMAT
MOVE CS,[POINT 7,TABI,6]
MOVEM CS,TABP
MOVEI CS,.CPL
IFN FORMSW,<SKIPL HWFMT ;IF MULTI-FORMAT
SUBI CS,8 ;LINE IS ONE TAB SHORTER
MOVSS HWFMT> ;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
TRNE ARG,PNTF ;[1222] PNTF SET ON PASS1?
RET ;[1222] YES - RECYCLE
UOUT0: TRNE ARG,UNDF ;[1222][735] UNDEFINED
JRST UOUT0A ;[1222] YES - CHECK FURTHER
IFN POLISH,< ;[1222]
JUMP1 UOUT16 ;[1222] MARK PASS1 POLISH AS UNDEFINED
>; END IFN POLISH ;[1222]
RET ;[1222] PASS2 AND DEFINED - NEXT
UOUT0A: JUMP2 UOUT10 ;[1222]
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@/]
TRC ARG,P1PF ;[1222] BUT IS IT PASS 1 POLISH?
TRCN ARG,P1PF ;[1222] INSTEAD OF REGULAR UNDEFINED?
MOVEI CS,[SIXBIT /NOT FULLY DEFINED IN PASS 1, DEFINED AS IF EXTERNAL@/] ;[1222] YES
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]
IFN POLISH,< ;[1222]
UOUT16: TRNN ARG,SYMF!OPDF ;[1222] SYMBOL OR OPDEF?
RET ;[1222] NO - NEXT
HLRZ CS,RC ;[1222] GET LEFT HAND RELOC
CAIN CS,377777 ;[1222] PASS1 ONLY POLISH?
JRST UOUT17 ;[1222] YES - CONVERT TO UNDEFINED
HRRZ CS,RC ;[1222] RIGHT HAND RELOC
CAIE CS,377777 ;[1222] PASS1 POLISH?
RET ;[1222] NO - NEXT SYMBOL
UOUT17: MOVSI ARG,SPTR ;[1222] CLEAR SPECIAL POINTER
ANDCAM ARG,(SX) ;[1222] FROM SYMBOL TABLE
MOVSI ARG,P1PF ;[1222] MARK AS PASS1 ONLY POLISH
IORM ARG,(SX) ;[1222] UNDF+PNTF+EXTF+MDFF
HRRZ AC1,(SX) ;[1222] NEW POINTER TO EXTERNAL VALUE
MOVE ARG,-1(SX) ;[1222] GET SYMBOL NAME
MOVEM ARG,1(AC1) ;[1222] STORE FOR GLOBAL FIXUPS
SETZM (AC1) ;[1222] ZERO COUNT
RET ;[1222] NEXT SYMBOL
>; END IFN POLISH ;[1222]
;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,SOUT11 ;[1226] IF POLISH, ONLY SET RHS FIXUP FLAG
>; END IFN POLISH ;[1226]
TLNE RC,-2 ;[1226] LEFT HALF FIXUP?
IORI AC1,30 ;[1226] SET NEW BITS
SOUT11: TRNE RC,-2 ;[1226] RIGHT HALF FIXUP?
IORI AC1,24 ;[1226] YES - NEW 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,UNDF ;[1226] UNDEFINED?
JRST [HRRI MRP,2 ;[1226] YES - PICK OFFSET
JRST SOUT16] ;[1226] SKIP AHEAD
JUMPN AC1,[TRNE ARG,NOOUTF ;[1226] INTERN=EXTERN - CHECK DDT SUPPRESS
IORI AC1,40 ;[1226] SET ONE MORE BIT
JRST SOUT17] ;[1226] AND FORGET TABLE BITS
TRNE ARG,ENTF ;ENTRY DMN
HRRI MRP,-5
TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW
JRST [PUSH P,MRP ;[1174] SAVE WHAT WE HAVE SO FAR
ADDI MRP,3 ;[1174] YES WFW
HLL MRP,0(P) ;[1174] GET THE RELOC BITS BACK
POP P,0(P) ;[1174] GET JUNK OFF THE STACK
JRST .+1] ;[1174] AND CONTINUE
SOUT16: IOR AC1,SOUTC(MRP) ;[1226] GET BITS FROM TABLE
SOUT17: MOVE ARG,AC1 ;[1226] MOVE BITS FOR SQUOZE
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,240000 ;[1226] 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
TLZ AC0,040000 ;[1226] CLEAR EXTRA BIT
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
>
<ASCII /ent/>!04 ;DMN
0
<ASCII /udf/>!60 ;UNDEFINED EXTERNAL
<ASCII /sen/>!44 ;SUPRESSED ENTRY
<ASCII /ext/>!60
SOUTC: EXP 10
<ASCII /int/>!04
<ASCII /sex/>!60 ;SUPPRESSED EXTERNAL (NOT USED YET)
<ASCII /spd/>!50
<ASCII /sin/>!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,<
CALL DSTWRC ;[1220] FIX POLISH RELOCATION
JUMPL RC,[SETZ RC, ;[1220] CLEAR IF STILL POLISH
TRO FRR,FWPSW ;[1220] MUST BE FULLWORD
JRST .+1] ;[1220]
TRNE FRR,LHPSW!RHPSW!FWPSW ;[1220] LISTING TO SHOW POLISH?
TLO FR,POLSW ;[1220] YES
TRNE FRR,FWPSW ;[1220] FULLWORD MEANS
TRO FRR,LHPSW!RHPSW ;[1220] BOTH HALFWORDS
>
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
IFN FTPSECT,< ;[1207]
SKIPE SGNMAX ;[1207] LISTING WITH PSECTS?
MOVEI C,3 ;[1207] YES - ACCOUNT FOR EXTRA CHARACTERS
> ;[1207]
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,^D24 ;[1207]
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
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
IFN FTPSECT,< ;[1207]
SKIPE SGNMAX ;[1207] LISTING PSECTS?
IBP TABP ;[1207] YES, AVOID TAB
> ;[1207]
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
AOJ CS, ;[1161] POINT TO THE WORD COUNT
MOVE AC0,(CS) ;[1161] GET IT
MOVEM AC0,POLWRD ;[1161] SAVE IT IN POLWRD
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
REPEAT 0,< ;[1161]
SKIPE POLERR ;[1161][1060] PROCESSING ERROR?
CALL [MOVEI C,POLLIM ;[1161][1060] YES, FORCE TERMINATION IN
MOVEM C,POLERR ;[1161][1060] CASE WE HAVE GARBAGE
PJRST POLER4] ;[1161][1060] GIVE MESSAGE AND RETURN
> ;[1161]
POUTQ1: TLZ FR,POLSW ;[1060] CLEAR FLAG IN CASE END
SETZM POLAD0 ;[1060] CLEAR ERROR INFO
SETZM POLSY0 ;[1060]
SKIPLE POLWRD ;[1161] HAVE WE WRITTEN MORE THAN 18 WORDS?
JRST POUTQ2 ;[1161] NO
AOS COUTX ;[1161] YES, INCR COUTX
CALL COUTT1 ;[1161] WRITE THE REST OF THE POLISH
POUTQ2: SETZM POLWRD ;[1161] CLEAR THE POLISH COUNT
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
POLTST: SKIPLE POLWRD ;[1161] HAVE WE WRITTEN THE FIRST 18 WORDS?
JRST POLT1 ;[1161] NO
AOS COUTX ;[1161] YES, INCR COUTX
CALL COUTT1 ;[1161] WRITE SOME POLISH
SETZ C, ;[1161] CLEAR C
RET ;[1161] RETURN
POLT1: HRRZ C,POLWRD ;[1161] GET THE WORD COUNT INTO C
AOS COUTX ;[1161] INCR COUTX
CAIE C,22 ;[1161] WRITING OUT EXACTLY 22 WORDS?
SETOM POLWRD ;[1161] WE HAVE WRITTEN THE FIRST 18 WORDS
CALL COUTD1 ;[1161] WRITE THE AND SOME POLISH
SETZ C, ;[1161] CLEAR C
RET ;[1161] RETURN
REPEAT 0,< ;[1161]
;[1161]HERE TO GIVE BEST ERROR MESSAGE POSSIBLE FOR POLISH BLOCK
;[1161]EXCEEDING 18 WORDS (OR CURRENT LIMIT)
POLLIM==1 ;[1161][1060] THIS VALUE DENOTES THE NUMBER OF 18-WORD
;[1161][1060] BLOCKS (BEYOND THE FIRST) WE ARE WILLING
;[1161][1060] TO PERUSE FOR A FIXUP TYPE;
;[1161][1060] CAN BE CHANGED FOR DEBUGGING PURPOSES.
POLER4: SKIPN POLERR ;[1161][1066] FIRST TIME THROUGH?
JRST [PUSH P,['MCRPTC'] ;[1161][1066] YES, SET PREFIX
POP P,PREFIX ;[1161][1066]
SETZ RC, ;[1161][1066] ZERO RC FOR TEST AFTER CALL
PUSH P,CS ;[1161][1066] SAVE PTR TO LIST
CALL EFATAL ;[1161][1066] FATAL ERROR
POP P,CS ;[1161][1066] RESTORE CS
CAMN RC,[-1] ;[1161][1066] TEXT TO BE SUPPRESSED?
PJRST POLER6 ;[1161][1066] YES, GIVE CRLF AND EXIT
JRST .+1] ;[1161][1066] NO, CONTINUE
SKIPE POLAD0 ;[1161][1060] LOCATION FIXUP?
JRST POLER1 ;[1161][1060] YES, GIVE APPROPRIATE MESSAGE
SKIPE POLSY0 ;[1161][1060] SYMBOL FIXUP?
JRST POLER2 ;[1161][1060] GIVE APPROPRIATE MESSAGE
MOVE C,POLERR ;[1161][1060] WE DON'T KNOW FIXUP TYPE YET,
CAIL C,POLLIM ;[1161][1060] CAN WE LOOK FURTHER?
JRST POLER5 ;[1161][1060] NO, GIVE UP
AOS POLERR ;[1161][1060] YES, INITIALIZE FOR NEXT BLOCK
PJRST COUTI ;[1161][1060] AND LOOK FOR FIXUP TYPE
POLER5: HRROI RC,[SIXBIT / POLISH TOO COMPLEX@/] ;[1161][1066][1060]
CALL TYPMSG ;[1161]PRINT MESSAGE
POLER0: SUB P,[1,,1] ;[1161][1060][654] ADJUST STACK POINTER AND
SETZM POLERR ;[1161][1060] CLEAR ERROR-PROCESSING COUNT
SETOM COUTX ;[1161][1060] RE-INIT WORD COUNT
JRST POUTQ1 ;[1161][1060] FORGET ABOUT THIS BLOCK
POLER1: HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR LOCATION@/] ;[1161][1066]
CALL TYPM2 ;[1161][1060]
HRRZ AC0,POLAD0 ;[1161][1060] TYPE OUT ADDRESS
CALL TYPOCT ;[1161][1060]
HLRZ C,POLAD0 ;[1161][1060] GET RELOCATION
CAIN C,1 ;[1161][1060] APPEND "'" IF NECESSARY
CALL [MOVEI C,"'" ;[1161][1060]
CALL TYO ;[1161][1060]
MOVE AC0,POLPS0 ;[1161][1060] APPEND PSECT INDEX IF
JUMPE AC0,CPOPJ ;[1161][1060] NECESSARY
CAIL AC0,10 ;[1161][1060]
PJRST TYPOCT ;[1161][1060]
MOVEI C,"0" ;[1161][1060]
CALL TYO ;[1161][1060]
MOVE C,POLPS0 ;[1161][1060]
ADDI C,"0" ;[1161][1060]
PJRST TYO] ;[1161][1060]
POLER6: CALL CRLF ;[1161][1066][1060] AND CRLF
JRST POLER0 ;[1161][1060] COMMON EXIT
DEFINE R50CHR(CHR),<IRPC CHR,<"CHR"-40 ;[1161]
>> ;[1161]
R50TAB: R50CHR( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% ) ;[1161]
POLER2: HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR SYMBOL@/] ;[1161][1066]
CALL TYPM2 ;[1161][1060]
MOVE C,POLSY0 ;[1161][1060] GET RADIX-50 OF SYMBOL
TLZ C,740000 ;[1161][1060] CLEAR 4-BIT SYMBOL CODE
SETZ RC, ;[1161][1060] CLEAR RELOCATION
MOVEI AC0,5 ;[1161][1060] SET ITERATION COUNT
POLER3: IDIVI C,50 ;[1161][1060] CONVERT TO SIXBIT
SKIPE CS,R50TAB(CS) ;[1161][1060]
LSHC CS,-6 ;[1161][1060]
CAILE C,50 ;[1161][1060]
SOJG AC0,POLER3 ;[1161][1060] LOOP BACK IF MORE
SKIPE CS,R50TAB(C) ;[1161][1060]
LSHC CS,-6 ;[1161][1060] LAST CHAR
MOVE CS,RC ;[1161][1060] TYPE RESULT
CALL TYPSYM ;[1161][1060]
PJRST POLER6 ;[1161][1066]
> ;[1161] END OF REPEAT 0
> ;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
MOVE AC0,SGFWOR(C) ;[1235] 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
SKIPN RC ;[1165] LOOKING AT BLANK PSECT?
JRST SGOUTA ;[1165] YES, DO NOT NEED TO OUTPUT THIS BLOCK
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
SGOUTA: POP P,BLKTYP ;[1165] 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
COUTD1: HRL C,BLKTYP ;SET BLOCK TYPE
COUTT: ;ENTER FROM .TEXT PSEUDO-OP
CALL OUTBIN ;OUTPUT COUNT AND TYPE
COUTT1: 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,<
PUSH P,RC ;[1221] SAVE RC
HLRZS RC ;[1221] ISOLATE LEFT HALF
CAIN RC,-2 ;[1221] FAKE LEFT HALF POLISH?
JRST [POP P,RC ;[1221] YES - RESTORE RELOC
JRST STOW05] ;[1221] DO HALFWORD TESTS
POP P,RC ;[1221] RESTORE
JUMPL RC,STOW20 ;[1221][624] JUMP IF FULLWORD POLISH
STOW05: ;[1221]
>
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
TLZ FR,POLSW ;[1220] DONE WITH POLISH
JUMP1 STOWP3 ;[1221] SKIP IN PASS 1
JUMPE AC0,STOWP3 ;[1221] SKIP IF NO VALUE
PUSH P,RC ;[1221] SAVE RC
HLRZS RC ;[1221] ISOLATE LEFT HALF
CAIN RC,-2 ;[1221] FAKE LEFT HALF POLISH?
JRST [POP P,RC ;[1221] YES - RESTORE RC
JRST STOWP3] ;[1221] HALFWORD CHECKS ALREADY DONE
POP P,RC ;[1221] RESTORE
JUMPL RC,STOWP2 ;[1221] VALUE AND POLISH IS ERROR
TRNE FRR,FWPSW ;[1221] CHECK FULLWORD POLISH
JRST STOWP2 ;[1221] STILL ERROR
TLNN AC0,-1 ;[1221] LEFT HALF VALUE
JRST STOWP1 ;[1221] NO
TRNE FRR,LHPSW ;[1221] AND LEFT HAND POLISH?
JRST STOWP2 ;[1221] ERROR
STOWP1: TRNN AC0,-1 ;[1221] RIGHT HALF VALUE?
JRST STOWP3 ;[1221] NO
TRNE FRR,RHPSW ;[1221] AND RIGHT HAND POLISH?
STOWP2: CALL QPOL ;[1221] YES - FLAG ERROR
STOWP3: ;[1221]
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
HRREI RC,-2 ;[1220][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
SKIPN INASGN ;[1232] IF IN ASSIGN
SKIPE INOPDF ;[1232] OR IN OPDEF
JRST .+1 ;[1232] NO CODE ACTUALLY STORED
SETOM BNSN ;[1232] 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
IFN POLISH,< ;[1220]
;[1220]DSTOW FAKE POLISH RELOCATION BACK TO LISTING FLAGS
DSTWRC: TRZ FRR,LHPSW!RHPSW!FWPSW ;[1220] CLEAR LISTING FLAGS
CAMN RC,[-2] ;[1220] FULLWORD POLISH?
JRST [TRO FRR,FWPSW ;[1220] YES
SETZ RC, ;[1220] FIX RELOCATION
JRST DSTWR1] ;[1220] DONE
PUSH P,RC ;[1220] SAVE FINAL RELOCATION
HLRZS RC ;[1220] LEFT HALF POLISH?
CAIN RC,-2 ;[1220]
JRST [TRO FRR,LHPSW ;[1220] YES
HRRZS 0(P) ;[1220] FIX RELOCATION
JRST .+1] ;[1220]
HRRZ RC,0(P) ;[1220] RIGHT HALF POLISH?
CAIN RC,-2 ;[1220]
JRST [TRO FRR,RHPSW ;[1220] YES
HLLZS 0(P) ;[1220] FIX
JRST .+1] ;[1220]
POP P,RC ;[1220] RESTORE RELOCATION
SKIPGE RC ;[1220] STILL POLISH?
TRO FRR,FWPSW ;[1220] YES - MUST BE FULLWORD
DSTWR1: RET ;[1220] RELOCATION/FLAGS RESTORED
>; END IFN POLISH ;[1220]
;EXTERNAL RIGHT
STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER
IFN POLISH,< ;[1221]
CAIN AC1,-2 ;[1221] FAKE POLISH?
TRNN AC0,-1 ;[1221] ERROR IF RIGHT HALF VALUE
>; END IFN POLISH ;[1221]
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
IFN POLISH,< ;[1221]
CAIN AC1,-2 ;[1221] FAKE POLISH?
TLNN AC0,-1 ;[1221] ERROR IF LEFT HALF VALUE
>; END IFN POLISH ;[1221]
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,<SYN LOOKUP,SGLKUP> ;[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
>
IFN POLISH,<TRO FRR,NOPSW> ;[1240] DO NOT ALLOW POLISH
CALL EVALCM ;GET A WORD
IFN POLISH,<TRZ FRR,NOPSW> ;[1240] ALLOW POLISH AGAIN
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,<PUSH P,IO ;SAVE FLAGS
TLO IO,IOPROG> ;XLIST LITS
CALL LIT1 ;RETURN VALUE IN AC2
IFE IIISW,<POP P,IO> ;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
SETZ AC1, ;[1231] MY JOB
RUNTIM AC1, ;[1231] CURRENT RUNTIME
SUB AC1,RTIME ;[1231] USED SO FAR
MOVEM AC1,R1TIME ;[1231] PASS1 RUNTIME
CALL INZ ;[1231] RESET FOR NEXT PROG
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,<TLNE IO,IOCREF> ;CLOSE CREF IF NECESSARY
REPEAT 0,<TLNE FR,CREFSW ;IF CREFFING
JRST ENDP2Q
MOVEI SDEL,0
PUSH P,DBUF+3 ;SO NO PAGE INFO
DPB SDEL,[POINT 7,DBUF+3,13]
IOR ER,OUTSW ;MAKE SURE OF OUTPUT
CALL CREF
MOVEI C,20 ;CODE FOR TITLE
CALL OUTLST
PUSH P,IO ;SAVE THIS
TLZ IO,IOPAGE ;AND PREVENT PAGE DURING TITLE
MOVEI CS,TBUF
CALL OUTAS0
MOVEI CS,VBUF
CALL OUTAS0
POP P,IO ;RESTORE THE IO WORD
POP P,DBUF+3> ;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,<ADDM C,.JBERR> ;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
TLZ IO,IOPAGE ;[1231] SUPPRESS POSSIBLE NEW PAGE
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,<TLNE IO,CRPGSW ;IF RPG, DON'T PRINT PGM BREAK
TRZ ER,TTYSW> ;...
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
ADD C,R1TIME ;[1231] PLUS PASS1 TIME
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,<TLNN IO,CRPGSW> ;[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,[SIXBIT/.LOW./] ;[1165] GET NAME OF BLANK PSECT
MOVEM CS,SGNAME ;[1165] RESET SGNAME
MOVEM CS,SGLIST ;[1165] AND SGLIST FOR BLANK PSECT
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 INZ2A ;[1167][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
INZ2A: ;[1167]
>
MOVEI VARHD
MOVEM VARHDX
MOVEI LITHD
MOVEM LITHDX
CALL LITI
IFN FTPSECT,< ;[575]
TLNE IO,MFLSW ;[1167] DOING PRGEND?
JUMP2 INZ3 ;[1167] YES, SKIP PSECT INIT
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: SETOM INRMRK ;[1177] REMARK IN PROGRESS
CALL GETCHR ;GET A CHARACTER
REMAR1: CAIE C,EOL
JRST REMAR0+1 ;[1177]
SETZM INRMRK ;[1177] ALL DONE
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)
MOVE V,LOCO ;[1166] GET THE OUTPUT LOCATION
HRL V,MODO ;[1166] AND RELOCATION
MOVEM V,-2(SX) ;[1166] SAVE IN BLOCK INFO
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,"<" ;<?
AOJA RC,IFB2 ;YES, INCREMENT COUNT
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 <X>,<X>,<INST.> 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,<MOVE AC1,HWFORM> ;USE STANDARD FORM
SETZM INCND ;NOT ANY MORE
JRST STOW ;STOW CODE AND EXIT
IFEX2: CALL GETCHR
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<EXP>,...
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,<TLNE ARG,LELF!RELF!SYNF!MACF!EXTF!UNDF!SPTR>
XX ASSIGNMENT
XX ENTRY,<TLNN ARG,ENTF>
XX EXPRESSION,<SKIPN .IFANG> ;;[1056] ANGLE-BRACKET SEEN?
XX EXTERNAL,<TLNN ARG,EXTF!SPTR>
XX GLOBAL,<TLNN ARG,ENTF!EXTF!INTF!SPTR>
XX INTERNAL,<TLNN ARG,INTF>
XX LABEL,<TLNN ARG,TAGF>
XX LOCAL
XX LRELOCATABLE,<TLNN ARG,LELF>
XX MACRO,<TLNN ARG,MACF>
XX NAME,<SKIPN .IFNAM> ;;[1112] SINGLE RADIX50 NAME SEEN?
XX NEEDED
XX NUMERIC,<TRNN ARG,NUMF>
XX OPCODE,<TRNN ARG,OPCF>
XX OPDEF,<TLNN ARG,OPDF>
XX REFERENCED
XX RELOCATABLE,<TLNN ARG,LELF!RELF>
XX RRELOCATABLE,<TLNN ARG,RELF>
XX SYMBOL,<TLNN ARG,SYMF>
XX SYNONYM,<TLNN ARG,SYNF>
>
DEFINE XX (A,B)<
<SIXBIT /A/>
>
IFATAB: IFATRIB
IFLEN==.-IFATAB
DEFINE XX (A,B)<
IFB <B>,<
CALL %IF'A
>
IFNB <B>,<
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:
IFN FTPSECT,<
SETOM SGSRCH> ;[1245] LOOK ONLY IN SYMBOLS FOR THIS PSECT
CALL SSRCH ;OK, SEARCH SYMBOL TABLE
JRST EXTER2 ;NOT THERE, INSERT IT
IFN FTPSECT,<
SETZM SGSRCH> ;[1245] TURN OFF LOOK ONLY HERE FLAG
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:
IFN FTPSECT,<
SETZM SGSRCH> ;[1245] TURN OFF LOOK ONLY HERE FLAG
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
JRST [CALL DSTOW ;[1220][1035]
IFN POLISH,< ;[1220]
CALL DSTWRC ;[1220] CORRECT FAKE POLISH RELOCATIONS
>; END IFN POLISH ;[1220]
JRST .+1] ;[1220]
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
TLC ARG,P1PF ;[1222] PASS1 POLISH DEFINITION?
TLCN ARG,P1PF ;[1222]
JRST [TLZ ARG,P1PF ;[1222] YES - REMOVE PASS1 DEFINITION
TLO ARG,SPTR ;[1222] ALLOW USE OF 2 WORD BLOCK IF NEEDED
JRST .+1] ;[1222]
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,P1PF ;[1222] PREVIOUSLY PASS1 POLISH?
TLCN ARG,P1PF ;[1222] UNDF+PNTF+EXTF+MDFF
JRST [TLZ ARG,P1PF ;[1222] YES - NOT ANY MORE
TLO ARG,SPTR ;[1222] ALLOW USE OF 2 WORD BLOCK IF NEEDED
JRST .+1] ;[1222]
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,^-<SYMF!TAGF!NOOUTF!INTF!ENTF!NCRF!MDFF!SUPRBT!SPTR> ;[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
;**; insert 2 lines at %ORG+16 13-Nov-85 HD
CAIN C,',' ;[1244] IS NEXT CHARACTER A COMMA?
TRO ER,ERRR!ERRN ;[1244] YES, FLAG AS 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 <ARG>
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 [MOVE AC0,[SIXBIT /.LOW./] ;[1165] NONE SPECIFIED,
;[1165] BLANK PSECT NAME IS .LOW.
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,<SG.RP==400000> ;[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
CAMN AC0,[SIXBIT /.LOW./] ;[1165] GIVING ATTRIB TO BLANK PSECT?
TRO ER,ERRA ;[1165] YES, FLAG ARG ERROR
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
MOVE AC1,SGNAME(AC1) ;[1165] GET THE PSECT NAME
CAMN AC1,[SIXBIT /.LOW./] ;[1165] ORIGIN FOR BLANK PSECT?
TRO ER,ERRA ;[1165] YES, FLAG ARG ERROR
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
MOVEM AC0,SGFWOR(AC1) ;[1235] 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]
<SIXBIT /ATB/> ;[1117]
DEF==1B<ATC> ;[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+<CON_-^D18>> ;[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,<JRST PRNAM> ;PRINT NAME IF FIRST ONE
IFE CCLSW,<RET> ;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,<JUMPCM XWD5> ;PROCESS COMMA COMMA IN XWD
IFN FORMSW,<JUMPNC .+4 ;JUMP IF NO COMMA
MOVE AC2,HWFORM ;GET FORM WORD FOR XWD
MOVEM AC2,-2(P) ;REPLACE INSTRUCTION FORM
JRST XWD5> ;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 INANGL ;[1227] IF NOT IN ANGLE BRACKETS
JUMPE AC0,OP4 ;[1227] OR IF NO OPCODE
SKIPE INASGN ;[1227] DOING ASSIGNMENT?
JRST OP3B ;[1227] YES - DO ADD
SKIPN INOPDF ;[624] OPDEF?
JRST OP4 ;[624] NO, JUMP
OP3B: MOVE PS,CSTAT+'+' ;[1227][624] YES, ADD OP AND ADR FIELDS
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,<TLNN AC0,-1 ;OK IF ALL 0'S
JRST .+4 ;IT WAS
TLC AC0,-1 ;CHANGE ALL ONES TO ZEROS
TLCE AC0,-1 ;OK IF ALL 1'S
TRO ER,ERRQ> ;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]
SKIPN -2(P) ;[1227] CURRENT RC NON-ZERO, IS STACKED RC?
JRST EVADRB ;[1227] YES - GO UPDATE
EXCH AC1,-2(P) ;[1227] GET AN AC
TLNE AC1,-1 ;[1227] LH RC ON STACK?
TLNN RC,-1 ;[1227] AND LH CURRENT RC?
SKIPA ;[1227] NO - OK SO FAR
JRST EVADRA ;[1227] GO FLAG ERROR
TRNE AC1,-1 ;[1227] RH RC ON STACK?
TRNN RC,-1 ;[1227] AND RH CURRENT RC?
SKIPA ;[1227] NO - DIFFERENT HALVES OK
EVADRA: TROA ER,ERRR ;[1227] SAME HALVES - RELOCATION ERROR
ADD RC,AC1 ;[1227] ADD RELOCATIONS
EXCH AC1,-2(P) ;[1227] RESTORE AC
EVADRB: MOVEM RC,-2(P) ;[1227] UPDATE STACKED RC
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,
SKIPN INASGN ;[1227] DOING ASSIGNMENT?
SKIPE INOPDF ;[1227] OR OPDEF?
JRST EVADR2 ;[1227] YES - SKIP
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: ;[1227]
>
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,<MOVSS SX,RC
IOR SX,V ;MERGE RELOCATION
TRNN SX,-1 ;RIGHT HALF ZERO?
JRST OP2A ;YES, DO SIMPLE ADD
MOVE ARG,RC> ;NO, SWAP RC INTO ARG
IFN IIISW,<MOVSS ARG,RC>
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,<TLNE SX,-1 ;IS LEFT HALF ZERO?
TRO ER,ERRQ ;NO FLAG FORMAT ERROR
OP2A: TLNE RC,-1 ;RELOCATION FOR LEFT HALF?
CALL OP2A1 ;YES,IS IT LEGAL?
TLNE AC0,777000 ;OP CODE FIELD USED?
JRST [EXCH AC0,-1(P) ;YES, GET STORED CODE
TLNE AC0,777000 ;OP CODE FIELD BEEN SET?
TRO ER,ERRQ ;YES, MOST LIKELY AN ERROR
EXCH AC0,-1(P)
JRST .+1]> ;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: SKIPN INASGN ;[1227] DOING ASSIGNMENT?
SKIPE INOPDF ;[1227] OR OPDEF?
RET ;[1227] YES - JUST RETURN
JUMP1 [ TRO ER,ERRF ;[1227]
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
PUSH P,MWP ;[1161] SAVE MWP
SETZ MWP, ;[1161] AND CLEAR IT
SETO PV, ;[1161] RESERVE ROOM FOR
CALL POLSTR ;[1161] COUNT OF POLISH WORDS NEEDED
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
AOJ MWP, ;[1161] COUNT PSECT REFERENCE
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
ADDI MWP,4 ;[1161] INCR COUNT FOR OP AND VALUE
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,<MOVEI AC0,0> ;CLEAR WORD
IFN IIISW,<TLNE SDEL,100000 ;ASCID?
TLZA SDEL,400000 ;YES, ZERO ASCIZ BIT
TDZA AC0,AC0 ;NO, ZERO WORD
MOVE AC0,[BYTE (7) 10,10,10,10,10 (1) 1] >;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,<ASC60:> ;[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,<TLNN SDEL,100000> ;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,<TRZ FRR,NOPSW> ;[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
SKIPN INASGN ;[1227] DOING ASSIGNMENT
SKIPE INOPDF ;[1227] OR OPDEF?
JRST [PUSH P,CS ;[1227] SAVE CURRENT STATUS
MOVEM RC,SAVCV ;[1227] VALUE
MOVEM RC,SAVRC ;[1227] AND RELOC FOR FORCED POLISH
MOVEI CV,^D18 ;[1227] SHIFT THIS MANY BITS
SETZ RC, ;[1227] ABSOLUTE
MOVE PS,CSTAT+'_' ;[1227] SHIFT OPERATOR
CALL FORCPP ;[1227] FORCE LEFT SHIFT
POP P,CS ;[1227] RECOVER STATUS
MOVEM RC,-1(P) ;[1227] UPDATE RELOCATION
SETOM POLTYP ;[1227] REST IS RIGHTHALF
JRST .+1] ;[1227] CONTINUE
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]
IFN POLISH,< ;[1227]
JUMPL RC,OP1A ;[1227] FINISH IN OP
>; END IFN POLISH ;[1227]
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:
JUMPE RC,IOWD13 ;[1243] ABSOLUTE?
JUMP2 [ SKIPN INANGL ;[730] NO, MUST BE REL OR EXT
JUMPN AC0,IOWD13 ;[1243] JUMP IF ADDITIVE GLOBAL NOT IN <>
CAIN RC,1 ;[730] JUMP IF
JRST IOWD13 ;[1243] RELOCATABLE
SETZM EXTPNT ;[730] EXTERNAL
JRST IOWDRP] ;[730] GO DO RH-1
JUMP1 [ CAIN RC,1 ;[1243] CHECK FOR RELOCATABLE
JRST IOWD13 ;[1243] YES
SKIPE LITLVL ;[1243] IN A LITERAL?
TRO ER,ERRF ;[1243] YES - DON'T FOLD IN PASS 1
JRST IOWD13 ] ;[1243]
IOWD13: ;[1243]
>
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]
CAIN AC1,^D18 ;[1223] JUST FINISHED A LEFT HALFWORD?
JRST [CAMN AC1,BYTESZ ;[1223] WITH A FULL HALFWORD BYTE?
MOVSS EXTPNT ;[1223] YES - CORRECT ANY EXTERNAL POINTERS
JRST .+1] ;[1223]
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
JUMP1 [TRC IO,<UNDF!ERRV> ;[1172] CHECK FOR UNDEFINED STORE
TRCN IO,<UNDF!ERRV> ;[1172] ADDRESS AND V ERROR
TRZ IO,ERRV ;[1172] OK, DURING PASS 1
JRST .+1] ;[1172] CONTINUE
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,<PUSH P,[0]> ;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,<CALL SETNOB>) ;;[1125] DON'T GENERATE REL FILE
X (.ITABM,<SETCAM AC2,ITABM>) ;;[1125] INCLUDE TAB/SPACE IN MACRO ARGS
X (.XTABM,<MOVEM AC2,ITABM>) ;;[1125] EXCLUDE TAB/SPACE IN MACRO ARGS
X (SFCOND,<SETCAM AC2,IFXLSW>) ;;[1125] XLIST IN IF (FALSE)
X (LITLST,<SETCAM AC2,LITLST>) ;;[1125] LIST BINARY IN LITERALS
X (FLBLST,<CALL SETFLB>) ;;[1125] FIRST LINE BINARY LISTING ONLY
X (MACPRF,<SETCAM AC2,MACPRF>) ;;[1125] MACRO DEF PREFERED OVER SYMBOL
X (MACMPD,<CALL SETMPD>) ;;[1125] NEW MACRO ARG HANDLING
X (KA10,<CALL SETKA>) ;;[1125] PUT KA10 TYPE IN HEADER BLOCK
X (KI10,<CALL SETKI>) ;;[1125] PUT KI10 TYPE IN HEADER BLOCK
X (KL10,<CALL SETKL>) ;;[1125] PUT KL10 TYPE IN HEADER BLOCK
X (KS10,<CALL SETKS>) ;;[1173] PUT KS10 TYPE IN HEADER BLOCK
X (.OKOVL,<SETCAM AC2,OKOVFL>) ;;[1125] ALLOW /,* OVERFLOW
X (.EROVL,<MOVEM AC2,OKOVFL>) ;;[1125] DON'T ALLOW /,* OVERFLOW
X (.NOCAL,<SETOM NOUUO>) ;;[1125][1043][1041] DON'T SEARCH UUO TABLES
IFN TSTCD,< ;;[1125]
X (.TCDON,<CALL TCDSET>) ;;[1125][575] SET LINK DEBUGGING FLAG
X (.TCDOF,<MOVEM AC2,TCDFLG>) ;;[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]
SETKS: MOVSI ARG,(10B5) ;[1173] SET BIT 2 FOR KS10
JRST SETKL+1 ;[1173] JOIN COMMON CODE
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==^D11 ;[1231] 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
ADD V,SGNMAX ;[1235] SAVE A SIXTH PSECT TABLE
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
MOVE AC0,SGFWOR(AC2) ;[1235] GET PSECT FULLWORD START ADDR.
CALL STORIT ;[1235] SAVE IT
SOJGE AC2,PSEND8 ;[1052]
SETZM SGNMAX ;ZERO PSECT CNT
SETZM SGNCUR ;[1136] ZERO CURRENT PSECT
SETZM SGDMAX ;[1136] ZERO PSECT NESTING COUNT
MOVE AC0,[SIXBIT/.LOW./] ;[1165] GET BLANK PSECT NAME
MOVEM AC0,SGNAME ;[1165] RESET SGNAME
MOVEM AC0,SGLIST ;[1165] AND SGLIST
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 AC0,-2(AC2) ;[1166] STORE OUTPUT LOCATION AND
CALL STORIT ;[1166] RELOCATION ALSO
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,R1TIME ;[1231] PASS1 RUNTIME
CALL STORIT ;[1231] SAVE
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]
CALL GETIT ;[1235] GET THE FULLWORD START ADDR.
MOVEM AC0,SGFWOR(AC2) ;[1235] RESTORE IT
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)
CALL GETIT ;[1166] GET OUTPUT LOCATION
MOVEM AC0,-2(AC2) ;[1166] AND RELOCATION
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 ;[1231] PASS1 RUNTIME
MOVEM AC0,R1TIME ;[1231]
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,"<" ;<?
JRST CORMAB ;NO, ERROR
MOVEI SDEL,1 ;SET COUNT
REPZ1: CALL GCHAR0 ;[1003][753] GET NEXT CHARACTER
CAIG C,FF ;END OF LINE?
CAIGE C,LF
JRST REPZ3 ;NO
SKIPE IFXLSW ;YES, XLISTING IN IF?
TLO IO,IOPROG ;YES, DO IT
REPZ3: CAIN C,"<" ;"<"?
AOJA SDEL,REPZ1 ;YES, INCREMENT COUNT
CAIN 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,"<" ;<?
JRST CORMAB ;NO, ERROR
SKIPE RPOLVL ;ARE WE NESTED?
AOS RPOLVL ;YES, DECREMENT CURRENT
PUSH MP,RPOLVL
SETOM RPOLVL
JRST STMNT
REPO1: CAIN C,"<"
SOS RPOLVL
CAIN 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
JRST DEFERR ;[1216] FLAG ERROR
ADDI SX,1 ;INCREMENT ARG COUNT
CAIG SX,37 ;[1162] TOO MANY ARGS?
JRST DEF11 ;[1162] NO, CONTINUE
PUSH P,['MCRTMA'] ;[1162] YES, SET UP PREFIX
POP P,PREFIX ;[1162] FOR THE ERROR MESSAGE
MOVSI RC,[SIXBIT/ MORE THAN 31 ARGUMENTS SPECIFIED FOR MACRO DEFINITION@/]
MOVE AC0,PPTMP2 ;[1162] GET THE MACRO NAME
JRST ERRNE4 ;[1162] GO GIVE THE ERROR MESSAGE
DEF11: PUSH P,AC0 ;[1162] 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
SETZ RC, ;[1156] MAKE SURE DEFINITION IS ABSOLUTE
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 ()
SKIPN LITLVL ;[1171] INSIDE A LITERAL?
JRST MAC10A ;[1171] NO
CAIN C,"]" ;[1171] CLOSING BRACKET?
JRST MAC21 ;[1171] YES, GO SET UP ARGUMENT LIST
MAC10A: CAIG C,CR ;[1171]
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,(<POINT 7,0,34>) ;..
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,(<POINT 7,0,34>) ;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,<CTL2==5> ;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,<TLZA IO,ARPGSW ;DON'T ALLOW RAPID PROGRAM GENERATION
TLO IO,ARPGSW> ;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,<IFE DFRMSW,<
SETOM PHWFMT>> ;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,<M:>
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,<TLNE IO,CRPGSW ;RPG IN PROGRESS?
JRST GOSET ;YES, GO READ NEXT COMMAND
TLNE IO,ARPGSW ;NO, RPG ALLOWED?
JRST RPGSET ;YES, GO TRY
CTLSET: RELEASE CTL2,> ;IN CASE OF LOOKUP FAILURE
IFE CCLSW,<CTLSET:>
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,<JRST BINSET ;BEGIN WITH BINARY FILE
RPGSET:
IFN TEMP,<HRRZ 3,.JBFF ;GET START OF BUFFER AREA
HRRZ 0,.JBREL ;GET TOP OF CORE
CAIGE 0,200(3) ;WILL BUFFER FIT?
JRST [ADDI 0,200 ;NO, GET ENUF CORE
CORE 0, ;CORE UUO
JRST XCEED2 ;FAILED, SO GIVE UP
JRST .+1] ;CONTINUE
HRRM 3,TMPFIL+1 ;STORE IN TMPCOR UUO IOWD
SOS TMPFIL+1 ;MAKE IT THE PROPER IOWD FORMAT
HRRM 3,CTLBLK+1 ;DUMMY UP BUFFER HEADER
MOVE 0,[2,,TMPFIL] ;SET UP FOR TEMP CORE READ
TMPCOR ;READ AND DELETE FILE "MAC"
JRST RPGTMP ;NO SUCH FILE IN CORE TRY DISK
ADD 3,0 ;CALCULATE END OF BUFFER
MOVEM 3,.JBFF ;FIX JOBFF SO FILE WONT BE KILLED
IMULI 0,5 ;CALCULATE CHARACTER COUNT
ADDI 0,1 ;SINCE SOSG HAPPENS AFTER NOT BEFORE
MOVEM 0,CTLBLK+2 ;SET UP CHAR CNT IN BUFFER HEADER
MOVEI 0,440700 ;SET UP BYTE POINTER IN HEADER
HRLM 0,CTLBLK+1 ;BUFFER HEADER NOW SET UP
SETOM TMPFLG ;MARK THAT A TMPCOR UUO WAS DONE
JRST RPGS2A ;CONTINUE IN MAIN STREAM
RPGTMP: SETZM TMPFLG> ;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,<SKIPE TMPFLG ;TMPCOR UUO IN PROGRESS?
EXIT> ;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,<MOVSI ACEXT,'CCL'> ;IF BLANK TRY CCL
IFN STANSW,<MOVSI ACEXT,'RPG'> ;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,<CAIN C,"!" ;WAS THIS AN IMPERATIVE?
JRST NUNSET ;GET THEE TO A NUNNERY
CAIN C,"@" ;CHECK FOR A NEW RPG FILE
JRST RPGS1>
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 [MOVE SDEL,CTL2SV ;[1176] PUT BACK THE BUFFER HEADER INFO
MOVEM SDEL,CTIBUF+2 ;[1176] FOR THE GETSET ROUTINE
MOVE SDEL,[POINT 7, CTLBUF] ;[1176]
MOVEM SDEL,CTIBUF+1 ;[1176]
JRST GETSET] ;[1176] 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
AOS OUTSW+0*TTYSW ;[1231] NO, ASSUME 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*<NUMBER OF /P'S +1>)
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
MOVE AC0,[SIXBIT /.LOW./] ;[1165] BLANK PSECT NAME IS .LOW.
MOVEM AC0,SGNAME ;[1165] SO STORE IT AS SGNAME
MOVEM AC0,SGLIST ;[1165] AND SGLIST
MOVSI 1
MOVEM SGRELC ;SET THE RELOCATION COUNTER
SETZM SGATTR ;ZERO PSECT BRK AND ATTRS
SETZM SGDMAX ;ONE .PSECT DEEP
>
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,<TLNE IO,CRPGSW ;BUT ONLY IF DOING RPG
TTCALL 3,[ASCIZ /MACRO:/] >;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
MOVE AC0,[SIXBIT /.LOW./] ;[1165] REPLACE BLANK PSECT NAME
MOVEM AC0,SGLIST ;[1165] AS .LOW.
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,<CAIE C,"!" ;IS CHAR AN IMPERATIVE?
CAIN C,"@"
RET> ;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,<RET> ;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,<LSH RC,6 ;SHIFT PREVIOUS RESULT
ADDI RC,-40(C)> ;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*<I=<"LETTER"-"A">/7>
SETCOD \I,J>
DEFINE SETCOD (I,J)
<BYTAB'I=BYTAB'I!<.-SWTAB>B<5*J+4>>
BYTAB0= 0 ;INITIALIZE TABLE
BYTAB1= 0
BYTAB2= 0
BYTAB3= 0
SWTAB:
SETSW Z,<TLO TIO,TIOCLD>
SETSW C,<TLZ FR,CREFSW>
SETSW P,<SOS PDP>
SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY
SETSW A,<ADDI CS,1>
SETSW B,<SUBI CS,1>
SETSW E,<TLZ IO,IOPALL!IOSALL>
IFN FORMSW,< SETSW F,<SETZM HWFMT>
SETSW G,<SETOM HWFMT>>
SETSW H,<JRST HELP>
SETSW L,<TLZ IO,IOMSTR>
SETSW M,<TLO IO,IOPALL!IOSALL>
SETSW N,<HLLOS TYPERR>
SETSW O,<XCT OFFML>
SETSW Q,<TLO FR,ERRQSW>
SETSW S,<TLO IO,IOMSTR>
SETSW T,<TLO TIO,TIOLE>
SETSW U,<SETOM UNVSKP>
SETSW W,<TLO TIO,TIORW>
SETSW X,<TLOA IO,IOPALL>
IFG .-SWTAB-37,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>
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,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2,BYTAB3>
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,<AOS .JBERR> ;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]
TLNE CS,DSKBIT ;[1206] SKIP IF NOT DSK OUTPUT
JRST ERRFIN ;[1206] PRINT MESSAGE FOR DISK
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,[<ASCII / />+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
HRR AC2,FREE ;[1230] POINT TO NEXT 2 WORD BLOCK
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<OP1END-OP1TOP> ;SET UP INDEX
MOVEI V,1B^L<OP1END-OP1TOP>/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,<N1=0
DEFINE X (SYM,COD)<N1=N1+1>> ;
IF2, <
N2=^D36
CC=0
RELOC OP1COD
RELOC
DEFINE X (SYMBOL,CODE)
<SIXBIT /SYMBOL/
CC=CC+CODE_<N2=N2-9>
IFE N2, <OUTLIT>>
DEFINE OUTLIT <
RELOC
+CC
RELOC
N2=^D36+<CC=0>>>
>
IFN OPHSH,<
OP1TOP: IF1,< BLOCK PRIME>
IF1,<DEFINE X (SB,CD)<>>
IF2,<
DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE_<9*<3-R&3>>>>
DEFINE X (SB,CD)<
SXB=<SIXBIT /SB/>
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,<PRINTX HASH FAILURE>>
DEFINE ITEM (QT,RM)<
IFN .%'RM,<R=R+H
IFL PRIME-R,<R=R-R/PRIME*PRIME>
H=H+Q_-22&777
IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>
IFE .%'RM,<.%'RM=SXB
OPSTOR \<R/4>>>>
IF1,<
DEFINE GETSYM (N)<.%'N=0>
N=0
XLIST
REPEAT PRIME,<GETSYM \N
N=N+1>
DEFINE GETSYM (N)<.$'N=0>
N=0
REPEAT <PRIME/4+1>,<GETSYM \N
N=N+1>
>
LIST>
;MACRO TO HANDLE KI10 OP-CODES
IFE KI10,<
DEFINE XK (SB,CD) <>> ;NUL MACRO
IFN KI10,<SYN X,XK> ;USUAL X MACRO
;MACRO TO HANDLE KL10 OP-CODES
IFE KL10,<
DEFINE XL (SB,CD) <>> ;NUL MACRO
IFN KL10,<SYN X,XL> ;USUAL X MACRO
;MACRO TO HANDLE F40 UUOS
IFE F40,<
DEFINE XF (SB,CD) <>> ;NUL MACRO
IFN F40,<SYN X,XF> ;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 ASCID , 773>
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 CONS,257>
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
XL DGFLTR, 027 ;[1237]
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,<X FIX , 130>
IFE STANSW,<XK FIX , 122>
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
XL GDBLE , 022 ;[1236]
XL GDFIX , 023 ;[1237]
XL GDFIXR, 025 ;[1237]
X GETSTS, 062
XL GFAD , 102 ;[1236]
XL GFDV , 107 ;[1236]
XL GFIX , 024 ;[1236]
XL GFIXR , 026 ;[1236]
XL GFMP , 106 ;[1236]
XL GFSB , 103 ;[1236]
XL GFSC , 031 ;[1236]
XL GSNGL , 021 ;[1236]
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
XL PMOVE , 052
XL PMOVEM , 053
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 SPCWAR,43>
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,<IFE OPHSH,<SUBTL:>>
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 XHLLI , 501 ;[1236]
XL XJEN , 761
XL XJRSTF, 762
X XLIST , 733
XL XMOVEI, 415 ;[1236]
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)<EXP .%'N
PURGE .%'N>
N=0
XLIST
REPEAT PRIME,<SETVAL \N
N=N+1>
LIST
>
OP1COD: IF1,< BLOCK <PRIME/4+1>>
IF2,<
DEFINE SETVAL (N)<EXP .$'N
PURGE .$'N>
N=0
XLIST
REPEAT <PRIME/4+1>,<SETVAL \N
N=N+1>
>
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<RELF>-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: SKIPGE 1(ARG) ;[1204] POINTER TO POLISH DEFINITION?
JRST SRCH4 ;[1204] YES - NO NEED TO COPY SYMBOLS
MOVE AC1,(ARG) ;[1204] GET ADDITION
TRNE AC1,-1 ;[1213] IS RIGHT HALF NON-ZERO?
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
REPEAT 0,< ;[1203] REMOVE EDIT 653
SKIPE UNISCH ;[1203] [653] FOUND IN UNV?
JRST [ TLC ARG,SYNF!PNTF ;[1203] [653] YES, CHECK FOR SYN FIXUP
TLCE ARG,SYNF!PNTF ;[1203] [653]
JRST .+1 ;[1203] [653]
TLNE ARG,VARF ;[1203] [653] YES, OLD STYLE UNV FILE?
JRST .+1 ;[1203] [653]
MOVE AC0,UNITBL(V) ;[1203] [653]
JRST VERSKW] ;[1203] [653] YES, REASSEMBL UNV
> ;[1203]
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
HLLZM ARG,0(P) ;[1230] ONLY LEFT HALF
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
>
PUSH P,ARG ;[1230] SAVE POINTER IN CASE LEFT HALF
TRNN ARG,-1 ;[1230] POINTER IN RIGHT HALF?
JRST SYMBKL ;[1230] NO, TRY LEFT HALF
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
MOVE AC0,(SX) ;[1230] GET FLAGS
TLNN AC0,EXTF ;[1230] CHECK FOR NOT EXTERNAL
CALL SYMBS2 ;[1230] NOT EXTERNAL - ERROR
HRRM ARG,-2(P) ;[1230] STACK POINTER TO GLOBAL
SYMBKL: SETZ ARG, ;[1230] CLEAR IN CASE NO LEFT HALF
MOVE AC0,0(P) ;[1230] GET POINTER BACK
TLNN AC0,-1 ;[1230] LEFT HALF?
JRST SYMBS1 ;[1230] NO.
HLR ARG,AC0 ;[1230] GET POINTER TO SYMBOL
MOVE AC0,1(ARG) ;[1230] AND FINALLY SYMBOL
CALL SEARCH ;[1230] SEE IF DEFINING GLOBAL IS IN TABLE
CALL [PUSH P,1(ARG) ;[1230] SAVE SIXBIT NAME
MOVSI ARG,SYMF!EXTF!PNTF ;[1230] SET ONLY THE REQUIRED FLAGS
JRST SYMBKY] ;[1230] NO, PUT IN SYMBOL TABLE
MOVE AC0,(SX) ;[1230] GET FLAGS
TLNN AC0,EXTF ;[1230] CHECK FOR NOT EXTERNAL
CALL SYMBS2 ;[1230] NOT EXTERNAL - ERROR
SYMBS1: POP P,0(P) ;[1230] TOSS POINTERS
POP P,AC0 ;[1230] GET SYMBOL BACK
CALL SEARCH ;SETUP SX AGAIN
JFCL ;WILL ALWAYS FAIL
TRZ FRR,NOUNVS ;[713] SEARCH UNIVERSALS AGAIN
HLL ARG,0(P) ;[1230] RECOVER FLAGS
HRLM ARG,0(P) ;[1230] STACK LH POINTER TO GLOBAL
JRST SYMBKY ;AND DO DUMMY PUSHJ
SYMBS2: TRO ER,ERRM ;[1230] SET PASS 1 'M' ERROR
MOVSI AC0,MDFF ;[1230] GET MULTIPLY DEFINED SYMBOL FLAG
IORM AC0,0(SX) ;[1230] SET FOR NEW SYMBOL
IORM AC0,-3(P) ;[1230] AND SUPPOSED EXTERNAL
MOVE AC0,-1(SX) ;[1230] GET SYMBOL
MOVEI SDEL,2 ;[1230] NEED 2 WORDS FOR FAKE EXTERNAL BLOCK
ADDB SDEL,FREE ;[1230] FROM FREE CORE
CAML SDEL,SYMBOL ;[1230] IS SPACE AVAILABLE?
CALL XCEEDS ;[1230] NO. MOVE SYMBOL TABLE
SETZM -2(SDEL) ;[1230] ZERO THE FIRST WORD
MOVEM AC0,-1(SDEL) ;[1230] PUT THE SYMBOL NAME IN EXTERNAL BLOCK
HRRI ARG,-2(SDEL) ;[1230] GET ADDRESS OF EXTERNAL BLOCK
RET ;[1230] RETURN
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,VARF ;[1210] IS THIS A VAR?
JUMP1 INSERT ;[1210] YES-DON'T DESTROY VALUE ON PASS 1
TLNE ARG,UNDF!VARF ;[1210]
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 <SYMTBL+LENGTH/2>,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: TLNE ARG,EXTF!MACF ;[1242] EXTERNAL OR MACRO REDEFINITION?
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,<LOWH:
PHASE LOWL>
IFN TEMP,<TMPFIL: SIXBIT /MAC/
XWD -200,0>
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 FOR COMMAND 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 <CTLSIZ+5>/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
BLOCK 1 ;[1224] START LOCATION OF VARIABLES
VARHD: BLOCK 1
VARHDX: BLOCK 1
VARCNT: BLOCK 1 ;VARIABLE COUNTER
LITAB: BLOCK 1
LITABX: BLOCK 1
BLOCK 1 ;[1166] STORE OUTPUT LOCATION & RELOCATION
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
SGFWOR: BLOCK SGNSGS+1 ;[1235] FULLWORD PSECT ORIGIN
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,<OTBUF: BLOCK 2>
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 <POL,,>
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,<EXTMP: BLOCK 1 ;HOLDS EXT OF COMMAND FILE (RH)
SAVFF: BLOCK 1>
CTLBLK: BLOCK 3
CTIBUF: BLOCK 3
CTOBUF: BLOCK 3
IFN TEMP,<TMPFLG: BLOCK 1>
IFN FORMSW,<PHWFMT: BLOCK 1>
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 ;[1231] CPU TIME AT START OF PASS
R1TIME: BLOCK 1 ;[1231] PASS1 RUNTIME
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
POLWRD: BLOCK 1 ;[1161] USED FOR COUNT FOR POLISH WORDS IN
;[1161] BLOCK TYPE 11
INRMRK: BLOCK 1 ;[1177] -1 IF DOING REMARK
VAR ;CLEAR VARIABLES
IFE FTPSECT,<SYN HIGH,SGATTR> ;[575]
JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONE
IFN PURESW,<LOWEND==.-1
RELOC >
END BEG
Reference in New Issue View Git Blame Copy Permalink