From cff7fa5698c01a69c3a64e2f39a8db9b398068b5 Mon Sep 17 00:00:00 2001 From: Richard Cornwell Date: Thu, 22 Nov 2018 23:22:09 -0500 Subject: [PATCH] Removed code that did not match --- src/macro.v46 | 7779 --------------------------------------------------------- 1 files changed, 0 insertions(+), 7779 deletions(-) delete mode 100644 src/macro.v46 diff --git a/src/macro.v46 b/src/macro.v46 deleted file mode 100644 index b67d60d..0000000 --- a/src/macro.v46 +++ /dev/null @@ -1,7779 +0,0 @@ -TITLE MACRO V.46(52) -SUBTTL RPG/CMF/JF/PMH/DMN 7-SEPT-71 -;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. - - VMACRO==36 ;VERSION NUMBER - VUPDATE==0 ;DEC UPDATE LEVEL - VEDIT==0 ;EDIT NUMBER - VCUSTOM==0 ;NON-DEC UPDATE LEVEL - - - LOC - B2+B11+B17+VEDIT - RELOC - MLON - -COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO) - - SWITCHES ON (NON-ZERO) IN DEC VERSION -SEG2SW GIVES TWO SEGMENT MACRO -PURESW GIVES VARIABLES IN LOW SEGMENT -CCLSW GIVES RAPID PROGRAM GENERATION FEATURE -FTDISK GIVES DISK FEATURES -RUNSW USE RUN UUO FOR "DEV:NAME!" -TEMP TMPCOR UUO IS TO BE USED -RENTSW ASSEMBLE REENTRANT PROGRAMS -FORMSW USE MORE READABLE FORMATS FOR LISTING (ICCSW) -DFRMSW DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON) - - SWITCHES OFF (ZERO) IN DEC VERSION -STANSW GIVES STANFORD FEATURES -LNSSW GIVES LNS VERSION -WFWSW GIVES ARRAY, INTEGER AND LVAR FEATURES -IIISW GIVES III FEATURES -OPHSH GIVES HASH SEARCH OF OPCODES -KI10 GIVES KI10 OP-CODES -* - SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS - -IFDEF TWOSEG,> -IFNDEF SEG2SW, -IFN SEG2SW, - -IFNDEF PURESW, - -IFNDEF STANSW, - -IFNDEF RENTSW, - -IFNDEF LNSSW, -IFN LNSSW, - -IFNDEF RUNSW, - -IFNDEF CCLSW, -IFN CCLSW, - -IFNDEF TEMP, - -IFNDEF WFWSW, - - -IFNDEF FTDISK, -IFNDEF DFRMSW, -IFN DFRMSW, -IFDEF ICCSW, ;SAME SWITCH -IFNDEF FORMSW, - -IFNDEF IIISW, - -IFNDEF OPHSH, - -IFNDEF KI10, - SUBTTL OTHER PARAMETERS - -.PDP== ^D50 ;BASIC PUSH-DOWN POINTER -IFNDEF LPTWID, ;DEFAULT WIDTH OF PRINTER -.LPTWD==8* ;USEFUL WIDTH IN MAIN LISTING -.CPL== .LPTWD-^D32 ;WIDTH AVAIABLE FOR TEXT WHEN - ;BINARY IS IN HALFWORD FORMAT -IFE STANSW,<.LPP==^D55 ;LINES/PAGE> -IFN STANSW,<.LPP==^D52 ;LINES/PAGE> -.STP== ^D40 ;STOW SIZE -.TBUF== ^D80 ;TITLE BUFFER -.SBUF== ^D80 ;SUB-TITLE BUFFER -.IFBLK==^D20 ;IFIDN COMPARISON BLOCK SIZE -.R1B==^D18 -.UNIV==^D10 ;NUMBER OF UNIVERSAL DEFINITIONS -.LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE - -NCOLS==LPTWID/^D32 ;NUMBER OF COLUMNS IN SYMBOL TABLE -IFN CCLSW,> -IFN OPHSH,> -IFNDEF NUMBUF,< -IFE STANSW!LNSSW, -IFN STANSW, -IFN LNSSW, -> - -EXTERN JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA -IFN CCLSW,< EXTERN JOBERR> - -IFN PURESW,< -IFE SEG2SW, -IFN SEG2SW,> - - SALL ;SUPPRESS ALL MACROS - -;SOME ASCII CHARACTERS - -HT==11 -LF==12 -VT==13 -FF==14 -CR==15 -EOL==33 - ;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) -RX== FR ;CURRENT RADIX (RIGHT) -MP= 16 ;MACRO PUSHDOWN POINTER -PP= 17 ;BASIC PUSHDOWN POINTER - -%OP== 3 -%MAC== 5 -%DSYM== 2 -%SYM== 1 -%DMAC== %MAC+1 - -OPDEF RESET [CALLI 0] -OPDEF SETDDT [CALLI 2] -OPDEF DDTOUT [CALLI 3] -OPDEF DEVCHR [CALLI 4] -OPDEF WAIT [MTAPE 0] -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] - -IFN STANSW,< OPDEF SWAP [CALLI 400004] > - ;FR FLAG REGISTER (FR/RX) -IOSCR== 000001 ;NO CR AFTER LINE -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 - - ;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 -IOTLSN==000002 ;TITLE SEEN -IOSALL==000001 ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED - -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 - - ;ER ERROR REGISTERS (IO/ER) -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 -ERRORS==777760 -LPTSW== 000002 -TTYSW== 000001 - - ;SYMBOL TABLE FLAGS -SYMF== 400000 ;SYMBOL -TAGF== 200000 ;TAG -NOOUTF==100000 ;NO DDT OUTPUT WFW -SYNF== 040000 ;SYNONYM -MACF== SYNF_-1 ;MACRO -OPDF== SYNF_-2 ;OPDEF -PNTF== 004000 ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE -UNDF== 002000 ;UNDEFINED -EXTF== 001000 ;EXTERNAL -INTF== 000400 ;INTERNAL -ENTF== 000200 ;ENTRY -VARF== 000100 ;VARIABLE -MDFF== 000020 ;MULTIPLY DEFINED -SPTR== 000010 ;SPECIAL EXTERNAL POINTER -SUPRBT==000004 ;SUPRESS OUTPUT TO DDT -LELF== 000002 ;LEFT HAND RELOCATABLE -RELF== 000001 ;RIGHT HAND RELOCATABLE - -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 - SUBTTL RUN UUO - -IFN CCLSW,< -IFN RUNSW,< XLIST > -IFE RUNSW,< -;THIS CODE MUST BE IN FIRST 1K TO ALLOW MAXIMUM SPACE -; FOR OVERWRITING -; 74 APPEARS BECAUSE ONLY LOCS 74 AND BEYOND ARE SAVED BY "SAVE" - -IFN CCLSW, > - LIST - - IFN RUNSW,< ;ASSEMBLE IF RUN UUO IMPLEMENTED -NUNSET: JUMPN ACDEV,.+2 - MOVSI ACDEV,(SIXBIT /SYS/) ;USE SYS IF NONE SPECIFIED - MOVEM ACDEV,RUNDEV -IFE STANSW,< - MOVEM ACFILE,RUNFIL ;STORE FILE NAME - PUSHJ PP,DELETE ;COMMAND FILE - SETZM RUNPP - MOVEI 16,RUNDEV ;XWD 0,RUNDEV - TLNE IO,CRPGSW ;WAS RPG IN PROGRESS? - HRLI 16,1 ;YES. START NEXT AT C(JOBSA)+1 - RUN 16, ;DO "RUN DEV:NAME" -> ;IFE STANSW, -IFN STANSW,< - MOVEM ACFILE,RUNDEV+1 - SETZM RUNDEV+2 - SETZM RUNDEV+3 - SETZM RUNDEV+4 - TLNE IO,CRPGSW ;ARE WE DOING RPG? - AOS RUNDEV+3 ;YES SET STARTING ADDRESS INCREMENT - MOVEI 16,RUNDEV ;ADDRESS OF SWAPBLOCK - SWAP 16, -> ;IFN STANSW - HALT ;SHOULDN'T RETURN. HALT IF IT DOES -> - -DELETE: HRRZ EXTMP ;IF THE EXTENSION - CAIE (SIXBIT/TMP/) ;IS .TMP - POPJ PP, ;RETURN. - CLOSE CTL2, ;DELETE - SETZB 4,5 ;THE COMMAND FILE. - SETZB 6,7 - RENAME CTL2,4 ; - JFCL - POPJ PP, -> - SUBTTL START ASSEMBLING - -ASSEMB: PUSHJ PP,INZ ;INITIALIZE FOR PASS - MOVE [ASCII /.MAIN/] - MOVEM TBUF - MOVEI SBUF - HRRM SUBTTX - -ASSEM1: PUSHJ PP,CHARAC ;TEST FOR FORM FEED - SKIPGE LIMBO ;CRLF FLAG? - JRST ASSEM1 ;YES ,IGNORE LF - CAIN C,14 - SKIPE SEQNO - JRST ASSEM2 - PUSHJ PP,OUTFF1 - PUSHJ PP,OUTLI - JRST ASSEM1 - -ASSEM2: AOS TAGINC - CAIN C,"\" ;BACK-SLASH? - TLZA IO,IOMAC ;YES, LIST IF IN MACRO - TLO IO,IORPTC - PUSHJ PP,STMNT ;OFF WE GO - TLZN IO,IOENDL ;WAS STOUT PRE-EMPTED? - PUSHJ PP,STOUT ;NO, POLISH OFF LINE - JRST ASSEM1 - - SUBTTL STATEMENT PROCESSOR - -STMNT: TLZ FR,INDSW!FSNSW - TLZA IO,FLDSW -STMNT1: PUSHJ PP,LABEL -STMNT2: PUSHJ PP,ATOM ;GET THE FIRST ATOM - CAIN C,35 ;"="? - JRST ASSIGN ;YES - CAIN C,32 ;":"? - JRST STMNT1 ;YES - JUMPAD STMNT7 ;NUMERIC EXPRESSION - JUMPN AC0,STMN2A ;JUMP IF NON NULL FIELD - SKIPN LITLVL ;ALLOW COMMA IN LITERALS - CAIE C,14 ;NULL, COMMA? - CAIN C,EOL ;OR END OF LINE? - POPJ PP, ;YES,EXIT - CAIN C,"]" ;CLOSING LITERAL? - POPJ PP, ;YES - JRST STMNT9 ;NO,AT LEAST SKIP ALL THIS NONSENSE - -STMN2A: JUMPE C,.+2 - TLO IO,IORPTC - PUSHJ PP,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,OPD1 ;OPDEF IF 1 - SOJE SDEL,CALLM ;MACRO IF 2 - JRST STMNT4 ;SYNONYM, PROCESS WITH OP-CODES - -STMNT3: PUSHJ PP,OPTSCH ;SEARCH OP CODE TABLE - JRST STMNT5 ;NOT FOUND -STMNT4: 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) ;NO, GO TO APPROPRIATE PROCESSOR - POPJ PP, ;YES,EXIT - -STMNT5: PUSHJ PP,SSRCH ;TRY SYMBOLS - JRST STMNT8 ;NOT FOUND - TLNE ARG,EXTF!UNDF ;EXTERNAL OR UNDEFINED? - JRST STMNT7 ;YES, PROCESS IN EVALEX - TLNN RC,-2 ;CHECK FOR EXTERNAL - TRNE RC,-2 - JRST STMNT7 - MOVE AC0,V ;FOUND, PUT VALUE IN AC0 - TLO IO,NUMSW ;FLAG AS NUMERIC -STMNT7: TLZ IO,IORPTC -STMNT9: PUSHJ PP,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,"]"-40 ;CLOSING LITERAL? - TRO ER,ERRQ ;NO, GIVE "Q" ERROR - POPJ PP, ;EXIT - - STMNT8: 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: PUSHJ PP,INSERT ;PUT OPDEF IN TABLE - JRST OPD ;AND TREAT AS OPDEF - -STMN8C: SETZ V, ;START WITH ZERO - CAIL V,TTCLTH ;END OF TABLE? - JRST STMN8A ;YES, ERROR - 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 - -STMN8A: 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 ;TO FORCE OUT A MESSAGE - - ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT) - ;UNTIL A LINE TERMINATOR IS SEEN. -STOUTS: TLOA IO,IOENDL!IORPTC -STOUT: TLO IO,IORPTC - PUSHJ PP,BYPAS1 - CAIN C,14 ;COMMA? - SKIPL STPX ;YES, ERROR IF CODE STORED - CAIN C,EOL - TLOA IO,IORPTC - TRO ER,ERRQ -STOUT1: PUSHJ PP,CHARAC - CAIG C,CR - CAIG C,HT - JRST STOUT1 - JRST OUTLIN ;OUTPUT THE LINE (BIN AND LST) - SUBTTL LABEL PROCESSOR - -LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC - JUMPE AC0,LABEL5 ;ERROR IF BLANK - TLO IO,DEFCRS ;THIS IS A DEFINITION - PUSHJ PP,SSRCH ;SEARCH FOR OPERAND - MOVSI ARG,SYMF!UNDF!TAGF ;NOT FOUND - TLNN ARG,EXTF ;OPERAND FOUND (SKIP EXIT) - JRST LABEL0 - JUMP1 LABEL3 ;ERROR ON PASS1 - TLNN ARG,UNDF ;UNDEFINED ON PASS1 - JRST LABEL3 ;NO, FLAG ERROR - TLZ ARG,EXTF!PNTF ;TURN OFF EXT FLAG NOW -LABEL0: TLZN ARG,UNDF!VARF ;WAS IT PREVIOUSLY DEFINED? - JRST LABEL2 ;YES, CHECK EQUALITY - MOVE V,LOCA ;WFW - MOVE RC,MODA - TLO ARG,TAGF - PUSHJ PP,PEEK ;GET NEXT CHAR. - CAIE C,":" ;SPECIAL CHECK FOR :: - JRST LABEL1 ;NO MATCH - TLO ARG,INTF ;MAKE IT INTERNAL - PUSHJ PP,GETCHR ;PROCESS NEXT CHAR. - PUSHJ PP,PEEK ;PREVIEW NEXT CHAR. -LABEL1: CAIE C,"!" ;HALF-KILL SIGN - JRST LABEL6 ;NO - TLO ARG,NOOUTF ;YES, SUPPRESS IT - PUSHJ PP,GETCHR ;AND GET RID OF IT -LABEL6: MOVEM AC0,TAG ;SAVE FOR PASS 1 ERRORS - HLLZS TAGINC ;ZERO INCREMENT - JRST INSERT ;INSERT/UPDATE AND EXIT - -LABEL2: HRLOM V,LOCBLK ;SAVE LIST LOCATION - 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 - JRST UPDATE ;UPDATE AND EXIT - -LABEL4: CAMN AC0,LOCA ;DO THEY COMPARE? - CAME RC,MODA -LABEL5: TRO ER,ERRP ;NO, FLAG PHASE ERROR - POPJ PP, - -LABEL7: SKIPE LITLVL ;LABEL IN A LITERAL? - MOVEM AC0,LITLBL ;YES, SAVE LABEL NAME FOR LATER - PUSHJ PP,PEEK ;INSPECT A CHAR. - CAIN C,":" ;COLON? - PUSHJ PP,GETCHR ;YES, DISPOSE OF IT - PUSHJ PP,PEEK ;EXAMINE ONE MORE CHAR. - CAIN C,"!" ;EXCLAMATION? - JRST GETCHR ;YES, INDEED - POPJ PP, - SUBTTL ATOM PROCESSOR -ATOM: PUSHJ PP,CELL ;GET FIRST CELL - TLNE IO,NUMSW ;IF NON-NUMERIC -ATOM1: CAIE C,42 ;OR NOT A BINARY SHIFT, - POPJ PP, ;EXIT - - PUSH PP,AC0 ;STACK REGISTERS, ITS A BINARY SHIFT - PUSH PP,AC1 - PUSH PP,RC - PUSH PP,RX - HRRI RX,^D10 ;COMPUTE SHIFT RADIX 10 - PUSHJ PP,CELLSF ;GET SHIFT - MOVE ARG,RC ;SAVE RELOCATION - POP PP,RX ;RESTORE REGISTERS - POP PP,RC - POP PP,AC1 - MOVN SX,AC0 ;USE NEGATIVE OF SHIFT - POP PP,AC0 - JUMPN ARG,NUMER2 ;IF NOT ABSOLUTE - TLNN IO,NUMSW ;AND NUMERIC, - JRST NUMER2 ;FLAG ERROR - LSHC AC0,^D35(SX) - LSH RC,^D35(SX) - JRST ATOM1 ;TEST FOR ANOTHER - CELLSF: TLO IO,FLDSW -CELL: SETZB AC0,RC ;CLEAR RESULT AND RELOCATION - SETZB AC1,AC2 ;CLEAR WORK REGISTERS - MOVEM PP,PPTEMP ;SAVE PUSHDOWN POINTER - TLZ IO,NUMSW - TLZA FR,NEGSW!DCFSW!RADXSW - -CELL1: TLO IO,FLDSW - PUSHJ PP,BYPASS - 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: PUSHJ PP,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 ;"#"? - POPJ PP, - JUMPE AC0,POPOUT ;TEST FOR NULL - PUSHJ PP,PEEK ;PEEK AT NEXT CHAR. - CAIN C,"#" ;IS IT 2ND #? - JRST LETTE4 ;YES, THEN IT'S AN EXTERN - TLO IO,DEFCRS - PUSHJ PP,SSRCH ;YES, SEARCH FOR SYMBOL (OPERAND) - MOVSI ARG,SYMF!UNDF ;NOT FOUND, FLAGAS UNDEFINED SYM. - TLNN ARG,UNDF ;UNDEFINED? - JRST GETCHR ;NO, GET NEXT CHAR AND RETURN - TLO ARG,VARF ;YES, FLAG AS A VARIABLE - TRO ER,ERRU ;SET UNDEFINED ERROR FLAG - PUSHJ PP,INSERZ ;INSERT IT WITH A ZERO VALUE - JRST GETDEL - -LETTE4: PUSHJ PP,GETCHR ;AND SCAN PAST IT - PUSHJ PP,GETCHR ;GET RID OF # - JRST EXTER1 ;PUT IN SYMBOL TABLE - -NUMER1: SETZB AC0,RC ;RETURN ZERO -NUMER2: TRO ER,ERRN ;FLAG ERROR - -GETDEL: PUSHJ PP,BYPASS -GETDE1: JUMPE C,.-1 - MOVEI AC1,0 -GETDE3: TLO IO,NUMSW!FLDSW ;FLAG NUMERIC - TLNN FR,NEGSW ;IS ATOM NEGATIVE? - POPJ PP, ;NO, EXIT - JUMPE AC1,GETDE2 - MOVNS AC1 - TDCA AC0,[-1] -GETDE2: MOVNS AC0 ;YES, NEGATE VALUE - MOVNS RC ;AND RELOCATION -POPOUT: POPJ PP, ;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: PUSHJ PP,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 - PUSHJ PP,PEEK ;LOOK AT NEXT CHAR. - CAIE C,42 - JRST QUOTE1 ;RESTORE REPEAT LEVEL AND QUIT - PUSHJ PP,CHARAC ;GET NEXT CHAR. - JRST QUOTE0 ;USE IT - -QUOTE2: TRO ER,ERRQ ;SET Q ERROR -QUOTE1: JRST GETDEL - -SQUOT0: TLNE AC0,770000 ;SIX CHARS. STORED ALREADY ? - TRO ER,ERRQ ;YES - LSH AC0,6 - IORI AC0,-40(C) ;OR IN SIXBIT CHAR. - -SQUOTE: PUSHJ PP,CHARAC - CAIG C,CR - CAIGE C,LF - JRST .+2 - JRST QUOTE1 - CAIE C,"'" - JRST SQUOT0 - PUSHJ PP,PEEK - CAIE C,"'" - JRST QUOTE1 - PUSHJ PP,CHARAC - JRST SQUOT0 - - QUAL: PUSHJ PP,BYPAS1 ;SKIP BLANKS, GET NEXT CHARACTER - CAIN C,42 ;"B"? - JRST QUAL2 ;YES, RADIX=D2 - CAIN C,57 ;"O"? - JRST QUAL8 ;YES, RADIX=D8 - CAIN C,46 ;"F"? - JRST NUMDF ;YES, PROCESS DECIMAL FRACTION - CAIN C,54 ;"L"? - JRST QUALL ;YES - CAIE C,44 ;"D"? - JRST NUMER1 ;NO, FLAG NUMERIC ERROR - ADDI AC2,2 -QUAL8: ADDI AC2,6 -QUAL2: ADDI AC2,2 - PUSH PP,RX - HRR RX,AC2 - PUSHJ PP,CELLSF -QUAL2A: POP PP,RX - TLNN IO,NUMSW - JRST NUMER1 - JRST GETDE1 - -QUALL: PUSH PP,FR - PUSHJ PP,CELLSF - MOVE AC2,AC0 - MOVEI AC0,^D36 - JUMPE AC2,QUAL2A - LSH AC2,-1 - SOJA AC0,.-2 - SUBTTL LITERAL PROCESSOR - -SQBRK: PUSH PP,FR - PUSH PP,EXTPNT ;ALLOW EXTERN TO PRECEDE LIT IN XWD - SETZM EXTPNT - SKIPE LITLVL ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY - JRST SQB5 - MOVE C,SEQNO2 - MOVEM C,LITSEQ - MOVE C,PAGENO - MOVEM C,LITPG -SQB5: JSP AC2,SVSTOW -SQB3: PUSHJ PP,STMNT - CAIN C,75 ;CHECK FOR ] - JRST SQB1 - TLO IO,IORPTC - TLNE FR,MWLFLG ;CALL IT ] IF NOT MULTI-WORD FLAG - JRST SQB2 ;BUT REPEAT LAST CHARACTER - PUSHJ PP,BYPAS1 - CAIN C,EOL - TLOA IO,IORPTC - TRO ER,ERRQ -SQB4: PUSHJ PP,CHARAC - CAIN C,";" ;COMMENT? - JRST SQB6 ;YES, IGNORE SQUARE BRACKETS - CAIN C,"]" ;LOOK FOR TERMINAL SQB - TRNN ER,ERRORS ;IN CASE OF ERROR IN LITERAL - JRST .+2 ;NO ALL IS WELL - JRST SQB1 ;FINISH THE LITERAL NOW!! - CAIG C,CR ;LOOK FOR END OF LINE - CAIN C,HT - JRST SQB4 -SQB4A: PUSHJ PP,OUTIML ;DUMP - PUSHJ PP,CHARAC ;GET ANOTHER CHAR. - SKIPL LIMBO ;CRLF FLAG - TLO IO,IORPTC ;NO REPEAT - JRST SQB3 - -SQB6: PUSHJ PP,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: TLZ IO,IORPTC -SQB2: PUSHJ PP,STOLIT - JSP AC2,GTSTOW - SKIPE LITLBL ;NEED TO FIXUP A LABEL? - PUSHJ PP,RELBLE ;YES, USE LOC OF LITERAL - POP PP,EXTPNT - POP PP,FR - SKIPE LITLVL ;WERE WE NESTED? - JUMP1 NUMER2 ;YES, FORCE ERROR IF PASS 1 - JRST GETDEL - -RELBLE: PUSH PP,AC0 ;SAVE LOCATION COUNTER - PUSH PP,RC ;AND RELOCATION - MOVE AC0,LITLBL ;SYMBOL WE NEED - SETZM LITLBL ;ZERO INDICATOR - PUSHJ PP,SSRCH ;SEARCH FOR OPERAND - JRST RELBL1 ;SHOULD NEVER HAPPEN - TLNN ARG,TAGF ;IT BETTER BE A LABEL - JRST RELBL1 ;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE - TLZ ARG,UNDF!EXTF!PNTF ;CLEAR FLAGS NOW - POP PP,RC ;GET LITERAL RELOCATION - MOVE V,(PP) ;GET VALUE (LOC COUNTER) - PUSHJ PP,UPDATE ;UPDATE VALUE - POP PP,AC0 ;RESTORE LITERAL COUNT - POPJ PP, ;RETURN - -RELBL1: POP PP,RC ;RESTORE RC - POP PP,AC0 ;AND AC0 - POPJ PP, ;JUST RETURN - ANGLB: PUSH PP,FR - TLZ FR,INDSW - PUSHJ PP,ATOM - TLNN IO,NUMSW - CAIE C,35 - JRST ANGLB1 - PUSHJ PP,ASSIG1 - MOVE AC0,V - JRST ANGLB2 - -ANGLB1: PUSHJ PP,EVALHA -ANGLB2: POP PP,FR - CAIE C,36 - TRO ER,ERRN - JRST GETDEL - -PERIOD: PUSHJ PP,GETCHR ;LOOK AT NEXT CHARACTER - TLNN CS,2 ;ALPHABETIC? - JRST PERNUM ;NO, TEST NUMERIC - MOVSI AC0,(SIXBIT /./) ;YES, PUT PERIOD IN AC0 - MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER - JRST LETTE2 ;AND TREAT AS SYMBOL - -PERNUM: 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: PUSHJ PP,GETCHR ;GET A CHARACTER - TLNN CS,4 ;NUMERIC? - JRST NUM10 ;NO -NUM1: SUBI C,20 ;CONVERT TO OCTAL - PUSH PP,C ;STACK FOR FLOATING POINT - MOVE AC0,AC1 - MULI AC0,0(RX) - ADD AC1,C ;ADD IN LAST VALUE - CAIL C,0(RX) ;IS NUMBER LESS THAN CURRENT RADIX? - TLO FR,RADXSW ;NO, SET FLAG - AOJA AC2,NUM ;YES, AC2=NO. OF DECIMAL PLACES - - NUM10: CAIE C,16 ;PERIOD? - TLNE FR,DCFSW ;OR DECIMAL FRACTION? - JRST NUM30 ;YES, PROCESS FLOATING POINT - LSH AC1,1 ;NO, CLEAR THE SIGN BIT - LSHC AC0,^D35 ;AND SHIFT INTO AC0 - MOVE PP,PPTEMP ;RESTORE PP - SOJE AC2,GETDE1 ;NO RADIX ERROR TEST IF ONE DIGIT - TLNE FR,RADXSW ;WAS ILLEGAL NUMBER ENCOUNTERED? - TRO ER,ERRN ;YES, FLAG N ERROR - JRST GETDE1 - -NUM30: CAIE C,"B"-40 ;IF "B" THEN MISSING "." -NUM31: PUSHJ PP,GETCHR - TLNN CS,4 ;NUMERIC? - JRST NUM40 ;NO -NUM32: SUBI C,20 - PUSH PP,C - JRST NUM31 - -NUM40: PUSH PP,FR ;STACK VALUES - HRRI RX,^D10 - PUSH PP,AC2 - PUSH PP,PPTEMP - CAIN C,45 ;"E"? - JRST [PUSHJ PP,PEEK ;GET NEXT CHAR - PUSH PP,C ;SAVE NEXT CHAR - PUSHJ PP,CELL ;YES, GET EXPONENT - POP PP,C ;GET FIRST CHAR. AFTER E - CAIN V,4 ;MUST HAVE NUMERICAL STATUS - JRST .+2 ;SKIP RETURN - CAIN C,"<" ;ALLOW - JRST .+2 ;SKIP RETURN - SKIPN AC0 ;ERROR IF NON-ZERO EXPRESSION - TROA ER,ERRQ ;ALLOW E+,E- - SETOM RC ;FORCE NUMERICAL ERROR - JRST .+2] ;SKIP RETURN - MOVEI AC0,0 ;NO, ZERO EXPONENT - POP PP,PPTEMP - POP PP,SX - POP PP,FR - HRRZ V,PP - MOVE PP,PPTEMP - JUMPN RC,NUMER1 ;EXPONENT MUST BE ABSOLUTE - ADD SX,AC0 - HRRZ ARG,PP - 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 - PUSHJ PP,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: MOVEI AC0,0 ;CLEAR AC0 - MOVSI AC1,(POINT 6,AC0) ;PUT POINTER IN AC1 - PUSHJ PP,BYPASS ;SKIP LEADING BLANKS - TLNN CS,2 ;ALPHABETIC? - JRST GETSY1 ;NO, ERROR - CAIE C,16 ;PERIOD? - JRST GETSY2 ;NO, A VALID SYMBOL - IDPB C,AC1 ;STORE THE CHARACTER - PUSHJ PP,GETCHR ;YES, TEST NEXT CHARACTER - TLNN CS,2 ;ALPHABETIC? -GETSY1: TROA ER,ERRA -GETSY2: AOS 0(PP) ;YES, SET SKIP EXIT -GETSY3: TLNN CS,6 ;ALPHA-NUMERIC? - JRST BYPAS2 ;NO, GET DELIMITER - TLNE AC1,770000 ;YES, HAVE WE STORED SIX? - IDPB C,AC1 ;NO, STORE IT - PUSHJ PP,GETCHR - JRST GETSY3 - - 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: PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION - PUSH PP,[0] ;MARK PDL - JUMPCM EVALC3 ;JUMP IF COMMA - TLO IO,IORPTC ;IT'S NOT,SO REPEAT - JRST OP ;PROCESS IN OP -EVALC3: -IFN FORMSW, - PUSH PP,[0] ;STORE ZERO'S ON PDL - PUSH PP,[0] ;....... - MOVSI AC2,(POINT 4,(PP),12) - JRST OP1B ;PROCESS IN OP - -EVALEX: TLO IO,FLDSW - PUSH PP,[XWD TNODE,0] ;MARK THE LIST 200000,,0 - TLZN FR,TMPSW -EVATOM: PUSHJ PP,ATOM ;GET THE NEXT ATOM - JUMPE AC0,EVGETD ;TEST FOR NULL/ZERO - TLOE IO,NUMSW ;SET NUMERIC, WAS IT PREVIOUSLY? - JRST EVGETD+1 ;YES, TREAT ACCORDINGLY - PUSHJ PP,SEARCH ;SEARCH FOR MACRO OR SYMBOL - JRST EVOP ;NOT FOUND, TRY FOR OP-CODE - JUMPL ARG,.+2 ;SKIP IF OPERAND - PUSHJ PP,SSRCH1 ;OPERATOR, TRY FOR SYMBOL (OPERAND) - PUSHJ PP,QSRCH ;PERFORM CROSS-REFERENCE - 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 - - JUMPE C,.+2 ;NON-BLANK? - TLO IO,IORPTC ;YES, REPEAT CHARACTER - SOJE SDEL,CALLM ;MACRO IF 2 - JUMPG SDEL,EVOPS ;SYNONYM IF 4 - - MOVE AC0,V ;OPDEF - MOVEI V,OP ;SET TRANSFER VECTOR - JRST EVOPD - EVOP: TLNE FR,NEGSW ;OPCODE, UNARY MINUS? - JRST EVERRZ ;YES, ERROR - - PUSHJ PP,OPTSCH ;SEARCH SYMBOL TABLE - JRST EVOPX ;NOT FOUND -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: JUMPE C,.+2 ;OPDEF, NON-BLANK DELIMITER? - TLO IO,IORPTC ;YES, REPEAT CHARACTER - JSP AC2,SVSTOW - PUSHJ PP,0(V) - PUSHJ PP,DSTOW - JSP AC2,GTSTOW - TRNE RC,-2 - HRRM RC,EXTPNT - TLNE RC,-2 - HLLM RC,EXTPNT - JRST EVNUM - -EVOPX: MOVSI ARG,SYMF!UNDF - PUSHJ PP,INSERZ -EVERRZ: SETZB AC0,RC ;CLEAR CODE AND RELOCATION -EVERRU: TRO ER,ERRU - JRST EVGETD - EVTSTS: TLNE ARG,UNDF - JRST [TRO ER,ERRU ;SET UNDEF ERROR - JUMP1 EVGETD ;TREAT AS UNDF ON PASS1 - JRST .+1] ;TREAT AS EXTERNAL ON PASS2 - TLNN ARG,EXTF - JRST EVTSTR - HRRZ RC,ARG ;GET ADRES WFW - HRRZ ARG,EXTPNT ;SAVE IT WFW - HRRM RC,EXTPNT ;WFW - TRNE ARG,-1 ;WFW - TRO ER,ERRE - SETZB AC0,ARG - -EVTSTR: TLNE ARG,MDFF ;MULTIPLY DEFINED? - TRO ER,ERRD ;YES, FLAG IT - TLNE FR,NEGSW ;NEGATIVE ATOM? - PUSHJ PP,GETDE2 ;YES, NEGATE AC0 AND RC - -EVGETD: TLNE IO,NUMSW ;NON BLANK FIELD - TLO FR,FSNSW ;YES,SET FLAG - PUSHJ PP,BYPAS2 - TLNE CS,6 ;ALPHA-NUMERIC? - TLO IO,IORPTC ;YES, REPEAT IT -EVNUM: POP PP,PS ;POP THE PREVIOUS DELIMITER/TNODE - TLO PS,4000 - 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 - TLNN CS,170000 ;YES, ARE WE POINTING AT DEL? (& ! * / + - _) - POPJ PP, ;YES, EXIT - ;NO,FALL INTO EVPUSH - - EVPUSH: PUSH PP,PS ;STACK VALUES - PUSH PP,CV - PUSH PP,RC - PUSH PP,CS - JRST EVATOM ;GET NEXT ATOM - -EVXCT: POP PP,PR ;POP PREVIOUS RELOCATABILITY - POP PP,PV ;AND PREVIOUS VALUE - LDB PS,[POINT 3,PS,29] ;TYPE OF OPERATION TO PS - JRST .+1(PS) ;PERFORM PROPER OPERATION - JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN - JRST XMUL ;1; - JRST XDIV ;2; - JRST XADD ;3; - JRST XSUB ;4; - JRST XLRW ;5; "_" - TDOA CV,PV ;6; MERGE PV INTO CV - AND CV,PV ;7; AND PV INTO CV - JUMPN RC,.+2 ;COMMON RELOCATION TEST -EVXCT1: JUMPE PR,EVNUM - TRO ER,ERRR ;BOTH MUST BE FIXED - JRST EVNUM ;GO TRY AGAIN - -XSUB: SUBM PV,CV - SUBM PR,RC - JRST EVNUM - -XADD: ADDM PV,CV - ADDM PR,RC - JRST EVNUM - -XDIV: IDIV PR,CV ;CORRECT RELOCATABILITY - IDIVM PV,CV -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 - IMULM PV,CV - JRST EVNUM -XLRW: EXCH PV,CV - LSH CV,0(PV) - LSH PR,0(PV) - JRST XDIV1 - SUBTTL LITERAL STORAGE HANDLER - -STOLER: -IFE FORMSW,< SETZB AC0,RC ;ERROR, NO CODE STORED - PUSHJ PP,STOW ;STOW ZERO> -IFN FORMSW,< MOVEI AC0,0 - PUSHJ PP,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 ;ANY ERRORS? - JRST STOL06 ;NO - JUMP2 STOL22 ;YES, NO SEARCH. BRANCH IF PASS2 - ADDM SDEL,LITCNT ;PASS ONE, UPDATE COUNT - 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: PUSHJ PP,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 STOL26 ;NO, JUST RETURN LOCATION - MOVEM AC2,SAVBLK+AC2 ;YES, SAVE STARTING INFO - MOVEM SX,SAVBLK+SX - -STOL12: SOJL AC2,STOL23 ;TEST FOR END - PUSHJ PP,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 - JRST STOL26 ;YES, RETURN LOCATION - -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: PUSHJ PP,DSTOW ;DSTOW AND CONVERT -STOL24: MOVE SX,LITABX ;GET CURRENT STORAGE - PUSHJ PP,GETTOP ;GET NEXT CELL - MOVEM AC0,-2(SX) ;STORE CODE WFW - 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: JUMP1 POPOUT ;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 - POPJ PP, ;EXIT - - SUBTTL INPUT ROUTINES -GETCHR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER - CAIL C,"A"+40 ;CHECK FOR LOWER CASE - CAILE C,"Z"+40 - JRST .+2 ;NOT LOWER CASE -IFN STANSW,< - SUBI C,40 - CAIN C,32 - MOVEI C,136 ;^ - CAIN C,30 - MOVEI C,137 ;_ - CAIN C,176 - MOVEI C,134 ;} - CAIN C,140 - MOVEI C,100 ;@> -IFE STANSW,< - TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT> - SUBI C,40 ;CONVERT TO SIXBIT - CAIG C,77 ;CHAR GREATER THAN SIXBIT? - JUMPGE C,GETCS ;TEST FOR VALID SIXBIT - ADDI C,40 ;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 - POPJ PP, ;EXIT - -GETCS1: JUMPE C,GETCS ;IGNORE NULS - TRC C,100 ;MAKE CHAR. VISIBLE - MOVEI CS,"^" - DPB CS,LBUFP ;PUT ^ IN OUTPUT - PUSHJ PP,RSW2 ;ALSO MODIFIED CHAR. - TRO ER,ERRQ ;FLAG Q ERROR - JRST GETCHR ;BUT IGNORE CHAR. - -CHARAC: TLZE IO,IORPTC ;REPEAT REQUESTED? - JRST CHARAX ;YES -RSW0: JUMPN MRP,MREAD ;BRANCH IF TREE POINTER SET - PUSHJ PP,READ -RSW1: SKIPE RPOLVL ;ARE WE IN "REPEAT ONCE"? - JRST REPO1 ;YES -RSW2: MOVE CS,LIMBO ;GET LAST CHAR. - MOVEM C,LIMBO ;STORE THIS CHAR. FOR RPTC - CAIN C,LF ;LF? - CAIE CS,CR ;YES,LAST CHAR. A CR? - JRST RSW3 ;NO - HRROS LIMBO ;YES,FLAG - POPJ PP, ;AND EXIT - -RSW3: TLNE IO,IOSALL ;MACRO SUPPRESS ALL? - JUMPN MRP,CPOPJ ;YES,DON'T LIST IN MACRO - SOSG CPL ;ANY ROOM IN THE IMAGE BUFFER? - PUSHJ PP,OUTPL ;NO, OUTPUT THE PARTIAL LINE - IDPB C,LBUFP ;YES, STORE IN PRINT AREA - CAIE C,HT ;TAB? - POPJ PP, ;NO, EXIT - MOVEI C,7 - ANDCAM C,CPL ;MASK -CHARAX: HRRZ C,LIMBO ;GET LAST CHARACTER - POPJ PP, ;EXIT - -CHARL: PUSHJ PP,CHARAC ;GET AND TEST 7-BIT ASCII - CAIG C,FF ;LINE OR FORM FEED OR VT? - CAIGE C,LF - POPJ PP, ;NO,EXIT - SKIPE LITLVL ;IN LITERAL? - JRST OUTIML ;YES -CHARL1: PUSHJ PP,SAVEXS ;SAVE REGISTERS - PUSHJ PP,OUTLIN ;DUMP THE LINE - JRST RSTRXS ;RESTORE REGISTERS AND EXIT - SUBTTL CHARACTER STATUS TABLE - - DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO) - - - ;OPLVL PRIORITY OF BINARY OPERATORS - ;ATOM INDEX TO JUMP TABLE AT CELL1 - ;AN TYPE OF CHARACTER - ; 1=OTHER, 2=ALPHA, 4=NUMERIC - ;SQUOZ VALUE IN RADIX 50 - ;OPTYPE INDEX TO JUMP TABLE AT EVXCT - ;SEQNO VALUE IN SIXBIT -CSTAT: - GENCS 00,00,1,00,00,00 ; ' ' - GENCS 04,12,1,00,06,01 ; '!' - GENCS 00,07,1,00,00,02 ; '"' - GENCS 00,12,1,00,00,03 ; '#' - GENCS 00,01,2,46,00,04 ; '$' - GENCS 00,01,2,47,00,05 ; '%' - GENCS 04,12,1,00,07,06 ; '&' - GENCS 00,07,1,00,00,07 ; ''' - - GENCS 00,01,1,00,00,10 ; '(' - GENCS 00,01,1,00,00,11 ; ')' - GENCS 02,12,1,00,01,12 ; '*' - GENCS 01,00,1,00,03,13 ; '+' - GENCS 40,01,1,00,00,14 ; ',' - GENCS 01,02,1,00,04,15 ; '-' - GENCS 00,11,2,45,00,16 ; '.' - GENCS 02,12,1,00,02,17 ; '/' - - GENCS 00,04,4,01,00,20 ; '0' - GENCS 00,04,4,02,00,21 ; '1' - GENCS 00,04,4,03,00,22 ; '2' - GENCS 00,04,4,04,00,23 ; '3' - GENCS 00,04,4,05,00,24 ; '4' - GENCS 00,04,4,06,00,25 ; '5' - GENCS 00,04,4,07,00,26 ; '6' - GENCS 00,04,4,10,00,27 ; '7' - - GENCS 00,04,4,11,00,30 ; '8' - GENCS 00,04,4,12,00,31 ; '9' - GENCS 00,12,1,00,00,32 ; ':' - GENCS 00,01,1,00,00,33 ; ';' - GENCS 00,05,1,00,00,34 ; '<' - GENCS 00,12,1,00,00,35 ; '=' - GENCS 00,01,1,00,00,36 ; '>' - GENCS 00,12,1,00,00,37 ; '?' - GENCS 00,03,1,00,00,40 ; '@' - GENCS 00,01,2,13,00,41 ; 'A' - GENCS 00,01,2,14,00,42 ; 'B' - GENCS 00,01,2,15,00,43 ; 'C' - GENCS 00,01,2,16,00,44 ; 'D' - GENCS 00,01,2,17,00,45 ; 'E' - GENCS 00,01,2,20,00,46 ; 'F' - GENCS 00,01,2,21,00,47 ; 'G' - - GENCS 00,01,2,22,00,50 ; 'H' - GENCS 00,01,2,23,00,51 ; 'I' - GENCS 00,01,2,24,00,52 ; 'J' - GENCS 00,01,2,25,00,53 ; 'K' - GENCS 00,01,2,26,00,54 ; 'L' - GENCS 00,01,2,27,00,55 ; 'M' - GENCS 00,01,2,30,00,56 ; 'N' - GENCS 00,01,2,31,00,57 ; 'O' - - GENCS 00,01,2,32,00,60 ; 'P' - GENCS 00,01,2,33,00,61 ; 'Q' - GENCS 00,01,2,34,00,62 ; 'R' - GENCS 00,01,2,35,00,63 ; 'S' - GENCS 00,01,2,36,00,64 ; 'T' - GENCS 00,01,2,37,00,65 ; 'U' - GENCS 00,01,2,40,00,66 ; 'V' - GENCS 00,01,2,41,00,67 ; 'W' - - GENCS 00,01,2,42,00,70 ; 'X' - GENCS 00,01,2,43,00,71 ; 'Y' - GENCS 00,01,2,44,00,72 ; 'Z' - GENCS 00,06,1,00,00,73 ; '[' - GENCS 00,12,1,00,00,74 ; '\' - GENCS 00,01,1,00,00,75 ; ']' - GENCS 00,10,1,00,00,76 ; '^' - GENCS 10,12,1,00,05,77 ; '_' - SUBTTL LISTING ROUTINES - -OUTLIN: TRNN ER,ERRORS-ERRQ ;ANY ERRORS? - TLNE FR,ERRQSW ;NO, IGNORE Q ERRORS? - TRZ ER,ERRQ ;YES, YES, ZERO THE Q ERROR - HRLZ AC0,ER ;PUT ERROR FLAGS IN AC0 LEFT - TDZ ER,TYPERR - JUMP1 OUTL30 ;BRANCH IF PASS ONE - JUMPN AC0,OUTL02 ;JUMP IF ANY ERRORS TO FORCE PRINTING - SKIPL STPX ;SKIP IF NO CODE, OTHERWISE - JRST OUTL01 ;NO - TLNN IO,IOSALL ;YES,SUPPRESS ALL? - JRST OUTL03 ;NO - JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO - LDB C,[XWD 350700,LBUF] - CAIE C,15 ;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 - TLNN FR,CREFSW ;CREF? - PUSHJ PP,CLSCRF ;YES, WRITE END OF CREF DATA (177,003) - JUMPE AC0,OUTL20 ;BRANCH IF NO ERRORS - TLZE AC0,ERRM ;M ERROR? - TLO AC0,ERRP ;M ERROR SET - SET P ERROR. - PUSHJ PP,OUTLER ;PROCESS ERRORS - -OUTL20: SKIPN RC,ASGBLK - SKIPE CS,LOCBLK ; - SKIPL STPX ;ANY BINARY? - JRST OUTL23 ;YES, JUMP - JUMPE RC,OUTL22 ;SEQUENCE BREAK AND NO BINARY JUMPS - ILDB C,TABP ;ASSIGNMENT FALLS THROUGH - PUSHJ PP,OUTL ;OUTPUT A TAB. - ILDB C,TABP ;OUTPUT 2ND TAB, LOCATION FIELD - PUSHJ PP,OUTC ;NEXT IS BINARY LISTING FIELD - HLLO CS,LOCBLK ;LEFT HALF OF A 36BIT VALUE - JUMPL RC,.+2 ;SKIP IF LEFT HALF IS NOT RELOC - TRZA CS,1 ;IT IS, SET THE FLAG - TLNE CS,-1 ;SKIP IF ITS A 18BIT VALUE, OTHERWISE - PUSHJ PP,ONC1 ;PRINT LH OF A 36 BIT VALUE IN CS - HRLO CS,LOCBLK ;PICK UP THE RIGHT HALF (18BIT VALUE) - TRZ CS,0(RC) ; - PUSHJ PP,ONC ;PRINT IT - JRST OUTL23 ;SKIP SINGLE QUOTE TEST - OUTL22: PUSHJ PP,ONC ;TAB TO RH AND PRINT IT - MOVEI C,"'" - SKIPE MODA - PUSHJ PP,OUTC -OUTL23: SKIPL STPX ;ANY BINARY? - PUSHJ PP,BOUT ;YES, DUMP IT - MOVE CS,@OUTLI2 ;[POINT 7,LBUF] -OUTL24: ILDB C,CS - JUMPE C,OUTL25 - CAIG C," " - JRST OUTL24 - MOVE CS,TABP - PUSHJ PP,OUTASC ;OUTPUT TABS -OUTL25: MOVEI CS,LBUF - PUSHJ PP,OUTAS0 ;DUMP THE LINE - TLNE IO,IOSALL ;SUPPRESSING ALL - JUMPN MRP,OUTL27 ;YES,EXTRA CR IF IN MACRO -OUTL26: SKIPGE STPX ;ANY BINARY? - JRST OUTLI ;NO, CLEAN UP AND EXIT - PUSHJ PP,OUTLI2 ;YES, INITIALIZE FOR NEXT LINE - PUSHJ PP,BOUT ;YES, DUMP IT -OUTL27: PUSHJ PP,OUTCR ;OUTPUT CARRIAGE RETURN - JRST OUTL26 ;TEST FOR MORE BINARY - -OUTPL: SKIPN LITLVL ;IF IN LITERAL - SKIPL STPX ;OR CODE GENERATED - JRST OUTIM ;JUST OUTPUT THE IMAGE - SKIPN ASGBLK ;SKIP IF AN ASSIGNMENT - JRST OUTIM ;OTHERWISE OUTPUT IMAGE - PUSH PP,C ;SAVE CHAR. - MOVEI C,CR - IDPB C,LBUFP - MOVEI C,LF - IDPB C,LBUFP ;FINISH WITH CRLF - PUSHJ PP,OUTLIN ;OUTPUT PARTIAL LINE - POP PP,C ;RESTORE CHAR. - JRST OUTLI2 ;INITIALISE REST OF LINE - OUTL30: AOS CS,STPX ;PASS ONE - ADDM CS,LOCO ;INCREMENT OUTPUT LOCATION - PUSHJ PP,STOWI ;INITIALIZE STOW - TLZ AC0,ERRORS-ERRM-ERRP-ERRV - JUMPN AC0,OUTL32 ;JUMP IF ERRORS - TLNE IO,IOSALL ;SUPPRESSING ALL/ - JUMPN MRP,CPOPJ ;YES,EXIT - JRST OUTLI1 ;NO,INIT LINE - -OUTL32: IDPB AC0,LBUFP ;ZERO TERNIMATOR - IOR ER,OUTSW ;LIST ERRORS - MOVEI CS,TAG - PUSHJ PP,OUTSIX ;OUTPUT TAG - HRRZ C,TAGINC - PUSHJ PP,DNC ;CONVERT INCREMENT TO DECIMAL - PUSHJ PP,OUTTAB ;OUTPUT TAB - PUSHJ PP,OUTLER ;OUTPUT ERROR FLAGS - PUSHJ PP,OUTTAB - MOVEI CS,SEQNO ;ADDRESS OF SEQUENCE NO. - SKIPE SEQNO ;FILE NOT SEQUENCED - PUSHJ PP,OUTAS0 ;OUTPUT IT - JRST OUTL25 ;OUTPUT BASIC LINE - -OUTLER: PUSH PP,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,INDIR ;GET FILE NAME - CAME CS,LSTFIL ;AND SEE IF SAME - JRST [MOVEM CS,LSTFIL ;SAVE AS LAST ONE - MOVEI CS,LSTFIL - PUSHJ PP,OUTSIX ;LIST NAME - MOVEI C," " - PUSHJ PP,OUTL - MOVE CS,PAGENO ;PRINT PAGE NUMBER TOO - JRST OUTLE8] - MOVE CS,PAGENO ;NOW CHECK PAGE NUMBER - CAME CS,LSTPGN -OUTLE8: JRST [MOVEM CS,LSTPGN - MOVEI CS,[ASCIZ /PAGE /] - PUSHJ PP,OUTAS0 - MOVE C,PAGENO - PUSHJ PP,DNC - PUSHJ PP,OUTCR ;AND NOW FOR THE ERROR LINE - JRST .+1] - HLLM ER,(PP) ;RESTORE ER BUT NOT IO (LEFT HALF OF AC) - POP PP,ER - MOVE CS,[POINT 7,[ASCII / QXADLRUVNOPEM/]] -OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC - JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED - PUSHJ PP,OUTL ;OUTPUT THE CHARACTER - AOS ERRCNT ;INCREMENT ERROR COUNT -OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT - JUMPN AC0,OUTLE2 ;TEST FOR END - POPJ PP, ;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,CPOPJ ;YES ,EXIT IF IN MACRO - JUMP1 OUTLI1 ;BYPASS IF PASS ONE - PUSH PP,ER - TDZ ER,TYPERR - TLNN IO,IOMSTR!IOPROG!IOMAC - IOR ER,OUTSW - PUSH PP,C ;OUTPUT IMAGE - TLNN FR,CREFSW - PUSHJ PP,CLSCRF -OUTIM2: MOVE CS,TABP - PUSHJ PP,OUTASC ;OUTPUT TABS - IDPB C,LBUFP ;STORE ZERO TERMINATOR - MOVEI CS,LBUF - PUSHJ PP,OUTAS0 ;OUTPUT THE IMAGE - TLZN FR,IOSCR ;CRLF SUPPRESS? - PUSHJ PP,OUTCR ;NO,OUTPUT - POP PP,C - HLLM ER,0(PP) - POP PP,ER - JRST OUTLI2 - -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 -OUTLI2: MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS - MOVEM CS,LBUFP -IFN FORMSW, - MOVE CS,[POINT 7,TABI,6] - MOVEM CS,TABP - MOVEI CS,.CPL -IFN FORMSW, - 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 - POPJ PP, - OUTIML: TLNE IO,IOSALL ;SUPPRESSING ALL? - JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO - TRNN ER,ERRORS-ERRQ ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS - TLNE FR,ERRQSW - TRZ ER,ERRQ - HRLZ CS,ER - JUMP1 OUTML1 ;CHECK PASS1 ERRORS - TDZ ER,TYPERR - JUMPE CS,OUTIM1 - PUSH PP,[0] ;ERRORS SHOULD BE ZEROED - PUSH PP,C - PUSH PP,AC0 ;SAVE AC0 IN CASE CALLED FROM ASCII - MOVE AC0,CS ;ERROR ROUTINE WANTS FLAGS IN AC0 - IOR ER,OUTSW - TLNN FR,CREFSW - PUSHJ PP,CLSCRF ;FIX CREF - TLZE AC0,ERRM - TLO AC0,ERRP - PUSHJ PP,OUTLER ;OUTPUT THEM - POP PP,AC0 - JRST OUTIM2 ;AND LINE - -OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV - JUMPE CS,OUTLI2 ;NONE - TRZ ER,ERRM!ERRP!ERRV - TRO ER,ERRL - PUSH PP,ER ;SAVE - PUSH PP,C ;SAVE THIS - PUSH PP,AC0 ;AS ABOVE - MOVE AC0,CS ;... - TDZ ER,TYPERR - IOR ER,OUTSW - MOVEI CS,TAG - PUSHJ PP,OUTSIX - HRRZ C,TAGINC - PUSHJ PP,DNC - PUSHJ PP,OUTTAB - PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS - PUSHJ PP,OUTTAB - MOVEI CS,LBUF ;PRINT REST OF LINE - PUSHJ PP,SOUT20 - POP PP,AC0 - POP PP,C - POP PP,ER - JRST OUTLI2 - SUBTTL OUTPUT ROUTINES -UOUT: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN - TRNN ARG,PNTF ;WFW - TRNN ARG,UNDF - JRST UOUT13 ;TEST FOR UNDF!EXTF!PNTF ON PASS2 - JUMP2 UOUT10 - TLNN IO,IOIOPF ;ANY IOP'S SEEN - JRST UOUT12 ;NO,MAKE EXTERNAL - MOVSI CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE -UOUT1: CAME AC0,PRMTBL(CS) ;HAVE WE A MATCH? - AOBJN CS,UOUT2 ;NO,INCREMENT AND JUMP - MOVE ARG,PRMTBL+1(CS);YES,GET VALUE - MOVEM ARG,(SX) ;UPDATE SYMBOL TABLE - POPJ PP, ;EXIT -UOUT2: AOBJN CS,UOUT1 ;TEST FOR END - -UOUT12: PUSHJ PP,EXTER2 ;MAKE IT EXTERNAL - MOVSI ARG,UNDF ;BUT PUT UNDF BACK ON - IORM ARG,(SX) ;SO MESSAGE WILL COME OUT - POPJ PP, ;GET NEXT SYMBOL - -UOUT13: JUMP1 CPOPJ ;RECYCLE ON PASS1 - TRC ARG,UNDF!EXTF!PNTF ;CHECK FOR ALL THREE ON - TRCE ARG,UNDF!EXTF!PNTF ;ARE THEY? - POPJ PP, ;NO, RECYCLE -UOUT10: PUSHJ PP,OUTCR - PUSHJ PP,OUTSYM ;OUTPUT THE SYMBOL - MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL @/] - JRST OUTSIX ;POPJ FOR NEXT SYMBOL - -UOUT30: PUSHJ PP,ONC1 ;OUTPUT THE LOCATION - JRST HIGHQ ;EXIT THROUGH HIGHQ - ;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) - ANDCAI ARG,SYMF!INTF!ENTF - JUMPN ARG,EOUT1 ;IF INVALID, DON'T COUNT - AOJA C,EOUT1 ;BUMP COUNT - -EOUT2: HRLI C,4 ;BLOCK TYPE 4 - PUSHJ PP,OUTBIN - SETZB C,ARG - PUSHJ PP,OUTBIN - MOVE SX,SYMBOL - MOVE SDEL,0(SX) - MOVEI V,^D18 - -EOUT3: SOJL SDEL,POPOUT - ADDI SX,2 - HLRZ C,0(SX) - ANDCAI C,SYMF!INTF!ENTF - JUMPN C,EOUT3 - SOJGE V,EOUT4 ;TEST END OF BLOCK - PUSHJ PP,OUTBIN - MOVEI V,^D17 ;WFW -EOUT4: MOVE AC0,-1(SX) - PUSHJ PP,SQOZE - MOVE C,AC0 - PUSHJ PP,OUTBIN - JRST EOUT3 - ;OUTPUT THE SYMBOLS - -SOUT: SKIPN IONSYM ;SKIP IF NOSYM SEEN - TRNN ER,LPTSW!TTYSW ;A LISTING REQUIRED? - JRST SOUT1 ;NO - MOVEI [ASCIZ /SYMBOL TABLE/] - HRRM SUBTTX ;SET NEW SUB-TITLE - PUSHJ PP,OUTFF ;FORCE NEW PAGE - 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 - MOVEM ARG,SYMCNT - PUSHJ PP,LOUT1 ;OUTPUT THEM - MOVE ARG,SYMCNT ;SEE IF WE ENDED EVEN - CAME ARG,NCOLLS - PUSHJ PP,OUTCR ;NO, NEED CR - JRST SOUT1 ;NOW FOR BLOCK TYPE 2 - -LOUT1: PUSHJ PP,LLUKUP ;SET FOR TABLE SCAN - TRNN ARG,SYMF - TRNN ARG,MACF!SYNF - TDZA MRP,MRP ;SKIP AND CLEAR MRP - POPJ PP, ;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,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL - TRNE ARG,SUPRBT ;IF SUPRESSED -; JUMPGE MRP,POPOUT ;DO NOT OUTPUT UNLESS EXTERNAL - POPJ PP, ;DO NOT OUTPUT - AOS (PP) ;SET FOR SKIP RETURN IF SYMBOL IS PRINTED - JUMPGE MRP,LOUT10 ;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 - -LOUT10: PUSH PP,RC ;SAVE FOR LATER - PUSHJ PP,OUTSYM ;OUTPUT THE NAME - MOVE RC,(PP) ;GET COPY - MOVEI AC1,0 - JUMPLE MRP,LOUT15 ;SET DEFFERRED BITS IF EXTERNAL - TLNE RC,-2 ;CHECK FOR LEFT FIXUP - IORI AC1,40 ;AND SET BITS - TRNE RC,-2 ;CHECK FOR RIGHT FIXUP - IORI AC1,20 ;AND SET BITS -LOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL - HRRZS RC - TRNE RC,-2 - HLLZS RC - TLZE RC,-1 - TRO RC,2 - HRL MRP,RC - MOVEI RC,0 - TRNE ARG,ENTF ;ENTRY DMN - HRRI MRP,-5 - TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW - ADDI MRP,3 ;YES WFW - TRNE ARG,UNDF ;UNDEFINED IS EXTERNAL - HRRI MRP,2 ;SO FLAG AS UXT - IOR AC1,SOUTC(MRP) - MOVE ARG,AC1 - MOVEM AC0,SVSYM ;SAVE IT - MOVE AC0,V ;GET THE VALUE - HLRZ RC,MRP ;AND THE RELOCATION - HLLO CS,V - TRNE RC,2 ;LEFT HALF RELOCATABLE? - TRZA CS,1 ;NO, FLAG AND PRINT - TLNE CS,-1 ;IS THE LEFT HALF ZERO? - PUSHJ PP,ONC1 ;NO, OUTPUT IT -LOUT11: PUSHJ PP,OUTTAB -LOUT30: HRLO CS,V - TDZ CS,RC ;SET RELOCATION - PUSHJ PP,ONC1 - PUSHJ PP,OUTTAB - POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL -LOUT60: MOVEI CS,SOUTC(MRP) - PUSHJ PP,OUTAS0 ;EXT/INT - SOSLE SYMCNT ;SEE IF WE HAVE RUN OUT - JRST OUTTAB ;NOT YET, PRINT ONE TAB -LOUT64: MOVE CS,NCOLLS ;YES, RESET - MOVEM CS,SYMCNT - JRST OUTCR ;CARRIAGE RETURN AND TRY FOR ANOTHER - - - SYN IFBLK,SYMBLK ;SOMEWHERE TO STORE THE POINTERS - -LLUKUP: POP PP,LOOKX ;INTERCEPT RETURN POP - MOVE SX,SYMBOL - MOVE SDEL,(SX) - ADDI SX,2 ;SKIP COUNT OF SYMBOLS -LLUKP2: HRLI SX,-<.LPP-1> ;LENGTH OF PAGE - MOVE V,ARG ;COPY OF ARG - MOVEM SX,SYMBLK(V) ;STORE SYMBOL POINTER IN TABLE - ADDI SX,2*<.LPP-2> ;SYMBOLS PER PAGE - SOJG V,.-2 ;FOR ALL COLUMNS - MOVE V,SYMCNT - HRRZ SX,SYMBLK(V) - CAMGE SX,SYMTOP - SOJG V,.-2 - ADDI V,1 - MOVEM V,SYMBLK - JRST LLUKP7 ;ENTER LOOP - -LLUKP1: MOVEM SX,SYMBLK(ARG) ;SAVE IT - MOVE AC0,-1(SX) - PUSHJ PP,SRCH7 - HLRZS ARG - PUSHJ PP,@LOOKX - JRST [MOVE ARG,SYMCNT - MOVEM SX,SYMBLK(ARG) - JRST .+1] -LLUKP7: SOJL SDEL,POPOUT ;TEST FOR END -LLUKP3: MOVE ARG,SYMCNT ;GET PAGE POSITION - MOVE SX,SYMBLK(ARG) ;GET NEXT POINTER - AOBJP SX,LLUKP4 - HRRZ V,SX - CAMG V,SYMTOP - AOJA SX,LLUKP1 -LLUKP6: PUSHJ PP,LOUT64 ;RESET SYMCNT - JUMPE SDEL,POPOUT ;EXIT IF ALL DONE - JRST LLUKP3 - -LLUKP4: AOJ SX, - MOVEM SX,SYMBLK(ARG) - MOVE V,NCOLLS - SKIPGE SYMBLK(V) ;TEST IF ALL FINISHED - JRST LLUKP5 ;NO - SOJG V,.-2 ;KEEP GOING - MOVE SX,SYMBLK - MOVE SX,SYMBLK(SX) - HLRZ V,SX ;GET NUMBER ADVANCED - LSH V,1 ;2 WORDS PER SYMBOL - SUBI SX,2(V) ;BACK UP ONE SYMBOL - SKIPGE LPP ;IF PAGE FULL - JRST .+3 ;DON'T FINISH WITH EXTRA CR-LF - SETZM LPP ;ENSURE END OF PAGE - PUSHJ PP,LOUT64 - MOVE ARG,NCOLLS - MOVEM ARG,SYMCNT ;JUST IN CASE - JRST LLUKP2 - -LLUKP5: SOSG SYMCNT ;ON LAST COL? - JRST LLUKP6 - SKIPGE LPP ;IF PAGE FULL - JRST LLUKP3 ;NO MORE OUTPUT -REPEAT 2, ;NO, TAB OUT TO NEXT COLUMN - JRST LLUKP3 - SOUT1: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN - TRNN ARG,SYMF - TRNN ARG,MACF!SYNF - TDZA MRP,MRP ;SKIP AND CLEAR MRP - POPJ PP, ;NO, TRY AGAIN - TRNE ARG,INTF - MOVEI MRP,1 -IFN WFWSW, - TRNE ARG,EXTF - MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL - TRNE ARG,SYNF ;SYNONYM? - JUMPL MRP,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL - TRNE ARG,SUPRBT ;IF SUPRESSED -; JUMPGE MRP,POPOUT ;DO NOT OUTPUT UNLESS EXTERNAL - POPJ PP, ;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 PP,RC ;SAVE FOR LATER - MOVEI AC1,0 - JUMPLE MRP,SOUT15 ;SET DEFFERRED BITS IF EXTERNAL - TLNE RC,-2 ;CHECK FOR LEFT FIXUP - IORI AC1,40 ;AND SET BITS - TRNE RC,-2 ;CHECK FOR RIGHT FIXUP - IORI AC1,20 ;AND SET BITS -IFN WFWSW, -SOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL - HRRZS RC - TRNE RC,-2 - HLLZS RC - TLZE RC,-1 - TRO RC,2 - HRL MRP,RC - MOVEI RC,0 - TRNE ARG,ENTF ;ENTRY DMN - HRRI MRP,-5 - TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW - ADDI MRP,3 ;YES WFW - IOR AC1,SOUTC(MRP) - MOVE ARG,AC1 - PUSHJ PP,NOUT2 ;SQUOZE AND DUMP THE SYMBOL - MOVEM AC0,SVSYM ;SAVE IT - MOVE AC0,V ;GET THE VALUE - HLRZ RC,MRP ;AND THE RELOCATION - PUSHJ PP,COUT - POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL - TRNN RC,-2 ;IS IT? - JRST SOUT50 ;NO - MOVE AC0,1(RC) ;GET NAME -IFN WFWSW, - MOVEI ARG,60 ;EXTERNAL REQ - PUSHJ PP,SQOZE - HLLZS RC ;NO RELOC - PUSHJ PP,COUT ;OUTPUT IT - MOVE AC0,SVSYM ;GET SYMBOL NAME - TLO AC0,500000 ;SET AS ADDITIVE SYMBOL - TLZ AC0,200000 ;BUT NOT LEFT HALF ETC - PUSHJ PP,COUT -SOUT50: MOVSS RC ;CHECK LEFT HALF - TRNN RC,-2 - JRST SOUT60 - MOVE AC0,1(RC) -IFN WFWSW, - MOVEI ARG,60 - PUSHJ PP,SQOZE - MOVEI RC,0 - PUSHJ PP,COUT - MOVE AC0,SVSYM - TLO AC0,700000 - PUSHJ PP,COUT -SOUT60: POPJ PP, - -SOUT20: PUSHJ PP,OUTAS0 - JRST OUTCR - - !04 ;DMN - Z - Z - !44 ;SUPRESSED ENTRY - !60 -SOUTC: EXP 10 - !04 - !60 ;UNDEFINED EXTERNAL - !50 - !44 ;DMN - IFN WFWSW,< -INVRSF: MOVEI ARG,3 ;GET A BLOCK - ADDB ARG,FREE - CAML ARG,SYMBOL - PUSHJ PP,XCEEDS - MOVEM AC0,(ARG) ;SAVE WHICH HALF INFO - MOVE AC0,SVSYM ;GET SYMBOL NAME - TLZ AC0,740000 ;GET RID OF CODE BITS - MOVEM AC0,-1(ARG) ;SAVE IT - HLRZ AC0,(RC) ;SYMBOL TABLE FIXUP POINTER - MOVEM AC0,-2(ARG) ;LINK IN THIS BLOCK - SUBI ARG,2 ;POINT TO START OF BLOCK - HRLM ARG,(RC) - POPJ PP, - -SOUT1W: HLRZS V ;GET THE SYMBOL TABLE POINTER - MOVEI RC,3 ;SET UP A NEW BLOCK FOR THIS SYMBOL - ADDB RC,FREE - CAML RC,SYMBOL - PUSHJ PP,XCEEDS ;CHECK ON OUT OF ROOM - PUSH PP,ARG ;SAVE ARG AND ACO - PUSH PP,AC0 - MOVEI ARG,0 ;NO CODE BITS - PUSHJ PP,SQOZE ;CONVERT TO RAD50 - MOVEM AC0,-1(RC) ;SYMBOL NAME - POP PP,AC0 - POP PP,ARG ;RESTORE - HRRZM V,-2(RC) ;LINK TO NEXT BLOCK - MOVSI V,200000 ;FLAG AS SYMBOL TABLE FIXUP - MOVEM V,(RC) - HRRZ V,(SX) ;GET POINTER TO HEADER BLOCK - SUBI RC,2 ;POINT TO HEAD OF BLOCK - HRLM RC,(V) ;PUT IN LINK TO NEW BLOCK - MOVE RC,FIXLNK ;ADD SYMBOL TO CHAIN OF ONES TO DO - MOVEM SX,FIXLNK ;CHAIN THROUGH SYMBOL ENTRY - MOVEM RC,-1(SX) ;WHICH IS NO LONGER NEEDED - SETZB RC,V ;PUT OUT 0 FOR SYMBOL VALUE - JRST SOUT10> - ;OUTPUT THE BINARY - -BOUT: HRLO CS,LOCO ;PICKUP THE LOCATION - PUSHJ PP,ONC ;OUTPUT IT TO THE LISTING FILE - MOVEI C,"'" - SKIPE MODO ;IF MODE IS NOT ABSOLUTE - PUSHJ PP,OUTC ;PRINT A SINGLE QUOTE - PUSHJ PP,DSTOW ;GET THE CODE - PUSH PP,RC ;SAVE RELOC - PUSH PP,RC ;AND AGAIN -IFE WFWSW, -IFN WFWSW, - TRNN RC,-2 ;RIGHT EXT? - JRST BOUT30 ;NO -IFN WFWSW, -IFE WFWSW, - JRST BOUT30 ;PROCESS - - BOUT20: - HRRM AC1,-1(PP) ;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 - 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 - PUSH PP,AC0 ;NEED AN AC - HLRZ AC0,-1(PP) ;AC0 = LEFT RELOCATION - CAILE AC0,1 ;EXTERNAL? - XORI CS,EXTF!1 ;YES, SET SWITCH - IFN FORMSW,< - OR AC0,HWFMT - JUMPN AC0,BOUT3H ;EDIT IN HALF WORD FORMAT IF NOT 0 - MOVE AC0,FORM ;GET FORM WORD - MOVEI C,0 ;ZERO FIELD SIZE -BOUT3A: JFFO AC0,BOUT3B ;AC1 = FIELD SIZE -1 - JRST BOUT3C ;NO FIELDS LEFT, JUMP -BOUT3B: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD - MOVEI AC1,6(AC1) - IDIVI AC1,3 ;AC1 = COLUMNS USED + 1 - ADDI C,(AC1) ;INCREMENT FIELD SIZE - CAIG C,^D23 ;IS FIELD SIZE GTR 23? - JRST BOUT3A ;NO. CONTINUE - MOVE AC1,HWFORM ;USE STANDARD FORM - MOVEM AC1,FORM - MOVEI C,^D13 ;SET FIELD SIZE TO 13 -BOUT3C: MOVEM C,FLDSIZ ;STORE FIELD SIZE - MOVE AC0,FORM ;AC0 = FORM WORD - TRNN RC,2 ;IS LEFT HALF RELOCATED? - CAMN AC0,HWFORM ;NO. IS FORM HALF WORD? - JRST BOUT3H ;YES. EDIT IN OLD WAY - CAMN AC0,IOFORM ;IS IT I/O WORD - SETOM IOSEEN ;YES,NEED MORE WORK - IBP TABP - CAIL C,^D16 - IBP TABP - ILDB C,TABP ;GET A TAB - PUSHJ PP,OUTL ;OUTPUT IT - MOVE AC2,(PP) ;AC2 = INFO TO BE EDITED - PUSH PP,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. - PUSHJ PP,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 - PUSHJ PP,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," " - PUSHJ PP,OUTC ;OUTPUT A SPACE - JRST BOUT3D ;PROCESS NEXT FIELD - -BOUT3G: POP PP,CS ;RESTORE CS = C+1 - MOVEI C,0 - TRNE RC,1 ;RELOCATABLE? - MOVEI C,"'" ;YES - HRRZ AC0,-1(PP) ;AC0 = RIGHT RELOCATION - CAILE AC0,1 ;EXTERNAL? - MOVEI C,"*" ;YES - PUSHJ PP,ONC2 ;STORE POSSIBLE INDICATOR - POP PP,AC0 - JRST BOUT3I ;CONTINUE - -BOUT3H: MOVEI C,^D15 ;SET SIZE TO 15 - MOVEM C,FLDSIZ -> - POP PP,AC0 ;RESTORE - PUSHJ PP,ONC - HRLO CS,AC0 - TDZ CS,RC ;SET RELOCATION - HRRZ C,(PP) ;C = RIGHT RELOCATION - CAILE C,1 ;EXTERNAL - XORI CS,EXTF!1 ;YES, SET SWITCH - PUSHJ PP,ONC -BOUT3I: POP PP,CS ;GET RID OF ENTRY ON STACK - 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? - PUSHJ PP,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 - PUSHJ PP,COUT ;STORE BLOCK LOCATION AND MODE - EXCH RC,MODO ;RESTORE CURRENT VALUES - EXCH AC0,LOCO - - BOUT40: PUSHJ PP,COUT ;EMIT CODE - POP PP,RC ;RETRIEVE EXTERNAL BITS - TRNN RC,-2 ;RIGHT EXTERNAL? - JRST BOUT50 ;TRY FOR LEFT - PUSHJ PP,COUTD - PUSH PP,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 - PUSHJ PP,SQOZE ;CONVERT TO RADIX 50 - HLLZS RC ;SYMBOL HAS NO RELOCATION - PUSHJ PP,COUT ;EMIT - MOVE AC0,LOCO ;GET CURRENT LOC - HRLI AC0,400000 ;ADDITIVE REQ - HRR RC,MODO ;CURRENT MODE - PUSHJ PP,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 - PUSHJ PP,COUTD ;CHANGE MODE - PUSH PP,BLKTYP - MOVEI AC0,2 - MOVEM AC0,BLKTYP -BOUT70: MOVE AC0,1(RC) - MOVEI ARG,60 - PUSHJ PP,SQOZE - HLLZS RC - PUSHJ PP,COUT - MOVE AC0,LOCO - HRLI AC0,600000 ;LEFT HALF ADD - HRR RC,MODO - PUSHJ PP,COUT ;EMIT -BOUT60: PUSHJ PP,COUTD ;CHANGE MODE - POP PP,BLKTYP ;TO OLD ONE -BOUT80: AOS LOCO - AOS MODLOC - POPJ PP, - IFN WFWSW,< -INCSC1: HLRZ RC,(AC1) ;GET OFFSET OF NEXT BLOCK - CAMN RC,AC0 ;IS IT THE SAME?? - POPJ PP, ;YES, RETURN AC1 POINTS TO BLOCK -INCSRC: MOVE RC,AC1 ;CURRENT POINTER - HRRZ AC1,(AC1) ;IN CASE THIS COMES UP 0 - JUMPN AC1,INCSC1 ;SINCE 0 IS END OF CHAIN. ANY MORE?? - MOVEI AC1,3 ;NO, GET A NEW BLOCK - ADDB AC1,FREE - CAML AC1,SYMBOL - PUSHJ PP,XCEED - SUBI AC1,2 ;WE MUST BE POINTING RIGHT WHEN WE GET OUT - HRRM AC1,(RC) ;INSERT WHERE END OF CHAIN WAS - HRLZM AC0,(AC1) ;SET OFFSET AND END OF CHAIN - SETZM 1(AC1) - SETZM 2(AC1) ;NO LEFT OR RIGHT HALF FIXUPS - POPJ PP, ;DONE - -LVLINK: MOVE RC,LOCO ;GET CURRENT LOCATION - HRL RC,MODO ;AND MODE - EXCH RC,1(AC1) ;PUT IN AND GET PLACE TO LINK TO - POPJ PP,> - -IFN FORMSW,< -BOUT3J: MOVSS IOSEEN ;SWAP - SKIPGE IOSEEN ;SKIP IF NOT FIRST FIELD - JRST [HLLZS IOSEEN ;CLEAR RIGHT HALF - POPJ PP,] ;AND RETURN - MOVSS IOSEEN ;SWAP BACK - LSH AC1,2 ;CORRECT MNEMONIC AND OP CODE - CAIE C,1 ;IS IT OP CODE? - POPJ PP, ;NO,JUST RETURN - MOVEI C,2 ;TWO CHAR. WIDE NOW - SETZM IOSEEN ;DON'T COME AGAIN - POPJ PP, ;RETURN -> - 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 ;... - 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 - POPJ PP, ;RETURN TO PUT IT IN THE TABLE - -IFN CCLSW,< TLNN IO,IOTLSN ;AND IF WE HAVE NOT SEEN A TITLE - PUSHJ PP,PRNAM ;THEN PRINT THE NAME> -NOUT2: PUSHJ PP,SQOZE ;CONVERT TO SIXBIT - JRST COUT ;DUMP AND EXIT - -HOUT: - MOVEI RC,1 ;RELOCATABLE -IFN RENTSW,< - MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS - JUMPE AC0,.+2 ;NOT TWO SEGMENTS - PUSHJ PP,COUT ;OUTPUT IT > - MOVE AC0,HIGH -IFN RENTSW,< - SKIPE HHIGH ;ANY TWOSEG HIGH STUFF - JRST COUT ;YES,SO NO ABS.> - PUSHJ PP,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 RENTSW,< -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 .+2 - POPJ PP, ;YES, EXIT - MOVE AC0,VECTOR ;AC0 SHOULD BE FLAGS - -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? - POPJ PP, ;NO, EXIT - -COUTD: AOSG C,COUTX ;DUMP THE BUFFER - JRST COUTI ;BUFFER WAS EMPTY - HRL C,BLKTYP ;SET BLOCK TYPE - PUSHJ PP,OUTBIN ;OUTPUT COUNT AND TYPE - SETOB C,COUTY ;INITIALIZE INDEX - -COUTD2: MOVE C,COUTDB(C) ;GET RELOCATION BITS/CODE - PUSHJ PP,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 - MOVE C,[POINT 2,COUTRB] - MOVEM C,COUTP ;INITIALIZE BIT POINTER - POPJ PP, ;EXIT - STOWZ1: -IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM> -STOWZ: MOVEI RC,0 -STOW: -IFN FORMSW,< MOVEM AC1,FORM ;STORE FORM WORD> - JUMP1 STOW20 ;SKIP TEST IF PASS ONE - TRNE RC,-2 ;RIGHT HALF ZERO OR 1? - PUSHJ PP,STOWT ;NO, HANDLE EXTERNAL - TLNN RC,-2 ;LEFT HALF ZERO OR 1? WFW - JRST STOW10 ;YES, SKIP TEST - MOVSS RC ;SWAP HALVES - PUSHJ PP,STOWT1 ;HANDLE EXTERNAL WFW - MOVSS RC ;RESTORE VALUES - -STOW10: SKIPE EXTPNT ;ANY EXTERNALS REMAINING? - TRO ER,ERRE ;YES, SET EXTERNAL ERROR FLAG - -STOW20: AOS AC1,STPX ;INCREMENT POINTER - MOVEM AC0,STCODE(AC1) ;STOW CODE - MOVEM RC,STOWRC(AC1) ;STOW RELOCATION BITS -IFN FORMSW,< - PUSH PP,FORM - POP PP,STFORM(AC1) ;STORE FORM WORD -> - SKIPN LITLVL ;ARE WE IN LITERAL? - AOS LOCA ;NO, INCREMENT ASSEMBLY LOCATION - CAIGE AC1,.STP-1 ;OVERFLOW? - POPJ PP, ;NO, EXIT - - SKIPE LITLVL ;ARE WE IN A LITERAL? - TROA ER,ERRL ;YES, FLAG ERROR BUT DON'T DUMP - JRST CHARL1 ;NO, SAVE REGISTERS AND DUMP THE BUFFER - JRST STOWI ;INITIALIZE BUFFER - -DSTOW: AOS AC1,STPY ;INCREMENT POINTER - MOVE AC0,STCODE(AC1) ;FETCH CODE - MOVE RC,STOWRC(AC1) ;FETCH RELOCATION BITS -IFN FORMSW,< - PUSH PP,STFORM(AC1) - POP PP,FORM ;GET FORM WORD -> - CAMGE AC1,STPX ;IS THIS THE END? - POPJ PP, ;NO, EXIT - -STOWI: SETOM STPX ;INITIALIZE FOR INPUT - SETOM STPY ;INITIALIZE FOR OUTPUT - SETZM EXTPNT - POPJ PP, ;EXIT - SVSTOW: AOS LITLVL ;NESTED LITERALS - PUSH PP,STPX ;MAKE ROOM FOR ANOTHER - PUSH PP,STPY - MOVE AC1,STPX - MOVEM AC1,STPY - JRST 0(AC2) - -GTSTOW: POP PP,STPY ;BACK UP A LEVEL - POP PP,STPX - SOS LITLVL - JRST 0(AC2) - - ;EXTERNAL RIGHT -STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER - CAIE AC1,(RC) ;DOES IT MATCH - PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR - HLLZS EXTPNT - POPJ PP, ;EXIT - - ;EXTERNAL LEFT -STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF - CAIE AC1,(RC) ;SEE ABOVE - PUSHJ PP,QEXT - HRRZS EXTPNT - POPJ PP, ;EXIT - ONC: ILDB C,TABP ;ENTRY TO ADVANCE TAB POINTER - PUSHJ PP,OUTL ;OUTPUT A TAB - ;OUTPUT 6 OCT NUMBERS FROM CS LEFT -ONC1: MOVEI C,6 ;CONVERT TO ASCII - LSHC C,3 ;SHIFT IN OCTAL - PUSHJ PP,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 -ONC2: JUMPN C,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE -IFN FORMSW,< SOS FLDSIZ ;DECREMENT FIELD SIZE> - POPJ PP, ;EXIT - -DNC: IDIVI C,^D10 - HRLM CS,0(PP) - JUMPE C,.+2 - PUSHJ PP,DNC ;RECURSE IF NON-ZERO - HLRZ C,0(PP) - ADDI C,"0" ;FORM ASCII - JRST PRINT ;DUMP AND TEST FOR END - -OUTAS0: HRLI CS,(POINT 7,,) ;ENTRY TO SET POINTER -OUTASC: ILDB C,CS ;GET NEXT BYTE - JUMPE C,POPOUT ;EXIT ON ZERO DELIMITER - PUSHJ PP,PRINT - JRST OUTASC - -OUTSIX: HRLI CS,(POINT 6,,) ;OUTPUT SIXBIT - ILDB C,CS ;GET SIXBIT - CAIN C,40 ;"@" DELIMITER? - POPJ PP, ;YES, EXIT - ADDI C,40 ;NO, FORM ASCII - PUSHJ PP,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,OUTTAB ;TEST FOR END - ADDI C,40 ;CONVERT TO ASCII - PUSHJ PP,OUTL ;OUTPUT - JRST OUTSY1 ;LOOP - OUTSET: AOS SX,0(PP) ;GET RETURN LOCATION - MOVE SX,-1(SX) ;GET XWD CODE - HLRM SX,BLKTYP ;SET BLOCK TYPE - SETZB ARG,RC - PUSHJ PP,0(SX) ;GO TO PRESCRIBED ROUTINE - JRST COUTD ;TERMINATE BLOCK AND EXIT - - ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE - -LOOKUP: POP PP,LOOKX ;INTERCEPT RETURN POP - MOVE SX,SYMBOL - MOVE SDEL,0(SX) ;SET FOR TABLE SCAN -LOOKL: SOJL SDEL,POPOUT ;TEST FOR END - ADDI SX,2 - MOVE AC0,-1(SX) - PUSHJ PP,SRCH7 ;LOAD REGISTERS - HLRZS ARG - PUSHJ PP,@LOOKX ;RETURN TO CALLING ROUTINE - JRST LOOKL ;TRY AGAIN - END0: PUSHJ PP,EVALCM ;GET A WORD - SKIPE EXTPNT ;ANY EXTERNALS? - TRO ER,ERRE ;YES, ERROR - SKIPN V,AC0 ;NON-ZERO? - JUMPE RC,.+2 ;OR RELOC? - PUSHJ PP,ASSIG7 ;YES, LIST THE VALUE - MOVEM AC0,VECTOR - MOVEM RC,VECREL - PUSHJ PP,VARA ;FILL OUT SELF-DEFINED VARIABLES - PUSHJ PP,STOUTS ;DUMP THE LINE -; PUSH PP,IO ;SAVE FLAGS -; TLO IO,IOPROG ;XLIST LITS - PUSHJ PP,LIT1 -; POP PP,IO ;GET FLAG BACK - JUMP2 ENDP2 - - PUSHJ PP,UOUT - TLNN IO,MFLSW ;SKIP IF ONLY PSEND - PUSHJ PP,REC2 - MOVE INDIR ;SET UP FIRST AS LAST - MOVEM LSTFIL ;PRINTED - SETZM LSTPGN - PUSHJ PP,INZ - TLNE IO,MFLSW ;IF PSEND - POPJ PP, ;BACK TO PSEND0 - SKIPE PRGPTR ;HAVE ANY PRGEND'S BEEN SEEN - JRST PSEND3 ;YES,GO SET UP AGAIN - -PASS20: SETZM CTLSAV - PUSHJ PP,COUTI - PUSHJ PP,EOUT ;OUTPUT THE ENTRIES - PUSHJ PP,OUTSET - XWD 6,NOUT ;OUTPUT THE NAME (BLKTYP-6) -IFN RENTSW,< - SKIPN HISNSW ;PUT OUT BLOCK TYPE 3? - JRST PASS21 ;NO - PUSHJ PP,OUTSET - XWD 3,HSOUT ;OUTPUT THE HISEG BLOCK -PASS21: > - 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 ;SO LISTINGS WILL BE THE WAY THEY SHOULD - TLNN FR,R1BSW - JRST STOWI - - MOVE CS,[XWD $ST-1-$CKSM,R1BLDR] - MOVE C,0(CS) - PUSHJ PP,PTPBIN - AOBJN CS,.-2 - PUSHJ PP,R1BI - JRST STOWI - -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> - ENDP2: PUSHJ PP,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] -IFN RENTSW, - CAMN AC0,HIGH - HRRZM AC2,HIGH -ENDP2W: -REPEAT 1, -REPEAT 0, ;NEEDS FIX TO CREF - PUSHJ PP,CLSCR2 ;CLOSE IT UP -ENDP2Q: HRR ER,OUTSW ;SET OUTPUT SWITCH - SKIPN TYPERR - TRO ER,TTYSW - PUSHJ PP,UOUT ;OUTPUT UNDEFINEDS - TRO ER,TTYSW - SKPINC C ;SEE IF WE CAN INPUT A CHAR. - JFCL ;BUT ONLY TO DEFEAT ^O - SKIPG C,ERRCNT ;GET ERROR COUNT AND CHECK FOR POSITIVE - JRST NOERW ;PRINT NO ERROR MESSAGE -IFN CCLSW, - PUSHJ PP,OUTCR - MOVE C,ERRCNT - CAIN C,1 ;1 IS A SPECIAL CASE - JRST ONERW ;PRINT MESSAGE - MOVEI C,"?" ;? FOR BATCH - PUSHJ PP,OUTL ;... - MOVE C,ERRCNT ;PRINT NUMBER OF ERRORS - PUSHJ PP,DNC - SKIPA CS,[EXP ERRMS1] ;LOAD TO PRINT -ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DETECTED -ONERW1: PUSHJ PP,OUTSIX ;PRINT - JRST ENDP2A -NOERW: MOVEI CS,ERRMS3 -IFN CCLSW, -IFE CCLSW, - TRZ ER,TTYSW ;NO TTY OUTPUT - IOR ER,OUTSW ;UNLESS NEEDED FOR LISTING - PUSHJ PP,OUTCR - JRST ONERW1 - - ENDP2A: PUSHJ PP,OUTCR - TLNN IO,MFLSW ;IN A MULTI-PROG FILE? - JRST ENDP2D ;NO - SKIPE ERRCNT ;ANY ERROR? - PUSHJ PP,[MOVEI CS,[ASCIZ /PROGRAM /] - PUSHJ PP,OUTAS0 ;YES,SO PRINT MESSAGE - MOVEI CS,TBUF ;AND TITLE - PUSHJ PP,OUTAS0 ;FOR IDENTIFICATION - JRST OUTCR] ;AND A CR-LF - TRZA ER,TTYSW ;NO MORE OUTPUT NOW -ENDP2D: -IFN CCLSW, -IFE CCLSW,< SKIPA ;SO PRGEND CODE CAN WORK> - IOR ER,OUTSW ;... - PUSHJ PP,OUTCR -IFN RENTSW,< - MOVEI CS,[SIXBIT /HI-SEG. BREAK IS @/] - SKIPN HHIGH ;DON'T PRINT IF ZERO - JRST ENDP2C ;IT WAS - PUSHJ PP,OUTSIX - HRLO CS,HHIGH ;GET THE BREAK - PUSHJ PP,ONC1 - PUSHJ PP,OUTCR -ENDP2C:> - MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/] - PUSHJ PP,OUTSIX ;OUTPUT PROGRAM BREAK - HRRZ CS,ABSHI ;GET ABS. BREAK - CAIG CS,140 ;ANY ABS. CODE - JRST [HRLO CS,HIGH ;NO - JRST ENDP2B] ;SO DON'T PRINT - HRLO CS,HIGH ;GET PROGRAM BREAK - PUSHJ PP,ONC1 - PUSHJ PP,OUTCR - MOVEI CS,[SIXBIT /ABSLUTE BREAK IS @/] - PUSHJ PP,OUTSIX - HRLO CS,ABSHI -ENDP2B: PUSHJ PP,ONC1 - PUSHJ PP,OUTCR - TLNE FR,RIMSW!R1BSW ;RIM MODE? - PUSHJ PP,RIMFIN ;YES, FINISH IT -IFN CCLSW, -IFE CCLSW, - TRO ER,TTYSW ;PRINT SIZE - PUSHJ PP,OUTCR - MOVE C,JOBREL - LSH C,-^D10 - ADDI C,1 - PUSHJ PP,DNC - MOVEI CS,[SIXBIT /K CORE USED@/] - PUSHJ PP,OUTSIX - PUSHJ PP,OUTCR - HRR ER,OUTSW - PUSHJ PP,OUTSET - XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2) - PUSHJ PP,OUTSET - XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7) -IFN WFWSW, - PUSHJ PP,OUTSET - XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5) - PUSHJ PP,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] - BLT PASS2Z-1 ;BUT NOT ALL OF VARIABLES - JRST INZ ;RE-INITIALIZE FOR NEXT PROG - IFN WFWSW,< -OUTB12: SKIPN ARG,FIXLNK ;WERE THERE ANY?? - POPJ PP, ;JUST GO AWAY -OUTB19: HRRZ SX,(ARG) ;POINTER TO HEADER BLOCK NOW IN SX - HRRZ AC1,(SX) ;NOW AC1 HAS POINTER TO CODE FIXUPS - JUMPE AC1,OUTB13 ;NONE THERE -OUTB16: HLRZ AC0,(AC1) ;GET LOCATION OFFSET - ADD AC0,2(SX) ;ADD BASE LOCATION - SKIPN 1(AC1) ;AND RIGHT HALF?? - JRST OUTB14 ;NO - PUSH PP,AC0 ;SAVE FIXUP VALUE - SETZB AC0,RC - PUSHJ PP,OUTBWD ;OUTPUT A Z (SAYS RIGHT HALF CODE) - POP PP,AC0 ;GET VALUE BACK - HLRZ RC,1(AC1) ;GET RELOC OF FIXUP CHAIN - LSH RC,1 ;GOES IN LEFT HALF - HRL AC0,1(AC1) ;LOCATION OF CHAIN - PUSHJ PP,OUTBWD ;LEFT HALF LOCATION, RIGHT HALF VALUE -OUTB14: SKIPN 2(AC1) ;ANY LEFT HALF?? - JRST OUTB15 ;NO, GO LOOK FOR NEXT BLOCK - PUSH PP,AC0 ;SAVE VALUE - MOVEI RC,0 - MOVSI AC0,400000 ;INDICATE LEFT HALF - PUSHJ PP,OUTBWD - POP PP,AC0 - HLRZ RC,2(AC1) ;GET RELOC FOR LEFT HALF - LSH RC,1 - HRL AC0,2(AC1) - PUSHJ PP,OUTBWD -OUTB15: HRRZ AC1,(AC1) ;NEXT LINK IN CHAIN - JUMPN AC1,OUTB16 ;IF NOT END, PROCESS -OUTB13: HLRZ AC1,(SX) ;POINTER TO SYMBOL TABLE FIXUP CHAIN - JUMPE AC1,OUTB17 ;CHACK FOR SOME THERE -OUTB18: MOVE AC0,2(AC1) ;FLAGS - HRR AC0,2(SX) ;VALUE IN RH - MOVEI RC,0 ;NO RELCO ON IT - PUSHJ PP,OUTBWD - MOVE AC0,1(AC1) ;THE SYMBOL NAME - PUSHJ PP,OUTBWD - HRRZ AC1,(AC1) ;FOOLOW CHAIN - JUMPN AC1,OUTB18 -OUTB17: HRRZ ARG,-1(ARG) ;DONE WITH THIS SYMBOL GET NEXT - JUMPN ARG,OUTB19 - POPJ PP, ;ALL DONE - -OUTBWD: SKIPL COUTX ;IF WE ARE AT THE START - JRST COUT ;NO PUT OUT - PUSH PP,AC0 ;WE NEED TO PUT NEW RELOC AND VAR LENGTH - PUSH PP,RC ;AS FIRST TWO WORDS - MOVE AC0,HIGH - MOVEI RC,1 ;IT IS RELOC - PUSHJ PP,COUT - MOVE AC0,LVARLC ;THE LENGTH - MOVEI RC,0 - PUSHJ PP,COUT - POP PP,RC - POP PP,AC0 - JRST COUT ;NOW PUT OUT THE ONE WE WANTED TO -> - -RIMFIN: TLNE FR,R1BSW - PUSHJ PP,R1BDMP - SKIPN C,VECTOR - MOVSI C,(JRST 4,) - TLNN C,777000 - TLO C,(JRST) - PUSHJ PP,PTPBIN - MOVEI C,0 - JRST PTPBIN - SUBTTL PASS INITIALIZE -INZ: AOS MODA - AOS MODO - SETZM SEQNO - SETZM TAG - HRRI RX,^D8 - MOVEI VARHD - MOVEM VARHDX - MOVEI LITHD - MOVEM LITHDX - PUSHJ PP,LITI - PUSHJ PP,STOWI -IFN FORMSW,< - HRRES HWFMT ;SET DEFAULT VALUE BACK> - JRST OUTLI - -RCPNTR: POINT 1,ARG,^L-18 ;POINT 1,ARG,22 - SUBTTL PSEUDO-OP HANDLERS - -TAPE0: PUSHJ PP,STOUTS ;FINISH THIS LINE - JRST GOTEND ;AND IGNORE THE REST OF THIS FILE - -RADIX0: PUSHJ PP,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 - HRR RX,AC0 ;SET NEW RADIX - POPJ PP, - - -XALL0: TLZ IO,IOSALL ;TURN OFF MACRO SUPPRESS ALL -IOSET: JUMP1 POPOUT ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG) - HLRZ SX,AC0 ;STORE FLAGS - PUSHJ PP,STOUTS ;POLISH OFF LINE - TLO IO,0(SX) ;NOW SUPRESS PRINTING - POPJ PP, - -IORSET: TDZ IO,AC0 ;RESET FLAG IOPALL/IOPROG - TLNE AC0,IONCRF ;RESTORING CREFFING? - TLZ IO,DEFCRS ;YES, CLEAR ANY WAITING DEFINING OCCURENCES - POPJ PP, - -BLOCK0: PUSHJ PP,HIGHQ - PUSHJ PP,EVALEX ;EVALUATE - TRZE RC,-1 ;EXTERNAL OR RELOCATABLE? - PUSHJ PP,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 POPOUT - TRNE ER,ERRU - TRO ER,ERRV - POPJ PP, - -PRNTX0: TRO ER,TTYSW ;SET OUTPUT TO TTY - JUMP2 PRNTX2 ;PASS1? - TDOA ER,OUTSW ;YES,OUTPUT TO LSTDEV ALSO -PRNTX2: ANDCM ER,OUTSW ;NO,DON'T OUTPUT TO TTY IF IT IS LSTDEV - PUSHJ PP,BYPASS ;GET FIRST CHAR. - TLOA IO,IORPTC ;REPEAT IT AND SKIP -PRNTX4: PUSHJ PP,PRINT ;PRINT THE CHAR. - PUSHJ PP,CHARAC ;GET ASCII CHAR. - CAIG C,CR ;IF GREATER THAN CR - CAIG C,HT ;OR LESS THAN LF - JRST PRNTX4 ;THEN CONTINUE - PUSHJ PP,OUTCR ;OUTPUT A CRLF - TRZA ER,TTYSW!LPTSW ;TURN OF OUTPUT -CPOPJ1: AOS (PP) ;USEFUL TAG HAS TO GO SOMEWHERE -CPOPJ: POPJ PP, ;EXIT - -REMAR0: PUSHJ PP,GETCHR ;GET A CHARACTER - CAIE C,EOL - JRST REMAR0 - POPJ PP, ;EXIT - LIT0: PUSHJ PP,BLOCK1 - PUSHJ PP,STOUTS -LIT1: JUMP2 LIT20 - -;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR - - MOVE AC0,LITCNT - MOVE SX,LITHDX - HRLM AC0,0(SX) - MOVE V,LOCA - HRL V,MODA - MOVEM V,-1(SX) - JRST LIT24 - -LIT20: PUSH PP,LOCA - PUSH PP,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 - MOVE SX,(SX) ;WFW POINTER TO THE NEXT LIT - PUSHJ PP,STOW20 ;STOW CODE - MOVEI C,12 ;SET LINE FEED - IDPB C,LBUFP - PUSHJ PP,OUTLIN ;OUTPUT THE LINE - JRST LIT21 - LIT22: HRRZ AC2,LOCO - POP PP,LOCO - POP PP,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 - PUSHJ PP,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,POPOUT -IFE FORMSW,< MOVEI SX,3 ;WFW> -IFN FORMSW,< MOVEI SX,4 ;ICC> - ADDB SX,FREE - CAML SX,SYMBOL - PUSHJ PP,XCEED - SUBI SX,1 ;MAKE SX POINT TO LINK - SETZM 0(SX) ;CLEAR FORWARD LINK - HRRM SX,0(AC1) ;STORE ADDRESS IN LAST LINK - POPJ PP, - VAR0: PUSHJ PP,BLOCK1 ;PRINT LOCATION - PUSHJ PP,VARA - JRST STOUTS - -VARA: MOVE SX,VARHDX - MOVE AC0,LOCA ;GET LOCATION FOR CHECK - JUMP1 VARB ;DO NOT CHECK START ON PASS 1 - CAME AC0,-1(SX) ;CHECK START OF VAR AREA - TRO ER,ERRP ;AND GIVE ERROR -VARB: MOVEM AC0,-1(SX) ;SAVE START FOR PASS 2 - HLRZ AC0,0(SX) - ADDM AC0,LOCA - ADDM AC0,LOCO - PUSHJ PP,GETTOP - HRRM SX,VARHDX - JUMP2 POPOUT - - PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN -IFN WFWSW, - TRZN ARG,VARF - POPJ PP, ;NO, EXIT - TRZ ARG,UNDF ;TURN OFF FLAG NOW -IFN WFWSW, -IFE WFWSW, - ADDM AC0,0(AC1) ;UPDATE COUNT -IFN WFWSW,< -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 -IFE WFWSW, - MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY -IFE WFWSW, - JRST HIGHQ1 - IF: PUSH PP,AC0 ;SAVE AC0 - PUSH PP,IO - PUSHJ PP,EVALXQ ;EVALUATE AND TEST EXTERNAL - POP PP,AC1 - JUMPL AC1,IFPOP - TLZ IO,FLDSW -IFPOP: POP PP,AC1 ;RETRIEVE SKIP INSTRUCTION -IFSET: TLO IO,IORPTC ;REPEAT CHARACTER -IFXCT: XCT AC1 ;EXECUTE INSTRUCTION - TDZA AC0,AC0 ;FALSE - MOVEI AC0,1 ;TRUE -IFEXIT: JUMPOC REPEA1 ;BRANCH IF IN OP-CODE FIELD -IFEX1: PUSHJ PP,GETCHR ;SEARCH FOR "<" - CAIN C,EOL ;ERROR IF END OF LINE - JRST ERRAX - CAIE C,34 - JRST IFEX1 - JUMPE AC0,IFEX2 ;TEST FOR 0 - TLO IO,IORPTC ;NO, PROCESS AS CELL - PUSHJ PP,CELL -IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM> - SETZM INCND ;NOT ANY MORE - JRST STOW ;STOW CODE AND EXIT - -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: PUSHJ PP,CHARL ;GET FIRST NON-BLANK - CAIE C," " - CAIN C," " - JRST IFB1 ;SKIP BLANKS AND TABS - CAIG C,CR ;CHECK FOR CARRET AS DELIM. - CAIGE C,LF - SKIPA SX,SEQNO2 - JRST ERRAX - MOVEM SX,CNDSEQ - MOVE SX,PAGENO - MOVEM SX,CNDPG - 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: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST - CAMN C,SX ;TEST FOR DELIMITER - JRST IFXCT ;FOUND - CAIE C," " ;BLANK? - CAIN C," " ;OR TAB? - JRST IFB2 ;YES - JUMPN SX,IFB3 ;JUMP IF NEW FORMAT - CAIN C,"<" ;" ;>? - SOJL RC,IFXCT ;YES, DECREMENT AND EXIT IF DONE - JRST IFB3 ;GET NEXT CHARACTER - - IFDEF0: HRRI AC0,UNDF ;MAKE IT TLNX ARG,UNDF - PUSH PP,AC0 ;STACK IT - PUSHJ PP,GETSYM ;TAKES SKIP RETURN IF SYM NAME IS LEGAL - TROA ER,ERRA ;ILLEGAL! - PUSHJ PP,SEARCH - JRST [PUSHJ PP,OPTSCH - TLO ARG,UNDF - JRST .+1] - PUSHJ PP,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 - PUSHJ PP,IFCL ;GET FIRST STRING - MOVEI RC,IFBLKA - PUSHJ PP,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: PUSHJ PP,CHARAC ;GET AND LIST CHARACTER - CAIE C," " ;SKIP SPACES - CAIG C,CR ;ALSO SKIP CR-LF - CAIGE C,HT ;AND TAB - JRST .+2 ;NOT ONE OF THEM - JRST IFCL ;SO LONG COMPARISONS WILL WORK -;*** A CROCK SO THAT IFIDN ,, WILL WORK *** - CAIE C,"," ;IS IT A COMMA? - JRST .+3 ;NO - SKIPN .TEMP ;YES, WAS PREVIOUS FIELD OLD METHOD? - JRST IFCL ;YES, IGNORE COMMA AND SPACES -; *** - CAIN C,"<" ;WAS IT LEFT BRACKET? - SETO C, ;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET - MOVEM C,.TEMP ;STORE TERMINATOR FOR COMPARISON - MOVEI SX,5*.IFBLK-1 ;LIMIT SEARCH - HRLI RC,(POINT 7,,) ;SET UP BYTE IN RC -IFCLR: PUSHJ PP,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 - POPJ PP, ;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 - - -IFEX2: PUSHJ PP,GETCHR - CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE - JRST ERRAX - CAIN C,34 ;"<"? - AOJA AC0,IFEX2 ;YES, INCREMENT COUNT - CAIE C,36 ;">"? - JRST IFEX2 ;NO, TRY AGAIN - SOJGE AC0,IFEX2 ;YES, TEST FOR MATCH - PUSHJ PP,BYPASS ;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: PUSHJ PP,GETSYM ;GET A SYMBOL - JRST INTER3 ;INVALID, SKIP - PUSHJ PP,SSRCH ;SEARCH THE TABLE - MOVSI ARG,SYMF!INTF!UNDF - TLNE ARG,UNDF ;UNDEFINED? - TRO ER,ERRA ;YES, FLAG ERROR -IFN WFWSW, - TLNN ARG,SYNF!EXTF - TDOA ARG,INTENT ;SET APPROPRIATE FLAGS -INTER3: TROA ER,ERRA ;FLAG ARG EROR AND SKIP - PUSHJ PP,INSERQ ;INSERT/UPDATE - JUMPCM INTER1 - SETZM EXTPNT ;JUST IN CASE, SO AS NOT TO CONFUSE WORLD - POPJ PP, ;NO, EXIT - EXTER0: PUSHJ PP,GETSYM ;GET A SYMBOL - JRST EXTER4 ;INVALID, ERROR -EXTER1: TLO IO,DEFCRS ;FLAG THIS AS A DEFINITION - PUSHJ PP,SSRCH ;OK, SEARCH SYMBOL TABLE - JRST EXTER2 ;NOT THERE, INSERT IT - TLNN ARG,EXTF!VARF!UNDF - TROA ER,ERRE ;FLAG ERROR 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: MOVEI V,2 ;NO, GET 2 CELLS FROM THE TREE - ADDB V,FREE - CAML V,SYMBOL ;HAVE WE RUN OUT OF CORE? - PUSHJ PP,XCEEDS ;YES, TRY TO BORROW SOME MORE - SUBI V,2 ;GET RIGHT CELL FOR POINTER - SETZB RC,0(V) ;ALL SET, ZERO VALUES - MOVSI ARG,SYMF!EXTF - PUSHJ PP,INSERT ;INSERT/UPDATE IT - MOVSI ARG,PNTF - IORM ARG,0(SX) - SKIPA ARG,-1(SX) ;GET THE SIXBIT FOR THE NAME -EXTER4: TROA ER,ERRA ;FLAG AS ERROR - MOVEM ARG,1(V) ;AND STORE THAT IN CASE SYMBOL TABLE MOVES -EXTER3: JUMPCM EXTER0 - POPJ PP, ;NO, EXIT - EVAL10: PUSH PP,RX - HRRI RX,^D10 - PUSHJ PP,EVALEX ;EVALUATE - POP PP,RX ;RESET RADIX - JUMPE RC,POPOUT ;EXIT IF ABSOLUTE - -QEXT: SKIPE EXTPNT ;ANY POSSIBILITIES? - TROA ER,ERRE ;YES, FLAG EXTERNAL ERROR - TRO ER,ERRR ;NO, FLAG RELOCATION ERROR - HLLZS RC ;CLEAR RELOCATION/EXTERNAL - POPJ PP, - -EVALXQ: PUSHJ PP,EVALEX ;EVALUATE EXPRESSION - TLZN RC,-2 ;LEFT HALF EXTERNAL - TRZE RC,-2 ;WAS AN EXTERNAL FOUND? - TRO ER,ERRE ;YES, FLAG ERROR - POPJ PP, ;RETURN - OPDEF0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL - POPJ PP, ;ERROR IF INVALID SYMBOL - CAIE C,73 ;"["? - JRST ERRAX ;NO, ERROR - PUSH PP,AC0 ;STACK MNEMONIC - AOS LITLVL ;SHORT OUT LOCATION INCREMENT - PUSHJ PP,STMNT ;EVALUATE STATEMENT - SKIPGE STPX ;CODE STORED? - TROA ER,ERRA ;NO,"A" ERROR - PUSHJ PP,DSTOW ;GET AND DECODE VALUE - SOS LITLVL - EXCH AC0,0(PP) ;EXCHANGE VALUE FOR MNEMONIC - PUSH PP,RC ;STACK RELOCATION - TLO IO,DEFCRS ;SAY WE ARE DEFINING IT - PUSHJ PP,MSRCH ;SEARCH SYMBOL TABLE - MOVSI ARG,OPDF ;NOT FOUND - POP PP,RC ;RESTORE VALUES - POP PP,V - TLNE ARG,SYNF!MACF - TRO ER,ERRA ;YES "A" ERROR - TRNN ER,ERRA ;ERROR? - PUSHJ PP,INSERT ;NO, INSERT/UPDATE - TLZ IO,DEFCRS ;JUST IN CASE - PUSHJ PP,BYPASS - JRST STOWI ;BE SURE STOW IS RESET - - -DEPHA0: MOVE AC0,LOCO - SKIPA RC,MODO ;SET TO OUTPUT VALUES AND SKIP -PHASE0: PUSHJ PP,EVALXQ ;EVALUATE AND CHECK FOR EXTERNAL - MOVEM AC0,LOCA ;SET ASSEMBLY LOCATION COUNTER - MOVEM RC,MODA - JRST BLOCK2 - ASSIGN: JUMPAD ERRAX ;NO, ERROR - PUSHJ PP,ASSIG1 - TLNE IO,IOSALL ;SUPPRESS ALL? - JUMPN MRP,CPOPJ ;IF IN MACRO -ASSIG7: MOVEM RC,ASGBLK - TRNE RC,-2 ;EXTERNAL - HLLZS ASGBLK ;YES,CLEAR RELOCATION - TLNE RC,1 ;LEFT HALF NOT RELOC? - TLNE RC,-2 ;... - HRROS ASGBLK ;YES, SET FLAG - MOVEM V,LOCBLK - POPJ PP, - -ASSIG1: PUSH PP,AC0 ;SAVE SYMBOL - SETZB AC0,EXTPNT ;SPECIAL CHECK FOR == WFW - PUSHJ PP,PEEK ;IS THE NEXT ON = - CAIE C,"=" - JRST ASSIG5 - TLO AC0,NOOUTF ;YES, NOT OUT TO DDT WFW - PUSHJ PP,GETCHR ;PROCESS THE CHAR. - PUSHJ PP,PEEK ;CHECK FOR ==: DMN -ASSIG5: CAIE C,":" ;IS IT - JRST ASSIG6 ;NO - TLO AC0,INTF ;MAKE INTERNAL - PUSHJ PP,GETCHR ;REPEAT IT -ASSIG6: MOVEM AC0,HDAS ;STORE THESE BITS WFW - PUSHJ PP,EVALCM ;EVALUATE EXPRESSION - EXCH AC0,0(PP) ;SWAP VALUE FOR SYMBOL - PUSH PP,RC - TRNN RC,-2 ;CHECK EXTERNAL AGREEMENT - JRST ASSIG2 - HRRZS RC - HRRZ ARG,EXTPNT - CAME RC,ARG - PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR -ASSIG2: HLRZ RC,(PP) - TRNN RC,-2 - JRST ASSIG3 - HLRZ ARG,EXTPNT - CAME RC,ARG - PUSHJ PP,QEXT -ASSIG3: TLO IO,DEFCRS - PUSHJ PP,SSRCH - MOVSI ARG,SYMF - IOR ARG,HDAS ;WFW - TLNE ARG,UNDF ;WAS IT UNDEFINED - TLZ ARG,EXTF!PNTF ;YES,CLEAR EXTF NOW - TLZ ARG,UNDF!VARF ;CANCEL UNDEFINED AND VARIABLE FLAGS - SETZM EXTPNT ;FOR REST OF WORLD - POP PP,RC - TRNE ER,ERRORS-ERRQ - SETZ RC, ;CLEAR RELOCATION - POP PP,V - TRNE ER,ERRU ;WAS VALUE UNDEFINED? - TLO ARG,UNDF ;YES,SO TURN UNDF ON - TLNE ARG,TAGF!EXTF - JRST ERRAX - JRST INSERT - - LOC0: PUSHJ PP,HIGHQ ;AC0=0,0 - PUSH PP,AC0 ;SAVE MODE REQUESTED - HLRZS AC0 ;PUT MODE IN RIGHT HALF - JUMPN AC0,RELOC0 ;RELOC PSEUDO-OP - CAMN AC0,MODO ;SAME AS PRESENT MODE? - JRST [HRRZ AC0,LOCO ;YES - EXCH AC0,ABSLOC ;EXCH VALUES - JRST LOC01] - HRRZ AC0,LOCO ;NO, GET CURRENT VALUE - MOVEM AC0,RELLOC ;SAVE IT - MOVE AC0,ABSLOC ;GET LAST RELOC VALUE -LOC01: PUSHJ PP,BYPASS ;SKIP BLANKS - TLO IO,IORPTC - CAIE C,EOL ;USE PREVIOUS VALUE IF NULL ARGUMENT - PUSHJ PP,EVALXQ ;GET EXPRESSION AND TEST EXTERNAL - HRRM AC0,(PP) ;STORE NEW VALUE - POP PP,AC0 ;RETRIEVE STORED MODE AND VALUE -LOC10: HRRZM AC0,LOCA ;SET ASSEMBLY LOCATION - HRRZM AC0,LOCO ;AND OUTPUT LOCATION - HLRZM AC0,MODA ;SET MODE - HLRZM AC0,MODO - JRST BLOCK2 - -RELOC0: CAMN AC0,MODO - JRST [HRRZ AC0,LOCO - EXCH AC0,RELLOC - JRST LOC01] - HRRZ AC0,LOCO - MOVEM AC0,ABSLOC - MOVE AC0,RELLOC - JRST LOC01 - - IFN RENTSW,< -HISEG1: PUSHJ PP,HIGHQ ;SET CURRENT PROGRAM BREAK - PUSHJ PP,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 - PUSHJ PP,BYPASS ;GO GET EXPRESSION - TLO IO,IORPTC - PUSHJ PP,EVALXQ ;CHECK FOR EXTERNAL - ANDCMI AC0,1777 ;ONLY ALLOWED TO START ON NEW K BOUND - HRRZM AC0,LOCA ;SET LOC COUNTERS - HRRZM AC0,LOCO - MOVEI RC,1 ;ASSUME RELOCATABLE - POPJ PP, - -TWSEG0: PUSHJ PP,HISEG1 ;COMMON CODE - JUMPN AC0,.+2 ;ARGUMENT SEEN - MOVEI AC0,400000 ;ASSUME 400000 - HRRZM AC0,HMIN ;SET OFSET OF HIGH SEG. - HRRZM AC0,HHIGH ;INCASE NO HISEG CODE - TLOA AC0,(1B0) ;SIGNAL TWO SEGMENTS AND SKIP - -HISEG0: PUSHJ PP,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> - -IFE RENTSW,< - SYN CPOPJ,HISEG0 - SYN CPOPJ,TWSEG0> - -IFN FORMSW,< -ONFORM: HRRES HWFMT ;ALLOW MULTI-FORMAT LISTING - POPJ PP, -OFFORM: HRROS HWFMT ;HALF-WORD FORMAT ONLY - POPJ PP, > - -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 - POPJ PP,] -IFN RENTSW, - CAMLE V,HIGH ;IS IT GREATER THAN "HIGH"? - MOVEM V,HIGH ;YES, REPLACE WITH LARGER VALUE - POPJ PP, - -ONML: TLZA FR,MWLFLG ;MULTI-WORD LITERALS OK -OFFML: TLO FR,MWLFLG ;NO - POPJ PP, - -OFFSYM: SETOM IONSYM ;SUPRESS SYMBOL TABLE LISTING - POPJ PP, - -SUPRE0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES - JRST SUPRE1 ;ERROR - PUSHJ PP,SSRCH ;SYMBOL ONLY - JRST SUPRE1 ;GIVE ERROR MESSAGE - TLOA ARG,SUPRBT ;SET THE SUPRESS BIT -SUPRE1: TROA ER,ERRA - IORM ARG,(SX) ;PUT BACK - JUMPCM SUPRE0 ;ANY MORE? - JRST SUPRS1 - -SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL - MOVSI ARG,SUPRBT - IORM ARG,(SX) -SUPRS1: SETZM EXTPNT ;JUST IN CASE WE LOOKED ONE UP - POPJ PP, - -XPUNG0: JUMP1 POPOUT - PUSHJ PP,LOOKUP - MOVE ARG,(SX) ;GET SYMBOL FLAGS - TLNN ARG,INTF!ENTF!EXTF!SPTR - TLOA ARG,SUPRBT ;LOCAL SYMBOL,SO SUPPRESS IT - SETZM EXTPNT - MOVEM ARG,(SX) ;RESTORE FLAGS - POPJ PP, - TITLE0: JUMP2 REMAR0 - MOVEI SX,.TBUF - HRRI AC0,TBUF - PUSHJ PP,SUBTT1 ;GO READ IT - MOVEM SX,TCNT ;SAVE COUNT OF CHARS. WRITTEN - SKIPE UNIVSN ;WAS IT A UNIVERSAL? - PUSHJ PP,ADDUNV ;YES ADD TO TABLE - TLOE IO,IOTLSN ;HAVE WE SEEN ONE -IFE CCLSW, -IFN CCLSW, - POPJ PP, ;EXIT OTHERWISE - -SUBTT0: SKIPE SBUF ;STORE FIRST SUBTTL ON PASS1 - JUMP1 REMAR0 ;OTHERWISE EXIT IF PASS ONE - MOVEI SX,.SBUF - HRRI AC0,SBUF - -SUBTT1: PUSHJ PP,BYPASS ;BYPASS LEADING BLANKS - TLO IO,IORPTC -SUBTT3: PUSHJ PP,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,CPOPJ ;COUNT NUL AND EXIT - -IFN CCLSW,< -PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG - POPJ PP, - PUSH PP,AC0 ;SAVE AC0 DMN - PUSH PP,RC ;AND RC - MOVE AC0,[POINT 7,TBUF] - MOVE SX,[POINT 7,OTBUF] - MOVEI RC,6 ;MAX OF SIX CHRS -PN1: ILDB C,AC0 - CAILE C," " ;CHECK FOR LEGAL - CAILE C,"Z"+40 ;CHECK AGAINST LOWER CASE Z - JRST PN2 - IDPB C,SX ;PUT IN OUTPUT BUFFER - SOJG RC,PN1 ;GET MORE -PN2: MOVEI C,0 - IDPB C,SX ;TERMINATOR - TTCALL 3,OTBUF - TTCALL 3,[ASCIZ / -/] - POP PP,RC - POP PP,AC0 ;RESTORE AC0 DMN - POPJ PP, -> - SYN0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL - JRST ERRAX ;ERROR, EXIT - PUSHJ PP,MSRCH ;TRY FOR MACRO/OPDEF - JRST SYN3 ;NO,0THRY FOR OPERAND -SYN1: MOVEI SX,MSRCH ;YES, SET FLAG -SYN2: PUSHJ PP,SAVEXS ;SAVE REGISTERS - JUMPNC ERRAX ;ERROR IF NO COMMA - PUSHJ PP,GETSYM ;GET THE SECOND SYMBOL - POPJ PP, - PUSHJ PP,@SAVBLK+SX ;SEARCH FOR SECOND SYMBOL - JFCL - MOVE ARG,SAVBLK+ARG ;GET VALUES - MOVE RC,SAVBLK+RC - MOVE V,SAVBLK+V - TLNE ARG,MACF ;MACRO? - PUSHJ PP,REFINC ;YES, INCREMENT REFERENCE - JRST INSERT ;INSERT AND EXIT - -SYN3: PUSHJ PP,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: PUSHJ PP,OPTSCH ;SEARCH FOR OP-CODE - JRST ERRAX ;NOT FOUND, EXIT WITH ERROR - MOVSI ARG,SYNF ;FLAG AS SYNONYM - JRST SYN1 - PURGE0: PUSHJ PP,GETSYM ;GET A MNEMONIC - JRST [TRZ ER,ERRA ;CLEAR ERROR - POPJ PP,] ;AND RETURN - PUSHJ PP,MSRCH ;SEARCH MACRO SYMBOL TABLE - JRST PURGE2 ;NOT FOUND, TRY SYMBOLS - PUSH PP,CS ;SAVE CS AS IT MAY GET GARBAGED - TLNE ARG,MACF ;MACRO? - PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE - POP PP,CS - JRST PURGE4 ;REMOVE SYMBOL FROM TABLE - -PURGE2: PUSHJ PP,SSRCH ;TRY OPERAND SYMBOL TABLE - JRST PURGE5 ;NOT FOUND GET NEXT SYMBOL - TRNN RC,-2 ;CHECK COMPLEX EXTERNAL - TLNE RC,-2 - TLNE ARG,SYNF - JRST .+2 - JRST PURGE3 - TLNE ARG,EXTF!UNDF ;ERROR IF EXTERNAL OR UNDEFINED - TLNE ARG,SYNF ;BUT NOT A SYNONYM - JRST PURGE4 -PURGE3: TROA ER,ERRA ;NOT FOUND, ERROR -PURGE4: PUSHJ PP,REMOVE ;REMOVE FROM THE SYMBOL TABLE -PURGE5: JUMPCM PURGE0 - POPJ PP, ;EXIT - OPD1: TLNE ARG,UNDF ;IF OPDEF IS UNDEFINED - TRO ER,ERRO ;GIVE "O" ERROR -OPD: MOVE AC0,V ;PUT VALUE IN AC0 - JRST OP -IOP: MOVSI AC2,(POINT 9,0(PP),11) -IFE FORMSW,< TLOA IO,IOIOPF ;SET "IOP SEEN" AND SKIP> -IFN FORMSW,< PUSH PP,IOFORM ;USE I/O FORM - TLO IO,IOIOPF ;SET "IOP" SEEN - JRST OP+2> -OP: MOVSI AC2,(POINT 4,0(PP),12) -IFN FORMSW,< PUSH PP,INFORM ;USE INST. FORM> - PUSH PP,RC - PUSH PP,AC0 ;STACK CODE - PUSH PP,AC2 - PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION - POP PP,AC2 - JUMPNC OP2 -OP1B: PUSHJ PP,GETCHR ;GET A CHARACTER -IFE FORMSW, -IFN FORMSW, - TLO IO,IORPTC ;NOT A COMMA,REPEAT IT - LDB AC1,AC2 - ADD AC1,AC0 - DPB AC1,AC2 - JUMPE RC,OP1A ;EXTERNAL OR RELOCATABLE? - PUSHJ PP,QEXT ;YES, DETERMINE WHICH AND FLAG AN ERROR - -OP1A: PUSHJ PP,EVALEX ;GET ADDRESS PART -OP2: PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS -OP3: POP PP,AC0 ;PUT IN AC0 - POP PP,RC -IFN FORMSW,< POP PP,AC1 ;GET FORM WORD> - SKIPE (PP) ;CAME FROM EVALCM? - JRST STOW ;NO,STOW CODE AND EXIT - POP PP,AC1 ;YES,EXIT IMMEDIATELY - POPJ PP, - - EVADR: ;EVALUATE STANDARD ADDRESS -IFE IIISW, - ADD AC0,-1(PP) ;ADD ADDRESS PORTIONS - HLL AC0,-1(PP) ;GET LEFT HALF - TLZE FR,INDSW ;INDIRECT BIT? - TLO AC0,(Z @) ;YES, PUT IT IN - MOVEM AC0,-1(PP) ;RE-STACK CODE - ADD RC,-2(PP) ;UPDATE RELOCATION - HRRM RC,-2(PP) ;USE HALF WORD ADD - CAIE C,10 ;"("? - POPJ PP, ;NO, EXIT - - MOVSS EXTPNT ;WFW - PUSHJ PP,EVALCM ;EVALUATE - MOVSS EXTPNT ;WFW - MOVSS V,AC0 ;SWAP HALVES -IFE IIISW, -IFN IIISW, - ADD V,-1(PP) ;ADD RIGHT HALVES - ADD ARG,-2(PP) - HRRM V,-1(PP) ;UPDATE WITHOUT CARRY - HRRM ARG,-2(PP) - HLLZS AC0 ;PREPARE LEFT HALVES - HLLZS RC -IFE IIISW, - ADDM AC0,-1(PP) ;MERGE WITH PREVIOUS VALUE - ADDM RC,-2(PP) - CAIE C,11 ;")"? - JRST ERRAX ;NO, FLAG ERROR - ;YES, BYPASS PARENTHESIS -BYPASS: -BYPAS1: PUSHJ PP,GETCHR -BYPAS2: JUMPE C,.-1 ;SKIP TRAILING BLANKS - POPJ PP, ;EXIT - - IFE IIISW,< -OP2A1: EXCH RC,-2(PP) ;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(PP) ;GET RC,BACK - POPJ PP, ;AND RETURN> - - -EXPRES: HRLZ AC0,RX ;FUDGE FOR OCT0 - -OCT0: PUSH PP,RX - HLR RX,AC0 -OCT1: PUSHJ PP,EVALEX ;EVALUATE -IFN FORMSW,< MOVE AC1,HWFORM> - PUSHJ PP,STOW ;STOW CODE - JUMPCM OCT1 - POP PP,RX ;YES, RESTORE RADIX - POPJ PP, ;EXIT - SIXB10: MOVSI RC,(POINT 6,AC0) ;SET UP POINTER - MOVEI AC0,0 ;CLEAR WORD - -SIXB20: PUSHJ PP,CHARL ;GET NEXT CHARACTER - CAMN C,SX ;IS THIS PRESET DELIMITER? -IFE FORMSW,< JRST ASC60 ;YES> -IFN FORMSW,< - JRST [PUSHJ PP,BYPAS1 - ANDCM RC,STPX - MOVE AC1,SXFORM - JUMPGE RC,STOWZ - POPJ PP,]> - CAIL C,"A"+40 - CAILE C,"Z"+40 - JRST .+2 - TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT - SUBI C,40 ;CONVERT TO SIXBIT - JUMPL C,ASC55 ;TEST FOR INVALID CHARACTER - IDPB C,RC ;NO, DEPOSIT THE BYTE - TLNE RC,770000 ;IS THE WORD FULL? - JRST SIXB20 ;NO, GET NEXT CHARACTER -IFN FORMSW,< MOVE AC1,SXFORM ;SIXBIT FORM> - PUSHJ PP,STOWZ ;YES, STORE - JRST SIXB10 ;GET NEXT WORD - ASCII0: HLLZ SDEL,AC0 ;STORE ASCII/ASCIZ FLAG -ASC10: PUSHJ PP,CHARL ;GET FIRST NON-BLANK - CAIE C," " - CAIN C,HT - JRST ASC10 - CAIG C,CR ;CHECK FOR CRRET AS DELIM - CAIGE C,LF - SKIPA SX,SEQNO2 - JRST ERRAX - MOVEM SX,TXTSEQ ;SAVE SEQ AND PAGE - MOVE SX,PAGENO - MOVEM SX,TXTPG - 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, -IFN IIISW, -ASC30: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST - 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,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD> - PUSHJ PP,STOWZ ;YES, STOW IT - JRST ASC20 ;GET NEXT WORD - -ASC55: TDZA CS,CS ;ZERO CS IN CASE NESTED -ASC50: TDZA RC,SDEL ;TEST FOR ASCIIZ - TROA ER,ERRA ;SIXBIT ERROR EXIT -ASC60: PUSHJ PP,BYPAS1 ;POLISH OFF TERMINATOR - SETZM INTXT ;WE ARE OUT OF IT -IFN FORMSW,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD> -IFN IIISW, - ANDCM RC,STPX ;STORE AT LEAST ONE WORD - TLNN SDEL,200000 ;GET OUT WITHOUT STORING - JUMPGE RC,STOWZ ;STOW - POPJ PP, ;ASCII, NO BYTES STORED, SO EXIT - POINT0: -IFN FORMSW,< PUSH PP,BPFORM ;USE BYTE POINTER FORM WORD> - PUSH PP,RC ;STACK REGISTERS - PUSH PP,AC0 - PUSHJ PP,EVAL10 ;EVALUATE RADIX 10 - DPB AC0,[POINT 6,0(PP),11] ;STORE BYTE SIZE - JUMPNC POINT2 - PUSHJ PP,EVALEX ;NO, GET ADDRESS - PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS - JUMPNC POINT2 - PUSHJ PP,EVAL10 ;EVALUATE RADIX 10 - 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(PP) ;UPDATE VALUE - JRST OP3 - XWD0: -IFN FORMSW,< PUSH PP,HWFORM ;USE HALF WORD FORM> - PUSH PP,RC - PUSH PP,AC0 ;STORE ZERO ON STACK - PUSHJ PP,EVALEX ;EVALUATE EXPRESSION - JUMPNC OP2 -XWD5: SKIPN (PP) ;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,(PP) ;USE PREVIOUS VALUE - MOVE RC,-1(PP) ;AND RELOCATION -XWD10: HRLZM AC0,0(PP) ;SET LEFT HALF - HRLZM RC,-1(PP) - MOVSS EXTPNT ;WFW - JRST OP1A ;EXIT THROUGH OP - -IOWD0: PUSHJ PP,EVALXQ ;EVALUATE AND TEST FOR EXTERNAL - CAIE C,14 ;","? - JRST [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 - PUSH PP,AC0 ;YES, STACK LEFT HALF - PUSHJ PP,EVALEX ;WFW - SUBI AC0,1 - POP PP,AC1 ;RETRIEVE LEFT HALF - MOVNS AC1 - HRL AC0,AC1 -IFN FORMSW,< MOVE AC1,HWFORM ;USE HALF WORD FORM> - JRST STOW ;STOW CODE AND EXIT - BYTE0: PUSHJ PP,BYPASS ;GET FIRST NON-BLANK - CAIE C,10 ;"("? - JRST ERRAX ;NO, FLAG ERROR AND EXIT -IFN FORMSW,< - PUSH PP,[1] - MOVEI AC0,0 -> - PUSH PP,RC - PUSH PP,AC0 ;INITIALIZE STACK TO ZERO - MOVSI ARG,(POINT -1,(PP)) - -BYTE1: PUSH PP,ARG - PUSHJ PP,EVAL10 ;EVALUATE RADIX 10 - POP PP,ARG - CAIG AC0,^D36 ;TEST SIZE - JUMPGE AC0,.+2 - TRO ER,ERRA - DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE - -BYTE2: IBP ARG ;INCREMENT BYTE - TRZN ARG,-1 ;OVERFLOW? - JRST BYTE3 ;NO - SETZB AC0,RC ;YES - EXCH AC0,0(PP) ;GET CURRENT VALUES - EXCH RC,-1(PP) ;AND STACK ZEROS -IFN FORMSW,< - MOVE AC1,HWFORM ;USE STANDARD FORM - EXCH AC1,-2(PP) ;GET FORM WORD -> - PUSHJ PP,STOW ;STOW FULL WORD - -BYTE3: PUSH PP,ARG - PUSHJ PP,EVALEX ;COMPUTE NEXT BYTE - POP PP,ARG - 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 -> - JUMPCM BYTE2 - CAIN C,10 ;"("? - JRST BYTE1 ;YES, GET NEW BYTE SIZE - JRST OP3 ;NO, EXIT - RADX50: PUSHJ PP,EVALEX ;EVALUATE CODE - JUMPN RC,ERRAX ;ERROR IF NOT ABSOLUTE - MOVE ARG,AC0 - JUMPNC ERRAX - PUSHJ PP,GETSYM ;YES, GET SYMBOL - TRZ ER,ERRA ;CLEAR ERROR - PUSHJ PP,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 - POPJ PP, - REPEAT 0,< EXPLANATION OF ARRAY AND LVAR FEATURES - -WHEN A VARIABLE IS SEEN EITHER BY #, INTEGER OR ARRAY -THE VALUE PORTION OF THE SYMBOL TABLE ENTRY (RH OF 2ND WORD) -IS USE TO HOLD THE DESIRED SIZE-1. THE CORRECT VALUE IS -ASSIGNED BY THE VAR PSEUDO OP. - -WHEN LVAR IS SEEN, A SEARCH OF THE SYMBOL TABLE IS MADE -FOR ALL VARIABLES. THE VARF (VARIABLE) FLAG IS -LEFT ON AND EXTF AND PNTF ARE TURNED ON SO THAT THE -VARIABLE LOOKS LIKE AN EXTERNAL. THE POINTER -(RH OF 2ND WORD OF THE SYMBOL TABLE ENTRY) POINTS -TO THE HEADER BLOCK. THE HEADER BLOCK IS FORMATTED AS FOLLOWS: -WORD 1: LEFT HALF IS A POINTER TO SYMBOL TABLE FIXUP BLOCKS - RIGHT HALF IS A POINTER TO CODE FIXUP BLOCKS -WORD 2: 0 THIS IS USED TO DISTINGUISH IT FROM NORMAL EXTERNALS - WHICH HAVE THE SYMBOL NAME HERE -WORD 3: THE LOCATION RELATIVE TO THE START OF THE LOW CORE - VARIABLES - -CORE FIXUP BLOCKS ARE SET UP BY BOUT - -WORD1: RH LINK TO NEXT CORE FIXUP BLOCK 0 IF END OF CHAIN - LH OFFSET. NUMBER TO BE ADDED TO SYMBOL VALUE BEFORE - FIXUP IS DONE -WORD 2: POINTER TO A FIXUP CHAIN FOR RIGHT HALVES - LEFT HALF IS RELOCATION RH IS ADDRESS -WORD 3: SAME AS WORD 2 BUT FOR LEFT HALF FIXUPS - -NOTE ALL THESE FIXUPS ARE CHAINED EVEN IF IN LEFT HALF. -SIMILARY ALL REFERENCES TO SAY A+1 ARE CHAINED - -SYMBOL TABLE FIXUP BLOCKS. THESE ARE GENERATED BY SOUT -AS THE SYMBOL TABLE IS PUT OUT. THESE FIXUPS ARE ADDITIVE -NOT CHAINED. - -WORD 1: RH LINK TO NEXT BLOCK - LH 0 -WORD 2: RADIX50 FOR THE SYMBOL -WORD 3: 200000,,0 IF RH FIXUP - 600000,,0 IF LH FIXUP - -SOUT ALSO SETS UP FIXLNK. FIXLNK POINTS TO THE CHAIN OF -ALL LVAR FIXUPS TO BE DONE. IT POINTS TO THE SECOND WORD - OF A 2 WORD BLOCK - -WORD 1: LINK TO 2ND WORD OF NEXT BLOCK 0 IF END -WORD 2: RH POINTER TO A HEADER BLOCK - LH GARBAGE - -FIXUPS ARE BLOCK TYPE 13 AS FOLLOWS -WORD 1: THE PROGRAM BREAK (AS BLOCK TYPE 5) -WORD 2: THE NUMBER OF LOCATION USED FOR VARIABLES IN THE - LOW SEGMENT+1 - -REMAINING WORDS COME IN PAIRS AS FOLLOWS: -1ST WORD BIT 0=0 RH FIXUP - BIT 0=1 LH FIXUP - BIT 1=0 CORE FIXUP - WORD 2 LH POINTER TO CHAIN - WORD 2 RH VALUE - BIT 1=1 SYMBOL FIXUP - WORD 1 RH VALUE - WORD 2 SYMBOL -> - -REPEAT 0,< EXPLANATION OF ICC FEATURES - - IF FORMSW IS SET NON ZERO THE FORM OF THE OCTAL LISTING OUTPUT - IS CHANGED FROM STANDARD HALF WORD FORM TO THE FOLLOWING:- - - IF INSTRUCTION BYTE 9,4,1,4,18 - IF I/O INSTRUCTION BYTE 3,7,3,1,4,18 - IF BYTE POINTER BYTE 6,6,2,4,18 - IF ASCII BYTE 7,7,7,7,7 - IF SIXBIT BYTE 6,6,6,6,6,6 - - ALL OTHERS ARE STANDARD HALF WORD - - THIS FEATURE CAN BE OVER RIDDEN BY USE OF /H SWITCH - STANDARD HALF WORD FORM IS THEN USED. - HOWEVER BECAUSE OF EXTRA SPACING THE OUTPUT IS PUSHED MORE - TO THE RIGHT AND LONG COMMENTS OVERFLOW THE LINE - > - IFN WFWSW,< -%INTEG: PUSHJ PP,GETSYM ;GET A SYMBOL - JRST INTG2 ;BAD SYMBOL ERROR - TLO IO,DEFCRS ;THIS IS A DEFINTION - PUSHJ PP,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 - PUSHJ PP,INSERZ ;PUT IN WITH ZERO VALUE (LENGTH OF 1) -INTG1: JUMPCM %INTEG - POPJ PP, - -%ARAY: MOVEM PP,ARAYP ;SAVE PUSHDOW POINTER -ARAY2: PUSHJ PP,GETSYM - JRST ARAY1 ;BAD SYMBOL GIVE ERROR AND ABORT - PUSH PP,AC0 ;SAVE NAME - JUMPCM ARAY2 ;AND GO ON IF A COMMA - CAIE C,"["-40 ;MUST BE A [ - JRST ARAY1 - PUSHJ PP,BYPASS ;OH, WELL - TLO IO,IORPTC - PUSHJ PP,EVALXQ ;GET A SIZE - CAIE C,"]"-40 ;MUST END RIGHT - JRST ARAY1 - PUSHJ PP,BYPASS ;?? - HRRZ V,AC0 ;GET VALUE - SUBI V,1 -NXTVAL: POP PP,AC0 - PUSH PP,V ;SAVE OVER SEARCH - TLO IO,DEFCRS - PUSHJ PP,SSRCH ;FIND IT - MOVSI ARG,SYMF!UNDF - POP PP,V ;GET VALUE BACK - TLNN ARG,UNDF - JRST ARAY3 - TLO ARG,VARF - MOVEI RC,0 ;NO RELOC - PUSHJ PP,INSERT -ARAY3: CAME PP,ARAYP - JRST NXTVAL ;STILL NAMES STACKED - JUMPCM ARAY2 - POPJ PP, - -ARAY1: TRO ER,ERRA ;ERROR EXIT - MOVE PP,ARAYP - POPJ PP, ;RESET PDL AND GO -> - IFN WFWSW,< -%LVAR: JUMP2 POPOUT ;IGNORE ON PASS2 - PUSHJ PP,LOOKUP ;SCAN SYMBOL TABLE - TRNN ARG,EXTF ;THESE ARE LVARS WE HAVE DONE ONCE - TRNN ARG,VARF ;FOR VARIABLES - POPJ PP, ;IGNORE ALL OTHERS - TRZ ARG,UNDF ;SET AS DEFINED - MOVEI RC,3 - ADDB RC,FREE - CAML RC,SYMBOL ;GET BLOCK - PUSHJ PP,XCEEDS - SUBI RC,2 ;POINT TO START OF BLOCK - ADDI V,1 - EXCH V,LVARLC ;GET CORRECT VARIABLE LOCATION - MOVEM V,2(RC) ;SAVE IT - ADDM V,LVARLC ;AND UPDATE BASE - SETZM (RC) - SETZM 1(RC) ;NO NAME TO IDENT AN LVAR AND NO FIXUPS - HRL ARG,RC ;POINTER - TRO ARG,EXTF!PNTF ;FLAG AS EXTERNAL AND POINTER - MOVSM ARG,(SX) ;PUT IT AWAY - POPJ PP, -> - ; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY - -; HERE IF PRGEND (PASS 1) -PSEND0: TLO IO,MFLSW ;PSEND SEEN - PUSHJ PP,END0 ;AS IF END STATEMENT - HLLZS IO ;CLEAR ER(RH) - SETZM ERRCNT ;CLEAR ERROR COUNT FOR EACH PROG. - JUMP2 PSEND2 ;DIFFERENT ON PASS2 - SKIPE UNIVSN ;SEEN A UNIVERSAL - PUSHJ PP,UNISYM ;YES, STORE SYMBOLS - PUSHJ PP,PSEND4 ;SAVE SYMBOLS, POINTERS AND TITLE - TLZ IO,IOTLSN ;CLEAR TITLE SEEN FLAG -PSEND1: TLZ IO,MFLSW ;FOR NEXT FILE - SETZM UNISCH ;CLEAR UNIVERSAL SEARCH TABLE - MOVE AC0,[UNISCH,,UNISCH+1] - BLT AC0,UNISCH+.UNIV-1 - PUSHJ PP,OUTFF ;RESET PAGE COUNT - MOVSI AC0,1 ;SET SO RELOC 0 WORKS - JRST LOC10 ;FOR RELOC 0 - -; HERE IF PRGEND (PASS 2) -PSEND2: SETZM SBUF ;SO SUBTTL IS NOT WRONG - PUSHJ PP,PSEND5 ;PUT TITLE BACK - PUSHJ PP,PSEND1 ;COMMON CODE - JRST PASS20 ;OUTPUT THE ENTRIES - -; HERE IF END (PASS 1) -PSEND3: PUSHJ PP,PSEND4 ;SAVE LAST PROGRAM - HLRS PRGPTR ;REINITIALIZE POINTER - PUSHJ PP,PSEND5 ;READ BACK FIRST PROGRAM - JRST PASS20 - ;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS - XTRA==4 ;NUMBER OF OTHER LOCATIONS TO SAVE - -PSEND4: MOVE V,FREE ;GET NEXT FREE LOCATION - ADDI V,LENGTH+.TBUF/5+XTRA - CAML V,SYMBOL ;WILL WORST CASE FIT? - PUSHJ PP,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,JOBREL ;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 - PUSHJ PP,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 - MOVE AC2,LITHDX ;POINTER TO LIT INFO. - MOVE AC0,-1(AC2) ;SIZE OF PASS1 LOCO - PUSHJ PP,STORIT ;SAVE IT IN SYMBOL TABLE - MOVE AC2,VARHDX ;SAME FOR VARS - MOVE AC0,-1(AC2) - PUSHJ PP,STORIT -IFN RENTSW,< - MOVE AC0,HISNSW ;GET TWOSEG/HISEG FLAG - HRR AC0,HIGH1 ;AND PASS1 BREAK - PUSHJ PP,STORIT - JUMPGE AC0,PSEND6 ;NOT TWOSEG - MOVE AC0,SVTYP3 ;HIGH SEGMENT OFFSET - PUSHJ PP,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 - POPJ PP, ;RETURN - - PSENDX: PUSHJ PP,XCEED ;NEED TO EXPAND CORE FIRST -PSEND5: HRRZ AC0,JOBREL ;GET TOP OF CORE - SUBI AC0,1 - 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 - PUSHJ PP,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 - TLO IO,IOTLSN ;SET AS IF TITLE SEEN - MOVE AC2,LITHDX ;INVERSE OF ABOVE - PUSHJ PP,GETIT - MOVEM AC0,-1(AC2) - MOVE AC2,VARHDX ;SAME FOR VARS - PUSHJ PP,GETIT - MOVEM AC0,-1(AC2) -IFN RENTSW,< - PUSHJ PP,GETIT ;GET TWO HALF WORDS - HRRZM AC0,HIGH1 ;PASS1 BREAK - HLLEM AC0,HISNSW ;TWOSEG/HISEG FLAG - JUMPGE AC0,CPOPJ ;NOT TWOSEG - PUSHJ PP,GETIT - MOVEM AC0,SVTYP3 ;BLOCK 3 WORD> - POPJ PP, - -STORIT: MOVEM AC0,@FREE ;STORE IT IN DATA BLOCK - AOS FREE ;ADVANCE POINTER - POPJ PP, - -GETIT: MOVE AC0,1(V) ;FILL AC0 OUT OF PRGEND BLOCK - AOJA V,CPOPJ ;INCREMENT AND RETURN - -PSNDER: HRROI RC,[SIXBIT /PRGEND ERROR @/] - JRST ERRFIN - ;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS - -UNIV0: JUMP2 TITLE0 ;DO IT ALL ON PASS 1 - HRRZ SX,UNIVNO ;GET NUMBER OF UNIVERSALS SEEN - CAIL SX,.UNIV ;ALLOW ONE MORE? - JRST UNVERR ;NO, GIVE FATAL ERROR - AOS UNIVNO ;ONE MORE NOW - SETOM UNIVSN ;AND SET SEEN A UNIVERSAL - JRST TITLE0 ;CONTINUE AS IF TITLE - - -ADDUNV: PUSH PP,RC ;AN AC TO USE - PUSHJ PP,NOUT ;CONVERT TO SIXBIT - HRRZ RC,UNIVNO ;GET ENTRY INDEX - MOVEM AC0,UNITBL(RC) ;STORE SIXBIT NAME IN TABLE - HRRZS UNIVSN ;ONLY DO IT ONCE - POP PP,RC ;RESTORE RC - POPJ PP, ;AND RETURN - -UNVERR: HRROI RC,[SIXBIT /TOO MANY UNIVERSALS@/] - JRST ERRFIN - -UNISYM: HRRZ AC0,FREE ;GET HIGHEST FREE LOCATION - MOVEM AC0,JOBFF ;INTO JOBFF - PUSHJ PP,SUPRSA ;TURN ON SUPPRESS BIT - PUSH PP,SYMBOL ;NEED TO SAVE INCASE PRGEND - MOVE AC0,SYMTOP ;TOP OF TABLE - SUB AC0,SYMBOL ;GET LENGTH OF TABLE - HRL ARG,SYMBOL ;BOTTOM OF TABLE - HRR ARG,JOBFF ;WHERE TO GO - HRRZ RC,UNIVNO ;GET TABLE INDEX - HRRM ARG,SYMBOL ;WILL BE THERE SOON - HRRZM ARG,UNIPTR(RC) ;STORE IN CORRESPONDING PLACE - ADDB AC0,JOBFF ;WHERE TO END - HRLM AC0,UNIPTR(RC) ;SAVE NEW SYMTOP - BLT ARG,@JOBFF ;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 - MOVEM AC0,FREE ;JUST IN CASE IN MACRO - MOVE AC0,SRCHX ;SAVE OLD SEARCH POINTER - PUSHJ PP,SRCHI ;GET SEARCH POINTER - EXCH AC0,SRCHX - MOVEM AC0,UNISHX(RC) ;SAVE IT - SETZM UNIVSN ;CLEAR FLAG INCASE PRGEND - POP PP,SYMBOL ;RESTORE OLD VALUE - POPJ PP, ;RETURN - - SERCH0: PUSHJ PP,GETSYM ;GET A SYMBOL - JRST ERRAX ;ERROR IF NOT VALID - MOVEI RC,1 ;START AT ENTRY ONE - CAIL RC,.UNIV ;CHECK FOR CONSISTENCY ERROR - JRST SCHERR ;CANNOT FIND THIS ONE - CAME AC0,UNITBL(RC) ;LOOK FOR MATCH - AOJA RC,.-3 ;NOT FOUND YET - MOVE AC0,RC ;STORE TABLE ENTRY NUMBER - MOVEI RC,1 ;START AT ENTRY ONE - CAIL RC,.UNIV ;CHECK FOR CONSISTENCY ERROR - JRST SCHERR ;SHOULD NEVER HAPPEN!! - SKIPE UNISCH(RC) ;LOOK FOR AN EMPTY SLOT - AOJA RC,.-3 ;NOT FOUND YET - MOVEM AC0,UNISCH(RC) ;STORE INDEX IN TABLE - JUMPCM SERCH0 ;LOOK FOR MORE NAMES - POPJ PP, ;FINISHED - -SCHERR: MOVSI RC,[SIXBIT /CANNOT FIND UNIVERSAL@/] - JRST ERRFIN ;NAME IN AC0 - -;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL -UNIERR: HRROI RC,[SIXBIT /UNIVERSAL PROGRAM(S) MUST HAVE SAME OUTPUT SPECIFICATION AS OTHER FILES@/] - JRST ERRFIN - SUBTTL MACRO/REPEAT HANDLERS - -REPEA0: PUSHJ PP,EVALXQ ;EVALUATE REPEAT EXP, EXTERNS ARE ILL. - JUMPNC ERRAX - -REPEA1: JUMPLE AC0,REPZ ;PASS THE EXP., DONT PROCESS - SOJE AC0,REPO ;REPEAT ONCE -REPEA2: PUSHJ PP,GCHARQ ;GET STARTING "<" - CAIE C,"<" - JRST REPEA2 - PUSHJ PP,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: PUSHJ PP,WCHARQ ;WRITE A CHARACTER - PUSHJ PP,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 - PUSHJ PP,WWRXE ;WRITE END - SKIPN LITLVL ;LITERAL MIGHT END ON LINE - SKIPE MACLVL ;IF IN MACRO DARE NOT PROCESS - JRST .+3 ;REST OF LINE SINCE MACRO MIGHT END ON IT - PUSHJ PP,BYPASS ;BYPASS - PUSHJ PP,STOUTS ;POLISH OF LINE BEFORE PROCESSING REPEAT - PUSH MP,MRP ;STACK PREVIOUS READ POINTER - PUSH MP,RCOUNT ;SAVE WORD COUNT - HRRZ MRP,REPPNT ;SET UP READ POINTER - SKIPN MACLVL ;IF IN MACRO GIVE CR-LF FIRST - SKIPE LITLVL ;SAME FOR LITERAL - JRST REPEA7 - AOJA MRP,POPOUT ;BYPASS ARG COUNT - -REPEA7: HRRZ MRP,REPPNT ;SET UP READ POINTER - ADDI MRP,1 ;BYPASS ARG COUNT -REPEA8: MOVEI C,CR - JRST RSW1 - -REPEND: SOSL REPEXP - JRST REPEA7 - HRRZ V,REPPNT ;GET START OF TREE - PUSHJ PP,REFDEC ;DECREMENT REFERENCE - POP MP,RCOUNT - POP MP,MRP - POP MP,REPPNT - POP MP,REPEXP - SKIPN LITLVL ;IF IN LITERAL OR - SKIPE MACLVL ;IF IN MACRO - JRST RSW0 ;FINISH OF LINE NOW - JRST REPEA8 - - REPZ: MOVE SDEL,SEQNO2 ;SAVE IN CASE OF END OF FILE - MOVEM SDEL,REPSEQ - MOVE SDEL,PAGENO - MOVEM SDEL,REPPG - SETOM INREP - MOVEI SDEL,0 ;SET COUNT -REPZ1: PUSHJ PP,GCHAR ;GET NEXT CHARACTER - CAIN C,"<" ;"<"? - AOJA SDEL,REPZ1 ;YES, INCREMENT COUNT - CAIN C,">" ;">"? - SOJLE SDEL,REPZ2 ;YES, EXIT IF MATCHING - JRST REPZ1 ;NO, RECYCLE -REPZ2: SETZM INREP ;FLAG OUT OF IT - SETZM INCND ;AND CONDITIONAL ALSO - JRST STMNT ;AND EXIT - -REPO: PUSHJ PP,GCHAR ;GET "<" - CAIE C,"<" - JRST REPO - 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 - PUSHJ PP,RSW2 - JRST RSW0 - DEFIN0: PUSHJ PP,GETSYM ;GET MACRO NAME - JRST ERRAX ;EXIT ON ERROR - MOVEM PP,PPTMP1 ;SAVE POINTER - MOVEM AC0,PPTMP2 ;SAVE NAME - TLO IO,IORPTC - MOVE SX,SEQNO2 ;SAVE IN CASE OF EOF - MOVEM SX,DEFSEQ - MOVE SX,PAGENO - MOVEM SX,DEFPG - SETOM INDEF ;AND FLAG IN DEFINE - SYN .TEMP,COMSW ;SAVE SPACE - SETZB SX,COMSW ;SET ARGUMENT AND REFERENCE COUNT AND COMMENT SWITCH -DEF02: PUSHJ PP,GCHAR ;SEARCH FOR "(" OR "<" - 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 - SKIPE COMSW ;INSIDE A COMMENT? - JRST DEF02 ;YES, IGNORE CHARACTER - CAIN C,"<" ;"<"? - JRST DEF20 ;YES - CAIE C,"(" ;"("? - JRST DEF02 ;NO -DEF10: PUSHJ PP,GETSYM ;YES, GET DUMMY SYMBOL - TRO ER,ERRA ;FLAG ERROR - ADDI SX,1 ;INCREMENT ARG COUNT - PUSH PP,AC0 ;STACK IT - CAIN C,'<' ;A DEFAULT ARGUMENT COMING UP? - JRST DEF80 ;YES, STORE IT AWAY - CAIE C,11 ;")"? - JRST DEF10 ;NO, GET NEXT DUMMY SYMBOL -DEF12: PUSHJ PP,GCHAR - CAIE C,"<" ;"<"? - JRST DEF12 ;NO -DEF20: PUSH PP,[0] ;YES, MARK THE LIST - LSH SX,9 ;SHIFT ARG COUNT - AOS ARG,SX - PUSHJ PP,SKELI ;INITIALIZE MACRO SKELETON - MOVE AC0,PPTMP2 ;GET NAME - TLO IO,DEFCRS - PUSHJ PP,MSRCH ;SEARCH THE TABLE - JRST DEF24 ;NOT FOUND - TLNN ARG,MACF ;FOUND, IS IT A MACRO? - TROA ER,ERRX ;NO, FLAG ERROR AND SKIP - PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE -DEF24: 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 - SUB PP,C ;BACK UP STACK - MOVE SDEL,.TEMP ;NUMBER OF WORDS NEEDED - ADDB SDEL,FREE ;FROM FREE CORE - CAML SDEL,SYMBOL ;MORE CORE NEEDED - PUSHJ PP,XCEEDS ;YES, TRY TO GET IT - SUB SDEL,.TEMP ;FORM POINTER - HRLM SDEL,1(V) ;STORE IT WITH ARG COUNT IN MACRO - SUBI SDEL,1 ;TO USE FOR PUSHING POINTER INTO STORAGE - MOVEI C,1(PP) ;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 PP,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 PP,PPTMP2 ;STORE TEMP STORAGE POINTER - PUSHJ PP,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: PUSHJ PP,WCHAR ;WRITE CHARACTER -DEF31: PUSHJ PP,GCHAR ;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 PP,C ;YES, SAVE CURRENT CHAR - MOVEI C,47 ;SET UP QUOTE - PUSHJ PP,WCHAR;WRITE IT - POP PP,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 PP,C ;YES, SAVE CURRENT CHARACTER - MOVEI C,47 ;AND PUT IN A ' - PUSHJ PP,WCHAR ;... - POP PP,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: TLNN IO,IOPALL ;IF LALL IS ON - JRST DEF33 ;JUST RETURN - PUSHJ PP,PEEK ;LOOK AT NEXT CHAR. - CAIN C,";" ;IS IT ;;? - JRST CPEEK1 ;YES - MOVE C,CS ;RESTORE C - JRST DEF33 ;AND RETURN - -CPEEK1: PUSHJ PP,GCHAR ;GET THE CHAR. - CAIE C,">" ;RETURN IF END OF MACRO - CAIG C,CR ;IS CHAR ONE OF - CAIGE C,LF ;LF,VT,FF,CR - JRST CPEEK1 ;NO,SO GET NEXT CHAR. - JRST DEF32 ;YES,RETURN AND STORE - DEF40: MOVEI AC0,0 ;CLEAR ATOM - MOVSI AC1,(POINT 6,AC0) ;SET POINTER -DEF42: PUSH PP,C ;STACK CHARACTER - TLNE AC1,770000 ;HAVE WE STORED 6? - IDPB CS,AC1 ;NO, STORE IN ATOM - PUSHJ PP,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 PP,[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 - PUSHJ PP,WWORD ;WRITE THE WORD - SETOM ARGF ;SET ARGUMENT SEEN FLAG - SETZM SQFLG ;AND IGNORE ANY ' WAITING TO GET INTO STRING -DEF48: MOVE PP,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 - PUSHJ PP,WCHAR ;... - SETZM SQFLG ;AND CLEAR FLAG -DEF51: MOVE C,2(SX) ;GET CHARACTER - JUMPE C,DEF48 ;CLEAN UP IF END - PUSHJ PP,WCHAR ;WRITE THE CHARACTER - AOJA SX,DEF51 ;GET NEXT - -DEF70: MOVE PP,PPTMP1 ;RESTORE PUSHDOWN POINTER - MOVSI CS,(BYTE (7) 177,1) - PUSHJ PP,WWRXE ;WRITE END - SETZM INDEF ;OUT OF IT - JRST BYPASS - ; HERE TO STORE DEFAULT ARGUMENTS - -DEF80: AOS .TEMP ;COUNT ONE MORE - PUSHJ PP,SKELI1 ;INITIALIZE SKELETON - HRL V,SX ;SYMBOL NUMBER - PUSH PP,V ;STORE POINTER - TDZA SDEL,SDEL ;ZERO BRACKET COUNT -DEF81: PUSHJ PP,WCHARQ ;WRITE A CHARACTER - PUSHJ PP,GCHARQ ;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) - PUSHJ PP,WWRXE ;WRITE END OF DUMMY ARGUMENT - PUSHJ PP,GCHAR ;READ AT NEXT CHAR. - CAIE C,")" ;END OF ARGUMENT LIST? - JRST DEF10 ;NO, GET NEXT SYMBOL - JRST DEF12 ;YES, LOOK FOR "<" - SUBTTL MACRO CALL PROCESSOR -CALLM: SKIPGE MACENL ;ARE WE TRYING TO RE-ENTER? - JRST ERRAX ;YES, BOMB OUT WITH ERROR - HRROS MACENL ;FLAG "CALLM IN PROGRESS" - EXCH MP,RP - PUSH MP,V ;STACK FOR REFDEC - EXCH MP,RP - MOVEM AC0,CALNAM ;SAVE MACRO NAME INCASE OF ERROR - MOVE SDEL,SEQNO2 ;SAVE IN CASE OF EOF - MOVEM SDEL,CALSEQ - MOVE SDEL,PAGENO - MOVEM SDEL,CALPG - ADDI V,1 ;POINT TO DUMMY SYMBOL COUNT - AOS SDEL,0(V) ;INCREMENT ARG COUNT - HLLZM SDEL,.TEMP ;DEFAULT ARG POINTER IF NON-ZERO - LSHC SDEL,-^D<9+36> ;ZERO SDEL, GET ARG COUNT IN SX - ANDI SX,777 ;MASK - SKIPE .TEMP ;IF AT LEAST ONE DEFAULT ARG - HRRM SX,.TEMP ;STORE COUNT OF ARGS - PUSH PP,V ;STACK FOR MRP - PUSH PP,RP ;STACK FOR MACPNT - JUMPE SX,MAC20 ;TEST FOR NO ARGS - PUSHJ PP,CHARAC - CAIE C,"(" ;"(" - TROA SDEL,-1 ;NO, FUDGE PAREN COUNT AND SKIP - -MAC10: PUSHJ PP,GCHAR ;GET A CHARACTER, LOOK FOR AN ARG - CAIG C,CR - CAIGE C,LF - CAIN C,";" ;";"? - JRST MAC21 ;YES, END OF ARGUMENT STRING - - PUSHJ PP,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 MAC16 ;YES; NULL SYMBOL - CAIN C,"(" ;"("? - ADDI SDEL,1 ;YES, INCREMENT COUNT - CAIN C,")" ;")"? - SOJL SDEL,MAC16 ;YES, TEST FOR END - PUSHJ PP,WCHAR ;WRITE INTO SKELETON -MAC14A: PUSHJ PP,CHARAC ;GET NEXT CHARACTER - CAIG C,CR - CAIGE C,LF - JRST .+2 - JRST MAC15 ;TEST FOR END OF LINE - CAIE C,";" ;";"? - JRST MAC14 ;YES, END OF LINE - -MAC15: TLO IO,IORPTC -MAC16: MOVSI CS,(BYTE (7) 177,2) - PUSHJ PP,WWRXE ;WRITE END - EXCH MP,RP - PUSH MP,WWRXX - EXCH MP,RP - SOJLE SX,MAC20 ;BRANCH IF NO MORE ARGS - JUMPGE SDEL,MAC10 ;HAVEN'T SEEN TERMINAL ")" YET - MAC20: TLZN IO,IORPTC - PUSHJ PP,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 - HRRZ C,LIMBO - TLNN IO,IOSALL ;SUPPRESSING ALL? - JRST MAC23 ;NO - JUMPN MRP,MAC27 ;IN MACRO? - CAIE C,";" ;NO,IN COMMENT? - JRST MAC26 ;NO -MAC22: PUSHJ PP,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: HRLZI SX,70000 ;DECREMENT BYTE POINTER - ADDB SX,LBUFP - JUMPGE SX,MAC27 - HRLOI SX,347777 - ADDM SX,LBUFP -MAC27: HRLI C,-1 ;SET FLAG - JRST MAC25 - -MAC23: MOVEI SX,"^" - JUMPAD MAC24 ;BRANCH IF ADDRESS FIELD - CAIN C,";" ;IF SEMI-COLON - SKIPE LITLVL ;AND NOT IN A LITERAL - JRST MAC24 ;NOT BOTH TRUE - JUMPN MRP,MAC24 ;OR IN A MACRO - PUSHJ PP,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: DPB SX,LBUFP ;SET ^ INTO LINE BUFFER -MAC25: PUSH MP,MACPNT - POP PP,MACPNT - PUSH MP,C - PUSH MP,RCOUNT ;STACK WORD COUNT - PUSH MP,MRP ;STACK MACRO POINTER - POP PP,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 - - MAC30: MOVEI AC0,0 ;INITIALIZE BRACKET COUNTER -MAC31: PUSHJ PP,GCHAR ;GET A CHARACTER - CAIN C,"<" ;"<"? - ADDI AC0,1 ;YES, INCREMENT COUNT - CAIN C,">" ;">"? - SOJL AC0,MAC14A ;YES, EXIT IF MATCHING - PUSHJ PP,WCHAR ;WRITE INTO SKELETON - JRST MAC31 ;GO BACK FOR ANOTHER - -MAC40: PUSH PP,SX ;STACK REGISTERS - PUSH PP,SDEL - HLLM IO,TAGINC ;SAVE IO FLAGS - PUSHJ PP,CELL ;GET AN ATOM - MOVE V,AC0 ;ASSUME NUMERIC - TLNE IO,NUMSW ;GOOD GUESS? - JRST MAC41 ;YES - PUSHJ PP,SSRCH ;SEARCH THE SYMBOL TABLE - TROA ER,ERRX ;NOT FOUND, ERROR -MAC41: PUSHJ PP,MAC42 ;FORM ASCII STRING - HLL IO,TAGINC ;RESTORE IO FLAGS - POP PP,SDEL - POP PP,SX - TLO IO,IORPTC ;REPEAT LAST CHARACTER - JRST MAC14A ;RETURN TO MAIN SCAN - -MAC42: MOVE C,V -MAC44: LSHC C,-^D35 - LSH CS,-1 - DIVI C,0(RX) ;DIVIDE BY CURRENT RADIX - HRLM CS,0(PP) - JUMPE C,.+2 ;TEST FOR END - PUSHJ PP,MAC44 - HLRZ C,0(PP) - ADDI C,"0" ;FORM TEXT - JRST WCHAR ;WRITE INTO SKELETON - MACEN0: SOS MACENL -MACEND: 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 - PUSHJ PP,RSW2 ;MARK END OF SUBSTITUTION - POP MP,C - POP MP,ARG - SKIPA MP,MACPNT ;RESET MP AND SKIP -MACEN1: PUSHJ PP,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 - PUSHJ PP,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 RSW1 - IRP0: SKIPN MACLVL ;ARE WE IN A MACRO? - JRST ERRAX ;NO, BOMB OUT -IRP10: PUSHJ PP,MREADS ;YES, GET DATA SPEC - CAIE C,40 ;SKIP LEADING BLANKS - CAIN C,"(" ;"("? - JRST IRP10 ;YES, BYPASS - CAIN C,11 - JRST IRP10 - CAIE C,177 ;NO, IS IT SPECIAL? - JRST ERRAX ;NO, ERROR - PUSHJ PP,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 - - PUSHJ PP,MREADS - CAIE C,"<" ;"<"? - JRST .-2 ;NO, SEARCH UNTIL FOUND - PUSHJ PP,SKELI1 ;INITIALIZE NEW STRING - MOVEM ARG,IRPPOI ;SET NEW POINTER - - TDZA SDEL,SDEL ;ZERO BRACKET COUNT AND SKIP -IRP20: PUSHJ PP,WCHAR1 - PUSHJ PP,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] - PUSHJ PP,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 - PUSHJ PP,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: PUSHJ PP,MREADS - CAIE C,177 ;SPECIAL? - AOJA SX,IRPSE2 ;NO, FLAG AS FOUND - PUSHJ PP,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: PUSHJ PP,WCHAR - SKIPN IRPCF ;IRPC? - JRST IRPSE1 ;NO, GET NEXT CHARACTER - -IRPSE4: MOVSI CS,(BYTE (7) 177,2) - PUSHJ PP,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 - STOPI0: SKIPN IRPARP ;IRP IN PROGRESS? - JRST ERRAX ;NO, ERROR - SETZM IRPSW ;YES, SET SWITCH - POPJ PP, - -IRPEND: MOVE V,@IRPARP - PUSHJ PP,REFDEC - SKIPE IRPSW ;MORE TO COME? - JRST IRPSET ;YES - -IRPPOP: MOVE V,IRPPOI - PUSHJ PP,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 PP,WWRXX - PUSH PP,MWP ;STACK MACRO WRITE POINTER - PUSH PP,WCOUNT ;SAVE WORD COUNT - PUSHJ PP,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 - IOR CS,[ASCII /.0000/] - MOVEI C,"." - PUSHJ PP,WCHAR - PUSHJ PP,WWORD ;WRITE INTO SKELETON - MOVSI CS,(BYTE (7) 177,2) - PUSHJ PP,WWRXE ;WRITE END CODE - POP PP,WCOUNT ;RESTORE WORD COUNT - POP PP,MWP ;RESTORE MACRO WRITE POINTER - POP PP,WWRXX - MOVE V,ARG ;SET UP FOR REFINC - -GETDS1: PUSHJ PP,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 - PUSHJ PP,REFDEC ;DECREMENT REFERENCE - JRST RSW0 ;EXIT - SKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG -SKELI: SETZ MWP, ;SIGNAL FIRST TIME THROUGH - PUSHJ PP,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? - POPJ PP, ;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? - PUSHJ PP,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,,21) ;2 ASCII CHARS - POPJ PP, - - ;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 -GCHAR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER - CAIG C,FF ;TEST FOR LF, VT OR FF - CAIGE C,LF - POPJ PP, ;NO - JRST OUTIM1 ;YES, LIST IT - -WCHARQ: -WCHAR: -WCHAR1: TLNN MWP,760000 ;END OF WORD? - PUSHJ PP,SKELW ;YES, GET ANOTHER - IDPB C,MWP ;STORE CHARACTER - POPJ PP, - -WWORD: LSHC C,7 ;MOVE ASCII INTO C - PUSHJ PP,WCHAR1 ;STORE IT - JUMPN CS,WWORD ;TEST FOR END - POPJ PP, ;YES, EXIT - -WWRXE: PUSHJ PP,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 - POPJ PP, - MREAD: PUSHJ PP,MREADS ;READ ONE CHARACTER - CAIE C,177 ;SPECIAL? - JRST RSW1 ;NO, EXIT - PUSHJ PP,MREADS ;YES, GET CODE WORD - TRZE C,100 ;SYMBOL? - JRST GETDS ;YES - CAILE C,4 ;POSSIBLY ILLEGAL - JRST ERRAX ;YUP - HRRI MRP,0 ;NO, SIGNAL END OF TEXT - JRST .+1(C) - PUSHJ PP,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 - -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 - 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,,21) ;SET POINTER - MOVEI C,.LEAF ;RESET COUNT - MOVEM C,RCOUNT -MREADC: ILDB C,MRP ;GET CHARACTER - POPJ PP, - -PEEK: JUMPN MRP,PEEKM ;THIS IS A MACRO READ - PUSHJ PP,CHARAC ;READ AN ASCII CHAR. - TLO IO,IORPTC ;REPEAT FOR NEXT - POPJ PP, ;AND RETURN - -PEEKM: PUSH PP,MRP ;SAVE MACRO READ POINTER - PUSH PP,RCOUNT ;SAVE WORD COUNT - PUSHJ PP,MREADS ;READ IN A CHAR. - POP PP,RCOUNT ;RESTORE WORD COUNT - POP PP,MRP ;RESET READ POINTER - POPJ PP, ;IORPTC IS NOT SET - REFINC: MOVEI CS,1(V) ;GET POINTER TO TREE - AOS 0(CS) ;INCREMENT REFERENCE - POPJ PP, - -REFDEC: JUMPLE V,DECERR ;CATASTROPHIC ERROR SOMEWHERE - MOVEI CS,1(V) ;GET POINTER TO TREE - SOS CS,0(CS) ;DECREMENT REFERENCE - TRNE CS,000777 ;IS IT ZERO? - POPJ PP, ;NO, EXIT - 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 - POPJ PP, - -DECERR: MOVE AC0,CALNAM ;GET MACRO NAME - MOVSI RC,[SIXBIT /ERROR WHILE EXPANDING@/] - PUSHJ PP,TYPMSG - JRST ERRNE2 ;COMMON MESSAGE - A== 0 ;ASCII MODE -AL== 1 ;ASCII LINE MODE -IB== 13 ;IMAGE BINARY MODE -B== 14 ;BINARY MODE -IFE RUNSW, - -CTL== 0 ;CONTROL DEVICE NUMBER -IFN CCLSW, -BIN== 1 ;BINARY DEVICE NUMBER -CHAR== 2 ;INPUT DEVICE NUMBER -LST== 3 ;LISTING DEVICE NUMBER - -; 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, -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,JOBREL ;GET LOWSEG SIZE - MOVEM MRP,MACSIZ ;SAVE CORE SIZE - ;DECODE VERSION NUMBER - MOVEI PP,JOBFFI ;TEMP PUSH DOWN STACK - PUSH PP,[0] ;MARK BOTTOM OF STACK - LDB 0,[POINT 3,JOBVER,2] ;GET USER BITS - JUMPE 0,GETE ;NOT SET IF ZERO - ADDI 0,"0" ;FORM NUMBER - PUSH PP,0 ;STACK IT - MOVEI 0,"-" ;SEPARATE BY HYPHEN - PUSH PP,0 ;STACK IT ALSO -GETE: HRRZ 0,JOBVER ;GET EDIT NUMBER - JUMPE 0,GETU ;SKIP ALL THIS IF ZERO - MOVEI 1,")" ;ENCLOSE IN PARENS. - PUSH PP,1 -GETED: IDIVI 0,8 ;GET OCTAL DIGITS - ADDI 1,"0" ;MAKE ASCII - PUSH PP,1 ;STACK IT - JUMPN 0,GETED ;LOOP TIL DONE - MOVEI 0,"(" ;OTHER PAREN. - PUSH PP,0 -GETU: LDB 0,[POINT 6,JOBVER,17] ;UPDATE NUMBER - JUMPE 0,GETV ;SKIP IF ZERO - IDIVI 0,8 ;MIGHT BE TWO DIGITS - ADDI 1,"@" ;FORM ALPHA - PUSH PP,1 - JUMPN 0,GETU+1 ;LOOP IF NOT DONE -GETV: LDB 0,[POINT 9,JOBVER,11] ;GET VERSION NUMBER - IDIVI 0,8 ;GET DIGIT - ADDI 1,"0" ;TO ASCII - PUSH PP,1 ;STACK - JUMPN 0,GETV+1 ;LOOP - MOVE 1,[POINT 7,VBUF+1,13] ;POINTER TO DEPOSIT IN VBUF - POP PP,0 ;GET CHARACTER - IDPB 0,1 ;DEPOSIT IT - JUMPN 0,.-2 ;KEEP GOING IF NOT ZERO -IFN FORMSW,> - IFN CCLSW,< - TLZA IO,CRPGSW ;SET TO INIT NEW COMMAND FILE -M: TLNN IO,CRPGSW ;CURRENTLY DOING RPG?> -IFE CCLSW, - RESET ;INITIALIZE PROGRAM - SETZM BINDEV ;CLEAR INCASE NOT USED NEXT TIME - SETZM LSTDEV ;SAME REASON - SETZM INDEV ;INCASE OF ERROR - HRRZ MRP,MACSIZ ;GET INITIAL SIZE - CORE MRP, ;BACK TO ORIGINAL SIZ4 - JFCL ;SHOULD NEVER FAIL - SETZB MRP,PASS1I - MOVE [XWD PASS1I,PASS1I+1] - BLT PASS2X-1 ;ZERO THE PASS1 AND PASS2 VARIABLES - MOVEI PP,JOBFFI ;SET TEMP PUSH-DOWN POINTER - MOVE CS,[POINT 7,DBUF,6] ;INITIALIZE FOR DATE - MSTIME 2, ;GET TIME FROM MONITOR - PUSHJ PP,TIMOUT ;TIME FORMAT OUTPUT - DATE 1, ;GET DATE - IBP CS ;PASS OVER PRESET SPACE - PUSHJ PP,DATOUT ;DATE FORMAT OUTPUT - MOVSI FR,P1!CREFSW -IFN CCLSW, -IFE CCLSW, - MOVSI IO,IOPALL ;ZERO FLAGS - INIT CTL,AL ;INITIALIZE USER CONSOLE - SIXBIT /TTY/ - XWD CTOBUF,CTIBUF - EXIT ;NO TTY, NO ASSEMBLY - MOVSI C,(SIXBIT /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 - PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED - MOVEI C,"*" - IDPB C,CTOBUF+1 - OUTPUT CTL, - INPUT CTL, - IFN CCLSW, - INIT CTL2,AL ;LOOK FOR DISK - SIXBIT /DSK/ ;... - XWD 0,CTLBLK ;... - JRST CTLSET ;DSK NOT THERE - -IFE STANSW,< - HRLZI 3,(SIXBIT /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 (SIXBIT /TMP/) ; -> -IFN STANSW,< - MOVE 3,['QQMACR'] - MOVEM 3,CTLBUF - MOVSI 0,'RPG' -> - 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 JOBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN - MOVEM SAVFF ;... - HRRZ JOBREL ;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 - 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? - PUSHJ PP,[IFN TEMP, - IN CTL2, ;READ ANOTHER BUFFERFUL - POPJ PP, ;EVERYTHING OK, RETURN - STATO CTL2,20000 ;EOF? - JRST [HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/] - JRST ERRFIN] ;GO COMPLAIN - PUSHJ PP,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 - 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 - HRROI RC,[SIXBIT /COMMAND LINE TOO LONG@/] - JRST ERRFIN ;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 SAVFF ;RESET JOBFF FOR NEW BINARY - MOVEM JOBFF ;... - JRST BINSET - -RPGS1: PUSHJ PP,DELETE ;DELETE COMMAND FILE - 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 - MOVEM ACEXT,INDIR+1 - LOOKUP CTL2,INDIR - JRST [JUMPN ACEXT,RPGLOS ;GIVE UP ,EXPLICIT EXTENSION -IFE STANSW,< MOVSI ACEXT,(SIXBIT /CCL/) ;IF BLANK TRY CCL> -IFN STANSW,< MOVSI ACEXT,(SIXBIT /RPG/) ;IF BLANK TRY RPG> - JRST .-2 ] - HLRM ACEXT,EXTMP ;SAVE THE EXTENSION - HLRZ JOBSA ;RESET JOBFF TO ORIGINAL - MOVEM JOBFF - 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: PUSHJ PP,NAME1 ;GET FIRST NAME -IFN CCLSW, - TLNN FR,CREFSW ;CROSS REF REQUESTED? - JRST LSTSE1 ;YES, SKIP BINARY - 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 - TLO FR,PNCHSW ;OK, SET SWITCH - MOVEM ACDEV,BINDEV ;STORE DEVICE NAME - MOVEM ACFILE,BINDIR ;STORE FILE NAME IN DIRECTORY - JUMPN ACEXT,.+2 ;EXTENSION SPECIFIED? - MOVSI ACEXT,(SIXBIT /REL/) ;NO, ASSUME RELOCATABLE BINARY - MOVEM ACEXT,BINDIR+1 ;STORE IN DIRECTORY - MOVEM ACPPN,BINDIR+3 ;SET PPN - OPEN BIN,BININI ;INITIALIZE BINARY - JRST EINIT ;ERROR - TLZE TIO,TIOLE ;SKIP TO EOT - MTAPE BIN,10 - TLZE TIO,TIORW ;REWIND REQUESTED? - MTAPE BIN,1 ;YES - JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE - MTAPE BIN,17 ;BACK-SPACE A FILE - AOJL CS,.-1 ;TEST FOR END - WAIT BIN, - STATO BIN,1B24 ;LOAD POINT? - MTAPE BIN,16 ;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 - CAIN C,"_" - JRST GETSET ;NO LISTING - LSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE -LSTSE1: CAIE C,"_" - JRST ERRCM - TLNE FR,CREFSW ;CROSS-REF REQUESTED? - JRST LSTSE2 ;NO, BRANCH - JUMPN ACDEV,.+2 ;YES, WAS DEVICE SPECIFIED? - MOVSI ACDEV,(SIXBIT /DSK/) ;NO, ASSUME DSK - JUMPN ACFILE,.+2 - MOVE ACFILE,[SIXBIT /CREF/] - JUMPN ACEXT,.+2 -IFE STANSW, -IFN STANSW, -LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED - MOVE AC0,ACDEV - DEVCHR AC0, ;GET CHARACTERISTICS - TLNE AC0,LPTBIT!DISBIT!TTYBIT - TLNE FR,CREFSW ; WAS CROSS-REF REQUESTED? - AOSA OUTSW+0*TTYSW ;NO, ASSUME TTY - JRST ERRCM ;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY - TLNE AC0,CONBIT ;CONTROLING TELETYPE LISTING? - JRST GETSET ;YES, BUFFER ALREADY SET - MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME - AOS OUTSW+0*LPTSW ;SET FOR LPT - MOVEM ACFILE,LSTDIR ;STORE FILE NAME - JUMPN ACEXT,.+2 - MOVSI ACEXT,(SIXBIT /LST/) - MOVEM ACEXT,LSTDIR+1 - MOVEM ACPPN,LSTDIR+3 ;SET PPN - OPEN LST,LSTINI ;INITIALIZE LISTING OUTPUT - JRST EINIT ;ERROR - TLZE TIO,TIOLE - MTAPE LST,10 - TLZE TIO,TIORW ;REWIND REQUESTED? - MTAPE LST,1 ;YES - JUMPGE CS,LSTSE3 - MTAPE LST,17 - AOJL CS,.-1 - WAIT LST, - STATO LST,1B24 - MTAPE LST,16 -LSTSE3: SOJG CS,.-1 - TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED? - UTPCLR LST, ;YES, CLEAR IT - OUTBUF LST,2 ;SET UP A TWO RING BUFFER - GETSET: MOVEI 3,PDPERR - HRRM 3,JOBAPR ;SET TRAP LOCATION - MOVEI 3,1B19 ;SET FOR PUSH-DOWN OVERFLOW - APRENB 3, - SOS 3,PDP ;GET PDP REQUEST MINUS 1 - IMULI 3,.PDP ;COMPUTE SIZE (50*) - HRLZ MP,3 - HRR MP,JOBFF ;SET BASIC POINTER - MOVE PP,MP - SUB PP,3 - MOVEM PP,RP ;SET RP - SUB PP,3 - ASH 3,1 ;DOUBLE SIZE OF BASIC POINTER - HRL PP,3 - SUBM PP,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 UNIERR ;IT WAS, YOU LOSE - 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 JOBREL - 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,JOBREL ;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 - PUSHJ PP,SRCHI ;INITIALIZE TABLE - MOVE [XWD CTIBUF+1,CTLSAV] ;SAVE CONTROL INPUT BUFFER - BLT CTLS1 ;FOR RESCAN ON PASS 2 -IFN FTDISK, - PUSHJ PP,COUTI ;INIT OUTPUT JUST IN CASE - PUSHJ PP,INSET ;GET FIRST INPUT FILE - -IFN CCLSW, - MOVE CS,INDIR ;SET UP NAME OF FIRST FILE - MOVEM CS,LSTFIL ;AS LAST PRINTED - SETZM LSTPGN - JRST ASSEMB ;START ASSEMBLY - FINIS: CLOSE BIN, ;DUMP BUFFER - TLNE FR,PNCHSW ;PUNCH REQUESTED? - PUSHJ PP,TSTBIN ;YES, TEST FOR ERRORS - RELEAS BIN, - CLOSE LST, - SOSLE OUTSW+0*LPTSW ;LPT TYPE OUTPUT? - PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS - RELEAS LST, - RELEAS CHAR, - OUTPUT CTL,0 ;FLUSH TTY OUTPUT - SKIPE UNIVSN ;SKIP IF NOT ASSEMBLING UNIVERSAL - PUSHJ PP,UNISYM ;STORE SYMBOLS ETC. FIRST - JRST M ;RETURN FOR NEXT ASSEMBLY - INSET: MOVEI JOBFFI ;POINTER TO INPUT BUFFER - HRRM JOBFF ;INFORM SYSTEM OF BUFFER AREA - PUSHJ PP,NAME2 ;GET NEXT COMMAND NAME - JUMPE ACDEV,ERRNE ;ERROR IF NONE LEFT - 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 - JRST EINIT ;ERROR - 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 - MTAPE CHAR,10 - TLZE TIO,TIORW ;REWIND? - MTAPE CHAR,1 ;YES - JUMPGE CS,INSET2 - MTAPE CHAR,17 - MTAPE CHAR,17 - AOJL CS,.-1 - WAIT CHAR, - STATO CHAR,1B24 - MTAPE CHAR,16 -INSET2: SOJGE CS,.-1 - -INSET3: INBUF CHAR,1 - MOVEI ACPNTR,JOBFFI - EXCH ACPNTR,JOBFF - SUBI ACPNTR,JOBFFI - MOVEI ACDEL,NUMBUF*203+1 - IDIV ACDEL,ACPNTR - INBUF CHAR,(ACDEL) - JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK - MOVSI ACEXT,(SIXBIT /MAC/) ;BLANK, TRY .MAC FIRST - PUSHJ PP,INSETI -INSET4: PUSHJ PP,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? - JRST ENTRDN ;YES, DON'T DO TWICE - SKIPN ACEXT,LSTDEV ;IS THERE A LIST DEVICE? - JRST LSTSE5 ;NO SO DON'T DO ENTER - SKIPN ACFILE,LSTDIR ;GET FILE NAME INCASE OF ERROR - JRST [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 - JRST LSTSE4] - HLLZ ACEXT,LSTDIR+1 ;EXT ALSO - MOVE ACPPN,LSTDIR+3 ;SAVE PPN - LOOKUP LST,LSTDIR ;PREVIOUS ONE STILL THERE - JRST LSTSE4 ;NO - SETZM LSTDIR ;YES,CLEAR NAME - MOVEM ACPPN,LSTDIR+3 ;RESET PPN - RENAME LST,LSTDIR - CLOSE LST, ;IGNORE FAILURE - MOVEM ACFILE,LSTDIR ;RESTORE NAME - HLLZS LSTDIR+1 ;BH 11/19/74 FOR DATE75. CLEAR RH. - SETZM LSTDIR+2 ;CLEAR PROTECTION AND DATE - MOVEM ACPPN,LSTDIR+3 ;SET PPN AGAIN -LSTSE4: -IFN STANSW,< - MOVSI ACEXT,400000 - MOVEM ACEXT,LSTDIR+2 ;SET DUMP NEVER BIT. -> - ENTER LST,LSTDIR ;SET UP DIRECTORY - JRST ERRCL ;ERROR -LSTSE5: SKIPN ACEXT,BINDEV ;A BINARY DEVICE THEN ? - JRST ENTRDN ;NO - SKIPN ACFILE,BINDIR ;INCASE OF ERROR - JRST [DEVCHR ACEXT, - TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY? - JRST .+1 ;YES, GIVE UP BEFORE HARM IS DONE - SKIPE ACFILE,INDIR ;USE INPUT FILE NAME - MOVEM ACFILE,BINDIR ;TOO BAD IF ZERO ALSO - JRST .+1] -IFN STANSW,< - MOVSI ACEXT,400000 - MOVEM ACEXT,BINDIR+2 -> - HLLZS ACEXT,BINDIR+1 ;BH 11/19/74 DATE75. WAS HLLZ. - ENTER BIN,BINDIR ;ENTER FILE NAME - JRST ERRCB ;ERROR - -ENTRDN: SETOM ENTERS ;MAKE SURE ONLY DONE ONCE - MOVE CS,[POINT 7,DEVBUF] - PUSH PP,1 ;SAVE THE ACCS - PUSH PP,2 - PUSH PP,3 - 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? - MOVEI 1," " ;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 -FINEXT: MOVEI 1," " - IDPB 1,CS ;SEPARATE BY TAB - LDB 1,[POINT 12,INDIR+2,35] ;GET DATE - LDB 2,[POINT 3,INDIR+1,20] ;BH 11/19/74 DATE75. - DPB 2,[POINT 3,1,23] ;BH 11/19/74 DATE75. - JUMPE 1,FINDEV ;NO DATE? - PUSHJ PP,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 - PUSHJ PP,TIMOU1 ;STORE TIME -FINDEV: SETZ 1, - MOVEI 2," " ;FINAL TAB - IDPB 2,CS - IDPB 1,CS ;TERMINATE FOR NOW - POP PP,3 ;RESTORE ACCS - POP PP,2 - POP PP,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 - POPJ PP, - REC2: MOVS [XWD CTIBUF+1,CTLSAV] ;RESCAN CONTROL (FROM PASS1 END STMNT) - BLT CTIBUF+2 ;INPUT BUFFER - MOVEI "_" - HRLM ACDELX ;FUDGE PREVIOUS DELIMITER -IFN RENTSW, - SETZM PASS2I - MOVE [XWD PASS2I,PASS2I+1] - BLT PASS2X-1 ;ZERO PASS2 VARIABLES - TLO FR,MTAPSW!LOADSW ;SET FLAGS - -GOTEND: MOVE INDEV ;GET LAST DEVICE - DEVCHR ;GET ITS CHARACTERISTICS - TLNE 4 ;TEST FOR DIRECTORY (DSK OR DTA) - JRST EOT ;YES, SO DON'T WASTE TIME - JRST .+3 ;NO, INPUT BUFFER BY BUFFER - IN CHAR, - JRST .-1 ;NO ERRORS - STATO CHAR,1B22 ;TEST FOR EOF - JRST .-3 ;IGNORE ERRORS - -EOT: PUSHJ PP,SAVEXS ;SAVE REGISTERS - PUSHJ PP,INSET ;GET THE NEXT INPUT DEVICE - HRROI RC,[SIXBIT /END OF PASS 1@/] ;ASSUME END OF PASS - TLZN FR,LOADSW ;ZERO ONLY ON END OF PASS 1 - HRROI RC,[SIXBIT /LOAD THE NEXT FILE@/] ;NOT END OF PASS - TLNN ACDEV,(1B13!1B15) ;WAS ALL THAT WORK NECESSARY? - PUSHJ PP,TYPMSG ;YES - -RSTRXS: MOVSI RC,SAVBLK ;SET POINTER - BLT RC,RC-1 ;RESTORE REGISTERS - MOVE RC,SAVERC ;RESTORE RC - POPJ PP, ;EXIT - -SAVEXS: MOVEM RC,SAVERC ;SAVE RC - MOVEI RC,SAVBLK ;SET POINTER - BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW RC - POPJ PP, ;EXIT - NAME1: SETZM ACDEVX ;ENTRY FOR DESTINATION -NAME2: SETZB ACDEV,INDIR+2 ;ENTRY FOR SOURCE - MOVEI ACFILE,0 ;CLEAR FILE - HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER - SETZB TIO,CS - SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR - SETZM PPN ;CLEAR PPN -NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER - TDZA AC0,AC0 ;CLEAR SYMBOL - -SLASH: PUSHJ PP,SW0 -GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER - CAIN C,"/" - JRST SLASH - CAIN C,"(" - JRST SWITCH - CAIN C,":" - JRST DEVICE - CAIN C,"." - JRST NAME -IFN CCLSW, - CAIE C,33 ;CHECK FOR THREE FLAVORS OF ALT-MODE - CAIN C,176 ;... - JRST TERM ;... - CAIG C,CR ;LESS THAN CR? - CAIGE C,LF ;AND GREATER THAN LF? - CAIN C,175 ;OR 3RD ALTMOD - JRST TERM ;YES -IFN FTDISK, - CAIN C,"=" ;EQUALS IS SAME AS LEFT ARROW - TRCA C,142 ;SO MAKE IT A "_" AND SKIP - CAIE C,"," - CAIN C,"_" - JRST TERM - CAIGE C,40 ;VALID AS SIXBIT? - JRST [CAIN C,"Z"-100 ;NO,IS IT ^Z - EXIT ;YES,EXIT FOR BATCH - JRST GETIOC] ;JUST IGNORE - 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 - -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 - -TERM: 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, - HLLZ ACEXT,AC0 ;SET EXTENSION - HRLM C,ACDELX ;SAVE PREVIOUS DELIMITER - JUMPN ACDEV,.+2 ;IF DEVICE SET USE IT - SKIPA ACDEV,ACDEVX ;OTHERWISE USE LAST DEVICE - MOVEM ACDEV,ACDEVX ;AND DEVICE - MOVE ACPPN,PPN ;PUT PPN IN RIGHT PLACE -IFN FTDISK, - POPJ PP, ;EXIT - ERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/] - JRST ERRFIN - -IFN FTDISK, -IFN STANSW, - JRST PROGN3 ;GET NEXT CHARACTER> - SWITC0: PUSHJ PP,SW1 ;PROCESS CHARACTER -SWITCH: PUSHJ PP,TTYIN ;GET NEXT CHARACTER - CAIE C,")" ;END OF STRING? - JRST SWITC0 ;NO - JRST GETIOC ;YES - -SW0: PUSHJ PP,TTYIN -SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC - CAILE C,"Z"-"A" ;WITHIN BOUNDS? (IS IT ALPHA?) - JRST ERRCM ;NO, ERROR - MOVE RC,[POINT 4,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 PP,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 - POPJ PP, ;EXIT - TLZ IO,IOSALL ;TAKE CARE OF /X - POPJ PP, - -DEFINE HELP (TEXT)< - XLIST - ASCIZ ?TEXT? - LIST> - -HLPMES: HELP < -Switches are :- -/A advance one file -/B backspace one file -/C produce a cref listing -/E list macro expansions (LALL) -/F list in new format (.MFRMT) -/G list in old format (.HWFRMT) -/H type this text -/L reinstate listing (LIST) -/M suppress ascii in macro and repeat expansion (SALL) -/N suppress error printout on tty -/O set MLOFF pseudo-op -/P increase size of the pushdown stack -/Q suppress Q errors on the listing -/S suppress listing (XLIST) -/T rewind device -/X suppress all macro expansions (XALL) -/Z zero the directory -Switches A,B,C,T,W,X, and Z must immediately follow -the device or file to which they refer. -> - DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION -J= <"LETTER"-"A">-^D9*/^D9> - SETCOD \I,J> - - DEFINE SETCOD (I,J) - B<4*J+3>> - -BYTAB0= 0 ;INITIALIZE TABLE -BYTAB1= 0 -BYTAB2= 0 - -SWTAB: - SETSW Z, - SETSW C, - SETSW P, -SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY - SETSW A, - SETSW B, - SETSW E, -IFN FORMSW,< SETSW F, - SETSW G,> - SETSW H, - SETSW L, - SETSW M, - SETSW N, - SETSW O, - SETSW Q, - SETSW S, - SETSW T, - SETSW W, - SETSW X, - -BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB - ;IT CONSIST OF 9 4BIT BYTES/WORD - ;OR ONE BYTE FOR EACH LETTER - - +BYTAB0 ;A-I BYTE = 1 THROUGH 17 = INDEX - +BYTAB1 ;J-R BYTE = 0 = COMMAND ERROR - +BYTAB2 ;S-Z - -IF2, - TTYIN: SOSGE CTIBUF+2 ;ENUF CHAR.? - JRST TTYERR ;NO - ILDB C,CTIBUF+1 ;GET CHARACTER - CAIE C," " ;SKIP BLANKS - CAIN C,HT ;AND TABS - JRST TTYIN - CAIN C,15 ;CR? - SETZM CTIBUF+2 ;YES,IGNORE REST OF LINE - CAIG C,"Z"+40 ;CHECK FOR LOWER CASE - CAIGE C,"A"+40 - POPJ PP, ;NO,EXIT - SUBI C,40 - POPJ PP, ;YES, EXIT - -TTYERR: SKIPN INDEV ;INPUT DEVICE SEEN? - JRST ERRCM ;NO, SO MISSING "_" -ERRNE: HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/] -ERRNE0: SKPINC V ;SEE IF WE CAN INPUT A CHAR. - JFCL ;BUT ONLY TO DEFEAT ^O - PUSHJ PP,TYPMSG ;OUTPUT IT - SKIPE LITLVL ;SEE IF IN LITERAL - SKIPN LITPG ;PAGE 0 MEANS NOT IN A LITERAL REALY - JRST ERRNE1 ;NO, TRY OTHERS - MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG] - PUSHJ PP,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] - JUMPN V,ERRNE3 - SKIPN LITLVL ;HAD ONE PAGE NUMBER ALREADY - SKIPA V,[XWD [SIXBIT /@/],PAGENO] ;BETTER THAN NOTHING - JRST .+2 -ERRNE3: PUSHJ PP,PRNUM - HRROI RC,[SIXBIT /@/] ;WILL GET A RETURN - JRST ERRFIN - -ERRMS1: SIXBIT / ERRORS DETECTED@/ -ERRMS2: SIXBIT /?1 ERROR DETECTED@/ -ERRMS3: SIXBIT /NO ERRORS DETECTED@/ -EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]] - JRST ERRFIN - 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 - -ERRFIN: SKPINC C ;SEE IN WE CAN INPUT A CHAR. - JFCL ;BUT ONLY TO DEFEAT ^O - PUSHJ PP,CRLF - MOVEI C,"?" - PUSHJ PP,TYO - PUSHJ PP,TYPMS1 - CLOSE LST, ;GIVE USER A PARTIAL LISTING - CLOSE BIN,40 ;BUT NEVER A BUM REL FILE -IFN CCLSW, - JRST M - - [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: PUSHJ PP,CRLF ;MOVE TO NEXT LINE -TYPMS1: HLRZ CS,RC ;GET FIRST MESSAGE - CAIE CS,-1 ;SKIP IF MINUS ONE - PUSHJ PP,TYPM2 ;TYPE MESSAGE - HRRZ CS,RC ;GET SECOND HALF - PUSHJ PP,TYPM2 - -CRLF: MOVEI C,CR ;OUTPUT CARRIAGE RETURN - PUSHJ PP,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? - POPJ PP, ;NO - OUTPUT CTL,0 ;YES - POPJ PP, ;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 - PUSHJ PP,TYO ;OUTPUT CHARACTER - JRST TYPM3 - - XCEEDS: ADDI SX,2000 ;ADJUST SYMBOL POINTER -XCEED: PUSHJ PP,SAVEXS ;SAVE THE REGISTERS - HRRZ 1,JOBREL ;GET CURRENT TOP - MOVEI 0,2000(1) - CORE 0, ;REQUEST MORE CORE - JRST XCEED2 ;ERROR, BOMB OUT - HRRZ 2,JOBREL ;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 - PUSHJ PP,SRCHI ;RE-INITIALIZE SYMBOL TABLE - JRST RSTRXS ;RESTORE REGISTERS AND EXIT - -XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/] - JRST ERRNE0 -PDPERR: HRROI RC,[SIXBIT .PDP OVERFLOW, TRY /P@.] - JRST ERRNE0 - -PRNUM: HLRZ CS,V ;GET MESSAGE - PUSHJ PP,TYPM2 - MOVEI CS,[SIXBIT /ON PAGE@/] - PUSHJ PP,TYPM2 - MOVE AC0,(V) ;GET PAGE - PUSHJ PP,DP1 ;PRINT NUMBER - MOVEI C,40 - PUSHJ PP,TYO - SKIPN AC1,1(V) ;GET SEQ NUM IF THERE - POPJ PP, ;NO, RETURN - MOVEM AC1,OUTSQ - MOVEI CS,[SIXBIT /LINE@/] - PUSHJ PP,TYPM2 - MOVEI AC0,OUTSQ ;PRINT IT - OUTPUT CTL,0 ;TO MAKE THINGS PRINT IN RIGHT ORDER - DDTOUT AC0, - MOVEI C,40 - JRST TYO ;AND RETURN - -DP1: IDIVI AC0,^D10 - HRLM AC1,(PP) - JUMPE AC0,.+2 - PUSHJ PP,DP1 - HLRZ C,(PP) - 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 - POPJ PP, - -ROUT: EXCH CS,RIMLOC - SUB PP,[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 - PUSHJ PP,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 - PUSHJ PP,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 - POPJ PP, - SOSG BINBUF+2 ;TEST FOR BUFFER FULL - PUSHJ PP,DMPBIN ;YES, DUMP IT - IDPB C,BINBUF+1 ;DEPOSIT BYTE - POPJ PP, ;EXIT - - DMPBIN: OUT BIN,0 ;DUMP THE BUFFER - POPJ PP, ;NO ERRORS -TSTBIN: GETSTS BIN,C ;GET STSTUS BITS - TRNN C,ERRBIT ;ERROR? - POPJ PP, ;NO, EXIT - MOVE AC0,BINDEV ;YES, GET TAG - JRST ERRLST ;TYPE MESSAGE AND ABORT - -DMPLST: OUT LST,0 ;OUTPUT BUFFER - POPJ PP, ;NO ERRORS -TSTLST: GETSTS LST,C ;ANY ERRORS? - TRNN C,ERRBIT - POPJ PP, ;NO, EXIT - MOVE AC0,LSTDEV -ERRLST: MOVSI RC,[SIXBIT /OUTPUT WRITE-LOCK ERROR DEVICE@/] - TRNE C,IOIMPM ;IMPROPER MODE? - JRST ERRFIN ;YES - MOVSI RC,[SIXBIT /OUTPUT DATA ERROR DEVICE@/] - TRNE C,IODERR ;DEVICE DATA ERROR? - JRST ERRFIN ;YES - MOVSI RC,[SIXBIT /OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/] - TRNE C,IODTER ;IS IT - JRST ERRFIN ;YES - MOVE CS,AC0 ;GET DEVICE - DEVCHR CS, ;FIND OUT WHAT IT IS - MOVSI RC,[SIXBIT /OUTPUT QUOTA EXCEEDED ON DEVICE@/] - TLNN CS,DSKBIT ;SKIP IF DSK OUTPUT - MOVSI RC,[SIXBIT /OUTPUT BLOCK TOO LARGE DEVICE@/] - JRST ERRFIN - -R1BDMP: SETCM CS,R1BCNT - JUMPE CS,R1BI - HRLZS C,CS - HRR C,R1BLOC - HRRI C,-1(C) - MOVEM C,R1BCHK - PUSHJ PP,PTPBIN - HRRI CS,R1BBLK -R1BDM1: MOVE C,0(CS) - ADDM C,R1BCHK - PUSHJ PP,PTPBIN - AOBJN CS,R1BDM1 - MOVE C,R1BCHK - PUSHJ PP,PTPBIN -R1BI: SETOM R1BCNT - PUSH PP,LOCO - POP PP,R1BLOC - POPJ PP, - -ROUT6: CAME CS,RIMLOC - PUSHJ PP,R1BDMP - AOS C,R1BCNT - MOVEM AC0,R1BBLK(C) - AOS LOCO - CAIN C,.R1B-1 - PUSHJ PP,R1BDMP - AOS RIMLOC - POPJ PP, - - - READ0: PUSHJ PP,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 - CAIN CS,1 ;CHECK FOR SPECIAL - MOVE CS,[+1] - MOVEM CS,SEQNO - MOVEM CS,SEQNO2 - MOVNI CS,4 - ADDM CS,IBUF+2 ;ADJUST WORD COUNT -REPEAT 4,< IBP IBUF+1> ;SKIP SEQ NO - PUSHJ PP,READ ;AND THE TAB - JRST READ ;GET NEXT CHARACTER - -READ1A: JUMPE C,READ ;IGNORE NULL - CAIN C,32 ;IF IT'S A "^Z" - MOVEI C,LF ;TREAT IT AS A "LF" - CAIE C,37 ;CONTROL _ - POPJ PP, - MOVEI C,"^" ;MAKE CONTROL-SHIFT _ VISIBLE - PUSHJ PP,RSW2 - MOVEI C,"_" - PUSHJ PP,RSW2 -READ2: PUSHJ PP,READ ;YES, TEST FOR LINE FEED - PUSHJ PP,RSW2 ;LIST IN ANY EVENT - CAIG C,FF ;IS IT ONE OF - CAIGE C,LF ;LF, VT, OR FF? - JRST READ2 ;NO - PUSHJ PP,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 - MOVSI RC,[SIXBIT/ INPUT PHYSICAL END OF TAPE DEVICE@/] - TRNE C,2000 - JRST ERRFIN ;E-O-T - MOVSI RC,[SIXBIT /MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/] - TRNE C,IOIMPM ;IMPROPER MODE? - JRST ERRFIN ;YES - MOVSI RC,[SIXBIT /INPUT DATA ERROR DEVICE@/] - TRNE C,IODERR ;DEVICE DATA ERROR? - JRST ERRFIN ;YES - MOVSI RC,[SIXBIT /INPUT CHECKSUM OR PARITY ERROR DEVICE@/] - TRNN C,IODTER - MOVSI RC,[SIXBIT /INPUT BLOCK TOO LARGE DEVICE@/] - JRST ERRFIN - - OUTAB2: PUSHJ PP,OUTTAB ;PRINT TWO TABS -OUTTAB: MOVEI C,HT -PRINT: CAIE C,CR ;IS THIS A CR? - CAIN C,LF ;OR LF? - JRST OUTCR ;YES, GO PROCESS - CAIN C,FF ;FORM FEED? - JRST OUTFF ;YES, FORCE NEW PAGE - JRST OUTL - -OUTCR: TRNN ER,ERRORS!LPTSW!TTYSW - POPJ PP, - MOVEI C,CR ;CARRIAGE RETURN, LINE FEED - PUSHJ PP,OUTL - SOSGE LPP ;END OF PAGE? - TLO IO,IOPAGE ;YES, SET FLAG - TRCA C,7 ;FORM LINE FEED AND SKIP - -OUTL: TLZN IO,IOPAGE ;NEW PAGE REQUESTED? - JRST OUTC ;NO - JUMP1 OUTC ;YES, BYPASS IF PASS ONE - PUSH PP,C ;SAVE C AND CS - PUSH PP,CS - PUSH PP,ER - TLNN IO,IOMSTR!IOPROG - HRR ER,OUTSW - TLNE IO,IOCREF ;IF DOING CREF OUTPUT NOW - TLNE FR,CREFSW ;AND CREFFING (JUST IN CASE) - JRST .+2 - PUSHJ PP,CLSC3 ;CLOSE IT OUT - HLLM IO,(PP) ;SAVE THIS NEW STATE OF IO - MOVEI C,.LPP - MOVEM C,LPP ;SET NEW COUNTER - MOVEI C,CR - PUSHJ PP,OUTC - MOVEI C,FF - PUSHJ PP,OUTC ;OUTPUT FORM FEED - MOVEI CS,TBUF - PUSHJ PP,OUTAS0 ;OUTPUT TITLE - MOVEI CS,VBUF - PUSHJ PP,OUTAS0 ;OUTPUT VERSION - MOVEI CS,DBUF - PUSHJ PP,OUTAS0 ; AND DATE - MOVE C,PAGENO - PUSHJ PP,DNC ;OUTPUT PAGE NUMBER - AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER? - JRST OUTL1 ;YES - MOVEI C,"-" ;NO, PUT OUT MODIFIER - PUSHJ PP,OUTC - MOVE C,PAGEN. - PUSHJ PP,DNC -OUTL1: PUSHJ PP,OUTCR - MOVEI CS,DEVBUF - PUSHJ PP,OUTAS0 - HRRZ CS,SUBTTX ;SWITCH FOR SUB-TITLE - SKIPE 0(CS) ;IS THERE A SUB-TITLE? - PUSHJ PP,OUTTAB ;YES, OUTPUT A TAB - PUSHJ PP,SOUT20 ;OUTPUT ASCII WITH CARRIAGE RETURN - PUSHJ PP,OUTCR - POP PP,ER - POP PP,CS ;RESTORE REGISTERS - POP PP,C - -OUTC: TRNE ER,ERRORS!TTYSW - PUSHJ PP,TYO - TRNN ER,LPTSW - POPJ PP, -OUTLST: SOSG LSTBUF+2 ;BUFFER FULL? - PUSHJ PP,DMPLST ;YES, DUMP IT -COMMENT $ REG DOESN'T LIKE THIS FEATURE ANY MORE 9-5-72 -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 - POPJ PP, ;EXIT - - PAGE0: PUSHJ PP,STOUTS ;PAGE PSEUDO-OP -OUTFF1: TLNE IO,IOCREF ;CURRENTLY DOING CREF? - TLNE IO,IOPROG ;AND NOT XLISTED? - JRST OUTFF ;NO - HRR ER,OUTSW - PUSHJ PP,CLSCRF - PUSHJ PP,OUTCR - HRRI ER,0 -OUTFF: TLO IO,IOPAGE -OUTFF2: SETOM PAGEN. - AOS PAGENO - POPJ PP, - -TIMOUT: IDIVI 2,^D60*^D1000 -TIMOU1: IDIVI 2,^D60 - PUSH PP,3 ;SAVE MINUTES - PUSHJ PP,OTOD ;STORE HOURS - MOVEI 3,":" ;SEPARATE BY COLON - IDPB 3,CS - POP PP,2 ;STORE MINUTES -OTOD: IDIVI 2,^D10 - ADDI 2,60 ;FORM ASCII - IDPB 2,CS - ADDI 3,60 - IDPB 3,CS - POPJ PP, - -DATOUT: IDIVI 1,^D31 ;GET DAY - ADDI 2,1 - CAIG 2,^D9 ;TWO DIGITS? - ADDI 2,7760*^D10 ;NO, PUT IN SPACE - PUSHJ PP,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-" - "-BEF-" - "-RAM-" - "-RPA-" - "-YAM-" - "-NUJ-" - "-LUJ-" - "-GUA-" - "-PES-" - "-TCO-" - "-VON-" - "-CED-" - SUBTTL MACHINE INSTRUCTION SEARCH ROUTINES -IFE OPHSH,< -OPTSCH: MOVEI RC,0 - MOVEI ARG,1B^L ;SET UP INDEX - MOVEI V,1B^L/2 ;SET UP INCREMENT - -OPT1A: CAMN AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL? - JRST OPT1D ;YES, GET THE CODE - JUMPE V,POPOUT ;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 - POPJ PP, ;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 - POPJ PP, ;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(PP) ;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,.+3 ;IF ".","$",OR "%" USE TABLE 1 - 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> - - IFDEF .XCREF,< .XCREF ;DON'T CREF THIS MESS> -IFE OPHSH,< - RELOC .-1 -OP1TOP: - RELOC - - IF1,> - - IF2, < - N2=^D36 - CC=0 - RELOC OP1COD - RELOC -DEFINE X (SYMBOL,CODE) - -IFE N2, > - -DEFINE OUTLIT < - RELOC - +CC - RELOC -N2=^D36+>> - SYN X,XX ;JUST THE SAME MACRO> - -IFN OPHSH,< -DEFINE XX (SB,CD)<> ;A NUL MACRO -OP1TOP: IF1,< BLOCK PRIME> -IF1,> -IF2,< -DEFINE OPSTOR (RM)<.$'RM=.$'RM+>>> - -DEFINE X (SB,CD)< -SXB= -Q=SXB&-1_-1/PRIME -R=SXB&-1_-1-Q*PRIME -H=Q_-22&777 -TRY=1 -OPCODE=CD -ITEM Q,\R -IFL PRIME-TRY,> - -DEFINE ITEM (QT,RM)< -IFN .%'RM, -H=H+Q_-22&777 -IFGE PRIME-,> -IFE .%'RM,<.%'RM=SXB -OPSTOR \>>> -IF1,< -DEFINE GETSYM (N)<.%'N=0> - -N=0 - XLIST -REPEAT PRIME, -DEFINE GETSYM (N)<.$'N=0> -N=0 -REPEAT , -> - LIST> - -;MACRO TO HANDLE KI10 OP-CODES -IFE KI10,< -DEFINE XK (SB,CD) <> ;NUL MACRO> -IFN KI10, - IFN OPHSH,< ;PUT THE MOST USED OP CODES FIRST -X JRST , 254 -X PUSHJ , 260 -X POPJ , 263 -X PUSH , 261 -X POP , 262 -X AOS , 350 -X ASCIZ , 701 -X CALLI , 047 -X EXTERN, 724 -X INTERN, 744 -X JFCL , 255 -X JSP , 265 -X MOVE , 200 -X MOVEI , 201 -X MOVEM , 202 -X SETZM , 402 -X SIXBIT, 717 -X SOS , 370 -X TLNE , 603 -X TLNN , 607 -X TLO , 661 -X TLZ , 621 -X TLZA , 625 -X TLZE , 623 -X TLZN , 627 -X TRNE , 602 -X TRNN , 606 -X TRZ , 620 -> - X ADD , 270 -X ADDB , 273 -X ADDI , 271 -X ADDM , 272 - -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 - -XX 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 -IFN WFWSW, -IFN IIISW, -X ASCII , 700 -XX 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 - -XX 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 -XX CALLI , 047 - -XX CAM , 310 -X CAMA , 314 -X CAME , 312 -X CAMG , 317 -X CAMGE , 315 -X CAML , 311 -X CAMLE , 313 -X CAMN , 316 - -XX CLEAR , 400 -XX CLEARB, 403 -XX CLEARI, 401 -XX CLEARM, 402 - -X CLOSE , 070 -X COMMEN, 770 - - -X CONI , 710 -X CONO , 711 -IFN STANSW, -X CONSO , 712 -X CONSZ , 713 - -XX DATA. , 020 - -X DATAI , 714 -X DATAO , 715 -X DEC , 716 -X DEFINE, 717 -X DEPHAS, 720 - -XK DFAD , 110 -XK DFDV , 113 -XK DFMP , 112 -X DFN , 131 -XK DFSB , 111 - -X DIV , 234 -X DIVB , 237 -X DIVI , 235 -X DIVM , 236 - -XK DMOVE , 120 -XK DMOVEM, 124 -XK DMOVN , 121 -XK DMOVNM, 125 - -X DPB , 137 - -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 -XX 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 - -XX FIN. , 021 - -IFN STANSW, -IFE STANSW, -XK FIXR , 126 -XK FLTR , 127 - -X FMP , 160 -X FMPB , 163 -X FMPL , 161 -X FMPM , 162 - - X FMPR , 164 -X FMPRB , 167 -X FMPRI , 165 -X FMPRM , 166 - -X FSB , 150 -X FSBB , 153 -X FSBL , 151 -X FSBM , 152 - -X FSBR , 154 -X FSBRB , 157 -X FSBRI , 155 -X FSBRM , 156 - -X FSC , 132 - -X GETSTS, 062 - - X HALT , 725 -X HISEG , 706 - -X HLL , 500 -X HLLE , 530 -X HLLEI , 531 -X HLLEM , 532 -X HLLES , 533 -X HLLI , 501 -X HLLM , 502 -X HLLO , 520 -X HLLOI , 521 -X HLLOM , 522 -X HLLOS , 523 -X HLLS , 503 -X HLLZ , 510 -X HLLZI , 511 -X HLLZM , 512 -X HLLZS , 513 - -X HLR , 544 -X HLRE , 574 -X HLREI , 575 -X HLREM , 576 -X HLRES , 577 -X HLRI , 545 -X HLRM , 546 -X HLRO , 564 -X HLROI , 565 -X HLROM , 566 -X HLROS , 567 -X HLRS , 547 -X HLRZ , 554 -X HLRZI , 555 -X HLRZM , 556 -X HLRZS , 557 - - X HRL , 504 -X HRLE , 534 -X HRLEI , 535 -X HRLEM , 536 -X HRLES , 537 -X HRLI , 505 -X HRLM , 506 -X HRLO , 524 -X HRLOI , 525 -X HRLOM , 526 -X HRLOS , 527 -X HRLS , 507 -X HRLZ , 514 -X HRLZI , 515 -X HRLZM , 516 -X HRLZS , 517 - -X HRR , 540 -X HRRE , 570 -X HRREI , 571 -X HRREM , 572 -X HRRES , 573 -X HRRI , 541 -X HRRM , 542 -X HRRO , 560 -X HRROI , 561 -X HRROM , 562 -X HRROS , 563 -X HRRS , 543 -X HRRZ , 550 -X HRRZI , 551 -X HRRZM , 552 -X HRRZS , 553 - -X IBP , 133 - -X IDIV , 230 -X IDIVB , 233 -X IDIVI , 231 -X IDIVM , 232 - -X IDPB , 136 - -X IF1 , 726 -X IF2 , 727 -X IFB , 730 -X IFDEF , 731 -X IFDIF , 732 -X IFE , 733 -X IFG , 734 -X IFGE , 735 -X IFIDN , 736 -X IFL , 737 -X IFLE , 740 -X IFN , 741 -X IFNB , 742 -X IFNDEF, 743 - -X ILDB , 134 - -X IMUL , 220 -X IMULB , 223 -X IMULI , 221 -X IMULM , 222 - -X IN , 056 -XX IN. , 016 -X INBUF , 064 -XX INF. , 026 -X INIT , 041 -X INPUT , 066 -IFN WFWSW, - -XX 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 - -XX JFCL , 255 - -X JFFO , 243 -X JFOV , 765 -X JOV , 754 - -X JRA , 267 -XX JRST , 254 - -X JRSTF , 755 - -X JSA , 266 -XX JSP , 265 -X JSR , 264 - -XX JUMP , 320 -XX 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 -IFN WFWSW, -XK MAP , 257 -X MLOFF , 767 -X MLON , 766 -XX MOVE , 200 -XX MOVEI , 201 -XX 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 -X MOVSM , 206 -X MOVSS , 207 - - -X MTAPE , 072 -XX MTOP. , 024 - -X MUL , 224 -X MULB , 227 -X MULI , 225 -X MULM , 226 -XX NLI. , 031 -XX 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 -XX OUT. , 017 -X OUTBUF, 065 -XX OUTF. , 027 -X OUTPUT, 067 - - X PAGE , 700 -X PASS2 , 701 -X PHASE , 702 -X POINT , 703 - -XX POP , 262 -XX POPJ , 263 - -X PRGEND, 714 -X PRINTX, 704 -X PURGE , 705 - -XX PUSH , 261 -XX PUSHJ , 260 - -X RADIX , 706 -X RADIX5, 707 - -X RELEAS, 071 - -X RELOC , 710 -X REMARK, 711 - -X RENAME, 055 - -X REPEAT, 712 - -XX RESET., 015 -X RIM , 715 -X RIM10 , 735 -X RIM10B, 736 - -X ROT , 241 -X ROTC , 245 - -X RSW , 716 -XX 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 -XX SETZM , 402 - -XX SIXBIT, 717 - -XX SKIP , 330 -X SKIPA , 334 -X SKIPE , 332 -X SKIPG , 337 -X SKIPGE, 335 -X SKIPL , 331 -X SKIPLE, 333 -X SKIPN , 336 - -XX 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 - -XX SOS , 370 -X SOSA , 374 -X SOSE , 372 -X SOSG , 377 -X SOSGE , 375 -X SOSL , 371 -X SOSLE , 373 -X SOSN , 376 - -IFN STANSW, -X SQUOZE, 707 - -X STATO , 061 -X STATUS, 062 -X STATZ , 063 - -X STOPI , 722 - -X SUB , 274 -X SUBB , 277 -X SUBI , 275 -X SUBM , 276 - -IF2,> -X SUBTTL, 723 -X SUPPRE, 713 -X SYN , 724 -X TAPE , 725 - - X TDC , 650 -X TDCA , 654 -X TDCE , 652 -X TDCN , 656 -X TDN , 610 -X TDNA , 614 -X TDNE , 612 -X TDNN , 616 -X TDO , 670 -X TDOA , 674 -X TDOE , 672 -X TDON , 676 -X TDZ , 630 -X TDZA , 634 -X TDZE , 632 -X TDZN , 636 - -X TITLE , 726 - -X TLC , 641 -X TLCA , 645 -X TLCE , 643 -X TLCN , 647 -X TLN , 601 -X TLNA , 605 -XX TLNE , 603 -XX TLNN , 607 -XX TLO , 661 -X TLOA , 665 -X TLOE , 663 -X TLON , 667 -XX TLZ , 621 -XX TLZA , 625 -XX TLZE , 623 -XX TLZN , 627 - - X TRC , 640 -X TRCA , 644 -X TRCE , 642 -X TRCN , 646 -X TRN , 600 -X TRNA , 604 -XX TRNE , 602 -XX TRNN , 606 -X TRO , 660 -X TROA , 664 -X TROE , 662 -X TRON , 666 -XX 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 - -XX WTB. , 023 - -X XALL , 732 - -X XCT , 256 - -X XLIST , 733 - -X XOR , 430 -X XORB , 433 -X XORI , 431 -X XORM , 432 - -X XPUNGE, 730 -X XWD , 734 - -X Z , 000 - -X .CREF , 740 -X .HWFRM, 742 -X .MFRMT, 743 -X .XCREF, 741 - - - IFN OPHSH,< ;NO-OPS, OLD MNEMONICS,F4 UUOS -X CAI , 300 -X CAM , 310 -X CLEAR , 400 -X CLEARB, 403 -X CLEARI, 401 -X CLEARM, 402 -X JUMP , 320 -X JUMPA , 324 -X SKIP , 330 -X RESET., 015 -X IN. , 016 -X OUT. , 017 -X DATA. , 020 -X FIN. , 021 -X RTB. , 022 -X WTB. , 023 -X MTOP. , 024 -X SLIST., 025 -X INF. , 026 -X OUTF. , 027 -X NLI. , 031 -X NLO. , 032 -> - IFE OPHSH,< -IF1, < BLOCK N1> -OP1END: -1B36 -OP1COD: BLOCK N1/4 - CC> -IFN OPHSH,< -IF2,< -DEFINE SETVAL (N) -N=0 -XLIST -REPEAT PRIME, -LIST -> -OP1COD: IF1,< BLOCK > -IF2,< -DEFINE SETVAL (N) -N=0 -XLIST -REPEAT , -> -LIST> - -IFDEF .CREF,< .CREF ;START CREFFING AGAIN> - SUBTTL PERMANENT SYMBOLS -SYMNUM: EXP LENGTH/2 ;NUMBER OF PERMANENT SYMBOLS -DEFINE P (A,B)< - SIXBIT /A/ - XWD SYMF!NOOUTF,B> - -P @, 0(SUPRBT) -P ??????, 0(SUPRBT) - -LENGTH= .-SYMNUM-1 ;LENGTH OF INITIAL SYMBOLS - -PRMTBL: ;PERMANENT SYMBOLS -P ADC, 24 -P APR, 0 -P CCI, 14 -P CDP, 110 -P CDR, 114 -P CPA, 0 -P CR, 150 -P DC, 200 -P DCSA, 300 -P DCSB, 304 -P DF, 270 -P DIS, 130 -P DLS, 240 -P DPC, 250 -P DSK, 170 -P DTC, 320 -P DTS, 324 -P LPT, 124 -P MDF, 260 -P MTC, 220 -P MTM, 230 -P MTS, 224 -P PAG, 10 -P PI, 4 -P PLT, 140 -P PTP, 100 -P PTR, 104 - -P TMC, 340 -P TMS, 344 -P TTY, 120 -P UTC, 210 -P UTS, 214 -IFE LNSSW,< XLIST > -IFN LNSSW,< ;SPECIAL DEVICES FOR PEPR -P .A,550 -P .AB,434 -P .ANG,440 -P .B,554 -P .BITE,470 -P .FA,564 -P .GAIN,520 -P .GATE,444 -P .IA,560 -P .INC,514 -P .LC,474 -P .LG,570 -P .PEPR,400 -P .RG,574 -P .SCON,430 -P .STAT,410 -P .TC,500 -P .TED,540 -P .THR,544 -P .TRK,404 -P .VIEW,524> - LIST -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 LOC0 (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 - ZAL IOSET (IOPALL!IOSALL) ;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 - ZAL XALL0 (IOPALL) ;XALL - ZAL IOSET (IOPROG) ;XLIST - Z XWD0 ;XWD - ZAL RIM0 (RIM1SW) ;RIM10 - ZAL RIM0 (R1BSW) ;RIM10B - ZA UNIV0 (Z (POINT 7,,)) ;UNIVERSAL - ZAL IORSET (IONCRF) ;.CREF - ZAL IOSET (IONCRF) ;.XCREF - ZA OFFORM ;.HWFRMT - ZA ONFORM ;.MFRMT - 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 - ZAL IORSET (IOPALL!IOSALL) ;LALL - ZAL IORSET (IOPROG) ;LIST - ZAL LIT0 ;LIT - ZAL LOC0 (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 -IFN IIISW!WFWSW,< - Z ASCII0 (5B20) ;ASCID -IFN WFWSW,< - ZAL %ARAY ;ARRAY - ZAL %INTEG ;INTEGER - ZAL %LVAR ;LVAR>> - -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 - -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 - SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES -MSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH - POPJ PP, ;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 - POPJ PP, ;NO, EXIT - ADDI SX,2 ;YES, POINT TO IT - PUSHJ PP,SRCH5 ;LOAD REGISTERS -MSRCH2: AOSA 0(PP) ;SET SKIP-EXIT -QSRCH: JUMPL ARG,SSRCH3 ;BRANCH IF OPERAND - MOVEI SDEL,%MAC ;SET OPERATOR FLAG - TLZE IO,DEFCRS ;IS IT A DEFINITION? - MOVEI SDEL,%DMAC ;YES - JRST CREF ;CROSS-REF AND EXIT - -SSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH - POPJ PP, ;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 - POPJ PP, ;NO DICE, EXIT - SUBI SX,2 ;YES, POINT TO IT - PUSHJ PP,SRCH5 ;LOAD REGISTERS -SSRCH2: AOS 0(PP) ;SET FOR SKIP-EXIT -SSRCH3: MOVEI SDEL,%SYM ;SET OPERAND FLAG - -CREF: TLNN IO,IONCRF ;NO CREFFING FOR THIS SYMBOL? - TLNE FR,P1!CREFSW ;PASS ONE OR CROSS-REF SUPPRESSION? - POPJ PP, ;YES, EXIT - EXCH SDEL,C ;PUT FLAG IN C, SACE C - PUSH PP,CS - TLNE IO,IOCREF ;HAVE WE PUT OUT THE 177,102 - JRST CREF3 ;YES - PUSH PP,C ;START OF CREF DATA - - REPEAT 0,< ;NEEDS CHANGE TO CREF - MOVEI C,177 - PUSHJ PP,OUTLST - MOVEI C,102 - PUSHJ PP,OUTLST - TLO IO,IOCREF ;WE NOW ARE IN THAT STATE - POP PP,C ;WE HAVE NOW -CREF3: JUMPE C,NOFLG ;JUST CLOSE IT - PUSHJ PP,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 - PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS - MOVE CS,AC0 - -CREF2: MOVEI C,0 - LSHC C,6 - ADDI C,40 - PUSHJ PP,OUTLST ;THE ASCII SYMBOL - JUMPN CS,CREF2 - MOVEI C,%DSYM - TLZE IO,DEFCRS - PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE -NOFLG: MOVE C,SDEL - POP PP,CS - POPJ PP, - -CLSCRF: TRNN ER,LPTSW - POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING -CLSCR2: MOVEI C,177 - PUSHJ PP,PRINT - TLZE IO,IOCREF ;WAS IT OPEN? - JRST CLSCR1 ;YES, JUST CLOSE IT - MOVEI C,102 ;NO, OPEN IT FIRST - PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA - MOVEI C,177 - PUSHJ PP,OUTLST -CLSCR1: MOVEI C,103 - JRST OUTLST ;MARK END OF CREF DATA - -CLSC3: TLZ IO,IOCREF - MOVEI C,177 - PUSHJ PP,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 - PUSHJ PP,CRFHDR ;GET CORRECT SUBTTL - MOVEI C,177 - PUSHJ PP,OUTLST - MOVEI C,102 - PUSHJ PP,OUTLST - TLO IO,IOCREF ;WE NOW ARE IN THAT STATE - POP PP,C ;WE HAVE NOW -CREF3: PUSHJ PP,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 - PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS - MOVE CS,AC0 - -CREF2: MOVEI C,0 - LSHC C,6 - ADDI C,40 - PUSHJ PP,OUTLST ;THE ASCII SYMBOL - JUMPN CS,CREF2 - MOVEI C,%DSYM - TLZE IO,DEFCRS - PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE - MOVE C,SDEL - POP PP,CS - POPJ PP, - -IFN OPHSH,< -SUBTL: SIXBIT /SUBTTL/> -CRFHDR: CAME AC0,SUBTL ;IS FIRST SYMBOL "SUBTTL" - JRST CRFHD1 ;NO - HLLZ AC0,V - PUSHJ PP,SUBTT0 ;UPDATE SUBTTL - MOVE AC0,SUBTL ;RESTORE ARG. - MOVEI V,CPOPJ -CRFHD1: MOVEI C,0 - JRST OUTL - -CLSC3: -CLSCRF: TRNN ER,LPTSW - POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING -CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE - JRST CLSCR1 - MOVEI C,0 - TLNE IO,IOPAGE ;NEW PAGE? - PUSHJ PP,OUTL ;YES,GIVE IT A ROUSING SENDOFF! - MOVEI C,177 - PUSHJ PP,OUTLST - MOVEI C,102 - PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA -CLSCR1: MOVEI C,177 - PUSHJ PP,OUTLST - MOVEI C,103 - JRST OUTLST ;MARK END OF CREF DATA -> ;END OF REPEAT 1 - SEARCH: HLRZ SX,SRCHX - HRRZ SDEL,SRCHX - -SRCH1: CAML AC0,-1(SX) - JRST SRCH3 -SRCH2: SUB SX,SDEL - LSH SDEL,-1 - CAMG SX,SYMTOP - JUMPN SDEL,SRCH1 - JUMPN SDEL,SRCH2 - SOJA SX,SRCHNO ;NOT FOUND - -SRCH3: CAMN AC0,-1(SX) - JRST SRCH4 ;NORMAL / FOUND EXIT - ADD SX,SDEL - LSH SDEL,-1 - CAMG SX,SYMTOP - JUMPN SDEL,SRCH1 - JUMPN SDEL,SRCH2 - SOJA SX,SRCHNO ;NOT FOUND - -SRCH4: AOS 0(PP) ;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 - 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 - TLNE RC,-2 ;CHECK AND SET EXTPNT - HLLM RC,EXTPNT - TRNE RC,-2 - HRRM RC,EXTPNT - JRST SRCHOK -SRCHNO: SKIPN UNISCH+1 ;ALLOWED TO SEARCH OTHER TABLES - POPJ PP, ;NO, JUST RETURN - AOS V,UNISCH ;GET NEXT INDEX TO TABLE - CAIE V,1 ;FIRST TIME IN - JRST SRCHN1 ;YES, SAVE SYMBOL INFO - HRLM SX,UNISCH ;SAVE SX AND SET FLAG - MOVE ARG,SRCHX ;SEARCH POINTER - MOVEM ARG,UNISHX ;TO A SAFE PLACE - HRR ARG,SYMBOL - HRL ARG,SYMTOP - MOVEM ARG,UNIPTR ;STORE ALSO -SRCHN1: 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) ;SYMTOP,,SYMBOL - HRRZM ARG,SYMBOL - HLRZM ARG,SYMTOP - JRST SEARCH ;TRY AGAIN - -SRCHKO: SETZ ARG, ;CLEAR ARG SO ZERO STORED -SRCHOK: SKIPN UNISCH ;HAVE WE SEARCH OTHER TABLES - POPJ PP, ;NO, JUST RETURN -SYMBCK: HLRZ SX,UNISCH ;RESTORE SX - SETZM UNISCH ;CLEAR SYMBCK FLAG - PUSH PP,V ;SAVE AN AC - MOVE V,UNISHX ;SRCHX - MOVEM V,SRCHX ;RESTORE ORIGINAL - MOVE V,UNIPTR ;SYMTOP,,SYMBOL - HRRZM V,SYMBOL - HLRZM V,SYMTOP - JUMPE ARG,SRCHK2 ;TOTALLY UNDEFINED - PUSH PP,RC ;SAVE SOME ACCS - PUSH PP,ARG - PUSH PP,EXTPNT - SETZB ARG,EXTPNT ;CLEAR ALL SYMBOL DATA - SETZB RC,V - PUSHJ PP,INSERT ;INSERT SYMBOL IN TABLE - POP PP,EXTPNT ;RESTORE ACCS ETC. - POP PP,ARG - POP PP,RC - MOVEM ARG,(SX) ;SET FLAGS AND VALUE AS IT SHOULD BE -SRCHK2: POP PP,V - POPJ PP, ;RETURN - - INSERQ: TLNE ARG,UNDF!VARF -INSERZ: SETZB RC,V -INSERT: CAME AC0,-1(SX) ;ARE WE LOOKING AT MATCHING MNEMONIC? - JRST INSRT2 ;NO, JUST INSERT - JUMPL ARG,INSRT1 ;YES, BRANCH IF OPERAND - SKIPL 0(SX) ;OPERATOR, ARE WE LOOKING AT ONE? - JRST UPDATE ;YES, UPDATE - JRST INSRT2 ;NO, INSERT - -INSRT1: SKIPG 0(SX) ;OPERAND, ARE WE LOOKING AT ONE? - JRST UPDATE ;YES, UPDATE - SUBI SX,2 ;NO, MOVE UNDER OPERATOR AND INSERT -INSRT2: MOVE SDEL,SYMBOL - SUBI SDEL,2 - CAMLE SDEL,FREE - JRST INSRT3 - PUSHJ PP,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 - AOS @SYMBOL ;INCREMENT THE SYMBOL COUNT - TLNN RC,-2 ;NEED SPECIAL? - TRNE RC,-2 ;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? - PUSHJ PP,XCEEDS ;YES - HRRI ARG,-1(SDEL) ;POINTER TO ARG - MOVEM V,0(ARG) ;36BIT VALUE TO FREE CORE - TLOA ARG,PNTF ;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE - -INSRT4: HRR ARG,V ;18BIT VALUE TO ARG - 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. - PUSHJ PP,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? - PUSHJ PP,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: 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 - FAD AC2,@SYMBOL - LSH AC2,-^D27 - MOVEI AC1,1000 - LSH AC1,-357(AC2) - HRRM AC1,SRCHX - LSH AC1,1 - ADD AC1,SYMBOL - HRLM AC1,SRCHX - POPJ PP, ;SRCHX=XWD ,LENGTH/4 - - UPDATE: DPB RC,RCPNTR ;FIX RIGHT RELOCATION - TLNE ARG,SPTR ;SKIP IF THERE IS NO SPECIAL POINTER - JRST UPDAT4 ;YES, USE THE TWO CELLS - TLNN RC,-2 ;NEED TO CHANGE - TRNE RC,-2 ;ANY CURRENT EXTERNS? - JRST UPDAT5 ;YES ,JUMP - 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 - POPJ PP, ;AND EXIT - -UPDAT1: AOS SDEL,FREE ;GET ONE CELL - CAML SDEL,SYMBOL ;NEED MORE CORE? - PUSHJ PP,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 - POPJ PP, ;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 - POPJ PP, ;AND EXIT - -UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL - ADDB SDEL,FREE ;SO WE NEED TWO LOACTIONS - CAML SDEL,SYMBOL ;NEED MORE CORE? - PUSHJ PP,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 - JRST UPDAT3 ;SAVE THE POINTER AND EXIT - - SUBTTL CONSTANTS - - -IFN FORMSW,< -HWFORM: BYTE (18) 1,1 -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 -BPFORM: BYTE (6) 1,1 (2) 1 (4) 1 (18) 1 -ASCIIF: BYTE (7) 1,1,1,1,1 -SXFORM: BYTE (6) 1,1,1,1,1,1 -> - - SUBTTL PHASED CODE - -IFN PURESW, -IFN SEG2SW,< PHASE LOWL> -> -IFN TEMP, -LSTFIL: BLOCK 1 - SIXBIT /@/ ;SYMBOL TO STOP PRINTING -TAG: BLOCK 1 - SIXBIT / + @/ -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,< -IFE RUNSW,< -NUNINI: EXP DMP -NUNDEV: BLOCK 1 - XWD 0,0> -RPGINI: EXP AL -RPGDEV: BLOCK 1 - XWD 0,CTLBLK -> -INDEVI: EXP A -INDEV: BLOCK 1 - XWD 0,IBUF -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,< -IFE SEG2SW,< LOC 140> -IFN SEG2SW,< RELOC LOWL> -LOWL: BLOCK LENLOW+3 > -PASS1I: - -RP: BLOCK 1 - -IFE CCLSW, -IFN CCLSW,/5 -IFN RUNSW,> -LSTBUF: BLOCK 3 -BINBUF: BLOCK 3 -IBUF: BLOCK 3 -IFN CCLSW,> -LSTDIR: BLOCK 4 -BINDIR: BLOCK 4 -INDIR: BLOCK 4 - -ACDELX: ;LEFT HALF -BLKTYP: BLOCK 1 ;RIGHT HALF - -COUTX: BLOCK 1 -COUTY: BLOCK 1 -COUTP: BLOCK 1 -COUTRB: BLOCK 1 -COUTDB: BLOCK ^D18 - -ERRCNT: BLOCK 1 -FREE: BLOCK 1 -IFN RENTSW, -IFBLK: BLOCK .IFBLK -IFBLKA: BLOCK .IFBLK -LADR: BLOCK 1 -NCOLLS: BLOCK 1 -LIMBO: BLOCK 1 -LBUFP: BLOCK 1 -LBUF: BLOCK <.CPL+5>/5 - BLOCK 1 -VARHD: BLOCK 1 -VARHDX: BLOCK 1 -IFN WFWSW, - -LITAB: BLOCK 1 -LITABX: BLOCK 1 - BLOCK 1 -LITHD: BLOCK 1 -LITHDX: BLOCK 1 -LITCNT: BLOCK 1 -LITNUM: BLOCK 1 - -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 - -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 -DEVBUF: BLOCK 6 ;STORE NAME.EXT CREATION DATE AND TIME -TYPERR: BLOCK 1 -IONSYM: BLOCK 1 ;-1 SUPRESS LISTING OF SYMBOLS -PRGPTR: BLOCK 1 ;POINTER TO CHAIN OF PRGEND BLOCKS -ENTERS: BLOCK 1 ;-1 WHEN ENTERS HAVE BEEN DONE -UNIVSN: BLOCK 1 ;-1 WHEN A UNIVERSAL SEEN - - PASS2I: - -ABSHI: BLOCK 1 -HIGH: BLOCK 1 -IFN RENTSW, -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 -CALPG: BLOCK 1 -CALSEQ: BLOCK 1 -DEFPG: BLOCK 1 -DEFSEQ: BLOCK 1 -LITPG: BLOCK 1 -LITSEQ: BLOCK 1 -REPPG: BLOCK 1 -REPSEQ: BLOCK 1 -TXTPG: BLOCK 1 -TXTSEQ: BLOCK 1 -CNDPG: BLOCK 1 -CNDSEQ: BLOCK 1 -IRPCNT: BLOCK 1 -IRPARG: BLOCK 1 -IRPARP: BLOCK 1 -IRPCF: BLOCK 1 -IRPPOI: BLOCK 1 -IRPSW: BLOCK 1 -IFN WFWSW, -LITLVL: BLOCK 1 -LITLBL: BLOCK 1 ;NAME OF LABEL DEFINED INSIDE A LITERAL - -ASGBLK: BLOCK 1 -LOCBLK: BLOCK 1 - -LOCA: BLOCK 1 -LOCO: BLOCK 1 -RELLOC: BLOCK 1 -ABSLOC: BLOCK 1 -LPP: BLOCK 1 -MODA: BLOCK 1 -MODLOC: BLOCK 1 -MODO: BLOCK 1 -IFN CCLSW, -OUTSQ: BLOCK 2 -PAGEN.: BLOCK 1 -PPTEMP: BLOCK 1 -PPTMP1: BLOCK 1 -PPTMP2: BLOCK 1 - -REPCNT: BLOCK 1 -REPEXP: BLOCK 1 -REPPNT: BLOCK 1 -RPOLVL: BLOCK 1 -R1BCNT: BLOCK 1 -R1BCHK: BLOCK 1 -R1BBLK: BLOCK .R1B -R1BLOC: BLOCK 1 -RIMLOC: BLOCK 1 -TAGINC: BLOCK 1 -VECREL: BLOCK 1 -VECTOR: BLOCK 1 -.TEMP: BLOCK 1 ;TEMPORARY STORAGE -UNISCH: BLOCK .UNIV ;SEARCH TABLE FOR UNIVERSALS -SQFLG: BLOCK 1 -ARGF: BLOCK 1 -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 -PASS2Z: ;ONLY CLEAR TO HERE ON PRGEND -LSTSYM: BLOCK 1 -PAGENO: BLOCK 1 -SEQNO2: BLOCK 1 -PASS2X: - - SUBTTL MULTI-ASSEMBLY STORAGE CELLS - -LSTPGN: BLOCK 1 -IFN WFWSW, -HDAS: BLOCK 1 -IFN CCLSW, -IFN TEMP, -IFN FORMSW, -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 ;TABLE OF UNIVERSAL NAMES -UNIPTR: BLOCK .UNIV ;TABLE OF SYMBOL POINTERS -UNISHX: BLOCK .UNIV ;TABLE OF SRCHX POINTERS - VAR ;CLEAR VARIABLES - -JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONE -IFN PURESW, - - END BEG - - -- 1.7.1