+++ /dev/null
-TITLE MACRO V.46(52) \r
-SUBTTL RPG/CMF/JF/PMH/DMN 7-SEPT-71\r
-;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.\r
-\r
- VMACRO==36 ;VERSION NUMBER\r
- VUPDATE==0 ;DEC UPDATE LEVEL\r
- VEDIT==0 ;EDIT NUMBER\r
- VCUSTOM==0 ;NON-DEC UPDATE LEVEL\r
-\r
-\r
- LOC <JOBVER==137>\r
- <VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT\r
- RELOC\r
- MLON\r
-\r
-COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)\r
-\r
- SWITCHES ON (NON-ZERO) IN DEC VERSION\r
-SEG2SW GIVES TWO SEGMENT MACRO\r
-PURESW GIVES VARIABLES IN LOW SEGMENT\r
-CCLSW GIVES RAPID PROGRAM GENERATION FEATURE\r
-FTDISK GIVES DISK FEATURES\r
-RUNSW USE RUN UUO FOR "DEV:NAME!"\r
-TEMP TMPCOR UUO IS TO BE USED\r
-RENTSW ASSEMBLE REENTRANT PROGRAMS\r
-FORMSW USE MORE READABLE FORMATS FOR LISTING (ICCSW)\r
-DFRMSW DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON)\r
-\r
- SWITCHES OFF (ZERO) IN DEC VERSION\r
-STANSW GIVES STANFORD FEATURES\r
-LNSSW GIVES LNS VERSION\r
-WFWSW GIVES ARRAY, INTEGER AND LVAR FEATURES\r
-IIISW GIVES III FEATURES\r
-OPHSH GIVES HASH SEARCH OF OPCODES\r
-KI10 GIVES KI10 OP-CODES\r
-*\r
-\fSUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS\r
-\r
-IFDEF TWOSEG,<IFNDEF SEG2SW,<SEG2SW==1>>\r
-IFNDEF SEG2SW,<SEG2SW==0>\r
-IFN SEG2SW,<PURESW==1>\r
-\r
-IFNDEF PURESW,<PURESW==1>\r
-\r
-IFNDEF STANSW,<STANSW==0>\r
-\r
-IFNDEF RENTSW,<RENTSW==1>\r
-\r
-IFNDEF LNSSW,<LNSSW==0>\r
-IFN LNSSW,<FTDISK==0>\r
-\r
-IFNDEF RUNSW,<RUNSW==0>\r
-\r
-IFNDEF CCLSW,<CCLSW==1>\r
-IFN CCLSW,<FTDISK==1>\r
-\r
-IFNDEF TEMP,<TEMP==0>\r
-\r
-IFNDEF WFWSW,<WFWSW==0>\r
-\r
-\r
-IFNDEF FTDISK,<FTDISK==0>\r
-IFNDEF DFRMSW,<DFRMSW==0>\r
-IFN DFRMSW,<FORMSW==0>\r
-IFDEF ICCSW,<FORMSW==ICCSW> ;SAME SWITCH\r
-IFNDEF FORMSW,<FORMSW==0>\r
-\r
-IFNDEF IIISW,<IIISW==0>\r
-\r
-IFNDEF OPHSH,<OPHSH==0>\r
-\r
-IFNDEF KI10,<KI10==0>\r
-\fSUBTTL OTHER PARAMETERS\r
-\r
-.PDP== ^D50 ;BASIC PUSH-DOWN POINTER\r
-IFNDEF LPTWID,<LPTWID==^D120> ;DEFAULT WIDTH OF PRINTER\r
-.LPTWD==8*<LPTWID/8> ;USEFUL WIDTH IN MAIN LISTING\r
-.CPL== .LPTWD-^D32 ;WIDTH AVAIABLE FOR TEXT WHEN\r
- ;BINARY IS IN HALFWORD FORMAT\r
-IFE STANSW,<.LPP==^D55 ;LINES/PAGE>\r
-IFN STANSW,<.LPP==^D52 ;LINES/PAGE>\r
-.STP== ^D40 ;STOW SIZE\r
-.TBUF== ^D80 ;TITLE BUFFER\r
-.SBUF== ^D80 ;SUB-TITLE BUFFER\r
-.IFBLK==^D20 ;IFIDN COMPARISON BLOCK SIZE\r
-.R1B==^D18\r
-.UNIV==^D10 ;NUMBER OF UNIVERSAL DEFINITIONS\r
-.LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE\r
-\r
-NCOLS==LPTWID/^D32 ;NUMBER OF COLUMNS IN SYMBOL TABLE\r
-IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D200>>\r
-IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>\r
-IFNDEF NUMBUF,<\r
-IFE STANSW!LNSSW,<NUMBUF==2 ;NUMBER OF INPUT BUFFERS>\r
-IFN STANSW,<NUMBUF==5 ;NUMBER OF INPUT BUFFERS>\r
-IFN LNSSW,<NUMBUF==4 ;DOUBLE BUFFER FOR DOUBLE SIZE DEVICES>\r
->\r
-\r
-EXTERN JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA\r
-IFN CCLSW,< EXTERN JOBERR>\r
-\r
-IFN PURESW,<\r
-IFE SEG2SW,<HISEG>\r
-IFN SEG2SW,<TWOSEGMENTS\r
-LOWL: ;START OF LOW SEGMENT\r
- RELOC 400000>>\r
-\r
- SALL ;SUPPRESS ALL MACROS\r
-\r
-;SOME ASCII CHARACTERS\r
-\r
-HT==11\r
-LF==12\r
-VT==13\r
-FF==14\r
-CR==15\r
-EOL==33\r
-\f ;ACCUMULATORS\r
-AC0== 0\r
-AC1= AC0+1\r
-AC2= AC1+1\r
-SDEL= 3 ;SEARCH INCREMENT\r
-SX= SDEL+1 ;SEARCH INDEX\r
-ARG= 5 ;ARGUMENT\r
-V= 6 ;VALUE\r
-C= 7 ;CURRENT CHARACTER\r
-CS= C+1 ;CHARACTER STATUS BITS\r
-RC= 11 ;RELOCATION BITS\r
-MWP= 12 ;MACRO WRITE POINTER\r
-MRP= 13 ;MACRO READ POINTER\r
-IO= 14 ;IO REGISTER (LEFT)\r
-ER== IO ;ERROR REGISTER (RIGHT)\r
-FR= 15 ;FLAG REGISTER (LEFT)\r
-RX== FR ;CURRENT RADIX (RIGHT)\r
-MP= 16 ;MACRO PUSHDOWN POINTER\r
-PP= 17 ;BASIC PUSHDOWN POINTER\r
-\r
-%OP== 3\r
-%MAC== 5\r
-%DSYM== 2\r
-%SYM== 1\r
-%DMAC== %MAC+1\r
-\r
-OPDEF RESET [CALLI 0]\r
-OPDEF SETDDT [CALLI 2]\r
-OPDEF DDTOUT [CALLI 3]\r
-OPDEF DEVCHR [CALLI 4]\r
-OPDEF WAIT [MTAPE 0]\r
-OPDEF CORE [CALLI 11]\r
-OPDEF EXIT [CALLI 12]\r
-OPDEF UTPCLR [CALLI 13]\r
-OPDEF DATE [CALLI 14]\r
-OPDEF APRENB [CALLI 16]\r
-OPDEF MSTIME [CALLI 23]\r
-OPDEF PJOB [CALLI 30]\r
-OPDEF RUN [CALLI 35]\r
-OPDEF TMPCOR [CALLI 44]\r
-\r
-IFN STANSW,< OPDEF SWAP [CALLI 400004] >\r
-\f ;FR FLAG REGISTER (FR/RX)\r
-IOSCR== 000001 ;NO CR AFTER LINE\r
-MTAPSW==000004 ;MAG TAPE\r
-ERRQSW==000010 ;IGNORE Q ERRORS\r
-LOADSW==000020 ;END OF PASS1 & NO EOF YET\r
-DCFSW== 000040 ;DECIMAL FRACTION\r
-RIM1SW==000100 ;RIM10 MODE\r
-NEGSW== 000200 ;NEGATIVE ATOM\r
-RIMSW== 000400 ;RIM OUTPUT\r
-PNCHSW==001000 ;RIM/BIN OUTPUT WANTED\r
-CREFSW==002000\r
-R1BSW== 004000 ;RIM10 BINARY OUTPUT\r
-TMPSW== 010000 ;EVALUATE CURRENT ATOM\r
-INDSW== 020000 ;INDIRECT ADDRESSING WANTED\r
-RADXSW==040000 ;RADIX ERROR SWITCH\r
-FSNSW== 100000 ;NON BLANK FIELD SEEN\r
-MWLFLG==200000 ;ON FOR DON'T ALLOW MULTI-WORD LITERALS\r
-P1== 400000 ;PASS1\r
-\r
- ;IO FLAG REGISTER (IO/ER)\r
-FLDSW== 400000 ;ADDRESS FIELD\r
-IOMSTR==200000\r
-ARPGSW==100000 ;ALLOW RAPID PROGRAM GENERATION\r
-IOPROG==040000 ;SUPRESS LISTING (LIST/XLIST PSEUDO OP)\r
-NUMSW== 020000\r
-IOMAC== 010000 ;MACRO EXPANSION IN PROGRESS\r
-IOPALL==004000 ;SUPRESS LISTING OF MACRO EXPANSIONS\r
-IONCRF==002000 ;SUPRESS OUTPUT OF CREF INFORMATION\r
-CRPGSW==001000 ;CURRENTLY IN PROGRESS ON RPG\r
-IOCREF==000400 ;WE ARE NOW OUTPUTTING CREF INFO\r
-IOENDL==000200 ;BEEN TO STOUT\r
-IOPAGE==000100\r
-DEFCRS==000040 ;THIS IS A DEFINING OCCURANCE (MACROS)\r
-IOIOPF==000020 ;IOP INSTRUCTION SEEN\r
-MFLSW== 000010 ;MULTI-FILE MODE,PRGEND SEEN\r
-IORPTC==000004 ;REPEAT CURRENT CHARACTER\r
-IOTLSN==000002 ;TITLE SEEN\r
-IOSALL==000001 ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED\r
-\r
-OPDEF JUMP1 [JUMPL FR, ] ;JUMP IF PASS 1\r
-OPDEF JUMP2 [JUMPGE FR, ] ;JUMP IF PASS 2\r
-\r
-OPDEF JUMPOC [JUMPGE IO, ] ;JUMP IF IN OP-CODE FIELD\r
-OPDEF JUMPAD [JUMPL IO, ] ;JUMP IF IN ADDRESS FIELD\r
-\r
-OPDEF JUMPCM [JUMPL CS, ] ;JUMP IF CURRENT CHAR IS COMMA\r
-OPDEF JUMPNC [JUMPGE CS, ] ;JUMP IF CURRENT CHAR IS NON-COMMA\r
-\r
-\f ;ER ERROR REGISTERS (IO/ER)\r
-ERRM== 000020 ;MULTIPLY DEFINED SYMBOL\r
-ERRE== 000040 ;ILLEGAL USE OF EXTERNAL\r
-ERRP== 000100 ;PHASE DISCREPANCY\r
-ERRO== 000200 ;UNDEFINED OP CODE\r
-ERRN== 000400 ;NUMBER ERROR\r
-ERRV== 001000 ;VALUE PREVIOUSLY UNDEFINED\r
-ERRU== 002000 ;UNDEFINED SYMBOL\r
-ERRR== 004000 ;RELOCATION ERROR\r
-ERRL== 010000 ;LITERAL ERROR\r
-ERRD== 020000 ;REFERENCE TO MULTIPLY DEFINED SYMBOL\r
-ERRA== 040000 ;PECULIAR ARGUMENT\r
-ERRX== 100000 ;MACRO DEFINITION ERROR\r
-ERRQ== 200000 ;QUESTIONABLE, NON-FATAL ERROR\r
-ERRORS==777760\r
-LPTSW== 000002\r
-TTYSW== 000001\r
-\r
- ;SYMBOL TABLE FLAGS\r
-SYMF== 400000 ;SYMBOL\r
-TAGF== 200000 ;TAG\r
-NOOUTF==100000 ;NO DDT OUTPUT WFW\r
-SYNF== 040000 ;SYNONYM\r
-MACF== SYNF_-1 ;MACRO\r
-OPDF== SYNF_-2 ;OPDEF\r
-PNTF== 004000 ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE\r
-UNDF== 002000 ;UNDEFINED\r
-EXTF== 001000 ;EXTERNAL\r
-INTF== 000400 ;INTERNAL\r
-ENTF== 000200 ;ENTRY\r
-VARF== 000100 ;VARIABLE\r
-MDFF== 000020 ;MULTIPLY DEFINED\r
-SPTR== 000010 ;SPECIAL EXTERNAL POINTER\r
-SUPRBT==000004 ;SUPRESS OUTPUT TO DDT\r
-LELF== 000002 ;LEFT HAND RELOCATABLE\r
-RELF== 000001 ;RIGHT HAND RELOCATABLE\r
-\r
-LITF== 200000 ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S\r
-ADDF== 100000 ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES\r
-\r
-TNODE== 200000 ;TERMINAL NODE FOR EVALEX\r
-\fSUBTTL RUN UUO\r
-\r
-IFN CCLSW,<\r
-IFN RUNSW,< XLIST >\r
-IFE RUNSW,<\r
-;THIS CODE MUST BE IN FIRST 1K TO ALLOW MAXIMUM SPACE\r
-; FOR OVERWRITING\r
-; 74 APPEARS BECAUSE ONLY LOCS 74 AND BEYOND ARE SAVED BY "SAVE"\r
-\r
-IFN CCLSW,<NUNCOM: IOWD 0,INHERE ;WHERE TO DO IO\r
- 0 ;TERMINATE COMMAND LIST\r
-NUNGO2: IN BIN,NUNCOM ;READ FILE\r
- JRST NUNGO3 ;THERE ARE NO ERRORS\r
-NUNERR: DDTOUT NUNPNT, ;COMPLAIN\r
- EXIT ;GIVE UP\r
-NUNERM: ASCIZ /?LINKAGE ERROR/\r
-NUNGO3: SKIPE 12,INHERE+133-74 ;LOOK AT JOBCOR\r
- ;DOES JOB WANT TO RUN IN MORE CORE?\r
- CAMG 12,JOBREL ;MORE CORE THAN CURRENTLY USED?\r
- JRST NUNGO4 ;NO, GO BLT PROG\r
- CORE 12, ;ASK FOR MORE CORE\r
- JRST NUNERR ;NOT AVAILABLE\r
- JRST NUNGO4 ;GO BLT PROGRAM\r
-INHERE:\r
-\f;THIS CODE MUST BE IN FIRST 1K\r
-NUNSET: JUMPN ACDEV,.+2 ;DEVICE SPECIFIED?\r
- MOVSI ACDEV,(SIXBIT /SYS/) ;NO, USE SYSTEM DEVICE\r
- JUMPN ACEXT,.+2 ;EXT SPECIFIED?\r
- MOVSI ACEXT,(SIXBIT /SAV/) ;NO, USE "SAV"\r
- MOVEM ACDEV,NUNDEV ;DEVICE NAME TO USE\r
- OPEN BIN,NUNINI ;INIT THE DEVICE\r
- JRST EINIT ;ERROR\r
- MOVEM ACFILE,NUNDIR ;IS THE FILE AVAILABLE?\r
- HLLZM ACEXT,NUNDIR+1 ;STASH EXTENSION\r
- SETZM NUNDIR+3 ;CLEAR PPN\r
- LOOKUP BIN,NUNDIR ;LOOK FOR FILE\r
- JRST [HLRZ ACEXT,NUNDIR+1 ;WAS EXTENSION "SAV"?\r
- CAIE ACEXT,(SIXBIT /SAV/) ;...\r
- JRST ERRCF ;GO COMPLAIN\r
- MOVSI ACEXT,(SIXBIT /DMP/) ;TRY "DMP" EXTENSION\r
- JRST .-3 ] ;TRA -3,4\r
- PUSHJ PP,DELETE ;COMMAND FILE\r
- MOVE 15,NUNDIR ;GET THE NAME\r
- CALLI 15,43 ;TELL SYSTEM "SETNAM"\r
- HLRO 15,NUNDIR+3 ;GET WORD COUNT\r
- HRLM 15,NUNCOM ;STASH COUNT\r
- MOVNS 15 ;NEGATIVE COUNT\r
- MOVEI 16,73(15) ;WHERE TO STOP BLT\r
- ADDI 15,INHERE ;HOW BIG TO MAKE CORE\r
- IORI 15,1777 ;AN EVEN MULTIPLE OF 1K\r
- CORE 15, ;ASK TS EXEC FOR CORE\r
- JRST [HRROI RC,[SIXBIT /NOT ENUF CORE FOR LINKAGE@/]\r
- JRST ERRFIN ];GO COMPLAIN\r
- MOVSI NUNTOP,NUNAC\r
- BLT NUNTOP,NUNTOP ;SET ACS\r
- HRR NUNBLT,16 ;...\r
- TLNN IO,CRPGSW ;WAS RPG IN PROGRESS?\r
- TLZ NUNAOS,577000 ;NO, DON'T MAKE NEXT AN RPG\r
- JRST NUNGO2\r
-\r
-NUNAC: PHASE 0\r
-NUNGO4: MOVE NUNLAC,INHERE+74-74 ;SETUP FOR NEW DDT\r
- SETDDT NUNLAC, ;...\r
-INTERN JOBS41\r
-JOBS41=122 ;LOADER WILL GIVE MUL. DEF. GLOBAL IF CHANGED\r
-\r
-EXTERN JOB41\r
- MOVE NUNLAC,JOBS41+INHERE-74 ;RESTORE LOC 41\r
- MOVEM NUNLAC,JOB41 ;...\r
-NUNBLT: BLT NUNTOP,.-. ;MOVE PRGM TO WHERE IT BELONGS\r
- RESET ;RESET ALL I/O\r
-NUNAOS: AOS 1,JOBSA ;GET STARTING ADDR FOR RPG\r
- JRST 0(1) ;GET ON WITH THE GAME\r
-NUNPNT: NUNERM ;ERROR MESSAGE POINTER\r
-NUNTOP: XWD INHERE+1,75\r
-NUNLAC=.\r
- DEPHASE\r
-> >\r
- LIST\r
-\r
-\fIFN RUNSW,< ;ASSEMBLE IF RUN UUO IMPLEMENTED\r
-NUNSET: JUMPN ACDEV,.+2\r
- MOVSI ACDEV,(SIXBIT /SYS/) ;USE SYS IF NONE SPECIFIED\r
- MOVEM ACDEV,RUNDEV\r
-IFE STANSW,<\r
- MOVEM ACFILE,RUNFIL ;STORE FILE NAME\r
- PUSHJ PP,DELETE ;COMMAND FILE\r
- SETZM RUNPP\r
- MOVEI 16,RUNDEV ;XWD 0,RUNDEV\r
- TLNE IO,CRPGSW ;WAS RPG IN PROGRESS?\r
- HRLI 16,1 ;YES. START NEXT AT C(JOBSA)+1\r
- RUN 16, ;DO "RUN DEV:NAME"\r
-> ;IFE STANSW,\r
-IFN STANSW,<\r
- MOVEM ACFILE,RUNDEV+1\r
- SETZM RUNDEV+2\r
- SETZM RUNDEV+3\r
- SETZM RUNDEV+4\r
- TLNE IO,CRPGSW ;ARE WE DOING RPG?\r
- AOS RUNDEV+3 ;YES SET STARTING ADDRESS INCREMENT\r
- MOVEI 16,RUNDEV ;ADDRESS OF SWAPBLOCK\r
- SWAP 16,\r
-> ;IFN STANSW\r
- HALT ;SHOULDN'T RETURN. HALT IF IT DOES\r
->\r
-\r
-DELETE: HRRZ EXTMP ;IF THE EXTENSION\r
- CAIE (SIXBIT/TMP/) ;IS .TMP\r
- POPJ PP, ;RETURN.\r
- CLOSE CTL2, ;DELETE\r
- SETZB 4,5 ;THE COMMAND FILE.\r
- SETZB 6,7\r
- RENAME CTL2,4 ;\r
- JFCL\r
- POPJ PP,\r
->\r
-\fSUBTTL START ASSEMBLING\r
-\r
-ASSEMB: PUSHJ PP,INZ ;INITIALIZE FOR PASS\r
- MOVE [ASCII /.MAIN/]\r
- MOVEM TBUF\r
- MOVEI SBUF\r
- HRRM SUBTTX\r
-\r
-ASSEM1: PUSHJ PP,CHARAC ;TEST FOR FORM FEED\r
- SKIPGE LIMBO ;CRLF FLAG?\r
- JRST ASSEM1 ;YES ,IGNORE LF\r
- CAIN C,14\r
- SKIPE SEQNO\r
- JRST ASSEM2\r
- PUSHJ PP,OUTFF1\r
- PUSHJ PP,OUTLI\r
- JRST ASSEM1\r
-\r
-ASSEM2: AOS TAGINC\r
- CAIN C,"\" ;BACK-SLASH?\r
- TLZA IO,IOMAC ;YES, LIST IF IN MACRO\r
- TLO IO,IORPTC\r
- PUSHJ PP,STMNT ;OFF WE GO\r
- TLZN IO,IOENDL ;WAS STOUT PRE-EMPTED?\r
- PUSHJ PP,STOUT ;NO, POLISH OFF LINE\r
- JRST ASSEM1\r
-\r
-\fSUBTTL STATEMENT PROCESSOR\r
-\r
-STMNT: TLZ FR,INDSW!FSNSW\r
- TLZA IO,FLDSW\r
-STMNT1: PUSHJ PP,LABEL\r
-STMNT2: PUSHJ PP,ATOM ;GET THE FIRST ATOM\r
- CAIN C,35 ;"="?\r
- JRST ASSIGN ;YES\r
- CAIN C,32 ;":"?\r
- JRST STMNT1 ;YES\r
- JUMPAD STMNT7 ;NUMERIC EXPRESSION\r
- JUMPN AC0,STMN2A ;JUMP IF NON NULL FIELD\r
- SKIPN LITLVL ;ALLOW COMMA IN LITERALS\r
- CAIE C,14 ;NULL, COMMA?\r
- CAIN C,EOL ;OR END OF LINE?\r
- POPJ PP, ;YES,EXIT\r
- CAIN C,"]" ;CLOSING LITERAL?\r
- POPJ PP, ;YES\r
- JRST STMNT9 ;NO,AT LEAST SKIP ALL THIS NONSENSE\r
-\r
-STMN2A: JUMPE C,.+2\r
- TLO IO,IORPTC\r
- PUSHJ PP,MSRCH ;SEARCH FOR MACRO/OPDEF/SYN\r
- JRST STMNT3 ;NOT FOUND, TRY OP CODE\r
- LDB SDEL,[POINT 3,ARG,5]\r
- JUMPE SDEL,ERRAX ;ERROR IF NO FLAGS\r
- SOJE SDEL,OPD1 ;OPDEF IF 1\r
- SOJE SDEL,CALLM ;MACRO IF 2\r
- JRST STMNT4 ;SYNONYM, PROCESS WITH OP-CODES\r
-\r
-STMNT3: PUSHJ PP,OPTSCH ;SEARCH OP CODE TABLE\r
- JRST STMNT5 ;NOT FOUND\r
-STMNT4: HLLZ AC0,V ;PUT CODE IN AC0\r
- TRZ V,ADDF ;CLEAR ADDRESS NON-VALID FLAG\r
- TRZE V,LITF ;VALID IN LITERAL?\r
- SKIPN LITLVL ;NO, ARE WE IN A LITERAL?\r
- JRST 0(V) ;NO, GO TO APPROPRIATE PROCESSOR\r
- POPJ PP, ;YES,EXIT\r
-\r
-STMNT5: PUSHJ PP,SSRCH ;TRY SYMBOLS\r
- JRST STMNT8 ;NOT FOUND\r
- TLNE ARG,EXTF!UNDF ;EXTERNAL OR UNDEFINED?\r
- JRST STMNT7 ;YES, PROCESS IN EVALEX\r
- TLNN RC,-2 ;CHECK FOR EXTERNAL\r
- TRNE RC,-2\r
- JRST STMNT7\r
- MOVE AC0,V ;FOUND, PUT VALUE IN AC0\r
- TLO IO,NUMSW ;FLAG AS NUMERIC\r
-STMNT7: TLZ IO,IORPTC\r
-STMNT9: PUSHJ PP,EVALHA ;EVALUATE EXPRESSION\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>\r
- TLNE FR,FSNSW ;FIELD SEEN?\r
- JRST STOW ;YES,STOW THE CODE AND EXIT\r
- CAIE C,"]"-40 ;CLOSING LITERAL?\r
- TRO ER,ERRQ ;NO, GIVE "Q" ERROR\r
- POPJ PP, ;EXIT\r
-\r
-\fSTMNT8: MOVEI V,0 ;ALWAYS START SCAN WITH 0\r
- CAIL V,CALNTH ;END OF TABLE?\r
- JRST STMN8C ;YES, TRY TTCALLS\r
- CAME AC0,CALTBL(V) ;FOUND IT?\r
- AOJA V,.-3 ;NO,TRY AGAIN\r
- SUBI V,NEGCAL ;CALLI'S START AT -1\r
- HRLI V,(CALLI) ;PUT IN UUO\r
-STMN8D: MOVSI ARG,OPDF ;SET FLAG FOR OPDEF\r
-STMN8B: PUSHJ PP,INSERT ;PUT OPDEF IN TABLE\r
- JRST OPD ;AND TREAT AS OPDEF\r
-\r
-STMN8C: SETZ V, ;START WITH ZERO\r
- CAIL V,TTCLTH ;END OF TABLE?\r
- JRST STMN8A ;YES, ERROR\r
- CAME AC0,TTCTBL(V) ;MATCH?\r
- AOJA V,.-3 ;NO, KEEP TRYING\r
- LSH V,5 ;PUT IN AC FIELD (RIGHT HALF)\r
- HRLZI V,<(TTCALL)>(V) ;PUT UUO IN LEFT HALF\r
- JRST STMN8D ;SET OPDEF FLAG\r
-\r
-STMN8A: SETZB V,RC ;CLEAR VALUE AND RELOCATION\r
- TRO ER,ERRO ;FLAG AS UNDEFINED OP-CODE\r
- JUMP1 OPD ;TREAT AS STANDARD OP ON PASS1\r
- MOVSI ARG,OPDF!UNDF!EXTF ;SET A FEW FLAGS\r
- JRST STMN8B ;TO FORCE OUT A MESSAGE\r
-\r
- ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)\r
- ;UNTIL A LINE TERMINATOR IS SEEN.\r
-STOUTS: TLOA IO,IOENDL!IORPTC\r
-STOUT: TLO IO,IORPTC\r
- PUSHJ PP,BYPAS1\r
- CAIN C,14 ;COMMA?\r
- SKIPL STPX ;YES, ERROR IF CODE STORED\r
- CAIN C,EOL\r
- TLOA IO,IORPTC\r
- TRO ER,ERRQ\r
-STOUT1: PUSHJ PP,CHARAC\r
- CAIG C,CR\r
- CAIG C,HT\r
- JRST STOUT1\r
- JRST OUTLIN ;OUTPUT THE LINE (BIN AND LST)\r
-\f SUBTTL LABEL PROCESSOR\r
- \r
-LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC\r
- JUMPE AC0,LABEL5 ;ERROR IF BLANK\r
- TLO IO,DEFCRS ;THIS IS A DEFINITION\r
- PUSHJ PP,SSRCH ;SEARCH FOR OPERAND\r
- MOVSI ARG,SYMF!UNDF!TAGF ;NOT FOUND\r
- TLNN ARG,EXTF ;OPERAND FOUND (SKIP EXIT)\r
- JRST LABEL0\r
- JUMP1 LABEL3 ;ERROR ON PASS1\r
- TLNN ARG,UNDF ;UNDEFINED ON PASS1\r
- JRST LABEL3 ;NO, FLAG ERROR\r
- TLZ ARG,EXTF!PNTF ;TURN OFF EXT FLAG NOW\r
-LABEL0: TLZN ARG,UNDF!VARF ;WAS IT PREVIOUSLY DEFINED?\r
- JRST LABEL2 ;YES, CHECK EQUALITY\r
- MOVE V,LOCA ;WFW\r
- MOVE RC,MODA\r
- TLO ARG,TAGF\r
- PUSHJ PP,PEEK ;GET NEXT CHAR.\r
- CAIE C,":" ;SPECIAL CHECK FOR ::\r
- JRST LABEL1 ;NO MATCH\r
- TLO ARG,INTF ;MAKE IT INTERNAL\r
- PUSHJ PP,GETCHR ;PROCESS NEXT CHAR.\r
- PUSHJ PP,PEEK ;PREVIEW NEXT CHAR.\r
-LABEL1: CAIE C,"!" ;HALF-KILL SIGN\r
- JRST LABEL6 ;NO\r
- TLO ARG,NOOUTF ;YES, SUPPRESS IT\r
- PUSHJ PP,GETCHR ;AND GET RID OF IT\r
-LABEL6: MOVEM AC0,TAG ;SAVE FOR PASS 1 ERRORS\r
- HLLZS TAGINC ;ZERO INCREMENT\r
- JRST INSERT ;INSERT/UPDATE AND EXIT\r
-\r
-LABEL2: HRLOM V,LOCBLK ;SAVE LIST LOCATION\r
- CAMN V,LOCA ;DOES IT COMPARE WITH PREVIOUS? WFW\r
- CAME RC,MODA\r
-LABEL3: TLOA ARG,MDFF ;NO, FLAG MULTIPLY DEFINED AND SKIP\r
- JRST LABEL7 ;YES, GET RID OF EXTRA CHARS.\r
- TRO ER,ERRM ;FLAG MULTIPLY DEFINED ERROR \r
- JRST UPDATE ;UPDATE AND EXIT\r
-\r
-LABEL4: CAMN AC0,LOCA ;DO THEY COMPARE?\r
- CAME RC,MODA\r
-LABEL5: TRO ER,ERRP ;NO, FLAG PHASE ERROR\r
- POPJ PP,\r
-\r
-LABEL7: SKIPE LITLVL ;LABEL IN A LITERAL?\r
- MOVEM AC0,LITLBL ;YES, SAVE LABEL NAME FOR LATER\r
- PUSHJ PP,PEEK ;INSPECT A CHAR.\r
- CAIN C,":" ;COLON?\r
- PUSHJ PP,GETCHR ;YES, DISPOSE OF IT\r
- PUSHJ PP,PEEK ;EXAMINE ONE MORE CHAR.\r
- CAIN C,"!" ;EXCLAMATION?\r
- JRST GETCHR ;YES, INDEED\r
-\f POPJ PP,\r
-\fSUBTTL ATOM PROCESSOR\r
-ATOM: PUSHJ PP,CELL ;GET FIRST CELL\r
- TLNE IO,NUMSW ;IF NON-NUMERIC\r
-ATOM1: CAIE C,42 ;OR NOT A BINARY SHIFT,\r
- POPJ PP, ;EXIT\r
-\r
- PUSH PP,AC0 ;STACK REGISTERS, ITS A BINARY SHIFT\r
- PUSH PP,AC1\r
- PUSH PP,RC\r
- PUSH PP,RX\r
- HRRI RX,^D10 ;COMPUTE SHIFT RADIX 10\r
- PUSHJ PP,CELLSF ;GET SHIFT\r
- MOVE ARG,RC ;SAVE RELOCATION\r
- POP PP,RX ;RESTORE REGISTERS\r
- POP PP,RC\r
- POP PP,AC1\r
- MOVN SX,AC0 ;USE NEGATIVE OF SHIFT\r
- POP PP,AC0\r
- JUMPN ARG,NUMER2 ;IF NOT ABSOLUTE\r
- TLNN IO,NUMSW ;AND NUMERIC,\r
- JRST NUMER2 ;FLAG ERROR\r
- LSHC AC0,^D35(SX)\r
- LSH RC,^D35(SX)\r
- JRST ATOM1 ;TEST FOR ANOTHER\r
-\fCELLSF: TLO IO,FLDSW\r
-CELL: SETZB AC0,RC ;CLEAR RESULT AND RELOCATION\r
- SETZB AC1,AC2 ;CLEAR WORK REGISTERS\r
- MOVEM PP,PPTEMP ;SAVE PUSHDOWN POINTER\r
- TLZ IO,NUMSW\r
- TLZA FR,NEGSW!DCFSW!RADXSW\r
-\r
-CELL1: TLO IO,FLDSW\r
- PUSHJ PP,BYPASS\r
- LDB V,[POINT 4,CSTAT(C),14] ;GET CODE\r
- XCT .+1(V) ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE\r
- JRST CELL1 ;0; BLANK, (TAB OR "+")\r
- JRST LETTER ;1; LETTER ] $ % ( ) , ; >\r
- TLC FR,NEGSW ;2; "-"\r
- TLO FR,INDSW ;3; "@"\r
- JRST NUM1 ;4; NUMERIC 0 - 9\r
- JRST ANGLB ;5; "<"\r
- JRST SQBRK ;6; "["\r
- JRST QUOTES ;7; ""","'" \r
- JRST QUAL ;10; "^"\r
- JRST PERIOD ;11; "."\r
- TROA ER,ERRQ ;12; ERROR, FLAG AND TREAT AS DELIMITER\r
- ;12; ! # & * / : = ? \ _\r
-\fLETTER: TLOA AC2,(POINT 6,AC0,) ;SET BYTE POINTER\r
-LETTE1: PUSHJ PP,GETCHR ;GET CHARACTER\r
- TLNN CS,6 ;ALPHA-NUMERIC?\r
- JRST LETTE3 ;NO,TEST FOR VARIABLE\r
- TLNE AC2,770000 ;STORE ONLY SIX BYTES\r
-LETTE2: IDPB C,AC2 ;RETURN FROM PERIOD\r
- JRST LETTE1\r
-\r
-LETTE3: CAIE C,03 ;"#"?\r
- POPJ PP,\r
- JUMPE AC0,POPOUT ;TEST FOR NULL\r
- PUSHJ PP,PEEK ;PEEK AT NEXT CHAR.\r
- CAIN C,"#" ;IS IT 2ND #?\r
- JRST LETTE4 ;YES, THEN IT'S AN EXTERN\r
- TLO IO,DEFCRS\r
- PUSHJ PP,SSRCH ;YES, SEARCH FOR SYMBOL (OPERAND)\r
- MOVSI ARG,SYMF!UNDF ;NOT FOUND, FLAGAS UNDEFINED SYM.\r
- TLNN ARG,UNDF ;UNDEFINED?\r
- JRST GETCHR ;NO, GET NEXT CHAR AND RETURN\r
- TLO ARG,VARF ;YES, FLAG AS A VARIABLE\r
- TRO ER,ERRU ;SET UNDEFINED ERROR FLAG\r
- PUSHJ PP,INSERZ ;INSERT IT WITH A ZERO VALUE\r
- JRST GETDEL\r
-\r
-LETTE4: PUSHJ PP,GETCHR ;AND SCAN PAST IT\r
- PUSHJ PP,GETCHR ;GET RID OF #\r
- JRST EXTER1 ;PUT IN SYMBOL TABLE\r
-\r
-NUMER1: SETZB AC0,RC ;RETURN ZERO\r
-NUMER2: TRO ER,ERRN ;FLAG ERROR\r
-\r
-GETDEL: PUSHJ PP,BYPASS\r
-GETDE1: JUMPE C,.-1\r
- MOVEI AC1,0\r
-GETDE3: TLO IO,NUMSW!FLDSW ;FLAG NUMERIC\r
- TLNN FR,NEGSW ;IS ATOM NEGATIVE?\r
- POPJ PP, ;NO, EXIT\r
- JUMPE AC1,GETDE2\r
- MOVNS AC1\r
- TDCA AC0,[-1]\r
-GETDE2: MOVNS AC0 ;YES, NEGATE VALUE\r
- MOVNS RC ;AND RELOCATION\r
-POPOUT: POPJ PP, ;EXIT\r
-\fQUOTES: CAIE C,"'"-40 ;IS IT "'"\r
- JRST QUOTE ;NO MUST BE """\r
- JRST SQUOTE ;YES\r
-\r
-QUOTE0: TLNE AC0,376000 ;5 CHARACTERS STORED ALREADY?\r
- TRO ER,ERRQ ;YES, GIVE WARNING\r
- ASH AC0,7\r
- IOR AC0,C\r
-QUOTE: PUSHJ PP,CHARAC ;GET 7-BIT ASCII\r
- CAIG C,15 ;TEST FOR LF, VT, FF OR CR\r
- CAIGE C,12\r
- JRST .+2 ;NO, SO ALL IS WELL\r
- JRST QUOTE2 ;ESCAPE WITH Q ERROR\r
- CAIE C,42\r
- JRST QUOTE0\r
- PUSHJ PP,PEEK ;LOOK AT NEXT CHAR.\r
- CAIE C,42\r
- JRST QUOTE1 ;RESTORE REPEAT LEVEL AND QUIT\r
- PUSHJ PP,CHARAC ;GET NEXT CHAR.\r
- JRST QUOTE0 ;USE IT\r
-\r
-QUOTE2: TRO ER,ERRQ ;SET Q ERROR\r
-QUOTE1: JRST GETDEL\r
-\r
-SQUOT0: TLNE AC0,770000 ;SIX CHARS. STORED ALREADY ?\r
- TRO ER,ERRQ ;YES\r
- LSH AC0,6\r
- IORI AC0,-40(C) ;OR IN SIXBIT CHAR.\r
-\r
-SQUOTE: PUSHJ PP,CHARAC\r
- CAIG C,CR\r
- CAIGE C,LF\r
- JRST .+2\r
- JRST QUOTE1\r
- CAIE C,"'"\r
- JRST SQUOT0\r
- PUSHJ PP,PEEK\r
- CAIE C,"'"\r
- JRST QUOTE1\r
- PUSHJ PP,CHARAC\r
- JRST SQUOT0\r
-\r
-\fQUAL: PUSHJ PP,BYPAS1 ;SKIP BLANKS, GET NEXT CHARACTER\r
- CAIN C,42 ;"B"?\r
- JRST QUAL2 ;YES, RADIX=D2\r
- CAIN C,57 ;"O"?\r
- JRST QUAL8 ;YES, RADIX=D8\r
- CAIN C,46 ;"F"?\r
- JRST NUMDF ;YES, PROCESS DECIMAL FRACTION\r
- CAIN C,54 ;"L"?\r
- JRST QUALL ;YES\r
- CAIE C,44 ;"D"?\r
- JRST NUMER1 ;NO, FLAG NUMERIC ERROR\r
- ADDI AC2,2\r
-QUAL8: ADDI AC2,6\r
-QUAL2: ADDI AC2,2\r
- PUSH PP,RX\r
- HRR RX,AC2\r
- PUSHJ PP,CELLSF\r
-QUAL2A: POP PP,RX\r
- TLNN IO,NUMSW\r
- JRST NUMER1\r
- JRST GETDE1\r
-\r
-QUALL: PUSH PP,FR\r
- PUSHJ PP,CELLSF\r
- MOVE AC2,AC0\r
- MOVEI AC0,^D36\r
- JUMPE AC2,QUAL2A\r
- LSH AC2,-1\r
- SOJA AC0,.-2\r
-\fSUBTTL LITERAL PROCESSOR\r
-\r
-SQBRK: PUSH PP,FR\r
- PUSH PP,EXTPNT ;ALLOW EXTERN TO PRECEDE LIT IN XWD\r
- SETZM EXTPNT\r
- SKIPE LITLVL ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY\r
- JRST SQB5\r
- MOVE C,SEQNO2\r
- MOVEM C,LITSEQ\r
- MOVE C,PAGENO\r
- MOVEM C,LITPG\r
-SQB5: JSP AC2,SVSTOW\r
-SQB3: PUSHJ PP,STMNT\r
- CAIN C,75 ;CHECK FOR ]\r
- JRST SQB1\r
- TLO IO,IORPTC\r
- TLNE FR,MWLFLG ;CALL IT ] IF NOT MULTI-WORD FLAG\r
- JRST SQB2 ;BUT REPEAT LAST CHARACTER\r
- PUSHJ PP,BYPAS1\r
- CAIN C,EOL\r
- TLOA IO,IORPTC\r
- TRO ER,ERRQ\r
-SQB4: PUSHJ PP,CHARAC\r
- CAIN C,";" ;COMMENT?\r
- JRST SQB6 ;YES, IGNORE SQUARE BRACKETS\r
- CAIN C,"]" ;LOOK FOR TERMINAL SQB\r
- TRNN ER,ERRORS ;IN CASE OF ERROR IN LITERAL\r
- JRST .+2 ;NO ALL IS WELL\r
- JRST SQB1 ;FINISH THE LITERAL NOW!!\r
- CAIG C,CR ;LOOK FOR END OF LINE\r
- CAIN C,HT\r
- JRST SQB4\r
-SQB4A: PUSHJ PP,OUTIML ;DUMP\r
- PUSHJ PP,CHARAC ;GET ANOTHER CHAR.\r
- SKIPL LIMBO ;CRLF FLAG\r
- TLO IO,IORPTC ;NO REPEAT\r
- JRST SQB3\r
-\r
-SQB6: PUSHJ PP,CHARAC ;GET A CHARACTER\r
- CAIG C,CR\r
- CAIN C,HT ;LOOK FOR END OF LINE CHAR.\r
- JRST SQB6 ;NOT YET\r
- JRST SQB4A ;GOT IT\r
-\r
-SQB1: TLZ IO,IORPTC\r
-SQB2: PUSHJ PP,STOLIT\r
- JSP AC2,GTSTOW\r
- SKIPE LITLBL ;NEED TO FIXUP A LABEL?\r
- PUSHJ PP,RELBLE ;YES, USE LOC OF LITERAL\r
- POP PP,EXTPNT\r
- POP PP,FR\r
- SKIPE LITLVL ;WERE WE NESTED?\r
- JUMP1 NUMER2 ;YES, FORCE ERROR IF PASS 1\r
- JRST GETDEL\r
-\r
-RELBLE: PUSH PP,AC0 ;SAVE LOCATION COUNTER\r
- PUSH PP,RC ;AND RELOCATION\r
- MOVE AC0,LITLBL ;SYMBOL WE NEED\r
- SETZM LITLBL ;ZERO INDICATOR\r
- PUSHJ PP,SSRCH ;SEARCH FOR OPERAND\r
- JRST RELBL1 ;SHOULD NEVER HAPPEN\r
- TLNN ARG,TAGF ;IT BETTER BE A LABEL\r
- JRST RELBL1 ;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE\r
- TLZ ARG,UNDF!EXTF!PNTF ;CLEAR FLAGS NOW\r
- POP PP,RC ;GET LITERAL RELOCATION\r
- MOVE V,(PP) ;GET VALUE (LOC COUNTER)\r
- PUSHJ PP,UPDATE ;UPDATE VALUE\r
- POP PP,AC0 ;RESTORE LITERAL COUNT\r
- POPJ PP, ;RETURN\r
- \r
-RELBL1: POP PP,RC ;RESTORE RC\r
- POP PP,AC0 ;AND AC0\r
- POPJ PP, ;JUST RETURN\r
-\fANGLB: PUSH PP,FR\r
- TLZ FR,INDSW\r
- PUSHJ PP,ATOM\r
- TLNN IO,NUMSW\r
- CAIE C,35\r
- JRST ANGLB1\r
- PUSHJ PP,ASSIG1\r
- MOVE AC0,V\r
- JRST ANGLB2\r
-\r
-ANGLB1: PUSHJ PP,EVALHA\r
-ANGLB2: POP PP,FR\r
- CAIE C,36\r
- TRO ER,ERRN\r
- JRST GETDEL\r
-\r
-PERIOD: PUSHJ PP,GETCHR ;LOOK AT NEXT CHARACTER\r
- TLNN CS,2 ;ALPHABETIC?\r
- JRST PERNUM ;NO, TEST NUMERIC\r
- MOVSI AC0,(SIXBIT /./) ;YES, PUT PERIOD IN AC0\r
- MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER\r
- JRST LETTE2 ;AND TREAT AS SYMBOL\r
-\r
-PERNUM: TLNE CS,4 ;IS IT A NUMBER\r
- JRST NUM32 ;YES\r
- MOVE AC0,LOCA ;NO. CURRENT LOC SYMBOL (.)\r
- MOVE RC,MODA ;SET TO CURRENT ASSEMBLY MODE\r
- JRST GETDE1 ;GET DELIMITER\r
-NUMDF: TLO FR,DCFSW ;SET DECIMAL FRACTION FLAG\r
-NUM: PUSHJ PP,GETCHR ;GET A CHARACTER\r
- TLNN CS,4 ;NUMERIC?\r
- JRST NUM10 ;NO\r
-NUM1: SUBI C,20 ;CONVERT TO OCTAL\r
- PUSH PP,C ;STACK FOR FLOATING POINT\r
- MOVE AC0,AC1\r
- MULI AC0,0(RX)\r
- ADD AC1,C ;ADD IN LAST VALUE\r
- CAIL C,0(RX) ;IS NUMBER LESS THAN CURRENT RADIX?\r
- TLO FR,RADXSW ;NO, SET FLAG\r
- AOJA AC2,NUM ;YES, AC2=NO. OF DECIMAL PLACES\r
-\r
-\fNUM10: CAIE C,16 ;PERIOD?\r
- TLNE FR,DCFSW ;OR DECIMAL FRACTION?\r
- JRST NUM30 ;YES, PROCESS FLOATING POINT\r
- LSH AC1,1 ;NO, CLEAR THE SIGN BIT\r
- LSHC AC0,^D35 ;AND SHIFT INTO AC0\r
- MOVE PP,PPTEMP ;RESTORE PP\r
- SOJE AC2,GETDE1 ;NO RADIX ERROR TEST IF ONE DIGIT\r
- TLNE FR,RADXSW ;WAS ILLEGAL NUMBER ENCOUNTERED?\r
- TRO ER,ERRN ;YES, FLAG N ERROR\r
- JRST GETDE1\r
-\r
-NUM30: CAIE C,"B"-40 ;IF "B" THEN MISSING "."\r
-NUM31: PUSHJ PP,GETCHR\r
- TLNN CS,4 ;NUMERIC?\r
- JRST NUM40 ;NO\r
-NUM32: SUBI C,20\r
- PUSH PP,C\r
- JRST NUM31\r
-\r
-NUM40: PUSH PP,FR ;STACK VALUES\r
- HRRI RX,^D10\r
- PUSH PP,AC2\r
- PUSH PP,PPTEMP\r
- CAIN C,45 ;"E"?\r
- JRST [PUSHJ PP,PEEK ;GET NEXT CHAR\r
- PUSH PP,C ;SAVE NEXT CHAR\r
- PUSHJ PP,CELL ;YES, GET EXPONENT\r
- POP PP,C ;GET FIRST CHAR. AFTER E\r
- CAIN V,4 ;MUST HAVE NUMERICAL STATUS\r
- JRST .+2 ;SKIP RETURN\r
- CAIN C,"<" ;ALLOW <EXP>\r
- JRST .+2 ;SKIP RETURN\r
- SKIPN AC0 ;ERROR IF NON-ZERO EXPRESSION\r
- TROA ER,ERRQ ;ALLOW E+,E-\r
- SETOM RC ;FORCE NUMERICAL ERROR\r
- JRST .+2] ;SKIP RETURN\r
- MOVEI AC0,0 ;NO, ZERO EXPONENT\r
- POP PP,PPTEMP\r
- POP PP,SX\r
- POP PP,FR\r
- HRRZ V,PP\r
- MOVE PP,PPTEMP\r
- JUMPN RC,NUMER1 ;EXPONENT MUST BE ABSOLUTE\r
- ADD SX,AC0\r
- HRRZ ARG,PP\r
- ADD SX,ARG\r
- SETZB AC0,AC2\r
- TLNE FR,DCFSW\r
- JRST NUM60\r
- JOV NUM50 ;CLEAR OVERFLOW FLAG\r
-\f\r
-NUM50: JSP SDEL,NUMUP ;FLOATING POINT\r
- JRST NUM52 ;END OF WHOLE NUMBERS\r
- FMPR AC0,[10.0] ;MULTIPLY BY 10\r
- TLO AC1,233000 ;CONVERT TO FLOATING POINT\r
- FADR AC0,AC1 ;ADD IT IN\r
- JRST NUM50\r
-\r
-NUM52: JSP SDEL,NUMDN ;PROCESS FRACTION\r
- FADR AC0,AC2\r
- JOV NUMER1 ;TEST FOR OVERFLOW\r
- JRST GETDE1\r
-\r
- TLO AC1,233000\r
- TRNE AC1,-1\r
- FADR AC2,AC1 ;ACCUMULATE FRACTION\r
- FDVR AC2,[10.0]\r
- JRST NUM52\r
-\r
-NUM60: JSP SDEL,NUMUP\r
- JRST NUM62\r
- IMULI AC0,^D10\r
- ADD AC0,AC1\r
- JRST NUM60\r
-\r
-NUM62: LSHC AC1,-^D36\r
- JSP SDEL,NUMDN\r
- LSHC AC1,^D37\r
- PUSHJ PP,BYPAS2\r
- JRST GETDE3\r
-\r
- DIVI AC1,^D10\r
- JRST NUM62\r
-\r
-NUMUP: MOVEI AC1,0\r
- CAML ARG,SX\r
- JRST 0(SDEL)\r
- CAMGE ARG,V\r
- MOVE AC1,1(ARG)\r
- AOJA ARG,1(SDEL)\r
-\r
-NUMDN: MOVEI AC1,0\r
- CAMG V,SX\r
- JRST 0(SDEL)\r
- CAMLE V,ARG\r
- MOVE AC1,0(V)\r
- SOJA V,3(SDEL)\r
-\fSUBTTL GETSYM\r
-GETSYM: MOVEI AC0,0 ;CLEAR AC0\r
- MOVSI AC1,(POINT 6,AC0) ;PUT POINTER IN AC1\r
- PUSHJ PP,BYPASS ;SKIP LEADING BLANKS\r
- TLNN CS,2 ;ALPHABETIC?\r
- JRST GETSY1 ;NO, ERROR\r
- CAIE C,16 ;PERIOD?\r
- JRST GETSY2 ;NO, A VALID SYMBOL\r
- IDPB C,AC1 ;STORE THE CHARACTER\r
- PUSHJ PP,GETCHR ;YES, TEST NEXT CHARACTER\r
- TLNN CS,2 ;ALPHABETIC?\r
-GETSY1: TROA ER,ERRA\r
-GETSY2: AOS 0(PP) ;YES, SET SKIP EXIT\r
-GETSY3: TLNN CS,6 ;ALPHA-NUMERIC?\r
- JRST BYPAS2 ;NO, GET DELIMITER\r
- TLNE AC1,770000 ;YES, HAVE WE STORED SIX?\r
- IDPB C,AC1 ;NO, STORE IT\r
- PUSHJ PP,GETCHR\r
- JRST GETSY3\r
-\r
-\fSUBTTL EXPRESSION EVALUATOR\r
-CV== AC0 ;CURRENT VALUE\r
-PV== AC1 ;PREVIOUS VALUE\r
-RC== RC ;CURRENT RELOCATABILITY\r
-PR== AC2 ;PREVIOUS RELOCATABILITY\r
-CS= CS ;CURRENT STATUS\r
-PS== SDEL ;PREVIOUS STATUS\r
-\r
-EVALHA: TLO FR,TMPSW\r
-EVALCM: PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION\r
- PUSH PP,[0] ;MARK PDL\r
- JUMPCM EVALC3 ;JUMP IF COMMA\r
- TLO IO,IORPTC ;IT'S NOT,SO REPEAT\r
- JRST OP ;PROCESS IN OP\r
-EVALC3:\r
-IFN FORMSW,<PUSH PP,INFORM ;PUT FORM WORD ON STACK>\r
- PUSH PP,[0] ;STORE ZERO'S ON PDL\r
- PUSH PP,[0] ;.......\r
- MOVSI AC2,(POINT 4,(PP),12)\r
- JRST OP1B ;PROCESS IN OP\r
-\r
-EVALEX: TLO IO,FLDSW\r
- PUSH PP,[XWD TNODE,0] ;MARK THE LIST 200000,,0\r
- TLZN FR,TMPSW\r
-EVATOM: PUSHJ PP,ATOM ;GET THE NEXT ATOM\r
- JUMPE AC0,EVGETD ;TEST FOR NULL/ZERO\r
- TLOE IO,NUMSW ;SET NUMERIC, WAS IT PREVIOUSLY?\r
- JRST EVGETD+1 ;YES, TREAT ACCORDINGLY\r
- PUSHJ PP,SEARCH ;SEARCH FOR MACRO OR SYMBOL\r
- JRST EVOP ;NOT FOUND, TRY FOR OP-CODE\r
- JUMPL ARG,.+2 ;SKIP IF OPERAND\r
- PUSHJ PP,SSRCH1 ;OPERATOR, TRY FOR SYMBOL (OPERAND)\r
- PUSHJ PP,QSRCH ;PERFORM CROSS-REFERENCE\r
- JUMPG ARG,EVMAC ;BRANCH IF OPERATOR\r
- MOVE AC0,V ;SYMBOL, SET VALUE\r
- JRST EVTSTS ;TEST STATUS\r
-\r
-EVMAC: TLNE FR,NEGSW ;UNARY MINUS?\r
- JRST EVERRZ ;YES, INVALID BEFORE OPERATOR\r
- LDB SDEL,[POINT 3,ARG,5] ;GET MACF/OPDF/SYNF\r
- SOJL SDEL,EVERRZ ;ERROR IF NO FLAGS\r
-\r
- JUMPE C,.+2 ;NON-BLANK?\r
- TLO IO,IORPTC ;YES, REPEAT CHARACTER\r
- SOJE SDEL,CALLM ;MACRO IF 2\r
- JUMPG SDEL,EVOPS ;SYNONYM IF 4\r
-\r
- MOVE AC0,V ;OPDEF\r
- MOVEI V,OP ;SET TRANSFER VECTOR\r
- JRST EVOPD\r
-\fEVOP: TLNE FR,NEGSW ;OPCODE, UNARY MINUS?\r
- JRST EVERRZ ;YES, ERROR\r
-\r
- PUSHJ PP,OPTSCH ;SEARCH SYMBOL TABLE\r
- JRST EVOPX ;NOT FOUND\r
-EVOPS: TRZ V,LITF ;CLEAR LIT INVALID FLAG\r
- TRZE V,ADDF ;SYNONYM\r
- JRST EVOPX ;PSEUDO-OP THAT GENERATES NO DATA JUMPS\r
- HLLZ AC0,V\r
-EVOPD: JUMPE C,.+2 ;OPDEF, NON-BLANK DELIMITER?\r
- TLO IO,IORPTC ;YES, REPEAT CHARACTER\r
- JSP AC2,SVSTOW\r
- PUSHJ PP,0(V)\r
- PUSHJ PP,DSTOW\r
- JSP AC2,GTSTOW\r
- TRNE RC,-2\r
- HRRM RC,EXTPNT\r
- TLNE RC,-2\r
- HLLM RC,EXTPNT\r
- JRST EVNUM\r
-\r
-EVOPX: MOVSI ARG,SYMF!UNDF\r
- PUSHJ PP,INSERZ\r
-EVERRZ: SETZB AC0,RC ;CLEAR CODE AND RELOCATION\r
-EVERRU: TRO ER,ERRU\r
- JRST EVGETD\r
-\fEVTSTS: TLNE ARG,UNDF\r
- JRST [TRO ER,ERRU ;SET UNDEF ERROR\r
- JUMP1 EVGETD ;TREAT AS UNDF ON PASS1\r
- JRST .+1] ;TREAT AS EXTERNAL ON PASS2\r
- TLNN ARG,EXTF\r
- JRST EVTSTR\r
- HRRZ RC,ARG ;GET ADRES WFW\r
- HRRZ ARG,EXTPNT ;SAVE IT WFW\r
- HRRM RC,EXTPNT ;WFW\r
- TRNE ARG,-1 ;WFW\r
- TRO ER,ERRE\r
- SETZB AC0,ARG\r
-\r
-EVTSTR: TLNE ARG,MDFF ;MULTIPLY DEFINED?\r
- TRO ER,ERRD ;YES, FLAG IT\r
- TLNE FR,NEGSW ;NEGATIVE ATOM?\r
- PUSHJ PP,GETDE2 ;YES, NEGATE AC0 AND RC\r
-\r
-EVGETD: TLNE IO,NUMSW ;NON BLANK FIELD\r
- TLO FR,FSNSW ;YES,SET FLAG\r
- PUSHJ PP,BYPAS2\r
- TLNE CS,6 ;ALPHA-NUMERIC?\r
- TLO IO,IORPTC ;YES, REPEAT IT\r
-EVNUM: POP PP,PS ;POP THE PREVIOUS DELIMITER/TNODE\r
- TLO PS,4000\r
- CAMGE PS,CS ;OPERATION REQUIRED?\r
- JRST EVPUSH ;NO, PUT VALUES BACK ON STACK\r
- TLNN PS,TNODE ;YES, HAVE WE REACHED TERMINAL NODE?\r
- JRST EVXCT ;NO, EXECUTION REQUIRED\r
- TLNN CS,170000 ;YES, ARE WE POINTING AT DEL? (& ! * / + - _)\r
- POPJ PP, ;YES, EXIT\r
- ;NO,FALL INTO EVPUSH\r
-\r
-\fEVPUSH: PUSH PP,PS ;STACK VALUES\r
- PUSH PP,CV\r
- PUSH PP,RC\r
- PUSH PP,CS\r
- JRST EVATOM ;GET NEXT ATOM\r
-\r
-EVXCT: POP PP,PR ;POP PREVIOUS RELOCATABILITY\r
- POP PP,PV ;AND PREVIOUS VALUE\r
- LDB PS,[POINT 3,PS,29] ;TYPE OF OPERATION TO PS\r
- JRST .+1(PS) ;PERFORM PROPER OPERATION\r
- JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN\r
- JRST XMUL ;1;\r
- JRST XDIV ;2;\r
- JRST XADD ;3;\r
- JRST XSUB ;4;\r
- JRST XLRW ;5; "_"\r
- TDOA CV,PV ;6; MERGE PV INTO CV\r
- AND CV,PV ;7; AND PV INTO CV\r
- JUMPN RC,.+2 ;COMMON RELOCATION TEST\r
-EVXCT1: JUMPE PR,EVNUM\r
- TRO ER,ERRR ;BOTH MUST BE FIXED\r
- JRST EVNUM ;GO TRY AGAIN\r
-\r
-XSUB: SUBM PV,CV\r
- SUBM PR,RC\r
- JRST EVNUM\r
-\r
-XADD: ADDM PV,CV\r
- ADDM PR,RC\r
- JRST EVNUM\r
-\r
-XDIV: IDIV PR,CV ;CORRECT RELOCATABILITY\r
- IDIVM PV,CV\r
-XDIV1: EXCH PR,RC ;TAKE RELOCATION OF NUMERATOR\r
- JRST EVXCT1\r
-\r
-XMUL: JUMPE PR,XMUL1 ;AT LEAST ONE OPERAND\r
- JUMPE RC,XMUL1 ;MUST BE FIXED\r
- TRO ER,ERRR\r
-XMUL1: IORM PR,RC ;GET RELOCATION TO RC\r
- CAMGE PV,CV ;FIND THE GREATER\r
- EXCH PV,CV ;FIX IN CASE CV=0,OR 1\r
- IMULM PV,RC\r
- IMULM PV,CV\r
- JRST EVNUM\r
-XLRW: EXCH PV,CV\r
- LSH CV,0(PV)\r
- LSH PR,0(PV)\r
- JRST XDIV1\r
-\f SUBTTL LITERAL STORAGE HANDLER\r
- \r
-STOLER:\r
-IFE FORMSW,< SETZB AC0,RC ;ERROR, NO CODE STORED\r
- PUSHJ PP,STOW ;STOW ZERO>\r
-IFN FORMSW,< MOVEI AC0,0\r
- PUSHJ PP,STOWZ1>\r
- TRO ER,ERRL ;AND FLAG THE ERROR\r
-\r
-STOLIT: MOVE SDEL,STPX\r
- SUB SDEL,STPY ;COMPUTE NUMBER OF WORDS\r
- JUMPE SDEL,STOLER ;ERROR IF NONE STORED\r
- TRNN ER,ERRORS ;ANY ERRORS?\r
- JRST STOL06 ;NO\r
- JUMP2 STOL22 ;YES, NO SEARCH. BRANCH IF PASS2\r
- ADDM SDEL,LITCNT ;PASS ONE, UPDATE COUNT\r
- JRST STOWI ;INITIALIZE STOW\r
-\r
-STOL06: MOVEI SX,LITAB ;PREPARE FOR SEARCH\r
- MOVE ARG,STPX ;SAVE IN THE EVENT OF MULTIPLE-WORD\r
- HRL ARG,STPY\r
- MOVE AC2,LITNUM\r
- MOVEI SDEL,0\r
-STOL08: PUSHJ PP,DSTOW ;GET VALUE WFW\r
-\r
-STOL10: SOJL AC2,STOL24 ;TEST FOR END\r
- MOVE SX,0(SX) ;NO, GET NEXT STORAGE CELL\r
- MOVE V,-1(SX) ;GET RELOCATION BITS WFW\r
- CAMN AC0,-2(SX) ;DO CODES COMPARE? WFW\r
- CAME RC,V ;YES, HOW ABOUT RELOCATION?\r
- AOJA SDEL,STOL10 ;NO, TRY AGAIN\r
- SKIPGE STPX ;YES, MULTI-WORD?\r
- JRST STOL26 ;NO, JUST RETURN LOCATION\r
- MOVEM AC2,SAVBLK+AC2 ;YES, SAVE STARTING INFO\r
- MOVEM SX,SAVBLK+SX\r
-\r
-STOL12: SOJL AC2,STOL23 ;TEST FOR END\r
- PUSHJ PP,DSTOW ;GET NEXT WORD WFW\r
- MOVE SX,0(SX) ;UPDATE POINTER\r
- MOVE V,-1(SX) ;GET RELOCATION WFW\r
- CAMN AC0,-2(SX) ;COMPARE VALUE WFW\r
- CAME RC,V ;AND RELOCATION\r
- JRST STOL14 ;NO MATCH, TRY AGAIN\r
- SKIPL STPX ;MATCH, HAVE WE FINISHED SEARCH?\r
- JRST STOL12 ;NO, TRY NEXT WORD\r
- JRST STOL26 ;YES, RETURN LOCATION\r
-\r
-STOL14: MOVE AC2,SAVBLK+AC2 ;RESTORE STOW POINTERS\r
- MOVE SX,SAVBLK+SX\r
- HRREM ARG,STPX\r
- HLREM ARG,STPY\r
- AOJA SDEL,STOL08 ;BETTER LUCK NEXT TIME\r
-\f\r
-STOL22: MOVE SDEL,LITNUM\r
-STOL23: PUSHJ PP,DSTOW ;DSTOW AND CONVERT\r
-STOL24: MOVE SX,LITABX ;GET CURRENT STORAGE\r
- PUSHJ PP,GETTOP ;GET NEXT CELL\r
- MOVEM AC0,-2(SX) ;STORE CODE WFW\r
- MOVEM RC,-1(SX) ;WFW\r
-IFN FORMSW,<\r
- MOVE AC0,FORM\r
- MOVEM AC0,-3(SX)>\r
- MOVEM SX,LITABX ;SET POINTER TO CURRENT CELL\r
- AOS LITNUM ;INCREMENT NUMBER STORED\r
- AOS LITCNT ;INCREMENT NUMBER RESERVED\r
- SKIPL STPX ;ANY MORE CODE?\r
- JRST STOL23 ;YES\r
-STOL26: JUMP1 POPOUT ;EXIT IF PASS ONE\r
- MOVE SX,LITHDX ;GET HEADER BLOCK\r
- HLRZ RC,-1(SX) ;GET BLOCK RELOCATION\r
- HRRZ AC0,-1(SX)\r
- ADDI AC0,0(SDEL) ;COMPUTE ACTUAL LOCATION\r
- POPJ PP, ;EXIT\r
-\r
-\fSUBTTL INPUT ROUTINES\r
-GETCHR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
- CAIL C,"A"+40 ;CHECK FOR LOWER CASE\r
- CAILE C,"Z"+40\r
- JRST .+2 ;NOT LOWER CASE\r
-IFN STANSW,<\r
- SUBI C,40\r
- CAIN C,32\r
- MOVEI C,136 ;^\r
- CAIN C,30\r
- MOVEI C,137 ;_\r
- CAIN C,176\r
- MOVEI C,134 ;}\r
- CAIN C,140\r
- MOVEI C,100 ;@>\r
-IFE STANSW,<\r
- TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT>\r
- SUBI C,40 ;CONVERT TO SIXBIT\r
- CAIG C,77 ;CHAR GREATER THAN SIXBIT?\r
- JUMPGE C,GETCS ;TEST FOR VALID SIXBIT\r
- ADDI C,40 ;BACK TO ASCII\r
- CAIN C,HT ;CHECK FOR TAB\r
- JRST GETCS2 ;MAKE IT LOOK LIKE SPACE\r
- CAIG C,CR ;GREATER THAN CR\r
- CAIG C,HT ;GREATER THAN TAB\r
- JRST GETCS1 ;IS NOT FF,VT,LF OR CR\r
- MOVEI C,EOL ;LINE OR FORM FEED OR V TAB\r
- TLOA IO,IORPTC ;REPEAT CHARACTER\r
-GETCS2: MOVEI C,0 ;BUT TREAT AS BLANK\r
-GETCS: MOVE CS,CSTAT(C) ;GET STATUS BITS\r
- POPJ PP, ;EXIT\r
-\r
-GETCS1: JUMPE C,GETCS ;IGNORE NULS\r
- TRC C,100 ;MAKE CHAR. VISIBLE\r
- MOVEI CS,"^"\r
- DPB CS,LBUFP ;PUT ^ IN OUTPUT\r
- PUSHJ PP,RSW2 ;ALSO MODIFIED CHAR.\r
- TRO ER,ERRQ ;FLAG Q ERROR\r
- JRST GETCHR ;BUT IGNORE CHAR.\r
-\f\r
-CHARAC: TLZE IO,IORPTC ;REPEAT REQUESTED?\r
- JRST CHARAX ;YES\r
-RSW0: JUMPN MRP,MREAD ;BRANCH IF TREE POINTER SET\r
- PUSHJ PP,READ\r
-RSW1: SKIPE RPOLVL ;ARE WE IN "REPEAT ONCE"?\r
- JRST REPO1 ;YES\r
-RSW2: MOVE CS,LIMBO ;GET LAST CHAR.\r
- MOVEM C,LIMBO ;STORE THIS CHAR. FOR RPTC\r
- CAIN C,LF ;LF?\r
- CAIE CS,CR ;YES,LAST CHAR. A CR?\r
- JRST RSW3 ;NO\r
- HRROS LIMBO ;YES,FLAG\r
- POPJ PP, ;AND EXIT\r
-\r
-RSW3: TLNE IO,IOSALL ;MACRO SUPPRESS ALL?\r
- JUMPN MRP,CPOPJ ;YES,DON'T LIST IN MACRO\r
- SOSG CPL ;ANY ROOM IN THE IMAGE BUFFER?\r
- PUSHJ PP,OUTPL ;NO, OUTPUT THE PARTIAL LINE\r
- IDPB C,LBUFP ;YES, STORE IN PRINT AREA\r
- CAIE C,HT ;TAB?\r
- POPJ PP, ;NO, EXIT\r
- MOVEI C,7\r
- ANDCAM C,CPL ;MASK\r
-CHARAX: HRRZ C,LIMBO ;GET LAST CHARACTER\r
- POPJ PP, ;EXIT\r
-\r
-CHARL: PUSHJ PP,CHARAC ;GET AND TEST 7-BIT ASCII\r
- CAIG C,FF ;LINE OR FORM FEED OR VT?\r
- CAIGE C,LF\r
- POPJ PP, ;NO,EXIT\r
- SKIPE LITLVL ;IN LITERAL?\r
- JRST OUTIML ;YES\r
-CHARL1: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
- PUSHJ PP,OUTLIN ;DUMP THE LINE\r
- JRST RSTRXS ;RESTORE REGISTERS AND EXIT\r
-\fSUBTTL CHARACTER STATUS TABLE\r
-\r
- DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)\r
-<BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>\r
-\r
- ;OPLVL PRIORITY OF BINARY OPERATORS\r
- ;ATOM INDEX TO JUMP TABLE AT CELL1\r
- ;AN TYPE OF CHARACTER\r
- ; 1=OTHER, 2=ALPHA, 4=NUMERIC\r
- ;SQUOZ VALUE IN RADIX 50\r
- ;OPTYPE INDEX TO JUMP TABLE AT EVXCT\r
- ;SEQNO VALUE IN SIXBIT\r
-CSTAT:\r
- GENCS 00,00,1,00,00,00 ; ' '\r
- GENCS 04,12,1,00,06,01 ; '!'\r
- GENCS 00,07,1,00,00,02 ; '"'\r
- GENCS 00,12,1,00,00,03 ; '#'\r
- GENCS 00,01,2,46,00,04 ; '$'\r
- GENCS 00,01,2,47,00,05 ; '%'\r
- GENCS 04,12,1,00,07,06 ; '&'\r
- GENCS 00,07,1,00,00,07 ; '''\r
-\r
- GENCS 00,01,1,00,00,10 ; '('\r
- GENCS 00,01,1,00,00,11 ; ')'\r
- GENCS 02,12,1,00,01,12 ; '*'\r
- GENCS 01,00,1,00,03,13 ; '+'\r
- GENCS 40,01,1,00,00,14 ; ','\r
- GENCS 01,02,1,00,04,15 ; '-'\r
- GENCS 00,11,2,45,00,16 ; '.'\r
- GENCS 02,12,1,00,02,17 ; '/'\r
-\r
- GENCS 00,04,4,01,00,20 ; '0'\r
- GENCS 00,04,4,02,00,21 ; '1'\r
- GENCS 00,04,4,03,00,22 ; '2'\r
- GENCS 00,04,4,04,00,23 ; '3'\r
- GENCS 00,04,4,05,00,24 ; '4'\r
- GENCS 00,04,4,06,00,25 ; '5'\r
- GENCS 00,04,4,07,00,26 ; '6'\r
- GENCS 00,04,4,10,00,27 ; '7'\r
-\r
- GENCS 00,04,4,11,00,30 ; '8'\r
- GENCS 00,04,4,12,00,31 ; '9'\r
- GENCS 00,12,1,00,00,32 ; ':'\r
- GENCS 00,01,1,00,00,33 ; ';'\r
- GENCS 00,05,1,00,00,34 ; '<'\r
- GENCS 00,12,1,00,00,35 ; '='\r
- GENCS 00,01,1,00,00,36 ; '>'\r
- GENCS 00,12,1,00,00,37 ; '?'\r
-\f GENCS 00,03,1,00,00,40 ; '@'\r
- GENCS 00,01,2,13,00,41 ; 'A'\r
- GENCS 00,01,2,14,00,42 ; 'B'\r
- GENCS 00,01,2,15,00,43 ; 'C'\r
- GENCS 00,01,2,16,00,44 ; 'D'\r
- GENCS 00,01,2,17,00,45 ; 'E'\r
- GENCS 00,01,2,20,00,46 ; 'F'\r
- GENCS 00,01,2,21,00,47 ; 'G'\r
-\r
- GENCS 00,01,2,22,00,50 ; 'H'\r
- GENCS 00,01,2,23,00,51 ; 'I'\r
- GENCS 00,01,2,24,00,52 ; 'J'\r
- GENCS 00,01,2,25,00,53 ; 'K'\r
- GENCS 00,01,2,26,00,54 ; 'L'\r
- GENCS 00,01,2,27,00,55 ; 'M'\r
- GENCS 00,01,2,30,00,56 ; 'N'\r
- GENCS 00,01,2,31,00,57 ; 'O'\r
-\r
- GENCS 00,01,2,32,00,60 ; 'P'\r
- GENCS 00,01,2,33,00,61 ; 'Q'\r
- GENCS 00,01,2,34,00,62 ; 'R'\r
- GENCS 00,01,2,35,00,63 ; 'S'\r
- GENCS 00,01,2,36,00,64 ; 'T'\r
- GENCS 00,01,2,37,00,65 ; 'U'\r
- GENCS 00,01,2,40,00,66 ; 'V'\r
- GENCS 00,01,2,41,00,67 ; 'W'\r
-\r
- GENCS 00,01,2,42,00,70 ; 'X'\r
- GENCS 00,01,2,43,00,71 ; 'Y'\r
- GENCS 00,01,2,44,00,72 ; 'Z'\r
- GENCS 00,06,1,00,00,73 ; '['\r
- GENCS 00,12,1,00,00,74 ; '\'\r
- GENCS 00,01,1,00,00,75 ; ']'\r
- GENCS 00,10,1,00,00,76 ; '^'\r
- GENCS 10,12,1,00,05,77 ; '_'\r
-\fSUBTTL LISTING ROUTINES\r
-\r
-OUTLIN: TRNN ER,ERRORS-ERRQ ;ANY ERRORS?\r
- TLNE FR,ERRQSW ;NO, IGNORE Q ERRORS?\r
- TRZ ER,ERRQ ;YES, YES, ZERO THE Q ERROR\r
- HRLZ AC0,ER ;PUT ERROR FLAGS IN AC0 LEFT\r
- TDZ ER,TYPERR\r
- JUMP1 OUTL30 ;BRANCH IF PASS ONE\r
- JUMPN AC0,OUTL02 ;JUMP IF ANY ERRORS TO FORCE PRINTING\r
- SKIPL STPX ;SKIP IF NO CODE, OTHERWISE\r
- JRST OUTL01 ;NO\r
- TLNN IO,IOSALL ;YES,SUPPRESS ALL?\r
- JRST OUTL03 ;NO\r
- JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO\r
- LDB C,[XWD 350700,LBUF]\r
- CAIE C,15 ;FIRST CHAR CR?\r
-OUTL01: TLZ IO,IOMAC ;FORCE MACRO PRINTING\r
-OUTL03: TLNN IO,IOMSTR!IOPROG!IOMAC\r
-OUTL02: IOR ER,OUTSW ;FORCE IT.\r
- IDPB AC0,LBUFP ;STORE ZERO TERMINATOR AFTER ASCII SRC LINE\r
- TLNN FR,CREFSW ;CREF?\r
- PUSHJ PP,CLSCRF ;YES, WRITE END OF CREF DATA (177,003)\r
- JUMPE AC0,OUTL20 ;BRANCH IF NO ERRORS\r
- TLZE AC0,ERRM ;M ERROR?\r
- TLO AC0,ERRP ;M ERROR SET - SET P ERROR.\r
- PUSHJ PP,OUTLER ;PROCESS ERRORS\r
-\r
-OUTL20: SKIPN RC,ASGBLK\r
- SKIPE CS,LOCBLK ;\r
- SKIPL STPX ;ANY BINARY?\r
- JRST OUTL23 ;YES, JUMP\r
- JUMPE RC,OUTL22 ;SEQUENCE BREAK AND NO BINARY JUMPS\r
- ILDB C,TABP ;ASSIGNMENT FALLS THROUGH\r
- PUSHJ PP,OUTL ;OUTPUT A TAB.\r
- ILDB C,TABP ;OUTPUT 2ND TAB, LOCATION FIELD\r
- PUSHJ PP,OUTC ;NEXT IS BINARY LISTING FIELD\r
- HLLO CS,LOCBLK ;LEFT HALF OF A 36BIT VALUE\r
- JUMPL RC,.+2 ;SKIP IF LEFT HALF IS NOT RELOC\r
- TRZA CS,1 ;IT IS, SET THE FLAG\r
- TLNE CS,-1 ;SKIP IF ITS A 18BIT VALUE, OTHERWISE\r
- PUSHJ PP,ONC1 ;PRINT LH OF A 36 BIT VALUE IN CS\r
- HRLO CS,LOCBLK ;PICK UP THE RIGHT HALF (18BIT VALUE)\r
- TRZ CS,0(RC) ;\r
- PUSHJ PP,ONC ;PRINT IT\r
- JRST OUTL23 ;SKIP SINGLE QUOTE TEST\r
-\fOUTL22: PUSHJ PP,ONC ;TAB TO RH AND PRINT IT\r
- MOVEI C,"'"\r
- SKIPE MODA\r
- PUSHJ PP,OUTC\r
-OUTL23: SKIPL STPX ;ANY BINARY?\r
- PUSHJ PP,BOUT ;YES, DUMP IT\r
- MOVE CS,@OUTLI2 ;[POINT 7,LBUF]\r
-OUTL24: ILDB C,CS\r
- JUMPE C,OUTL25\r
- CAIG C," "\r
- JRST OUTL24\r
- MOVE CS,TABP\r
- PUSHJ PP,OUTASC ;OUTPUT TABS\r
-OUTL25: MOVEI CS,LBUF\r
- PUSHJ PP,OUTAS0 ;DUMP THE LINE\r
- TLNE IO,IOSALL ;SUPPRESSING ALL\r
- JUMPN MRP,OUTL27 ;YES,EXTRA CR IF IN MACRO\r
-OUTL26: SKIPGE STPX ;ANY BINARY?\r
- JRST OUTLI ;NO, CLEAN UP AND EXIT\r
- PUSHJ PP,OUTLI2 ;YES, INITIALIZE FOR NEXT LINE\r
- PUSHJ PP,BOUT ;YES, DUMP IT\r
-OUTL27: PUSHJ PP,OUTCR ;OUTPUT CARRIAGE RETURN\r
- JRST OUTL26 ;TEST FOR MORE BINARY\r
-\r
-OUTPL: SKIPN LITLVL ;IF IN LITERAL\r
- SKIPL STPX ;OR CODE GENERATED\r
- JRST OUTIM ;JUST OUTPUT THE IMAGE\r
- SKIPN ASGBLK ;SKIP IF AN ASSIGNMENT\r
- JRST OUTIM ;OTHERWISE OUTPUT IMAGE\r
- PUSH PP,C ;SAVE CHAR.\r
- MOVEI C,CR\r
- IDPB C,LBUFP\r
- MOVEI C,LF\r
- IDPB C,LBUFP ;FINISH WITH CRLF\r
- PUSHJ PP,OUTLIN ;OUTPUT PARTIAL LINE\r
- POP PP,C ;RESTORE CHAR.\r
- JRST OUTLI2 ;INITIALISE REST OF LINE\r
-\fOUTL30: AOS CS,STPX ;PASS ONE\r
- ADDM CS,LOCO ;INCREMENT OUTPUT LOCATION\r
- PUSHJ PP,STOWI ;INITIALIZE STOW\r
- TLZ AC0,ERRORS-ERRM-ERRP-ERRV\r
- JUMPN AC0,OUTL32 ;JUMP IF ERRORS\r
- TLNE IO,IOSALL ;SUPPRESSING ALL/\r
- JUMPN MRP,CPOPJ ;YES,EXIT\r
- JRST OUTLI1 ;NO,INIT LINE\r
-\r
-OUTL32: IDPB AC0,LBUFP ;ZERO TERNIMATOR\r
- IOR ER,OUTSW ;LIST ERRORS\r
- MOVEI CS,TAG\r
- PUSHJ PP,OUTSIX ;OUTPUT TAG\r
- HRRZ C,TAGINC\r
- PUSHJ PP,DNC ;CONVERT INCREMENT TO DECIMAL\r
- PUSHJ PP,OUTTAB ;OUTPUT TAB\r
- PUSHJ PP,OUTLER ;OUTPUT ERROR FLAGS\r
- PUSHJ PP,OUTTAB\r
- MOVEI CS,SEQNO ;ADDRESS OF SEQUENCE NO.\r
- SKIPE SEQNO ;FILE NOT SEQUENCED\r
- PUSHJ PP,OUTAS0 ;OUTPUT IT\r
- JRST OUTL25 ;OUTPUT BASIC LINE\r
-\r
-OUTLER: PUSH PP,ER ;SAVE LISTING SWITCHES FOR LATER\r
- TRNE ER,TTYSW ;IF THIS IS ON, LISTING IS ON TTY\r
- TRZ ER,ERRORS ;SO SUPPRESS ON TTY\r
- TDZ ER,OUTSW ;BUT THIS SHOULD ONLY GO TO THE TTY\r
- MOVE CS,INDIR ;GET FILE NAME\r
- CAME CS,LSTFIL ;AND SEE IF SAME\r
- JRST [MOVEM CS,LSTFIL ;SAVE AS LAST ONE\r
- MOVEI CS,LSTFIL\r
- PUSHJ PP,OUTSIX ;LIST NAME\r
- MOVEI C," "\r
- PUSHJ PP,OUTL\r
- MOVE CS,PAGENO ;PRINT PAGE NUMBER TOO\r
- JRST OUTLE8]\r
- MOVE CS,PAGENO ;NOW CHECK PAGE NUMBER\r
- CAME CS,LSTPGN\r
-OUTLE8: JRST [MOVEM CS,LSTPGN\r
- MOVEI CS,[ASCIZ /PAGE /]\r
- PUSHJ PP,OUTAS0\r
- MOVE C,PAGENO\r
- PUSHJ PP,DNC\r
- PUSHJ PP,OUTCR ;AND NOW FOR THE ERROR LINE\r
- JRST .+1]\r
- HLLM ER,(PP) ;RESTORE ER BUT NOT IO (LEFT HALF OF AC)\r
- POP PP,ER\r
- MOVE CS,[POINT 7,[ASCII / QXADLRUVNOPEM/]]\r
-OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC\r
- JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED\r
- PUSHJ PP,OUTL ;OUTPUT THE CHARACTER\r
- AOS ERRCNT ;INCREMENT ERROR COUNT\r
-OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT\r
-\f JUMPN AC0,OUTLE2 ;TEST FOR END\r
- POPJ PP, ;EXIT\r
-\fOUTIM1: TLOA FR,IOSCR ;SUPPRESS CRLF AFTER LINE\r
-OUTIM: TLZ FR,IOSCR ;DON'T FOR PARTIAL LINE\r
- TLNE IO,IOSALL ;SUPPRESSING ALL?\r
- JUMPN MRP,CPOPJ ;YES ,EXIT IF IN MACRO\r
- JUMP1 OUTLI1 ;BYPASS IF PASS ONE\r
- PUSH PP,ER\r
- TDZ ER,TYPERR\r
- TLNN IO,IOMSTR!IOPROG!IOMAC\r
- IOR ER,OUTSW\r
- PUSH PP,C ;OUTPUT IMAGE\r
- TLNN FR,CREFSW\r
- PUSHJ PP,CLSCRF\r
-OUTIM2: MOVE CS,TABP\r
- PUSHJ PP,OUTASC ;OUTPUT TABS\r
- IDPB C,LBUFP ;STORE ZERO TERMINATOR\r
- MOVEI CS,LBUF\r
- PUSHJ PP,OUTAS0 ;OUTPUT THE IMAGE\r
- TLZN FR,IOSCR ;CRLF SUPPRESS?\r
- PUSHJ PP,OUTCR ;NO,OUTPUT\r
- POP PP,C\r
- HLLM ER,0(PP)\r
- POP PP,ER\r
- JRST OUTLI2\r
-\r
-OUTLI: TLNE IO,IOSALL ;SUPPRESSING ALL\r
- JUMPN MRP,OUTLI3 ;YES,SET FLAG IN REPEATS ALSO\r
- TLNE IO,IOPALL ;MACRO EXPANSION SUPRESS REQUESTED?\r
- SKIPN MACLVL ;YES, ARE WE IN MACRO?\r
- TLZA IO,IOMAC ;NO, CLEAR MAC FLAG\r
-OUTLI3: TLO IO,IOMAC ;YES, SET FLAG\r
-\r
-OUTLI1: TRZ ER,ERRORS!LPTSW!TTYSW\r
-OUTLI2: MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS\r
- MOVEM CS,LBUFP\r
-IFN FORMSW,<MOVE CS,[POINT 7,TABI]\r
- MOVSS HWFMT ;PUT FLAG IN LEFT HALF\r
- SKIPGE HWFMT ;BUT IF ONLY HALF-WORD FORMAT>\r
- MOVE CS,[POINT 7,TABI,6]\r
- MOVEM CS,TABP\r
- MOVEI CS,.CPL\r
-IFN FORMSW,<SKIPL HWFMT ;IF MULTI-FORMAT\r
- SUBI CS,8 ;LINE IS ONE TAB SHORTER\r
- MOVSS HWFMT ;BACK AS IT WAS>\r
- MOVEM CS,CPL\r
- MOVSI CS,(ASCII / /)\r
- SKIPE SEQNO ;HAVE WE SEQUENCE NUMBERS?\r
- MOVEM CS,SEQNO ;YES, STORE TAB IN CASE OF MACRO\r
- MOVEM CS,SEQNO+1 ;STORE TAB AND TERMINATOR\r
- SETZM ASGBLK\r
- SETZM LOCBLK\r
- POPJ PP,\r
-\fOUTIML: TLNE IO,IOSALL ;SUPPRESSING ALL?\r
- JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO\r
- TRNN ER,ERRORS-ERRQ ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS\r
- TLNE FR,ERRQSW\r
- TRZ ER,ERRQ\r
- HRLZ CS,ER\r
- JUMP1 OUTML1 ;CHECK PASS1 ERRORS\r
- TDZ ER,TYPERR\r
- JUMPE CS,OUTIM1\r
- PUSH PP,[0] ;ERRORS SHOULD BE ZEROED\r
- PUSH PP,C\r
- PUSH PP,AC0 ;SAVE AC0 IN CASE CALLED FROM ASCII\r
- MOVE AC0,CS ;ERROR ROUTINE WANTS FLAGS IN AC0\r
- IOR ER,OUTSW\r
- TLNN FR,CREFSW\r
- PUSHJ PP,CLSCRF ;FIX CREF\r
- TLZE AC0,ERRM\r
- TLO AC0,ERRP\r
- PUSHJ PP,OUTLER ;OUTPUT THEM\r
- POP PP,AC0\r
- JRST OUTIM2 ;AND LINE\r
- \r
-OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV\r
- JUMPE CS,OUTLI2 ;NONE\r
- TRZ ER,ERRM!ERRP!ERRV\r
- TRO ER,ERRL\r
- PUSH PP,ER ;SAVE\r
- PUSH PP,C ;SAVE THIS\r
- PUSH PP,AC0 ;AS ABOVE\r
- MOVE AC0,CS ;...\r
- TDZ ER,TYPERR\r
- IOR ER,OUTSW\r
- MOVEI CS,TAG\r
- PUSHJ PP,OUTSIX\r
- HRRZ C,TAGINC\r
- PUSHJ PP,DNC\r
- PUSHJ PP,OUTTAB\r
- PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS\r
- PUSHJ PP,OUTTAB\r
- MOVEI CS,LBUF ;PRINT REST OF LINE\r
- PUSHJ PP,SOUT20\r
- POP PP,AC0\r
- POP PP,C\r
- POP PP,ER\r
- JRST OUTLI2\r
-\fSUBTTL OUTPUT ROUTINES\r
-UOUT: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
- TRNN ARG,PNTF ;WFW\r
- TRNN ARG,UNDF\r
- JRST UOUT13 ;TEST FOR UNDF!EXTF!PNTF ON PASS2\r
- JUMP2 UOUT10\r
- TLNN IO,IOIOPF ;ANY IOP'S SEEN\r
- JRST UOUT12 ;NO,MAKE EXTERNAL\r
- MOVSI CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE\r
-UOUT1: CAME AC0,PRMTBL(CS) ;HAVE WE A MATCH?\r
- AOBJN CS,UOUT2 ;NO,INCREMENT AND JUMP\r
- MOVE ARG,PRMTBL+1(CS);YES,GET VALUE\r
- MOVEM ARG,(SX) ;UPDATE SYMBOL TABLE\r
- POPJ PP, ;EXIT\r
-UOUT2: AOBJN CS,UOUT1 ;TEST FOR END\r
-\r
-UOUT12: PUSHJ PP,EXTER2 ;MAKE IT EXTERNAL\r
- MOVSI ARG,UNDF ;BUT PUT UNDF BACK ON\r
- IORM ARG,(SX) ;SO MESSAGE WILL COME OUT\r
- POPJ PP, ;GET NEXT SYMBOL\r
-\r
-UOUT13: JUMP1 CPOPJ ;RECYCLE ON PASS1\r
- TRC ARG,UNDF!EXTF!PNTF ;CHECK FOR ALL THREE ON\r
- TRCE ARG,UNDF!EXTF!PNTF ;ARE THEY?\r
- POPJ PP, ;NO, RECYCLE\r
-UOUT10: PUSHJ PP,OUTCR\r
- PUSHJ PP,OUTSYM ;OUTPUT THE SYMBOL\r
- MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL @/]\r
- JRST OUTSIX ;POPJ FOR NEXT SYMBOL\r
-\r
-UOUT30: PUSHJ PP,ONC1 ;OUTPUT THE LOCATION\r
- JRST HIGHQ ;EXIT THROUGH HIGHQ\r
-\f ;OUTPUT THE ENTRIES\r
-\r
-EOUT: MOVEI C,0 ;INITIALIZE THE COUNT\r
- MOVE SX,SYMBOL\r
- MOVE SDEL,0(SX)\r
-EOUT1: SOJL SDEL,EOUT2 ;TEST FOR END\r
- ADDI SX,2\r
- HLRZ ARG,0(SX)\r
- ANDCAI ARG,SYMF!INTF!ENTF\r
- JUMPN ARG,EOUT1 ;IF INVALID, DON'T COUNT\r
- AOJA C,EOUT1 ;BUMP COUNT\r
-\r
-EOUT2: HRLI C,4 ;BLOCK TYPE 4\r
- PUSHJ PP,OUTBIN\r
- SETZB C,ARG\r
- PUSHJ PP,OUTBIN\r
- MOVE SX,SYMBOL\r
- MOVE SDEL,0(SX)\r
- MOVEI V,^D18\r
-\r
-EOUT3: SOJL SDEL,POPOUT\r
- ADDI SX,2\r
- HLRZ C,0(SX)\r
- ANDCAI C,SYMF!INTF!ENTF\r
- JUMPN C,EOUT3\r
- SOJGE V,EOUT4 ;TEST END OF BLOCK\r
- PUSHJ PP,OUTBIN\r
- MOVEI V,^D17 ;WFW\r
-EOUT4: MOVE AC0,-1(SX)\r
- PUSHJ PP,SQOZE\r
- MOVE C,AC0\r
- PUSHJ PP,OUTBIN\r
- JRST EOUT3\r
-\f ;OUTPUT THE SYMBOLS\r
-\r
-SOUT: SKIPN IONSYM ;SKIP IF NOSYM SEEN\r
- TRNN ER,LPTSW!TTYSW ;A LISTING REQUIRED?\r
- JRST SOUT1 ;NO\r
- MOVEI [ASCIZ /SYMBOL TABLE/]\r
- HRRM SUBTTX ;SET NEW SUB-TITLE\r
- PUSHJ PP,OUTFF ;FORCE NEW PAGE\r
- MOVEI ARG,NCOLS ;SET UP FOR NCOLS ACROSS SYMBOL TABLE\r
- TRNE ER,TTYSW ;IS TTY LISTING DEVICE?\r
- MOVEI ARG,2 ;YES,ONLY 2 COLLUMNS\r
- MOVEM ARG,NCOLLS ;STORE ANSWER\r
- MOVEM ARG,SYMCNT\r
- PUSHJ PP,LOUT1 ;OUTPUT THEM\r
- MOVE ARG,SYMCNT ;SEE IF WE ENDED EVEN\r
- CAME ARG,NCOLLS\r
- PUSHJ PP,OUTCR ;NO, NEED CR\r
- JRST SOUT1 ;NOW FOR BLOCK TYPE 2\r
-\r
-LOUT1: PUSHJ PP,LLUKUP ;SET FOR TABLE SCAN\r
- TRNN ARG,SYMF\r
- TRNN ARG,MACF!SYNF\r
- TDZA MRP,MRP ;SKIP AND CLEAR MRP\r
- POPJ PP, ;NO, TRY AGAIN\r
- TRNE ARG,INTF\r
- MOVEI MRP,1\r
- TRNE ARG,EXTF\r
- MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL\r
- TRNE ARG,SYNF ;SYNONYM?\r
- JUMPL MRP,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL\r
- TRNE ARG,SUPRBT ;IF SUPRESSED\r
-; JUMPGE MRP,POPOUT ;DO NOT OUTPUT UNLESS EXTERNAL\r
- POPJ PP, ;DO NOT OUTPUT\r
- AOS (PP) ;SET FOR SKIP RETURN IF SYMBOL IS PRINTED\r
- JUMPGE MRP,LOUT10 ;BRANCH IF NOT EXTERNAL\r
- HLRZ RC,V ;PUT POINTER/FLAGS IN RC\r
- TRNE RC,-2 ;POINTER?\r
- MOVS RC,0(RC) ;YES\r
- HLL V,RC ;STORE LEFT VALUE\r
-\r
-LOUT10: PUSH PP,RC ;SAVE FOR LATER\r
- PUSHJ PP,OUTSYM ;OUTPUT THE NAME\r
- MOVE RC,(PP) ;GET COPY\r
- MOVEI AC1,0\r
- JUMPLE MRP,LOUT15 ;SET DEFFERRED BITS IF EXTERNAL\r
- TLNE RC,-2 ;CHECK FOR LEFT FIXUP\r
- IORI AC1,40 ;AND SET BITS\r
- TRNE RC,-2 ;CHECK FOR RIGHT FIXUP\r
- IORI AC1,20 ;AND SET BITS\r
-LOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL\r
- HRRZS RC\r
- TRNE RC,-2\r
- HLLZS RC\r
- TLZE RC,-1\r
- TRO RC,2\r
- HRL MRP,RC\r
- MOVEI RC,0\r
- TRNE ARG,ENTF ;ENTRY DMN\r
- HRRI MRP,-5\r
- TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW\r
- ADDI MRP,3 ;YES WFW\r
- TRNE ARG,UNDF ;UNDEFINED IS EXTERNAL\r
- HRRI MRP,2 ;SO FLAG AS UXT\r
- IOR AC1,SOUTC(MRP)\r
- MOVE ARG,AC1\r
- MOVEM AC0,SVSYM ;SAVE IT\r
- MOVE AC0,V ;GET THE VALUE\r
- HLRZ RC,MRP ;AND THE RELOCATION\r
- HLLO CS,V\r
- TRNE RC,2 ;LEFT HALF RELOCATABLE?\r
- TRZA CS,1 ;NO, FLAG AND PRINT\r
- TLNE CS,-1 ;IS THE LEFT HALF ZERO?\r
- PUSHJ PP,ONC1 ;NO, OUTPUT IT\r
-LOUT11: PUSHJ PP,OUTTAB\r
-LOUT30: HRLO CS,V\r
- TDZ CS,RC ;SET RELOCATION\r
- PUSHJ PP,ONC1\r
- PUSHJ PP,OUTTAB\r
- POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL\r
-LOUT60: MOVEI CS,SOUTC(MRP)\r
- PUSHJ PP,OUTAS0 ;EXT/INT\r
- SOSLE SYMCNT ;SEE IF WE HAVE RUN OUT\r
- JRST OUTTAB ;NOT YET, PRINT ONE TAB\r
-LOUT64: MOVE CS,NCOLLS ;YES, RESET\r
-\f MOVEM CS,SYMCNT\r
- JRST OUTCR ;CARRIAGE RETURN AND TRY FOR ANOTHER\r
-\r
-\r
-\f SYN IFBLK,SYMBLK ;SOMEWHERE TO STORE THE POINTERS\r
-\r
-LLUKUP: POP PP,LOOKX ;INTERCEPT RETURN POP\r
- MOVE SX,SYMBOL\r
- MOVE SDEL,(SX)\r
- ADDI SX,2 ;SKIP COUNT OF SYMBOLS\r
-LLUKP2: HRLI SX,-<.LPP-1> ;LENGTH OF PAGE\r
- MOVE V,ARG ;COPY OF ARG\r
- MOVEM SX,SYMBLK(V) ;STORE SYMBOL POINTER IN TABLE\r
- ADDI SX,2*<.LPP-2> ;SYMBOLS PER PAGE\r
- SOJG V,.-2 ;FOR ALL COLUMNS\r
- MOVE V,SYMCNT\r
- HRRZ SX,SYMBLK(V)\r
- CAMGE SX,SYMTOP\r
- SOJG V,.-2\r
- ADDI V,1\r
- MOVEM V,SYMBLK\r
- JRST LLUKP7 ;ENTER LOOP\r
-\r
-LLUKP1: MOVEM SX,SYMBLK(ARG) ;SAVE IT \r
- MOVE AC0,-1(SX)\r
- PUSHJ PP,SRCH7\r
- HLRZS ARG\r
- PUSHJ PP,@LOOKX\r
- JRST [MOVE ARG,SYMCNT\r
- MOVEM SX,SYMBLK(ARG)\r
- JRST .+1]\r
-LLUKP7: SOJL SDEL,POPOUT ;TEST FOR END\r
-LLUKP3: MOVE ARG,SYMCNT ;GET PAGE POSITION\r
- MOVE SX,SYMBLK(ARG) ;GET NEXT POINTER\r
- AOBJP SX,LLUKP4\r
- HRRZ V,SX\r
- CAMG V,SYMTOP\r
- AOJA SX,LLUKP1\r
-LLUKP6: PUSHJ PP,LOUT64 ;RESET SYMCNT\r
- JUMPE SDEL,POPOUT ;EXIT IF ALL DONE\r
- JRST LLUKP3\r
-\r
-LLUKP4: AOJ SX,\r
- MOVEM SX,SYMBLK(ARG)\r
- MOVE V,NCOLLS\r
- SKIPGE SYMBLK(V) ;TEST IF ALL FINISHED\r
- JRST LLUKP5 ;NO\r
- SOJG V,.-2 ;KEEP GOING\r
- MOVE SX,SYMBLK\r
- MOVE SX,SYMBLK(SX)\r
- HLRZ V,SX ;GET NUMBER ADVANCED\r
- LSH V,1 ;2 WORDS PER SYMBOL\r
- SUBI SX,2(V) ;BACK UP ONE SYMBOL\r
- SKIPGE LPP ;IF PAGE FULL\r
- JRST .+3 ;DON'T FINISH WITH EXTRA CR-LF\r
- SETZM LPP ;ENSURE END OF PAGE\r
- PUSHJ PP,LOUT64\r
- MOVE ARG,NCOLLS\r
- MOVEM ARG,SYMCNT ;JUST IN CASE\r
- JRST LLUKP2\r
-\r
-LLUKP5: SOSG SYMCNT ;ON LAST COL?\r
- JRST LLUKP6\r
- SKIPGE LPP ;IF PAGE FULL\r
- JRST LLUKP3 ;NO MORE OUTPUT \r
-REPEAT 2,<PUSHJ PP,OUTAB2> ;NO, TAB OUT TO NEXT COLUMN\r
- JRST LLUKP3\r
-\fSOUT1: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
- TRNN ARG,SYMF\r
- TRNN ARG,MACF!SYNF\r
- TDZA MRP,MRP ;SKIP AND CLEAR MRP\r
- POPJ PP, ;NO, TRY AGAIN\r
- TRNE ARG,INTF\r
- MOVEI MRP,1\r
-IFN WFWSW,<TRNE ARG,VARF ;IF THIS FLAG IS ON SHOULD GO IN LOW SEG\r
- JRST SOUT1W >\r
- TRNE ARG,EXTF\r
- MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL\r
- TRNE ARG,SYNF ;SYNONYM?\r
- JUMPL MRP,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL\r
- TRNE ARG,SUPRBT ;IF SUPRESSED\r
-; JUMPGE MRP,POPOUT ;DO NOT OUTPUT UNLESS EXTERNAL\r
- POPJ PP, ;DO NOT OUTPUT\r
- JUMPGE MRP,SOUT10 ;BRANCH IF NOT EXTERNAL\r
- HLRZ RC,V ;PUT POINTER/FLAGS IN RC\r
- TRNE RC,-2 ;POINTER?\r
- MOVS RC,0(RC) ;YES\r
- HLL V,RC ;STORE LEFT VALUE\r
-\r
-SOUT10: PUSH PP,RC ;SAVE FOR LATER\r
- MOVEI AC1,0\r
- JUMPLE MRP,SOUT15 ;SET DEFFERRED BITS IF EXTERNAL\r
- TLNE RC,-2 ;CHECK FOR LEFT FIXUP\r
- IORI AC1,40 ;AND SET BITS\r
- TRNE RC,-2 ;CHECK FOR RIGHT FIXUP\r
- IORI AC1,20 ;AND SET BITS\r
-IFN WFWSW,<TRNE ARG,VARF ;IF SO THEN DEFERD\r
- IORI AC1,20>\r
-SOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL\r
- HRRZS RC\r
- TRNE RC,-2\r
- HLLZS RC\r
- TLZE RC,-1\r
- TRO RC,2\r
- HRL MRP,RC\r
- MOVEI RC,0\r
- TRNE ARG,ENTF ;ENTRY DMN\r
- HRRI MRP,-5\r
- TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW\r
- ADDI MRP,3 ;YES WFW\r
- IOR AC1,SOUTC(MRP)\r
- MOVE ARG,AC1\r
- PUSHJ PP,NOUT2 ;SQUOZE AND DUMP THE SYMBOL\r
- MOVEM AC0,SVSYM ;SAVE IT\r
- MOVE AC0,V ;GET THE VALUE\r
- HLRZ RC,MRP ;AND THE RELOCATION\r
- PUSHJ PP,COUT\r
- POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL\r
- TRNN RC,-2 ;IS IT?\r
- JRST SOUT50 ;NO\r
- MOVE AC0,1(RC) ;GET NAME\r
-IFN WFWSW,<JUMPE AC0,[MOVSI AC0,200000 ;RIGHT DEFERED\r
- PUSHJ PP,INVRSF ;INSERT IN SYMBOL INFORMATION\r
- JRST SOUT50]>\r
- MOVEI ARG,60 ;EXTERNAL REQ\r
- PUSHJ PP,SQOZE\r
- HLLZS RC ;NO RELOC\r
- PUSHJ PP,COUT ;OUTPUT IT\r
- MOVE AC0,SVSYM ;GET SYMBOL NAME\r
- TLO AC0,500000 ;SET AS ADDITIVE SYMBOL\r
- TLZ AC0,200000 ;BUT NOT LEFT HALF ETC\r
- PUSHJ PP,COUT\r
-SOUT50: MOVSS RC ;CHECK LEFT HALF\r
- TRNN RC,-2\r
- JRST SOUT60\r
- MOVE AC0,1(RC)\r
-IFN WFWSW,<JUMPE AC0,[MOVSI AC0,600000 ;LEFT DEFERED\r
- PUSHJ PP,INVRSF\r
- JRST SOUT60]>\r
- MOVEI ARG,60\r
- PUSHJ PP,SQOZE\r
- MOVEI RC,0\r
- PUSHJ PP,COUT\r
- MOVE AC0,SVSYM\r
- TLO AC0,700000\r
- PUSHJ PP,COUT\r
-SOUT60: POPJ PP,\r
-\r
-SOUT20: PUSHJ PP,OUTAS0\r
- JRST OUTCR\r
-\r
- <ASCII /ENT/>!04 ;DMN\r
- Z\r
- Z\r
- <ASCII /SEN/>!44 ;SUPRESSED ENTRY\r
- <ASCII /EXT/>!60\r
-SOUTC: EXP 10\r
- <ASCII /INT/>!04\r
- <ASCII /UXT/>!60 ;UNDEFINED EXTERNAL\r
- <ASCII /SPD/>!50\r
- <ASCII /SIN/>!44 ;DMN\r
-\fIFN WFWSW,<\r
-INVRSF: MOVEI ARG,3 ;GET A BLOCK\r
- ADDB ARG,FREE\r
- CAML ARG,SYMBOL\r
- PUSHJ PP,XCEEDS\r
- MOVEM AC0,(ARG) ;SAVE WHICH HALF INFO\r
- MOVE AC0,SVSYM ;GET SYMBOL NAME\r
- TLZ AC0,740000 ;GET RID OF CODE BITS\r
- MOVEM AC0,-1(ARG) ;SAVE IT\r
- HLRZ AC0,(RC) ;SYMBOL TABLE FIXUP POINTER\r
- MOVEM AC0,-2(ARG) ;LINK IN THIS BLOCK\r
- SUBI ARG,2 ;POINT TO START OF BLOCK\r
- HRLM ARG,(RC)\r
- POPJ PP,\r
-\r
-SOUT1W: HLRZS V ;GET THE SYMBOL TABLE POINTER\r
- MOVEI RC,3 ;SET UP A NEW BLOCK FOR THIS SYMBOL\r
- ADDB RC,FREE\r
- CAML RC,SYMBOL\r
- PUSHJ PP,XCEEDS ;CHECK ON OUT OF ROOM\r
- PUSH PP,ARG ;SAVE ARG AND ACO\r
- PUSH PP,AC0\r
- MOVEI ARG,0 ;NO CODE BITS\r
- PUSHJ PP,SQOZE ;CONVERT TO RAD50\r
- MOVEM AC0,-1(RC) ;SYMBOL NAME\r
- POP PP,AC0\r
- POP PP,ARG ;RESTORE\r
- HRRZM V,-2(RC) ;LINK TO NEXT BLOCK\r
- MOVSI V,200000 ;FLAG AS SYMBOL TABLE FIXUP\r
- MOVEM V,(RC)\r
- HRRZ V,(SX) ;GET POINTER TO HEADER BLOCK\r
- SUBI RC,2 ;POINT TO HEAD OF BLOCK\r
- HRLM RC,(V) ;PUT IN LINK TO NEW BLOCK\r
- MOVE RC,FIXLNK ;ADD SYMBOL TO CHAIN OF ONES TO DO\r
- MOVEM SX,FIXLNK ;CHAIN THROUGH SYMBOL ENTRY\r
- MOVEM RC,-1(SX) ;WHICH IS NO LONGER NEEDED\r
- SETZB RC,V ;PUT OUT 0 FOR SYMBOL VALUE\r
- JRST SOUT10>\r
-\f ;OUTPUT THE BINARY\r
-\r
-BOUT: HRLO CS,LOCO ;PICKUP THE LOCATION\r
- PUSHJ PP,ONC ;OUTPUT IT TO THE LISTING FILE\r
- MOVEI C,"'"\r
- SKIPE MODO ;IF MODE IS NOT ABSOLUTE\r
- PUSHJ PP,OUTC ;PRINT A SINGLE QUOTE\r
- PUSHJ PP,DSTOW ;GET THE CODE\r
- PUSH PP,RC ;SAVE RELOC\r
- PUSH PP,RC ;AND AGAIN\r
-IFE WFWSW,<TLNE RC,-2 ;CHECK LEFT EXTERNAL\r
- HRRZS RC ;MAKE LEFT NON-RELOC>\r
-IFN WFWSW,<TLNE FR,RIMSW!RIM1SW!R1BSW ;CHECK FOR SPECIAL BIN OUT\r
- JRST BOUT30 ;AND LET HIM DISCOVER THE HORROR\r
- TLNN RC,-2 ;LEFT HALF EXTERNAL??\r
- JRST BOUT11 ;NO\r
- HLRZ AC1,RC ;GET POINTER\r
- SKIPE 1(AC1) ;IS IT SPECIAL LVAR KIND (NAME IS 0)\r
- JRST [HRRZS RC\r
- JRST BOUT11] ;IGNORE FOR NOW\r
- PUSH PP,AC0 ;SAVE WORD\r
- HLRZS AC0 ;GET OFFSET\r
- PUSHJ PP,INCSRC ;FIND A MATCH OR INSERT NEW BLOCK\r
- ADDI AC1,1 ;POINT ONE FURTHER IN BLOCK\r
- PUSHJ PP,LVLINK ;AND SET INFORMATION\r
- POP PP,AC0\r
- HRLM RC,AC0 ;THE LINK\r
- HLLM RC,-1(PP) ;AND ITS RELOC\r
- MOVE RC,-1(PP) ;GET RELOC BACK\r
-BOUT11:>\r
- TRNN RC,-2 ;RIGHT EXT?\r
- JRST BOUT30 ;NO\r
-IFN WFWSW,<HRRZ AC1,RC ;GET POINTER\r
- SKIPE 1(AC1)\r
- JRST [HRRZ AC1,AC0 ;ORDINARY EXTERNAL, HANDLE\r
- JUMPE AC1,BOUT20\r
- HLLZS RC ;ADD EXTERNAL\r
- JRST BOUT30]\r
- PUSH PP,AC0 ;SAVE WORD\r
- HRRZS AC0 ;GET OFFSET\r
- PUSHJ PP,INCSRC\r
- PUSHJ PP,LVLINK\r
- POP PP,AC0\r
- HRRM RC,AC0\r
- HLRM RC,-1(PP)\r
- MOVE RC,-1(PP)>\r
-IFE WFWSW,<HRRZ AC1,AC0 ;YES\r
- JUMPE AC1,BOUT20 ;PROCESS IF ZERO CODE THERE\r
- HLLZS RC ;MAKE NON-RELOC>\r
- JRST BOUT30 ;PROCESS\r
-\r
-\fBOUT20:\r
- HRRM AC1,-1(PP) ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)\r
- HRR AC0,0(RC) ;NO, SET ADDRESS LINK\r
- MOVE AC1,LOCO ;GET CURRENT LOCATION\r
- HRRM AC1,0(RC) ;SET NEW LINK\r
- HLRZ AC1,0(RC) ;GET FLAGS/POINTER\r
- TRNN AC1,-2 ;POINTER?\r
- HRR AC1,RC ;NO, SET TO FLAGS\r
- HLR RC,0(AC1) ;PUT FLAGS IN RC\r
- HRL AC1,MODO ;GET CURRENT MODE\r
- TRZE RC,-2 ;LEFT HALF RELOCATABLE+\r
- TLO AC1,2 ;YES, SET FLAG\r
- HLLM AC1,0(AC1) ;STORE NEW FLAGS\r
-BOUT30: HLLO CS,AC0\r
- TLZE RC,1 ;PACK RELOCATION BITS\r
- TRO RC,2\r
- TRNE RC,2 ;LEFT HALF RELOCATABLE?\r
- TRZ CS,1 ;YES, RESET BIT\r
- PUSH PP,AC0 ;NEED AN AC\r
- HLRZ AC0,-1(PP) ;AC0 = LEFT RELOCATION\r
- CAILE AC0,1 ;EXTERNAL?\r
- XORI CS,EXTF!1 ;YES, SET SWITCH\r
-\fIFN FORMSW,<\r
- OR AC0,HWFMT\r
- JUMPN AC0,BOUT3H ;EDIT IN HALF WORD FORMAT IF NOT 0\r
- MOVE AC0,FORM ;GET FORM WORD\r
- MOVEI C,0 ;ZERO FIELD SIZE\r
-BOUT3A: JFFO AC0,BOUT3B ;AC1 = FIELD SIZE -1\r
- JRST BOUT3C ;NO FIELDS LEFT, JUMP\r
-BOUT3B: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD\r
- MOVEI AC1,6(AC1)\r
- IDIVI AC1,3 ;AC1 = COLUMNS USED + 1\r
- ADDI C,(AC1) ;INCREMENT FIELD SIZE\r
- CAIG C,^D23 ;IS FIELD SIZE GTR 23?\r
- JRST BOUT3A ;NO. CONTINUE\r
- MOVE AC1,HWFORM ;USE STANDARD FORM\r
- MOVEM AC1,FORM\r
- MOVEI C,^D13 ;SET FIELD SIZE TO 13\r
-BOUT3C: MOVEM C,FLDSIZ ;STORE FIELD SIZE\r
- MOVE AC0,FORM ;AC0 = FORM WORD\r
- TRNN RC,2 ;IS LEFT HALF RELOCATED?\r
- CAMN AC0,HWFORM ;NO. IS FORM HALF WORD?\r
- JRST BOUT3H ;YES. EDIT IN OLD WAY\r
- CAMN AC0,IOFORM ;IS IT I/O WORD\r
- SETOM IOSEEN ;YES,NEED MORE WORK\r
- IBP TABP\r
- CAIL C,^D16\r
- IBP TABP\r
- ILDB C,TABP ;GET A TAB\r
- PUSHJ PP,OUTL ;OUTPUT IT\r
- MOVE AC2,(PP) ;AC2 = INFO TO BE EDITED\r
- PUSH PP,CS ;SAVE CS = C+1\r
-BOUT3D: JFFO AC0,BOUT3E ;AC1 = FIELD LENGTH - 1\r
-BOUT3E: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD\r
- MOVEI C,3(AC1)\r
- MOVEI AC1,0\r
- LSHC AC1,-2(C) ;AC1 = FIELD INFO\r
- IDIVI C,3 ;C = # OF OCTAL DIGITS\r
- MOVE C+1,AC0 ;SAVE AC0\r
- SKIPE IOSEEN ;IS THIS A I/O INST.\r
- PUSHJ PP,BOUT3J ;YES,SET FIELDS CORRECTLY\r
- MOVNS C\r
- ROT AC1,(C)\r
- ROT AC1,(C)\r
- ROT AC1,(C)\r
- MOVNS C\r
-\fBOUT3F: MOVEI AC0,6 ;EDIT A DIGIT\r
- LSHC AC0,3\r
- EXCH AC0,C\r
- PUSHJ PP,OUTC ;OUTPUT IT\r
- MOVE C,AC0\r
- SOJG C,BOUT3F ;IF MORE DIGITS, GO BACK\r
- JUMPE C+1,BOUT3G ;JUMP IF END OF WORD\r
- MOVE AC0,C+1 ;RESTORE AC0\r
- MOVEI C," "\r
- PUSHJ PP,OUTC ;OUTPUT A SPACE\r
- JRST BOUT3D ;PROCESS NEXT FIELD\r
-\r
-BOUT3G: POP PP,CS ;RESTORE CS = C+1\r
- MOVEI C,0\r
- TRNE RC,1 ;RELOCATABLE?\r
- MOVEI C,"'" ;YES\r
- HRRZ AC0,-1(PP) ;AC0 = RIGHT RELOCATION\r
- CAILE AC0,1 ;EXTERNAL?\r
- MOVEI C,"*" ;YES\r
- PUSHJ PP,ONC2 ;STORE POSSIBLE INDICATOR\r
- POP PP,AC0\r
- JRST BOUT3I ;CONTINUE\r
-\r
-BOUT3H: MOVEI C,^D15 ;SET SIZE TO 15\r
- MOVEM C,FLDSIZ\r
->\r
- POP PP,AC0 ;RESTORE\r
- PUSHJ PP,ONC\r
- HRLO CS,AC0\r
- TDZ CS,RC ;SET RELOCATION\r
- HRRZ C,(PP) ;C = RIGHT RELOCATION\r
- CAILE C,1 ;EXTERNAL\r
- XORI CS,EXTF!1 ;YES, SET SWITCH\r
- PUSHJ PP,ONC\r
-BOUT3I: POP PP,CS ;GET RID OF ENTRY ON STACK\r
- HRRZ CS,LOCO\r
- TLNE FR,RIMSW!RIM1SW!R1BSW ;RIM OUTPUT?\r
- JRST ROUT ;YES, GO PROCESS\r
-\r
- HRL CS,MODO\r
- CAME CS,MODLOC ;SEQUENCE OR RELOCATION BREAK?\r
- PUSHJ PP,COUTD ;YES, DUMP THE BUFFER\r
- SKIPL COUTX ;NEW BUFFER?\r
- JRST BOUT40 ;NO, STORE CODE AND EXIT\r
- MOVEM CS,MODLOC ;YES, STORE NEW VALUES\r
- EXCH AC0,LOCO\r
- EXCH RC,MODO\r
- PUSHJ PP,COUT ;STORE BLOCK LOCATION AND MODE\r
- EXCH RC,MODO ;RESTORE CURRENT VALUES\r
- EXCH AC0,LOCO\r
-\r
-\fBOUT40: PUSHJ PP,COUT ;EMIT CODE\r
- POP PP,RC ;RETRIEVE EXTERNAL BITS\r
- TRNN RC,-2 ;RIGHT EXTERNAL?\r
- JRST BOUT50 ;TRY FOR LEFT\r
- PUSHJ PP,COUTD\r
- PUSH PP,BLKTYP ;TERMINATE TYPE AND SAVE\r
- MOVEI AC0,2 ;BLOCK TYPE 2\r
- MOVEM AC0,BLKTYP\r
- MOVE AC0,1(RC) ;GET SYMBOL\r
- MOVEI ARG,60 ;CODE BITS\r
- PUSHJ PP,SQOZE ;CONVERT TO RADIX 50\r
- HLLZS RC ;SYMBOL HAS NO RELOCATION\r
- PUSHJ PP,COUT ;EMIT\r
- MOVE AC0,LOCO ;GET CURRENT LOC\r
- HRLI AC0,400000 ;ADDITIVE REQ\r
- HRR RC,MODO ;CURRENT MODE\r
- PUSHJ PP,COUT ;EMIT\r
- MOVSS RC ;NOW FOR LEFT\r
- TRNN RC,-2\r
- JRST BOUT60\r
- JRST BOUT70\r
-BOUT50: MOVSS RC ;CHECK OTHER HALF\r
- TRNN RC,-2 ;LEFT HALF EXTERNAL?\r
- JRST BOUT80 ;NO, FALSE ALARM\r
- PUSHJ PP,COUTD ;CHANGE MODE\r
- PUSH PP,BLKTYP\r
- MOVEI AC0,2\r
- MOVEM AC0,BLKTYP\r
-BOUT70: MOVE AC0,1(RC)\r
- MOVEI ARG,60\r
- PUSHJ PP,SQOZE\r
- HLLZS RC\r
- PUSHJ PP,COUT\r
- MOVE AC0,LOCO\r
- HRLI AC0,600000 ;LEFT HALF ADD\r
- HRR RC,MODO\r
- PUSHJ PP,COUT ;EMIT\r
-BOUT60: PUSHJ PP,COUTD ;CHANGE MODE\r
- POP PP,BLKTYP ;TO OLD ONE\r
-BOUT80: AOS LOCO\r
- AOS MODLOC\r
- POPJ PP,\r
-\fIFN WFWSW,<\r
-INCSC1: HLRZ RC,(AC1) ;GET OFFSET OF NEXT BLOCK\r
- CAMN RC,AC0 ;IS IT THE SAME??\r
- POPJ PP, ;YES, RETURN AC1 POINTS TO BLOCK\r
-INCSRC: MOVE RC,AC1 ;CURRENT POINTER\r
- HRRZ AC1,(AC1) ;IN CASE THIS COMES UP 0\r
- JUMPN AC1,INCSC1 ;SINCE 0 IS END OF CHAIN. ANY MORE??\r
- MOVEI AC1,3 ;NO, GET A NEW BLOCK\r
- ADDB AC1,FREE\r
- CAML AC1,SYMBOL\r
- PUSHJ PP,XCEED\r
- SUBI AC1,2 ;WE MUST BE POINTING RIGHT WHEN WE GET OUT\r
- HRRM AC1,(RC) ;INSERT WHERE END OF CHAIN WAS\r
- HRLZM AC0,(AC1) ;SET OFFSET AND END OF CHAIN\r
- SETZM 1(AC1)\r
- SETZM 2(AC1) ;NO LEFT OR RIGHT HALF FIXUPS\r
- POPJ PP, ;DONE\r
-\r
-LVLINK: MOVE RC,LOCO ;GET CURRENT LOCATION\r
- HRL RC,MODO ;AND MODE\r
- EXCH RC,1(AC1) ;PUT IN AND GET PLACE TO LINK TO\r
- POPJ PP,>\r
-\r
-IFN FORMSW,<\r
-BOUT3J: MOVSS IOSEEN ;SWAP\r
- SKIPGE IOSEEN ;SKIP IF NOT FIRST FIELD\r
- JRST [HLLZS IOSEEN ;CLEAR RIGHT HALF\r
- POPJ PP,] ;AND RETURN\r
- MOVSS IOSEEN ;SWAP BACK\r
- LSH AC1,2 ;CORRECT MNEMONIC AND OP CODE\r
- CAIE C,1 ;IS IT OP CODE?\r
- POPJ PP, ;NO,JUST RETURN\r
- MOVEI C,2 ;TWO CHAR. WIDE NOW\r
- SETZM IOSEEN ;DON'T COME AGAIN\r
- POPJ PP, ;RETURN\r
->\r
-\fNOUT: MOVE V,[POINT 7,TBUF] ;POINTER TO ASCII LINE\r
- MOVSI CS,(POINT 6,AC0) ;POINTER TO SIXBIT AC0\r
- SETZB ARG,AC0\r
-NOUT1: ILDB C,V ;GET ASCII\r
- CAIL C,"A"+40\r
- CAILE C,"Z"+40\r
- JRST .+2\r
- TRZA C,100 ;LOWER CASE TO SIXBIT\r
- SUBI C,40 ;CONVERT TO SIXBIT\r
- JUMPLE C,NOUT3 ;TEST FORM NON-SIXBIT\r
- CAILE C,77 ;AND NOT GREATER THAN SIXBIT\r
- JRST NOUT3 ;...\r
- IDPB C,CS ;DEPOSIT IN AC0\r
- TLNE CS,770000 ;TEST FOR SIX CHARACTERS\r
- JRST NOUT1 ;NO, GET ANOTHER\r
-NOUT3: SKIPGE UNIVSN ;IF A UNIVERSAL PROG\r
- POPJ PP, ;RETURN TO PUT IT IN THE TABLE\r
-\r
-IFN CCLSW,< TLNN IO,IOTLSN ;AND IF WE HAVE NOT SEEN A TITLE\r
- PUSHJ PP,PRNAM ;THEN PRINT THE NAME>\r
-NOUT2: PUSHJ PP,SQOZE ;CONVERT TO SIXBIT\r
- JRST COUT ;DUMP AND EXIT\r
-\r
-HOUT:\r
- MOVEI RC,1 ;RELOCATABLE\r
-IFN RENTSW,<\r
- MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS\r
- JUMPE AC0,.+2 ;NOT TWO SEGMENTS\r
- PUSHJ PP,COUT ;OUTPUT IT >\r
- MOVE AC0,HIGH\r
-IFN RENTSW,<\r
- SKIPE HHIGH ;ANY TWOSEG HIGH STUFF\r
- JRST COUT ;YES,SO NO ABS.>\r
- PUSHJ PP,COUT ;OUTPUT THE HIGHEST LOCATION\r
- MOVE AC0,ABSHI\r
- ;PUT OUT ABS PORTION OF PROGRAM BREAK\r
- SOJA RC,COUT ;OUTPUT A WORD OF ZERO AND EXIT\r
-\r
-\fIFN RENTSW,<\r
-HSOUT: SETZM HISNSW ;CLEAR FOR PASS2\r
- MOVE AC0,SVTYP3 ;GET HISEG ARG\r
- JUMPGE AC0,.+4 ;JUMP IF ONLY HISEG\r
- HRL AC0,HIGH1 ;GET BREAK FROM PASS 1\r
- JUMPL AC0,.+2 ;OK IF GREATER THAN 400000\r
- HRLS AC0 ;SIGNAL TWO SEGMENT TO LOADER\r
- MOVEI RC,1 ;ASSUME RELOCATABLE\r
- JRST COUT ;OUTPUT THE WORD>\r
-\r
-VOUT: SKIPN RC,VECREL ;IS VECTOR ABSOLUTE ZERO?\r
- SKIPE VECTOR ;ALSO CHECK RELOCATION\r
- JRST .+2\r
- POPJ PP, ;YES, EXIT\r
- MOVE AC0,VECTOR ;AC0 SHOULD BE FLAGS\r
-\r
-COUT: AOS C,COUTX ;INCREMENT INDEX\r
- MOVEM AC0,COUTDB(C) ;STORE CODE\r
- IDPB RC,COUTP ;STORE RELOCATION BITS\r
- CAIE C,^D17 ;IS THE BUFFER FULL?\r
- POPJ PP, ;NO, EXIT\r
-\r
-COUTD: AOSG C,COUTX ;DUMP THE BUFFER\r
- JRST COUTI ;BUFFER WAS EMPTY\r
- HRL C,BLKTYP ;SET BLOCK TYPE\r
- PUSHJ PP,OUTBIN ;OUTPUT COUNT AND TYPE\r
- SETOB C,COUTY ;INITIALIZE INDEX\r
-\r
-COUTD2: MOVE C,COUTDB(C) ;GET RELOCATION BITS/CODE\r
- PUSHJ PP,OUTBIN ;DUMP IT\r
- AOS C,COUTY ;INCREMENT INDEX\r
- CAMGE C,COUTX ;TEST FOR END\r
- JRST COUTD2 ;NO, GET NEXT WORD\r
-\r
-COUTI: SETOM COUTX ;INITIALIZE BUFFER INDEX\r
- SETZM COUTRB ;ZERO RELOCATION BITS\r
- MOVE C,[POINT 2,COUTRB]\r
- MOVEM C,COUTP ;INITIALIZE BIT POINTER\r
- POPJ PP, ;EXIT\r
-\fSTOWZ1:\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>\r
-STOWZ: MOVEI RC,0\r
-STOW:\r
-IFN FORMSW,< MOVEM AC1,FORM ;STORE FORM WORD>\r
- JUMP1 STOW20 ;SKIP TEST IF PASS ONE\r
- TRNE RC,-2 ;RIGHT HALF ZERO OR 1?\r
- PUSHJ PP,STOWT ;NO, HANDLE EXTERNAL\r
- TLNN RC,-2 ;LEFT HALF ZERO OR 1? WFW\r
- JRST STOW10 ;YES, SKIP TEST\r
- MOVSS RC ;SWAP HALVES\r
- PUSHJ PP,STOWT1 ;HANDLE EXTERNAL WFW\r
- MOVSS RC ;RESTORE VALUES\r
-\r
-STOW10: SKIPE EXTPNT ;ANY EXTERNALS REMAINING?\r
- TRO ER,ERRE ;YES, SET EXTERNAL ERROR FLAG\r
-\r
-STOW20: AOS AC1,STPX ;INCREMENT POINTER\r
- MOVEM AC0,STCODE(AC1) ;STOW CODE\r
- MOVEM RC,STOWRC(AC1) ;STOW RELOCATION BITS\r
-IFN FORMSW,<\r
- PUSH PP,FORM\r
- POP PP,STFORM(AC1) ;STORE FORM WORD\r
->\r
- SKIPN LITLVL ;ARE WE IN LITERAL?\r
- AOS LOCA ;NO, INCREMENT ASSEMBLY LOCATION\r
- CAIGE AC1,.STP-1 ;OVERFLOW?\r
- POPJ PP, ;NO, EXIT\r
-\r
- SKIPE LITLVL ;ARE WE IN A LITERAL?\r
- TROA ER,ERRL ;YES, FLAG ERROR BUT DON'T DUMP\r
- JRST CHARL1 ;NO, SAVE REGISTERS AND DUMP THE BUFFER\r
- JRST STOWI ;INITIALIZE BUFFER\r
-\r
-DSTOW: AOS AC1,STPY ;INCREMENT POINTER\r
- MOVE AC0,STCODE(AC1) ;FETCH CODE\r
- MOVE RC,STOWRC(AC1) ;FETCH RELOCATION BITS\r
-IFN FORMSW,<\r
- PUSH PP,STFORM(AC1)\r
- POP PP,FORM ;GET FORM WORD\r
->\r
- CAMGE AC1,STPX ;IS THIS THE END?\r
- POPJ PP, ;NO, EXIT\r
-\r
-STOWI: SETOM STPX ;INITIALIZE FOR INPUT\r
- SETOM STPY ;INITIALIZE FOR OUTPUT\r
- SETZM EXTPNT\r
- POPJ PP, ;EXIT\r
-\fSVSTOW: AOS LITLVL ;NESTED LITERALS\r
- PUSH PP,STPX ;MAKE ROOM FOR ANOTHER\r
- PUSH PP,STPY\r
- MOVE AC1,STPX\r
- MOVEM AC1,STPY\r
- JRST 0(AC2)\r
-\r
-GTSTOW: POP PP,STPY ;BACK UP A LEVEL\r
- POP PP,STPX\r
- SOS LITLVL\r
- JRST 0(AC2)\r
-\r
- ;EXTERNAL RIGHT\r
-STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER\r
- CAIE AC1,(RC) ;DOES IT MATCH \r
- PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR\r
- HLLZS EXTPNT\r
- POPJ PP, ;EXIT\r
-\r
- ;EXTERNAL LEFT\r
-STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF\r
- CAIE AC1,(RC) ;SEE ABOVE\r
- PUSHJ PP,QEXT\r
- HRRZS EXTPNT\r
- POPJ PP, ;EXIT\r
-\fONC: ILDB C,TABP ;ENTRY TO ADVANCE TAB POINTER\r
- PUSHJ PP,OUTL ;OUTPUT A TAB\r
- ;OUTPUT 6 OCT NUMBERS FROM CS LEFT\r
-ONC1: MOVEI C,6 ;CONVERT TO ASCII\r
- LSHC C,3 ;SHIFT IN OCTAL\r
- PUSHJ PP,OUTL ;OUTPUT ASCII FROM C\r
- TRNE CS,-1 ;ARE WE THROUGH?\r
- JRST ONC1 ;NO, GET ANOTHER\r
- MOVEI C,0 ;CLEAR C\r
- TLNN CS,1 ;RELOCATABLE?\r
- MOVEI C,"'" ;YES\r
- TLNN CS,EXTF ;OR EXTERNAL\r
- MOVEI C,"*" ;YES\r
-ONC2: JUMPN C,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE\r
-IFN FORMSW,< SOS FLDSIZ ;DECREMENT FIELD SIZE>\r
- POPJ PP, ;EXIT\r
-\r
-DNC: IDIVI C,^D10\r
- HRLM CS,0(PP)\r
- JUMPE C,.+2\r
- PUSHJ PP,DNC ;RECURSE IF NON-ZERO\r
- HLRZ C,0(PP)\r
- ADDI C,"0" ;FORM ASCII\r
- JRST PRINT ;DUMP AND TEST FOR END\r
-\r
-OUTAS0: HRLI CS,(POINT 7,,) ;ENTRY TO SET POINTER\r
-OUTASC: ILDB C,CS ;GET NEXT BYTE\r
- JUMPE C,POPOUT ;EXIT ON ZERO DELIMITER\r
- PUSHJ PP,PRINT\r
- JRST OUTASC\r
-\r
-OUTSIX: HRLI CS,(POINT 6,,) ;OUTPUT SIXBIT\r
- ILDB C,CS ;GET SIXBIT\r
- CAIN C,40 ;"@" DELIMITER?\r
- POPJ PP, ;YES, EXIT\r
- ADDI C,40 ;NO, FORM ASCII\r
- PUSHJ PP,OUTL ;OUTPUT ASCII CHAR FROM C\r
- JRST OUTSIX+1\r
-\r
-OUTSYM: MOVE CS,AC0 ;PLACE NAME IN CS\r
-OUTSY1: MOVEI C,0 ;CLEAR C\r
- LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN\r
- JUMPE C,OUTTAB ;TEST FOR END\r
- ADDI C,40 ;CONVERT TO ASCII\r
- PUSHJ PP,OUTL ;OUTPUT\r
- JRST OUTSY1 ;LOOP\r
-\fOUTSET: AOS SX,0(PP) ;GET RETURN LOCATION\r
- MOVE SX,-1(SX) ;GET XWD CODE\r
- HLRM SX,BLKTYP ;SET BLOCK TYPE\r
- SETZB ARG,RC\r
- PUSHJ PP,0(SX) ;GO TO PRESCRIBED ROUTINE\r
- JRST COUTD ;TERMINATE BLOCK AND EXIT\r
-\r
- ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE\r
-\r
-LOOKUP: POP PP,LOOKX ;INTERCEPT RETURN POP\r
- MOVE SX,SYMBOL\r
- MOVE SDEL,0(SX) ;SET FOR TABLE SCAN\r
-LOOKL: SOJL SDEL,POPOUT ;TEST FOR END\r
- ADDI SX,2\r
- MOVE AC0,-1(SX)\r
- PUSHJ PP,SRCH7 ;LOAD REGISTERS\r
- HLRZS ARG\r
- PUSHJ PP,@LOOKX ;RETURN TO CALLING ROUTINE\r
- JRST LOOKL ;TRY AGAIN\r
-\fEND0: PUSHJ PP,EVALCM ;GET A WORD\r
- SKIPE EXTPNT ;ANY EXTERNALS?\r
- TRO ER,ERRE ;YES, ERROR\r
- SKIPN V,AC0 ;NON-ZERO?\r
- JUMPE RC,.+2 ;OR RELOC?\r
- PUSHJ PP,ASSIG7 ;YES, LIST THE VALUE\r
- MOVEM AC0,VECTOR\r
- MOVEM RC,VECREL\r
- PUSHJ PP,VARA ;FILL OUT SELF-DEFINED VARIABLES\r
- PUSHJ PP,STOUTS ;DUMP THE LINE\r
-; PUSH PP,IO ;SAVE FLAGS\r
-; TLO IO,IOPROG ;XLIST LITS\r
- PUSHJ PP,LIT1\r
-; POP PP,IO ;GET FLAG BACK\r
- JUMP2 ENDP2\r
-\r
- PUSHJ PP,UOUT\r
- TLNN IO,MFLSW ;SKIP IF ONLY PSEND\r
- PUSHJ PP,REC2\r
- MOVE INDIR ;SET UP FIRST AS LAST\r
- MOVEM LSTFIL ;PRINTED\r
- SETZM LSTPGN\r
- PUSHJ PP,INZ\r
- TLNE IO,MFLSW ;IF PSEND\r
- POPJ PP, ;BACK TO PSEND0\r
- SKIPE PRGPTR ;HAVE ANY PRGEND'S BEEN SEEN\r
- JRST PSEND3 ;YES,GO SET UP AGAIN\r
-\r
-PASS20: SETZM CTLSAV\r
- PUSHJ PP,COUTI\r
- PUSHJ PP,EOUT ;OUTPUT THE ENTRIES\r
- PUSHJ PP,OUTSET\r
- XWD 6,NOUT ;OUTPUT THE NAME (BLKTYP-6)\r
-IFN RENTSW,<\r
- SKIPN HISNSW ;PUT OUT BLOCK TYPE 3?\r
- JRST PASS21 ;NO\r
- PUSHJ PP,OUTSET\r
- XWD 3,HSOUT ;OUTPUT THE HISEG BLOCK\r
-PASS21: >\r
- MOVEI 1\r
- HRRM BLKTYP ;SET FOR TYPE 1 BLOCK\r
- TLZ FR,P1 ;SET FOR PASS 2 AND TURN OFF FLAG\r
- TLO IO,IOPALL ;PUT THESE BACK\r
- TLZ IO,IOPROG!IOCREF!DEFCRS ;SO LISTINGS WILL BE THE WAY THEY SHOULD\r
- TLNN FR,R1BSW\r
- JRST STOWI\r
- \r
- MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]\r
- MOVE C,0(CS)\r
- PUSHJ PP,PTPBIN\r
- AOBJN CS,.-2\r
- PUSHJ PP,R1BI\r
- JRST STOWI\r
-\f \r
-R1BLDR:\r
- PHASE 0\r
- IOWD $ADR,$ST\r
-$ST: CONO PTR,60\r
- HRRI $A,$RD+1\r
-$RD: CONSO PTR,10\r
- JRST .-1\r
- DATAI PTR,@$TBL1-$RD+1($A)\r
- XCT $TBL1-$RD+1($A)\r
- XCT $TBL2-$RD+1($A)\r
-$A: SOJA $A,\r
-$TBL1: CAME $CKSM,$ADR\r
- ADD $CKSM,1($ADR)\r
- SKIPL $CKSM,$ADR\r
-$TBL2: JRST 4,$ST\r
- AOBJN $ADR,$RD\r
-$ADR: JRST $ST+1\r
-$CKSM: \r
- DEPHASE\r
-\r
-IF2,< PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>\r
-\fENDP2: PUSHJ PP,COUTD ;DUMP THE BUFFER\r
- MOVE AC0,LOCO ;CHECK TO SEE IF LIT DIFFERED\r
- SKIPN MODO ;AND USE SMALLER SINCE AT END\r
- JRST [CAMN AC0,ABSHI\r
- HRRZM AC2,ABSHI\r
- JRST ENDP2W]\r
-IFN RENTSW,<SKIPE HHIGH ;SKIP IF NOT TWO SEGMENTS\r
- JRST [CAMN AC0,HHIGH\r
- HRRZM AC2,HHIGH\r
- JRST ENDP2W]>\r
- CAMN AC0,HIGH\r
- HRRZM AC2,HIGH\r
-ENDP2W:\r
-REPEAT 1,<TLNE IO,IOCREF ;CLOSE CREF IF NECESSARY>\r
-REPEAT 0,<TLNE FR,CREFSW ;IF CREFFING\r
- JRST ENDP2Q\r
- MOVEI SDEL,0\r
- PUSH PP,DBUF+3 ;SO NO PAGE INFO\r
- DPB SDEL,[POINT 7,DBUF+3,13]\r
- IOR ER,OUTSW ;MAKE SURE OF OUTPUT\r
- PUSHJ PP,CREF\r
- MOVEI C,20 ;CODE FOR TITLE\r
- PUSHJ PP,OUTLST\r
- PUSH PP,IO ;SAVE THIS\r
- TLZ IO,IOPAGE ;AND PREVENT PAGE DURING TITLE\r
- MOVEI CS,TBUF\r
- PUSHJ PP,OUTAS0\r
- MOVEI CS,VBUF\r
- PUSHJ PP,OUTAS0\r
- POP PP,IO ;RESTORE THE IO WORD\r
- POP PP,DBUF+3 > ;NEEDS FIX TO CREF\r
- PUSHJ PP,CLSCR2 ;CLOSE IT UP\r
-ENDP2Q: HRR ER,OUTSW ;SET OUTPUT SWITCH\r
- SKIPN TYPERR\r
- TRO ER,TTYSW\r
- PUSHJ PP,UOUT ;OUTPUT UNDEFINEDS\r
- TRO ER,TTYSW\r
- SKPINC C ;SEE IF WE CAN INPUT A CHAR.\r
- JFCL ;BUT ONLY TO DEFEAT ^O\r
- SKIPG C,ERRCNT ;GET ERROR COUNT AND CHECK FOR POSITIVE\r
- JRST NOERW ;PRINT NO ERROR MESSAGE\r
-IFN CCLSW,<ADDM C,JOBERR ;REMEMBER ERROR COUNT FOR EXECUTION DELETION>\r
- PUSHJ PP,OUTCR\r
- MOVE C,ERRCNT\r
- CAIN C,1 ;1 IS A SPECIAL CASE\r
- JRST ONERW ;PRINT MESSAGE\r
- MOVEI C,"?" ;? FOR BATCH\r
- PUSHJ PP,OUTL ;...\r
- MOVE C,ERRCNT ;PRINT NUMBER OF ERRORS\r
- PUSHJ PP,DNC\r
- SKIPA CS,[EXP ERRMS1] ;LOAD TO PRINT\r
-ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DETECTED\r
-ONERW1: PUSHJ PP,OUTSIX ;PRINT\r
- JRST ENDP2A\r
-NOERW: MOVEI CS,ERRMS3\r
-IFN CCLSW,<TLNE IO,CRPGSW!MFLSW ;IF RPG, DON'T PRINT MESSAGE>\r
-IFE CCLSW,<TLNE IO,MFLSW ;NOR IF MULTI-FILE MODE>\r
- TRZ ER,TTYSW ;NO TTY OUTPUT\r
- IOR ER,OUTSW ;UNLESS NEEDED FOR LISTING\r
- PUSHJ PP,OUTCR\r
- JRST ONERW1\r
-\r
-\fENDP2A: PUSHJ PP,OUTCR\r
- TLNN IO,MFLSW ;IN A MULTI-PROG FILE?\r
- JRST ENDP2D ;NO\r
- SKIPE ERRCNT ;ANY ERROR?\r
- PUSHJ PP,[MOVEI CS,[ASCIZ /PROGRAM /]\r
- PUSHJ PP,OUTAS0 ;YES,SO PRINT MESSAGE\r
- MOVEI CS,TBUF ;AND TITLE\r
- PUSHJ PP,OUTAS0 ;FOR IDENTIFICATION\r
- JRST OUTCR] ;AND A CR-LF\r
- TRZA ER,TTYSW ;NO MORE OUTPUT NOW\r
-ENDP2D:\r
-IFN CCLSW,<TLNE IO,CRPGSW ;IF RPG, DON'T PRINT PGM BREAK\r
- TRZ ER,TTYSW ;...>\r
-IFE CCLSW,< SKIPA ;SO PRGEND CODE CAN WORK>\r
- IOR ER,OUTSW ;...\r
- PUSHJ PP,OUTCR\r
-IFN RENTSW,<\r
- MOVEI CS,[SIXBIT /HI-SEG. BREAK IS @/]\r
- SKIPN HHIGH ;DON'T PRINT IF ZERO\r
- JRST ENDP2C ;IT WAS\r
- PUSHJ PP,OUTSIX\r
- HRLO CS,HHIGH ;GET THE BREAK\r
- PUSHJ PP,ONC1\r
- PUSHJ PP,OUTCR\r
-ENDP2C:>\r
- MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/]\r
- PUSHJ PP,OUTSIX ;OUTPUT PROGRAM BREAK\r
- HRRZ CS,ABSHI ;GET ABS. BREAK\r
- CAIG CS,140 ;ANY ABS. CODE\r
- JRST [HRLO CS,HIGH ;NO\r
- JRST ENDP2B] ;SO DON'T PRINT\r
- HRLO CS,HIGH ;GET PROGRAM BREAK\r
- PUSHJ PP,ONC1\r
- PUSHJ PP,OUTCR\r
- MOVEI CS,[SIXBIT /ABSLUTE BREAK IS @/]\r
- PUSHJ PP,OUTSIX\r
- HRLO CS,ABSHI\r
-ENDP2B: PUSHJ PP,ONC1\r
- PUSHJ PP,OUTCR\r
- TLNE FR,RIMSW!R1BSW ;RIM MODE?\r
- PUSHJ PP,RIMFIN ;YES, FINISH IT\r
-IFN CCLSW,<TLNN IO,CRPGSW!MFLSW ;IF NOT IN CCL MODE>\r
-IFE CCLSW,<TLNN IO,MFLSW ;NOR IF IN MULTI-FILE MODE>\r
- TRO ER,TTYSW ;PRINT SIZE\r
- PUSHJ PP,OUTCR\r
- MOVE C,JOBREL\r
- LSH C,-^D10\r
- ADDI C,1\r
- PUSHJ PP,DNC\r
- MOVEI CS,[SIXBIT /K CORE USED@/]\r
- PUSHJ PP,OUTSIX\r
- PUSHJ PP,OUTCR \r
- HRR ER,OUTSW\r
- PUSHJ PP,OUTSET\r
- XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2)\r
- PUSHJ PP,OUTSET\r
- XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7)\r
-IFN WFWSW,<PUSHJ PP,OUTSET ;OUTPUT THE LVAR FIXUPS\r
- XWD 13,OUTB12>\r
- PUSHJ PP,OUTSET\r
- XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5)\r
- PUSHJ PP,COUTD\r
- TLNN IO,MFLSW ;IS IT PRGEND?\r
- JRST FINIS ;ALAS, FINISHED\r
- MOVEI CS,SBUF ;RESET SBUF POINTER\r
- HRRM CS,SUBTTX ;TO SUBTTL\r
- SETZM PASS2I ;CLEAR PASS2 VARIABLES\r
- MOVE [XWD PASS2I,PASS2I+1]\r
- BLT PASS2Z-1 ;BUT NOT ALL OF VARIABLES\r
- JRST INZ ;RE-INITIALIZE FOR NEXT PROG\r
-\fIFN WFWSW,<\r
-OUTB12: SKIPN ARG,FIXLNK ;WERE THERE ANY??\r
- POPJ PP, ;JUST GO AWAY\r
-OUTB19: HRRZ SX,(ARG) ;POINTER TO HEADER BLOCK NOW IN SX\r
- HRRZ AC1,(SX) ;NOW AC1 HAS POINTER TO CODE FIXUPS\r
- JUMPE AC1,OUTB13 ;NONE THERE\r
-OUTB16: HLRZ AC0,(AC1) ;GET LOCATION OFFSET\r
- ADD AC0,2(SX) ;ADD BASE LOCATION\r
- SKIPN 1(AC1) ;AND RIGHT HALF??\r
- JRST OUTB14 ;NO\r
- PUSH PP,AC0 ;SAVE FIXUP VALUE\r
- SETZB AC0,RC\r
- PUSHJ PP,OUTBWD ;OUTPUT A Z (SAYS RIGHT HALF CODE)\r
- POP PP,AC0 ;GET VALUE BACK\r
- HLRZ RC,1(AC1) ;GET RELOC OF FIXUP CHAIN\r
- LSH RC,1 ;GOES IN LEFT HALF\r
- HRL AC0,1(AC1) ;LOCATION OF CHAIN\r
- PUSHJ PP,OUTBWD ;LEFT HALF LOCATION, RIGHT HALF VALUE\r
-OUTB14: SKIPN 2(AC1) ;ANY LEFT HALF??\r
- JRST OUTB15 ;NO, GO LOOK FOR NEXT BLOCK\r
- PUSH PP,AC0 ;SAVE VALUE\r
- MOVEI RC,0\r
- MOVSI AC0,400000 ;INDICATE LEFT HALF\r
- PUSHJ PP,OUTBWD\r
- POP PP,AC0\r
- HLRZ RC,2(AC1) ;GET RELOC FOR LEFT HALF\r
- LSH RC,1\r
- HRL AC0,2(AC1)\r
- PUSHJ PP,OUTBWD\r
-OUTB15: HRRZ AC1,(AC1) ;NEXT LINK IN CHAIN\r
- JUMPN AC1,OUTB16 ;IF NOT END, PROCESS\r
-OUTB13: HLRZ AC1,(SX) ;POINTER TO SYMBOL TABLE FIXUP CHAIN\r
- JUMPE AC1,OUTB17 ;CHACK FOR SOME THERE\r
-OUTB18: MOVE AC0,2(AC1) ;FLAGS\r
- HRR AC0,2(SX) ;VALUE IN RH\r
- MOVEI RC,0 ;NO RELCO ON IT\r
- PUSHJ PP,OUTBWD\r
- MOVE AC0,1(AC1) ;THE SYMBOL NAME\r
- PUSHJ PP,OUTBWD\r
- HRRZ AC1,(AC1) ;FOOLOW CHAIN\r
- JUMPN AC1,OUTB18\r
-OUTB17: HRRZ ARG,-1(ARG) ;DONE WITH THIS SYMBOL GET NEXT\r
- JUMPN ARG,OUTB19\r
- POPJ PP, ;ALL DONE\r
-\f\r
-OUTBWD: SKIPL COUTX ;IF WE ARE AT THE START\r
- JRST COUT ;NO PUT OUT\r
- PUSH PP,AC0 ;WE NEED TO PUT NEW RELOC AND VAR LENGTH\r
- PUSH PP,RC ;AS FIRST TWO WORDS\r
- MOVE AC0,HIGH\r
- MOVEI RC,1 ;IT IS RELOC\r
- PUSHJ PP,COUT\r
- MOVE AC0,LVARLC ;THE LENGTH\r
- MOVEI RC,0\r
- PUSHJ PP,COUT\r
- POP PP,RC\r
- POP PP,AC0\r
- JRST COUT ;NOW PUT OUT THE ONE WE WANTED TO\r
->\r
-\r
-RIMFIN: TLNE FR,R1BSW\r
- PUSHJ PP,R1BDMP\r
- SKIPN C,VECTOR\r
- MOVSI C,(JRST 4,)\r
- TLNN C,777000\r
- TLO C,(JRST)\r
- PUSHJ PP,PTPBIN\r
- MOVEI C,0\r
- JRST PTPBIN\r
-\fSUBTTL PASS INITIALIZE\r
-INZ: AOS MODA\r
- AOS MODO\r
- SETZM SEQNO\r
- SETZM TAG\r
- HRRI RX,^D8\r
- MOVEI VARHD\r
- MOVEM VARHDX\r
- MOVEI LITHD\r
- MOVEM LITHDX\r
- PUSHJ PP,LITI\r
- PUSHJ PP,STOWI\r
-IFN FORMSW,<\r
- HRRES HWFMT ;SET DEFAULT VALUE BACK>\r
- JRST OUTLI\r
-\r
-RCPNTR: POINT 1,ARG,^L<RELF>-18 ;POINT 1,ARG,22\r
-\fSUBTTL PSEUDO-OP HANDLERS\r
-\r
-TAPE0: PUSHJ PP,STOUTS ;FINISH THIS LINE\r
- JRST GOTEND ;AND IGNORE THE REST OF THIS FILE\r
-\r
-RADIX0: PUSHJ PP,EVAL10 ;EVALUATE RADIX D10\r
- CAIG AC0,^D10 ;IF GREATER THAN 10\r
- CAIG AC0,1 ;OR LESS THAN 2,\r
-ERRAX: TROA ER,ERRA ;FLAG ERROR AND SKIP\r
- HRR RX,AC0 ;SET NEW RADIX\r
- POPJ PP,\r
-\r
-\r
-XALL0: TLZ IO,IOSALL ;TURN OFF MACRO SUPPRESS ALL\r
-IOSET: JUMP1 POPOUT ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)\r
- HLRZ SX,AC0 ;STORE FLAGS\r
- PUSHJ PP,STOUTS ;POLISH OFF LINE\r
- TLO IO,0(SX) ;NOW SUPRESS PRINTING\r
- POPJ PP,\r
-\r
-IORSET: TDZ IO,AC0 ;RESET FLAG IOPALL/IOPROG\r
- TLNE AC0,IONCRF ;RESTORING CREFFING?\r
- TLZ IO,DEFCRS ;YES, CLEAR ANY WAITING DEFINING OCCURENCES\r
- POPJ PP,\r
-\r
-BLOCK0: PUSHJ PP,HIGHQ\r
- PUSHJ PP,EVALEX ;EVALUATE\r
- TRZE RC,-1 ;EXTERNAL OR RELOCATABLE?\r
- PUSHJ PP,QEXT ;YES, DETERMINE TYPE\r
- ADDM AC0,LOCO ;UPDATE ASSEMBLY LOCATION\r
-BLOCK1: EXCH AC0,LOCA ;SAVE START OF BLOCK\r
- ADDM AC0,LOCA ;UPDATE OUTPUT LOCATION\r
-BLOCK2: HRLOM AC0,LOCBLK\r
- JUMP2 POPOUT\r
- TRNE ER,ERRU\r
- TRO ER,ERRV\r
- POPJ PP,\r
-\f\r
-PRNTX0: TRO ER,TTYSW ;SET OUTPUT TO TTY\r
- JUMP2 PRNTX2 ;PASS1?\r
- TDOA ER,OUTSW ;YES,OUTPUT TO LSTDEV ALSO\r
-PRNTX2: ANDCM ER,OUTSW ;NO,DON'T OUTPUT TO TTY IF IT IS LSTDEV\r
- PUSHJ PP,BYPASS ;GET FIRST CHAR.\r
- TLOA IO,IORPTC ;REPEAT IT AND SKIP\r
-PRNTX4: PUSHJ PP,PRINT ;PRINT THE CHAR.\r
- PUSHJ PP,CHARAC ;GET ASCII CHAR.\r
- CAIG C,CR ;IF GREATER THAN CR\r
- CAIG C,HT ;OR LESS THAN LF\r
- JRST PRNTX4 ;THEN CONTINUE\r
- PUSHJ PP,OUTCR ;OUTPUT A CRLF\r
- TRZA ER,TTYSW!LPTSW ;TURN OF OUTPUT\r
-CPOPJ1: AOS (PP) ;USEFUL TAG HAS TO GO SOMEWHERE\r
-CPOPJ: POPJ PP, ;EXIT\r
-\r
-REMAR0: PUSHJ PP,GETCHR ;GET A CHARACTER\r
- CAIE C,EOL\r
- JRST REMAR0\r
- POPJ PP, ;EXIT\r
-\fLIT0: PUSHJ PP,BLOCK1\r
- PUSHJ PP,STOUTS\r
-LIT1: JUMP2 LIT20\r
-\r
-;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR\r
-\r
- MOVE AC0,LITCNT\r
- MOVE SX,LITHDX\r
- HRLM AC0,0(SX)\r
- MOVE V,LOCA\r
- HRL V,MODA\r
- MOVEM V,-1(SX)\r
- JRST LIT24\r
-\r
-LIT20: PUSH PP,LOCA\r
- PUSH PP,LOCO\r
- SKIPN LITNUM\r
- JRST LIT20A\r
- MOVE SX,LITHDX\r
- HRRZ AC0,-1(SX)\r
- CAME AC0,LOCA\r
- TRO ER,ERRP\r
-LIT20A: MOVE SX,LITAB\r
-LIT21: SOSGE LITNUM\r
- JRST LIT22\r
-IFN FORMSW,<\r
- MOVE AC0,-3(SX)\r
- MOVEM AC0,FORM\r
->\r
- MOVE AC0,-2(SX) ;WFW\r
- MOVE RC,-1(SX) ;WFW\r
- MOVE SX,(SX) ;WFW POINTER TO THE NEXT LIT\r
- PUSHJ PP,STOW20 ;STOW CODE\r
- MOVEI C,12 ;SET LINE FEED\r
- IDPB C,LBUFP\r
- PUSHJ PP,OUTLIN ;OUTPUT THE LINE\r
- JRST LIT21\r
-\fLIT22: HRRZ AC2,LOCO\r
- POP PP,LOCO\r
- POP PP,LOCA\r
- MOVE SX,LITHDX\r
- HLRZ AC0,0(SX)\r
- SUB AC2,LOCO ;COMPUTE LENGTH USED\r
- CAMGE AC0,AC2 ;USE LARGER\r
- MOVE AC0,AC2\r
- ADD AC2,LOCO\r
-LIT24: ADDM AC0,LOCA\r
- ADDM AC0,LOCO\r
- PUSHJ PP,GETTOP\r
- HRRM SX,LITHDX\r
-LITI: SETZM LITCNT\r
- SETZM LITNUM\r
- MOVEI LITAB\r
- MOVEM LITABX\r
- JRST HIGHQ\r
-\r
-GETTOP: HRRZ AC1,SX ;VARHD\r
- HRRZ SX,0(SX)\r
- JUMPN SX,POPOUT\r
-IFE FORMSW,< MOVEI SX,3 ;WFW>\r
-IFN FORMSW,< MOVEI SX,4 ;ICC>\r
- ADDB SX,FREE\r
- CAML SX,SYMBOL\r
- PUSHJ PP,XCEED\r
- SUBI SX,1 ;MAKE SX POINT TO LINK\r
- SETZM 0(SX) ;CLEAR FORWARD LINK\r
- HRRM SX,0(AC1) ;STORE ADDRESS IN LAST LINK\r
- POPJ PP,\r
-\fVAR0: PUSHJ PP,BLOCK1 ;PRINT LOCATION\r
- PUSHJ PP,VARA\r
- JRST STOUTS\r
-\r
-VARA: MOVE SX,VARHDX\r
- MOVE AC0,LOCA ;GET LOCATION FOR CHECK\r
- JUMP1 VARB ;DO NOT CHECK START ON PASS 1\r
- CAME AC0,-1(SX) ;CHECK START OF VAR AREA\r
- TRO ER,ERRP ;AND GIVE ERROR\r
-VARB: MOVEM AC0,-1(SX) ;SAVE START FOR PASS 2\r
- HLRZ AC0,0(SX)\r
- ADDM AC0,LOCA\r
- ADDM AC0,LOCO\r
- PUSHJ PP,GETTOP\r
- HRRM SX,VARHDX\r
- JUMP2 POPOUT\r
-\r
- PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
-IFN WFWSW,<TRNN ARG,EXTF ;IN CASE LVAR HAS BEEN THROUGH>\r
- TRZN ARG,VARF\r
- POPJ PP, ;NO, EXIT\r
- TRZ ARG,UNDF ;TURN OFF FLAG NOW\r
-IFN WFWSW,<MOVSI AC0,1(V) ;NUMBER TO ADD TO>\r
-IFE WFWSW,<MOVSI AC0,1 ;ADD 1>\r
- ADDM AC0,0(AC1) ;UPDATE COUNT\r
-IFN WFWSW,<\r
-VARA1: ADDI V,1 ;GET LENGTH OF DESIRED BLOCK\r
- ADDM V,LOCO\r
- EXCH V,LOCA\r
- ADDM V,LOCA\r
- HRL ARG,V ;GET STARTING LOCATION AND UPDAT PCS\r
->\r
-\r
- IOR ARG,MODA ;SET TO ASSEMBLY MODE\r
-IFE WFWSW,<HRL ARG,LOCA>\r
- MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY\r
-IFE WFWSW,<AOS LOCA\r
- AOS LOCO>\r
- JRST HIGHQ1\r
-\fIF: PUSH PP,AC0 ;SAVE AC0\r
- PUSH PP,IO\r
- PUSHJ PP,EVALXQ ;EVALUATE AND TEST EXTERNAL\r
- POP PP,AC1\r
- JUMPL AC1,IFPOP\r
- TLZ IO,FLDSW\r
-IFPOP: POP PP,AC1 ;RETRIEVE SKIP INSTRUCTION\r
-IFSET: TLO IO,IORPTC ;REPEAT CHARACTER\r
-IFXCT: XCT AC1 ;EXECUTE INSTRUCTION\r
- TDZA AC0,AC0 ;FALSE\r
- MOVEI AC0,1 ;TRUE\r
-IFEXIT: JUMPOC REPEA1 ;BRANCH IF IN OP-CODE FIELD\r
-IFEX1: PUSHJ PP,GETCHR ;SEARCH FOR "<"\r
- CAIN C,EOL ;ERROR IF END OF LINE\r
- JRST ERRAX\r
- CAIE C,34\r
- JRST IFEX1\r
- JUMPE AC0,IFEX2 ;TEST FOR 0\r
- TLO IO,IORPTC ;NO, PROCESS AS CELL\r
- PUSHJ PP,CELL\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>\r
- SETZM INCND ;NOT ANY MORE\r
- JRST STOW ;STOW CODE AND EXIT\r
-\r
-IFPASS: HRRI AC0,P1 ;MAKE IT TLNX IO,P1\r
- MOVE AC1,AC0 ;PLACE IT IN AC1\r
- JRST IFSET ;EXECUTE INSTRUCTION\r
-\r
-IFB0: HLLO AC1,AC0 ;FORM AND STORE TEST INSTRUCTION\r
-IFB1: PUSHJ PP,CHARL ;GET FIRST NON-BLANK\r
- CAIE C," "\r
- CAIN C," "\r
- JRST IFB1 ;SKIP BLANKS AND TABS\r
- CAIG C,CR ;CHECK FOR CARRET AS DELIM.\r
- CAIGE C,LF\r
- SKIPA SX,SEQNO2\r
- JRST ERRAX\r
- MOVEM SX,CNDSEQ\r
- MOVE SX,PAGENO\r
- MOVEM SX,CNDPG\r
- SETOM INCND ;SAVE INFO. FOR PASS 1 ERRORS\r
- CAIN C,"<" ;LEFT BRACKET?\r
- SETZB C,RC ;YES, PREPARE FOR OLD FORMAT\r
- SKIPA SX,C ;SAVE FOR COMPARISON\r
-IFB3: TRO AC0,1 ;SET FLAG\r
-IFB2: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST\r
- CAMN C,SX ;TEST FOR DELIMITER\r
- JRST IFXCT ;FOUND\r
- CAIE C," " ;BLANK?\r
- CAIN C," " ;OR TAB?\r
- JRST IFB2 ;YES\r
- JUMPN SX,IFB3 ;JUMP IF NEW FORMAT\r
- CAIN C,"<" ;<?\r
- AOJA RC,IFB2 ;YES, INCREMENT COUNT\r
- CAIN C,">" ;>?\r
- SOJL RC,IFXCT ;YES, DECREMENT AND EXIT IF DONE\r
- JRST IFB3 ;GET NEXT CHARACTER\r
-\r
-\fIFDEF0: HRRI AC0,UNDF ;MAKE IT TLNX ARG,UNDF\r
- PUSH PP,AC0 ;STACK IT\r
- PUSHJ PP,GETSYM ;TAKES SKIP RETURN IF SYM NAME IS LEGAL\r
- TROA ER,ERRA ;ILLEGAL!\r
- PUSHJ PP,SEARCH\r
- JRST [PUSHJ PP,OPTSCH\r
- TLO ARG,UNDF\r
- JRST .+1]\r
- PUSHJ PP,SSRCH3 ;EMIT TO CREF ANYWAY\r
- JRST IFPOP ;POP AND EXECUTE INSTRUCTION\r
-\r
-\fIFIDN0: HLRZS AC0\r
- MOVEI V,2*.IFBLK-1\r
- SETZM IFBLK(V) ;CLEAR COMPARISON BLOCK\r
- SOJGE V,.-1\r
- SETZM .TEMP ;CLEAR STORED DELIMETER\r
- MOVEI RC,IFBLK ;SET FOR FIRST BLOCK\r
- PUSHJ PP,IFCL ;GET FIRST STRING\r
- MOVEI RC,IFBLKA\r
- PUSHJ PP,IFCL ;GET SECOND STRING\r
- MOVEI V,.IFBLK-1\r
- MOVE SX,IFBLK(V) ;GET WORD FROM FIRST STRING\r
- CAMN SX,IFBLKA(V) ;COMPARE WITH SECOND STRING\r
- SOJGE V,.-2 ;EQUAL, TRY NEXT WORD\r
- JUMPL V,IFEXIT ;DID WE FINISH STRING\r
- XORI AC0,1 ;NO, TOGGLE REQUEST\r
- JRST IFEXIT ;DO NOT TURN ON IORPTC WFW\r
-\r
-IFCL: PUSHJ PP,CHARAC ;GET AND LIST CHARACTER\r
- CAIE C," " ;SKIP SPACES\r
- CAIG C,CR ;ALSO SKIP CR-LF\r
- CAIGE C,HT ;AND TAB\r
- JRST .+2 ;NOT ONE OF THEM\r
- JRST IFCL ;SO LONG COMPARISONS WILL WORK\r
-;*** A CROCK SO THAT IFIDN <X>,<X>,<INST.> WILL WORK ***\r
- CAIE C,"," ;IS IT A COMMA?\r
- JRST .+3 ;NO\r
- SKIPN .TEMP ;YES, WAS PREVIOUS FIELD OLD METHOD?\r
- JRST IFCL ;YES, IGNORE COMMA AND SPACES\r
-; ***\r
- CAIN C,"<" ;WAS IT LEFT BRACKET?\r
- SETO C, ;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET\r
- MOVEM C,.TEMP ;STORE TERMINATOR FOR COMPARISON\r
- MOVEI SX,5*.IFBLK-1 ;LIMIT SEARCH\r
- HRLI RC,(POINT 7,,) ;SET UP BYTE IN RC\r
-IFCLR: PUSHJ PP,CHARAC\r
- SKIPLE .TEMP ;NEW METHOD?\r
- JRST IFCLR1 ;YES, IGNORE ANGLE BRACKET COUNTING\r
- CAIN C,"<" ;ANOTHER LEFT ANGLE?\r
- SOS .TEMP ;YES, KEEP COUNT\r
- CAIN C,">" ;CLOSING ANGLE\r
- AOSGE .TEMP ;MATCHING COUNT?\r
-IFCLR1: CAMN C,.TEMP ;TEST FOR DELIMITER\r
- POPJ PP, ;EXIT ON RIGHT DELIMITER\r
- SOJG SX,.+2 ;ANY ROOM IN COMPARISON BLOCK?\r
- TROA ER,ERRA ;NO, FLAG ERROR BUT KEEP ON GOING\r
- IDPB C,RC ;DEPOSIT BYTE\r
- JRST IFCLR\r
-\r
-\f\r
-IFEX2: PUSHJ PP,GETCHR\r
- CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE\r
- JRST ERRAX\r
- CAIN C,34 ;"<"?\r
- AOJA AC0,IFEX2 ;YES, INCREMENT COUNT\r
- CAIE C,36 ;">"?\r
- JRST IFEX2 ;NO, TRY AGAIN\r
- SOJGE AC0,IFEX2 ;YES, TEST FOR MATCH\r
- PUSHJ PP,BYPASS ;YES, MOVE TO NEXT DELIMITER\r
- SETZM INCND ;OUT OF CONDITIONAL NOW\r
- AOJA AC0,STOWZ1 ;STOW ZERO\r
-\r
-\r
-INTER0: HLLZM AC0,INTENT ;AC0 CONTAINS INTF/ENTF FLAGS\r
-\r
-INTER1: PUSHJ PP,GETSYM ;GET A SYMBOL\r
- JRST INTER3 ;INVALID, SKIP\r
- PUSHJ PP,SSRCH ;SEARCH THE TABLE\r
- MOVSI ARG,SYMF!INTF!UNDF\r
- TLNE ARG,UNDF ;UNDEFINED?\r
- TRO ER,ERRA ;YES, FLAG ERROR\r
-IFN WFWSW,<TLNN ARG,VARF ;LET HIM MAKE INTERNAL EVEN IF EXTF ON>\r
- TLNN ARG,SYNF!EXTF\r
- TDOA ARG,INTENT ;SET APPROPRIATE FLAGS\r
-INTER3: TROA ER,ERRA ;FLAG ARG EROR AND SKIP\r
- PUSHJ PP,INSERQ ;INSERT/UPDATE\r
- JUMPCM INTER1\r
- SETZM EXTPNT ;JUST IN CASE, SO AS NOT TO CONFUSE WORLD\r
- POPJ PP, ;NO, EXIT\r
-\fEXTER0: PUSHJ PP,GETSYM ;GET A SYMBOL\r
- JRST EXTER4 ;INVALID, ERROR\r
-EXTER1: TLO IO,DEFCRS ;FLAG THIS AS A DEFINITION\r
- PUSHJ PP,SSRCH ;OK, SEARCH SYMBOL TABLE\r
- JRST EXTER2 ;NOT THERE, INSERT IT\r
- TLNN ARG,EXTF!VARF!UNDF\r
- TROA ER,ERRE ;FLAG ERROR AND BYPASS\r
- TLNE ARG,EXTF ;VALID, ALREADY DEFINED?\r
- JRST [JUMP1 EXTER3 ;YES, BYPASS\r
- TLZN ARG,UNDF ;SKIP IF UNDEFINED ALSO\r
- JRST EXTER3 ;CONTINUE\r
- ANDM ARG,(SX) ;CLEAR UNDF ON PASS 2\r
- JRST EXTER2] ;SET UP EXTERNAL NOW\r
-EXTER2: MOVEI V,2 ;NO, GET 2 CELLS FROM THE TREE\r
- ADDB V,FREE\r
- CAML V,SYMBOL ;HAVE WE RUN OUT OF CORE?\r
- PUSHJ PP,XCEEDS ;YES, TRY TO BORROW SOME MORE\r
- SUBI V,2 ;GET RIGHT CELL FOR POINTER\r
- SETZB RC,0(V) ;ALL SET, ZERO VALUES\r
- MOVSI ARG,SYMF!EXTF\r
- PUSHJ PP,INSERT ;INSERT/UPDATE IT\r
- MOVSI ARG,PNTF\r
- IORM ARG,0(SX)\r
- SKIPA ARG,-1(SX) ;GET THE SIXBIT FOR THE NAME\r
-EXTER4: TROA ER,ERRA ;FLAG AS ERROR\r
- MOVEM ARG,1(V) ;AND STORE THAT IN CASE SYMBOL TABLE MOVES\r
-EXTER3: JUMPCM EXTER0\r
- POPJ PP, ;NO, EXIT\r
-\fEVAL10: PUSH PP,RX\r
- HRRI RX,^D10\r
- PUSHJ PP,EVALEX ;EVALUATE\r
- POP PP,RX ;RESET RADIX\r
- JUMPE RC,POPOUT ;EXIT IF ABSOLUTE\r
-\r
-QEXT: SKIPE EXTPNT ;ANY POSSIBILITIES?\r
- TROA ER,ERRE ;YES, FLAG EXTERNAL ERROR\r
- TRO ER,ERRR ;NO, FLAG RELOCATION ERROR\r
- HLLZS RC ;CLEAR RELOCATION/EXTERNAL\r
- POPJ PP,\r
-\r
-EVALXQ: PUSHJ PP,EVALEX ;EVALUATE EXPRESSION\r
- TLZN RC,-2 ;LEFT HALF EXTERNAL\r
- TRZE RC,-2 ;WAS AN EXTERNAL FOUND?\r
- TRO ER,ERRE ;YES, FLAG ERROR\r
- POPJ PP, ;RETURN\r
-\fOPDEF0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL\r
- POPJ PP, ;ERROR IF INVALID SYMBOL\r
- CAIE C,73 ;"["?\r
- JRST ERRAX ;NO, ERROR\r
- PUSH PP,AC0 ;STACK MNEMONIC\r
- AOS LITLVL ;SHORT OUT LOCATION INCREMENT\r
- PUSHJ PP,STMNT ;EVALUATE STATEMENT\r
- SKIPGE STPX ;CODE STORED?\r
- TROA ER,ERRA ;NO,"A" ERROR\r
- PUSHJ PP,DSTOW ;GET AND DECODE VALUE\r
- SOS LITLVL\r
- EXCH AC0,0(PP) ;EXCHANGE VALUE FOR MNEMONIC\r
- PUSH PP,RC ;STACK RELOCATION\r
- TLO IO,DEFCRS ;SAY WE ARE DEFINING IT\r
- PUSHJ PP,MSRCH ;SEARCH SYMBOL TABLE\r
- MOVSI ARG,OPDF ;NOT FOUND\r
- POP PP,RC ;RESTORE VALUES\r
- POP PP,V\r
- TLNE ARG,SYNF!MACF\r
- TRO ER,ERRA ;YES "A" ERROR\r
- TRNN ER,ERRA ;ERROR?\r
- PUSHJ PP,INSERT ;NO, INSERT/UPDATE\r
- TLZ IO,DEFCRS ;JUST IN CASE\r
- PUSHJ PP,BYPASS\r
- JRST STOWI ;BE SURE STOW IS RESET\r
-\r
-\r
-DEPHA0: MOVE AC0,LOCO\r
- SKIPA RC,MODO ;SET TO OUTPUT VALUES AND SKIP\r
-PHASE0: PUSHJ PP,EVALXQ ;EVALUATE AND CHECK FOR EXTERNAL\r
- MOVEM AC0,LOCA ;SET ASSEMBLY LOCATION COUNTER\r
- MOVEM RC,MODA\r
- JRST BLOCK2\r
-\fASSIGN: JUMPAD ERRAX ;NO, ERROR\r
- PUSHJ PP,ASSIG1\r
- TLNE IO,IOSALL ;SUPPRESS ALL?\r
- JUMPN MRP,CPOPJ ;IF IN MACRO\r
-ASSIG7: MOVEM RC,ASGBLK\r
- TRNE RC,-2 ;EXTERNAL\r
- HLLZS ASGBLK ;YES,CLEAR RELOCATION\r
- TLNE RC,1 ;LEFT HALF NOT RELOC?\r
- TLNE RC,-2 ;...\r
- HRROS ASGBLK ;YES, SET FLAG\r
- MOVEM V,LOCBLK\r
- POPJ PP,\r
-\r
-ASSIG1: PUSH PP,AC0 ;SAVE SYMBOL\r
- SETZB AC0,EXTPNT ;SPECIAL CHECK FOR == WFW\r
- PUSHJ PP,PEEK ;IS THE NEXT ON =\r
- CAIE C,"="\r
- JRST ASSIG5\r
- TLO AC0,NOOUTF ;YES, NOT OUT TO DDT WFW\r
- PUSHJ PP,GETCHR ;PROCESS THE CHAR.\r
- PUSHJ PP,PEEK ;CHECK FOR ==: DMN\r
-ASSIG5: CAIE C,":" ;IS IT\r
- JRST ASSIG6 ;NO\r
- TLO AC0,INTF ;MAKE INTERNAL\r
- PUSHJ PP,GETCHR ;REPEAT IT\r
-ASSIG6: MOVEM AC0,HDAS ;STORE THESE BITS WFW\r
- PUSHJ PP,EVALCM ;EVALUATE EXPRESSION\r
- EXCH AC0,0(PP) ;SWAP VALUE FOR SYMBOL\r
- PUSH PP,RC\r
- TRNN RC,-2 ;CHECK EXTERNAL AGREEMENT\r
- JRST ASSIG2\r
- HRRZS RC\r
- HRRZ ARG,EXTPNT\r
- CAME RC,ARG\r
- PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR\r
-ASSIG2: HLRZ RC,(PP)\r
- TRNN RC,-2\r
- JRST ASSIG3\r
- HLRZ ARG,EXTPNT\r
- CAME RC,ARG\r
- PUSHJ PP,QEXT\r
-ASSIG3: TLO IO,DEFCRS\r
- PUSHJ PP,SSRCH\r
- MOVSI ARG,SYMF\r
- IOR ARG,HDAS ;WFW\r
- TLNE ARG,UNDF ;WAS IT UNDEFINED\r
- TLZ ARG,EXTF!PNTF ;YES,CLEAR EXTF NOW\r
- TLZ ARG,UNDF!VARF ;CANCEL UNDEFINED AND VARIABLE FLAGS\r
- SETZM EXTPNT ;FOR REST OF WORLD\r
- POP PP,RC\r
- TRNE ER,ERRORS-ERRQ\r
- SETZ RC, ;CLEAR RELOCATION\r
- POP PP,V\r
- TRNE ER,ERRU ;WAS VALUE UNDEFINED?\r
- TLO ARG,UNDF ;YES,SO TURN UNDF ON\r
- TLNE ARG,TAGF!EXTF\r
- JRST ERRAX\r
- JRST INSERT\r
-\r
-\fLOC0: PUSHJ PP,HIGHQ ;AC0=0,0\r
- PUSH PP,AC0 ;SAVE MODE REQUESTED\r
- HLRZS AC0 ;PUT MODE IN RIGHT HALF\r
- JUMPN AC0,RELOC0 ;RELOC PSEUDO-OP\r
- CAMN AC0,MODO ;SAME AS PRESENT MODE?\r
- JRST [HRRZ AC0,LOCO ;YES\r
- EXCH AC0,ABSLOC ;EXCH VALUES\r
- JRST LOC01]\r
- HRRZ AC0,LOCO ;NO, GET CURRENT VALUE\r
- MOVEM AC0,RELLOC ;SAVE IT\r
- MOVE AC0,ABSLOC ;GET LAST RELOC VALUE\r
-LOC01: PUSHJ PP,BYPASS ;SKIP BLANKS\r
- TLO IO,IORPTC\r
- CAIE C,EOL ;USE PREVIOUS VALUE IF NULL ARGUMENT\r
- PUSHJ PP,EVALXQ ;GET EXPRESSION AND TEST EXTERNAL\r
- HRRM AC0,(PP) ;STORE NEW VALUE\r
- POP PP,AC0 ;RETRIEVE STORED MODE AND VALUE\r
-LOC10: HRRZM AC0,LOCA ;SET ASSEMBLY LOCATION\r
- HRRZM AC0,LOCO ;AND OUTPUT LOCATION\r
- HLRZM AC0,MODA ;SET MODE\r
- HLRZM AC0,MODO\r
- JRST BLOCK2\r
-\r
-RELOC0: CAMN AC0,MODO\r
- JRST [HRRZ AC0,LOCO\r
- EXCH AC0,RELLOC\r
- JRST LOC01]\r
- HRRZ AC0,LOCO\r
- MOVEM AC0,ABSLOC\r
- MOVE AC0,RELLOC\r
- JRST LOC01\r
-\r
-\fIFN RENTSW,<\r
-HISEG1: PUSHJ PP,HIGHQ ;SET CURRENT PROGRAM BREAK\r
- PUSHJ PP,COUTD ;DUMP CURRENT TYPE OF BLOCK\r
- SKIPN HISNSW ;IF WE HAVE SEEN IT BEFORE\r
- SKIPE HIGH ;OR ANY RELOC CODE PUT OUT\r
- TRO ER,ERRQ ;FLAG AS AN ERROR\r
- PUSHJ PP,BYPASS ;GO GET EXPRESSION\r
- TLO IO,IORPTC\r
- PUSHJ PP,EVALXQ ;CHECK FOR EXTERNAL\r
- ANDCMI AC0,1777 ;ONLY ALLOWED TO START ON NEW K BOUND\r
- HRRZM AC0,LOCA ;SET LOC COUNTERS\r
- HRRZM AC0,LOCO\r
- MOVEI RC,1 ;ASSUME RELOCATABLE\r
- POPJ PP,\r
-\r
-TWSEG0: PUSHJ PP,HISEG1 ;COMMON CODE\r
- JUMPN AC0,.+2 ;ARGUMENT SEEN\r
- MOVEI AC0,400000 ;ASSUME 400000\r
- HRRZM AC0,HMIN ;SET OFSET OF HIGH SEG.\r
- HRRZM AC0,HHIGH ;INCASE NO HISEG CODE\r
- TLOA AC0,(1B0) ;SIGNAL TWO SEGMENTS AND SKIP\r
-\r
-HISEG0: PUSHJ PP,HISEG1 ;COMMON CODE\r
-HISEG2: MOVEM AC0,SVTYP3 ;SAVE THE HISEG ARG\r
- MOVEM RC,MODA ;SET MODES\r
- MOVEM RC,MODO\r
- SETOM HISNSW ;WE HAVE ALREADY PUT ONE OUT\r
- JRST BLOCK2 ;MAKE LISTING HAPPEN RIGHT>\r
-\r
-IFE RENTSW,<\r
- SYN CPOPJ,HISEG0\r
- SYN CPOPJ,TWSEG0>\r
-\r
-IFN FORMSW,<\r
-ONFORM: HRRES HWFMT ;ALLOW MULTI-FORMAT LISTING\r
- POPJ PP,\r
-OFFORM: HRROS HWFMT ;HALF-WORD FORMAT ONLY\r
- POPJ PP, >\r
-\r
-IFE FORMSW,<\r
- SYN CPOPJ,ONFORM\r
- SYN CPOPJ,OFFORM>\r
-\fHIGHQ:\r
-HIGHQ1: MOVE V,LOCO ;GET ASSEMBLY LOCATION\r
- SKIPN MODO ;IF ASSEMBLY MODE IS ABSOLUTE\r
- JRST [CAMLE V,ABSHI ;RECORED ABS HIGHEST ALSO\r
- MOVEM V,ABSHI\r
- POPJ PP,]\r
-IFN RENTSW,<SKIPE HMIN ;IS IT A TWO SEGMENT PROGRAM?\r
- JRST [CAMGE V,HMIN ;YES,IS THIS HIGH SEG.?\r
- JRST .+1 ;NO,STORE LOW SEGMENT\r
- CAMLE V,HHIGH ;YES,IS IT GREATER THAN "HHIGH"?\r
- MOVEM V,HHIGH ;YES,REPLACE WITH LARGER VALUE\r
- POPJ PP,]>\r
- CAMLE V,HIGH ;IS IT GREATER THAN "HIGH"?\r
- MOVEM V,HIGH ;YES, REPLACE WITH LARGER VALUE\r
- POPJ PP,\r
- \r
-ONML: TLZA FR,MWLFLG ;MULTI-WORD LITERALS OK\r
-OFFML: TLO FR,MWLFLG ;NO\r
- POPJ PP,\r
-\r
-OFFSYM: SETOM IONSYM ;SUPRESS SYMBOL TABLE LISTING\r
- POPJ PP,\r
-\r
-SUPRE0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES\r
- JRST SUPRE1 ;ERROR\r
- PUSHJ PP,SSRCH ;SYMBOL ONLY\r
- JRST SUPRE1 ;GIVE ERROR MESSAGE\r
- TLOA ARG,SUPRBT ;SET THE SUPRESS BIT\r
-SUPRE1: TROA ER,ERRA\r
- IORM ARG,(SX) ;PUT BACK\r
- JUMPCM SUPRE0 ;ANY MORE?\r
- JRST SUPRS1\r
-\r
-SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL\r
- MOVSI ARG,SUPRBT\r
- IORM ARG,(SX)\r
-SUPRS1: SETZM EXTPNT ;JUST IN CASE WE LOOKED ONE UP\r
- POPJ PP,\r
-\r
-XPUNG0: JUMP1 POPOUT\r
- PUSHJ PP,LOOKUP\r
- MOVE ARG,(SX) ;GET SYMBOL FLAGS\r
- TLNN ARG,INTF!ENTF!EXTF!SPTR\r
- TLOA ARG,SUPRBT ;LOCAL SYMBOL,SO SUPPRESS IT\r
- SETZM EXTPNT\r
- MOVEM ARG,(SX) ;RESTORE FLAGS\r
- POPJ PP,\r
-\fTITLE0: JUMP2 REMAR0\r
- MOVEI SX,.TBUF\r
- HRRI AC0,TBUF\r
- PUSHJ PP,SUBTT1 ;GO READ IT\r
- MOVEM SX,TCNT ;SAVE COUNT OF CHARS. WRITTEN\r
- SKIPE UNIVSN ;WAS IT A UNIVERSAL?\r
- PUSHJ PP,ADDUNV ;YES ADD TO TABLE\r
- TLOE IO,IOTLSN ;HAVE WE SEEN ONE\r
-IFE CCLSW,<TRO ER,ERRM ;YES, COMPLAIN>\r
-IFN CCLSW,<TROA ER,ERRM ;YES, MESSAGE\r
- JRST PRNAM ;PRINT NAME IF FIRST ONE>\r
- POPJ PP, ;EXIT OTHERWISE\r
-\r
-SUBTT0: SKIPE SBUF ;STORE FIRST SUBTTL ON PASS1\r
- JUMP1 REMAR0 ;OTHERWISE EXIT IF PASS ONE\r
- MOVEI SX,.SBUF\r
- HRRI AC0,SBUF\r
-\r
-SUBTT1: PUSHJ PP,BYPASS ;BYPASS LEADING BLANKS\r
- TLO IO,IORPTC\r
-SUBTT3: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
- IDPB C,AC0 ;STORE IN BLOCK\r
- CAIGE C,40 ;TEST FOR TERMINATOR\r
- CAIN C,HT\r
- SOJG SX,SUBTT3 ;TEST FOR BUFFER FULL\r
- DPB RC,AC0 ;END, STORE TERMINATOR\r
- SOJA SX,CPOPJ ;COUNT NUL AND EXIT\r
-\r
-IFN CCLSW,<\r
-PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG\r
- POPJ PP,\r
- PUSH PP,AC0 ;SAVE AC0 DMN\r
- PUSH PP,RC ;AND RC\r
- MOVE AC0,[POINT 7,TBUF]\r
- MOVE SX,[POINT 7,OTBUF]\r
- MOVEI RC,6 ;MAX OF SIX CHRS\r
-PN1: ILDB C,AC0\r
- CAILE C," " ;CHECK FOR LEGAL\r
- CAILE C,"Z"+40 ;CHECK AGAINST LOWER CASE Z\r
- JRST PN2\r
- IDPB C,SX ;PUT IN OUTPUT BUFFER\r
- SOJG RC,PN1 ;GET MORE\r
-PN2: MOVEI C,0\r
- IDPB C,SX ;TERMINATOR\r
- TTCALL 3,OTBUF\r
- TTCALL 3,[ASCIZ /\r
-/]\r
- POP PP,RC\r
- POP PP,AC0 ;RESTORE AC0 DMN\r
- POPJ PP,\r
->\r
-\fSYN0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL\r
- JRST ERRAX ;ERROR, EXIT\r
- PUSHJ PP,MSRCH ;TRY FOR MACRO/OPDEF\r
- JRST SYN3 ;NO,0THRY FOR OPERAND\r
-SYN1: MOVEI SX,MSRCH ;YES, SET FLAG\r
-SYN2: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
- JUMPNC ERRAX ;ERROR IF NO COMMA\r
- PUSHJ PP,GETSYM ;GET THE SECOND SYMBOL\r
- POPJ PP,\r
- PUSHJ PP,@SAVBLK+SX ;SEARCH FOR SECOND SYMBOL\r
- JFCL\r
- MOVE ARG,SAVBLK+ARG ;GET VALUES\r
- MOVE RC,SAVBLK+RC\r
- MOVE V,SAVBLK+V\r
- TLNE ARG,MACF ;MACRO?\r
- PUSHJ PP,REFINC ;YES, INCREMENT REFERENCE\r
- JRST INSERT ;INSERT AND EXIT\r
-\r
-SYN3: PUSHJ PP,SSRCH ;SEARCH FOR OPERAND\r
- JRST SYN4 ;NOT FOUND, TRY OP CODE\r
- TLO ARG,SYNF ;FLAG AS SYNONYM\r
- TLNE ARG,EXTF ;EXTERNAL?\r
- HRRZ V,ARG ;YES, RELPACE WITH POINTER\r
- MOVEI SX,SSRCH ;SET FLAG\r
- TLNN ARG,VARF ;DO NOT LET HIM SYN A VARIABLE\r
- JRST SYN2\r
- JRST ERRAX\r
-\r
-SYN4: PUSHJ PP,OPTSCH ;SEARCH FOR OP-CODE\r
- JRST ERRAX ;NOT FOUND, EXIT WITH ERROR\r
- MOVSI ARG,SYNF ;FLAG AS SYNONYM\r
- JRST SYN1\r
-\fPURGE0: PUSHJ PP,GETSYM ;GET A MNEMONIC\r
- JRST [TRZ ER,ERRA ;CLEAR ERROR\r
- POPJ PP,] ;AND RETURN\r
- PUSHJ PP,MSRCH ;SEARCH MACRO SYMBOL TABLE\r
- JRST PURGE2 ;NOT FOUND, TRY SYMBOLS\r
- PUSH PP,CS ;SAVE CS AS IT MAY GET GARBAGED\r
- TLNE ARG,MACF ;MACRO?\r
- PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE\r
- POP PP,CS\r
- JRST PURGE4 ;REMOVE SYMBOL FROM TABLE\r
-\r
-PURGE2: PUSHJ PP,SSRCH ;TRY OPERAND SYMBOL TABLE\r
- JRST PURGE5 ;NOT FOUND GET NEXT SYMBOL\r
- TRNN RC,-2 ;CHECK COMPLEX EXTERNAL\r
- TLNE RC,-2\r
- TLNE ARG,SYNF\r
- JRST .+2\r
- JRST PURGE3\r
- TLNE ARG,EXTF!UNDF ;ERROR IF EXTERNAL OR UNDEFINED\r
- TLNE ARG,SYNF ;BUT NOT A SYNONYM\r
- JRST PURGE4\r
-PURGE3: TROA ER,ERRA ;NOT FOUND, ERROR\r
-PURGE4: PUSHJ PP,REMOVE ;REMOVE FROM THE SYMBOL TABLE\r
-PURGE5: JUMPCM PURGE0\r
- POPJ PP, ;EXIT\r
-\fOPD1: TLNE ARG,UNDF ;IF OPDEF IS UNDEFINED\r
- TRO ER,ERRO ;GIVE "O" ERROR\r
-OPD: MOVE AC0,V ;PUT VALUE IN AC0\r
- JRST OP\r
-IOP: MOVSI AC2,(POINT 9,0(PP),11)\r
-IFE FORMSW,< TLOA IO,IOIOPF ;SET "IOP SEEN" AND SKIP>\r
-IFN FORMSW,< PUSH PP,IOFORM ;USE I/O FORM\r
- TLO IO,IOIOPF ;SET "IOP" SEEN\r
- JRST OP+2>\r
-OP: MOVSI AC2,(POINT 4,0(PP),12)\r
-IFN FORMSW,< PUSH PP,INFORM ;USE INST. FORM>\r
- PUSH PP,RC\r
- PUSH PP,AC0 ;STACK CODE \r
- PUSH PP,AC2\r
- PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION\r
- POP PP,AC2\r
- JUMPNC OP2\r
-OP1B: PUSHJ PP,GETCHR ;GET A CHARACTER\r
-IFE FORMSW,<JUMPCM XWD5 ;PROCESS COMMA COMMA IN XWD>\r
-IFN FORMSW,<JUMPNC .+4 ;JUMP IF NO COMMA\r
- MOVE AC2,HWFORM ;GET FORM WORD FOR XWD\r
- MOVEM AC2,-2(PP) ;REPLACE INSTRUCTION FORM\r
- JRST XWD5 ;PROCESS COMMA COMMA IN XWD>\r
- TLO IO,IORPTC ;NOT A COMMA,REPEAT IT\r
- LDB AC1,AC2\r
- ADD AC1,AC0\r
- DPB AC1,AC2\r
- JUMPE RC,OP1A ;EXTERNAL OR RELOCATABLE?\r
- PUSHJ PP,QEXT ;YES, DETERMINE WHICH AND FLAG AN ERROR\r
-\r
-OP1A: PUSHJ PP,EVALEX ;GET ADDRESS PART\r
-OP2: PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS\r
-OP3: POP PP,AC0 ;PUT IN AC0\r
- POP PP,RC\r
-IFN FORMSW,< POP PP,AC1 ;GET FORM WORD>\r
- SKIPE (PP) ;CAME FROM EVALCM?\r
- JRST STOW ;NO,STOW CODE AND EXIT\r
- POP PP,AC1 ;YES,EXIT IMMEDIATELY\r
- POPJ PP,\r
-\r
-\fEVADR: ;EVALUATE STANDARD ADDRESS\r
-IFE IIISW,<TLNN AC0,-1 ;OK IF ALL 0'S\r
- JRST .+4 ;IT WAS\r
- TLC AC0,-1 ;CHANGE ALL ONES TO ZEROS\r
- TLCE AC0,-1 ;OK IF ALL 1'S\r
- TRO ER,ERRQ ;NO,FLAG Q ERROR>\r
- ADD AC0,-1(PP) ;ADD ADDRESS PORTIONS\r
- HLL AC0,-1(PP) ;GET LEFT HALF\r
- TLZE FR,INDSW ;INDIRECT BIT?\r
- TLO AC0,(Z @) ;YES, PUT IT IN\r
- MOVEM AC0,-1(PP) ;RE-STACK CODE\r
- ADD RC,-2(PP) ;UPDATE RELOCATION\r
- HRRM RC,-2(PP) ;USE HALF WORD ADD\r
- CAIE C,10 ;"("?\r
- POPJ PP, ;NO, EXIT\r
-\r
- MOVSS EXTPNT ;WFW\r
- PUSHJ PP,EVALCM ;EVALUATE\r
- MOVSS EXTPNT ;WFW\r
- MOVSS V,AC0 ;SWAP HALVES\r
-IFE IIISW,<MOVSS SX,RC\r
- IOR SX,V ;MERGE RELOCATION\r
- TRNN SX,-1 ;RIGHT HALF ZERO?\r
- JRST OP2A ;YES, DO SIMPLE ADD\r
- MOVE ARG,RC ;NO, SWAP RC INTO ARG>\r
-IFN IIISW,<MOVSS ARG,RC>\r
- ADD V,-1(PP) ;ADD RIGHT HALVES\r
- ADD ARG,-2(PP)\r
- HRRM V,-1(PP) ;UPDATE WITHOUT CARRY\r
- HRRM ARG,-2(PP)\r
- HLLZS AC0 ;PREPARE LEFT HALVES\r
- HLLZS RC\r
-IFE IIISW,<TLNE SX,-1 ;IS LEFT HALF ZERO?\r
- TRO ER,ERRQ ;NO FLAG FORMAT ERROR\r
-OP2A: TLNE RC,-1 ;RELOCATION FOR LEFT HALF?\r
- PUSHJ PP,OP2A1 ;YES,IS IT LEGAL?\r
- TLNE AC0,777000 ;OP CODE FIELD USED?\r
- JRST [EXCH AC0,-1(PP);YES, GET STORED CODE\r
- TLNE AC0,777000 ;OP CODE FIELD BEEN SET?\r
- TRO ER,ERRQ ;YES, MOST LIKELY AN ERROR\r
- EXCH AC0,-1(PP)\r
- JRST .+1] ;RETURN TO ADD >\r
- ADDM AC0,-1(PP) ;MERGE WITH PREVIOUS VALUE\r
- ADDM RC,-2(PP)\r
- CAIE C,11 ;")"?\r
- JRST ERRAX ;NO, FLAG ERROR\r
- ;YES, BYPASS PARENTHESIS\r
-BYPASS:\r
-BYPAS1: PUSHJ PP,GETCHR\r
-BYPAS2: JUMPE C,.-1 ;SKIP TRAILING BLANKS\r
- POPJ PP, ;EXIT\r
-\r
-\fIFE IIISW,<\r
-OP2A1: EXCH RC,-2(PP) ;GET STORED CODE\r
- TLNN RC,-1 ;OK IF ALL ZERO\r
- JRST OP2A2 ;OK SO RETURN\r
- TLC RC,-1 ;CHANGE ALL ONES TO ZEROS\r
- TLCE RC,-1 ;OK IF ALL ONES\r
- TRO ER,ERRQ ;OTHERWISE A "Q" ERROR\r
-OP2A2: EXCH RC,-2(PP) ;GET RC,BACK\r
- POPJ PP, ;AND RETURN>\r
-\r
-\r
-EXPRES: HRLZ AC0,RX ;FUDGE FOR OCT0\r
-\r
-OCT0: PUSH PP,RX\r
- HLR RX,AC0\r
-OCT1: PUSHJ PP,EVALEX ;EVALUATE\r
-IFN FORMSW,< MOVE AC1,HWFORM>\r
- PUSHJ PP,STOW ;STOW CODE\r
- JUMPCM OCT1\r
- POP PP,RX ;YES, RESTORE RADIX\r
- POPJ PP, ;EXIT\r
-\fSIXB10: MOVSI RC,(POINT 6,AC0) ;SET UP POINTER\r
- MOVEI AC0,0 ;CLEAR WORD\r
-\r
-SIXB20: PUSHJ PP,CHARL ;GET NEXT CHARACTER\r
- CAMN C,SX ;IS THIS PRESET DELIMITER?\r
-IFE FORMSW,< JRST ASC60 ;YES>\r
-IFN FORMSW,<\r
- JRST [PUSHJ PP,BYPAS1\r
- ANDCM RC,STPX\r
- MOVE AC1,SXFORM\r
- JUMPGE RC,STOWZ\r
- POPJ PP,]>\r
- CAIL C,"A"+40\r
- CAILE C,"Z"+40\r
- JRST .+2\r
- TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT\r
- SUBI C,40 ;CONVERT TO SIXBIT\r
- JUMPL C,ASC55 ;TEST FOR INVALID CHARACTER\r
- IDPB C,RC ;NO, DEPOSIT THE BYTE\r
- TLNE RC,770000 ;IS THE WORD FULL?\r
- JRST SIXB20 ;NO, GET NEXT CHARACTER\r
-IFN FORMSW,< MOVE AC1,SXFORM ;SIXBIT FORM>\r
- PUSHJ PP,STOWZ ;YES, STORE\r
- JRST SIXB10 ;GET NEXT WORD\r
-\fASCII0: HLLZ SDEL,AC0 ;STORE ASCII/ASCIZ FLAG\r
-ASC10: PUSHJ PP,CHARL ;GET FIRST NON-BLANK\r
- CAIE C," "\r
- CAIN C,HT\r
- JRST ASC10\r
- CAIG C,CR ;CHECK FOR CRRET AS DELIM\r
- CAIGE C,LF\r
- SKIPA SX,SEQNO2\r
- JRST ERRAX\r
- MOVEM SX,TXTSEQ ;SAVE SEQ AND PAGE\r
- MOVE SX,PAGENO\r
- MOVEM SX,TXTPG\r
- SETOM INTXT\r
- MOVE SX,C ;SAVE FOR COMPARISON\r
- JUMPG SDEL,SIXB10 ;BRANCH IF SIXBIT\r
-\r
-ASC20: MOVSI RC,(POINT 7,AC0) ;SET UP POINTER\r
- TLNE SDEL,200000 ;THIS BIT (AND BIT0) IN FOR COMMENT\r
- MOVSI RC,440000 ;SO NOTHING WILL BE DEPOSITED\r
-IFE IIISW,<MOVEI AC0,0 ;CLEAR WORD>\r
-IFN IIISW,<TLNE SDEL,100000 ;ASCID?\r
- TLZA SDEL,400000 ;YES, ZERO ASCIZ BIT\r
- TDZA AC0,AC0 ;NO, ZERO WORD\r
- MOVE AC0,[BYTE (7) 10,10,10,10,10 (1) 1] ;YES, A WORD FULL OF BACKSPACES>\r
-ASC30: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST\r
- CAMN C,SX ;TEST FOR DELIMITER\r
- JRST ASC50 ;FOUND\r
- IDPB C,RC ;DEPOSIT BYTE\r
- TLNE RC,760000 ;HAVE WE FINISHED WORD?\r
- JRST ASC30 ;NO,GET NEXT CHARACTER\r
-IFN FORMSW,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD>\r
- PUSHJ PP,STOWZ ;YES, STOW IT\r
- JRST ASC20 ;GET NEXT WORD\r
-\r
-ASC55: TDZA CS,CS ;ZERO CS IN CASE NESTED\r
-ASC50: TDZA RC,SDEL ;TEST FOR ASCIIZ\r
- TROA ER,ERRA ;SIXBIT ERROR EXIT\r
-ASC60: PUSHJ PP,BYPAS1 ;POLISH OFF TERMINATOR\r
- SETZM INTXT ;WE ARE OUT OF IT\r
-IFN FORMSW,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD>\r
-IFN IIISW,<TLNN SDEL,100000 ;NO EXTRA WORDS FOR ASCID>\r
- ANDCM RC,STPX ;STORE AT LEAST ONE WORD\r
- TLNN SDEL,200000 ;GET OUT WITHOUT STORING\r
- JUMPGE RC,STOWZ ;STOW\r
- POPJ PP, ;ASCII, NO BYTES STORED, SO EXIT\r
-\fPOINT0:\r
-IFN FORMSW,< PUSH PP,BPFORM ;USE BYTE POINTER FORM WORD>\r
- PUSH PP,RC ;STACK REGISTERS\r
- PUSH PP,AC0\r
- PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
- DPB AC0,[POINT 6,0(PP),11] ;STORE BYTE SIZE\r
- JUMPNC POINT2\r
- PUSHJ PP,EVALEX ;NO, GET ADDRESS\r
- PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS\r
- JUMPNC POINT2\r
- PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
- TLNE IO,NUMSW ;IF NUMERIC\r
- TDCA AC0,[-1] ;POSITION=D35-RHB\r
-POINT2: MOVEI AC0,0 ;OTHERWISE SET TO D36\r
- ADDI AC0,^D36\r
- LSH AC0,^D30\r
- ADDM AC0,0(PP) ;UPDATE VALUE\r
- JRST OP3\r
-\fXWD0:\r
-IFN FORMSW,< PUSH PP,HWFORM ;USE HALF WORD FORM>\r
- PUSH PP,RC\r
- PUSH PP,AC0 ;STORE ZERO ON STACK\r
- PUSHJ PP,EVALEX ;EVALUATE EXPRESSION\r
- JUMPNC OP2\r
-XWD5: SKIPN (PP) ;ANY CODE YET?\r
- JRST XWD10 ;NO,USE VALUE IN AC0\r
- JUMPE AC0,.+2 ;ANYTHING IN AC0?\r
- TRO ER,ERRQ ;YES,FLAG "Q"ERROR\r
- MOVE AC0,(PP) ;USE PREVIOUS VALUE\r
- MOVE RC,-1(PP) ;AND RELOCATION\r
-XWD10: HRLZM AC0,0(PP) ;SET LEFT HALF\r
- HRLZM RC,-1(PP)\r
- MOVSS EXTPNT ;WFW\r
- JRST OP1A ;EXIT THROUGH OP\r
-\r
-IOWD0: PUSHJ PP,EVALXQ ;EVALUATE AND TEST FOR EXTERNAL\r
- CAIE C,14 ;","?\r
- JRST [SKIPN AC0 ;IF NZERO AND NO "," SEEN\r
- TRO ER,ERRQ ;TREAT AS Q ERROR\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE HALF WORD FORM>\r
- SOJA AC0,STOW] ;NO, TREAT AS RIGHT HALF\r
- PUSH PP,AC0 ;YES, STACK LEFT HALF\r
- PUSHJ PP,EVALEX ;WFW\r
- SUBI AC0,1\r
- POP PP,AC1 ;RETRIEVE LEFT HALF\r
- MOVNS AC1\r
- HRL AC0,AC1\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE HALF WORD FORM>\r
- JRST STOW ;STOW CODE AND EXIT\r
-\fBYTE0: PUSHJ PP,BYPASS ;GET FIRST NON-BLANK\r
- CAIE C,10 ;"("?\r
- JRST ERRAX ;NO, FLAG ERROR AND EXIT\r
-IFN FORMSW,<\r
- PUSH PP,[1]\r
- MOVEI AC0,0\r
->\r
- PUSH PP,RC\r
- PUSH PP,AC0 ;INITIALIZE STACK TO ZERO\r
- MOVSI ARG,(POINT -1,(PP))\r
-\r
-BYTE1: PUSH PP,ARG\r
- PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
- POP PP,ARG\r
- CAIG AC0,^D36 ;TEST SIZE\r
- JUMPGE AC0,.+2\r
- TRO ER,ERRA\r
- DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE\r
-\r
-BYTE2: IBP ARG ;INCREMENT BYTE\r
- TRZN ARG,-1 ;OVERFLOW?\r
- JRST BYTE3 ;NO\r
- SETZB AC0,RC ;YES\r
- EXCH AC0,0(PP) ;GET CURRENT VALUES\r
- EXCH RC,-1(PP) ;AND STACK ZEROS\r
-IFN FORMSW,<\r
- MOVE AC1,HWFORM ;USE STANDARD FORM\r
- EXCH AC1,-2(PP) ;GET FORM WORD\r
->\r
- PUSHJ PP,STOW ;STOW FULL WORD\r
-\r
-BYTE3: PUSH PP,ARG\r
- PUSHJ PP,EVALEX ;COMPUTE NEXT BYTE\r
- POP PP,ARG\r
- DPB AC0,ARG ;STORE BYTE\r
- HLLO AC0,ARG\r
- DPB RC,AC0 ;STORE RELOCATION\r
-\r
-IFN FORMSW,<\r
- MOVEI AC0,1\r
- HRRI ARG,-2\r
- DPB AC0,ARG ;STORE FORM BYTE\r
- HRRI ARG,0\r
->\r
- JUMPCM BYTE2\r
- CAIN C,10 ;"("?\r
- JRST BYTE1 ;YES, GET NEW BYTE SIZE\r
- JRST OP3 ;NO, EXIT\r
-\fRADX50: PUSHJ PP,EVALEX ;EVALUATE CODE\r
- JUMPN RC,ERRAX ;ERROR IF NOT ABSOLUTE\r
- MOVE ARG,AC0\r
- JUMPNC ERRAX\r
- PUSHJ PP,GETSYM ;YES, GET SYMBOL\r
- TRZ ER,ERRA ;CLEAR ERROR\r
- PUSHJ PP,SQOZE ;SQUOZE SIXBIT AND ADD CODE\r
-IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>\r
- JRST STOW ;STOW CODE AND EXIT\r
-\r
-\r
-SQOZE: MOVE AC1+1,AC0 ;PUT SIXBIT IN AC1+1\r
- MOVEI AC0,0 ;CLEAR RESULT\r
-SQOZ1: MOVEI AC1,0\r
- LSHC AC1,6 ;PUT 6-BIT CHARACTER IN AC1\r
- LDB AC1,[POINT 6,CSTAT(AC1),23] ;CONVERT TO RADIX50\r
- IMULI AC0,50 ;MULTIPLY PREVIOUS RESULT\r
- ADD AC0,AC1 ;ADD NEW CHARACTER\r
- JUMPN AC1+1,SQOZ1 ;TEST FOR END\r
- LSH ARG,^D30 ;LEFT-JUSTIFY CODE\r
- IOR AC0,ARG ;MERGE WITH RESULT\r
- POPJ PP,\r
-\fREPEAT 0,< EXPLANATION OF ARRAY AND LVAR FEATURES\r
-\r
-WHEN A VARIABLE IS SEEN EITHER BY #, INTEGER OR ARRAY\r
-THE VALUE PORTION OF THE SYMBOL TABLE ENTRY (RH OF 2ND WORD)\r
-IS USE TO HOLD THE DESIRED SIZE-1. THE CORRECT VALUE IS\r
-ASSIGNED BY THE VAR PSEUDO OP.\r
-\r
-WHEN LVAR IS SEEN, A SEARCH OF THE SYMBOL TABLE IS MADE\r
-FOR ALL VARIABLES. THE VARF (VARIABLE) FLAG IS\r
-LEFT ON AND EXTF AND PNTF ARE TURNED ON SO THAT THE\r
-VARIABLE LOOKS LIKE AN EXTERNAL. THE POINTER\r
-(RH OF 2ND WORD OF THE SYMBOL TABLE ENTRY) POINTS\r
-TO THE HEADER BLOCK. THE HEADER BLOCK IS FORMATTED AS FOLLOWS:\r
-WORD 1: LEFT HALF IS A POINTER TO SYMBOL TABLE FIXUP BLOCKS\r
- RIGHT HALF IS A POINTER TO CODE FIXUP BLOCKS\r
-WORD 2: 0 THIS IS USED TO DISTINGUISH IT FROM NORMAL EXTERNALS\r
- WHICH HAVE THE SYMBOL NAME HERE\r
-WORD 3: THE LOCATION RELATIVE TO THE START OF THE LOW CORE\r
- VARIABLES\r
-\r
-CORE FIXUP BLOCKS ARE SET UP BY BOUT\r
-\r
-WORD1: RH LINK TO NEXT CORE FIXUP BLOCK 0 IF END OF CHAIN\r
- LH OFFSET. NUMBER TO BE ADDED TO SYMBOL VALUE BEFORE\r
- FIXUP IS DONE\r
-WORD 2: POINTER TO A FIXUP CHAIN FOR RIGHT HALVES\r
- LEFT HALF IS RELOCATION RH IS ADDRESS\r
-WORD 3: SAME AS WORD 2 BUT FOR LEFT HALF FIXUPS\r
-\r
-NOTE ALL THESE FIXUPS ARE CHAINED EVEN IF IN LEFT HALF.\r
-SIMILARY ALL REFERENCES TO SAY A+1 ARE CHAINED\r
-\r
-SYMBOL TABLE FIXUP BLOCKS. THESE ARE GENERATED BY SOUT\r
-AS THE SYMBOL TABLE IS PUT OUT. THESE FIXUPS ARE ADDITIVE\r
-NOT CHAINED.\r
-\r
-WORD 1: RH LINK TO NEXT BLOCK\r
- LH 0\r
-WORD 2: RADIX50 FOR THE SYMBOL\r
-WORD 3: 200000,,0 IF RH FIXUP\r
- 600000,,0 IF LH FIXUP\r
-\r
-SOUT ALSO SETS UP FIXLNK. FIXLNK POINTS TO THE CHAIN OF\r
-ALL LVAR FIXUPS TO BE DONE. IT POINTS TO THE SECOND WORD\r
-\fOF A 2 WORD BLOCK\r
-\r
-WORD 1: LINK TO 2ND WORD OF NEXT BLOCK 0 IF END\r
-WORD 2: RH POINTER TO A HEADER BLOCK\r
- LH GARBAGE\r
-\r
-FIXUPS ARE BLOCK TYPE 13 AS FOLLOWS\r
-WORD 1: THE PROGRAM BREAK (AS BLOCK TYPE 5)\r
-WORD 2: THE NUMBER OF LOCATION USED FOR VARIABLES IN THE\r
- LOW SEGMENT+1\r
-\r
-REMAINING WORDS COME IN PAIRS AS FOLLOWS:\r
-1ST WORD BIT 0=0 RH FIXUP\r
- BIT 0=1 LH FIXUP\r
- BIT 1=0 CORE FIXUP\r
- WORD 2 LH POINTER TO CHAIN\r
- WORD 2 RH VALUE\r
- BIT 1=1 SYMBOL FIXUP\r
- WORD 1 RH VALUE\r
- WORD 2 SYMBOL\r
->\r
-\r
-REPEAT 0,< EXPLANATION OF ICC FEATURES\r
-\r
- IF FORMSW IS SET NON ZERO THE FORM OF THE OCTAL LISTING OUTPUT\r
- IS CHANGED FROM STANDARD HALF WORD FORM TO THE FOLLOWING:-\r
-\r
- IF INSTRUCTION BYTE 9,4,1,4,18\r
- IF I/O INSTRUCTION BYTE 3,7,3,1,4,18\r
- IF BYTE POINTER BYTE 6,6,2,4,18\r
- IF ASCII BYTE 7,7,7,7,7\r
- IF SIXBIT BYTE 6,6,6,6,6,6\r
-\r
- ALL OTHERS ARE STANDARD HALF WORD\r
-\r
- THIS FEATURE CAN BE OVER RIDDEN BY USE OF /H SWITCH\r
- STANDARD HALF WORD FORM IS THEN USED.\r
- HOWEVER BECAUSE OF EXTRA SPACING THE OUTPUT IS PUSHED MORE\r
- TO THE RIGHT AND LONG COMMENTS OVERFLOW THE LINE\r
- >\r
-\fIFN WFWSW,<\r
-%INTEG: PUSHJ PP,GETSYM ;GET A SYMBOL\r
- JRST INTG2 ;BAD SYMBOL ERROR\r
- TLO IO,DEFCRS ;THIS IS A DEFINTION\r
- PUSHJ PP,SSRCH ;SEE IF THERE\r
- MOVSI ARG,SYMF!UNDF ;SET SYMBOL AND UNDEFINED IF NOT\r
- TLNN ARG,UNDF ;IF ALREADY DEFINED\r
- JRST INTG1 ;JUST IGNORE\r
- TLOA ARG,VARF ;SET VARIABLE FLAG\r
-INTG2: TROA ER,ERRA ;SYMBOL ERROR\r
- PUSHJ PP,INSERZ ;PUT IN WITH ZERO VALUE (LENGTH OF 1)\r
-INTG1: JUMPCM %INTEG\r
- POPJ PP,\r
-\r
-%ARAY: MOVEM PP,ARAYP ;SAVE PUSHDOW POINTER\r
-ARAY2: PUSHJ PP,GETSYM\r
- JRST ARAY1 ;BAD SYMBOL GIVE ERROR AND ABORT\r
- PUSH PP,AC0 ;SAVE NAME\r
- JUMPCM ARAY2 ;AND GO ON IF A COMMA\r
- CAIE C,"["-40 ;MUST BE A [\r
- JRST ARAY1\r
- PUSHJ PP,BYPASS ;OH, WELL\r
- TLO IO,IORPTC\r
- PUSHJ PP,EVALXQ ;GET A SIZE\r
- CAIE C,"]"-40 ;MUST END RIGHT\r
- JRST ARAY1\r
- PUSHJ PP,BYPASS ;??\r
- HRRZ V,AC0 ;GET VALUE\r
- SUBI V,1\r
-NXTVAL: POP PP,AC0\r
- PUSH PP,V ;SAVE OVER SEARCH\r
- TLO IO,DEFCRS\r
- PUSHJ PP,SSRCH ;FIND IT\r
- MOVSI ARG,SYMF!UNDF\r
- POP PP,V ;GET VALUE BACK\r
- TLNN ARG,UNDF\r
- JRST ARAY3\r
- TLO ARG,VARF\r
- MOVEI RC,0 ;NO RELOC\r
- PUSHJ PP,INSERT\r
-ARAY3: CAME PP,ARAYP\r
- JRST NXTVAL ;STILL NAMES STACKED\r
- JUMPCM ARAY2\r
- POPJ PP,\r
-\r
-ARAY1: TRO ER,ERRA ;ERROR EXIT\r
- MOVE PP,ARAYP\r
- POPJ PP, ;RESET PDL AND GO\r
->\r
-\fIFN WFWSW,<\r
-%LVAR: JUMP2 POPOUT ;IGNORE ON PASS2\r
- PUSHJ PP,LOOKUP ;SCAN SYMBOL TABLE\r
- TRNN ARG,EXTF ;THESE ARE LVARS WE HAVE DONE ONCE\r
- TRNN ARG,VARF ;FOR VARIABLES\r
- POPJ PP, ;IGNORE ALL OTHERS\r
- TRZ ARG,UNDF ;SET AS DEFINED\r
- MOVEI RC,3\r
- ADDB RC,FREE\r
- CAML RC,SYMBOL ;GET BLOCK\r
- PUSHJ PP,XCEEDS\r
- SUBI RC,2 ;POINT TO START OF BLOCK\r
- ADDI V,1\r
- EXCH V,LVARLC ;GET CORRECT VARIABLE LOCATION\r
- MOVEM V,2(RC) ;SAVE IT\r
- ADDM V,LVARLC ;AND UPDATE BASE\r
- SETZM (RC)\r
- SETZM 1(RC) ;NO NAME TO IDENT AN LVAR AND NO FIXUPS\r
- HRL ARG,RC ;POINTER\r
- TRO ARG,EXTF!PNTF ;FLAG AS EXTERNAL AND POINTER\r
- MOVSM ARG,(SX) ;PUT IT AWAY\r
- POPJ PP,\r
->\r
-\f; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY\r
-\r
-; HERE IF PRGEND (PASS 1)\r
-PSEND0: TLO IO,MFLSW ;PSEND SEEN\r
- PUSHJ PP,END0 ;AS IF END STATEMENT\r
- HLLZS IO ;CLEAR ER(RH)\r
- SETZM ERRCNT ;CLEAR ERROR COUNT FOR EACH PROG.\r
- JUMP2 PSEND2 ;DIFFERENT ON PASS2\r
- SKIPE UNIVSN ;SEEN A UNIVERSAL\r
- PUSHJ PP,UNISYM ;YES, STORE SYMBOLS\r
- PUSHJ PP,PSEND4 ;SAVE SYMBOLS, POINTERS AND TITLE\r
- TLZ IO,IOTLSN ;CLEAR TITLE SEEN FLAG\r
-PSEND1: TLZ IO,MFLSW ;FOR NEXT FILE\r
- SETZM UNISCH ;CLEAR UNIVERSAL SEARCH TABLE\r
- MOVE AC0,[UNISCH,,UNISCH+1]\r
- BLT AC0,UNISCH+.UNIV-1\r
- PUSHJ PP,OUTFF ;RESET PAGE COUNT\r
- MOVSI AC0,1 ;SET SO RELOC 0 WORKS\r
- JRST LOC10 ;FOR RELOC 0\r
-\r
-; HERE IF PRGEND (PASS 2)\r
-PSEND2: SETZM SBUF ;SO SUBTTL IS NOT WRONG\r
- PUSHJ PP,PSEND5 ;PUT TITLE BACK\r
- PUSHJ PP,PSEND1 ;COMMON CODE\r
- JRST PASS20 ;OUTPUT THE ENTRIES\r
-\r
-; HERE IF END (PASS 1)\r
-PSEND3: PUSHJ PP,PSEND4 ;SAVE LAST PROGRAM \r
- HLRS PRGPTR ;REINITIALIZE POINTER\r
- PUSHJ PP,PSEND5 ;READ BACK FIRST PROGRAM\r
- JRST PASS20\r
-\f;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS\r
- XTRA==4 ;NUMBER OF OTHER LOCATIONS TO SAVE\r
-\r
-PSEND4: MOVE V,FREE ;GET NEXT FREE LOCATION\r
- ADDI V,LENGTH+.TBUF/5+XTRA\r
- CAML V,SYMBOL ;WILL WORST CASE FIT?\r
- PUSHJ PP,XCEED ;NO, EXPAND\r
- MOVS V,FREE\r
- HRR V,PRGPTR ;LAST PRGEND BLOCK\r
- HLRM V,(V) ;LINK THIS BLOCK\r
- SKIPN PRGPTR ;IF FIRST TIME\r
- HLLZM V,PRGPTR ;SET LINK TO START OF CHAIN\r
- HLRM V,PRGPTR ;POINTER TO IT\r
- SETZM @FREE ;CLEAR LINK WORD\r
- AOS FREE ;THIS LOCATION USED NOW\r
- MOVS AC0,SYMBOL ;BOTTOM OF SYMBOL TABLE\r
- HRR AC0,FREE ;FREE SPACE\r
- MOVE V,@SYMBOL ;GET NUMBER OF SYMBOLS\r
- ASH V,1 ;TWO WORDS PER SYMBOL\r
- ADDI V,1 ;ONE MORE FOR COUNT\r
- ADDB V,FREE ;END OF TABLE WHEN MOVED\r
- BLT AC0,(V) ;MOVE TABLE\r
- HRRZ AC0,JOBREL ;TOP OF CORE\r
- SUBI AC0,1\r
- MOVEM AC0,SYMTOP ;FOR NEXT SYMBOL TABLE\r
- SUBI AC0,LENGTH ;LENGTH OF INITIAL SYMBOLS\r
- MOVEM AC0,SYMBOL ;SET POINTER TO COUNT OF SYMBOLS\r
- HRLI AC0,SYMNUM ;BLT POINTER\r
- BLT AC0,@SYMTOP ;SET UP INITIAL SYMBOL TABLE\r
- PUSHJ PP,SRCHI ;SET UP SEARCH POINTER\r
- MOVEI AC0,.TBUF ;MAX NUMBER OF CHARS. IN TITLE\r
- SUB AC0,TCNT ;ACTUAL NUMBER\r
- IDIVI AC0,5 ;NUMBER OF WORDS\r
- SKIPE AC1 ;REMAINDER?\r
- ADDI AC0,1 ;YES\r
- MOVEM AC0,@FREE ;STORE COUNT\r
- AOS FREE ;THIS LOCATION USED NOW\r
- EXCH AC0,FREE ;SET UP AC0 FOR BLT\r
- ADDM AC0,FREE ;WILL BE AFTER TITLE MOVES\r
- HRLI AC0,TBUF ;BLT POINTER\r
- BLT AC0,@FREE ;MOVE TITLE\r
- MOVE AC2,LITHDX ;POINTER TO LIT INFO.\r
- MOVE AC0,-1(AC2) ;SIZE OF PASS1 LOCO\r
- PUSHJ PP,STORIT ;SAVE IT IN SYMBOL TABLE\r
- MOVE AC2,VARHDX ;SAME FOR VARS\r
- MOVE AC0,-1(AC2)\r
- PUSHJ PP,STORIT\r
-IFN RENTSW,<\r
- MOVE AC0,HISNSW ;GET TWOSEG/HISEG FLAG\r
- HRR AC0,HIGH1 ;AND PASS1 BREAK\r
- PUSHJ PP,STORIT\r
- JUMPGE AC0,PSEND6 ;NOT TWOSEG\r
- MOVE AC0,SVTYP3 ;HIGH SEGMENT OFFSET\r
- PUSHJ PP,STORIT ;SAVE IT ALSO>\r
-PSEND6: MOVE AC0,FREE ;GET NEXT FREE LOCATION\r
- SUBI AC0,1 ;LAST ONE USED\r
- HRRZ V,PRGPTR ;POINTER TO START OF DATA BLOCK\r
- HRLM AC0,(V) ;LINK TO END OF BLOCK\r
- POPJ PP, ;RETURN\r
-\r
-\fPSENDX: PUSHJ PP,XCEED ;NEED TO EXPAND CORE FIRST\r
-PSEND5: HRRZ AC0,JOBREL ;GET TOP OF CORE\r
- SUBI AC0,1\r
- MOVEM AC0,SYMTOP ;TOP OF NEW SYMBOL TABLE\r
- HRRZ V,PRGPTR ;ADDRESS OF THIS BLOCK\r
- JUMPE V,PSNDER ;ERROR LINK NOT SET UP\r
- MOVE AC1,(V) ;NEXT LINK\r
- MOVE V,1(V) ;GET ITS SYMBOL COUNT\r
- ASH V,1 ;NUMBER OF WORDS\r
- ADDI V,1 ;PLUS ONE FOR COUNT\r
- SUBI AC0,(V) ;START OF NEW SYMBOL TABLE\r
- CAMG AC0,FREE ;WILL IT FIT\r
- JRST PSENDX ;NO, NEED TO EXPAND AND RESET AC0\r
- ADD V,PRGPTR ;POINT TO END OF SYMBOL TABLE\r
- MOVEI V,1(V) ;THEN TO BEG OF TITLE\r
- MOVEM AC0,SYMBOL ;BOTTOM OF NEW TABLE\r
- HRL AC0,PRGPTR ;ADDRESS OF FIRST WORD OF BLOCK\r
- ADD AC0,[1,,0] ;MAKE BLT POINTER\r
- HRRM AC1,PRGPTR ;POINT TO NEXT BLOCK\r
- BLT AC0,@SYMTOP ;MOVE TABLE\r
- PUSHJ PP,SRCHI ;SET UP POINTER\r
- MOVE AC1,(V) ;NUMBER OF WORDS OF TITLE\r
- MOVEI AC0,1(V) ;START OF STORED TITLE\r
- ADD V,AC1 ;INCREMENT PAST TITLE\r
- ADDI AC1,TBUF-1 ;END OF TITLE\r
- HRLI AC0,TBUF ;WHERE TO PUT IT\r
- MOVSS AC0 ;BLT POINTER\r
- BLT AC0,(AC1) ;MOVE TITLE\r
- TLO IO,IOTLSN ;SET AS IF TITLE SEEN\r
- MOVE AC2,LITHDX ;INVERSE OF ABOVE\r
- PUSHJ PP,GETIT\r
- MOVEM AC0,-1(AC2)\r
- MOVE AC2,VARHDX ;SAME FOR VARS\r
- PUSHJ PP,GETIT\r
- MOVEM AC0,-1(AC2)\r
-IFN RENTSW,<\r
- PUSHJ PP,GETIT ;GET TWO HALF WORDS\r
- HRRZM AC0,HIGH1 ;PASS1 BREAK\r
- HLLEM AC0,HISNSW ;TWOSEG/HISEG FLAG\r
- JUMPGE AC0,CPOPJ ;NOT TWOSEG\r
- PUSHJ PP,GETIT\r
- MOVEM AC0,SVTYP3 ;BLOCK 3 WORD>\r
- POPJ PP,\r
-\r
-STORIT: MOVEM AC0,@FREE ;STORE IT IN DATA BLOCK\r
- AOS FREE ;ADVANCE POINTER\r
- POPJ PP,\r
-\r
-GETIT: MOVE AC0,1(V) ;FILL AC0 OUT OF PRGEND BLOCK\r
- AOJA V,CPOPJ ;INCREMENT AND RETURN\r
-\r
-PSNDER: HRROI RC,[SIXBIT /PRGEND ERROR @/]\r
- JRST ERRFIN\r
-\f;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS\r
-\r
-UNIV0: JUMP2 TITLE0 ;DO IT ALL ON PASS 1\r
- HRRZ SX,UNIVNO ;GET NUMBER OF UNIVERSALS SEEN\r
- CAIL SX,.UNIV ;ALLOW ONE MORE?\r
- JRST UNVERR ;NO, GIVE FATAL ERROR\r
- AOS UNIVNO ;ONE MORE NOW\r
- SETOM UNIVSN ;AND SET SEEN A UNIVERSAL\r
- JRST TITLE0 ;CONTINUE AS IF TITLE\r
-\r
-\r
-ADDUNV: PUSH PP,RC ;AN AC TO USE\r
- PUSHJ PP,NOUT ;CONVERT TO SIXBIT\r
- HRRZ RC,UNIVNO ;GET ENTRY INDEX\r
- MOVEM AC0,UNITBL(RC) ;STORE SIXBIT NAME IN TABLE\r
- HRRZS UNIVSN ;ONLY DO IT ONCE\r
- POP PP,RC ;RESTORE RC\r
- POPJ PP, ;AND RETURN\r
-\r
-UNVERR: HRROI RC,[SIXBIT /TOO MANY UNIVERSALS@/]\r
- JRST ERRFIN\r
-\r
-UNISYM: HRRZ AC0,FREE ;GET HIGHEST FREE LOCATION\r
- MOVEM AC0,JOBFF ;INTO JOBFF\r
- PUSHJ PP,SUPRSA ;TURN ON SUPPRESS BIT\r
- PUSH PP,SYMBOL ;NEED TO SAVE INCASE PRGEND\r
- MOVE AC0,SYMTOP ;TOP OF TABLE\r
- SUB AC0,SYMBOL ;GET LENGTH OF TABLE\r
- HRL ARG,SYMBOL ;BOTTOM OF TABLE\r
- HRR ARG,JOBFF ;WHERE TO GO\r
- HRRZ RC,UNIVNO ;GET TABLE INDEX\r
- HRRM ARG,SYMBOL ;WILL BE THERE SOON\r
- HRRZM ARG,UNIPTR(RC) ;STORE IN CORRESPONDING PLACE\r
- ADDB AC0,JOBFF ;WHERE TO END\r
- HRLM AC0,UNIPTR(RC) ;SAVE NEW SYMTOP\r
- BLT ARG,@JOBFF ;MOVE TABLE\r
- HRRZM AC0,UNITOP ;SAVE TOP OF TABLES+1\r
- CAMLE AC0,MACSIZ ;IN CASE OVER A K BOUND\r
- MOVEM AC0,MACSIZ ;DON'T REDUCE SO FAR NOW\r
- MOVEM AC0,FREE ;JUST IN CASE IN MACRO\r
- MOVE AC0,SRCHX ;SAVE OLD SEARCH POINTER\r
- PUSHJ PP,SRCHI ;GET SEARCH POINTER\r
- EXCH AC0,SRCHX\r
- MOVEM AC0,UNISHX(RC) ;SAVE IT\r
- SETZM UNIVSN ;CLEAR FLAG INCASE PRGEND\r
- POP PP,SYMBOL ;RESTORE OLD VALUE\r
- POPJ PP, ;RETURN\r
-\r
-\fSERCH0: PUSHJ PP,GETSYM ;GET A SYMBOL\r
- JRST ERRAX ;ERROR IF NOT VALID\r
- MOVEI RC,1 ;START AT ENTRY ONE\r
- CAIL RC,.UNIV ;CHECK FOR CONSISTENCY ERROR\r
- JRST SCHERR ;CANNOT FIND THIS ONE\r
- CAME AC0,UNITBL(RC) ;LOOK FOR MATCH\r
- AOJA RC,.-3 ;NOT FOUND YET\r
- MOVE AC0,RC ;STORE TABLE ENTRY NUMBER\r
- MOVEI RC,1 ;START AT ENTRY ONE\r
- CAIL RC,.UNIV ;CHECK FOR CONSISTENCY ERROR\r
- JRST SCHERR ;SHOULD NEVER HAPPEN!!\r
- SKIPE UNISCH(RC) ;LOOK FOR AN EMPTY SLOT\r
- AOJA RC,.-3 ;NOT FOUND YET\r
- MOVEM AC0,UNISCH(RC) ;STORE INDEX IN TABLE\r
- JUMPCM SERCH0 ;LOOK FOR MORE NAMES\r
- POPJ PP, ;FINISHED\r
-\r
-SCHERR: MOVSI RC,[SIXBIT /CANNOT FIND UNIVERSAL@/]\r
- JRST ERRFIN ;NAME IN AC0\r
-\r
-;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL\r
-UNIERR: HRROI RC,[SIXBIT /UNIVERSAL PROGRAM(S) MUST HAVE SAME OUTPUT SPECIFICATION AS OTHER FILES@/]\r
- JRST ERRFIN\r
-\fSUBTTL MACRO/REPEAT HANDLERS\r
-\r
-REPEA0: PUSHJ PP,EVALXQ ;EVALUATE REPEAT EXP, EXTERNS ARE ILL.\r
- JUMPNC ERRAX\r
-\r
-REPEA1: JUMPLE AC0,REPZ ;PASS THE EXP., DONT PROCESS\r
- SOJE AC0,REPO ;REPEAT ONCE\r
-REPEA2: PUSHJ PP,GCHARQ ;GET STARTING "<"\r
- CAIE C,"<"\r
- JRST REPEA2\r
- PUSHJ PP,SKELI1 ;INITIALIZE SKELETON\r
- PUSH MP,REPEXP\r
- MOVEM AC0,REPEXP\r
- PUSH MP,REPPNT ;STACK PREVIOUS REPEAT POINTER\r
- MOVEM ARG,REPPNT ;STORE NEW POINTER\r
- TDZA SDEL,SDEL ;YES, INITIALIZE BRACKET COUNT AND SKIP\r
-\r
-REPEA4: PUSHJ PP,WCHARQ ;WRITE A CHARACTER\r
- PUSHJ PP,GCHARQ ;GET A CHARACTER\r
- CAIN C,"<" ;"<"?\r
- AOJA SDEL,REPEA4 ;YES, INCREMENT AND WRITE\r
- CAIE C,">" ;">"?\r
- JRST REPEA4 ;NO, WRITE THE CHARACTER\r
- SOJGE SDEL,REPEA4 ;YES, WRITE IF NON-NEGATIVE COUNT\r
- MOVSI CS,(BYTE (7) 177,3) ;SET "REPEAT" END\r
- PUSHJ PP,WWRXE ;WRITE END\r
- SKIPN LITLVL ;LITERAL MIGHT END ON LINE\r
- SKIPE MACLVL ;IF IN MACRO DARE NOT PROCESS\r
- JRST .+3 ;REST OF LINE SINCE MACRO MIGHT END ON IT\r
- PUSHJ PP,BYPASS ;BYPASS\r
- PUSHJ PP,STOUTS ;POLISH OF LINE BEFORE PROCESSING REPEAT\r
- PUSH MP,MRP ;STACK PREVIOUS READ POINTER\r
- PUSH MP,RCOUNT ;SAVE WORD COUNT\r
- HRRZ MRP,REPPNT ;SET UP READ POINTER\r
- SKIPN MACLVL ;IF IN MACRO GIVE CR-LF FIRST\r
- SKIPE LITLVL ;SAME FOR LITERAL\r
- JRST REPEA7\r
- AOJA MRP,POPOUT ;BYPASS ARG COUNT\r
-\r
-REPEA7: HRRZ MRP,REPPNT ;SET UP READ POINTER\r
- ADDI MRP,1 ;BYPASS ARG COUNT\r
-REPEA8: MOVEI C,CR\r
- JRST RSW1\r
-\r
-REPEND: SOSL REPEXP\r
- JRST REPEA7\r
- HRRZ V,REPPNT ;GET START OF TREE\r
- PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
- POP MP,RCOUNT\r
- POP MP,MRP\r
- POP MP,REPPNT\r
- POP MP,REPEXP\r
- SKIPN LITLVL ;IF IN LITERAL OR\r
- SKIPE MACLVL ;IF IN MACRO\r
- JRST RSW0 ;FINISH OF LINE NOW\r
- JRST REPEA8\r
-\r
-\fREPZ: MOVE SDEL,SEQNO2 ;SAVE IN CASE OF END OF FILE\r
- MOVEM SDEL,REPSEQ\r
- MOVE SDEL,PAGENO\r
- MOVEM SDEL,REPPG\r
- SETOM INREP\r
- MOVEI SDEL,0 ;SET COUNT\r
-REPZ1: PUSHJ PP,GCHAR ;GET NEXT CHARACTER\r
- CAIN C,"<" ;"<"?\r
- AOJA SDEL,REPZ1 ;YES, INCREMENT COUNT\r
- CAIN C,">" ;">"?\r
- SOJLE SDEL,REPZ2 ;YES, EXIT IF MATCHING\r
- JRST REPZ1 ;NO, RECYCLE\r
-REPZ2: SETZM INREP ;FLAG OUT OF IT\r
- SETZM INCND ;AND CONDITIONAL ALSO\r
- JRST STMNT ;AND EXIT\r
-\r
-REPO: PUSHJ PP,GCHAR ;GET "<"\r
- CAIE C,"<"\r
- JRST REPO\r
- SKIPE RPOLVL ;ARE WE NESTED?\r
- AOS RPOLVL ;YES, DECREMENT CURRENT\r
- PUSH MP,RPOLVL\r
- SETOM RPOLVL\r
- JRST STMNT\r
-\r
-REPO1: CAIN C,"<"\r
- SOS RPOLVL\r
- CAIN C,">"\r
- AOSE RPOLVL\r
- JRST RSW2\r
- POP MP,RPOLVL\r
- PUSHJ PP,RSW2\r
- JRST RSW0\r
-\fDEFIN0: PUSHJ PP,GETSYM ;GET MACRO NAME\r
- JRST ERRAX ;EXIT ON ERROR\r
- MOVEM PP,PPTMP1 ;SAVE POINTER\r
- MOVEM AC0,PPTMP2 ;SAVE NAME\r
- TLO IO,IORPTC\r
- MOVE SX,SEQNO2 ;SAVE IN CASE OF EOF\r
- MOVEM SX,DEFSEQ\r
- MOVE SX,PAGENO\r
- MOVEM SX,DEFPG\r
- SETOM INDEF ;AND FLAG IN DEFINE\r
- SYN .TEMP,COMSW ;SAVE SPACE\r
- SETZB SX,COMSW ;SET ARGUMENT AND REFERENCE COUNT AND COMMENT SWITCH\r
-DEF02: PUSHJ PP,GCHAR ;SEARCH FOR "(" OR "<"\r
- CAIG C,FF ;SEARCH FOR END OF LINE\r
- CAIGE C,LF ;LF,VT, OR FF\r
- JRST .+2 ;WASN'T ANY OF THEM\r
- SETZM COMSW ;RESET COMMENT SWITCH\r
- CAIN C,";" ;COMMENT?\r
- SETOM COMSW ;YES, SET COMMENT SWITCH\r
- SKIPE COMSW ;INSIDE A COMMENT?\r
- JRST DEF02 ;YES, IGNORE CHARACTER\r
- CAIN C,"<" ;"<"?\r
- JRST DEF20 ;YES\r
- CAIE C,"(" ;"("?\r
- JRST DEF02 ;NO\r
-DEF10: PUSHJ PP,GETSYM ;YES, GET DUMMY SYMBOL\r
- TRO ER,ERRA ;FLAG ERROR\r
- ADDI SX,1 ;INCREMENT ARG COUNT\r
- PUSH PP,AC0 ;STACK IT\r
- CAIN C,'<' ;A DEFAULT ARGUMENT COMING UP?\r
- JRST DEF80 ;YES, STORE IT AWAY\r
- CAIE C,11 ;")"?\r
- JRST DEF10 ;NO, GET NEXT DUMMY SYMBOL\r
-DEF12: PUSHJ PP,GCHAR\r
- CAIE C,"<" ;"<"?\r
- JRST DEF12 ;NO\r
-DEF20: PUSH PP,[0] ;YES, MARK THE LIST\r
- LSH SX,9 ;SHIFT ARG COUNT\r
- AOS ARG,SX\r
- PUSHJ PP,SKELI ;INITIALIZE MACRO SKELETON\r
- MOVE AC0,PPTMP2 ;GET NAME\r
- TLO IO,DEFCRS\r
- PUSHJ PP,MSRCH ;SEARCH THE TABLE\r
- JRST DEF24 ;NOT FOUND\r
- TLNN ARG,MACF ;FOUND, IS IT A MACRO?\r
- TROA ER,ERRX ;NO, FLAG ERROR AND SKIP\r
- PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE\r
-DEF24: HRRZ V,WWRXX ;GET START OF TREE\r
- SKIPN .TEMP ;ANY DEFAULT ARGUMENTS TO TAKE CARE OF?\r
- JRST DEF25 ;NO\r
- HRRZ C,1(V) ;GET SHIFTED ARG COUNT\r
- LSH C,-9 ;GET ARG COUNT BACK\r
- ADDI C,1 ;ONE MORE FOR TERMINAL ZERO\r
- ADD C,.TEMP ;NUMBER OF ITEMS IN STACK\r
- HRLS C ;MAKE XWD\r
- SUB PP,C ;BACK UP STACK\r
- MOVE SDEL,.TEMP ;NUMBER OF WORDS NEEDED\r
- ADDB SDEL,FREE ;FROM FREE CORE\r
- CAML SDEL,SYMBOL ;MORE CORE NEEDED\r
- PUSHJ PP,XCEEDS ;YES, TRY TO GET IT\r
- SUB SDEL,.TEMP ;FORM POINTER\r
- HRLM SDEL,1(V) ;STORE IT WITH ARG COUNT IN MACRO\r
- SUBI SDEL,1 ;TO USE FOR PUSHING POINTER INTO STORAGE\r
- MOVEI C,1(PP) ;POINT TO START OF STACK\r
-DEF26: MOVE ARG,(C) ;GET AN ITEM OFF STACK\r
- TLNN ARG,-40 ;A POINTER?\r
- JUMPN ARG,[PUSH SDEL,ARG ;YES, STORE IT\r
-\f AOJA C,DEF26] ;GET NEXT\r
- PUSH PP,ARG ;RESTACK ARGUMENT\r
- SKIPE ARG ;FINISHED IF ZERO\r
- AOJA C,DEF26 ;GET NEXT\r
- PUSH SDEL,ARG ;STORE ZERO IN DEFAULT LIST ALSO\r
-\fDEF25: MOVSI ARG,MACF\r
- MOVEM PP,PPTMP2 ;STORE TEMP STORAGE POINTER\r
- PUSHJ PP,INSERT ;INSERT/UPDATE\r
- TLZ IO,DEFCRS ;JUST IN CASE\r
- SETZM ARGF ;NO ARGUMENT SEEN\r
- SETZM SQFLG ;AND NO ' SEEN\r
- TDZA SDEL,SDEL ;CLEAR BRACKET COUNT\r
-DEF30: PUSHJ PP,WCHAR ;WRITE CHARACTER\r
-DEF31: PUSHJ PP,GCHAR ;GET A CHARACTER\r
-DEF32: MOVE CS,C ;GET A COPY\r
- CAIN C,";" ;IS IT A COMMENT\r
- JRST CPEEK ;YES CHECK FOR ;;\r
-DEF33: CAIG CS,"Z"+40 ;CONVERT LOWER CASE\r
- CAIGE CS,"A"+40\r
- JRST .+2\r
- SUBI CS,40\r
-\f CAIGE CS,40 ;TEST FOR CONTROL CHAR.\r
- JRST [SKIPN SQFLG ;HAS SINGLE QUOTE BEEN SEEN?\r
- JRST DEF30 ;NO, OUTPUT THIS CHAR.\r
- PUSH PP,C ;YES, SAVE CURRENT CHAR\r
- MOVEI C,47 ;SET UP QUOTE\r
- PUSHJ PP,WCHAR;WRITE IT\r
- POP PP,C ;GET BACK CURRENT CHAR.\r
- SETZM SQFLG ;RESET FLAG\r
- JRST DEF30] ;AND CONTINUE \r
- CAILE CS,77+40\r
- JRST DEF30 ;TEST FOR SPECIAL\r
- MOVE CS,CSTAT-40(CS) ;GET STATUS BITS\r
-\f TLNE CS,6 ;ALPHA-NUMERIC?\r
- JRST DEF40 ;YES\r
- SKIPN SQFLG ;WAS A ' SEEN?\r
- JRST DEF36 ;NO, PROCESH\r
- PUSH PP,C ;YES, SAVE CURRENT CHARACTER\r
- MOVEI C,47 ;AND PUT IN A '\r
- PUSHJ PP,WCHAR ;...\r
- POP PP,C ;RESTORE CURRENT CHARACTER\r
- SETZM SQFLG ;AND RESET FLAG\r
-DEF36: CAIE C,47 ;IS THIS A '?\r
- JRST DEF35 ;NOPE\r
- SKIPN ARGF ;YES, WAS LAST THING SEEN AN ARG?\r
- SETOM SQFLG ;IF NOT, SET SNGL QUOT FLAG\r
- SETZM ARGF ;BUT NOT ARGUMENT IN ANY CASE\r
- JRST DEF31 ;GO GET NEXT CHARACTER\r
-\fDEF35: SETZM ARGF ;THIS IS NOT AN ARGUMENT\r
- CAIN C,"<" ;"<"?\r
- AOJA SDEL,DEF30 ;YES, INCREMENT COUNT AND WRITE\r
- CAIN C,">" ;">"?\r
- SOJL SDEL,DEF70 ;YES, TEST FOR END\r
- JRST DEF30 ;NO, WRITE IT\r
-\r
-CPEEK: TLNN IO,IOPALL ;IF LALL IS ON\r
- JRST DEF33 ;JUST RETURN\r
- PUSHJ PP,PEEK ;LOOK AT NEXT CHAR.\r
- CAIN C,";" ;IS IT ;;?\r
- JRST CPEEK1 ;YES\r
- MOVE C,CS ;RESTORE C\r
- JRST DEF33 ;AND RETURN\r
-\r
-CPEEK1: PUSHJ PP,GCHAR ;GET THE CHAR.\r
- CAIE C,">" ;RETURN IF END OF MACRO\r
- CAIG C,CR ;IS CHAR ONE OF\r
- CAIGE C,LF ;LF,VT,FF,CR\r
- JRST CPEEK1 ;NO,SO GET NEXT CHAR.\r
- JRST DEF32 ;YES,RETURN AND STORE\r
-\fDEF40: MOVEI AC0,0 ;CLEAR ATOM\r
- MOVSI AC1,(POINT 6,AC0) ;SET POINTER\r
-DEF42: PUSH PP,C ;STACK CHARACTER\r
- TLNE AC1,770000 ;HAVE WE STORED 6?\r
- IDPB CS,AC1 ;NO, STORE IN ATOM\r
- PUSHJ PP,GCHAR ;GET NEXT CHARACTER\r
- MOVE CS,C\r
- CAIG CS,"Z"+40\r
- CAIGE CS,"A"+40\r
- JRST .+2\r
- SUBI CS,40 ;CONVERT LOWER TO UPPER\r
- CAIL CS,40\r
- CAILE CS,77+40\r
- JRST DEF44 ;TEST SPECIAL\r
- MOVE CS,CSTAT-40(CS) ;GET STATUS\r
- TLNE CS,6 ;ALPHA-NUMERIC?\r
- JRST DEF42 ;YES, GET ANOTHER\r
-DEF44: PUSH PP,[0] ;NO, MARK THE LIST\r
- MOVE SX,PPTMP1 ;GET POINTER TO TOP\r
-\r
-DEF46: SKIPN 1(SX) ;END OF LIST?\r
- JRST DEF50 ;YES\r
- CAME AC0,1(SX) ;NO, DO THEY COMPARE?\r
- AOJA SX,DEF46 ;NO, TRY AGAIN\r
- SUB SX,PPTMP1 ;YES, GET DUMMY SYMBOL NUMBER\r
- LSH SX,4\r
- MOVSI CS,<(BYTE (7) 177,101)>(SX) ;SET ESCAPE CODE MACEND\r
- LSH AC0,-^D30\r
- CAIN AC0,5 ;"%"?\r
- TLO CS,1000 ;YES, SET CRESYM FLAG\r
- PUSHJ PP,WWORD ;WRITE THE WORD\r
- SETOM ARGF ;SET ARGUMENT SEEN FLAG\r
- SETZM SQFLG ;AND IGNORE ANY ' WAITING TO GET INTO STRING\r
-DEF48: MOVE PP,PPTMP2 ;RESET PUSHDOWN POINTER\r
- TLO IO,IORPTC ;ECHO LAST CHARACTER\r
- JRST DEF31 ;RECYCLE\r
-\r
-DEF50:\r
- SKIPN SQFLG ;HAVE WE SEEN A '?\r
- JRST DEF51 ;NOPE\r
- MOVEI C,47 ;YES, PUT IT IN\r
- PUSHJ PP,WCHAR ;...\r
- SETZM SQFLG ;AND CLEAR FLAG\r
-DEF51: MOVE C,2(SX) ;GET CHARACTER\r
- JUMPE C,DEF48 ;CLEAN UP IF END\r
- PUSHJ PP,WCHAR ;WRITE THE CHARACTER\r
- AOJA SX,DEF51 ;GET NEXT\r
-\r
-DEF70: MOVE PP,PPTMP1 ;RESTORE PUSHDOWN POINTER\r
- MOVSI CS,(BYTE (7) 177,1)\r
- PUSHJ PP,WWRXE ;WRITE END\r
- SETZM INDEF ;OUT OF IT\r
- JRST BYPASS\r
-\f; HERE TO STORE DEFAULT ARGUMENTS\r
-\r
-DEF80: AOS .TEMP ;COUNT ONE MORE\r
- PUSHJ PP,SKELI1 ;INITIALIZE SKELETON\r
- HRL V,SX ;SYMBOL NUMBER\r
- PUSH PP,V ;STORE POINTER\r
- TDZA SDEL,SDEL ;ZERO BRACKET COUNT\r
-DEF81: PUSHJ PP,WCHARQ ;WRITE A CHARACTER\r
- PUSHJ PP,GCHARQ ;GET A CHARACTER\r
- CAIN C,"<" ;ANOTHER "<"?\r
- AOJA SDEL,DEF81 ;YES, INCREMENT AND WRITE\r
- CAIE C,">" ;CLOSING ANGLE?\r
- JRST DEF81 ;NO, JUST WRITE THE CHAR.\r
- SOJGE SDEL,DEF81 ;YES, WRITE IF NOT END\r
- MOVSI CS,(BYTE (7) 177,2)\r
- PUSHJ PP,WWRXE ;WRITE END OF DUMMY ARGUMENT\r
- PUSHJ PP,GCHAR ;READ AT NEXT CHAR.\r
- CAIE C,")" ;END OF ARGUMENT LIST?\r
- JRST DEF10 ;NO, GET NEXT SYMBOL\r
- JRST DEF12 ;YES, LOOK FOR "<"\r
-\fSUBTTL MACRO CALL PROCESSOR\r
-CALLM: SKIPGE MACENL ;ARE WE TRYING TO RE-ENTER?\r
- JRST ERRAX ;YES, BOMB OUT WITH ERROR\r
- HRROS MACENL ;FLAG "CALLM IN PROGRESS"\r
- EXCH MP,RP\r
- PUSH MP,V ;STACK FOR REFDEC\r
- EXCH MP,RP\r
- MOVEM AC0,CALNAM ;SAVE MACRO NAME INCASE OF ERROR\r
- MOVE SDEL,SEQNO2 ;SAVE IN CASE OF EOF\r
- MOVEM SDEL,CALSEQ\r
- MOVE SDEL,PAGENO\r
- MOVEM SDEL,CALPG\r
- ADDI V,1 ;POINT TO DUMMY SYMBOL COUNT\r
- AOS SDEL,0(V) ;INCREMENT ARG COUNT\r
- HLLZM SDEL,.TEMP ;DEFAULT ARG POINTER IF NON-ZERO\r
- LSHC SDEL,-^D<9+36> ;ZERO SDEL, GET ARG COUNT IN SX\r
- ANDI SX,777 ;MASK\r
- SKIPE .TEMP ;IF AT LEAST ONE DEFAULT ARG\r
- HRRM SX,.TEMP ;STORE COUNT OF ARGS\r
- PUSH PP,V ;STACK FOR MRP\r
- PUSH PP,RP ;STACK FOR MACPNT\r
- JUMPE SX,MAC20 ;TEST FOR NO ARGS\r
- PUSHJ PP,CHARAC\r
- CAIE C,"(" ;"("\r
- TROA SDEL,-1 ;NO, FUDGE PAREN COUNT AND SKIP\r
-\r
-MAC10: PUSHJ PP,GCHAR ;GET A CHARACTER, LOOK FOR AN ARG\r
- CAIG C,CR\r
- CAIGE C,LF\r
- CAIN C,";" ;";"?\r
- JRST MAC21 ;YES, END OF ARGUMENT STRING\r
-\r
- PUSHJ PP,SKELI1 ;NO, INITIALIZE SKELETON\r
- CAIN C,"<" ;"<"?\r
- JRST MAC30 ;YES, PROCESS AS SPECIAL\r
- CAIE C,176\r
- CAIN C,134 ;"\"\r
- JRST MAC40 ;YES, PROCESS SYMBOL\r
-\r
-MAC14: CAIN C,"," ;","?\r
- JRST MAC16 ;YES; NULL SYMBOL\r
- CAIN C,"(" ;"("?\r
- ADDI SDEL,1 ;YES, INCREMENT COUNT\r
- CAIN C,")" ;")"?\r
- SOJL SDEL,MAC16 ;YES, TEST FOR END\r
- PUSHJ PP,WCHAR ;WRITE INTO SKELETON\r
-MAC14A: PUSHJ PP,CHARAC ;GET NEXT CHARACTER\r
- CAIG C,CR\r
- CAIGE C,LF\r
- JRST .+2\r
- JRST MAC15 ;TEST FOR END OF LINE\r
- CAIE C,";" ;";"?\r
- JRST MAC14 ;YES, END OF LINE\r
-\r
-MAC15: TLO IO,IORPTC\r
-MAC16: MOVSI CS,(BYTE (7) 177,2)\r
- PUSHJ PP,WWRXE ;WRITE END\r
- EXCH MP,RP\r
- PUSH MP,WWRXX\r
- EXCH MP,RP\r
- SOJLE SX,MAC20 ;BRANCH IF NO MORE ARGS\r
- JUMPGE SDEL,MAC10 ;HAVEN'T SEEN TERMINAL ")" YET\r
-\fMAC20: TLZN IO,IORPTC\r
- PUSHJ PP,CHARAC\r
-MAC21: EXCH MP,RP\r
- JUMPE SX,MAC21B ;NO MISSING ARGS\r
-MAC21A: PUSH MP,[-1] ;FILL IN MISSING ARGS\r
- SKIPN .TEMP ;ANY DEFAULT ARGS?\r
- JRST MAC21C ;NO\r
- HRRZ C,.TEMP ;GET ARG COUNT\r
- SUBI C,-1(SX) ;ACCOUNT FOR THOSE GIVEN\r
- HRLZS C ;PUT IN LEFT HALF\r
- HLRZ SDEL,.TEMP ;ADDRESS OF TABLE\r
-MAC21D: SKIPN (SDEL) ;END OF LIST\r
- JRST MAC21C ;YES\r
- XOR C,(SDEL) ;TEST FOR CORRECT ARG\r
- TLNN C,-1 ;WAS IT?\r
- JRST MAC21E ;YES\r
- XOR C,(SDEL) ;BACK THE WAY IT WAS\r
- AOJA SDEL,MAC21D ;AND TRY AGAIN\r
-\r
-MAC21E: MOVEM C,(MP) ;REPLACE -1 WITH TREE POINTER\r
- AOS 1(C) ;INCREMENT REFERENCE\r
-MAC21C: SOJG SX,MAC21A\r
-MAC21B: PUSH MP,[0] ;SET TERMINAL\r
- HRRZ C,LIMBO\r
- TLNN IO,IOSALL ;SUPPRESSING ALL?\r
- JRST MAC23 ;NO\r
- JUMPN MRP,MAC27 ;IN MACRO?\r
- CAIE C,";" ;NO,IN COMMENT?\r
- JRST MAC26 ;NO\r
-MAC22: PUSHJ PP,CHARAC ;YES,GET IT INTO THE LBUF\r
- CAIG C,CR ;LESS THAN CR?\r
- CAIGE C,LF ;AND GREATER THAN LF?\r
- JRST MAC22 ;NO GET ANOTHER\r
-MAC26: HRLZI SX,70000 ;DECREMENT BYTE POINTER\r
- ADDB SX,LBUFP\r
- JUMPGE SX,MAC27\r
- HRLOI SX,347777\r
- ADDM SX,LBUFP\r
-MAC27: HRLI C,-1 ;SET FLAG\r
- JRST MAC25\r
-\r
-MAC23: MOVEI SX,"^"\r
- JUMPAD MAC24 ;BRANCH IF ADDRESS FIELD\r
- CAIN C,";" ;IF SEMI-COLON\r
- SKIPE LITLVL ;AND NOT IN A LITERAL\r
- JRST MAC24 ;NOT BOTH TRUE\r
- JUMPN MRP,MAC24 ;OR IN A MACRO\r
- PUSHJ PP,STOUT ;LIST COMMENT OR CR-LF\r
- TLNE IO,IOPALL ;MACRO EXPANSION SUPPRESSION?\r
- TLO IO,IOMAC ; NO, SET TEMP BIT\r
- TDOA C,[-1] ;FLAG LAST CHARACTER\r
-MAC24: DPB SX,LBUFP ;SET ^ INTO LINE BUFFER\r
-MAC25: PUSH MP,MACPNT\r
- POP PP,MACPNT\r
- PUSH MP,C\r
- PUSH MP,RCOUNT ;STACK WORD COUNT\r
- PUSH MP,MRP ;STACK MACRO POINTER\r
- POP PP,MRP ;SET NEW READ POINTER\r
- EXCH MP,RP\r
- AOS MACLVL\r
- HRRZS MACENL ;RESET "CALLM IN PROGRESS"\r
- JUMPOC STMNT2 ;OP-CODE FIELD\r
- JRST EVATOM ;ADDRESS FIELD\r
-\r
-\fMAC30: MOVEI AC0,0 ;INITIALIZE BRACKET COUNTER\r
-MAC31: PUSHJ PP,GCHAR ;GET A CHARACTER\r
- CAIN C,"<" ;"<"?\r
- ADDI AC0,1 ;YES, INCREMENT COUNT\r
- CAIN C,">" ;">"?\r
- SOJL AC0,MAC14A ;YES, EXIT IF MATCHING\r
- PUSHJ PP,WCHAR ;WRITE INTO SKELETON\r
- JRST MAC31 ;GO BACK FOR ANOTHER\r
-\r
-MAC40: PUSH PP,SX ;STACK REGISTERS\r
- PUSH PP,SDEL\r
- HLLM IO,TAGINC ;SAVE IO FLAGS\r
- PUSHJ PP,CELL ;GET AN ATOM\r
- MOVE V,AC0 ;ASSUME NUMERIC\r
- TLNE IO,NUMSW ;GOOD GUESS?\r
- JRST MAC41 ;YES\r
- PUSHJ PP,SSRCH ;SEARCH THE SYMBOL TABLE\r
- TROA ER,ERRX ;NOT FOUND, ERROR\r
-MAC41: PUSHJ PP,MAC42 ;FORM ASCII STRING\r
- HLL IO,TAGINC ;RESTORE IO FLAGS\r
- POP PP,SDEL\r
- POP PP,SX\r
- TLO IO,IORPTC ;REPEAT LAST CHARACTER\r
- JRST MAC14A ;RETURN TO MAIN SCAN\r
-\r
-MAC42: MOVE C,V\r
-MAC44: LSHC C,-^D35\r
- LSH CS,-1\r
- DIVI C,0(RX) ;DIVIDE BY CURRENT RADIX\r
- HRLM CS,0(PP)\r
- JUMPE C,.+2 ;TEST FOR END\r
- PUSHJ PP,MAC44\r
- HLRZ C,0(PP)\r
- ADDI C,"0" ;FORM TEXT\r
- JRST WCHAR ;WRITE INTO SKELETON\r
-\fMACEN0: SOS MACENL\r
-MACEND: SKIPGE C,MACENL ;TEST "CALLM IN PROGRESS"\r
- AOS MACENL ;INCREMENT END LEVEL AND EXIT\r
- JUMPL C,REPEA8\r
- EXCH MP,RP\r
- POP MP,MRP ;RETRIEVE READ POINTER\r
- POP MP,RCOUNT ;AND WORD COUNT\r
- MOVEI C,"^"\r
- SKIPL 0(MP) ;TEST FLAG\r
- PUSHJ PP,RSW2 ;MARK END OF SUBSTITUTION\r
- POP MP,C\r
- POP MP,ARG\r
- SKIPA MP,MACPNT ;RESET MP AND SKIP\r
-MACEN1: PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
-MACEN2: AOS V,MACPNT ;GET POINTER\r
- MOVE V,0(V)\r
- JUMPG V,MACEN1 ;IF >0, DECREMENT REFERENCE\r
- JUMPL V,MACEN2 ;IF <0, BYPASS\r
- POP MP,V ;IF=0, RETRIEVE POINTER\r
- PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
- MOVEM ARG,MACPNT\r
- EXCH MP,RP\r
- SOS MACLVL\r
- SKIPN MACENL ;CHECK UNPROCESSED END LEVEL\r
- JRST MACEN3 ;NONE TO PROCESS\r
- TRNN MRP,-1 ;MRP AT END OF TEXT\r
- JRST MACEN0 ;THEN POP THE MACRO STACK NOW\r
-MACEN3: TRNN C,77400 ;SALL FLAG?\r
- HRLI C,0 ;YES,TURN IT OFF\r
- JUMPL C,REPEA8 ;IF FLAG SET SUBSTITUTE\r
- JRST RSW1\r
-\fIRP0: SKIPN MACLVL ;ARE WE IN A MACRO?\r
- JRST ERRAX ;NO, BOMB OUT\r
-IRP10: PUSHJ PP,MREADS ;YES, GET DATA SPEC\r
- CAIE C,40 ;SKIP LEADING BLANKS\r
- CAIN C,"(" ;"("?\r
- JRST IRP10 ;YES, BYPASS\r
- CAIN C,11\r
- JRST IRP10\r
- CAIE C,177 ;NO, IS IT SPECIAL?\r
- JRST ERRAX ;NO, ERROR\r
- PUSHJ PP,MREADS ;YES\r
- TRZN C,100 ;CREATED?\r
- JRST ERRAX\r
- CAIL C,40 ;TOO BIG?\r
- JRST ERRAX\r
- ADD C,MACPNT ;NO, FORM POINTER TO STACK\r
- PUSH MP,IRPCF ;STACK PREVIOUS POINTERS\r
- PUSH MP,IRPSW\r
- PUSH MP,IRPARP\r
- PUSH MP,IRPARG\r
- PUSH MP,IRPCNT\r
- PUSH MP,0(C)\r
- PUSH MP,IRPPOI\r
-\r
- HRRZM C,IRPARP\r
- MOVEM AC0,IRPCF ;IRPC FLAG FOUND IN AC0\r
- SETOM IRPSW ;RESET IRP SWITCH\r
- MOVE CS,0(C)\r
- MOVEM CS,IRPARG\r
-\r
- PUSHJ PP,MREADS\r
- CAIE C,"<" ;"<"?\r
- JRST .-2 ;NO, SEARCH UNTIL FOUND\r
- PUSHJ PP,SKELI1 ;INITIALIZE NEW STRING\r
- MOVEM ARG,IRPPOI ;SET NEW POINTER\r
-\r
- TDZA SDEL,SDEL ;ZERO BRACKET COUNT AND SKIP\r
-IRP20: PUSHJ PP,WCHAR1\r
- PUSHJ PP,MREADS\r
- CAIN C,"<" ;"<"?\r
- AOJA SDEL,IRP20 ;YES, INCREMENT COUNT AND WRITE\r
- CAIE C,">" ;">"?\r
- JRST IRP20 ;NO, JUST WRITE IT\r
- SOJGE SDEL,IRP20 ;YES, WRITE IF NOT MATCHING\r
- MOVE CS,[BYTE (7) 15,177,4]\r
- PUSHJ PP,WWRXE ;WRITE END\r
- PUSH MP,MRP ;STACK PREVIOUS READ POINTER\r
- PUSH MP,RCOUNT ;AND WORD COUNT\r
- SKIPG CS,IRPARG\r
- JRST IRPPOP ;EXIT IF NOT VALID ARGUMENT\r
- MOVEI C,1(CS) ;INITIALIZE POINTER\r
- MOVEM C,IRPARG\r
-\fIRPSET: EXCH MRP,IRPARG ;SWAP READ POINTERS\r
- MOVE SX,RCOUNT ;SWAP COUNT OF WORDS TO READ\r
- EXCH SX,IRPCNT\r
- MOVEM SX,RCOUNT\r
- PUSHJ PP,SKELI1 ;INITIALIZE SKELETON FOR DATA\r
- HRRZM ARG,@IRPARP ;STORE NEW DS POINTER\r
- SETZB SX,SDEL ;ZERO FOUND FLAG AND BRACKET COUNT\r
- LDB C,MRP ;GET LAST CHAR\r
- CAIN C,","\r
- SKIPE IRPCF ;IN IRPC\r
- JRST IRPSE1 ;NO\r
- MOVEI SX,1 ;FORCE ARGUMENT\r
-IRPSE1: PUSHJ PP,MREADS\r
- CAIE C,177 ;SPECIAL?\r
- AOJA SX,IRPSE2 ;NO, FLAG AS FOUND\r
- PUSHJ PP,PEEKM ;LOOK AT NEXT CHARACTER\r
- SETZM IRPSW ;SET IRP SWITCH\r
- JUMPG SX,IRPSE4 ;IF ARG FOUND, PROCESS IT\r
- JRST IRPPOP ;NO, CLEAN UP AND EXIT\r
-\r
-IRPSE2: SKIPE IRPCF ;IRPC?\r
- JRST IRPSE3 ;YES, WRITE IT\r
- CAIN C,"," ;NO, IS IT A COMMA?\r
- JUMPE SDEL,IRPSE4 ;YES, EXIT IF NOT NESTED\r
- CAIN C,"<" ;"<"?\r
- ADDI SDEL,1 ;YES, INCREMENT COUNT\r
- CAIN C,">" ;">"?\r
- SUBI SDEL,1 ;YES, DECREMENT COUNT\r
-\r
-IRPSE3: PUSHJ PP,WCHAR\r
- SKIPN IRPCF ;IRPC?\r
- JRST IRPSE1 ;NO, GET NEXT CHARACTER\r
-\r
-IRPSE4: MOVSI CS,(BYTE (7) 177,2)\r
- PUSHJ PP,WWRXE ;WRITE END\r
- MOVEM MRP,IRPARG ;SAVE POINTER\r
- MOVE MRP,RCOUNT ;SAVE COUNT\r
- MOVEM MRP,IRPCNT\r
- HRRZ MRP,IRPPOI ;SET FOR NEW SCAN\r
- AOJA MRP,REPEA8 ;ON ARG COUNT\r
-\fSTOPI0: SKIPN IRPARP ;IRP IN PROGRESS?\r
- JRST ERRAX ;NO, ERROR\r
- SETZM IRPSW ;YES, SET SWITCH\r
- POPJ PP,\r
-\r
-IRPEND: MOVE V,@IRPARP\r
- PUSHJ PP,REFDEC\r
- SKIPE IRPSW ;MORE TO COME?\r
- JRST IRPSET ;YES\r
-\r
-IRPPOP: MOVE V,IRPPOI\r
- PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
- POP MP,RCOUNT\r
- POP MP,MRP ;RESTORE CELLS\r
- POP MP,IRPPOI\r
- POP MP,@IRPARP\r
- POP MP,IRPCNT\r
- POP MP,IRPARG\r
- POP MP,IRPARP\r
- POP MP,IRPSW\r
- POP MP,IRPCF\r
- JRST REPEA8\r
-\fGETDS: ;GET DUMMY SYMBOL NUMBER\r
- MOVE CS,C ;USE CS FOR WORK REGISTER\r
- ANDI CS,37 ;MASK\r
- ADD CS,MACPNT ;ADD BASE ADDRESS\r
- MOVE V,0(CS) ;GET POINTER FLAG\r
- JUMPG V,GETDS1 ;BRANCH IF POINTER\r
- TRNN C,40 ;NOT POINTER, SHOULD WE CREATE?\r
- JRST RSW0 ;NO, FORGET THIS ARG\r
- PUSH PP,WWRXX\r
- PUSH PP,MWP ;STACK MACRO WRITE POINTER\r
- PUSH PP,WCOUNT ;SAVE WORD COUNT\r
- PUSHJ PP,SKELI1 ;INITIALIZE SKELETON\r
- MOVEM ARG,0(CS) ;STORE POINTER\r
- MOVE CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL\r
- ADD CS,LSTSYM ;LSTSYM= # OF LAST CREATED\r
- TDZ CS,[BYTE (7) 0,170,170,170,170]\r
- MOVEM CS,LSTSYM\r
- IOR CS,[ASCII /.0000/]\r
- MOVEI C,"."\r
- PUSHJ PP,WCHAR\r
- PUSHJ PP,WWORD ;WRITE INTO SKELETON\r
- MOVSI CS,(BYTE (7) 177,2)\r
- PUSHJ PP,WWRXE ;WRITE END CODE\r
- POP PP,WCOUNT ;RESTORE WORD COUNT\r
- POP PP,MWP ;RESTORE MACRO WRITE POINTER\r
- POP PP,WWRXX\r
- MOVE V,ARG ;SET UP FOR REFINC\r
-\r
-GETDS1: PUSHJ PP,REFINC ;INCREMENT REFERENCE\r
- HRL V,RCOUNT ;SAVE WORD COUNT\r
- PUSH MP,V ;STACK V FOR DECREMENT\r
- PUSH MP,MRP ;STACK READ POINTER\r
- MOVEI MRP,1(V) ;FORM READ POINTER\r
- JRST RSW0 ;EXIT\r
-\r
-DSEND: POP MP,MRP\r
- POP MP,V\r
- HLREM V,RCOUNT ;RESTORE WORD COUNT\r
- HRRZS V ;CLEAR COUNT\r
- PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
- JRST RSW0 ;EXIT\r
-\fSKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG\r
-SKELI: SETZ MWP, ;SIGNAL FIRST TIME THROUGH\r
- PUSHJ PP,SKELWL ;GET POINTER WORD\r
- HRRZM MWP,WWRXX ;SAVE FIRST ADDRESS\r
- HRRZM MWP,LADR ;SAVE START OF LINKED LIST\r
- HRRZM ARG,1(MWP) ;STORE COUNT\r
- SOS WCOUNT ;ACCOUNT FOR WORD\r
- HRRZ ARG,WWRXX ;SET FIRST ADDRESS\r
- ADDI MWP,2 ;BUMP POINTER\r
- HRLI MWP,(POINT 7) ;SET FOR 5 ASCII BYTES\r
- ;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)\r
-\r
-SKELW: SOSLE WCOUNT ;STILL SOME SPACE IN LEAF?\r
- POPJ PP, ;YES, RETURN\r
-SKELWL: SKIPE V,NEXT ;GET FIRST FREE ADDRESS\r
- JRST SKELW1 ;IF NON-ZERO, UPDATE FREE\r
- MOVE V,FREE ;GET FREE\r
- ADDI V,.LEAF ;INCREMENT BY LEAF SIZE\r
- CAML V,SYMBOL ;OVERFLOW?\r
- PUSHJ PP,XCEED ;YES, BOMB OUT\r
- EXCH V,FREE ;UPDATE FREE\r
- SETZM (V) ;CLEAR LINK\r
-\r
-SKELW1: HLL V,0(V) ;GET ADDRESS\r
- HLRM V,NEXT ;UPDATE NEXT\r
- SKIPE MWP ;IF FIRST TIME\r
- HRLM V,1-.LEAF(MWP) ;STORE LINK IN FIRST WORD OF LEAF\r
- MOVEI MWP,.LEAF ;SIZE OF LEAF\r
- MOVEM MWP,WCOUNT ;STORE FOR COUNT DOWN\r
- MOVEI MWP,(V) ;SET UP WRITE POINTER\r
- TLO MWP,(POINT 7,,21) ;2 ASCII CHARS\r
- POPJ PP,\r
-\r
- ;WWRXX POINTS TO END OF TREE\r
- ;MWP IDPB POINTER TO NEXT HOLE\r
- ;NEXT FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)\r
- ;FREE POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE\r
- ;LADR POINTS TO BEG OF LINKED PORTION.\r
-\fGCHARQ: JUMPN MRP,MREADS ;IF GETTING CHAR. FROM TREE\r
-GCHAR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
- CAIG C,FF ;TEST FOR LF, VT OR FF\r
- CAIGE C,LF\r
- POPJ PP, ;NO\r
- JRST OUTIM1 ;YES, LIST IT\r
-\r
-WCHARQ:\r
-WCHAR: \r
-WCHAR1: TLNN MWP,760000 ;END OF WORD?\r
- PUSHJ PP,SKELW ;YES, GET ANOTHER\r
- IDPB C,MWP ;STORE CHARACTER\r
- POPJ PP,\r
-\r
-WWORD: LSHC C,7 ;MOVE ASCII INTO C\r
- PUSHJ PP,WCHAR1 ;STORE IT\r
- JUMPN CS,WWORD ;TEST FOR END\r
- POPJ PP, ;YES, EXIT\r
-\r
-WWRXE: PUSHJ PP,WWORD ;WRITE LAST WORD\r
- ADD MWP,WCOUNT ;GET TO END OF LEAF\r
- SUBI MWP,.LEAF ;NOW POINT TO START OF IT\r
- HRRZS (MWP) ;ZERO LEFT HALF OF LAST LEAF\r
- HRRM MWP,@WWRXX ;SET POINTER TO END\r
- POPJ PP,\r
-\fMREAD: PUSHJ PP,MREADS ;READ ONE CHARACTER\r
- CAIE C,177 ;SPECIAL?\r
- JRST RSW1 ;NO, EXIT\r
- PUSHJ PP,MREADS ;YES, GET CODE WORD\r
- TRZE C,100 ;SYMBOL?\r
- JRST GETDS ;YES\r
- CAILE C,4 ;POSSIBLY ILLEGAL\r
- JRST ERRAX ;YUP\r
- HRRI MRP,0 ;NO, SIGNAL END OF TEXT\r
- JRST .+1(C)\r
- PUSHJ PP,XCEED\r
- JRST MACEND ;1; END OF MACRO\r
- JRST DSEND ;2; END OF DUMMY SYMBOL\r
- JRST REPEND ;3; END OF REPEAT\r
- JRST IRPEND ;4; END OF IRP\r
-\r
-MREADI: HRLI MRP,700 ;SET UP BYTE POINTER\r
- MOVEI C,.LEAF-1 ;NUMBER OF WORDS\r
- MOVEM C,RCOUNT\r
-MREADS: TLNN MRP,-1 ;FIRST TIME HERE?\r
- JRST MREADI ;YES, SET UP MRP AND RCOUNT\r
- TLNN MRP,760000 ;HAVE WE FINISHED WORD?\r
- SOSLE RCOUNT ;YES, STILL ROOM IN LEAF?\r
- JRST MREADC ;STILL CHAR. IN LEAF\r
- HLRZ MRP,1-.LEAF(MRP);YES, GET LINK\r
- HRLI MRP,(POINT 7,,21) ;SET POINTER\r
- MOVEI C,.LEAF ;RESET COUNT\r
- MOVEM C,RCOUNT\r
-MREADC: ILDB C,MRP ;GET CHARACTER\r
- POPJ PP,\r
-\r
-PEEK: JUMPN MRP,PEEKM ;THIS IS A MACRO READ\r
- PUSHJ PP,CHARAC ;READ AN ASCII CHAR.\r
- TLO IO,IORPTC ;REPEAT FOR NEXT\r
- POPJ PP, ;AND RETURN\r
-\r
-PEEKM: PUSH PP,MRP ;SAVE MACRO READ POINTER\r
- PUSH PP,RCOUNT ;SAVE WORD COUNT\r
- PUSHJ PP,MREADS ;READ IN A CHAR.\r
- POP PP,RCOUNT ;RESTORE WORD COUNT\r
- POP PP,MRP ;RESET READ POINTER\r
- POPJ PP, ;IORPTC IS NOT SET\r
-\fREFINC: MOVEI CS,1(V) ;GET POINTER TO TREE\r
- AOS 0(CS) ;INCREMENT REFERENCE\r
- POPJ PP,\r
-\r
-REFDEC: JUMPLE V,DECERR ;CATASTROPHIC ERROR SOMEWHERE\r
- MOVEI CS,1(V) ;GET POINTER TO TREE\r
- SOS CS,0(CS) ;DECREMENT REFERENCE\r
- TRNE CS,000777 ;IS IT ZERO?\r
- POPJ PP, ;NO, EXIT\r
- HRRZ CS,0(V) ;YES, GET POINTER TO END\r
- HRL CS,NEXT ;GET POINTER TO NEXT RE-USABLE\r
- HLLM CS,0(CS) ;SET LINK\r
- HRRM V,NEXT ;RESET NEXT\r
- POPJ PP,\r
-\r
-DECERR: MOVE AC0,CALNAM ;GET MACRO NAME\r
- MOVSI RC,[SIXBIT /ERROR WHILE EXPANDING@/]\r
- PUSHJ PP,TYPMSG\r
- JRST ERRNE2 ;COMMON MESSAGE\r
-\fA== 0 ;ASCII MODE\r
-AL== 1 ;ASCII LINE MODE\r
-IB== 13 ;IMAGE BINARY MODE\r
-B== 14 ;BINARY MODE\r
-IFE RUNSW,<DMP==16 ;DUMP MODE>\r
-\r
-CTL== 0 ;CONTROL DEVICE NUMBER\r
-IFN CCLSW,<CTL2==4 ;INPUT DEV FOR CCL FILE>\r
-BIN== 1 ;BINARY DEVICE NUMBER\r
-CHAR== 2 ;INPUT DEVICE NUMBER\r
-LST== 3 ;LISTING DEVICE NUMBER\r
-\r
-; COMMAND STRING ACCUMULATORS\r
-\r
-ACDEV== 1 ;DEVICE\r
-ACFILE==2 ;FILE\r
-ACEXT== 3 ;EXTENSION\r
-ACPPN== 4 ;PPN\r
-ACDEL== 4 ;DELIMITER\r
-ACPNTR==5 ;BYTE POINTER\r
-\r
-TIO== 6\r
-\r
-TIORW== 1000\r
-TIOLE== 2000\r
-TIOCLD==20000\r
-\r
-DIRBIT==4 ;DIRECTORY DEVICE\r
-TTYBIT==10 ;TTY\r
-MTABIT==20 ;MTA\r
-DTABIT==100 ;DTA\r
-DISBIT==2000 ;DISPLAY\r
-CONBIT==20000 ;CONTROLING TTY\r
-LPTBIT==40000 ;LPT\r
-DSKBIT==200000 ;DSK\r
-\r
-;GETSTS ERROR BITS\r
-\r
-IOIMPM==400000 ;IMPROPER MODE (WRITE LOCK)\r
-IODERR==200000 ;DEVICE DATA ERROR\r
-IODTER==100000 ;CHECKSUM OR PARITY ERROR\r
-IOBKTL== 40000 ;BLOCK TOO LARGE\r
-ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL\r
-\r
-SYN .TEMP,PPN\r
-\fSUBTTL I/O ROUTINES\r
-BEG:\r
-IFN CCLSW,<TLZA IO,ARPGSW ;DON'T ALLOW RAPID PROGRAM GENERATION\r
- TLO IO,ARPGSW ;ALLOW RAPID PROGRAM GENERATION>\r
-IFN PURESW,<\r
- MOVE MRP,[XWD LOWL,LOWL+1] ;START OF DATA\r
- SETZM LOWL ;ZERO FIRST WORD\r
- BLT MRP,LOWEND ;AND THE REST\r
- MOVE MRP,[XWD LOWH,LOWL] ;PHASED CODE\r
- BLT MRP,LOWL+LENLOW ;MOVE IT IN>\r
- HRRZ MRP,JOBREL ;GET LOWSEG SIZE\r
- MOVEM MRP,MACSIZ ;SAVE CORE SIZE\r
- ;DECODE VERSION NUMBER\r
- MOVEI PP,JOBFFI ;TEMP PUSH DOWN STACK\r
- PUSH PP,[0] ;MARK BOTTOM OF STACK\r
- LDB 0,[POINT 3,JOBVER,2] ;GET USER BITS\r
- JUMPE 0,GETE ;NOT SET IF ZERO\r
- ADDI 0,"0" ;FORM NUMBER\r
- PUSH PP,0 ;STACK IT\r
- MOVEI 0,"-" ;SEPARATE BY HYPHEN\r
- PUSH PP,0 ;STACK IT ALSO\r
-GETE: HRRZ 0,JOBVER ;GET EDIT NUMBER\r
- JUMPE 0,GETU ;SKIP ALL THIS IF ZERO\r
- MOVEI 1,")" ;ENCLOSE IN PARENS.\r
- PUSH PP,1\r
-GETED: IDIVI 0,8 ;GET OCTAL DIGITS\r
- ADDI 1,"0" ;MAKE ASCII\r
- PUSH PP,1 ;STACK IT\r
- JUMPN 0,GETED ;LOOP TIL DONE\r
- MOVEI 0,"(" ;OTHER PAREN.\r
- PUSH PP,0\r
-GETU: LDB 0,[POINT 6,JOBVER,17] ;UPDATE NUMBER\r
- JUMPE 0,GETV ;SKIP IF ZERO\r
- IDIVI 0,8 ;MIGHT BE TWO DIGITS\r
- ADDI 1,"@" ;FORM ALPHA\r
- PUSH PP,1\r
- JUMPN 0,GETU+1 ;LOOP IF NOT DONE\r
-GETV: LDB 0,[POINT 9,JOBVER,11] ;GET VERSION NUMBER\r
- IDIVI 0,8 ;GET DIGIT\r
- ADDI 1,"0" ;TO ASCII\r
- PUSH PP,1 ;STACK\r
- JUMPN 0,GETV+1 ;LOOP\r
- MOVE 1,[POINT 7,VBUF+1,13] ;POINTER TO DEPOSIT IN VBUF\r
- POP PP,0 ;GET CHARACTER\r
- IDPB 0,1 ;DEPOSIT IT\r
- JUMPN 0,.-2 ;KEEP GOING IF NOT ZERO\r
-IFN FORMSW,<IFE DFRMSW,<\r
- SETOM PHWFMT ;HALF WORD UNLESS CHANGED BY SWITCH>>\r
-\fIFN CCLSW,<\r
- TLZA IO,CRPGSW ;SET TO INIT NEW COMMAND FILE\r
-M: TLNN IO,CRPGSW ;CURRENTLY DOING RPG?>\r
-IFE CCLSW,<M:>\r
- RESET ;INITIALIZE PROGRAM\r
- SETZM BINDEV ;CLEAR INCASE NOT USED NEXT TIME\r
- SETZM LSTDEV ;SAME REASON\r
- SETZM INDEV ;INCASE OF ERROR\r
- HRRZ MRP,MACSIZ ;GET INITIAL SIZE\r
- CORE MRP, ;BACK TO ORIGINAL SIZ4\r
- JFCL ;SHOULD NEVER FAIL\r
- SETZB MRP,PASS1I\r
- MOVE [XWD PASS1I,PASS1I+1]\r
- BLT PASS2X-1 ;ZERO THE PASS1 AND PASS2 VARIABLES\r
- MOVEI PP,JOBFFI ;SET TEMP PUSH-DOWN POINTER\r
- MOVE CS,[POINT 7,DBUF,6] ;INITIALIZE FOR DATE\r
- MSTIME 2, ;GET TIME FROM MONITOR\r
- PUSHJ PP,TIMOUT ;TIME FORMAT OUTPUT\r
- DATE 1, ;GET DATE\r
- IBP CS ;PASS OVER PRESET SPACE\r
- PUSHJ PP,DATOUT ;DATE FORMAT OUTPUT\r
- MOVSI FR,P1!CREFSW\r
-IFN CCLSW,<TLNE IO,CRPGSW ;RPG IN PROGRESS?\r
- JRST GOSET ;YES, GO READ NEXT COMMAND\r
- TLNE IO,ARPGSW ;NO, RPG ALLOWED?\r
- JRST RPGSET ;YES, GO TRY\r
-CTLSET: RELEASE CTL2, ;IN CASE OF LOOKUP FAILURE>\r
-IFE CCLSW,<CTLSET:>\r
- MOVSI IO,IOPALL ;ZERO FLAGS\r
- INIT CTL,AL ;INITIALIZE USER CONSOLE\r
- SIXBIT /TTY/\r
- XWD CTOBUF,CTIBUF\r
- EXIT ;NO TTY, NO ASSEMBLY\r
- MOVSI C,(SIXBIT /TTY/)\r
- DEVCHR C, ;GET CHARACTERISTICS\r
- TLNN C,10 ;IS IT REALLY A TTY\r
- EXIT ;NO\r
- INBUF CTL,1 ;INITIALIZE SINGLE CONTROL\r
- OUTBUF CTL,1 ;BUFFERS\r
- PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED\r
- MOVEI C,"*"\r
- IDPB C,CTOBUF+1\r
- OUTPUT CTL,\r
- INPUT CTL,\r
-\fIFN CCLSW,<JRST BINSET ;BEGIN WITH BINARY FILE\r
-\r
-RPGSET:\r
-IFN TEMP,<HRRZ 3,JOBFF ;GET START OF BUFFER AREA\r
- HRRZ 0,JOBREL ;GET TOP OF CORE\r
- CAIGE 0,200(3) ;WILL BUFFER FIT?\r
- JRST [ADDI 0,200 ;NO, GET ENUF CORE\r
- CORE 0, ;CORE UUO\r
- JRST XCEED2 ;FAILED, SO GIVE UP\r
- JRST .+1] ;CONTINUE\r
- HRRM 3,TMPFIL+1 ;STORE IN TMPCOR UUO IOWD\r
- SOS TMPFIL+1 ;MAKE IT THE PROPER IOWD FORMAT\r
- HRRM 3,CTLBLK+1 ;DUMMY UP BUFFER HEADER\r
- MOVE 0,[XWD 2,TMPFIL] ;SET UP FOR TEMP CORE READ\r
- TMPCOR ;READ AND DELETE FILE "MAC"\r
- JRST RPGTMP ;NO SUCH FILE IN CORE TRY DISK\r
- ADD 3,0 ;CALCULATE END OF BUFFER\r
- MOVEM 3,JOBFF ;FIX JOBFF SO FILE WONT BE KILLED\r
- IMULI 0,5 ;CALCULATE CHARACTER COUNT\r
- ADDI 0,1 ;SINCE SOSG HAPPENS AFTER NOT BEFORE\r
- MOVEM 0,CTLBLK+2 ;SET UP CHAR CNT IN BUFFER HEADER\r
- MOVEI 0,440700 ;SET UP BYTE POINTER IN HEADER\r
- HRLM 0,CTLBLK+1 ;BUFFER HEADER NOW SET UP\r
- SETOM TMPFLG ;MARK THAT A TMPCOR UUO WAS DONE\r
- JRST RPGS2A ;CONTINUE IN MAIN STREAM\r
-RPGTMP: SETZM TMPFLG ;JUST IN CASE>\r
- INIT CTL2,AL ;LOOK FOR DISK\r
- SIXBIT /DSK/ ;...\r
- XWD 0,CTLBLK ;...\r
- JRST CTLSET ;DSK NOT THERE\r
-\r
-IFE STANSW,<\r
- HRLZI 3,(SIXBIT /MAC/) ;###MAC\r
- MOVEI 3 ;COUNT\r
- PJOB AC1, ;RETURNS JOB NO. TO AC1\r
-RPGLUP: IDIVI AC1,12 ;CONVERT\r
- ADDI AC2,"0"-40 ;SIXBITIZE IT\r
- LSHC AC2,-6 ;\r
- SOJG 0,RPGLUP ;3 TIMES\r
- MOVEM 3,CTLBUF ;###MAC\r
- HRLZI (SIXBIT /TMP/) ;\r
->\r
-IFN STANSW,<\r
- MOVE 3,['QQMACR']\r
- MOVEM 3,CTLBUF\r
- MOVSI 0,'RPG'\r
->\r
- MOVEM CTLBUF+1 ;TMP\r
- SETZM CTLBUF+3 ;PROG-PRO\r
- LOOKUP CTL2,CTLBUF ;COMMAND FILE\r
- JRST CTLSET ;NOT THERE\r
- HLRM EXTMP ;SAVE THE EXTENSION\r
-\r
-RPGS2: INBUF CTL2,1 ;SINGLE BUFFERED\r
-RPGS2A: INIT CTL,AL ;TTY FOR CONSOLE MESSAGES\r
- SIXBIT /TTY/ ;...\r
- XWD CTOBUF,0 ;...\r
- EXIT ;NO TTY, NO ASSEMBLY\r
- OUTBUF CTL,1 ;SINGLE BUFFERED\r
- MOVE JOBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN\r
- MOVEM SAVFF ;...\r
- HRRZ JOBREL ;TOP OF CORE\r
- CAMLE MACSIZ ;SEE IF IT HAS GROWN\r
- MOVEM MACSIZ ;PREVENTS ADDRESS CHECK ON EXIT\r
- TLNE IO,CRPGSW ;ARE WE ALREADY IN RPG MODE?\r
- JRST M ;MUST HAVE COME FROM @ COMMAND, RESET\r
-\r
-\fGOSET: MOVSI IO,IOPALL!CRPGSW ;SET INITIAL FLAGS\r
- MOVEI CS,CTLSIZ ;MAXIMUM CHARS IN A LINE\r
- MOVE AC1,CTLBLK+2 ;NUMBER OF CHARACTERS\r
- MOVEM AC1,CTIBUF+2 ;SAVE FOR PASS 2\r
- MOVE AC1,[POINT 7,CTLBUF] ;WHERE TO STASH CHARS\r
- MOVEM AC1,CTIBUF+1 ;...\r
-GOSET1: SOSG CTLBLK+2 ;ANY MORE CHARS?\r
- PUSHJ PP,[IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO IN PROGRESS?\r
- EXIT ;YES EXIT>\r
- IN CTL2, ;READ ANOTHER BUFFERFUL\r
- POPJ PP, ;EVERYTHING OK, RETURN\r
- STATO CTL2,20000 ;EOF?\r
- JRST [HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]\r
- JRST ERRFIN] ;GO COMPLAIN\r
- PUSHJ PP,DELETE ;CMD FILE\r
- EXIT] ;EOF AND FINISHED\r
- ILDB C,CTLBLK+1 ;GET NEXT CHAR\r
- MOVE RC,@CTLBLK+1 ;CHECK FOR SEQUENCE NUMBERS\r
- TRNE RC,1 ;...\r
- JRST [AOS CTLBLK+1 ;SKIP OVER ANOTHER 5 CHARS\r
- MOVNI RC,5 ;...\r
- ADDM RC,CTLBLK+2 ;...\r
- JRST GOSET1 ] ;GO READ ANOTHER CHAR\r
- JUMPE C,GOSET1 ;IGNORE NULLS\r
- IDPB C,CTIBUF+1 ;STASH AWAY\r
- AOS CTIBUF+2 ;INCREMENT CHAR. COUNT\r
- CAIE C,12 ;LINE FEED OR\r
- CAIN C,175 ;ALTMODE?\r
- JRST GOSET2 ;YES, FINISHED WITH COMMAND\r
- CAIE C,176\r
- CAIN C,33\r
- JRST GOSET2 ;ALTMODE.\r
- SOJG CS,GOSET1 ;GO READ ANOTHER\r
- HRROI RC,[SIXBIT /COMMAND LINE TOO LONG@/]\r
- JRST ERRFIN ;GO COMPLAIN\r
-GOSET2: MOVEI C,12 ;MAKE SURE THERE'S A LF\r
- IDPB C,CTIBUF+1 ;...\r
- MOVEM AC1,CTIBUF+1 ;SET POINTER TO BEGINNING\r
- AOS CTIBUF+2 ;ADD I TO COUNT\r
- MOVE SAVFF ;RESET JOBFF FOR NEW BINARY\r
- MOVEM JOBFF ;...\r
- JRST BINSET\r
-\f\r
-RPGS1: PUSHJ PP,DELETE ;DELETE COMMAND FILE\r
- MOVEM ACDEV,RPGDEV ;GET SET TO INIT\r
- OPEN CTL2,RPGINI ;DO IT\r
- JRST EINIT ;ERROR\r
- MOVEM ACFILE,INDIR ;USE INPUT BLOCK\r
- MOVEM ACPPN,INDIR+3 ;SET PPN \r
- MOVEM ACEXT,INDIR+1\r
- LOOKUP CTL2,INDIR\r
- JRST [JUMPN ACEXT,RPGLOS ;GIVE UP ,EXPLICIT EXTENSION\r
-IFE STANSW,< MOVSI ACEXT,(SIXBIT /CCL/) ;IF BLANK TRY CCL>\r
-IFN STANSW,< MOVSI ACEXT,(SIXBIT /RPG/) ;IF BLANK TRY RPG>\r
- JRST .-2 ]\r
- HLRM ACEXT,EXTMP ;SAVE THE EXTENSION\r
- HLRZ JOBSA ;RESET JOBFF TO ORIGINAL\r
- MOVEM JOBFF\r
- TLO IO,CRPGSW ;TURN ON SWITCH SO WE RESET WORLD\r
- JRST RPGS2 ;AND GO\r
-RPGLOS: RELEAS CTL2,0\r
- TLZ IO,CRPGSW ;STOPS IO TO UNASGD CHAN\r
- JRST ERRCF ;NO FILE FOUND\r
->\r
-\fBINSET: PUSHJ PP,NAME1 ;GET FIRST NAME\r
-IFN CCLSW,<CAIN C,"!" ;WAS THIS AN IMPERATIVE?\r
- JRST NUNSET ;GET THEE TO A NUNNERY\r
- CAIN C,"@" ;CHEK FOR A NEW RPG FILE\r
- JRST RPGS1>\r
- TLNN FR,CREFSW ;CROSS REF REQUESTED?\r
- JRST LSTSE1 ;YES, SKIP BINARY\r
- CAIN C,"," ;COMMA?\r
- JUMPE ACDEV,LSTSET ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
- CAIN C,"_" ;LEFT ARROW?\r
- JUMPE ACDEV,LSTSE1 ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
- JUMPE ACDEV,M ;IGNORE IF JUST <CR-LF>\r
- TLO FR,PNCHSW ;OK, SET SWITCH\r
- MOVEM ACDEV,BINDEV ;STORE DEVICE NAME\r
- MOVEM ACFILE,BINDIR ;STORE FILE NAME IN DIRECTORY\r
- JUMPN ACEXT,.+2 ;EXTENSION SPECIFIED?\r
- MOVSI ACEXT,(SIXBIT /REL/) ;NO, ASSUME RELOCATABLE BINARY\r
- MOVEM ACEXT,BINDIR+1 ;STORE IN DIRECTORY\r
- MOVEM ACPPN,BINDIR+3 ;SET PPN\r
- OPEN BIN,BININI ;INITIALIZE BINARY\r
- JRST EINIT ;ERROR\r
- TLZE TIO,TIOLE ;SKIP TO EOT\r
- MTAPE BIN,10\r
- TLZE TIO,TIORW ;REWIND REQUESTED?\r
- MTAPE BIN,1 ;YES\r
- JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE\r
- MTAPE BIN,17 ;BACK-SPACE A FILE\r
- AOJL CS,.-1 ;TEST FOR END\r
- WAIT BIN,\r
- STATO BIN,1B24 ;LOAD POINT?\r
- MTAPE BIN,16 ;NO, GO FORWARD ONE\r
-BINSE2: SOJG CS,.-1 ;TEST FORWARD SPACING\r
-\r
- TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?\r
- UTPCLR BIN, ;YES, CLEAR IT\r
- OUTBUF BIN,2 ;SET UP TWO RING BUFFER\r
- CAIN C,"_"\r
- JRST GETSET ;NO LISTING\r
-\fLSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE\r
-LSTSE1: CAIE C,"_"\r
- JRST ERRCM\r
- TLNE FR,CREFSW ;CROSS-REF REQUESTED?\r
- JRST LSTSE2 ;NO, BRANCH\r
- JUMPN ACDEV,.+2 ;YES, WAS DEVICE SPECIFIED?\r
- MOVSI ACDEV,(SIXBIT /DSK/) ;NO, ASSUME DSK\r
- JUMPN ACFILE,.+2\r
- MOVE ACFILE,[SIXBIT /CREF/]\r
- JUMPN ACEXT,.+2\r
-IFE STANSW,<MOVSI ACEXT,(SIXBIT /CRF/) >\r
-IFN STANSW,<MOVSI ACEXT,'LST'>\r
-LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED\r
- MOVE AC0,ACDEV\r
- DEVCHR AC0, ;GET CHARACTERISTICS\r
- TLNE AC0,LPTBIT!DISBIT!TTYBIT\r
- TLNE FR,CREFSW ; WAS CROSS-REF REQUESTED?\r
- AOSA OUTSW+0*TTYSW ;NO, ASSUME TTY\r
- JRST ERRCM ;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY\r
- TLNE AC0,CONBIT ;CONTROLING TELETYPE LISTING?\r
- JRST GETSET ;YES, BUFFER ALREADY SET\r
- MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME\r
- AOS OUTSW+0*LPTSW ;SET FOR LPT\r
- MOVEM ACFILE,LSTDIR ;STORE FILE NAME\r
- JUMPN ACEXT,.+2\r
- MOVSI ACEXT,(SIXBIT /LST/)\r
- MOVEM ACEXT,LSTDIR+1\r
- MOVEM ACPPN,LSTDIR+3 ;SET PPN\r
- OPEN LST,LSTINI ;INITIALIZE LISTING OUTPUT\r
- JRST EINIT ;ERROR\r
- TLZE TIO,TIOLE\r
- MTAPE LST,10\r
- TLZE TIO,TIORW ;REWIND REQUESTED?\r
- MTAPE LST,1 ;YES\r
- JUMPGE CS,LSTSE3\r
- MTAPE LST,17\r
- AOJL CS,.-1\r
- WAIT LST,\r
- STATO LST,1B24\r
- MTAPE LST,16\r
-LSTSE3: SOJG CS,.-1\r
- TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?\r
- UTPCLR LST, ;YES, CLEAR IT\r
- OUTBUF LST,2 ;SET UP A TWO RING BUFFER\r
-\fGETSET: MOVEI 3,PDPERR\r
- HRRM 3,JOBAPR ;SET TRAP LOCATION\r
- MOVEI 3,1B19 ;SET FOR PUSH-DOWN OVERFLOW\r
- APRENB 3,\r
- SOS 3,PDP ;GET PDP REQUEST MINUS 1\r
- IMULI 3,.PDP ;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)\r
- HRLZ MP,3\r
- HRR MP,JOBFF ;SET BASIC POINTER\r
- MOVE PP,MP\r
- SUB PP,3\r
- MOVEM PP,RP ;SET RP\r
- SUB PP,3\r
- ASH 3,1 ;DOUBLE SIZE OF BASIC POINTER\r
- HRL PP,3\r
- SUBM PP,3 ;COMPUTE TOP LOCATION\r
- SKIPN UNITOP ;IF ANY UNIVERSALS HAVE BEEN SEEN\r
- JRST GETSE0 ;NO\r
- HRRZS 3 ;GET TOP OF BUFFERS AND STACKS\r
- CAMLE 3,UNISIZ ;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE\r
- JRST UNIERR ;IT WAS, YOU LOSE\r
- SKIPA 3,UNITOP ;DON'T LOSE THEM\r
-GETSE0: HRRZM 3,UNISIZ ;STORE UNTIL A UNIVERSAL IS SEEN\r
- HRRZM 3,LADR ;SET START OF MACRO TREE\r
- HRRZM 3,FREE\r
-\r
-GETSE1: HRRZ JOBREL\r
- SUBI 1\r
- MOVEM SYMTOP ;SET TOP OF SYMBOL TABLE\r
- SUBI LENGTH ;SET POINTER FOR INITIAL SYMBOLS\r
- CAMLE LADR ;HAVE WE ROOM?\r
- JRST GETSE2 ;YES\r
-\r
- HRRZ 2,JOBREL ;NO, TRY FOR MORE CORE\r
- ADDI 2,2000\r
- CORE 2,\r
- JRST XCEED2 ;NO MORE, INFORM USER\r
- JRST GETSE1 ;TRY AGAIN\r
-\r
-GETSE2: MOVEM SYMBOL ;SET START OF SYMBOL TABLE\r
- HRLI SYMNUM\r
- BLT @SYMTOP ;STORE SYMBOLS\r
- PUSHJ PP,SRCHI ;INITIALIZE TABLE\r
- MOVE [XWD CTIBUF+1,CTLSAV] ;SAVE CONTROL INPUT BUFFER\r
- BLT CTLS1 ;FOR RESCAN ON PASS 2\r
-IFN FTDISK,<MOVSI (SIXBIT /DSK/) ;SET INPUT TO TAKE DSK AS DEV\r
- MOVEM ACDEVX>\r
- PUSHJ PP,COUTI ;INIT OUTPUT JUST IN CASE\r
- PUSHJ PP,INSET ;GET FIRST INPUT FILE\r
-\r
-IFN CCLSW,<TLNE IO,CRPGSW ;BUT ONLY IF DOING RPG\r
- TTCALL 3,[ASCIZ /MACRO: /] ;PUBLISH COMPILER NAME>\r
- MOVE CS,INDIR ;SET UP NAME OF FIRST FILE\r
- MOVEM CS,LSTFIL ;AS LAST PRINTED\r
- SETZM LSTPGN\r
- JRST ASSEMB ;START ASSEMBLY\r
-\fFINIS: CLOSE BIN, ;DUMP BUFFER\r
- TLNE FR,PNCHSW ;PUNCH REQUESTED?\r
- PUSHJ PP,TSTBIN ;YES, TEST FOR ERRORS\r
- RELEAS BIN,\r
- CLOSE LST,\r
- SOSLE OUTSW+0*LPTSW ;LPT TYPE OUTPUT?\r
- PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS\r
- RELEAS LST,\r
- RELEAS CHAR,\r
- OUTPUT CTL,0 ;FLUSH TTY OUTPUT\r
- SKIPE UNIVSN ;SKIP IF NOT ASSEMBLING UNIVERSAL\r
- PUSHJ PP,UNISYM ;STORE SYMBOLS ETC. FIRST\r
- JRST M ;RETURN FOR NEXT ASSEMBLY\r
-\fINSET: MOVEI JOBFFI ;POINTER TO INPUT BUFFER\r
- HRRM JOBFF ;INFORM SYSTEM OF BUFFER AREA\r
- PUSHJ PP,NAME2 ;GET NEXT COMMAND NAME\r
- JUMPE ACDEV,ERRNE ;ERROR IF NONE LEFT\r
- MOVEM ACDEV,INDEV ;STORE DEVICE\r
- MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY\r
- MOVEM ACPPN,INDIR+3 ;STORE PPN BEFORE WE LOSE IT\r
- OPEN CHAR,INDEVI\r
- JRST EINIT ;ERROR\r
- DEVCHR ACDEV, ;TEST CHARACTERISTICS\r
- TLNN ACDEV,MTABIT ;MAG TAPE?\r
- JRST INSET3 ;NO\r
- TLZN FR,MTAPSW ;FIRST MAG TAPE IN PASS 2?\r
- JRST INSET1 ;NO\r
- TLNN TIO,TIORW ;YES, REWIND REQUESTED?\r
- SUB CS,RECCNT ;NO, PREPARE TO BACK-SPACE TAPE\r
-INSET1: AOS RECCNT ;INCREMENT FILE COUNTER\r
- ADDM CS,RECCNT ;UPDATE COUNT\r
- TLZE TIO,TIOLE\r
- MTAPE CHAR,10\r
- TLZE TIO,TIORW ;REWIND?\r
- MTAPE CHAR,1 ;YES\r
- JUMPGE CS,INSET2\r
- MTAPE CHAR,17\r
- MTAPE CHAR,17\r
- AOJL CS,.-1\r
- WAIT CHAR,\r
- STATO CHAR,1B24\r
- MTAPE CHAR,16\r
-INSET2: SOJGE CS,.-1\r
-\r
-INSET3: INBUF CHAR,1\r
- MOVEI ACPNTR,JOBFFI\r
- EXCH ACPNTR,JOBFF\r
- SUBI ACPNTR,JOBFFI\r
- MOVEI ACDEL,NUMBUF*203+1\r
- IDIV ACDEL,ACPNTR\r
- INBUF CHAR,(ACDEL)\r
- JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK\r
- MOVSI ACEXT,(SIXBIT /MAC/) ;BLANK, TRY .MAC FIRST\r
- PUSHJ PP,INSETI\r
-INSET4: PUSHJ PP,INSETI\r
- JUMPE ACEXT,ERRCF ;ERROR IF ZERO\r
- TLNE ACDEV,TTYBIT ;TELETYPE?\r
- SETSTS CHAR,AL ;YES, CHANGE TO ASCII LINE\r
-\f ;DO ALL ENTERS HERE FOR LEVEL D\r
- SKIPE ENTERS ;HAVE ENTERS BEEN DONE ALREADY?\r
- JRST ENTRDN ;YES, DON'T DO TWICE\r
- SKIPN ACEXT,LSTDEV ;IS THERE A LIST DEVICE?\r
- JRST LSTSE5 ;NO SO DON'T DO ENTER\r
- SKIPN ACFILE,LSTDIR ;GET FILE NAME INCASE OF ERROR\r
- JRST [DEVCHR ACEXT, \r
- TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY?\r
- JRST LSTSE4 ;YES, GIVE UP BEFORE HARM IS DONE\r
- SKIPE ACFILE,INDIR ;USE INPUT FILE NAME\r
- MOVEM ACFILE,LSTDIR ;TOO BAD IF ZERO ALSO\r
- JRST LSTSE4]\r
- HLLZ ACEXT,LSTDIR+1 ;EXT ALSO\r
- MOVE ACPPN,LSTDIR+3 ;SAVE PPN\r
- LOOKUP LST,LSTDIR ;PREVIOUS ONE STILL THERE\r
- JRST LSTSE4 ;NO\r
- SETZM LSTDIR ;YES,CLEAR NAME\r
- MOVEM ACPPN,LSTDIR+3 ;RESET PPN\r
- RENAME LST,LSTDIR\r
- CLOSE LST, ;IGNORE FAILURE\r
- MOVEM ACFILE,LSTDIR ;RESTORE NAME\r
- HLLZS LSTDIR+1 ;BH 11/19/74 FOR DATE75. CLEAR RH.\r
- SETZM LSTDIR+2 ;CLEAR PROTECTION AND DATE\r
- MOVEM ACPPN,LSTDIR+3 ;SET PPN AGAIN\r
-LSTSE4: \r
-IFN STANSW,<\r
- MOVSI ACEXT,400000\r
- MOVEM ACEXT,LSTDIR+2 ;SET DUMP NEVER BIT.\r
->\r
- ENTER LST,LSTDIR ;SET UP DIRECTORY\r
- JRST ERRCL ;ERROR\r
-LSTSE5: SKIPN ACEXT,BINDEV ;A BINARY DEVICE THEN ?\r
- JRST ENTRDN ;NO\r
- SKIPN ACFILE,BINDIR ;INCASE OF ERROR\r
- JRST [DEVCHR ACEXT, \r
- TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY?\r
- JRST .+1 ;YES, GIVE UP BEFORE HARM IS DONE\r
- SKIPE ACFILE,INDIR ;USE INPUT FILE NAME\r
- MOVEM ACFILE,BINDIR ;TOO BAD IF ZERO ALSO\r
- JRST .+1]\r
-IFN STANSW,<\r
- MOVSI ACEXT,400000\r
- MOVEM ACEXT,BINDIR+2\r
->\r
- HLLZS ACEXT,BINDIR+1 ;BH 11/19/74 DATE75. WAS HLLZ.\r
- ENTER BIN,BINDIR ;ENTER FILE NAME\r
- JRST ERRCB ;ERROR\r
-\r
-ENTRDN: SETOM ENTERS ;MAKE SURE ONLY DONE ONCE\r
- MOVE CS,[POINT 7,DEVBUF]\r
- PUSH PP,1 ;SAVE THE ACCS\r
- PUSH PP,2\r
- PUSH PP,3\r
- SKIPN 2,INDIR ;GET INPUT NAME\r
- JRST FINDEV ;FINISHED WITH DEVICE\r
- SETZ 1, ;CLEAR FOR RECEIVING\r
- LSHC 1,6 ;SHIFT ONE CHAR. IN\r
- ADDI 1,40 ;FORM ASCII\r
- IDPB 1,CS ;STORE CHAR.\r
- JUMPN 2,.-4 ;MORE TO DO?\r
- MOVEI 1," " ;SEPARATE BY TAB\r
- IDPB 1,CS\r
- HLLZ 2,INDIR+1 ;GET EXT\r
- JUMPE 2,FINEXT ;NO EXT\r
- SETZ 1,\r
- LSHC 1,6 ;SAME LOOP AS ABOVE\r
- ADDI 1,40\r
- IDPB 1,CS\r
- JUMPN 2,.-4\r
-FINEXT: MOVEI 1," "\r
- IDPB 1,CS ;SEPARATE BY TAB\r
- LDB 1,[POINT 12,INDIR+2,35] ;GET DATE\r
- LDB 2,[POINT 3,INDIR+1,20] ;BH 11/19/74 DATE75.\r
- DPB 2,[POINT 3,1,23] ;BH 11/19/74 DATE75.\r
- JUMPE 1,FINDEV ;NO DATE?\r
- PUSHJ PP,DATOUT ;STORE IT\r
- LDB 2,[POINT 11,INDIR+2,23] ;GET CREATION TIME\r
- JUMPE 2,FINDEV ;NO TIME (DECTAPE)\r
- MOVEI 1," " ;SEPARATE BY SPACE\r
- IDPB 1,CS\r
- PUSHJ PP,TIMOU1 ;STORE TIME\r
-FINDEV: SETZ 1,\r
- MOVEI 2," " ;FINAL TAB\r
- IDPB 2,CS\r
- IDPB 1,CS ;TERMINATE FOR NOW\r
- POP PP,3 ;RESTORE ACCS\r
- POP PP,2\r
- POP PP,1\r
- SKIPN PAGENO ;IF FIRST TIME THRU\r
- JRST OUTFF ;START NEW PAGE\r
- SETZM PAGENO ;ON NEW FILE, RESET PAGES\r
- JRST OUTFF2 ;DON'T START NEW PAGE UNLESS FF\r
-\r
-INSETI: HLLZM ACEXT,INDIR+1 ;STORE EXTENSION\r
- MOVE ACPPN,INDIR+3 ;SAVE PPN\r
- LOOKUP CHAR,INDIR\r
- SKIPA ACEXT,INDIR+1 ;GET ERROR CODE\r
- JRST CPOPJ1 ;SKIP-RETURN IF FOUND\r
- TRNE ACEXT,-1 ;ERROR CODE OF 0 IS FILE NOT FOUND\r
- JRST ERRCF ;FILE THERE BUT NOT READABLE\r
- SETZ ACEXT, ;CLEAR EXT AND TRY AGAIN\r
- MOVEM ACPPN,INDIR+3 ;RESTORE PPN\r
- POPJ PP,\r
-\fREC2: MOVS [XWD CTIBUF+1,CTLSAV] ;RESCAN CONTROL (FROM PASS1 END STMNT)\r
- BLT CTIBUF+2 ;INPUT BUFFER\r
- MOVEI "_"\r
- HRLM ACDELX ;FUDGE PREVIOUS DELIMITER\r
-IFN RENTSW,<MOVE HHIGH ;GET HI-SEG BREAK\r
- MOVEM HIGH1 ;SAVE THE ONE WE GOT ON PASS1 (FOR HISEG)>\r
- SETZM PASS2I\r
- MOVE [XWD PASS2I,PASS2I+1]\r
- BLT PASS2X-1 ;ZERO PASS2 VARIABLES\r
- TLO FR,MTAPSW!LOADSW ;SET FLAGS \r
-\r
-GOTEND: MOVE INDEV ;GET LAST DEVICE\r
- DEVCHR ;GET ITS CHARACTERISTICS\r
- TLNE 4 ;TEST FOR DIRECTORY (DSK OR DTA)\r
- JRST EOT ;YES, SO DON'T WASTE TIME\r
- JRST .+3 ;NO, INPUT BUFFER BY BUFFER\r
- IN CHAR,\r
- JRST .-1 ;NO ERRORS\r
- STATO CHAR,1B22 ;TEST FOR EOF\r
- JRST .-3 ;IGNORE ERRORS\r
-\r
-EOT: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
- PUSHJ PP,INSET ;GET THE NEXT INPUT DEVICE\r
- HRROI RC,[SIXBIT /END OF PASS 1@/] ;ASSUME END OF PASS\r
- TLZN FR,LOADSW ;ZERO ONLY ON END OF PASS 1\r
- HRROI RC,[SIXBIT /LOAD THE NEXT FILE@/] ;NOT END OF PASS\r
- TLNN ACDEV,(1B13!1B15) ;WAS ALL THAT WORK NECESSARY?\r
- PUSHJ PP,TYPMSG ;YES\r
-\r
-RSTRXS: MOVSI RC,SAVBLK ;SET POINTER\r
- BLT RC,RC-1 ;RESTORE REGISTERS\r
- MOVE RC,SAVERC ;RESTORE RC\r
- POPJ PP, ;EXIT\r
-\r
-SAVEXS: MOVEM RC,SAVERC ;SAVE RC\r
- MOVEI RC,SAVBLK ;SET POINTER\r
- BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW RC\r
- POPJ PP, ;EXIT\r
-\fNAME1: SETZM ACDEVX ;ENTRY FOR DESTINATION\r
-NAME2: SETZB ACDEV,INDIR+2 ;ENTRY FOR SOURCE\r
- MOVEI ACFILE,0 ;CLEAR FILE\r
- HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER\r
- SETZB TIO,CS\r
- SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR\r
- SETZM PPN ;CLEAR PPN\r
-NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER\r
- TDZA AC0,AC0 ;CLEAR SYMBOL\r
-\r
-SLASH: PUSHJ PP,SW0\r
-GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER\r
- CAIN C,"/"\r
- JRST SLASH\r
- CAIN C,"("\r
- JRST SWITCH\r
- CAIN C,":"\r
- JRST DEVICE\r
- CAIN C,"."\r
- JRST NAME\r
-IFN CCLSW,<CAIE C,"!" ;IS CHAR AN IMPERATIVE?\r
- CAIN C,"@"\r
- JRST TERM ;YES, GO DO IT>\r
- CAIE C,33 ;CHECK FOR THREE FLAVORS OF ALT-MODE\r
- CAIN C,176 ;...\r
- JRST TERM ;...\r
- CAIG C,CR ;LESS THAN CR?\r
- CAIGE C,LF ;AND GREATER THAN LF?\r
- CAIN C,175 ;OR 3RD ALTMOD\r
- JRST TERM ;YES\r
-IFN FTDISK,<CAIN C,"["\r
- JRST PROGNP ;GET PROGRAMER NUMBER PAIR>\r
- CAIN C,"=" ;EQUALS IS SAME AS LEFT ARROW\r
- TRCA C,142 ;SO MAKE IT A "_" AND SKIP\r
- CAIE C,","\r
- CAIN C,"_"\r
- JRST TERM\r
- CAIGE C,40 ;VALID AS SIXBIT?\r
- JRST [CAIN C,"Z"-100 ;NO,IS IT ^Z\r
- EXIT ;YES,EXIT FOR BATCH\r
- JRST GETIOC] ;JUST IGNORE\r
- SUBI C,40 ;CONVERT TO 6-BIT\r
- TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?\r
- IDPB C,ACPNTR ;NO, STORE IT\r
- JRST GETIOC ;GET NEXT CHARACTER\r
-\r
-DEVICE: JUMPN ACDEV,ERRCM ;ERROR IF ALREADY SET\r
- MOVE ACDEV,AC0 ;DEVICE NAME\r
- JRST DEVNAM ;COMMON CODE\r
-\r
-NAME: JUMPN ACFILE,ERRCM ;ERROR IF ALREADY SET\r
- MOVE ACFILE,AC0 ;FILE NAME\r
-DEVNAM: MOVE ACDEL,C ;SET DELIMITER\r
- JRST NAME3 ;GET NEXT SYMBOL\r
-\r
-TERM: JUMPE ACDEL,TERM1 ;IF NO PREVIOUS TERMINATOR, THEN FILENAME\r
- CAIN ACDEL,"_" ;...\r
- JRST TERM1 ;...\r
- CAIE ACDEL,":" ;IF PREVIOUS DELIMITER\r
- CAIN ACDEL,"," ;WAS COLON OR COMMA\r
-TERM1: MOVE ACFILE,AC0 ;SET FILE\r
- CAIN ACDEL,"." ;IF PERIOD,\r
- HLLZ ACEXT,AC0 ;SET EXTENSION\r
- HRLM C,ACDELX ;SAVE PREVIOUS DELIMITER\r
- JUMPN ACDEV,.+2 ;IF DEVICE SET USE IT\r
- SKIPA ACDEV,ACDEVX ;OTHERWISE USE LAST DEVICE\r
- MOVEM ACDEV,ACDEVX ;AND DEVICE\r
- MOVE ACPPN,PPN ;PUT PPN IN RIGHT PLACE\r
-IFN FTDISK,<CAIN C,"!" ;IMPERATIVE?\r
- POPJ PP, ;YES, DON'T ASSUME DEV\r
- JUMPE ACFILE,CPOPJ ;IF THERE IS A FILE,\r
- JUMPN ACDEV,.+2 ;BUT NO DEVICE\r
- MOVSI ACDEV,(SIXBIT /DSK/) ;THEN ASSUME DISK>\r
- POPJ PP, ;EXIT\r
-\fERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/]\r
- JRST ERRFIN\r
-\r
-IFN FTDISK,<PROGNP:\r
-PROGN1: HRLZM RC,PPN ;COMMA, STORE LEFT HALF\r
-PROGN2: MOVEI RC,0 ;CLEAR AC\r
-PROGN3: PUSHJ PP,TTYIN\r
- CAIN C,","\r
- JRST PROGN1 ;STORE LEFT HALF\r
- HRRM RC,PPN ;ASSUME TERMINAL\r
- CAIN C,"]"\r
- JRST GETIOC ;YES, RETURN TO MAIN SCAN\r
-IFE STANSW,<\r
- CAIL C,"0" ;CHECK FOR VALID NUMBERS\r
- CAILE C,"7"\r
- JRST ERRCM ;NOT VALID\r
- LSH RC,3 ;SHIFT PREVIOUS RESULT\r
- ADDI RC,-"0"(C) ;ADD IN NEW NUMBER>\r
-IFN STANSW,<LSH RC,6 ;SHIFT PREVIOUS RESULT\r
- ADDI RC,-40(C) ;PUT IN NEW CHARACTER>\r
- JRST PROGN3 ;GET NEXT CHARACTER>\r
-\fSWITC0: PUSHJ PP,SW1 ;PROCESS CHARACTER\r
-SWITCH: PUSHJ PP,TTYIN ;GET NEXT CHARACTER\r
- CAIE C,")" ;END OF STRING?\r
- JRST SWITC0 ;NO\r
- JRST GETIOC ;YES\r
-\r
-SW0: PUSHJ PP,TTYIN\r
-SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC\r
- CAILE C,"Z"-"A" ;WITHIN BOUNDS? (IS IT ALPHA?)\r
- JRST ERRCM ;NO, ERROR\r
- MOVE RC,[POINT 4,BYTAB]\r
- IBP RC\r
- SOJGE C,.-1 ;MOVE TO PROPER BYTE\r
- LDB C,RC ;PICK UP BYTE\r
- JUMPE C,ERRCM ;TEST FOR VALID SWITCH\r
- CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE?\r
- JUMPL PP,ERRCM ;NO, TEST FOR SOURCE\r
- LDB RC,[POINT 4,SWTAB-1(C),12]\r
- CAIN RC,IO\r
- SKIPN CTLSAV ;IF PASS2 OR IO SWITCH,\r
- XCT SWTAB-1(C) ;EXECUTE INSTRUCTION\r
- POPJ PP, ;EXIT\r
- TLZ IO,IOSALL ;TAKE CARE OF /X\r
- POPJ PP,\r
-\r
-DEFINE HELP (TEXT)<\r
- XLIST\r
- ASCIZ ?TEXT?\r
- LIST>\r
-\r
-HLPMES: HELP <\r
-Switches are :-\r
-/A advance one file\r
-/B backspace one file\r
-/C produce a cref listing\r
-/E list macro expansions (LALL)\r
-/F list in new format (.MFRMT)\r
-/G list in old format (.HWFRMT)\r
-/H type this text\r
-/L reinstate listing (LIST)\r
-/M suppress ascii in macro and repeat expansion (SALL)\r
-/N suppress error printout on tty\r
-/O set MLOFF pseudo-op\r
-/P increase size of the pushdown stack\r
-/Q suppress Q errors on the listing\r
-/S suppress listing (XLIST)\r
-/T rewind device\r
-/X suppress all macro expansions (XALL)\r
-/Z zero the directory\r
-Switches A,B,C,T,W,X, and Z must immediately follow\r
-the device or file to which they refer.\r
->\r
-\f DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION\r
-J= <"LETTER"-"A">-^D9*<I=<"LETTER"-"A">/^D9>\r
- SETCOD \I,J>\r
-\r
- DEFINE SETCOD (I,J)\r
- <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
-\r
-BYTAB0= 0 ;INITIALIZE TABLE\r
-BYTAB1= 0\r
-BYTAB2= 0\r
-\r
-SWTAB:\r
- SETSW Z,<TLO TIO,TIOCLD >\r
- SETSW C,<TLZ FR,CREFSW >\r
- SETSW P,<SOS PDP >\r
-SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY\r
- SETSW A,<ADDI CS,1 >\r
- SETSW B,<SUBI CS,1 >\r
- SETSW E,<TLZ IO,IOPALL!IOSALL >\r
-IFN FORMSW,< SETSW F,<SETZM HWFMT>\r
- SETSW G,<SETOM HWFMT>>\r
- SETSW H,<OUTSTR HLPMES>\r
- SETSW L,<TLZ IO,IOMSTR >\r
- SETSW M,<TLO IO,IOPALL!IOSALL >\r
- SETSW N,<HLLOS TYPERR >\r
- SETSW O,<XCT OFFML >\r
- SETSW Q,<TLO FR,ERRQSW >\r
- SETSW S,<TLO IO,IOMSTR >\r
- SETSW T,<TLO TIO,TIOLE >\r
- SETSW W,<TLO TIO,TIORW >\r
- SETSW X,<TLOA IO,IOPALL >\r
-\r
-BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB\r
- ;IT CONSIST OF 9 4BIT BYTES/WORD\r
- ;OR ONE BYTE FOR EACH LETTER\r
-\r
- +BYTAB0 ;A-I BYTE = 1 THROUGH 17 = INDEX\r
- +BYTAB1 ;J-R BYTE = 0 = COMMAND ERROR\r
- +BYTAB2 ;S-Z\r
-\r
-IF2,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2>\r
-\fTTYIN: SOSGE CTIBUF+2 ;ENUF CHAR.?\r
- JRST TTYERR ;NO\r
- ILDB C,CTIBUF+1 ;GET CHARACTER\r
- CAIE C," " ;SKIP BLANKS\r
- CAIN C,HT ;AND TABS\r
- JRST TTYIN\r
- CAIN C,15 ;CR?\r
- SETZM CTIBUF+2 ;YES,IGNORE REST OF LINE\r
- CAIG C,"Z"+40 ;CHECK FOR LOWER CASE\r
- CAIGE C,"A"+40\r
- POPJ PP, ;NO,EXIT\r
- SUBI C,40\r
- POPJ PP, ;YES, EXIT\r
-\r
-TTYERR: SKIPN INDEV ;INPUT DEVICE SEEN?\r
- JRST ERRCM ;NO, SO MISSING "_"\r
-ERRNE: HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]\r
-ERRNE0: SKPINC V ;SEE IF WE CAN INPUT A CHAR.\r
- JFCL ;BUT ONLY TO DEFEAT ^O\r
- PUSHJ PP,TYPMSG ;OUTPUT IT\r
- SKIPE LITLVL ;SEE IF IN LITERAL\r
- SKIPN LITPG ;PAGE 0 MEANS NOT IN A LITERAL REALY\r
- JRST ERRNE1 ;NO, TRY OTHERS\r
- MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG]\r
- PUSHJ PP,PRNUM ;GO PRINT INFORMATION\r
-ERRNE1: MOVEI V,0 ;CHECK FOR OTHER PLACES\r
- SKIPE INDEF\r
- MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]\r
- SKIPE INTXT\r
- MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG]\r
- SKIPE INREP\r
- MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]\r
- SKIPE INCND\r
- MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]\r
- SKIPGE MACENL\r
-ERRNE2: MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]\r
- JUMPN V,ERRNE3\r
- SKIPN LITLVL ;HAD ONE PAGE NUMBER ALREADY\r
- SKIPA V,[XWD [SIXBIT /@/],PAGENO] ;BETTER THAN NOTHING\r
- JRST .+2\r
-ERRNE3: PUSHJ PP,PRNUM\r
- HRROI RC,[SIXBIT /@/] ;WILL GET A RETURN\r
- JRST ERRFIN\r
-\r
-ERRMS1: SIXBIT / ERRORS DETECTED@/\r
-ERRMS2: SIXBIT /?1 ERROR DETECTED@/\r
-ERRMS3: SIXBIT /NO ERRORS DETECTED@/\r
-EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]\r
- JRST ERRFIN\r
-\fERRCL: HRRZ RC,LSTDIR+1 ;GET LST DEV ERROR CODE\r
- JRST .+2 ;GET ERROR MESSAGE\r
-ERRCB: HRRZ RC,BINDIR+1 ;GET BIN DEV ERROR CODE\r
- JUMPN RC,ERRTYP\r
- SOJA RC,ERRTYP ;SPECIAL CASE IF ERROR CODE 0\r
-\r
-ERRCF: HRRZ RC,INDIR+1 ;GET INPUT DEV ERROR CODE\r
- HLLZ ACEXT,INDIR+1 ;SET UP EXT\r
-\r
-ERRTYP: CAIL RC,TABLND-TABLE ;IS ERROR CODE LEGAL?\r
- SKIPA RC,TABLND ;NO, GIVE CATCH ALL MESSAGE\r
- MOVE RC,TABLE(RC) ;YES, PICK UP MESSAGE\r
-\r
-ERRFIN: SKPINC C ;SEE IN WE CAN INPUT A CHAR.\r
- JFCL ;BUT ONLY TO DEFEAT ^O\r
- PUSHJ PP,CRLF\r
- MOVEI C,"?"\r
- PUSHJ PP,TYO\r
- PUSHJ PP,TYPMS1\r
- CLOSE LST, ;GIVE USER A PARTIAL LISTING\r
- CLOSE BIN,40 ;BUT NEVER A BUM REL FILE\r
-IFN CCLSW,<AOS JOBERR ;RECORD ERROR SO EXECUTION DELETED>\r
- JRST M\r
-\r
- [SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE\r
-TABLE: [SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE\r
- [SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE\r
- [SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE\r
- [SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE\r
- [SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE\r
- [SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE\r
- [SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE\r
- [SIXBIT /(7) NOT A SAV FILE@/],,ACFILE\r
- [SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE\r
- [SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE\r
- [SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE\r
- [SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE\r
- [SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE\r
- [SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE\r
- [SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE\r
- [SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE\r
- [SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE\r
- [SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE\r
- [SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE\r
- [SIXBIT /(23) SFD NOT FOUND@/],,ACFILE\r
- [SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE\r
- [SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE\r
- [SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE\r
-\r
-TABLND: [SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE\r
-\fTYPMSG: PUSHJ PP,CRLF ;MOVE TO NEXT LINE\r
-TYPMS1: HLRZ CS,RC ;GET FIRST MESSAGE\r
- CAIE CS,-1 ;SKIP IF MINUS ONE\r
- PUSHJ PP,TYPM2 ;TYPE MESSAGE\r
- HRRZ CS,RC ;GET SECOND HALF\r
- PUSHJ PP,TYPM2\r
-\r
-CRLF: MOVEI C,CR ;OUTPUT CARRIAGE RETURN\r
- PUSHJ PP,TYO\r
- MOVEI C,LF ;AND LINE FEED\r
-\r
-TYO: SOSG CTOBUF+2 ;BUFFER FULL?\r
- OUTPUT CTL,0 ;YES, DUMP IT\r
- IDPB C,CTOBUF+1 ;STORE BYTE\r
- CAIG C,FF ;FORM FEED?\r
- CAIGE C,LF ;V TAB OR LINE FEED?\r
- POPJ PP, ;NO\r
- OUTPUT CTL,0 ;YES\r
- POPJ PP, ;AND EXIT\r
-\r
-TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD\r
- CAIN CS,ACFILE ;FILE NAME ?\r
- JRST [JUMPE ACEXT,.+1 ;YES, TEST FOR EXT\r
- LSH ACEXT,-6 ;MAKE SPACE FOR "."\r
- IOR ACEXT,[SIXBIT /. @/]\r
- JRST TYPM2A]\r
- CAIG CS,17 ;IS IT?\r
- MOVEM C,1(CS)\r
-TYPM2A: HRLI CS,(POINT 6,,) ;FORM BYTE POINTER\r
-\r
-TYPM3: ILDB C,CS ;GET A SIXBIT BYTE\r
- CAIN C,40 ;"@"?\r
- JRST TYO ;YES, TYPE SPACE AND EXIT\r
- ADDI C,40 ;NO, FORM 7-BIT ASCII\r
- PUSHJ PP,TYO ;OUTPUT CHARACTER\r
- JRST TYPM3\r
-\r
-\fXCEEDS: ADDI SX,2000 ;ADJUST SYMBOL POINTER\r
-XCEED: PUSHJ PP,SAVEXS ;SAVE THE REGISTERS\r
- HRRZ 1,JOBREL ;GET CURRENT TOP\r
- MOVEI 0,2000(1)\r
- CORE 0, ;REQUEST MORE CORE\r
- JRST XCEED2 ;ERROR, BOMB OUT\r
- HRRZ 2,JOBREL ;GET NEW TOP\r
-\r
-XCEED1: MOVE 0,0(1) ;GET ORIGIONAL\r
- MOVEM 0,0(2) ;STORE IN NEW LOCATION\r
- SUBI 2,1 ;DECREMENT UPPER\r
- CAMLE 1,SYMBOL ;HAVE WE ARRIVED?\r
- SOJA 1,XCEED1 ;NO, GET ANOTHER\r
- MOVEI 1,2000\r
- ADDM 1,SYMBOL\r
- ADDM 1,SYMTOP\r
- PUSHJ PP,SRCHI ;RE-INITIALIZE SYMBOL TABLE\r
- JRST RSTRXS ;RESTORE REGISTERS AND EXIT\r
-\r
-XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/]\r
- JRST ERRNE0\r
-PDPERR: HRROI RC,[SIXBIT .PDP OVERFLOW, TRY /P@.]\r
- JRST ERRNE0\r
-\r
-PRNUM: HLRZ CS,V ;GET MESSAGE\r
- PUSHJ PP,TYPM2\r
- MOVEI CS,[SIXBIT /ON PAGE@/]\r
- PUSHJ PP,TYPM2\r
- MOVE AC0,(V) ;GET PAGE\r
- PUSHJ PP,DP1 ;PRINT NUMBER\r
- MOVEI C,40\r
- PUSHJ PP,TYO\r
- SKIPN AC1,1(V) ;GET SEQ NUM IF THERE\r
- POPJ PP, ;NO, RETURN\r
- MOVEM AC1,OUTSQ\r
- MOVEI CS,[SIXBIT /LINE@/]\r
- PUSHJ PP,TYPM2\r
- MOVEI AC0,OUTSQ ;PRINT IT\r
- OUTPUT CTL,0 ;TO MAKE THINGS PRINT IN RIGHT ORDER\r
- DDTOUT AC0,\r
- MOVEI C,40\r
- JRST TYO ;AND RETURN\r
-\r
-DP1: IDIVI AC0,^D10\r
- HRLM AC1,(PP)\r
- JUMPE AC0,.+2\r
- PUSHJ PP,DP1\r
- HLRZ C,(PP)\r
- ADDI C,"0"\r
- JRST TYO\r
-\fRIM0: TDO FR,AC0 ;SET RIM/RIM10 FLAG\r
- TLNE FR,PNCHSW ;FORGET IT IF PUNCH RESET\r
- SETSTS BIN,IB ;SET TO IMAGE BINARY MODE\r
- POPJ PP,\r
-\r
-ROUT: EXCH CS,RIMLOC\r
- SUB PP,[XWD 1,1] ;CLEAR OUT STACK WFW\r
- TLNE FR,R1BSW\r
- JRST ROUT6\r
- TLNN FR,RIM1SW\r
- JRST ROUT1\r
- JUMPE CS,ROUT1 ;RIM10 OUTPUT\r
- SUB CS,RIMLOC\r
- JUMPE CS,ROUT1\r
- JUMPG CS,ERRAX\r
- MOVEI C,0\r
- PUSHJ PP,PTPBIN\r
- AOJL CS,.-1\r
-ROUT1: MOVSI C,(DATAI PTR,) ;RIM OUTPUT\r
- HRR C,LOCO ;GET ADDRESS\r
- TLNE FR,RIM1SW ;NO DATAI IF RIM10\r
- AOSA RIMLOC\r
- PUSHJ PP,PTPBIN ;OUTPUT\r
- MOVE C,AC0 ;CODE\r
- AOSA LOCO ;INCREMENT CURRENT LOCATION\r
-\r
-OUTBIN: TLNN FR,RIMSW!RIM1SW!R1BSW ;EXIT IF RIM MODE\r
-PTPBIN: TLNN FR,PNCHSW ;EXIT IF PUNCH NOT REQUESTED\r
- POPJ PP,\r
- SOSG BINBUF+2 ;TEST FOR BUFFER FULL\r
- PUSHJ PP,DMPBIN ;YES, DUMP IT\r
- IDPB C,BINBUF+1 ;DEPOSIT BYTE\r
- POPJ PP, ;EXIT\r
-\r
-\fDMPBIN: OUT BIN,0 ;DUMP THE BUFFER\r
- POPJ PP, ;NO ERRORS\r
-TSTBIN: GETSTS BIN,C ;GET STSTUS BITS\r
- TRNN C,ERRBIT ;ERROR?\r
- POPJ PP, ;NO, EXIT\r
- MOVE AC0,BINDEV ;YES, GET TAG\r
- JRST ERRLST ;TYPE MESSAGE AND ABORT\r
-\r
-DMPLST: OUT LST,0 ;OUTPUT BUFFER\r
- POPJ PP, ;NO ERRORS\r
-TSTLST: GETSTS LST,C ;ANY ERRORS?\r
- TRNN C,ERRBIT\r
- POPJ PP, ;NO, EXIT\r
- MOVE AC0,LSTDEV\r
-ERRLST: MOVSI RC,[SIXBIT /OUTPUT WRITE-LOCK ERROR DEVICE@/]\r
- TRNE C,IOIMPM ;IMPROPER MODE?\r
- JRST ERRFIN ;YES\r
- MOVSI RC,[SIXBIT /OUTPUT DATA ERROR DEVICE@/]\r
- TRNE C,IODERR ;DEVICE DATA ERROR?\r
- JRST ERRFIN ;YES\r
- MOVSI RC,[SIXBIT /OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/]\r
- TRNE C,IODTER ;IS IT\r
- JRST ERRFIN ;YES\r
- MOVE CS,AC0 ;GET DEVICE\r
- DEVCHR CS, ;FIND OUT WHAT IT IS\r
- MOVSI RC,[SIXBIT /OUTPUT QUOTA EXCEEDED ON DEVICE@/]\r
- TLNN CS,DSKBIT ;SKIP IF DSK OUTPUT\r
- MOVSI RC,[SIXBIT /OUTPUT BLOCK TOO LARGE DEVICE@/]\r
- JRST ERRFIN\r
-\f \r
-R1BDMP: SETCM CS,R1BCNT\r
- JUMPE CS,R1BI\r
- HRLZS C,CS\r
- HRR C,R1BLOC\r
- HRRI C,-1(C)\r
- MOVEM C,R1BCHK\r
- PUSHJ PP,PTPBIN\r
- HRRI CS,R1BBLK\r
-R1BDM1: MOVE C,0(CS)\r
- ADDM C,R1BCHK\r
- PUSHJ PP,PTPBIN\r
- AOBJN CS,R1BDM1\r
- MOVE C,R1BCHK\r
- PUSHJ PP,PTPBIN\r
-R1BI: SETOM R1BCNT\r
- PUSH PP,LOCO\r
- POP PP,R1BLOC\r
- POPJ PP,\r
-\r
-ROUT6: CAME CS,RIMLOC\r
- PUSHJ PP,R1BDMP\r
- AOS C,R1BCNT\r
- MOVEM AC0,R1BBLK(C)\r
- AOS LOCO\r
- CAIN C,.R1B-1\r
- PUSHJ PP,R1BDMP\r
- AOS RIMLOC\r
- POPJ PP,\r
- \r
-\r
-\fREAD0: PUSHJ PP,EOT ;END OF TAPE\r
-\r
-READ: SOSGE IBUF+2 ;BUFFER EMPTY?\r
- JRST READ3 ;YES\r
-READ1: ILDB C,IBUF+1 ;PLACE CHARACTER IN C\r
- MOVE CS,@IBUF+1 ;CHECK FOR SEQUENCE NUMBER\r
- TRNN CS,1\r
- JRST READ1A\r
- CAIN CS,1 ;CHECK FOR SPECIAL\r
- MOVE CS,[<ASCII/ />+1]\r
- MOVEM CS,SEQNO\r
- MOVEM CS,SEQNO2\r
- MOVNI CS,4\r
- ADDM CS,IBUF+2 ;ADJUST WORD COUNT\r
-REPEAT 4,< IBP IBUF+1> ;SKIP SEQ NO\r
- PUSHJ PP,READ ;AND THE TAB\r
- JRST READ ;GET NEXT CHARACTER\r
-\r
-READ1A: JUMPE C,READ ;IGNORE NULL\r
- CAIN C,32 ;IF IT'S A "^Z"\r
- MOVEI C,LF ;TREAT IT AS A "LF"\r
- CAIE C,37 ;CONTROL _\r
- POPJ PP,\r
- MOVEI C,"^" ;MAKE CONTROL-SHIFT _ VISIBLE\r
- PUSHJ PP,RSW2\r
- MOVEI C,"_"\r
- PUSHJ PP,RSW2\r
-READ2: PUSHJ PP,READ ;YES, TEST FOR LINE FEED\r
- PUSHJ PP,RSW2 ;LIST IN ANY EVENT\r
- CAIG C,FF ;IS IT ONE OF\r
- CAIGE C,LF ;LF, VT, OR FF?\r
- JRST READ2 ;NO\r
- PUSHJ PP,OUTIM1 ;YES, DUMP THE LINE\r
- JRST READ ;RETURN NEXT CHARACTER\r
-\r
-READ3: IN CHAR,0 ;GET NEXT BUFFER\r
- JRST READ ;NO ERRORS\r
- GETSTS CHAR,C\r
- TRNN C,ERRBIT!2000 ;ERRORS?\r
- JRST READ0 ;EOF\r
- MOVE AC0,INDEV\r
- MOVSI RC,[SIXBIT/ INPUT PHYSICAL END OF TAPE DEVICE@/]\r
- TRNE C,2000\r
- JRST ERRFIN ;E-O-T\r
- MOVSI RC,[SIXBIT /MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/]\r
- TRNE C,IOIMPM ;IMPROPER MODE?\r
- JRST ERRFIN ;YES\r
- MOVSI RC,[SIXBIT /INPUT DATA ERROR DEVICE@/]\r
- TRNE C,IODERR ;DEVICE DATA ERROR?\r
- JRST ERRFIN ;YES\r
- MOVSI RC,[SIXBIT /INPUT CHECKSUM OR PARITY ERROR DEVICE@/]\r
- TRNN C,IODTER\r
- MOVSI RC,[SIXBIT /INPUT BLOCK TOO LARGE DEVICE@/]\r
- JRST ERRFIN\r
-\r
-\fOUTAB2: PUSHJ PP,OUTTAB ;PRINT TWO TABS\r
-OUTTAB: MOVEI C,HT\r
-PRINT: CAIE C,CR ;IS THIS A CR?\r
- CAIN C,LF ;OR LF?\r
- JRST OUTCR ;YES, GO PROCESS\r
- CAIN C,FF ;FORM FEED?\r
- JRST OUTFF ;YES, FORCE NEW PAGE\r
- JRST OUTL\r
-\r
-OUTCR: TRNN ER,ERRORS!LPTSW!TTYSW\r
- POPJ PP,\r
- MOVEI C,CR ;CARRIAGE RETURN, LINE FEED\r
- PUSHJ PP,OUTL\r
- SOSGE LPP ;END OF PAGE?\r
- TLO IO,IOPAGE ;YES, SET FLAG\r
- TRCA C,7 ;FORM LINE FEED AND SKIP\r
-\r
-OUTL: TLZN IO,IOPAGE ;NEW PAGE REQUESTED?\r
- JRST OUTC ;NO\r
- JUMP1 OUTC ;YES, BYPASS IF PASS ONE\r
- PUSH PP,C ;SAVE C AND CS\r
- PUSH PP,CS\r
- PUSH PP,ER\r
- TLNN IO,IOMSTR!IOPROG\r
- HRR ER,OUTSW\r
- TLNE IO,IOCREF ;IF DOING CREF OUTPUT NOW\r
- TLNE FR,CREFSW ;AND CREFFING (JUST IN CASE)\r
- JRST .+2\r
- PUSHJ PP,CLSC3 ;CLOSE IT OUT\r
- HLLM IO,(PP) ;SAVE THIS NEW STATE OF IO\r
- MOVEI C,.LPP\r
- MOVEM C,LPP ;SET NEW COUNTER\r
- MOVEI C,CR\r
- PUSHJ PP,OUTC\r
- MOVEI C,FF\r
- PUSHJ PP,OUTC ;OUTPUT FORM FEED\r
- MOVEI CS,TBUF\r
- PUSHJ PP,OUTAS0 ;OUTPUT TITLE\r
- MOVEI CS,VBUF\r
- PUSHJ PP,OUTAS0 ;OUTPUT VERSION\r
- MOVEI CS,DBUF\r
- PUSHJ PP,OUTAS0 ; AND DATE\r
- MOVE C,PAGENO\r
- PUSHJ PP,DNC ;OUTPUT PAGE NUMBER\r
- AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER?\r
- JRST OUTL1 ;YES\r
- MOVEI C,"-" ;NO, PUT OUT MODIFIER\r
- PUSHJ PP,OUTC\r
- MOVE C,PAGEN.\r
- PUSHJ PP,DNC\r
-OUTL1: PUSHJ PP,OUTCR\r
- MOVEI CS,DEVBUF\r
- PUSHJ PP,OUTAS0\r
- HRRZ CS,SUBTTX ;SWITCH FOR SUB-TITLE\r
- SKIPE 0(CS) ;IS THERE A SUB-TITLE?\r
- PUSHJ PP,OUTTAB ;YES, OUTPUT A TAB\r
- PUSHJ PP,SOUT20 ;OUTPUT ASCII WITH CARRIAGE RETURN\r
- PUSHJ PP,OUTCR\r
- POP PP,ER\r
- POP PP,CS ;RESTORE REGISTERS\r
- POP PP,C\r
-\r
-OUTC: TRNE ER,ERRORS!TTYSW\r
- PUSHJ PP,TYO\r
- TRNN ER,LPTSW\r
- POPJ PP,\r
-OUTLST: SOSG LSTBUF+2 ;BUFFER FULL?\r
- PUSHJ PP,DMPLST ;YES, DUMP IT\r
-COMMENT $ REG DOESN'T LIKE THIS FEATURE ANY MORE 9-5-72\r
-IFN STANSW,< CAIN C,"@"\r
- MOVEI C,140\r
- CAIN C,"_"\r
- MOVEI C,30\r
- CAIN C,"^"\r
- MOVEI C,32\r
- CAIE C,"\"\r
- JRST OUTLSS\r
- MOVEI C,177\r
- IDPB C,LSTBUF+1\r
- JRST OUTLST\r
-OUTLSS: >\r
-$\r
- IDPB C,LSTBUF+1 ;STORE BYTE\r
- POPJ PP, ;EXIT\r
-\r
-\fPAGE0: PUSHJ PP,STOUTS ;PAGE PSEUDO-OP\r
-OUTFF1: TLNE IO,IOCREF ;CURRENTLY DOING CREF?\r
- TLNE IO,IOPROG ;AND NOT XLISTED?\r
- JRST OUTFF ;NO\r
- HRR ER,OUTSW\r
- PUSHJ PP,CLSCRF\r
- PUSHJ PP,OUTCR\r
- HRRI ER,0\r
-OUTFF: TLO IO,IOPAGE\r
-OUTFF2: SETOM PAGEN.\r
- AOS PAGENO\r
- POPJ PP,\r
-\r
-TIMOUT: IDIVI 2,^D60*^D1000\r
-TIMOU1: IDIVI 2,^D60\r
- PUSH PP,3 ;SAVE MINUTES\r
- PUSHJ PP,OTOD ;STORE HOURS\r
- MOVEI 3,":" ;SEPARATE BY COLON\r
- IDPB 3,CS\r
- POP PP,2 ;STORE MINUTES\r
-OTOD: IDIVI 2,^D10\r
- ADDI 2,60 ;FORM ASCII\r
- IDPB 2,CS\r
- ADDI 3,60\r
- IDPB 3,CS\r
- POPJ PP,\r
-\r
-DATOUT: IDIVI 1,^D31 ;GET DAY\r
- ADDI 2,1\r
- CAIG 2,^D9 ;TWO DIGITS?\r
- ADDI 2,7760*^D10 ;NO, PUT IN SPACE\r
- PUSHJ PP,OTOD ;STORE DAY\r
- IDIVI 1,^D12 ;GET MONTH\r
- MOVE 2,DTAB(2) ;GET MNEMONIC\r
- IDPB 2,CS ;DEPOSIT RIGHT MOST 7 BITS\r
- LSH 2,-7 ;SHIFT NEXT IN\r
- JUMPN 2,.-2 ;DEPOSIT IFIT EXISTS\r
- MOVEI 2,^D64(1) ;GET YEAR\r
- JRST OTOD ;STORE IT\r
-\r
-DTAB: "-NAJ-"\r
- "-BEF-"\r
- "-RAM-"\r
- "-RPA-"\r
- "-YAM-"\r
- "-NUJ-"\r
- "-LUJ-"\r
- "-GUA-"\r
- "-PES-"\r
- "-TCO-"\r
- "-VON-"\r
- "-CED-"\r
-\fSUBTTL MACHINE INSTRUCTION SEARCH ROUTINES\r
-IFE OPHSH,<\r
-OPTSCH: MOVEI RC,0\r
- MOVEI ARG,1B^L<OP1END-OP1TOP> ;SET UP INDEX\r
- MOVEI V,1B^L<OP1END-OP1TOP>/2 ;SET UP INCREMENT\r
-\r
-OPT1A: CAMN AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL?\r
- JRST OPT1D ;YES, GET THE CODE\r
- JUMPE V,POPOUT ;TEST FOR END\r
- CAML AC0,OP1TOP(ARG) ;NO, SHOULD WE MOVE DOWN?\r
- TDOA ARG,V ;NO, INCREMENT\r
-OPT1B: SUB ARG,V ;YES, DECREMENT\r
- ASH V,-1 ;HALVE INCREMENT\r
- CAIG ARG,OP1END-OP1TOP ;ARE WE OUT OF BOUNDS?\r
- JRST OPT1A ;NO, TRY AGAIN\r
- JRST OPT1B ;YES, BRING IT DOWN A PEG\r
->\r
-\r
-IFN OPHSH,<\r
-OPTSCH: MOVE ARG,AC0 ;GET SIXBIT NAME\r
- TLZ ARG,400000 ;CLEAR SIGN BIT\r
- IDIVI ARG,PRIME ;REM. GOES IN V\r
- CAMN AC0,OP1TOP(V) ;ARE WE POINTING AT SYMBOL?\r
- JRST OPT1D ;YES\r
- SKIPN OP1TOP(V) ;TEST FOR END\r
- POPJ PP, ;SYMBOL NOT FOUND\r
- HLRZ RC,ARG ;SAVE LHS OF QUOTIENT\r
- SKIPA ARG,RC ;GET IT BACK\r
-OPT1A: ADDI ARG,(RC) ;INCREMENT ARG\r
- ADDI V,(ARG) ;QUADRATIC INCREASE TO V\r
- CAIL V,PRIME ;V IS MODULO PRIME\r
- JRST [SUBI V,PRIME\r
- JRST .-1]\r
- CAMN AC0,OP1TOP(V) ;IS THIS IT?\r
- JRST OPT1D ;YES\r
- SKIPE OP1TOP(V) ;END?\r
- JRST OPT1A ;TRY AGAIN\r
- POPJ PP, ;FAILED\r
->\r
-OPT1D:\r
-IFN OPHSH,< SETZ RC, ;CLEAR RELOCATION\r
- MOVE ARG,V ;GET INDEX IN RIGHT ACC.>\r
- IDIVI ARG,4 ;ARG HAS INDEX USED IN OPTTAB\r
- LDB V,OPTTAB(V) ;V HAS INDEX TO OPTTAB\r
- CAIL V,700 ;PSEUDO-OP OR IO INSTRUCTION?\r
- JRST OPT1G ;YES\r
- ROT V,-^D9 ;LEFT JUSTIFY\r
- HRRI V,OP ;POINT TO BASIC FORMAT\r
-OPT1F: AOS 0(PP) ;SET FOR SKIP EXIT\r
- MOVEI SDEL,%OP ;SET OP-CODE CROSS-REF FLAG\r
- JRST CREF ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE\r
-\r
-OPT1G: JUMPG AC0,.+3 ;IF ".","$",OR "%" USE TABLE 1\r
- TLNN AC0,200000 ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE\r
- SKIPA V,OP2TAB-700(V) ;2ND TABLE, FIRST LETTER IS "A" TO "O"\r
- MOVE V,OP1TAB-700(V) ;1ST TABLE, ..."P" TO "Z"\r
- JRST OPT1F ;EXIT\r
-\r
-OPTTAB:\r
-IFE OPHSH,< POINT 9,OP1COD-1(ARG),35>\r
- POINT 9,OP1COD (ARG), 8\r
- POINT 9,OP1COD (ARG),17\r
- POINT 9,OP1COD (ARG),26\r
-IFN OPHSH,< POINT 9,OP1COD (ARG),35>\r
-\r
-\fIFDEF .XCREF,< .XCREF ;DON'T CREF THIS MESS>\r
-IFE OPHSH,<\r
- RELOC .-1\r
-OP1TOP:\r
- RELOC\r
-\r
- IF1,<N1=0\r
- DEFINE X <N1=N1+1 ;>>\r
-\r
- IF2, <\r
- N2=^D36\r
- CC=0\r
- RELOC OP1COD\r
- RELOC\r
-DEFINE X (SYMBOL,CODE) \r
-<SIXBIT /SYMBOL/\r
-CC=CC+CODE_<N2=N2-9>\r
-IFE N2, <OUTLIT>>\r
-\r
-DEFINE OUTLIT <\r
- RELOC\r
- +CC\r
- RELOC\r
-N2=^D36+<CC=0>>>\r
- SYN X,XX ;JUST THE SAME MACRO>\r
-\f\r
-IFN OPHSH,<\r
-DEFINE XX (SB,CD)<> ;A NUL MACRO\r
-OP1TOP: IF1,< BLOCK PRIME>\r
-IF1,<DEFINE X (SB,CD)<>>\r
-IF2,<\r
-DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE_<9*<3-R&3>>>>\r
-\r
-DEFINE X (SB,CD)<\r
-SXB=<SIXBIT /SB/>\r
-Q=SXB&-1_-1/PRIME\r
-R=SXB&-1_-1-Q*PRIME\r
-H=Q_-22&777\r
-TRY=1\r
-OPCODE=CD\r
-ITEM Q,\R\r
-IFL PRIME-TRY,<PRINTX HASH FAILURE>>\r
-\r
-DEFINE ITEM (QT,RM)<\r
-IFN .%'RM,<R=R+H\r
-IFL PRIME-R,<R=R-R/PRIME*PRIME>\r
-H=H+Q_-22&777\r
-IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>\r
-IFE .%'RM,<.%'RM=SXB\r
-OPSTOR \<R/4>>>>\r
-IF1,<\r
-DEFINE GETSYM (N)<.%'N=0>\r
-\r
-N=0\r
- XLIST\r
-REPEAT PRIME,<GETSYM \N\r
-N=N+1>\r
-DEFINE GETSYM (N)<.$'N=0>\r
-N=0\r
-REPEAT <PRIME/4+1>,<GETSYM \N\r
-N=N+1>\r
->\r
- LIST>\r
-\r
-;MACRO TO HANDLE KI10 OP-CODES\r
-IFE KI10,<\r
-DEFINE XK (SB,CD) <> ;NUL MACRO>\r
-IFN KI10,<SYN X,XK ;USUAL X MACRO>\r
-\fIFN OPHSH,< ;PUT THE MOST USED OP CODES FIRST\r
-X JRST , 254\r
-X PUSHJ , 260\r
-X POPJ , 263\r
-X PUSH , 261\r
-X POP , 262\r
-X AOS , 350\r
-X ASCIZ , 701\r
-X CALLI , 047\r
-X EXTERN, 724\r
-X INTERN, 744\r
-X JFCL , 255\r
-X JSP , 265\r
-X MOVE , 200\r
-X MOVEI , 201\r
-X MOVEM , 202\r
-X SETZM , 402\r
-X SIXBIT, 717\r
-X SOS , 370\r
-X TLNE , 603\r
-X TLNN , 607\r
-X TLO , 661\r
-X TLZ , 621\r
-X TLZA , 625\r
-X TLZE , 623\r
-X TLZN , 627\r
-X TRNE , 602\r
-X TRNN , 606\r
-X TRZ , 620\r
->\r
-\fX ADD , 270\r
-X ADDB , 273\r
-X ADDI , 271\r
-X ADDM , 272\r
-\r
-X AND , 404\r
-X ANDB , 407\r
-X ANDCA , 410\r
-X ANDCAB, 413\r
-X ANDCAI, 411\r
-X ANDCAM, 412\r
-X ANDCB , 440\r
-X ANDCBB, 443\r
-X ANDCBI, 441\r
-X ANDCBM, 442\r
-X ANDCM , 420\r
-X ANDCMB, 423\r
-X ANDCMI, 421\r
-X ANDCMM, 422\r
-X ANDI , 405\r
-X ANDM , 406\r
-\r
-X AOBJN , 253\r
-X AOBJP , 252\r
-\r
-X AOJ , 340\r
-X AOJA , 344\r
-X AOJE , 342\r
-X AOJG , 347\r
-X AOJGE , 345\r
-X AOJL , 341\r
-X AOJLE , 343\r
-X AOJN , 346\r
-\r
-XX AOS , 350\r
-X AOSA , 354\r
-X AOSE , 352\r
-X AOSG , 357\r
-X AOSGE , 355\r
-X AOSL , 351\r
-X AOSLE , 353\r
-X AOSN , 356\r
-X ARG , 320\r
-IFN WFWSW,<X ARRAY , 772>\r
-IFN IIISW,<X ASCID , 771>\r
-X ASCII , 700\r
-XX ASCIZ , 701\r
-\r
-X ASH , 240\r
-X ASHC , 244\r
-\r
-X ASUPPR, 705\r
-X BLKI , 702\r
-X BLKO , 703\r
-X BLOCK , 704\r
-\r
-X BLT , 251\r
-\r
-X BYTE , 707\r
-\r
-XX CAI , 300\r
-X CAIA , 304\r
-X CAIE , 302\r
-X CAIG , 307\r
-X CAIGE , 305\r
-X CAIL , 301\r
-X CAILE , 303\r
-X CAIN , 306\r
-\r
-X CALL , 040\r
-XX CALLI , 047\r
-\r
-XX CAM , 310\r
-X CAMA , 314\r
-X CAME , 312\r
-X CAMG , 317\r
-X CAMGE , 315\r
-X CAML , 311\r
-X CAMLE , 313\r
-X CAMN , 316\r
-\r
-XX CLEAR , 400\r
-XX CLEARB, 403\r
-XX CLEARI, 401\r
-XX CLEARM, 402\r
-\r
-X CLOSE , 070\r
-X COMMEN, 770\r
-\r
-\r
-X CONI , 710\r
-X CONO , 711\r
-IFN STANSW,<X CONS,257>\r
-X CONSO , 712\r
-X CONSZ , 713\r
-\r
-XX DATA. , 020\r
-\r
-X DATAI , 714\r
-X DATAO , 715\r
-X DEC , 716\r
-X DEFINE, 717\r
-X DEPHAS, 720\r
-\r
-XK DFAD , 110\r
-XK DFDV , 113\r
-XK DFMP , 112\r
-X DFN , 131\r
-XK DFSB , 111\r
-\r
-X DIV , 234\r
-X DIVB , 237\r
-X DIVI , 235\r
-X DIVM , 236\r
-\r
-XK DMOVE , 120\r
-XK DMOVEM, 124\r
-XK DMOVN , 121\r
-XK DMOVNM, 125\r
-\r
-X DPB , 137\r
-\r
-X END , 721\r
-\r
-X ENTER , 077\r
-\r
-X ENTRY , 722\r
-\r
-X EQV , 444\r
-X EQVB , 447\r
-X EQVI , 445\r
-X EQVM , 446\r
-\r
-X EXCH , 250\r
-\r
-X EXP , 723\r
-XX EXTERN, 724\r
-\r
-X FAD , 140\r
-X FADB , 143\r
-X FADL , 141\r
-X FADM , 142\r
-\r
-X FADR , 144\r
-X FADRB , 147\r
-X FADRI , 145\r
-X FADRM , 146\r
-\r
-X FDV , 170\r
-X FDVB , 173\r
-X FDVL , 171\r
-X FDVM , 172\r
-\r
-X FDVR , 174\r
-X FDVRB , 177\r
-X FDVRI , 175\r
-X FDVRM , 176\r
-\r
-XX FIN. , 021\r
-\r
-IFN STANSW,<X FIX , 247>\r
-IFE STANSW,<XK FIX , 122>\r
-XK FIXR , 126\r
-XK FLTR , 127\r
-\r
-X FMP , 160\r
-X FMPB , 163\r
-X FMPL , 161\r
-X FMPM , 162\r
-\r
-\fX FMPR , 164\r
-X FMPRB , 167\r
-X FMPRI , 165\r
-X FMPRM , 166\r
-\r
-X FSB , 150\r
-X FSBB , 153\r
-X FSBL , 151\r
-X FSBM , 152\r
-\r
-X FSBR , 154\r
-X FSBRB , 157\r
-X FSBRI , 155\r
-X FSBRM , 156\r
-\r
-X FSC , 132\r
-\r
-X GETSTS, 062\r
-\r
-\fX HALT , 725\r
-X HISEG , 706\r
-\r
-X HLL , 500\r
-X HLLE , 530\r
-X HLLEI , 531\r
-X HLLEM , 532\r
-X HLLES , 533\r
-X HLLI , 501\r
-X HLLM , 502\r
-X HLLO , 520\r
-X HLLOI , 521\r
-X HLLOM , 522\r
-X HLLOS , 523\r
-X HLLS , 503\r
-X HLLZ , 510\r
-X HLLZI , 511\r
-X HLLZM , 512\r
-X HLLZS , 513\r
-\r
-X HLR , 544\r
-X HLRE , 574\r
-X HLREI , 575\r
-X HLREM , 576\r
-X HLRES , 577\r
-X HLRI , 545\r
-X HLRM , 546\r
-X HLRO , 564\r
-X HLROI , 565\r
-X HLROM , 566\r
-X HLROS , 567\r
-X HLRS , 547\r
-X HLRZ , 554\r
-X HLRZI , 555\r
-X HLRZM , 556\r
-X HLRZS , 557\r
-\r
-\fX HRL , 504\r
-X HRLE , 534\r
-X HRLEI , 535\r
-X HRLEM , 536\r
-X HRLES , 537\r
-X HRLI , 505\r
-X HRLM , 506\r
-X HRLO , 524\r
-X HRLOI , 525\r
-X HRLOM , 526\r
-X HRLOS , 527\r
-X HRLS , 507\r
-X HRLZ , 514\r
-X HRLZI , 515\r
-X HRLZM , 516\r
-X HRLZS , 517\r
-\r
-X HRR , 540\r
-X HRRE , 570\r
-X HRREI , 571\r
-X HRREM , 572\r
-X HRRES , 573\r
-X HRRI , 541\r
-X HRRM , 542\r
-X HRRO , 560\r
-X HRROI , 561\r
-X HRROM , 562\r
-X HRROS , 563\r
-X HRRS , 543\r
-X HRRZ , 550\r
-X HRRZI , 551\r
-X HRRZM , 552\r
-X HRRZS , 553\r
-\r
-X IBP , 133\r
-\r
-X IDIV , 230\r
-X IDIVB , 233\r
-X IDIVI , 231\r
-X IDIVM , 232\r
-\r
-X IDPB , 136\r
-\r
-X IF1 , 726\r
-X IF2 , 727\r
-X IFB , 730\r
-X IFDEF , 731\r
-X IFDIF , 732\r
-X IFE , 733\r
-X IFG , 734\r
-X IFGE , 735\r
-X IFIDN , 736\r
-X IFL , 737\r
-X IFLE , 740\r
-X IFN , 741\r
-X IFNB , 742\r
-X IFNDEF, 743\r
-\r
-X ILDB , 134\r
-\r
-X IMUL , 220\r
-X IMULB , 223\r
-X IMULI , 221\r
-X IMULM , 222\r
-\r
-X IN , 056\r
-XX IN. , 016\r
-X INBUF , 064\r
-XX INF. , 026\r
-X INIT , 041\r
-X INPUT , 066\r
-IFN WFWSW,<X INTEGE, 773>\r
-\r
-XX INTERN, 744\r
-\r
-X IOR , 434\r
-X IORB , 437\r
-X IORI , 435\r
-X IORM , 436\r
-\r
-\r
-X IOWD , 745\r
-X IRP , 746\r
-X IRPC , 747\r
-X JCRY , 750\r
-X JCRY0 , 751\r
-X JCRY1 , 752\r
-X JEN , 753\r
-\r
-XX JFCL , 255\r
-\r
-X JFFO , 243\r
-X JFOV , 765\r
-X JOV , 754\r
-\r
-X JRA , 267\r
-XX JRST , 254\r
-\r
-X JRSTF , 755\r
-\r
-X JSA , 266\r
-XX JSP , 265\r
-X JSR , 264\r
-\r
-XX JUMP , 320\r
-XX JUMPA , 324\r
-X JUMPE , 322\r
-X JUMPG , 327\r
-X JUMPGE, 325\r
-X JUMPL , 321\r
-X JUMPLE, 323\r
-X JUMPN , 326\r
-\r
-X LALL , 756\r
-\r
-X LDB , 135\r
-\r
-X LIST , 757\r
-X LIT , 760\r
-X LOC , 761\r
-\r
-X LOOKUP, 076\r
-\r
-X LSH , 242\r
-X LSHC , 246\r
-IFN WFWSW,<X LVAR , 774>\r
-XK MAP , 257\r
-X MLOFF , 767\r
-X MLON , 766\r
-XX MOVE , 200\r
-XX MOVEI , 201\r
-XX MOVEM , 202\r
-X MOVES , 203\r
-X MOVM , 214\r
-X MOVMI , 215\r
-X MOVMM , 216\r
-X MOVMS , 217\r
-X MOVN , 210\r
-X MOVNI , 211\r
-X MOVNM , 212\r
-X MOVNS , 213\r
-X MOVS , 204\r
-X MOVSI , 205\r
-X MOVSM , 206\r
-X MOVSS , 207\r
-\r
-\r
-X MTAPE , 072\r
-XX MTOP. , 024\r
-\r
-X MUL , 224\r
-X MULB , 227\r
-X MULI , 225\r
-X MULM , 226\r
-XX NLI. , 031\r
-XX NLO. , 032\r
-\r
-X NOSYM , 762\r
-\r
-\fX OCT , 763\r
-X OPDEF , 764\r
-\r
-X OPEN , 050\r
-\r
-X OR , 434\r
-X ORB , 437\r
-X ORCA , 454\r
-X ORCAB , 457\r
-X ORCAI , 455\r
-X ORCAM , 456\r
-X ORCB , 470\r
-X ORCBB , 473\r
-\r
-X ORCBI , 471\r
-X ORCBM , 472\r
-X ORCM , 464\r
-X ORCMB , 467\r
-X ORCMI , 465\r
-X ORCMM , 466\r
-X ORI , 435\r
-X ORM , 436\r
-\r
-X OUT , 057\r
-XX OUT. , 017\r
-X OUTBUF, 065\r
-XX OUTF. , 027\r
-X OUTPUT, 067\r
-\r
-\fX PAGE , 700\r
-X PASS2 , 701\r
-X PHASE , 702\r
-X POINT , 703\r
-\r
-XX POP , 262\r
-XX POPJ , 263\r
-\r
-X PRGEND, 714\r
-X PRINTX, 704\r
-X PURGE , 705\r
-\r
-XX PUSH , 261\r
-XX PUSHJ , 260\r
-\r
-X RADIX , 706\r
-X RADIX5, 707\r
-\r
-X RELEAS, 071\r
-\r
-X RELOC , 710\r
-X REMARK, 711\r
-\r
-X RENAME, 055\r
-\r
-X REPEAT, 712\r
-\r
-XX RESET., 015\r
-X RIM , 715\r
-X RIM10 , 735\r
-X RIM10B, 736\r
-\r
-X ROT , 241\r
-X ROTC , 245\r
-\r
-X RSW , 716\r
-XX RTB. , 022\r
-X SALL , 720\r
-X SEARCH, 721\r
-\r
-X SETA , 424\r
-X SETAB , 427\r
-X SETAI , 425\r
-X SETAM , 426\r
-X SETCA , 450\r
-X SETCAB, 453\r
-X SETCAI, 451\r
-X SETCAM, 452\r
-X SETCM , 460\r
-X SETCMB, 463\r
-X SETCMI, 461\r
-X SETCMM, 462\r
-X SETM , 414\r
-X SETMB , 417\r
-X SETMI , 415\r
-X SETMM , 416\r
-X SETO , 474\r
-X SETOB , 477\r
-X SETOI , 475\r
-X SETOM , 476\r
-X SETSTS, 060\r
-X SETZ , 400\r
-X SETZB , 403\r
-X SETZI , 401\r
-XX SETZM , 402\r
-\r
-XX SIXBIT, 717\r
-\r
-XX SKIP , 330\r
-X SKIPA , 334\r
-X SKIPE , 332\r
-X SKIPG , 337\r
-X SKIPGE, 335\r
-X SKIPL , 331\r
-X SKIPLE, 333\r
-X SKIPN , 336\r
-\r
-XX SLIST., 025\r
-\r
-X SOJ , 360\r
-X SOJA , 364\r
-X SOJE , 362\r
-X SOJG , 367\r
-X SOJGE , 365\r
-X SOJL , 361\r
-X SOJLE , 363\r
-X SOJN , 366\r
-\r
-XX SOS , 370\r
-X SOSA , 374\r
-X SOSE , 372\r
-X SOSG , 377\r
-X SOSGE , 375\r
-X SOSL , 371\r
-X SOSLE , 373\r
-X SOSN , 376\r
-\r
-IFN STANSW,<X SPCWAR,43>\r
-X SQUOZE, 707\r
-\r
-X STATO , 061\r
-X STATUS, 062\r
-X STATZ , 063\r
-\r
-X STOPI , 722\r
-\r
-X SUB , 274\r
-X SUBB , 277\r
-X SUBI , 275\r
-X SUBM , 276\r
-\r
-IF2,<IFE OPHSH,<SUBTL:>>\r
-X SUBTTL, 723\r
-X SUPPRE, 713\r
-X SYN , 724\r
-X TAPE , 725\r
-\r
-\fX TDC , 650\r
-X TDCA , 654\r
-X TDCE , 652\r
-X TDCN , 656\r
-X TDN , 610\r
-X TDNA , 614\r
-X TDNE , 612\r
-X TDNN , 616\r
-X TDO , 670\r
-X TDOA , 674\r
-X TDOE , 672\r
-X TDON , 676\r
-X TDZ , 630\r
-X TDZA , 634\r
-X TDZE , 632\r
-X TDZN , 636\r
-\r
-X TITLE , 726\r
-\r
-X TLC , 641\r
-X TLCA , 645\r
-X TLCE , 643\r
-X TLCN , 647\r
-X TLN , 601\r
-X TLNA , 605\r
-XX TLNE , 603\r
-XX TLNN , 607\r
-XX TLO , 661\r
-X TLOA , 665\r
-X TLOE , 663\r
-X TLON , 667\r
-XX TLZ , 621\r
-XX TLZA , 625\r
-XX TLZE , 623\r
-XX TLZN , 627\r
-\r
-\fX TRC , 640\r
-X TRCA , 644\r
-X TRCE , 642\r
-X TRCN , 646\r
-X TRN , 600\r
-X TRNA , 604\r
-XX TRNE , 602\r
-XX TRNN , 606\r
-X TRO , 660\r
-X TROA , 664\r
-X TROE , 662\r
-X TRON , 666\r
-XX TRZ , 620\r
-X TRZA , 624\r
-X TRZE , 622\r
-X TRZN , 626\r
-\r
-X TSC , 651\r
-X TSCA , 655\r
-X TSCE , 653\r
-X TSCN , 657\r
-X TSN , 611\r
-X TSNA , 615\r
-X TSNE , 613\r
-\r
-X TSNN , 617\r
-X TSO , 671\r
-X TSOA , 675\r
-X TSOE , 673\r
-X TSON , 677\r
-X TSZ , 631\r
-X TSZA , 635\r
-X TSZE , 633\r
-X TSZN , 637\r
-X TTCALL, 051\r
-X TWOSEG, 731\r
-X UFA , 130\r
-X UGETF , 073\r
-X UJEN , 100\r
-X UNIVER, 737\r
-X USETI , 074\r
-X USETO , 075\r
-\r
-X VAR , 727\r
-\r
-XX WTB. , 023\r
-\r
-X XALL , 732\r
-\r
-X XCT , 256\r
-\r
-X XLIST , 733\r
-\r
-X XOR , 430\r
-X XORB , 433\r
-X XORI , 431\r
-X XORM , 432\r
-\r
-X XPUNGE, 730\r
-X XWD , 734\r
-\r
-X Z , 000\r
-\r
-X .CREF , 740\r
-X .HWFRM, 742\r
-X .MFRMT, 743\r
-X .XCREF, 741\r
-\r
-\r
-\fIFN OPHSH,< ;NO-OPS, OLD MNEMONICS,F4 UUOS\r
-X CAI , 300\r
-X CAM , 310\r
-X CLEAR , 400\r
-X CLEARB, 403\r
-X CLEARI, 401\r
-X CLEARM, 402\r
-X JUMP , 320\r
-X JUMPA , 324\r
-X SKIP , 330\r
-X RESET., 015\r
-X IN. , 016\r
-X OUT. , 017\r
-X DATA. , 020\r
-X FIN. , 021\r
-X RTB. , 022\r
-X WTB. , 023\r
-X MTOP. , 024\r
-X SLIST., 025\r
-X INF. , 026\r
-X OUTF. , 027\r
-X NLI. , 031\r
-X NLO. , 032\r
->\r
-\fIFE OPHSH,<\r
-IF1, < BLOCK N1>\r
-OP1END: -1B36\r
-OP1COD: BLOCK N1/4\r
- CC>\r
-IFN OPHSH,<\r
-IF2,<\r
-DEFINE SETVAL (N)<EXP .%'N\r
-PURGE .%'N>\r
-N=0\r
-XLIST\r
-REPEAT PRIME,<SETVAL \N\r
-N=N+1>\r
-LIST\r
->\r
-OP1COD: IF1,< BLOCK <PRIME/4+1>>\r
-IF2,<\r
-DEFINE SETVAL (N)<EXP .$'N\r
-PURGE .$'N>\r
-N=0\r
-XLIST\r
-REPEAT <PRIME/4+1>,<SETVAL \N\r
-N=N+1>\r
->\r
-LIST>\r
-\r
-IFDEF .CREF,< .CREF ;START CREFFING AGAIN>\r
-\fSUBTTL PERMANENT SYMBOLS\r
-SYMNUM: EXP LENGTH/2 ;NUMBER OF PERMANENT SYMBOLS\r
-DEFINE P (A,B)<\r
- SIXBIT /A/\r
- XWD SYMF!NOOUTF,B>\r
-\r
-P @, 0(SUPRBT)\r
-P ??????, 0(SUPRBT)\r
-\r
-LENGTH= .-SYMNUM-1 ;LENGTH OF INITIAL SYMBOLS\r
-\r
-PRMTBL: ;PERMANENT SYMBOLS\r
-P ADC, 24\r
-P APR, 0\r
-P CCI, 14\r
-P CDP, 110\r
-P CDR, 114\r
-P CPA, 0\r
-P CR, 150\r
-P DC, 200\r
-P DCSA, 300\r
-P DCSB, 304\r
-P DF, 270\r
-P DIS, 130\r
-P DLS, 240\r
-P DPC, 250\r
-P DSK, 170\r
-P DTC, 320\r
-P DTS, 324\r
-P LPT, 124\r
-P MDF, 260\r
-P MTC, 220\r
-P MTM, 230\r
-P MTS, 224\r
-P PAG, 10\r
-P PI, 4\r
-P PLT, 140\r
-P PTP, 100\r
-P PTR, 104\r
-\r
-P TMC, 340\r
-P TMS, 344\r
-P TTY, 120\r
-P UTC, 210\r
-P UTS, 214\r
-IFE LNSSW,< XLIST >\r
-IFN LNSSW,< ;SPECIAL DEVICES FOR PEPR\r
-P .A,550\r
-P .AB,434\r
-P .ANG,440\r
-P .B,554\r
-P .BITE,470\r
-P .FA,564\r
-P .GAIN,520\r
-P .GATE,444\r
-P .IA,560\r
-P .INC,514\r
-P .LC,474\r
-P .LG,570\r
-P .PEPR,400\r
-P .RG,574\r
-P .SCON,430\r
-P .STAT,410\r
-P .TC,500\r
-P .TED,540\r
-P .THR,544\r
-P .TRK,404\r
-P .VIEW,524>\r
- LIST\r
-PRMEND: ;END OF PERMANENT SYMBOLS\r
-\r
-\f OPDEF ZL [Z LITF] ;INVALID IN LITERALS\r
- OPDEF ZA [Z ADDF] ;INVALID IN ADDRESSES\r
- OPDEF ZAL [Z ADDF!LITF]\r
-\r
-OP1TAB:\r
-\r
- ZA PAGE0 ;PAGE\r
- ZAL PASS20 ;PASS2\r
- ZAL PHASE0 ;PHASE\r
- Z POINT0 ;POINT\r
- ZA PRNTX0 ;PRINTX\r
- ZA PURGE0 ;PURGE\r
- ZA RADIX0 ;RADIX\r
- Z RADX50 ;RADIX50,SQUOZE\r
- ZAL LOC0 (1) ;RELOC\r
- ZAL REMAR0 ;REMARK\r
- ZA REPEA0 ;REPEAT\r
- ZA SUPRE0 ;SUPRESS\r
- ZAL PSEND0 ;PRGEND\r
- ZAL RIM0 (RIMSW) ;RIM\r
- DATAI 0,IOP ;RSW\r
- Z ASCII0 (1) ;SIXBIT\r
- ZAL IOSET (IOPALL!IOSALL) ;SALL\r
- ZAL SERCH0 ;SEARCH\r
- ZA STOPI0 ;STOPI\r
- ZA SUBTT0 (Z (POINT 7,,)) ;SUBTTL\r
- ZA SYN0 ;SYN\r
- ZAL TAPE0 ;TAPE\r
- ZA TITLE0 (Z (POINT 7,,)) ;TITLE\r
- ZAL VAR0 ;VAR\r
-\r
- Z XPUNG0 ;XPUNGE\r
- ZAL TWSEG0 ;TWOSEGMENTS\r
- ZAL XALL0 (IOPALL) ;XALL\r
- ZAL IOSET (IOPROG) ;XLIST\r
- Z XWD0 ;XWD\r
- ZAL RIM0 (RIM1SW) ;RIM10\r
- ZAL RIM0 (R1BSW) ;RIM10B\r
- ZA UNIV0 (Z (POINT 7,,)) ;UNIVERSAL\r
- ZAL IORSET (IONCRF) ;.CREF\r
- ZAL IOSET (IONCRF) ;.XCREF\r
- ZA OFFORM ;.HWFRMT\r
- ZA ONFORM ;.MFRMT\r
-\fOP2TAB:\r
-\r
- Z ASCII0 (0) ;ASCII\r
- Z ASCII0 (1B18) ;ASCIZ\r
- BLKI IOP ;BLKI\r
- BLKO IOP ;BLKO\r
- ZAL BLOCK0 ;BLOCK\r
- ZA SUPRSA ;ASUPPRESS\r
- ZAL HISEG0 ;HISEG\r
- Z BYTE0 ;BYTE\r
- CONI IOP ;CONI\r
- CONO IOP ;CONO\r
- CONSO IOP ;CONSO\r
- CONSZ IOP ;CONSZ\r
- DATAI IOP ;DATAI\r
- DATAO IOP ;DATAO\r
- Z OCT0 (^D10) ;DEC\r
- ZA DEFIN0 ;DEFINE\r
-\r
- ZAL DEPHA0 ;DEPHASE\r
- ZAL END0 ;END\r
- ZA INTER0 (INTF!ENTF) ;ENTRY\r
- Z EXPRES ;EXP\r
- ZA EXTER0 ;EXTERN\r
- JRST 4,OP ;HALT\r
- TLNN FR,IFPASS ;IF1\r
- TLNE FR,IFPASS ;IF2\r
-\r
- TRNE AC0,IFB0 ;IFB\r
- TLNE ARG,IFDEF0 ;IFDEF\r
- Z IFIDN0 (0) ;IFDIF\r
- SKIPE IF ;IFE\r
- SKIPG IF ;IFG\r
- SKIPGE IF ;IFGE\r
- Z IFIDN0 (1) ;IFIDN\r
- SKIPL IF ;IFL\r
-\r
- SKIPLE IF ;IFLE\r
- SKIPN IF ;IFN\r
- TRNN AC0,IFB0 ;IFNB\r
- TLNN ARG,IFDEF0 ;IFNDEF\r
- ZA INTER0 (INTF) ;INTERN\r
- Z IOWD0 ;IOWD\r
- Z IRP0 (0) ;IRP\r
- Z IRP0 (400000) ;IRPC\r
-\r
- JFCL 6,OP ;JCRY\r
- JFCL 4,OP ;JCRY0\r
- JFCL 2,OP ;JCRY1\r
- JRST 12,OP ;JEN\r
- JFCL 10,OP ;JOV\r
- JRST 2,OP ;JRSTF\r
- ZAL IORSET (IOPALL!IOSALL) ;LALL\r
- ZAL IORSET (IOPROG) ;LIST\r
- ZAL LIT0 ;LIT\r
- ZAL LOC0 (0) ;LOC\r
- ZA OFFSYM ;NOSYM\r
- Z OCT0 (^D8) ;OCT\r
- ZA OPDEF0 ;OPDEF\r
- JFCL 1,OP ;JFOV\r
- ZA ONML ;MLON\r
- ZA OFFML ;MLOFF\r
- Z ASCII0 (3B19) ;COMMENT\r
-IFN IIISW!WFWSW,<\r
- Z ASCII0 (5B20) ;ASCID\r
-IFN WFWSW,<\r
- ZAL %ARAY ;ARRAY\r
- ZAL %INTEG ;INTEGER\r
- ZAL %LVAR ;LVAR>>\r
-\f\r
-CALTBL:\r
- ;USER DEFINED CALLI'S GO HERE\r
- SIXBIT /LIGHTS/ ;-1\r
-CALLI0: SIXBIT /RESET/ ; 0\r
- SIXBIT /DDTIN/ ; 1\r
- SIXBIT /SETDDT/ ; 2\r
- SIXBIT /DDTOUT/ ; 3\r
- SIXBIT /DEVCHR/ ; 4\r
- SIXBIT /DDTGT/ ; 5\r
- SIXBIT /GETCHR/ ; 6\r
- SIXBIT /DDTRL/ ; 7\r
- SIXBIT /WAIT/ ;10\r
- SIXBIT /CORE/ ;11\r
- SIXBIT /EXIT/ ;12\r
- SIXBIT /UTPCLR/ ;13\r
- SIXBIT /DATE/ ;14\r
- SIXBIT /LOGIN/ ;15\r
- SIXBIT /APRENB/ ;16\r
- SIXBIT /LOGOUT/ ;17\r
- SIXBIT /SWITCH/ ;20\r
- SIXBIT /REASSI/ ;21\r
- SIXBIT /TIMER/ ;22\r
- SIXBIT /MSTIME/ ;23\r
- SIXBIT /GETPPN/ ;24\r
- SIXBIT /TRPSET/ ;25\r
- SIXBIT /TRPJEN/ ;26\r
- SIXBIT /RUNTIM/ ;27\r
- SIXBIT /PJOB/ ;30\r
- SIXBIT /SLEEP/ ;31\r
- SIXBIT /SETPOV/ ;32\r
- SIXBIT /PEEK/ ;33\r
- SIXBIT /GETLIN/ ;34\r
- SIXBIT /RUN/ ;35\r
- SIXBIT /SETUWP/ ;36\r
- SIXBIT /REMAP/ ;37\r
- SIXBIT /GETSEG/ ;40\r
- SIXBIT /GETTAB/ ;41\r
- SIXBIT /SPY/ ;42\r
- SIXBIT /SETNAM/ ;43\r
- SIXBIT /TMPCOR/ ;44\r
- SIXBIT /DSKCHR/ ;45\r
- SIXBIT /SYSSTR/ ;46\r
- SIXBIT /JOBSTR/ ;47\r
- SIXBIT /STRUUO/ ;50\r
- SIXBIT /SYSPHY/ ;51\r
- SIXBIT /FRECHN/ ;52\r
- SIXBIT /DEVTYP/ ;53\r
- SIXBIT /DEVSTS/ ;54\r
- SIXBIT /DEVPPN/ ;55\r
- SIXBIT /SEEK/ ;56\r
- SIXBIT /RTTRP/ ;57\r
- SIXBIT /LOCK/ ;60\r
- SIXBIT /JOBSTS/ ;61\r
- SIXBIT /LOCATE/ ;62\r
- SIXBIT /WHERE/ ;63\r
- SIXBIT /DEVNAM/ ;64\r
- SIXBIT /CTLJOB/ ;65\r
- SIXBIT /GOBSTR/ ;66\r
- 0 ;67\r
- 0 ;70\r
- SIXBIT /HPQ/ ;71\r
- SIXBIT /HIBER/ ;72\r
- SIXBIT /WAKE/ ;73\r
- SIXBIT /CHGPPN/ ;74\r
- SIXBIT /SETUUO/ ;75\r
- SIXBIT /DEVGEN/ ;76\r
- SIXBIT /OTHUSR/ ;77\r
- SIXBIT /CHKACC/ ;100\r
- SIXBIT /DEVSIZ/ ;101\r
- SIXBIT /DAEMON/ ;102\r
- SIXBIT /JOBPEK/ ;103\r
- SIXBIT /ATTACH/ ;104\r
- SIXBIT /DAEFIN/ ;105\r
- SIXBIT /FRCUUO/ ;106\r
- SIXBIT /DEVLNM/ ;107\r
- SIXBIT /PATH./ ;110\r
-\r
-CALNTH==.-CALTBL\r
-NEGCAL==CALLI0-CALTBL ;NUMBER OF NEGATIVE CALLI'S\r
-\r
-TTCTBL: SIXBIT /INCHRW/ ; 0 INPUT A CHAR. AND WAIT\r
- SIXBIT /OUTCHR/ ; 1 OUTPUT A CHAR.\r
- SIXBIT /INCHRS/ ; 2 INPUT A CHAR. AND SKIP\r
- SIXBIT /OUTSTR/ ; 3 OUTPUT A STRING\r
- SIXBIT /INCHWL/ ; 4 INPUT CHAR., WAIT, LINE MODE\r
- SIXBIT /INCHSL/ ; 5 INPUT CHAR., SKIP, LINE MODE\r
- SIXBIT /GETLCH/ ; 6 GET LINE CHARACTERISTICS\r
- SIXBIT /SETLCH/ ; 7 SET LINE CHARACTERISTICS\r
- SIXBIT /RESCAN/ ;10 RESET INPUT STREAM TO COMMAND\r
- SIXBIT /CLRBFI/ ;11 CLEAR TYPEIN BUFFER\r
- SIXBIT /CLRBFO/ ;12 CLEAR TYPEOUT BUFFER\r
- SIXBIT /SKPINC/ ;13 SKIPS IF A CHAR. CAN BE INPUT\r
- SIXBIT /SKPINL/ ;14 SKIPS IF A LINE CAN BE INPUT\r
- SIXBIT /IONEOU/ ;15 OUTPUT AS AN IMAGE CHAR.\r
-\r
-TTCLTH==.-TTCTBL\r
- SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES\r
-MSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH\r
- POPJ PP, ;NOT FOUND, EXIT\r
- JUMPG ARG,MSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND\r
- CAME AC0,1(SX) ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE\r
- POPJ PP, ;NO, EXIT\r
- ADDI SX,2 ;YES, POINT TO IT\r
- PUSHJ PP,SRCH5 ;LOAD REGISTERS\r
-MSRCH2: AOSA 0(PP) ;SET SKIP-EXIT\r
-QSRCH: JUMPL ARG,SSRCH3 ;BRANCH IF OPERAND\r
- MOVEI SDEL,%MAC ;SET OPERATOR FLAG\r
- TLZE IO,DEFCRS ;IS IT A DEFINITION?\r
- MOVEI SDEL,%DMAC ;YES\r
- JRST CREF ;CROSS-REF AND EXIT\r
-\r
-SSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH\r
- POPJ PP, ;NOT FOUND, EXIT\r
- JUMPL ARG,SSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND\r
-SSRCH1: CAME AC0,-3(SX) ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW\r
- POPJ PP, ;NO DICE, EXIT\r
- SUBI SX,2 ;YES, POINT TO IT\r
- PUSHJ PP,SRCH5 ;LOAD REGISTERS\r
-SSRCH2: AOS 0(PP) ;SET FOR SKIP-EXIT\r
-SSRCH3: MOVEI SDEL,%SYM ;SET OPERAND FLAG\r
-\r
-CREF: TLNN IO,IONCRF ;NO CREFFING FOR THIS SYMBOL?\r
- TLNE FR,P1!CREFSW ;PASS ONE OR CROSS-REF SUPPRESSION?\r
- POPJ PP, ;YES, EXIT\r
- EXCH SDEL,C ;PUT FLAG IN C, SACE C\r
- PUSH PP,CS\r
- TLNE IO,IOCREF ;HAVE WE PUT OUT THE 177,102\r
- JRST CREF3 ;YES\r
- PUSH PP,C ;START OF CREF DATA\r
-\r
-\fREPEAT 0,< ;NEEDS CHANGE TO CREF\r
- MOVEI C,177\r
- PUSHJ PP,OUTLST\r
- MOVEI C,102\r
- PUSHJ PP,OUTLST\r
- TLO IO,IOCREF ;WE NOW ARE IN THAT STATE\r
- POP PP,C ;WE HAVE NOW\r
-CREF3: JUMPE C,NOFLG ;JUST CLOSE IT\r
- PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
- MOVSI CS,770000 ;COUNT CHRS\r
- TDZA C,C ;STARTING AT 0\r
- LSH CS,-6 ;TRY NEXT\r
- TDNE AC0,CS ;IS THAT ONE THERE?\r
- AOJA C,.-2 ;YES\r
- PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
- MOVE CS,AC0\r
-\r
-CREF2: MOVEI C,0\r
- LSHC C,6\r
- ADDI C,40\r
- PUSHJ PP,OUTLST ;THE ASCII SYMBOL\r
- JUMPN CS,CREF2\r
- MOVEI C,%DSYM\r
- TLZE IO,DEFCRS\r
- PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE\r
-NOFLG: MOVE C,SDEL\r
- POP PP,CS\r
- POPJ PP,\r
-\r
-CLSCRF: TRNN ER,LPTSW\r
- POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING\r
-CLSCR2: MOVEI C,177\r
- PUSHJ PP,PRINT\r
- TLZE IO,IOCREF ;WAS IT OPEN?\r
- JRST CLSCR1 ;YES, JUST CLOSE IT\r
- MOVEI C,102 ;NO, OPEN IT FIRST\r
- PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA\r
- MOVEI C,177\r
- PUSHJ PP,OUTLST\r
-CLSCR1: MOVEI C,103\r
- JRST OUTLST ;MARK END OF CREF DATA\r
-\r
-CLSC3: TLZ IO,IOCREF\r
- MOVEI C,177\r
- PUSHJ PP,OUTLST\r
- MOVEI C,104\r
- JRST OUTLST ;177,104 CLOSES IT FOR NOW\r
-> ;END OF REPEAT 0\r
-\fREPEAT 1,< ;WORKS WITH EXISTING CREF\r
- TLNE IO,IOPAGE\r
- PUSHJ PP,CRFHDR ;GET CORRECT SUBTTL\r
- MOVEI C,177\r
- PUSHJ PP,OUTLST\r
- MOVEI C,102\r
- PUSHJ PP,OUTLST\r
- TLO IO,IOCREF ;WE NOW ARE IN THAT STATE\r
- POP PP,C ;WE HAVE NOW\r
-CREF3: PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
- MOVSI CS,770000 ;COUNT CHRS\r
- TDZA C,C ;STARTING AT 0\r
- LSH CS,-6 ;TRY NEXT\r
- TDNE AC0,CS ;IS THAT ONE THERE?\r
- AOJA C,.-2 ;YES\r
- PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
- MOVE CS,AC0\r
-\r
-CREF2: MOVEI C,0\r
- LSHC C,6\r
- ADDI C,40\r
- PUSHJ PP,OUTLST ;THE ASCII SYMBOL\r
- JUMPN CS,CREF2\r
- MOVEI C,%DSYM\r
- TLZE IO,DEFCRS\r
- PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE\r
- MOVE C,SDEL\r
- POP PP,CS\r
- POPJ PP,\r
-\r
-IFN OPHSH,<\r
-SUBTL: SIXBIT /SUBTTL/>\r
-CRFHDR: CAME AC0,SUBTL ;IS FIRST SYMBOL "SUBTTL"\r
- JRST CRFHD1 ;NO\r
- HLLZ AC0,V\r
- PUSHJ PP,SUBTT0 ;UPDATE SUBTTL\r
- MOVE AC0,SUBTL ;RESTORE ARG.\r
- MOVEI V,CPOPJ\r
-CRFHD1: MOVEI C,0\r
- JRST OUTL\r
-\r
-CLSC3:\r
-CLSCRF: TRNN ER,LPTSW\r
- POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING\r
-CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE\r
- JRST CLSCR1\r
- MOVEI C,0\r
- TLNE IO,IOPAGE ;NEW PAGE?\r
- PUSHJ PP,OUTL ;YES,GIVE IT A ROUSING SENDOFF!\r
- MOVEI C,177\r
- PUSHJ PP,OUTLST\r
- MOVEI C,102\r
- PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA\r
-CLSCR1: MOVEI C,177\r
- PUSHJ PP,OUTLST\r
- MOVEI C,103\r
- JRST OUTLST ;MARK END OF CREF DATA\r
-> ;END OF REPEAT 1\r
-\fSEARCH: HLRZ SX,SRCHX\r
- HRRZ SDEL,SRCHX\r
-\r
-SRCH1: CAML AC0,-1(SX)\r
- JRST SRCH3\r
-SRCH2: SUB SX,SDEL\r
- LSH SDEL,-1\r
- CAMG SX,SYMTOP\r
- JUMPN SDEL,SRCH1\r
- JUMPN SDEL,SRCH2\r
- SOJA SX,SRCHNO ;NOT FOUND\r
-\r
-SRCH3: CAMN AC0,-1(SX)\r
- JRST SRCH4 ;NORMAL / FOUND EXIT\r
- ADD SX,SDEL\r
- LSH SDEL,-1\r
- CAMG SX,SYMTOP\r
- JUMPN SDEL,SRCH1\r
- JUMPN SDEL,SRCH2\r
- SOJA SX,SRCHNO ;NOT FOUND\r
-\r
-SRCH4: AOS 0(PP) ;SET FOR SKIP EXIT\r
-SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT\r
- ANDCAM ARG,(SX) ; IN THE TABLE\r
-SRCH7: MOVE ARG,0(SX) ;FLAG AND VALUE TO ARG\r
- LDB RC,RCPNTR ;POINT 1,ARG,17\r
- TLNE ARG,LELF ;CHECK LEFT RELOCATE\r
- TLO RC,1\r
- HRRZ V,ARG\r
- TLNE ARG,SPTR ;CHECK SPECIAL EXTESN POINTER\r
- JRST SRCH6\r
- TLNE ARG,PNTF\r
- MOVE V,0(ARG) ;36BIT VALUE TO V\r
- JRST SRCHOK\r
- \r
-SRCH6: MOVE V,0(ARG) ;VALUE\r
- MOVE RC,1(ARG) ;AND RELOC\r
- TLNE RC,-2 ;CHECK AND SET EXTPNT\r
- HLLM RC,EXTPNT\r
- TRNE RC,-2 \r
- HRRM RC,EXTPNT\r
- JRST SRCHOK\r
-SRCHNO: SKIPN UNISCH+1 ;ALLOWED TO SEARCH OTHER TABLES\r
- POPJ PP, ;NO, JUST RETURN\r
- AOS V,UNISCH ;GET NEXT INDEX TO TABLE\r
- CAIE V,1 ;FIRST TIME IN\r
- JRST SRCHN1 ;YES, SAVE SYMBOL INFO\r
- HRLM SX,UNISCH ;SAVE SX AND SET FLAG\r
- MOVE ARG,SRCHX ;SEARCH POINTER\r
- MOVEM ARG,UNISHX ;TO A SAFE PLACE\r
- HRR ARG,SYMBOL\r
- HRL ARG,SYMTOP\r
- MOVEM ARG,UNIPTR ;STORE ALSO\r
-SRCHN1: MOVE V,UNISCH(V) ;GET TRUE INDEX\r
- JUMPE V,SRCHKO ;IF ZERO ALL TABLE SCANNED\r
- MOVE ARG,UNISHX(V) ;NEW SRCHX\r
- MOVEM ARG,SRCHX ;SET IT UP\r
- MOVE ARG,UNIPTR(V) ;SYMTOP,,SYMBOL\r
- HRRZM ARG,SYMBOL\r
- HLRZM ARG,SYMTOP\r
- JRST SEARCH ;TRY AGAIN\r
-\r
-SRCHKO: SETZ ARG, ;CLEAR ARG SO ZERO STORED\r
-SRCHOK: SKIPN UNISCH ;HAVE WE SEARCH OTHER TABLES\r
- POPJ PP, ;NO, JUST RETURN\r
-SYMBCK: HLRZ SX,UNISCH ;RESTORE SX\r
- SETZM UNISCH ;CLEAR SYMBCK FLAG\r
- PUSH PP,V ;SAVE AN AC\r
- MOVE V,UNISHX ;SRCHX\r
- MOVEM V,SRCHX ;RESTORE ORIGINAL\r
- MOVE V,UNIPTR ;SYMTOP,,SYMBOL\r
- HRRZM V,SYMBOL\r
- HLRZM V,SYMTOP\r
- JUMPE ARG,SRCHK2 ;TOTALLY UNDEFINED\r
- PUSH PP,RC ;SAVE SOME ACCS\r
- PUSH PP,ARG\r
- PUSH PP,EXTPNT\r
- SETZB ARG,EXTPNT ;CLEAR ALL SYMBOL DATA\r
- SETZB RC,V\r
- PUSHJ PP,INSERT ;INSERT SYMBOL IN TABLE\r
- POP PP,EXTPNT ;RESTORE ACCS ETC.\r
- POP PP,ARG\r
- POP PP,RC\r
- MOVEM ARG,(SX) ;SET FLAGS AND VALUE AS IT SHOULD BE\r
-SRCHK2: POP PP,V\r
- POPJ PP, ;RETURN\r
-\r
-\fINSERQ: TLNE ARG,UNDF!VARF\r
-INSERZ: SETZB RC,V\r
-INSERT: CAME AC0,-1(SX) ;ARE WE LOOKING AT MATCHING MNEMONIC?\r
- JRST INSRT2 ;NO, JUST INSERT\r
- JUMPL ARG,INSRT1 ;YES, BRANCH IF OPERAND\r
- SKIPL 0(SX) ;OPERATOR, ARE WE LOOKING AT ONE?\r
- JRST UPDATE ;YES, UPDATE\r
- JRST INSRT2 ;NO, INSERT\r
-\r
-INSRT1: SKIPG 0(SX) ;OPERAND, ARE WE LOOKING AT ONE?\r
- JRST UPDATE ;YES, UPDATE\r
- SUBI SX,2 ;NO, MOVE UNDER OPERATOR AND INSERT\r
-INSRT2: MOVE SDEL,SYMBOL\r
- SUBI SDEL,2\r
- CAMLE SDEL,FREE\r
- JRST INSRT3\r
- PUSHJ PP,XCEEDS\r
- ADDI SDEL,2000\r
-INSRT3: MOVEM SDEL,SYMBOL ;MAKE ROOM FOR A TWO WORD ENTRY\r
- HRLI SDEL,2(SDEL)\r
- BLT SDEL,-2(SX) ;PUSH EVERYONE DOWN TWO LOACTIONS\r
- AOS @SYMBOL ;INCREMENT THE SYMBOL COUNT\r
- TLNN RC,-2 ;NEED SPECIAL?\r
- TRNE RC,-2 ;LEFT OR RIGHT EXTERNAL?\r
- JRST INSRT5 ;YES, JUMP\r
- TLNN V,-1 ;SKIP IF V IS A 36BIT VALUE\r
- JRST INSRT4 ;JUMP, ITS A 18BIT VALUE\r
- AOS SDEL,FREE ;36BIT, SO GET A CELL FROM FREE CORE\r
- CAML SDEL,SYMBOL ;MORE CORE NEEDED?\r
- PUSHJ PP,XCEEDS ;YES\r
- HRRI ARG,-1(SDEL) ;POINTER TO ARG\r
- MOVEM V,0(ARG) ;36BIT VALUE TO FREE CORE\r
- TLOA ARG,PNTF ;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE\r
-\r
-INSRT4: HRR ARG,V ;18BIT VALUE TO ARG\r
- DPB RC,RCPNTR ;FIX RIGHT RELOCATION\r
- TLNE RC,1\r
- TLO ARG,LELF ;FIX LEFT RELOCATION\r
-INSRT6: MOVEM ARG,0(SX) ;INSERT FLAGS AND VALUE.\r
- MOVEM AC0,-1(SX) ;INSERT SYMBOL NAME.\r
- PUSHJ PP,SRCHI ;INITILIAZE SRCHX\r
- JRST QSRCH ;EXIT THROUGH CREF\r
- \r
-INSRT5: MOVEI SDEL,2 ;GET TWO CELLS FROM FREE CORE\r
- ADDB SDEL,FREE\r
- CAML SDEL,SYMBOL;MORE CORE NEEDED?\r
- PUSHJ PP,XCEEDS ;YES\r
- MOVEM RC,-1(SDEL)\r
- HRRI ARG,-2(SDEL) ;POINTER TO ARG\r
- MOVEM V,0(ARG)\r
- TLO ARG,SPTR ;SET SPECIAL POINTER, POINTS TO TWO CELLS\r
- JRST INSRT6\r
-\fREMOVE: SUBI SX,2 ;MOVE EVERYONE UP TWO LOCATIONS\r
-REMOV1: MOVE 0(SX)\r
- MOVEM 2(SX) ;OVERWRITE THE DELETED SYMBOL\r
- CAME SX,SYMBOL ;SKIP WHEN DONE\r
- SOJA SX,REMOV1\r
- ADDI SX,2\r
- MOVEM SX,SYMBOL\r
- SOS 0(SX) ;DECREMENT THE SYMBOL COUNT\r
-\r
-SRCHI: MOVEI AC2,0 ;THIS CODE SETS UP SRCHX\r
- FAD AC2,@SYMBOL\r
- LSH AC2,-^D27\r
- MOVEI AC1,1000\r
- LSH AC1,-357(AC2)\r
- HRRM AC1,SRCHX\r
- LSH AC1,1\r
- ADD AC1,SYMBOL\r
- HRLM AC1,SRCHX\r
- POPJ PP, ;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4\r
-\r
-\fUPDATE: DPB RC,RCPNTR ;FIX RIGHT RELOCATION\r
- TLNE ARG,SPTR ;SKIP IF THERE IS NO SPECIAL POINTER\r
- JRST UPDAT4 ;YES, USE THE TWO CELLS\r
- TLNN RC,-2 ;NEED TO CHANGE\r
- TRNE RC,-2 ;ANY CURRENT EXTERNS?\r
- JRST UPDAT5 ;YES ,JUMP\r
- TLZ ARG,LELF ;CLEAR LELF\r
- TLNE RC,1 ;LEFT RELOCATABLE?\r
- TLO ARG,LELF ;YES, SET THE FLAG\r
- TLNE ARG,PNTF ;WAS THERE A 36BIT VALUE?\r
- JRST UPDAT2 ;YES, USE IT.\r
- TLNE V,-1 ;NO,IS THERE A 36BIT VALUE?\r
- JRST UPDAT1 ;YES, GET A CELL\r
- HRR ARG,V ;NO, USE RH OF ARG\r
-UPDAT3: MOVEM ARG,0(SX) ;OVERWRITE THE ONE IN THE TABLE\r
- POPJ PP, ;AND EXIT\r
-\r
-UPDAT1: AOS SDEL,FREE ;GET ONE CELL\r
- CAML SDEL,SYMBOL ;NEED MORE CORE?\r
- PUSHJ PP,XCEEDS ;YES\r
- HRRI ARG,-1(SDEL) ;POINTER TO ARG\r
- TLO ARG,PNTF ;AND NOTE IT.\r
-UPDAT2: TLNE ARG,EXTF ;IS THERE A EXTERNAL?\r
- JRST UPDAT3 ;YES, - JUST SAVE A LOCATION\r
- MOVEM ARG,0(SX) ;NO, OVERWRITE THE POINTER IN THE TABLE\r
- MOVEM V,0(ARG) ;STORE VALUE AS A 36BIT VALUE\r
- POPJ PP, ;AND EXIT\r
- \r
-UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM\r
- MOVEM V,0(ARG) ;SAVE AS 36BIT VALUE\r
- MOVEM RC,1(ARG) ;SAVE RELOCATION BITS\r
- POPJ PP, ;AND EXIT\r
-\r
-UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL\r
- ADDB SDEL,FREE ;SO WE NEED TWO LOACTIONS\r
- CAML SDEL,SYMBOL ;NEED MORE CORE?\r
- PUSHJ PP,XCEEDS ;YES\r
- MOVEM RC,-1(SDEL) ;SAVE RELOCATION BITS\r
- HRRI ARG,-2(SDEL) ;SAVE THE POINTER IN ARG\r
- MOVEM V,0(ARG) ;SAVE A 36BIT VALUE\r
- TLO ARG,SPTR ;SET SPECIAL PNTR FLAG\r
- TLZ ARG,PNTF ;CLEAR POINTER FLAG\r
- JRST UPDAT3 ;SAVE THE POINTER AND EXIT\r
-\r
-\f SUBTTL CONSTANTS\r
-\r
-\r
-IFN FORMSW,<\r
-HWFORM: BYTE (18) 1,1\r
-INFORM: BYTE (9) 1 (4) 1 (1) 1 (4) 1 (18) 1\r
-IOFORM: BYTE (3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1\r
-BPFORM: BYTE (6) 1,1 (2) 1 (4) 1 (18) 1\r
-ASCIIF: BYTE (7) 1,1,1,1,1\r
-SXFORM: BYTE (6) 1,1,1,1,1,1\r
->\r
-\r
-\f SUBTTL PHASED CODE\r
-\r
-IFN PURESW,<LOWH:\r
-IFE SEG2SW,< PHASE 140>\r
-IFN SEG2SW,< PHASE LOWL>\r
->\r
-IFN TEMP,<TMPFIL: SIXBIT /MAC/\r
- XWD -200,0>\r
-LSTFIL: BLOCK 1\r
- SIXBIT /@/ ;SYMBOL TO STOP PRINTING\r
-TAG: BLOCK 1\r
- SIXBIT / + @/\r
-TABI:\r
-IFE FORMSW,< BYTE (7) 0, 11, 11, 11, 11>\r
-IFN FORMSW,< BYTE (7) 11,11, 11, 11, 11>\r
-SEQNO: BLOCK 1\r
- ASCIZ / /\r
-BININI: EXP B\r
-BINDEV: BLOCK 1\r
- XWD BINBUF,0\r
-LSTINI: EXP AL\r
-LSTDEV: BLOCK 1\r
- XWD LSTBUF,0\r
-IFN CCLSW,<\r
-IFE RUNSW,<\r
-NUNINI: EXP DMP\r
-NUNDEV: BLOCK 1\r
- XWD 0,0>\r
-RPGINI: EXP AL\r
-RPGDEV: BLOCK 1\r
- XWD 0,CTLBLK\r
->\r
-INDEVI: EXP A\r
-INDEV: BLOCK 1\r
- XWD 0,IBUF\r
-DBUF: ASCIZ / TI:ME DY-MON-YR PAGE /\r
-VBUF: ASCIZ / MACRO / ;MUST BE LAST LOCATIONS IN BLOCK\r
-IFE PURESW,< BLOCK 3 ;ALLOW FOR LONG TITLE>\r
-IFN PURESW,< DEPHASE\r
- LENLOW==.-LOWH>\r
-\r
-\fSUBTTL STORAGE CELLS\r
-\r
-IFN PURESW,<\r
-IFE SEG2SW,< LOC 140>\r
-IFN SEG2SW,< RELOC LOWL>\r
-LOWL: BLOCK LENLOW+3 >\r
-PASS1I:\r
-\r
-RP: BLOCK 1\r
-\r
-IFE CCLSW,<CTIBUF: BLOCK 3\r
-CTOBUF: BLOCK 3\r
->\r
-IFN CCLSW,<CTLBUF: BLOCK <CTLSIZ+5>/5\r
-IFN RUNSW,<RUNDEV: BLOCK 1\r
-RUNFIL: BLOCK 3\r
-RUNPP: BLOCK 2>>\r
-LSTBUF: BLOCK 3\r
-BINBUF: BLOCK 3\r
-IBUF: BLOCK 3\r
-IFN CCLSW,<IFE RUNSW,<NUNDIR:>>\r
-LSTDIR: BLOCK 4\r
-BINDIR: BLOCK 4\r
-INDIR: BLOCK 4\r
-\r
-ACDELX: ;LEFT HALF\r
-BLKTYP: BLOCK 1 ;RIGHT HALF\r
-\r
-COUTX: BLOCK 1\r
-COUTY: BLOCK 1\r
-COUTP: BLOCK 1\r
-COUTRB: BLOCK 1\r
-COUTDB: BLOCK ^D18\r
-\r
-ERRCNT: BLOCK 1\r
-FREE: BLOCK 1\r
-IFN RENTSW,<HIGH1: BLOCK 1\r
-HISNSW: BLOCK 1\r
-SVTYP3: BLOCK 1\r
-HMIN: BLOCK 1 ;START OF HIGH SEG. IN TWO SEG. PROG.>\r
-IFBLK: BLOCK .IFBLK\r
-IFBLKA: BLOCK .IFBLK\r
-LADR: BLOCK 1\r
-NCOLLS: BLOCK 1\r
-LIMBO: BLOCK 1\r
-LBUFP: BLOCK 1\r
-LBUF: BLOCK <.CPL+5>/5\r
- BLOCK 1\r
-VARHD: BLOCK 1\r
-VARHDX: BLOCK 1\r
-IFN WFWSW,<LVARLC: BLOCK 1>\r
-\r
-LITAB: BLOCK 1\r
-LITABX: BLOCK 1\r
- BLOCK 1\r
-LITHD: BLOCK 1\r
-LITHDX: BLOCK 1\r
-LITCNT: BLOCK 1\r
-LITNUM: BLOCK 1\r
-\r
-LOOKX: BLOCK 1\r
-NEXT: BLOCK 1\r
-OUTSW: BLOCK 1\r
-PDP: BLOCK 1\r
-RECCNT: BLOCK 1\r
-SAVBLK: BLOCK RC\r
-SAVERC: BLOCK 1\r
-SBUF: BLOCK .SBUF/5\r
-SRCHX: BLOCK 1\r
-SUBTTX: BLOCK 1\r
-SVSYM: BLOCK 1\r
-SYMBOL: BLOCK 1\r
-SYMTOP: BLOCK 1\r
-SYMCNT: BLOCK 1\r
-\r
-STPX: BLOCK 1\r
-STPY: BLOCK 1\r
-STCODE: BLOCK .STP\r
-STOWRC: BLOCK .STP\r
-\r
-IFN FORMSW,<\r
-STFORM: BLOCK .STP\r
-FORM: BLOCK 1\r
-HWFMT: BLOCK 1\r
-FLDSIZ: BLOCK 1\r
-IOSEEN: BLOCK 1\r
->\r
-TABP: BLOCK 1\r
-TCNT: BLOCK 1 ;COUNT OF CHARS. LEFT IN TBUF\r
-TBUF: BLOCK .TBUF/5\r
-DEVBUF: BLOCK 6 ;STORE NAME.EXT CREATION DATE AND TIME\r
-TYPERR: BLOCK 1\r
-IONSYM: BLOCK 1 ;-1 SUPRESS LISTING OF SYMBOLS\r
-PRGPTR: BLOCK 1 ;POINTER TO CHAIN OF PRGEND BLOCKS\r
-ENTERS: BLOCK 1 ;-1 WHEN ENTERS HAVE BEEN DONE\r
-UNIVSN: BLOCK 1 ;-1 WHEN A UNIVERSAL SEEN\r
-\r
-\fPASS2I:\r
-\r
-ABSHI: BLOCK 1\r
-HIGH: BLOCK 1\r
-IFN RENTSW,<HHIGH: BLOCK 1 ;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.>\r
-ACDEVX: BLOCK 1\r
-CPL: BLOCK 1\r
-CTLSAV: BLOCK 1\r
-CTLS1: BLOCK 1\r
-EXTPNT: BLOCK 1\r
-INTENT: BLOCK 1\r
-INREP: BLOCK 1\r
-INDEF: BLOCK 1\r
-INTXT: BLOCK 1\r
-INCND: BLOCK 1\r
-CALNAM: BLOCK 1\r
-CALPG: BLOCK 1\r
-CALSEQ: BLOCK 1\r
-DEFPG: BLOCK 1\r
-DEFSEQ: BLOCK 1\r
-LITPG: BLOCK 1\r
-LITSEQ: BLOCK 1\r
-REPPG: BLOCK 1\r
-REPSEQ: BLOCK 1\r
-TXTPG: BLOCK 1\r
-TXTSEQ: BLOCK 1\r
-CNDPG: BLOCK 1\r
-CNDSEQ: BLOCK 1\r
-IRPCNT: BLOCK 1\r
-IRPARG: BLOCK 1\r
-IRPARP: BLOCK 1\r
-IRPCF: BLOCK 1\r
-IRPPOI: BLOCK 1\r
-IRPSW: BLOCK 1\r
-IFN WFWSW,<FIXLNK: BLOCK 1>\r
-LITLVL: BLOCK 1\r
-LITLBL: BLOCK 1 ;NAME OF LABEL DEFINED INSIDE A LITERAL\r
-\r
-ASGBLK: BLOCK 1\r
-LOCBLK: BLOCK 1\r
-\r
-LOCA: BLOCK 1\r
-LOCO: BLOCK 1\r
-RELLOC: BLOCK 1\r
-ABSLOC: BLOCK 1\r
-LPP: BLOCK 1\r
-MODA: BLOCK 1\r
-MODLOC: BLOCK 1\r
-MODO: BLOCK 1\r
-IFN CCLSW,<OTBUF: BLOCK 2>\r
-OUTSQ: BLOCK 2\r
-PAGEN.: BLOCK 1\r
-PPTEMP: BLOCK 1\r
-PPTMP1: BLOCK 1\r
-PPTMP2: BLOCK 1\r
-\r
-REPCNT: BLOCK 1\r
-REPEXP: BLOCK 1\r
-REPPNT: BLOCK 1\r
-RPOLVL: BLOCK 1\r
-R1BCNT: BLOCK 1\r
-R1BCHK: BLOCK 1\r
-R1BBLK: BLOCK .R1B\r
-R1BLOC: BLOCK 1\r
-RIMLOC: BLOCK 1\r
-TAGINC: BLOCK 1\r
-VECREL: BLOCK 1\r
-VECTOR: BLOCK 1\r
-.TEMP: BLOCK 1 ;TEMPORARY STORAGE\r
-UNISCH: BLOCK .UNIV ;SEARCH TABLE FOR UNIVERSALS\r
-SQFLG: BLOCK 1\r
-ARGF: BLOCK 1\r
-MACENL: BLOCK 1\r
-MACLVL: BLOCK 1\r
-MACPNT: BLOCK 1\r
-WWRXX: BLOCK 1\r
-RCOUNT: BLOCK 1 ;COUNT OF WORDS STILL TO READ IN LEAF\r
-WCOUNT: BLOCK 1 ;COUNT OF WORDS STILL FREE IN LEAF\r
-PASS2Z: ;ONLY CLEAR TO HERE ON PRGEND\r
-LSTSYM: BLOCK 1\r
-PAGENO: BLOCK 1\r
-SEQNO2: BLOCK 1\r
-PASS2X:\r
-\r
-\fSUBTTL MULTI-ASSEMBLY STORAGE CELLS\r
-\r
-LSTPGN: BLOCK 1\r
-IFN WFWSW,<ARAYP: BLOCK 1>\r
-HDAS: BLOCK 1\r
-IFN CCLSW,<EXTMP: BLOCK 1 ;HOLDS EXT OF COMMAND FILE (RH)\r
-SAVFF: BLOCK 1\r
-CTLBLK: BLOCK 3\r
-CTIBUF: BLOCK 3\r
-CTOBUF: BLOCK 3>\r
-IFN TEMP,<TMPFLG: BLOCK 1>\r
-IFN FORMSW,<PHWFMT: BLOCK 1>\r
-MACSIZ: BLOCK 1 ;INITIAL SIZE OF LOW SEG\r
-UNISIZ: BLOCK 1 ;TOP OF BUFFERS AND STACKS\r
-UNITOP: BLOCK 1 ;TOP OF UNIVERSAL SYMBOL TABLE\r
-UNIVNO: BLOCK 1 ;NUMBER OF UNIVERSALS SEEN\r
-UNITBL: BLOCK .UNIV ;TABLE OF UNIVERSAL NAMES\r
-UNIPTR: BLOCK .UNIV ;TABLE OF SYMBOL POINTERS\r
-UNISHX: BLOCK .UNIV ;TABLE OF SRCHX POINTERS\r
- VAR ;CLEAR VARIABLES\r
-\r
-JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONE\r
-IFN PURESW,<LOWEND==.-1\r
- RELOC >\r
-\r
- END BEG\r
-\f\r
-\0\0\0\0\r
git://git.sky-visions.com / retro-software/dec/tops10/v4.5.git / commitdiff