From 2663da64e4ec84bcd937fc55b1e2bba442324609 Mon Sep 17 00:00:00 2001 From: Richard Cornwell Date: Fri, 1 Jan 2021 19:50:20 -0500 Subject: [PATCH] Added Macro version 37. --- src/mac37.mac | 5178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 files changed, 5178 insertions(+), 0 deletions(-) create mode 100644 src/mac37.mac diff --git a/src/mac37.mac b/src/mac37.mac new file mode 100644 index 0000000..98364c8 --- /dev/null +++ b/src/mac37.mac @@ -0,0 +1,5178 @@ +TITLE MACRO.V36 +SUBTTL RPG/CMF/JF/PMH/DMN 7-SEPT-71 +;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. + + + LOC + OCT 37 + RELOC + MLON + +REPEAT 0,< + ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO) + + SWITCHES ON (NON-ZERO) IN DEC VERSION +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 REENTERANT PROGRAMS + +> + SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS + +IFNDEF PURESW, + +IFNDEF RUNSW, + +IFNDEF RENTSW, + +IFNDEF CCLSW, +IFN CCLSW, + +IFNDEF TEMP, + +IFNDEF FTDISK, + + SUBTTL OTHER PARAMETERS + +.PDP== ^D40 ;BASIC PUSH-DOWN POINTER +IFNDEF LPTWID, ;DEFAULT WIDTH OF PRINTER +.LPTWD==8* ;USEFUL WIDTH IN MAIN LISTING +.CPL== .LPTWD-^D40 ;WIDTH AVAIABLE FOR TEXT WHEN + ;BINARY IS IN HALFWORD FORMAT +.LPP==^D55 ;LINES/PAGE +.STP== ^D40 ;STOW SIZE +.TBUF== ^D80 ;TITLE BUFFER +.SBUF== ^D80 ;SUB-TITLE BUFFER +.IFBLK==^D5 ;IFIDN COMPARISON BLOCK SIZE +.R1B==^D18 +.LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE + +NCOLS==LPTWID/^D40 ;NUMBER OF COLUMNS IN SYMBOL TABLE +IFN CCLSW,> +IFNDEF NUMBUF, + +EXTERN JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA +IFN CCLSW,< EXTERN JOBERR> + +IFN PURESW,< HISEG > + +;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 CORE [CALLI 11] +OPDEF EXIT [CALLI 12] +OPDEF UTPCLR [CALLI 13] +OPDEF DATE [CALLI 14] +OPDEF APRENB [CALLI 16] +OPDEF MSTIME [CALLI 23] +OPDEF PJOB [CALLI 30] +OPDEF RUN [CALLI 35] +OPDEF TMPCOR [CALLI 44] +OPDEF MTWAT. [MTAPE 0] +OPDEF MTREW. [MTAPE 1] +OPDEF MTEOT. [MTAPE 10] +OPDEF MTSKF. [MTAPE 16] +OPDEF MTBSF. [MTAPE 17] + + ;FR FLAG REGISTER (FR/RX) +IOSCR== 000001 ;NO CR AFTER LINE +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 + +;USEFUL MACROS + +DEFINE FORERR(AC,ABC)< + MOVE AC,SEQNO2 + MOVEM AC,ABC'SEQ + MOVE AC,PAGENO + MOVEM AC,ABC'PG +> + + +IFN CCLSW,< ;ASSEMBLE IF RUN UUO IMPLEMENTED +NUNSET: SKIPN ACDEV + MOVSI ACDEV,(SIXBIT /SYS/) ;USE SYS IF NONE SPECIFIED +IFN RUNSW,< + MOVEM ACDEV,RUNDEV + 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" + HALT ;SHOULD'T RETURN. HALT IF IT DOES +> +IFE RUNSW, + +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 + CAIN C,14 + SKIPE SEQNO + JRST ASSEM2 + PUSHJ PP,OUTFF + PUSHJ PP,OUTLI + JRST ASSEM1 + +ASSEM2: AOS TAGINC + CAIN C,15 + JRST ASSEM3 + 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 + JRST ASSEM1 +ASSEM3: PUSHJ PP,STOUT+1 + JRST ASSEM1 + + SUBTTL STATEMENT PROCESSOR + +STMNT: TLZ FR,INDSW + 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 + SKIPE C + TLO IO,IORPTC + SKIPN AC2,AC0 + POPJ PP, + 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 FLAG + 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 + TRZE V,LITF ;VALID IN LITERAL? + SKIPN LITLVL ;NO, ARE WE IN A LITERAL? + JRST 0(V) ;NO, GO TO APPRORIATE PROCESSOR + MOVE AC0,AC2 + +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 + PUSHJ PP,EVALHA ;EVALUATE EXPRESSION + JRST STOW ;YES,STOW THE CODE AND EXIT + + STMNT8: SETZB AC0,RC ;CLEAR VALUE AND RELOCATION + TRO ER,ERRO ;FLAG AS UNDEIFNED OP-CODE + JRST OPD + + ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT) + ;UNTIL A LINE TERMINATOR IS SEEN. +STOUTS: TLO IO,IOENDL +STOUT: TLO IO,IORPTC + PUSHJ PP,BYPAS1 + CAIN C,14 ;COMMA? + SKIPL STPX ;YES, ERROR IF CODE STORED + CAIN C,33 + TLOA IO,IORPTC + TRO ER,ERRQ +STOUT1: PUSHJ PP,CHARAC + CAIGE C,CR + CAIG C,HT + JRST STOUT1 + JRST OUTLIN + SUBTTL LABEL PROCESSOR + +LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC + JUMPE AC0,LABEL5 ;ERROR IF BLANK + MOVEM AC0,TAG + HLLZS AC0,TAGINC + TLO IO,DEFCRS ;THIS IS A DEFINITION + PUSHJ PP,SSRCH ;SEARCH FOR OPERAND + MOVSI ARG,SYMF!UNDF!TAGF ;NOT FOUND + TLNE ARG,EXTF ;UNDEFINED ON PASS1 + JRST LABEL3 ;NO, FLAG ERROR + TLZN ARG,UNDF!VARF + JRST LABEL2 ;YES, CHECK EQUALITY +LABEL1: MOVE V,LOCA ;WFW + MOVE RC,MODA + TLO ARG,TAGF + JRST INSERT ;INSERT/UPDATE AND EXIT + +LABEL2: HRLOM V,LOCBLK ;SAVE LIST LOCATION + TLNE ARG,40 + JRST LABEL6 +LABEL0: CAMN V,LOCA ;DOES IT COMPARE WITH PREVIOUS? WFW + CAME RC,MODA +LABEL3: TLOA ARG,MDFF ;NO, FLAG MULTIPLY DEFINED AND SKIP + POPJ PP, + 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,IOPAGE ;NO, FLAG PHASE ERROR + POPJ PP, + +LABEL6: JUMP1 LABEL1 + TRO ER,IOMSTR + TLZ ARG,40 + PUSHJ PP,UPDATE + JRST LABEL0 + SUBTTL ATOM PROCESOR +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 + SKIPN 0,5 + TLNN IO,NUMSW ;AND NUMERIC, + JRST NUMER2 + LSHC AC0,^D35(SX) + LSH RC,^D35(SX) + JRST ATOM1 + 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,BYPAS1 + 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 + 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 + +NUMER1: SETZB AC0,RC ;RETURN ZERO +NUMER2: TRO ER,ERRN ;FLAG ERROR + +GETDEL: PUSHJ PP,BYPAS1 +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 AC0,1 + TDCA AC0,[-1] +GETDE2: MOVNS AC0 ;YES, NEGATE VALUE + MOVNS RC ;AND RELOCATION +POPOUT: POPJ PP, ;EXIT + QUOTE0: ASH AC0,7 + IOR AC0,C +QUOTES: PUSHJ PP,CHARAC + CAIN C,CR + JRST QUOTE2 + CAIE C,42 + JRST QUOTE0 + PUSHJ PP,CHARAC ;LOOK AT NEXT CHAR. + CAIN C,42 + JRST QUOTE0 +QUOTE2: TLO IO,IORPTC + JRST GETDEL + 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,RX + PUSHJ PP,CELLSF + MOVE AC2,AC0 + MOVEI AC0,^D36 + JUMPE AC2,QUAL2A + LSH AC2,-1 + SOJA AC0,.-2 + SUBTTL NUMBER PROCESSOR + +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 + 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 + FORERR (C,LIT) +SQB5: JSP AC2,SVSTOW +SQB3: PUSHJ PP,STMNT + TLNE FR,MWLFLG ;CALL IT ] IF NOT MULTI-WORD FLAG + CAIN C,75 ;CHECK FOR ] + JRST SQB1 + TLO IO,IORPTC + PUSHJ PP,BYPAS1 + CAIN C,33 ;COMMENT? + TLOA IO,IORPTC + TRO ER,ERRQ +SQB4: PUSHJ PP,CHARAC + CAIGE C,CR ;LOOK FOR END OF LINE + CAIN C,HT + JRST SQB4 + PUSHJ PP,OUTIML ;DUMP + JRST SQB3 +SQB1: TLZ IO,IORPTC + PUSHJ PP,STOLIT + JSP AC2,GTSTOW + POP PP,EXTPNT + POP PP,FR + SKIPE LITLVL ;WERE WE NESTED? + JUMP1 NUMER2 ;YES, FORCE ERROR IF PASS 1 + 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 NUM31 ;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 + +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 + CAIE C,45 ;"E"? + TDZA AC0,AC0 + PUSHJ PP,CELL + 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,BYPAS1 ;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 +BYPAS1: PUSHJ PP,GETCHR +BYPAS2: JUMPE C,.-1 + POPJ PP, + 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 +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 ;YES, TREAT ACCORDINGLY + PUSHJ PP,SEARCH ;SEARCH FOR MACRO OR SYMBOL + JRST EVOP ;NOT FOUND, TRY FOR OP-CODE + SKIPL ARG ;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 + + SKIPE C ;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,OPD ;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: TRZE V,LITF ;CLEAR LIT INVALID FLAG + JRST EVOPX ;PSEUDO-OP THAT GENERATES NO DATA JUMPS + HLLZ AC0,V +EVOPD: SKIPE C ;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 EVERRU + TLNN ARG,EXTF + JRST EVTSTR + HRRZ RC,ARG ;GET ADRES WFW + HRRZ ARG,EXTPNT ;SAVE IT WDW + 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, NEGATIVE AC0 AND RC + +EVGETD: PUSHJ PP,BYPAS2 + TLNE CS,6 ;NON BLANK FIELD + TLO IO,IORPTC ;YES,SET FLAG +EVNUM: POP PP,SDEL ;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,AC2 ;POP PREVIOUS RELOCATABILITY + POP PP,AC1 ;AND PREVIOUS VALUE + LDB PS,[POINT 3,PS,29] ;TYPE OF OPERATION TO PS + JRST .(PS) ;PREFORM PROPER OPERATION + 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 + SKIPN RC ;COMMON RELOCATION TEST + SKIPE AC2 + 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 + SKIPE PR + TRO ER,ERRR + JRST EVNUM + +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 + 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: SETZB AC0,RC ;ERROR, NO CODE STORED + PUSHJ PP,STOW ;STOW ZERO + 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 + JRST STOWI + +STOL06: MOVEI SX,LITAB + MOVE ARG,STPX + 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 + MOVEM SX,LITABX ;SET POINTER TO CURRENT CELL + AOS LITNUM ;INCREMENT NUMBER STORED + AOS LITCNT ;INCREMENT NUMBER RESERVED + SKIPL STPX ;ANY MODE 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 + CAIG C,172 ;CHECK FOR LOWER CASE + CAIGE C,141 + SKIPA ;NOT LOWER CASE + SUBI C,40 ;CONVERT LOWER CASE TO SIXBIT + SUBI C,40 ;CONVERT TO SIX BIT + CAIN C,7 + JRST GETCHR + CAILE C,77 + JRST GETCS1 + JUMPGE C,GETCS + ADDI C,27 + JUMPE C,GETCS + TLOA IO,IORPTC ;REPEAT CHARACTER + +GETCS1: TDO IO,[XWD IORPTC,ERRQ] + MOVEI C,33 +GETCS: MOVE CS,CSTAT(C) ;GET STATUS BITS + POPJ PP, ;EXIT + +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: 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 CS,7 + ANDCAM CS,CPL ;MASK + POPJ PP, ;EXIT + +CHARAX: LDB C,LBUFP ;GET LAST CHARACTER + POPJ PP, ;EXIT +CHARL: PUSHJ PP,CHARAC ;GET AND TEST 7-BIT ASCII + CAIE C,LF ;LINE OR FORM FEED OR VT? + CAIN C,FF + SKIPA CS,LITLVL ;IN LITERAL? + POPJ PP, ;EXIT + JUMPN CS,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,00,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 + IDPB AC0,LBUFP + JUMP1 OUTL30 ;BRANCH IF PASS ONE + JUMPN AC0,OUTL02 ;JUMP IF ANY ERRORS TO FORCE PRINTING + SKIPL STPX ;SKIP IF NO CODE, OTHERWISE + TLZ IO,IOMAC ;FORCE MACRO PRINTING + TLNN IO,IOMSTR!IOPROG!IOMAC +OUTL02: IOR IO,OUTSW ;FORCE IT. + 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 FALL THROUGH + PUSHJ PP,OUTL + 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 + 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) ; + OUTL22: PUSHJ PP,ONC ;PRINT IT +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 +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 + PUSHJ PP,OUTCR ;OUTPUT CARRIAGE RETURN + JRST OUTL26 ;TEST FOR MORE BINARY + + OUTL30: AOS CS,STPX ;PASS ONE + ADDM CS,LOCO ;INCREMENT OUTPUT LOCATION + PUSHJ PP,STOWI ;INITIALIZE STOW + TLZ AC0,ERRORS-ERRM-ERRP-ERRV-400000 + JUMPE AC0,OUTLI3 ;JUMP IF ERRORS + 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 + JRST OUTL25 ;OUTPUT BASIC LINE + +OUTLER: ASH AC0,-4 + MOVE CS,[POINT 6,[SIXBIT /PRINTQXADLRUVNOPEM/]] +OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC + JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED + ADDI C,40 + PUSHJ PP,OUTL + AOS ERRCNT ;INCREMENT ERROR COUNT +OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT + JUMPN AC0,OUTLE2 ;TEST FOR END + POPJ PP, ;EXIT +OUTPL: IBP LBUFP +OUTIM1: JUMP1 OUTLI3 + PUSH PP,IO + TDZ IO,TYPERR + TLNN IO,250000 + IOR IO,OUTSW + PUSH PP,C + TLNN FR,2000 + PUSHJ PP,CLSCRF +OUTIM2: MOVE CS,TABP + PUSHJ PP,OUTASC ;OUTPUT TABS + DPB C,LBUFP + MOVEI CS,LBUF + PUSHJ PP,SOUT20 + POP PP,C + HLLM IO,0(PP) + POP PP,IO + JRST OUTLI2 +OUTLI: TLNE IO,IOPALL ;SUPRESSING ALL + SKIPN MACLVL + TLZA IO,IOMAC ;NO, CLEAR MAC FLAG + TLO IO,IOMAC ;YES, SET FLAG +OUTLI3: TRZ IO,ERRORS!LPTSW!TTYSW +OUTLI2: MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS + MOVEM CS,LBUFP + MOVEI CS,130 + MOVEM CS,CPL + MOVE CS,[POINT 7,TABI,6] + MOVEM CS,TABP + 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 TERRMINATOR + SETZM ASGBLK + SETZM LOCBLK + POPJ PP, + OUTIML: 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 ACO 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 +OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV-400000 + JUMPE CS,OUTLI2 + TRZ ER,ERRM!ERRP!ERRV!400000 + 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 + POPJ PP, + JUMP1 VARA1 + PUSHJ PP,OUTCR + PUSHJ PP,OUTSYM + MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS @/] + PUSHJ PP,OUTSIX + HRLO CS,V + TDZ CS,RC +UOUT1: PUSHJ PP,ONC1 + JRST HIGHQ + ;OUTPUT THE ENTRIES + +EOUT: MOVEI C,0 ;INITIALIZE THE COUNT + MOVE SX,SYMBOL + MOVE SDEL,0(SX) +EOUT1: SOJL SDEL,EOUT2 + 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: 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 + MOVEM ARG,SYMCNT ;STORE ANSWER + PUSHJ PP,LOUT1 ;OUTPUT THEM + MOVE ARG,SYMCNT + CAIE ARG,NCOLS + JRST OUTCR ;NO, NEED CR + POPJ PP, + +LOUT1: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN + TRNN ARG,SYMF + TRNN ARG,MACF!SYNF + TRNE ARG,40 ;SKIP AND CLEAR MRP + POPJ PP, ;NO, TRY AGAIN + MOVEI MRP,0 + 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 + TLNE IO,2000 + JUMPE MRP,POPOUT + JUMPGE MRP,LOUT10 + HLRZ RC,V ;PUT POINTER/FLAGS IN RC + TRNE RC,-2 ;POINTER? + MOVS RC,0(RC) ;YES + HLL V,RC ;STORE LEFT HALF + +LOUT10: PUSH PP,RC ;SAVE FOR LATER + PUSHJ PP,OUTSYM ;OUTPUT THE NAME + MOVE RC,0(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 AC0,RC + TRNE RC,-2 + HLLZS AC0,RC + TLZE RC,-1 + TRO RC,2 + HRL MRP,RC + MOVEI RC,0 + TRNE ARG,NOOUTF ;ENTRY DMN + 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 + 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 + PUSHJ PP,OUTTAB + HRLO CS,V + TDZ CS,RC ;SET RELOCATION + PUSHJ PP,ONC1 + PUSHJ PP,OUTTAB + POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL + TRNN RC,-2 ;IS IT? + JRST SOUT50 ;NO + MOVE AC0,1(RC) ;GET NAME + MOVEI ARG,60 ;EXTERNAL REQ + PUSHJ PP,SQOZE + HLLZS AC0,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 SOUT30 + MOVE AC0,1(RC) + MOVEI ARG,60 + PUSHJ PP,SQOZE + MOVEI RC,0 + PUSHJ PP,COUT + MOVE AC0,SVSYM + TLO AC0,700000 + PUSHJ PP,COUT + +SOUT30: MOVEI CS,SOUTC(MRP) + PUSHJ PP,OUTAS0 + SOSLE SYMCNT + JRST OUTAB2 + MOVEI CS,3 + MOVEM CS,SYMCNT + JRST OUTCR + +SOUT20: PUSHJ PP,OUTAS0 + JRST OUTCR + + !60 ;DMN +SOUTC: EXP 10 + !04 + !60 + !50 + !04 ;DMN + ;OUTPUT THE BINARY + +BOUT: HRLO CS,LOCO ;PICKUP THE LOCATION + PUSHJ PP,ONC ;OUTPUT IT TO THE LISTING FILE + PUSHJ PP,DSTOW ;GET THE CODE + PUSH PP,RC ;SAVE RELOCATION + TLNE RC,-2 ;CHECK LEFT EXTERNAL + HRRZS RC ;MAKE LEFT NON-RELOC + TRNN RC,-2 ;RIGHT EXT? + JRST BOUT30 ;NO + HRRZ AC1,AC0 ;YES + JUMPE AC1,BOUT20 ;PROCESS IF ZERO CODE THERE + HLLZS AC0,RC ;MAKE NON-RELOC + JRST BOUT30 ;PROCESS + TRNN RC,-2 + JRST BOUT30 + +BOUT20: HRRM AC1,0(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 + PUSHJ PP,ONC + HRLO CS,AC0 + TDZ CS,RC ;SET RELOCATION + PUSHJ PP,ONC + HRRZ CS,LOCO ;CS = RIGHT RELOCATION + 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 ;EXIT CODE + POP PP,RC ;RETREIVE 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(11) ;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 AC0,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, + 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 + SKIPA + SUBI C,40 ;CONVERT TO LOWER CASE + 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 +NOUT3: + +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 + +IFN RENTSW,< +HOUT: + MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS + MOVEI RC,1 ;RELOCATABL + PUSHJ PP,COUT ;OUTPUT IT + SETZB AC0,RC + JRST COUT ;OUTPUT THE HIGHEST LOCATION> + +VOUT: SKIPN RC,VECREL ;IS VECTOR ABSOLUTE ZERO? + SKIPE VECTOR ;ALSO CHECK RELOCATION + SKIPA + POPJ PP, ;YES, EXIT + MOVE AC0,VECTOR ;ACO 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 + STOWZ: MOVEI RC,0 ;USE STANDARD FORM +STOW: 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 ;INCREMEMT POINTER + MOVEM AC0,STCODE(AC1) ;STOW CODE + MOVEM RC,STOWRC(AC1) ;STOW RELOCATION BITS + 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 ERRRO 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 + 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 + CAIN AC1,0(RC) ;DOES IT MATCH + JRST STOWT0 ;EXTERNAL OR RELOCATION ERROR + HRRI RC,0 + TRO ER,ERRE +STOWT0: HLLZS EXTPNT + POPJ PP, ;EXIT + + ;EXTERNAL LEFT +STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF + CAIN AC1,0(RC) ;SEE ABOVE + JRST STOWT2 + HRRI RC,0 + TRO ER,ERRE +STOWT2: 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,"'" + TLNN CS,1 ;RELOCATABLE? + PUSHJ PP,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE + POPJ PP, ;EXIT + +DNC: IDIVI C,^D10 + HRLM CS,0(PP) + SKIPE C + 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 ;OUTPUTASCII 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: AOS LITLVL + PUSHJ PP,STMNT + SOS LITLVL + SKIPL STPX + PUSHJ PP,DSTOW + TLZN RC,-2 + TRZE RC,-2 + TRO ER,ERRE + MOVEM AC0,VECTOR + MOVEM RC,VECREL + PUSHJ PP,VARA + PUSHJ PP,LIT1 + JUMP2 ENDP2 + PUSHJ PP,UOUT + PUSHJ PP,REC2 + PUSHJ PP,INZ + +PASS20: SETZM CTLSAV + PUSHJ PP,COUTI + PUSHJ PP,EOUT ;OUTPUT THE ENTRIES + PUSHJ PP,OUTSET + XWD 6,NOUT ;OUTPUT THE HISEG BLOCK +PASS21: MOVEI 1 + HRRM BLKTYP ;SET FOR TYPE 1 BLOCK + TLZ FR,P1!MWLFLG ;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 +IFN RENTSW,< + MOVE AC0,HHIGH + CAMN AC0,LOCO + HRRZM AC2,HHIGH +> + TLNN FR,CREFSW + TLNN IO,IOCREF ;CLOSE CREF IF NECESSARY + SKIPA + PUSHJ PP,CLSCR2 ;CLOSE IT UP + HRR ER,OUTSW ;SET OUTPUT SWITCH + SKIPN TYPERR + TRO ER,TTYSW + PUSHJ PP,UOUT ;OUTPUT UNDEFINEDS + TRO ER,TTYSW + SKIPG C,ERRCNT ;GET ERROR COUNT AND CHECK FOR POSITIVE + JRST NOERW +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 ERRMS3] ;LOAD TO PRINT +ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DECTECTED +ONERW1: PUSHJ PP,OUTSIX ;PRINT + JRST ENDP2D +NOERW: MOVEI CS,ERRMS1 + TLNE IO,CRPGSW ;IF RPG, DON'T PRINT MESSAGE + TRZ IO,TTYSW ;NO TTY OUTPUT + IOR IO,OUTSW ;UNLESS NEEDED FOR LISTING + PUSHJ PP,OUTCR + JRST ONERW1 +ENDP2D: PUSHJ PP,OUTCR +IFN CCLSW, +IFE CCLSW,< SKIPA ;SO PRGEND CODE CAN WORK> + IOR IO,OUTSW ;... + PUSHJ PP,OUTCR + MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/] + PUSHJ PP,OUTSIX +IFN RENTSW,< + HRLO CS,HHIGH ;GET PROGRAM BREAK + PUSHJ PP,UOUT1> + PUSHJ PP,OUTCR + TLNE FR,RIMSW!R1BSW ;RIM MODE? + PUSHJ PP,RIMFIN ;YES, FINISH IT + HRR IO,OUTSW + PUSHJ PP,OUTSET + XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2) + PUSHJ PP,OUTSET + XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7) +IFN RENTSW,< + PUSHJ PP,OUTSET + XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5)> + PUSHJ PP,COUTD + JRST FINIS +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 + PUSHJ PP,OUTFF + SETZM SEQNO + SETZM TAG + HRRI RX,^D8 + MOVEI VARHD + MOVEM VARHDX + MOVEI LITHD + MOVEM LITHDX + PUSHJ PP,LITI + PUSHJ PP,STOWI + JRST OUTLI +RCPNTR: POINT 1,ARG,^L-18 ;POINT 1,ARG,22 + SUBTTL PSEUDO-OP HANDLERS + +TAPE0: PUSHJ PP,STOUTS + JRST GOTEND + +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, + +IOSET: JUMP1 POPOUT ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG) + HLRZ SX,AC0 ;STORE FLAGS + PUSHJ PP,STOUTS ;POLISH OFF LINE + TLOA IO,0(SX) ;NOW SUPPRESS PRINTING +IORSET: TDZ IO,AC0 ;RESET FLAG IOPALL/IOPROG + POPJ PP, + +BLOCK0: PUSHJ PP,HIGHQ + PUSHJ PP,EVALEX ;EVALUATE + TRZE RC,-1 ;EXTERNAL OR RELOCATABLE? + PUSHJ PP,QEXT ;UPDATE ASSEMBLY LOCATION + ADDM AC0,LOCO ;SAVE START OF BLOCK +BLOCK1: EXCH AC0,LOCA ;UPDATE OUTPUT LOCATION + ADDM AC0,LOCA +BLOCK2: HRLOM AC0,LOCBLK + JUMP2 POPOUT + TRNE ER,ERRU + TRO ER,ERRV + POPJ PP, + +PRINT0: MOVNI AC0,5 + ADDM AC0,ERRCNT + TRO ER,400000 + POPJ PP, + +REMAR0: PUSHJ PP,GETCHR + CAIE C,EOL + JRST REMAR0 + POPJ PP, + LIT0: PUSHJ PP,BLOCK1 +LIT1: JUMP2 LIT20 + +;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR + + PUSHJ PP,STOUTS + 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: PUSHJ PP,STOUTS + MOVE SX,LITAB +LIT21: SOSGE LITNUM + JRST LIT22 + MOVE AC0,-2(SX) ;WFW + MOVE RC,-1(SX) ;WFW + MOVE SX,0(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 + MOVEI SX,3 ;WFW + ADDB SX,FREE + CAML SX,SYMBOL + PUSHJ PP,XCEED + SETZM 0(SX) ;CLEAR FORWARE 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 + TRZN ARG,VARF + POPJ PP, ;NO, EXIT + TRZ ARG,UNDF ;TURN OFF FLAG NOW + MOVSI V,1 ;NUMBER TO ADD TO + ADDM V,0(AC1) ;UPDATE COUNT +VARA1: IOR ARG,MODA ;SET TO ASSEMBLY MODE + HRL ARG,LOCA + + MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY + AOS LOCA + AOS LOCO + JRST HIGHQ1 + IF: PUSH PP,AC0 ;SAVE AC0 + PUSH PP,IO + PUSHJ PP,EVALXQ ;EVALUATE AND TEST EXTERNAL + POP PP,AC1 + SKIPL AC1 + 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 + JRST STOW ;STOW CODE AND EXIT + +IFPASS: TLZ 14,4 + 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 +IFB2: PUSHJ PP,CHARAC ;GET FIRST NON-BLANK + CAIN C,74 + AOJA RC,IFB2 + CAIN C,76 + SOJLE RC,IFXCT + CAIE C," " ;BLANK + TRO AC0,0(RC) + JRST IFB2 + 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 + + IFIDN0: HLRZS AC0 + MOVEI V,2*.IFBLK-1 + SETZM IFBLK(V) ;CLEAR COMPARISON BLOCK + SOJGE V,.-1 + 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 + SKIPL V ;DID WE FINISH STRING + XORI AC0,1 ;NO, TOGGLE REQUEST + JRST IFEXIT ;DO NOT TURN ON IORPTC WFW + +IFCL: HRLI RC,(POINT 7,,) +IFCL1: PUSHJ PP,CHARAC ;GET AND LIST CHARACTERS + CAIE C,74 ;SKIP SPACES + JRST IFCL1 + MOVEI SX,30 +IFCL2: PUSHJ PP,CHARAC + CAIN C,76 + POPJ PP, + IDPB C,RC + SOJLE SX,POPOUT + JRST IFCL2 + +IFEX2: PUSHJ PP,GETCHR + CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE + JRST ERRAX + CAIN C,34 ;"<"? + AOJA IFEX2 ;YES, INCREMENT COUNT + CAIE C,36 ;">"? + JRST IFEX2 ;NO, TRY AGAIN + SOJGE IFEX2 ;YES, TEST FOR MATCH + PUSHJ PP,BYPAS1 ;YES, MOVE TO NEXT DELIMITER + AOJA AC0,STOWZ ;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 ;ALLOW FORWARD REFERENCE + TRO ER,ERRA + 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 + POPJ PP, ;NO, EXIT + EXTER0: PUSHJ PP,GETSYM ;GET A SYMBOL + JRST EXTER3 ;INVALID, ERROR + PUSHJ PP,SSRCH ;OK, SEARCH SYMBOL TABLE + JRST EXTER2 ;NOT THER, INSERT IT + TLNN ARG,EXTF!VARF!UNDF + TROA ER,ERRE ;FLAG ERROR AND BYPASS + TLNE ARG,EXTF ;VALID, ALREADY DEFINED + JRST EXTER3 +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,1 ;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) + MOVE ARG,-1(SX) ;GET THE SIXBIT FOR THE NAME + MOVEM ARG,1(V) ;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS +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 ;EVALUTE EXPRESSION + TLZN RC,-2 ;WAS AN EXTERNAL FOUND? + TRZE RC,-2 + 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 + 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 + JRST ERRAX ;YES "A" ERROR + PUSHJ PP,INSERT ;NO, INSERT/UPDATE + TLZ IO,DEFCRS ;JUST IN CASE + PUSHJ PP,BYPAS1 + 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 + HRROM RC,ASGBLK + MOVEM V,LOCBLK + POPJ PP, + +ASSIG1: PUSH PP,AC0 + MOVEI AC0,0 + PUSHJ PP,GETCHR + CAIN C,35 ;EQUALS? + TLOA AC0,NOOUTF ;YES, NOT OUT TO DDT WFW + TLO IO,IORPTC + MOVEM AC0,HDAS ;STORE THESE BITS WFW + SETZM EXTPNT + PUSHJ PP,EVALEX ;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 + JRST ASSIG4 +ASSIG2: HLRZ RC,0(PP) + TRNN RC,-2 + JRST ASSIG3 + HLRZ ARG,EXTPNT + CAME RC,ARG + JRST ASSIG4 +ASSIG3: TLO IO,DEFCRS + PUSHJ PP,SSRCH + MOVSI ARG,400000 + IOR ARG,HDAS + TLZA ARG,UNDF!VARF!40 ;CANCEL UNDEFINED AND VARIABLE FLAGS +ASSIG4: TRO ER,ERRE + SETZM EXTPNT ;FOR REST OF WORLD + TRNE ER,ERRORS-ERRQ + TLO ARG,UNDF ;YES,SO TURN UNDF ON + POP PP,RC + POP PP,V + TLNE ARG,TAGF!EXTF + JRST ERRAX + JRST INSERT + LOC0: PUSHJ PP,HIGHQ ;AC0=0,0 + HRR AC0,LOCO + EXCH AC0,RELLOC + PUSHJ PP,BYPAS1 + TLO IO,IORPTC + CAIE C,EOL + PUSHJ PP,EVALXQ + HLL AC0,RELLOC + HRRZM AC0,LOCA ;SET ASSEMBLY LOCATION + HRRZM AC0,LOCO ;AND OUTPUT LOCATION + HLRZM AC0,MODA ;SET MODE + HLRZM AC0,MODO + JRST BLOCK2 + +IFN RENTSW,< +HISEG0: PUSHJ PP,HIGHQ ;SET CURRENT PROGRAM BREAK + PUSHJ PP,COUTD ;DUMP CURRENT TYPE OF BLOCK + PUSH PP,BLKTYP + MOVEI AC0,3 + MOVEM AC0,BLKTYP + PUSHJ PP,BYPAS1 ;GO GET EXPRESSION + TLO IO,IORPTC + PUSHJ PP,EVALXQ ;CHECK FOR EXTERNAL + HRRZM AC0,LOCA ;SET LOC COUNTERS + HRRZM AC0,LOCO + MOVEI RC,1 ;ASSUME RELOCATABLE + PUSHJ PP,COUT + MOVEM RC,MODA ;SET MODES + MOVEM RC,MODO + PUSHJ PP,COUTD + POP PP,BLKTYP + JRST BLOCK2 + HIGHQ: JUMP1 POPOUT +HIGHQ1: SKIPN MODO + POPJ PP, + MOVE V,LOCO ;GET ASSEMBLY LOCATION + CAMLE V,HHIGH ;IS IT GREATER THAN "HIGH"? + MOVEM V,HHIGH ;YES, REPLACE WITH LARGER VALUE + POPJ PP,> +IFE RENTSW,< +HIGHQ: JUMP1 POPOUT +HIGHQ1: MOVE V,LOCO + POPJ PP, +> +ONML: TLOA FR,MWLFLG ;MULTI-WORD LITERALS OK +OFFML: TLZ FR,MWLFLG + 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 +SUPRS1: SETZM EXTPNT + POPJ PP, + +SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL + MOVSI ARG,SUPRBT + IORM ARG,(SX) + SETZM EXTPNT ;JUST IN CASE + POPJ PP, + + TITLE0: JUMP2 REMAR0 + MOVEI SX,.TBUF-1 + HRRI AC0,TBUF + PUSHJ PP,SUBTT1 ;GO READ IT + TLOE IO,IOTLSN ;HAVE WE SEEN ONE +IFE CCLSW, +IFN CCLSW, + POPJ PP, ;EXIT OTHERWISE + +SUBTT0: JUMP1 REMAR0 ;OTHERWISE EXIT IF PASS ONE + MOVEI SX,.SBUF-1 + HRRI SBUF +SUBTT1: PUSHJ PP,BYPAS1 ;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 + SOJGE SX,SUBTT3 ;TEST FOR BUFFER FULL + DPB RC,AC0 ;END, STORE TERMINATOR + POPJ PP, +IFN CCLSW,< +PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG + POPJ PP, + 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 + MOVEI C,OTBUF + DDTOUT C, + MOVEI C,[ASCIZ / +/] + DDTOUT C, + 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,SAVERC + 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, EXIT WITH ERROR + TLO ARG,SYNF ;FLAG AS SYNONYM + TLNE ARG,EXTF ;EXTERNAL? + HRRZ V,ARG ;YES, RELPACE WITH POINTER + MOVEI SX,SSRCH ;SET FLAG + JRST SYN2 + +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 PURGE5 + PUSHJ PP,MSRCH ;SEARCH MACRO SYMBOL TABLE + JRST PURGE2 ;NOT FOUND, TRY SYMBOLS + TLNE ARG,MACF ;MACRO? + PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE + JRST PURGE4 ;REMOVE SYMBOL FROM TABLE + +PURGE2: PUSHJ PP,SSRCH ;TRY OPERAND SYMBOL TABLE + JRST PURGE3 ;NOT FOUND GET NEXT SYMBOL + TRNN RC,-2 ;CHECK COMPLEX EXTERNAL + TLNE RC,-2 + TLNE ARG,SYNF + SKIPA + 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: MOVE AC0,V ;PUT VALUE IN AC0 +OP: +OPD: SKIPA 2,[POINT 4,0(PP),12] +IOP: MOVSI AC2,(POINT 9,0(PP),11) + PUSH PP,RC + PUSH PP,AC0 ;STACK CODE + PUSH PP,AC2 + PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION + POP PP,AC2 + JUMPNC OP2 + LDB AC1,AC2 + ADD AC1,AC0 + DPB AC1,AC2 + SKIPE RC ;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 + JRST STOW ;NO,STOW CODE AND EXIT + EVADR: TLCE AC0,-1 ;OK IF ALL 0'S + TLNN AC0,-1 + SKIPA + TRO ER,ERRQ ;NO,FLAG Q ERROR + ADD AC0,-1(PP) ;ADD ADDRESS PORTIONS + HLL AC0,-1(PP) ;GET LEFT HALF + TLZE FR,INDSW ;INDIRECT BIT? + TLO AC0,20 + 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,EVALEX ;EVALUATE + MOVSS EXTPNT ;WFW + MOVSS V,AC0 ;SWAP HALVES + MOVSS SX,RC + IOR SX,V ;MERGE RELOCATION + TRNN SX,-1 ;RIGHT HALF ZERO? + JRST OP2A ;YES, DO SIMPLE ADD + MOVE ARG,RC ;NO, SWAP RC INTO ARG + 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 + TLNE SX,-1 ;IS LEFT HALF ZERO? + TRO ER,ERRQ ;NO FLAG FORMAT ERROR +OP2A: ADDM AC0,-1(PP) ;MERGE WITH PREVIOUS VALUE + ADDM RC,-2(PP) + CAIE C,11 ;")"? + JRST ERRAX ;NO, FLAG ERROR + JRST BYPAS1 ;YES, BYPASS PARENTHESIS + +EXPRES: HRLZ AC0,RX ;FUDGE FOR OCT0 + +OCT0: PUSH PP,RX + HLR RX,AC0 +OCT1: PUSHJ PP,EVALEX ;EVALUATE + 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? + JRST ASC60 ;YES + CAIL C,"A"+40 + CAILE C,"Z"+40 + SKIPA + SUBI C,40 ;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 + 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 + JRST ERRAX + MOVE SX,SEQNO2 + MOVEM SX,TXTSEQ + 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 + MOVEI AC0,0 ;CLEAR WORD +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 + PUSHJ PP,STOWZ ;YES, STOW IT + JRST ASC20 ;GET NEXT WORD + +ASC50: TDZA RC,SDEL ;TEST FOR ASCIIZ +ASC55: TROA ER,ERRA ;SIXBIT FOUND EXIT +ASC60: PUSHJ PP,BYPAS1 ;POLISH OFF TERMINATE + SETZM INTXT ;WE ARE OUT OF IT + ANDCM RC,STPX ;STORE AT LEAST ONE WORD + JUMPGE RC,STOWZ ;STOW + POPJ PP, ;ASCII, NO BYTES STORED, SO EXIT + POINT0: 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: PUSH PP,RC + PUSH PP,AC0 ;STORE ZERO ON STACK + PUSHJ PP,EVALEX ;EVALUATE EXPRESSION + JUMPNC OP2 + HRLM AC0,0(PP) ;SET LEFT HALF + HRLM RC,-1(PP) + MOVSS EXTPNT ;WFW + JRST OP1A ;EXIT THROUGH OP + +IOWD0: PUSHJ PP,EVALXQ ;EVALUATE AND TEST FOR EXTERNAL + CAIE C,14 ;","? + 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 + JRST STOW ;STOW CODE AND EXIT + BYTE0: PUSHJ PP,BYPAS1 ;GET FIRST NON-BLANK + CAIE C,10 ;"("? + JRST ERRAX ;NO, FLAG ERROR AND EXIT + 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 + CAIGE AC0,0 + 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 + 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 + + 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 ;YET, GET SYMBOL + POPJ PP, + PUSHJ PP,SQOZE ;SQUOZE SIXBIT AND ADD CODE + 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, + 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 ;INITIALZE 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 + PUSH MP,MRP ;STACK PREVIOUS READ POINTER +REPEA5: HLRZ MRP,@REPPNT +REPEA8: MOVEI C,LF + JRST RSW1 + +REPEND: SOSL REPEXP + JRST REPEA5 + HRRZ V,REPPNT ;GET START OF TREE + PUSHJ PP,REFDEC ;DECREMENT REFERENCE + POP MP,MRP + POP MP,REPPNT + POP MP,REPEXP + JRST RSW0 + REPZ: MOVE SDEL,SEQNO2 + 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 + JRST GETCHR + +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 + MOVEM SX,DEFSEQ + MOVE SX,PAGENO + MOVEM SX,DEFPG + SETOM INDEF + MOVEI SX,0 +DEF02: PUSHJ PP,GCHAR + CAIN C,74 + JRST DEF20 + CAIE C,50 + JRST DEF02 +DEF10: PUSHJ PP,GETSYM ;YES, GET DUMMY SYMBOL + TRO ER,ERRA ;FLAG ERROR + ADDI SX,1000 ;INCREMENT ARG COUNT + PUSH PP,AC0 ;STACK IT + 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 + AOS ARG,SX + PUSHJ PP,SKELI ;INITIALIZE MACRO SKELETON + MOVE AC0,PPTMP2 ;GET NAME + MOVEM PP,PPTMP2 + 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 + MOVSI ARG,MACF + PUSHJ PP,INSERT ;INSERT/UPDATE + TLZ IO,DEFCRS ;JUST IN CASE + 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 + CAIG CS,"Z"+40 ;CONVERT LOWER CASE + CAIGE CS,"A"+40 + SKIPA + SUBI CS,40 + CAIL CS,40 + 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 + CAIN C,74 + AOJA SDEL,DEF30 + CAIN C,76 + SOJL SDEL,DEF70 + CAIE C,47 ;IS THIS A '? + JRST DEF30 + SKIPE SDEL +CPEEK1: PUSHJ PP,WCHAR + PUSHJ PP,GCHAR + CAIE C,47 + JRST DEF32 + JRST CPEEK1 + DEF40: MOVEI AC0,0 ;CLEAR ATOM + MOVSI AC1,(POINT 6,AC0) ;SET POINTER +DEF42: PUSH PP,C + TLNE AC1,770000 + IDPB CS,1 + PUSHJ PP,GCHAR ;GET NEXT CHARACTER + MOVE CS,C + CAIG CS,"Z"+40 + CAIGE CS,"A"+40 + SKIPA + 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 TP + +DEF46: SKIPN 1(SX) ;END OF LIST? + JRST DEF51 ;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,0776020(SX) ;()(SX) ;SET ESCAPE CODE MACEND + LSH AC0,-^D30 + CAIN AC0,5 ;"%"? + TLO CS,1000 ;YES, SET CRESYM FLAG + PUSHJ PP,WWORD ;WRITE THE WORD +DEF48: MOVE PP,PPTMP2 ;RESET PUSHDOWN POINTER + TLO IO,IORPTC ;ECHO LAST CHARACTER + JRST DEF31 + +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 BYPAS1 + 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 + MOVE SDEL,SEQNO2 + MOVEM SDEL,CALSEQ + MOVE SDEL,PAGENO + MOVEM SDEL,CALPG + HLRZ V,0(V) + AOS SDEL,0(V) ;INCREMENT ARG COUNT + LSHC SDEL,-^D<9+36> ;ZERO SDEL, GET ARG COUNT IN SX + ANDI SX,777 ;MASK + PUSH PP,V ;STORE COUNT OF ARGS + PUSH PP,RP ;STACK FOR MACPNT + JUMPE SX,MAC20 ;TEST FOR NO ARGS + PUSHJ PP,CHARAC + CAIE C,"(" ;"(" + TROA SDEL,-1 ;YES, END OF ARGUMENT STRING + +MAC10: PUSHJ PP,GCHAR + CAIG C,CR + CAIGE C,LF + SKIPA + JRST MAC21 + 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 +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 + SKIPA + 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 + SOJG SX,MAC10 ;BRANCH IF NO MORE ARGS + MAC20: TLZN IO,IORPTC + PUSHJ PP,CHARAC +MAC21: EXCH MP,RP +MAC21A: PUSH MP,[-1] ;NO MISSING ARGS + SOJGE SX,MAC21A + SETZM 0(MP) + LDB C,LBUFP + MOVEI SX,"^" + JUMPAD MAC24 + CAIN C,";" + SKIPE MRP + JRST MAC24 + PUSHJ PP,STOUT ;LIST COMMOENT 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 + PUSH MP,MACPNT + POP PP,MACPNT + PUSH MP,C + PUSH MP,MRP ;STACK WORD COUNT + POP PP,MRP ;STACK MACRO 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 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) + SKIPE C ;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 + 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 + HLRZ CS,0(MRP) + SKIPE MACENL ;CHECK UPROCESSED END LEVEL + JUMPE CS,MACEN0 ;THEN POP THE MACRO STACK NOW + 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,0(C) + PUSH MP,IRPPOI + + HRRZM C,IRPARP + MOVEM AC0,IRPCF ;IRPC FLAG FOUND IN AC0 + SETOM AC0,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,WCHAR + 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 + SKIPG CS,IRPARG + JRST IRPPOP ;EXIT IF NOT VALID ARGUMENT + HLRZ C,0(CS) ;INITIALIZE POINTER + MOVEM C,IRPARG + IRPSET: EXCH MRP,IRPARG ;SWAP READ POINTERS + PUSHJ PP,SKELI1 ;INITIALIZE SKELETON FOR DATA + HRRZM ARG,@IRPARP ;STORE NEW DS POINTER + SETZB SX,SDEL ;ZERO FOUND FLAG AND BRACKET COUNT +IRPSE1: PUSHJ PP,MREADS + CAIE C,177 ;SPECIAL? + AOJA SX,IRPSE2 ;NO, FLAG AS FOUND + MOVEM MRP,V + PUSHJ PP,MREADS ;LOOK AT NEXT CHARACTER + MOVE MRP,V + 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 + HLRZ MRP,@IRPPOI ;SET FOR NEW SCAN + JRST 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,MRP ;RESTORE CELLS + POP MP,IRPPOI + POP MP,@IRPARP + POP MP,IRPARG + POP MP,IRPARP + POP MP,IRPSW + POP MP,IRPCF + JRST REPEA8 + GETDS: 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 + 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 ;WRITE INTO SKELETON + PUSHJ PP,WWORD + MOVSI CS,(BYTE (7) 177,2) + PUSHJ PP,WWRXE ;WRITE END CODE + POP PP,MWP ;RESTORE MACRO WRITE POINTER + POP PP,WWRXX + MOVE V,ARG ;SET UP FOR REFINC + +GETDS1: PUSHJ PP,REFINC ;INCREMENT REFERENCE + PUSH MP,V ;STACK V FOR DECREMENT + PUSH MP,MRP ;STACK READ POINTER + HLRZ MRP,0(V) ;FORM READ POINTER + JRST RSW0 ;EXIT + +DSEND: POP MP,MRP + POP MP,V + PUSHJ PP,REFDEC ;DECREMENT REFERENCE + JRST RSW0 ;EXIT + SKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG +SKELI: MOVE MWP,LADR + PUSHJ PP,SKELWL ;GET POINTER WORD + HRRZM MWP,WWRXX ;SAVE FIRST ADDRESS + PUSHJ PP,SKELWL + HRRM ARG,0(MWP) ;STORE COUNT + HRRZ ARG,WWRXX ;SET FIRST ADDRESS + ;SKEW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT) + +SKELWL: SKIPE V,NEXT ;GET FIRST FREE ADDRESS + JRST SKELW1 ;IF NON-ZERO, UPDATE FREE + AOS V,FREE ;INCREMENT BY LEAF SIZE + CAML V,SYMBOL ;OVERFLOW? + PUSHJ PP,XCEED ;YES, BOMB OUT + SETZM (V) ;CLEAR LINK + +SKELW1: HLL V,0(V) ;GET ADDRESS + HLRM V,NEXT ;UPDATE NEXT + HRLM V,0(MWP) ;STORE LINK IN FIRST WORD OF LEAF + HRRZ MWP,V + 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: SKIPE MACLVL + JRST MREADS ;IF GETTING CHAR. FROM TREE +GCHAR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER + CAIE C,LF ;TEST FOR LF, VT OR FF + CAIN C,FF + PUSHJ PP,OUTIM1 ;YES, LIST IT + POPJ PP, + +WCHARQ: SKIPE MACLVL + JRST WCHAR +WCHAR: TLNN MWP,770000 ;END OF WORD? + PUSHJ PP,SKELWL ;YES, GET ANOTHER + IDPB C,MWP + POPJ PP, + +WWORD: LSHC C,7 ;MOVE ASCII INTO C + PUSHJ PP,WCHAR ;STORE IT + JUMPN CS,WWORD ;TEST FOR END + POPJ PP, ;YES, EXIT + +WWRXE: PUSHJ PP,WWORD ;WRITE LAST WORD + HRRZS (MWP) ;ZERO LEFT HALF OF LAST LEAF + HRRM MWP,@WWRXX ;SET POINTER TO END + POPJ PP, + MREAD: PUSHJ PP,MREADS ;READ ON 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 ;YES + 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 + +MREADS: TLNE MRP,770000 ;HAVE WE FINISHED WORD? + JRST MREADC ;STILL CHAR. IN LEAF + HLRZ MRP,0(MRP) ;YES, GET LINK + HRLI MRP,(POINT 7,,21) ;SET POINTER +MREADC: ILDB C,MRP ;GET CHARACTER + POPJ PP, + + REFINC: HLRZ CS,0(V) ;GET POINTER TO FREE + AOS 0(CS) ;INCREMENT REFERENCE + POPJ PP, +REFDEC: HLRZ CS,0(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, + + A== 0 ;ASCII MODE +AL== 1 ;ASCII LINE MODE +IB== 13 ;IMAGE BINARY MODE +B== 14 ;BINARY MODE + +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 + SUBTTL I/O ROUTINES +BEG: +IFN CCLSW, +IFE CCLSW, + RESET ;INITIALIZE PROGRAM + SETZB MRP,PASS1I + MOVE [XWD PASS1I,PASS1I+1] + BLT PASS2X-1 ;ZERO THE PASS1 AND PASS2 VARIABLE + MOVEI PP,JOBFFI ;SET TEMP PUSH-DOWN POINTER + MOVE CS,[POINT 7,DBUF] ;INITIALIZE FOR DATA + MSTIME 2, ;GET TIME FROM MONITOR + IDIVI 2,^D60*^D1000 + IDIVI 2,^D60 + PUSH PP,3 ;SAVE MINUTES + PUSHJ PP,OTOD1 + POP PP,2 + PUSHJ PP,OTOD1 + DATE 1, + IDIVI 1,^D31 ;GET DAY + ADDI 2,1 + CAIG 2,^D9 ;TWO DIGITS? + ADDI 2,7760*^D10 ;NO, PUT IN SPACE + PUSHJ PP,OTOD1 ;STORE DAY + IDIVI 1,^D12 ;GET MONTH + MOVE 2,DTAB(2) ;GET MNEMONIC + ADDI CS,1 + MOVEM 2,0(CS) + MOVEI 2,^D64(1) ;GET YEAR + PUSHJ PP,OTOD ;STORE IT + 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 + 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,0 + INPUT CTL,0 + IFN CCLSW, + INIT CTL2,AL ;LOOK FOR DISK + SIXBIT /DSK/ ;... + XWD 0,CTLBLK ;... + JRST CTLSET ;DSK NOT THERE + + 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 RPGLUP ;3 TIMES + MOVEM 3,CTLBUF ;###MAC + HRLZI (SIXBIT /TMP/) ; + MOVEM CTLBUF+1 ;TMP + SETZM CTLBUF+3 ;PROG-PRO + LOOKUP CTL2,CTLBUF ;COMMAND FILE + JRST CTLSET ;NOT THERE + HLRM EXTMP ;SAVE THE EXTENSION +RPGS2: INBUF CTL2,1 ;SINGLE BUFFERED +RPGS2A: INIT CTL,AL ;TTY FOR CONSOLE MESSAGES + SIXBIT /TTY/ ;... + XWD CTOBUF,0 ;... + EXIT ;NO TTY, NO ASSEMBLY + OUTBUF CTL,1 ;SINGLE BUFFERED + MOVE JOBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN + MOVEM SAVFF ;... + TLNE IO,CRPGSW ;ARE WE ALREAD 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,[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 ERRNE0] ;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 ;GET NEXT CHAR + 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 ERRNE0 ;GO COMPLAIN +GOSET2: MOVEI C,12 ;MAKE SURE THERE'S A LF + IDPB C,CTIBUF+1 ;... + MOVEM AC1,CTIBUF+1 ;SET POINTER TO BEGINNING + MOVE AC0,SAVFF ;RESET JOBFF FOR NEW BINARY + MOVEM AC0,JOBFF ;... + JRST BINSET + RPGS1: PUSHJ PP,DELETE ;DELETE COMMAND FILE + MOVEM ACDEV,RPGDEV ;GET SET TO INIT + PUSHJ PP,RPGINI + MOVEM ACFILE,INDIR ;USE INPUT BLOCK + MOVEM ACEXT,INDIR+1 + LOOKUP CTL2,INDIR + JRST RPGLOS + HLRM ACEXT,EXTMP ;SAVE THE EXTENSION + HLRZ JOBSA ;RESET JOBFF TO ORIGINAL + MOVEM JOBFF + TLO IO,CRPGSW ;TURN ON SWITHC 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,ERRCM ;IGNORE IF JUST + TLO FR,PNCHSW ;OK, SET SWITCH + MOVEM ACDEV,BINDEV ;STORE DEVICE NAME + MOVEM ACFILE,INDIR ;STORE FILE NAME IN DIRECTORY + SKIPN ACEXT ;EXTENSION SPECIFIED? + MOVSI ACEXT,(SIXBIT /REL/) ;NO, ASSUME RELOCATABLE BINARY + MOVEM ACEXT,INDIR+1 ;STORE IN DIRECTORY + PUSHJ PP,BININI ;INITIALIZE BINARY + TLZE TIO,TIOLE ;SKIP TO EOT + MTEOT. BIN, + TLZE TIO,TIORW ;REWIND REQUESTED? + MTREW. BIN, ;YES + JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE + MTBSF. BIN, ;BACK-SPACE A FILE + AOJL CS,.-1 ;TEST FOR END + MTWAT. BIN, + STATO BIN,1B24 ;LOAD POINT? + MTSKF. BIN, ;NO, GO FORWARD ONE +BINSE2: SOJG CS,.-1 ;TEST FORWARD SPACING + + TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED? + UTPCLR BIN, ;YES, CLEAR IT + OUTBUF BIN,2 ;SET UP TWO RING BUFFER + ENTER BIN,INDIR + JRST ERREF + 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 + SKIPN ACDEV ;YES, WAS DEVICE SPECIFIED? + MOVSI ACDEV,(SIXBIT /DSK/) ;NO, ASSUME DSK + SKIPN ACFILE + MOVE ACFILE,[SIXBIT /CREF/] + SKIPN ACEXT + MOVSI ACEXT,(SIXBIT /LST/) +LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED + MOVEM ACDEV,LSTDEV + MOVE AC0,1 + DEVCHR AC0, + TLNN AC0,2 + TLNE FR,CREFSW ; WAS CROSS-REF REQUESTED? + AOSA OUTSW ;NO, ASSUME TTY + JRST ERRCM ;YES, ERROR - CREF DEV MUST NO TBE LPT, DIS OR TTY + TLNE AC0,TTYBIT ;CONTROLING TELETYPE LISTING? + JRST GETSET ;YES, BUFFER ALREADY SET + AOS OUTSW ;SET FOR LPT + MOVEM ACFILE,INDIR + SKIPN ACEXT + MOVSI ACEXT,(SIXBIT /LST/) + MOVEM ACEXT,INDIR+1 + PUSHJ PP,LSTINI + TLZE TIO,TIOLE + MTEOT. LST, + TLZE TIO,TIORW + MTREW. LST, + JUMPGE CS,LSTSE3 + MTBSF. LST, + AOJL CS,.-1 + MTWAT. LST, + STATO LST,1B24 + MTSKF. LST, +LSTSE3: SOJG CS,.-1 + TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED? + UTPCLR LST, ;YES, CLEAR IT + OUTBUF LST,2 ;SET UP A TWO RING BUFFER + ENTER LST,INDIR + JRST ERREF + 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 + HRRZM 3,LADR ;SET START OF MACRO TREE + HRRZM 3,FREE + +GETSE1: HRRZ JOBREL + SKIPE JOBDDT + HRRZ JOBSYM + SUBI 1 + MOVEM SYMTOP + SUBI LENGTH + CAMLE LADR + JRST GETSE2 + + 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 + MOVE AC0,CTIBUF+1 + MOVEM AC0,CTLSAV + MOVSI AC0,(SIXBIT 'DSK') + MOVEM AC0,ACDEVX + PUSHJ PP,INSET + + MOVEI CS,[ASCIZ /MACRO: /] ;PUBLISH COMPILER NAME + TLNE IO,CRPGSW ;PUNCH REQUESTED? + DDTOUT CS, + JRST ASSEMB + + FINIS: CLOSE BIN, ;DUMP BUFFER + TLNE FR,PNCHSW ;PUNCH REQUESTED? + PUSHJ PP,TSTBIN ;YES, TEST FOR ERRORS + RELEAS BIN, + CLOSE LST, + SOSLE OUTSW ;LPT TYPE OUTPUT? + PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS + RELEAS LST, + CLOSE CHAR, + RELEAS CHAR, + OUTPUT CTL,0 ;FLUSH TTY OUTPUT + JRST M + 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 + PUSHJ PP,INDEVI + DEVCHR ACDEV, ;TEST CHARACTERISTICS + TLNN ACDEV,MTABIT ;MAG TAPE? + JRST INSET3 ;NO + TLZN FR,MTAPSW ;FIRST MAG TAPE IS PASS 2? + JRST INSET1 ;NO + TLNN TIO,TIORW ;YES, REWIND REQUESTED? + SUB CS,RECCNT ;NO, PREPARE TO BACK-SPACE TAPE +INSET1: AOS RECCNT ;INCREMENT FILE COUNTER + ADDM CS,RECCNT ;UPDATE COUNT + TLZE TIO,TIOLE + MTEOT. CHAR, + TLZE TIO,TIORW ;REWIND? + MTREW. CHAR, ;YES + JUMPGE CS,INSET2 + MTBSF. CHAR, + MTBSF. CHAR, + AOJL CS,.-1 + MTWAT. CHAR, + STATO CHAR,1B24 + MTSKF. CHAR, +INSET2: SOJGE CS,.-1 + +INSET3: INBUF CHAR,1 + MOVEI ACPNTR,JOBFFI + EXCH ACPNTR,JOBFF + SUBI ACPNTR,JOBFFI + MOVEI ACDEL,NUMBUF*203+1 + IDIV ACDEL,ACPNTR + INBUF CHAR,(ACDEL) + JUMPN SDEL,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK + MOVSI SDEL,(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 + POPJ PP, + +INSETI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION + LOOKUP CHAR,INDIR + TDZA ACEXT,ACEXT + AOS 0(PP) + POPJ PP, + REC2: MOVE CTLSAV + MOVEM CTIBUF+1 + MOVEI "_" + HRLM BLKTYP + SETZM ACDEVX + MOVE [XWD PASS2I,PASS2I+1] + BLT PASS2X-1 ;ZERO PASS2 VARIABLES + TLOA FR,MTAPSW!LOADSW ;SET FLAGS + INPUT CHAR, + +GOTEND: STATO CHAR,1B22 ;TEST FOR EOF + JRST .-2 + +EOT: PUSHJ PP,SAVEXS ;SAVE REGISTERS + RELEAS CHAR, + 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 + MOVE RC,SAVERC ;RESTORE RC + POPJ PP, + +SAVEXS: MOVEM RC,SAVERC ;SAVE RC + MOVEI RC,SAVBLK ;SET POINTER + BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW EC + POPJ PP, ;EXIT + + NAME2: SKIPA ACDEV,ACDEVX +NAME1: SETZB ACDEV,INDIR+2 + MOVEI ACFILE,0 ;CLEAR FILE + HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER + SETZB TIO,CS + SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR +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 ;... + CAIE C,175 ;OR 3RD ALTMOD + CAIN C,CR ;CR? + JRST TERM + CAIN C,"[" + JRST PROGNP + CAIE C,"," + CAIN C,"_" + JRST TERM + 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: SKIPA ACDEV,0 ;ERROR IF ALREADY SET + +NAME: MOVE ACFILE,AC0 ;FILE NAME + MOVE ACDEL,C ;SET DELIMITER + JRST NAME3 + +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 + MOVEM ACDEV,ACDEVX ;USE LAST DEVICE + CAIN C,"!" ;IMPERATIVE? + POPJ PP, ;YES, DON'T ASSUME DEV + JUMPE ACFILE,POPOUT ;IF THERE IS A FILE, + SKIPN ACDEV ;BUT NO DEVICE + MOVSI ACDEV,(SIXBIT /DSK/) ;THEN ASSUME DISK + POPJ PP, ;EXIT + + PROGNP: JUMPL PP,PROGN2 + +ERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/] + JRST ERRNE0 + +PROGN1: HRLZM RC,INDIR+3 +PROGN2: MOVEI RC,0 ;CLEAR AC +PROGN3: PUSHJ PP,TTYIN + CAIN C,"," + JRST PROGN1 ;STORE LEFT HALF + HRRM RC,INDIR+3 + CAIN C,135 + JRST GETIOC + LSH RC,3 ;SHIFT PREVIOUS RESULT + ADDI RC,-"0"(C) ;ADD IN NEW NUMBER + JRST PROGN3 + SWITC0: PUSHJ PP,SW1 +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, + + DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION +J= <"LETTER"-"A">-9*/9> + 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, + SETSW L, + SETSW N, + SETSW Q, + SETSW S, + SETSW T, + SETSW W, + SETSW X, +IFG .-SWTAB-17, + +BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB + ;IT CONSIST OF 9 4BIT BYTES/WORD + ;OR ONE BYTE FOR EACH LETTER + + +BYTAB0 ;A-G BYTE = 1 THROUGH 17 = INDEX + +BYTAB1 ;H-N BYTE = 0 = COMMAND ERROR + +BYTAB2 ;O-U + + TTYIN: ILDB C,CTIBUF+1 ;GET CHARACTER + CAIE C," " ;SKIP BLANKS + CAIN C,HT ;AND TABS + JRST TTYIN + CAIE C,LF + POPJ PP, + +ERRNE: HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/] + PUSHJ PP,TYPMSG + SKIPN LITLVL ;SET IF IN LITERAL + JRST ERRNE1 ;NO, TRY OTHERS + MOVE V,[XWD [SIXBIT /LITERAL@/],LITPG] + PUSHJ PP,PRNUM +ERRNE1: MOVEI V,0 ;CHECK FOR OTHER PLACES + SKIPE INDEF + MOVE V,[XWD [SIXBIT /DEFINE@/],DEFPG] + SKIPE INTXT + MOVE V,[XWD [SIXBIT /TEXT@/],TXTPG] + SKIPE INREP + MOVE V,[XWD [SIXBIT /CONDITIONAL OR REPEAT@/],REPPG] + SKIPGE MACENL + MOVE V,[XWD [SIXBIT /MACRO CALL@/],CALPG] + SKIPE V + PUSHJ PP,PRNUM ;GO PRINT INFORMATION + HRROI RC,[SIXBIT /@/] ;WILL GET A RETURN + JRST ERRNE0 + +ERRMS3: SIXBIT / ERRORS DETECTED@/ +ERRMS2: SIXBIT /?1 ERROR DETECTED@/ +ERRMS1: SIXBIT /NO ERRORS DETECTED@/ +EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]] + JRST ERRNE0 + ERREF: SKIPA RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE] +ERRCF: MOVE RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE] +ERRNE0: PUSHJ PP,CRLF + MOVEI C,77 + PUSHJ PP,TYO + PUSHJ PP,TYPMS1 + JRST M + 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 + CAIE C,FF ;FORM FEED? + CAIN C,LF ;V TAB OR LINE FEED? + OUTPUT CTL,0 ;YES + POPJ PP, ;AND EXIT + +TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD + CAIG CS,17 ;IS IT? + MOVEM C,1(CS) + 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) +XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/] + CORE 0 ;REQUEST MORE CORE + JRST ERRNE0 ;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,116 + ADDM 1,SYMTOP + PUSHJ PP,SRCHI ;RE-INITIALIZE SYMBOL TABLE + JRST RSTRXS ;RESTORE REGISTERS AND EXIT + +PDPERR: HRROI RC,[SIXBIT .PDP OVERFLOW, TRY /P@.] + JRST ERRNE0 + +PRNUM: HLRZ CS,V ;GET MESSAGE + 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, + MOVEM AC1,OUTSQ + MOVEI AC0,OUTSQ + 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) + SKIPE AC0 + 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 + 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: OUTPUT BIN,0 ;DUMP THE BUFFER +TSTBIN: STATO BIN,740000 ;GET STATUS BITS + POPJ PP, ;NO, EXIT + MOVE AC0,BINDEV ;YES, GET TAG + JRST ERRLST + +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 0,R1BBLK(C) + AOS LOCO + CAIN C,21 + PUSHJ PP,R1BDMP + AOS RIMLOC + POPJ PP, + READ0: PUSHJ PP,EOT +READ: SOSG 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 NU + PUSHJ PP,READ ;AND THE TAB + JRST READ ;GET NEXT CHARACTER + +READ1A: JUMPE C,READ ;IGNORE NULL + JUMP2 READ1B + CAIN C,14 + AOS PAGENO +READ1B: CAIN C,32 ;IF IT'S A "^Z" + MOVEI C,LF ;TREAT IT AS A "LF" + CAIE C,37 ;CONTROL _ + POPJ PP, +READ2: PUSHJ PP,READ ;YES, TEST FOR LINE FEED + PUSHJ PP,RSW2 ;LIST IN ANY EVENT + CAIE C,LF ;IS IT LF + JRST READ2 ;NO + PUSHJ PP,OUTIM1 ;YES, DUMP THE LINE + JRST READ ;RETURN NEXT CHARACTER + +READ3: INPUT CHAR,0 ;GET NEXT BUFFER + STATO CHAR,762000 ;NO ERRORS + JRST READ1 + STATO CHAR,742000 ;ERRORS? + JRST READ0 ;EOF + MOVE AC0,INDEV + MOVSI RC,[SIXBIT /INPUT ERROR ON DEVICE@/] + JRST ERRNE0 + OUTAB2: PUSHJ PP,OUTTAB ;PRINT TWO TABS +OUTTAB: MOVEI C,HT +PRINT: CAIN C,LF ;IS THIS A LF? + JRST OUTCR ;YES, GO PROCESS + CAIN C,CR ;OR CR? + POPJ PP, + 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 + 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 + MOVE C,PAGENO + PUSHJ PP,DNC ;OUTPUT PAGE NUMBER + AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER? + JRST OUTL1 + MOVEI C,"-" ;NO, PUT OUT MODIFIER + PUSHJ PP,OUTC + MOVE C,PAGEN. + PUSHJ PP,DNC +OUTL1: PUSHJ PP,OUTCR + 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 + 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 + IDPB C,LSTBUF+1 ;STORE BYTE + POPJ PP, +DMPLST: OUTPUT LST,0 ;OUTPUT BUFFER +TSTLST: STATO LST,740000 + POPJ PP, + MOVE 0,LSTDEV +ERRLST: MOVSI RC,[SIXBIT /DATA ERROR DEVICE@/] + JRST ERRNE0 + PAGE0: +OUTFF: AOS PAGENO + SETOM PAGEN. + TLO IO,IOPAGE + POPJ PP, + +OTOD1: IBP CS +OTOD: IDIVI 2,^D10 + ADDI 2,60 ;FORM ASCII + IDPB 2,CS + ADDI 3,60 + IDPB 3,CS + POPJ PP, + +DTAB: ASCII "JAN-" + ASCII "FEB-" + ASCII "MAR-" + ASCII "APR-" + ASCII "MAY-" + ASCII "JUN-" + ASCII "JUL-" + ASCII "AUG-" + ASCII "SEP-" + ASCII "OCT-" + ASCII "NOV-" + ASCII "DEC-" + SUBTTL MACHINE INSTRUCTION SEARCH ROUTINES +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 +OPT1D: 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,OPD ;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: 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: + POINT 9,OP1COD-1(ARG),35 + POINT 9,OP1COD(ARG),8 + POINT 9,OP1COD(ARG),17 + POINT 9,OP1COD(ARG),26 + + IFDEF .XCREF,< .XCREF ;DON'T CREF THIS MESS> + 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 + 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 +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 CONI , 710 +X CONO , 711 +X CONSO , 712 +X CONSZ , 713 + +XX DATA. , 020 + +X DATAI , 714 +X DATAO , 715 +X DEC , 716 +X DEFINE, 717 +X DEPHAS, 720 + +X DFN , 131 + +X DIV , 234 +X DIVB , 237 +X DIVI , 235 +X DIVM , 236 + +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 + + +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 +IFN RENTSW, + +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 + +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 +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 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 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 + +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 UFA , 130 +X UGETF , 073 +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 XWD , 734 + +X Z , 000 + + + + +IF1, < BLOCK N1> +OP1END: -1B36 +OP1COD: BLOCK N1/4 + CC + + +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!40,B> + +P @, 0 +PRMTBL: ;PERMANENT SYMBOLS +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 DRUM, 400 +P DSK, 170 +P DTC, 210 +P DTS, 214 +P LPT, 124 +P MDF, 260 +P MTC, 220 +P MTM, 230 +P MTS, 224 +P PI, 4 +P PLT, 140 +P PTP, 100 +P PTR, 104 +P TDC, 320 +P TDS, 324 +P TMC, 340 +P TMS, 344 +P TTY, 120 +P UTC, 210 +P UTS, 214 +P ??????, 0 +PRMEND: ;END OF PERMANENT SYMBOLS + +LENGTH= .-SYMNUM ;LENGTH OF INITIAL SYMBOLS + + OPDEF ZL [Z LITF] ;INVALID IN LITERALS + OPDEF ZA [Z ADDF] ;INVALID IN ADDRESSES + OPDEF ZAL [Z ADDF!LITF] + +OP1TAB: + + ZL PAGE0 ;PAGE + ZL PASS20 ;PASS2 + ZL PHASE0 ;PHASE + Z POINT0 ;POINT + ZL PRINT0 ;PRINTX + ZL PURGE0 ;PURGE + ZL RADIX0 ;RADIX + Z RADX50 ;RADIX50,SQUOZE + ZL LOC0 (1) ;RELOC + ZL REMAR0 ;REMARK + ZL REPEA0 ;REPEAT + ZL SUPRE0 ;SUPRESS + Z ;? + ZL RIM0 (RIMSW) ;RIM + DATAI 0,IOP ;RSW + Z ASCII0 (1) ;SIXBIT + Z + Z +; ZL IOSET (IOPALL!IOSALL) ;SALL + ZL STOPI0 ;STOPI + ZL SUBTT0 (Z (POINT 7,,)) ;SUBTTL + ZL SYN0 ;SYN + ZL TAPE0 ;TAPE + ZL TITLE0 (Z (POINT 7,,)) ;TITLE + ZL VAR0 ;VAR + + Z + Z + ZL IOSET (IOPALL) ;XALL + ZL IOSET (IOPROG) ;XLIST + Z XWD0 ;XWD + ZL RIM0 (RIM1SW) ;RIM10 + ZL RIM0 (R1BSW) ;RIM10B + OP2TAB: + + Z ASCII0 (0) ;ASCII + Z ASCII0 (1B18) ;ASCIZ + BLKI IOP ;BLKI + BLKO IOP ;BLKO + ZL BLOCK0 ;BLOCK + ZL SUPRSA ;ASUPPRESS +IFN RENTSW,< ZL HISEG0 ;HISEG> +IFE RENTSW,< Z ;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 + ZL DEFIN0 ;DEFINE + + ZL DEPHA0 ;DEPHASE + ZL END0 ;END + ZL INTER0 (INTF!ENTF) ;ENTRY + Z EXPRES ;EXP + ZL 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 + ZL INTER0 (INTF) ;INTERN + Z IOWD0 ;IOWD + ZL IRP0 (0) ;IRP + ZL 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 + ZL IORSET (IOPALL) ;LALL + ZL IORSET (IOPROG) ;LIST + ZL LIT0 ;LIT + ZL LOC0 (0) ;LOC + ZL IOSET (IONCRF) ;CREF +; ZL OFFSYM ;NOSYM + Z OCT0 (^D8) ;OCT + ZL OPDEF0 ;OPDEF + JFCL 1,OP ;JFOV + ZL ONML ;MLON + ZL OFFML ;MLOFF +; TRN ASCII0 (3B19) ;COMMENT + + 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: 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 + TLOE IO,IOCREF ;HAVE WE PUT OUT THE 177,102 + JRST CREF3 ;YES + PUSH PP,C ;START OF CREF DATA + MOVEI C,0 +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,OUTL ;GET CORRECT SUBTTL + MOVEI C,177 + PUSHJ PP,OUTLST + MOVEI C,102 + PUSHJ PP,OUTLST + 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, + +CLSCRF: TRNN ER,LPTSW + POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING +CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE + JRST CLSCR1 + MOVEI C,177 + PUSHJ PP,PRINT + 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,POPOUT ;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,POPOUT ;NOT FOUND + +SRCH4: AOS 0(PP) ;SET FOR SKIP EXIT +SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT + ANDCAM ARG,0(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 + POPJ PP, + +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 + POPJ PP, + 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,XCEED + ADDI SDEL,2000 + ADDI SX,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 ;SPECIAL LEFT OR RIGHT EXTERNAL? + TRNE RC,-2 + 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 + HRR ARG,SDEL ;POINT 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,0(SDEL) + HRRI ARG,-1(SDEL) ;POINT TO THE 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,0(SX) + MOVEM 0,2(SX) ;OVERWRITE THE DELETED SYMBOL + CAME SX,SYMBOL ;SKIP WHEN DONE + SOJA SX,REMOV1 + ADDI SX,2 + MOVEM SX,SYMBOL + SOS 0,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, + 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 ANY CURRENT EXTERNS + TRNE RC,-2 + 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 + HRR ARG,SDEL ;POINT 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 VALUES + 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 RELCATION BITS + POPJ PP, ;AND EXIT + +UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL + ADDB SDEL,FREE ;SO WE NEED TWO LOCATIONS + CAML SDEL,SYMBOL ;NEED MORE CORE? + PUSHJ PP,XCEEDS ;YES + MOVEM RC,0(SDEL) ;SAVE RELOCATION BITS + HRRI ARG,-1(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 STORAGE CELLS + +IFN PURESW,< + LOC 140 +> +PASS1I: + +RP: BLOCK 1 +IFE CCLSW, + +IFN CCLSW,/5 +IFN RUNSW,> +LSTBUF: BLOCK 3 +BINBUF: BLOCK 3 +IBUF: BLOCK 3 +IFN CCLSW,> +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 +LBUFP: BLOCK 1 +LBUF: BLOCK <.CPL+5>/5 + BLOCK 1 +VARHD: BLOCK 1 +VARHDX: BLOCK 1 + +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 + +TABP: BLOCK 1 +TBUF: BLOCK .TBUF/5 +TYPERR: BLOCK 1 + + PASS2I: + +ACDEVX: BLOCK 1 +CPL: BLOCK 1 +CTLSAV: BLOCK 1 +EXTPNT: BLOCK 1 +INTENT: BLOCK 1 +INREP: BLOCK 1 +INDEF: BLOCK 1 +INTXT: 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 +IRPARG: BLOCK 1 +IRPARP: BLOCK 1 +IRPCF: BLOCK 1 +IRPPOI: BLOCK 1 +IRPSW: BLOCK 1 +LITLVL: BLOCK 1 + +ASGBLK: BLOCK 1 +LOCBLK: BLOCK 1 + +LOCA: BLOCK 1 +LOCO: BLOCK 1 +RELLOC: BLOCK 1 +LPP: BLOCK 1 +LSTSYM: BLOCK 1 +MACENL: BLOCK 1 +MACLVL: BLOCK 1 +MACPNT: BLOCK 1 +MODA: BLOCK 1 +MODLOC: BLOCK 1 +MODO: BLOCK 1 +IFN CCLSW, +OUTSQ: BLOCK 2 +PAGENO: BLOCK 1 +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 +SEQNO2: BLOCK 1 +TAGINC: BLOCK 1 +VECREL: BLOCK 1 +VECTOR: BLOCK 1 +WWRXX: BLOCK 1 +PASS2X: + SUBTTL MULTI-ASSEMBLY STORAGE CELLS + +HDAS: BLOCK 1 +IFN CCLSW, +IFN TEMP, + VAR ;CLEAR VARIABLES + + SUBTTL CONSTANTS + +IFN TEMP, +TAG: BLOCK 1 + SIXBIT / + @/ +TABI: + BYTE (7) 0, 11, 11, 11, 11 +SEQNO: BLOCK 1 + ASCIZ / / +BININI: INIT 1,B +BINDEV: BLOCK 1 + XWD BINBUF,0 + JRST EINIT + POPJ PP, +LSTINI: INIT 3,AL +LSTDEV: BLOCK 1 + XWD LSTBUF,0 + JRST EINIT + POPJ PP, + INIT 1,16 + BLOCK 2 + JRST EINIT + POPJ PP, +IFN CCLSW,< +RPGINI: INIT 4,1 +RPGDEV: BLOCK 1 + XWD 0,CTLBLK + JRST EINIT + POPJ PP, +> +INDEVI: INIT 2,0 +INDEV: BLOCK 1 + XWD 0,IBUF + JRST EINIT + POPJ PP, +VBUF: ASCII / MACRO.V36/ ;MUST BE LAST LOCATIONS IN BLOCK +DBUF: ASCIZ / TI:ME DY-MON-YR PAGE / +JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONES +IFN PURESW, + + END BEG + -- 1.7.1