--- /dev/null
+/ RALF, V62A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1974, 1975, 1977
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/ RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV
+/
+/
+/ FPPASM BY HANK MAURER
+/ RALF MODS BY JUD LEONARD
+/ OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY
+/ NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER
+/
+/ THE FOLLOWING FORMULA GIVES THE NUM
+/ OF USER SYMBOLS:
+/ -(FREE+200[BASE8])/6[BASE10]
+/ WHERE THE VALUE OF FREE IS FROM THE
+/ RALF SYMBOL MAP
+/
+/
+IFNDEF RALF <RALF=1 /GO RELOCATABLE THEN>
+/
+/ ASSEMBLE WITH PAL8-V9 WITH W SWITCH
+/ SAVE AS:
+/ .SAVE SYS RALF.SV ;200=2000
+
+/
+/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
+/ .CHANGED VERSION NUMBER TO 62
+/ .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF:
+/ 1.) THE ESD IS LONGER THAN ONE BLOCK, AND
+/ 2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER
+/
+/
+ FLD0=0
+ FLD1=10
+ VNUM=62
+ PATCH="A /PATCH LEVEL A
+ *3
+VERS, VNUM /VERSION NUMBER
+OLDN3, 0 /\ fTEMP FOR LOOKUP
+OTEMP, 0 /A COUPLE OF TEMPS THAT
+OCNT, 0 /DIDNT FIT INTO THEIR PAGE
+ 0
+X10, 0
+X11, 0
+X12, 0
+X13, 0
+X14, 0
+OUTPTR, OUBUF-1
+NEXT, FREE-1
+CHRPTR, LINE-1
+NCHARS, -1 /CHARACTER INPUT STUFF
+CPTMP, 0
+NCTMP, 0 /USED TO SAVE CHAR POSITION
+LINSIZ, 0 /SIZE OF LINE FOR PRINTING
+STYPE, /SYMBOL TYPE CODE
+CHKSUM, 0 /FOR BINARY OUTPUT
+ IFZERO RALF <
+LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM
+LOCTR2, 200 >
+ IFNZRO RALF <
+ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
+LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
+LOCTR2, 0
+DPFLG, 0 >
+\fBASER, 4000 /BASE REGISTER SETTING
+ 0
+INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER
+ 0
+EXPVAL, 0 /EXPRESSION VALUE
+ 0
+ 0
+EXPDEF, 0 /=0 IF EXPR IS UNDEFINED
+EXPSW, 0 /FLAG=1 IF NO EXPR
+WORD1, 0 /TEMPORARY 2 WORD OPERAND
+WORD2, 0
+FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR
+ 0
+OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER
+XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT
+XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR
+BUCKET, 0 /FIRST CHAR OF NAME
+NAME1, 0 /CHARS 2 AND 3 OF NAME
+NAME2, 0 /CHARS 4 AND 5 OF NAME
+NAME3, 0 /CHAR 6 OF NAME AND TYPE
+LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR
+PASSNO, -1 /PASS NUMBER
+ASMOF, 0 /SET NEGATIVE WHEN ASSEMBLY OFF
+PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT
+LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING)
+OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED
+REPCNT, 0 /REPEAT COUNTER
+SCSWT, 0 /SEMICOLON SWITCH
+RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL)
+LTEMP, -177 /TEMP USED BY LOOKUP
+EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS
+EXTMP2, 0
+EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN
+ /NEXT TWO LOCS USED WITH EQUN BY DMPESD
+FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR
+FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT
+FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0
+LITRL, 0 /SET = 1 FOR LITERAL
+P0LIT, 177
+CPLIT, 177
+PAGEN, 0
+ERRORS, 0 /ERROR COUNT
+PC, TTYOUT /OUTPUT ROUTINE
+OUFILE, 7573 /OUTPUT FILE LIST POINTER
+BFILE, 1
+\fLPAGE1, 1 /INPUT FORMFEED COUNT
+LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE
+LINPAG, -1 /LINES/PAGE COUNTER
+LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE
+LINKS, /NO OF LINKS GENERATED
+ABREFS, 0 /NO OF ABSOLUTE REFERENCES
+ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT
+USR, 200 /CURRENT CALL ADDRESS FOR USR
+SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE
+ /IS SPECIFIED. ITS SET VIA SLASH S
+ /=1=REGULAR
+NP17, 17 /**
+NP7700, 7700
+OPX, 0
+OP, ZBLOCK 6
+ACX, 0
+AC, ZBLOCK 6
+M3, -3
+BLINE, LINE-1
+/
+ PAGE
+\f/
+/ CORE ALLOCATION IN HIGH FIELD 0
+/
+ CPLBUF=5100 /ACTUALLY AT 5200
+ P0LBUF=5200 /AND 5300, 1/2 PAGE EACH
+ IFZERO RALF <
+ INBUF=5400 >
+ IFNZRO RALF <
+ INBUF=6000 /AFTER PASS 1, MOVES TO 5400>
+ OUBUF=6400
+ LINE=7000 /CURRENT INPUT LINE IN ASCII
+ INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR
+ OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR
+ INRECS=2
+ INCTL=400
+ OUCTL=4200
+/
+/ COLLECT THE NEXT STATEMENT
+/
+ ISZ .+2
+REPLEN, JMP I .+1
+REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001
+NEXTST, CDF FLD0 /JUST PRECAUTION
+ TAD OUTSWT /IF NO OUTPUT FROM THIS LINE,
+ SNA CLA
+ TAD PASSNO /AND LISTING PASS
+ SMA SZA CLA
+ TAD LISTSW /AND LISTING ENABLED
+ SNA CLA /PRINT THIS LINE NOW
+ JMP START /ELSE GET NEXT
+ JMS I [CRLF /PRINT CR/LF
+ TAD (-6
+ DCA LTEMP /SPACE OVER
+ JMS I [PRINT2 /12 SPACES
+ ISZ LTEMP
+ JMP .-2
+ JMS I (PRNTLN /THEN PRINT LINE
+START, JMS I [GETCHR /ANY MORE CHARS ?
+ JMP NOTEG
+ JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE
+ 0507 /*EG*
+NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ?
+ SNA CLA
+ JMP .+5 /NO
+ DCA SCSWT /KILL SC SWITCH
+ ISZ CHRPTR /SKIP OVER SEMICOLON
+ ISZ NCHARS
+ JMP ASMBL /DON'T READ A NEW LINE
+ TAD REPCNT /IS THIS LINE TO BE REPEATED?
+ SPA CLA
+ JMP AGAIN /DO IT
+NEWLIN, TAD BLINE /RESET POINTER
+ DCA CHRPTR
+ TAD [-200 /LIMIT LINE SIZE
+ DCA MAXLIN
+ DCA OUTSWT /CLEAR OUTPUT SWITCH
+\fRDLOOP, JMS I (ICHAR /READ A CHAR
+ TAD (-212
+ SNA
+ JMP RDLOOP /IGNORE LINE FEEDS
+ TAD (212-215 /END ON CR
+ SNA
+ JMP ENDLIN
+ IAC
+ SNA /FORM FEED?
+ JMP FORMFD
+ TAD (214 /FIX CHAR
+ DCA I CHRPTR /SAVE IT
+ ISZ MAXLIN /TEST FOR LINE TOO LONG
+ JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1
+ JMS I (ICHAR /IGNORE ANOTHER CHAR
+ TAD (-215 /UNLESS CR
+ SZA CLA
+ JMP .-3
+ JMS I [ERMSG /EXCESS LENGTH LINE
+ 1424 /*LT*
+ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1
+ CMA
+ TAD BLINE
+ DCA NCHARS
+ TAD REPCNT /0 BECOMES 0,
+ CIA /BUT POS REP COUNT
+ DCA REPCNT /ENABLES REPEAT
+ TAD NCHARS /SAVE LENGTH
+ DCA REPLEN
+ TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT
+ DCA REPLST
+REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT
+ DCA LINSIZ
+ TAD BLINE
+ DCA CHRPTR /SET POINTER
+ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL
+ SZA CLA
+ JMP OFFIT /YES, AND THE COND WAS FALSE
+ JMS I [GETCHR /LOOK FOR A CHARACTER
+ JMP NEXTST
+ TAD (-257 /IS IT SLASH ?
+ SNA
+ JMP NOASM /YES, COOL IT
+ TAD [257-240 /IS IT BLANK OR TAB ?
+ SZA CLA /YES, IGNORE
+ JMS I [BACK1 /NO, PUT IT BACK
+ JMP I (LUNAME /ASSEMBLE STMT
+\fFORMFD, ISZ LPAGE1 /BUMP FORM FEED COUNT
+ DCA LPAGE2 /CLEAR SUB-PAGE COUNT
+ CLA CMA
+ DCA LINPAG /FORCE EJECT ON CRLF
+ JMP RDLOOP
+OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE
+ TAD ASMOF
+ DCA ASMOF
+OFFIT, ISZ NCHARS /MORE TO GO?
+ JMP GETIT /YES
+NOASM, CLA CMA
+ DCA NCHARS /DONT ASSEMBLE THIS LINE
+ JMP NEXTST /(PREVENTING *EG* MESSAGE)
+GETIT, TAD I CHRPTR /PICK UP THE CHARACTER
+ TAD (-274 /OPEN ANGLE BRACKET?
+ SNA
+ JMP OPENIT /YES, PUSH ONE LEVEL DOWN
+ CLL RTR
+ SNA CLA
+ ISZ ASMOF /IF CLOSE, CHECK LEVEL
+ JMP OFFIT /TRY FOR NEXT
+ JMP ASMBL /RESUME WORK
+AGAIN, TAD REPLEN /WE NOW REPEAT THE SAME LINE
+ DCA NCHARS
+ DCA LISTSW /NO LISTING DURRING REPEAT
+ ISZ REPCNT
+ JMP REASM /ASSUMING COUNT STILL OK
+ TAD REPLST /RESTORE LISTING
+ DCA LISTSW
+ JMP NEWLIN /GET NEXT LINE
+ MAXLIN=LTEMP
+/
+TXERR, TEXT " ERRORS"
+TXELN= .-TXERR
+ PAGE
+\f/
+/ DIVIDE AC BY 3
+/ USEFUL IN FPP REFERENCES TO BASE
+/
+OVER3, 0 /DIVIDE AC BY THREE
+ DCA EXTMP2 /MQ
+ TAD (-15 /SET SHIFT COUNT
+ DCA LTEMP
+DIVLUP, CLL /ZERO LINK
+ TAD (-3 /SUBTRACT DIVISOR FROM AC
+ SZL /IF AC>=3 SET LINK TO 1
+ JMP .+3 /OK, DONT RESTORE
+ TAD (3 /TOO SMALL, RESTORE AC
+ CLL /SET LINK BACK TO 0
+ DCA EXTMP /SAVE AC
+ TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK IN MQ
+ RAL
+ DCA EXTMP2 /SAVE MQ
+ TAD EXTMP /GET BACK AC
+ RAL /COMPLETE SHIFT
+ ISZ LTEMP /TEST COUNT
+ JMP DIVLUP /KEEP GOING
+ DCA EXTMP /THIS IS REMAINDER
+ TAD EXTMP2 /RETURN QUOTIENT
+ JMP I OVER3
+/
+/ INITIALIZE FOR OUTPUT
+/
+OUSETP, 0
+ TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
+ CIA /NEGATE IT (PAL10 BLOWS)
+ DCA OUDWCT
+ TAD NOUBUF
+ DCA OUPTR /INITIALIZE WORD POINTER
+ TAD OUJMPE
+ DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
+ JMP I OUSETP
+NOUBUF, OUBUF
+/
+/ STORE CHARACTERS IN OUTPUT BUFFER
+/ IN PS8 FORMAT (YOU KNOW, 3 CHARS
+/ IN 2 WORDS THE WRONG WAY)
+/
+OCHAR, 0
+ AND (377
+ DCA OUTEMP
+ TAD OUTINH
+ SZA CLA /IS THERE AN OUTPUT FILE?
+ JMP I OCHAR /NO - EXIT
+ CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
+ ISZ OUJMP /BUMP THE CHARACTER SWITCH
+OUJMP, HLT /THREE WAY CHARACTER SWITCH
+ JMP OCHAR1
+ JMP OCHAR2
+ TAD OUTEMP
+ CLL RTL
+ RTL
+ AND (7400
+ TAD I OUPOLD
+ DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
+ /ORDER 4 BITS OF THIRD CHAR
+ TAD OUTEMP
+ CLL RTR
+ RTR
+ RAR
+ AND (7400
+ TAD I OUPTR
+ DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
+ JMP OUCOMN
+ TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
+ JMS I (OUTDMP /DUMP THE BUFFER
+ JMS OUSETP /RE-INITIALIZE THE POINTERS
+ JMP OUCOMN
+OCHAR2, TAD OUPTR
+ DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
+ ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
+OCHAR1, TAD OUTEMP
+ DCA I OUPTR
+OUCOMN, CDF
+ JMP I OCHAR
+OUTEMP, 0
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTINH, 0
+/
+/ MOVE OUTPUT FILE NAME TO FIELD 0
+/
+OFNAME, 0
+ TAD OUFILE
+ DCA X10
+ TAD (OUFNAM-1
+ DCA X11
+ TAD (-4
+ DCA LTEMP
+ CDF 10
+ TAD I X10
+ CDF 0
+ DCA I X11
+ ISZ LTEMP
+ JMP .-5
+ JMP I OFNAME
+\f/
+/ GET OUTPUT DEVICE CHARISTICS
+/
+OTYPE, 0
+ CDF 10
+ TAD I (7600
+ AND [17
+ TAD (DCB-1
+ DCA OTYPP
+ TAD I OTYPP
+ CDF 0
+ JMP I OTYPE
+OTYPP= OFNAME
+/
+/ BASIC TITLE INFO
+/
+TITBUF,
+ IFZERO RALF <
+ TEXT "FLAP V" >
+ IFNZRO RALF <
+ TEXT "RALF V" >
+*.-1
+VMTXT, 0;0;0
+TITDAT, ZBLOCK 6
+ TEXT " PAGE"
+TITLEN= .-TITBUF
+ PAGE
+\f/
+/ PROCESS A STATEMENT
+/
+LUNAME, TAD CHRPTR /SAVE CHAR STUFF
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP
+ DCA LINKSW /CLEAR SWITCH
+ JMS I [GETNAM /LOOK FOR NAME
+ IFZERO RALF <
+ JMP I (TRYSTR /COULD BE AN ORG>
+ IFNZRO RALF <
+ JMP I (GETEXP /NOT ONE OF OURS, I GUESS>
+ JMS I [GETCHR /LOOK FOR COMMA
+ JMP JSTONE /ITS JUST ONE SYMBOL
+ TAD (-254 /COMMA TEST
+ SZA
+ JMP TRYEQU /NO COMMA, CHECK FOR EQUAL
+ JMS I [LOOKUP /LOOK UP SYMBOL
+ JMP DEFLBL /ITS UNDEFINED
+ CLL RAR /VERIFY ADDR TYPE
+ SZA CLA
+ JMP MDERR /THAT'S A NO-NO
+ TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION
+ CIA
+ TAD LOCTR1 /FIRST UPPERR HALF
+ SZA CLA
+ JMP .+6
+ TAD I X10
+ CIA
+ TAD LOCTR2 /THEN LOWER HALF
+ SNA CLA
+ JMP DEFIND
+MDERR, JMS I [ERMSG /MULTIPLY DEFINED
+ 1504 /*MD*
+ JMP I (ASMBL /FIELD IS OK
+DEFLBL, ISZ I LTEMP /SET TYPE TO 1 (USER ADDR)
+ TAD LOCTR1 /PUT LOCATION COUNTER
+ DCA I X10 /INTO VALUE
+ TAD LOCTR2
+ DCA I X10
+DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG
+ JMP I (ASMBL
+\fTRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN
+ SZA
+ JMP TRYBLK /NO, TRY BLANK
+ TAD NAME1
+ DCA EQUN /SAVE 6 CHARACTER NAME
+ TAD NAME2
+ DCA EQUN+1
+ TAD NAME3
+ DCA EQUN+2
+ TAD BUCKET
+ DCA EQUN+3
+ JMS I [GETCHR /ALLOW BLANK AFTER =
+ JMP EQUERR
+ TAD [-240
+ SZA CLA
+ JMS I [BACK1 /ANYTHING ELSE GOES BACK
+ JMS I [EXPR /GET VALUE RIGHT OF EQUALS
+ JMP EQUERR /BAD EQU
+ TAD EQUN /RESTORE NAME
+ DCA NAME1
+ TAD EQUN+1
+ DCA NAME2
+ TAD EQUN+2
+ DCA NAME3
+ TAD EQUN+3
+ DCA BUCKET
+ JMS I [LOOKUP /LOOKUP SYMBOL
+ JMP PUTVAL /A NEW SYMBOL
+ CLL RAR
+ SZA CLA
+ JMP EQUERR /TYPE CONFLICT
+PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE
+ DCA I X10
+ TAD EXPVAL+2
+ DCA I X10
+ TAD I LTEMP /NOW GET TYPE WORD
+ AND (7740 /ZERO OLD TYPE, PRESERVING FORCE BIT
+ TAD EXPDEF /DEFINED BY RIGHT HAND SIDE
+ DCA I LTEMP /RESTORE WORD
+ CDF FLD0
+ JMP I [NEXTST /GO GET NEXT STMT
+EQUERR, JMS I [ERMSG /BAD EQU
+ 0205 /*BE*
+ JMP I [NEXTST
+\fTRYBLK, TAD (35 /CHECK FOR BLANK
+ SNA /MATCH BLANK?
+ JMP JSTONE /YES
+ AND [77
+ JMS I [R6L
+ DCA NAME3 /MAKE MODIFIED NAME OF IT
+ JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK
+ JMP I (GETEXP /LOOKS BAD
+ TAD [-240 /GOT IT?
+ SZA CLA
+ JMP I (GETEXP /LET EXPR TELL HIM IF ITS WRONG
+JSTONE, TAD (33 /USE OUR INTERNAL SYMBOL TABLE
+ JMS I [FIND /IS IT THERE?
+ JMP I (GETEXP /NO, LOOK IN USER'S
+ TAD OPCTBL /CREATE JUMP THRU TABLE
+ DCA OPCJMP /SAVE IT
+ TAD I X10 /PICK UP FIRST WORD OF VALUE
+ DCA OPCODE /ITS AN OPCODE-MAYBE?
+ CDF FLD0
+OPCJMP, 0 /JUMP SOMEWHERE
+OPCTBL, JMP I .-4
+ PSEUDO /PSEUDO OPS
+ PDP8MR /PDP8 MRI
+ FPPMR /FPPMR
+ FPPS1 /OTHER FPP OPCODES
+ FPPS2
+ FPPS3
+ FPPS4
+ FPPS5
+ FPMRI /INDIRECT FPP MEM REF
+ FPMRS /SHORT DIRECT MEM REF
+ FPMRL /LONG DIRECT REF
+ PDPOPR /8-MODE OPERATES
+REPETX, JMS I (ADRGET /EVALUATE REPEAT EXPR
+ CLL CMA RAR /3777
+ AND EXPVAL+2
+ DCA REPCNT
+ JMP I [NEXTST
+ PAGE
+\f/
+GETEXP, CDF FLD0
+ TAD CPTMP /RESTORE CHARACTER POINTER
+ DCA CHRPTR
+ TAD NCTMP /TO JUST AFTER TAG (IF ANY)
+ DCA NCHARS
+SX, DCA OPCODE
+ JMS I [EXPR /TRY FOR AN EXPRESSION
+ JMP BADEXP /IF NONE, ERROR
+ IFNZRO RALF <
+ JMS RELERR /BOMB IF NOT ABSOLUTE EXP>
+ TAD EXPVAL+2
+ JMS I [OUTWRD
+ JMP I [NEXTST /GO DO NEXT STMT
+ IFNZRO RALF </IF EXPVAL IS RELOCATABLE,
+RELERR, 0 /GIVE ERROR MESSAGE
+ TAD EXPVAL+1 /CAUTION: THIS ROUTINE IS
+ /SOMETIMES CALLED WITH NON-ZERO AC
+ AND [7770 /JUST ESD BITS
+ SNA CLA
+ JMP I RELERR /ITS ABSOLUTELY FINE
+ TAD EXPVAL+1
+ AND [7 /REMOVE ESD
+ DCA EXPVAL+1
+ JMS I [ERMSG
+ 2205 /*RE*
+ JMP I RELERR >
+/
+FPPMR, ISZ FPPSWT /SET FORCE ENABLE
+ JMS FPADR
+ TAD WORD1 /IF WAY OFF BASE,
+ SNA
+ TAD FPPWD2 /OR IF FORCED
+ SNA
+ TAD XFLAG /OR IF INDEXED
+ SZA CLA
+ JMP FORMT1 /USE LONG FORM
+ TAD WORD2
+ CLL
+ TAD (-600 /COMPLETE OFF-BASE CHECK
+ SZL CLA
+ JMP FORMT1 /USE LONG
+ JMP FORMT2
+FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR
+ JMS IXMES /BUT DISALLOW INDEX
+ JMP F2WD /PUT TWO WORDS OUT
+/
+IXMES, 0
+ TAD XFLAG /NO INDEX ALLOWED
+ SNA CLA
+ JMP I IXMES /HE'S COOL
+ JMS I [ERMSG
+ 1130 /*IX*
+ JMP I IXMES
+\fFPMRL, JMS FPADR
+FORMT1, JMS I (FIXOPC
+F2WD, TAD FPPADR
+ AND [7 /FIELD BITS
+ TAD OPCODE /IN FIRST WORD
+FPDMP, IFZERO RALF <
+ JMS I [OUTWRD
+ TAD FPPADR+1 /LOW ADDRESS
+ JMS I [OUTWRD
+ JMP I [NEXTST /NEXT!>
+ IFNZRO RALF <
+ JMP I (OUTREL /DUMP TWO RELOCATABLE>
+FPMRS, JMS FPADR /COLLECT OPERAND
+ JMS IXMES /ERROR IF INDEX GIVEN
+ TAD WORD1
+ SZA CLA
+ JMP BADEXP
+ TAD WORD2
+ CLL
+ TAD (-600 /DOES IT FIT?
+ SNL CLA
+ JMP FORMT2
+BADEXP, JMS I [ERMSG
+ 0230 /*BX*
+ TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT
+ JMS I [OUTWRD
+ JMP I [NEXTST
+FPMRI, JMS FPADR
+ TAD WORD1
+ SZA CLA
+ JMP BADEXP /NOT EVEN CLOSE
+ TAD WORD2
+ CLL
+ TAD (-30
+ SZL CLA
+ JMP BADEXP /GOTTA BE IN THE FIRST 10
+FORMT3, JMS I (FIXOPC
+FORMT2, TAD WORD2
+ JMS I (OVER3 /BY 3 FOR BASE ADDRESS
+ TAD [200
+FPPS3, TAD OPCODE
+ JMS I [OUTWRD /WHEW!
+ JMP I [NEXTST
+FPPS1, JMS I (GETADR /GET ADDR, AND INDEX
+ JMS I (FIXOPC /PUT OPCODE TOGETHER
+ TAD FPPADR /GET ADDR EXTENSION
+ AND [7
+ TAD OPCODE /WITH TOGETHER OPCODE
+ AND (7377 /WITHDRAW ONE BIT
+ JMP FPDMP /PUT IT OUT
+\fFPPS5, CLA IAC /DISALLOW INDEX INCR
+ JMS I (GETADR /COLLECT ADDRESS AND INDEX
+ IFNZRO RALF <
+ TAD FPPADR
+ AND [7770 /MUST BE ABSOLUTE
+ SNA CLA
+ JMP .+3 /OK
+ JMS I [ERMSG
+ 2205 /*RE*>
+ TAD XFLAG
+ SZA CLA /ANY INDEX?
+ TAD EXPVAL+2
+ AND [7 /STRIP OFF ESD BITS
+ TAD OPCODE
+ JMS I [OUTWRD /DUMP THAT
+ TAD FPPADR+1
+ JMS I [OUTWRD /NOW LOW 12 BITS
+ JMP I [NEXTST
+/
+FPADR, 0
+ JMS I (GETADR /COLLECT ADDRESS AND INDEX
+ TAD BASER+1
+ CIA STL
+ TAD FPPADR+1
+ DCA WORD2 /GET ADDRESS RELATIVE TO BASE
+ RAL
+ TAD BASER
+ CIA
+ TAD FPPADR
+ DCA WORD1
+ JMP I FPADR
+ PAGE
+\f/
+PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR
+/
+ IFZERO RALF <
+/
+/ ASSEMBLE VARIOUS INSTRUCTION TYPES
+/
+PDP8MR, TAD CHRPTR /SAVE POSITION
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP /SAVE COUNT
+ JMS I [GETCHR /LOOK FOR SPACE "I"
+ JMP GETMR /WILL GIVE BX ERROR
+ TAD (-"I /IS IT I?
+ SNA CLA /IF NOT, FORGET IT
+ JMS I [GETCHR /MUST BE FOLLOWED BY SPACE
+ JMP NOTIND
+ TAD [-240
+ SZA CLA
+ JMP NOTIND /SOMETHING ELSE
+ TAD OPCODE /PUT INDIRECT INTO OPCODE
+ TAD (400
+ DCA OPCODE
+GETMR, JMS ADRGET /PICK UP ADDRESS FIELD
+ TAD EXPVAL+2 /CHECK PAGE OF ADDRESS
+ AND [7600
+ SNA
+ JMP PAGEZ /ITS IN PAGE 0
+ CIA
+ TAD LOCTR2 /COMPARE WITH CURRENT PAGE
+ AND [7600
+ SNA CLA
+ JMP THSPAG /OK, ITS THIS PAGE
+ TAD OPCODE /CAN WE USE A LINK ?
+ AND (400 /IS INDIRECT BIT OFF ?
+ SNA CLA
+ JMP I (MAKLNK /YES, GO MAKE LINK
+ JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE
+ 1122 /*IR*
+THSPAG, TAD EXPVAL+2 /GET ADDRESS
+ AND [177 /LOWER 7 BITS
+ TAD [200 /PUT IN PAGE BIT
+ SKP
+PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
+ TAD OPCODE /PLUS OPCODE
+ JMS I [OUTWRD /OUTPUT WORD
+ JMP I [NEXTST
+NOTIND, TAD CPTMP /RESTORE CHAR POINTER
+ DCA CHRPTR
+ TAD NCTMP
+ DCA NCHARS
+ JMP GETMR /NOT AN INDIRECT>
+\fFPPS4, JMS ADRGET /GET INDEX REG EXPRESSION
+ IFZERO RALF <
+ JMS LITERR /CAN'T ALLOW LITERAL>
+ JMS SUBX /GET RELATIVE INDEX VALUE
+ TAD EXPVAL+2 /GET LOWER 3 BITS
+ AND [7 /OF INDEX REG EXPR
+ TAD OPCODE /WITH OPCODE
+ JMS I [OUTWRD /OUT
+ JMP I [NEXTST
+ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE
+ JMS I [EXPR /GET EXPR
+ JMS I [ERMSG /BAD ADDR EXPR
+ 0230 /*BX*
+ JMP I ADRGET
+ IFZERO RALF <
+LITERR, 0 /GIVE ERROR IF LITERAL
+ TAD LITRL
+ SNA CLA
+ JMP I LITERR
+ JMS I [ERMSG
+ 1114 /*IL*
+ JMP I LITERR >
+ IFNZRO RALF <
+PDP8MR, JMS ADRGET
+ JMP I (CHCKMR /V.56
+ >
+\fGETADR, 0 /GET ADDR, INDEX
+ DCA XITEMP /SAVE INDEX INCREMENT SWITCH
+ JMS ADRGET /GET ADDR
+ DCA FPPSWT /KILL FPP SWITCH
+ IFZERO RALF <
+ JMS LITERR /DISALLOW LITERALS>
+ TAD EXPDEF /IF EXPR WAS UNDEFINED
+ SNA CLA
+ IAC /OR FORCE BIT WAS SET
+ TAD FPP2WD
+ DCA FPPWD2 /FORCE 2 WORD FORMAT
+ DCA XFLAG /ZERO INDEX SWT
+ TAD EXPVAL+1 /SAVE ADDRESS VALUE
+ DCA FPPADR
+ TAD EXPVAL+2
+ DCA FPPADR+1
+ JMS I [GETCHR /LOOK FOR COMMA
+ JMP I GETADR /NO INDEX
+ TAD (-254
+ SZA CLA
+ JMS I [BACK1 /WILL CAUSE A BX ERROR
+ ISZ XFLAG /SET INDEX SWITCH
+ TAD XITEMP /SET INDEX INCREMENT SWITCH
+ DCA XINCR
+ JMS ADRGET
+ ISZ XINCR /CLEAR INDEX INCREMENT SWITCH
+ IFZERO RALF <
+ JMS LITERR >
+ JMS SUBX /CALCULATE INDEX NO
+ JMP I GETADR
+XITEMP,
+SUBX, 0
+ TAD INDXR+1 /CHECK FOR INDEX IN RANGE
+ STL CIA
+ TAD EXPVAL+2
+ DCA EXPVAL+2
+ RAL
+ TAD INDXR
+ CIA
+ TAD EXPVAL+1
+ SZA CLA
+ JMP BIERR
+ TAD EXPVAL+2
+ CLL
+ TAD [-10
+ SZL CLA
+BIERR, JMS I [ERMSG
+ 0211 /*BI*
+ JMP I SUBX
+\f IFNZRO RALF <
+/
+/ AT END OF PASS,
+/ CLEAR LENGTHS OF ALL SECTIONS
+/
+CLRSCT, 0
+ TAD (PNDL+3
+ DCA LTEMP /POINT TO USER SYMBOL SPACE
+ CDF FLD1
+CSLOOP, TAD I LTEMP /GET TYPE
+ AND [37 /STRIP TO TYPE ONLY
+ TAD (-3
+ SPA CLA /IS IT COMMON OR SECTION?
+ JMP NOTSCT /NO, PASS IT
+ ISZ LTEMP /BUMP POINTER TO VALUE
+ TAD I LTEMP
+ AND [7770 /SAVE ESD NUMBER
+ DCA I LTEMP
+ ISZ LTEMP
+ DCA I LTEMP /CLEAR LOW ORDER
+ CLA CLL CMA RAL /-2
+NOTSCT, TAD (6 /BUMP POINTER
+ TAD LTEMP /TO NEXT SYMBOL
+ DCA LTEMP
+ TAD NEXT /COMPARE END OF SYMBOL TABLE
+ CIA CLL
+ TAD LTEMP
+ SNL CLA
+ JMP CSLOOP /MORE TO GO
+ CDF FLD0
+ JMP I CLRSCT /THAS ALL>
+/
+/
+ IFNZRO RALF <
+/
+/ ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE
+/
+NOREL, 0
+ TAD WORD1 /IS SYMBOL RELOCATABLE?
+ AND [7770 /TEST ESD BITS
+ SZA CLA
+ STL RAR /IF SO, FORCE ERROR
+ JMS I (RELERR /TEST SUB EXPR
+ JMP I NOREL
+DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS
+ DCA DPFLG /DP HARDWARE
+ JMP I [NEXTST
+/ SET BASE AND INDEX LOCS
+INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
+BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
+ DCA X12 /HOPEFULLY UNUSED XR
+ JMS I (ADRGET /COLLECT EXPRESSION
+ TAD EXPVAL+1
+ DCA I X12 /HIGH ORDER AND ESD
+ TAD EXPVAL+2
+ DCA I X12 /LOW ORDER
+ JMP I [NEXTST >/THIS CONDITIONAL SASSEMBLY WAS
+/EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO
+/COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP.
+DELFIL, 0
+ TAD [7600
+ DCA OUFILE
+ JMS I [OFNAME
+ CLA IAC
+ CIF 10
+ JMS I USR
+ 4
+ OUFNAM
+ 0
+ NOP
+ JMP I DELFIL
+ PAGE
+\f/
+/ PRINT THE CURRENT LINE IF NOT ALREADY DONE
+/
+PRNTLN, 0 /PRINT THE LINE
+ TAD OUTSWT /HAS THE LINE BEEN PRINTED YET?
+ SZA CLA
+ JMP I PRNTLN /YES, COOL IT
+ ISZ OUTSWT /SET SWITCH
+ TAD BLINE /POINTER TO LINE
+ DCA X13
+ DCA CRLF /CLEAR POSITION COUNT
+ JMP PRLTST /IN CASE OF EMPTY LINE
+PRLNXT, TAD I X13 /GET A CHAR
+ TAD (-211 /WATCH OUT FOR TAB
+ SNA
+ JMP TABIT /CONVERT TO BLANKS
+ TAD (211 /RESTORE
+ ISZ CRLF /BUMP POSITION COUNT
+ JMS I PC /PRINT IT
+PRLTST, ISZ LINSIZ /CHECK COUNT
+ JMP PRLNXT
+ JMP I PRNTLN
+TABIT, TAD [240 /REPLACE TAB WITH BLANKS
+ ISZ CRLF
+ JMS I PC
+ TAD CRLF
+ AND [7
+ SZA CLA
+ JMP TABIT
+ JMP PRLTST
+/
+/ GO TO NEXT LINE
+/
+CRLF, 0
+ CLA
+ TAD (215
+ JMS I PC /PRINT A CHAR
+ TAD (212
+ JMS I PC
+ ISZ LINPAG /FULL PAGE?
+ JMP I CRLF /NO
+ CLA CMA
+ DCA LINPAG
+/
+/ NEW PAGE, WITH HEADING AND PAGE NO
+/
+ TAD PASSNO /IF NOT LISTING PASS
+ SMA SZA CLA
+ TAD LISTSW /OR IF NOT LISTING,
+ SNA CLA
+ JMP I CRLF /DO NOT EJECT
+ TAD RFORMF
+ SZA /DON'T F.F. FIRST TIME
+ JMS I PC /TOP OF PAGE
+ TAD (214
+ DCA RFORMF
+ JMS I (PRTXT /PRINT HEADING
+ TITBUF-1
+ -TITLEN
+ TAD LPAGE1 /FORM FEED COUNT
+ JMS I (DECOUT
+ TAD LPAGE2
+ SNA CLA
+ JMP .+5 /NO SUB PAGE IF 0
+ TAD (255
+ JMS I PC
+ TAD LPAGE2
+ JMS I (DECOUT
+ ISZ LPAGE2
+ TAD (215 /FOR BH
+ JMS I PC
+ TAD (212
+ JMS I PC
+ TAD (-71 /RESET LINE COUNTER
+ DCA LINPAG
+ JMP CRLF+1 /GIVE ANOTHER CRLF
+RFORMF, 0
+/
+/ PRINT TEXT
+/
+PRTXT, 0
+ TAD I PRTXT
+ DCA X13
+ ISZ PRTXT
+ TAD I PRTXT
+ DCA PRTTMP
+ ISZ PRTXT
+ TAD I X13
+ JMS PRINT2
+ ISZ PRTTMP
+ JMP .-3
+ JMP I PRTXT
+PRTTMP= PRNTLN
+/
+PRINT2, 0
+ DCA P2
+ TAD P2
+ JMS I [R6R
+ JMS P1
+ TAD P2
+ JMS P1
+ JMP I PRINT2
+/
+P1, 0
+ AND [77
+ SNA
+ JMP .+4 /PRINT ZERO AS BLANK
+ TAD (-40 /TEST ABOVE OR BELOW 300
+ SPA
+ TAD [100 /ABOVE, MAKE 301 TO 337
+ TAD [240 /IF BELOW, MAKE 240 TO 277
+ JMS I PC /PRINT IT, WHATEVER IT IS
+ JMP I P1
+\f/
+TTYOUT, 0
+ TLS
+ TSF
+ JMP .-1
+TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE
+ TAD (-14 /CTRL/O
+ SZA CLA
+ JMP I TTYOUT
+ TAD .+2
+ DCA TTYOUT+1
+ JMP I TTYOUT
+/
+P2, 0
+/
+ IFZERO RALF <
+TXLNK, TEXT " LINKS"
+TXLLN= .-TXLNK >
+ IFNZRO RALF <
+TXABR, TEXT " ABS REFS"
+TXALN= .-TXABR >
+ PAGE
+\f/
+/ GET AND EVALUATE AN EXPRESSION
+/
+EXPR, 0 /GET EXPRESSION
+ DCA EXPVAL /ZERO EXPR VALUE
+ DCA EXPVAL+1
+ DCA EXPVAL+2
+ CLA IAC
+ DCA EXPDEF /AND TYPE
+ CLA IAC /SET EXPR SWITCH TO NO EXPR
+ DCA EXPSW
+ DCA FPP2WD /SET FORCE SWITCH OFF
+ CLA IAC /SET LASTOP TO +
+ DCA LASTOP
+ IFZERO RALF <
+ JMS I (CHKLIT /GO CHECK FOR LITERAL>
+ JMS I (GETSGN /IGNORE +, BUMP LASTOP IF -
+SYMBOL, JMS I [GETNAM /NOW PICK UP NAME
+ JMP NOSYM /NONE, TRY OTHER
+ JMS I [LOOKUP /LOOK IT UP
+ JMP UNDEF /A NEW ONE
+ IFZERO RALF <
+ JMP ADR /YES >
+ IFNZRO RALF <
+ CLL RAR
+ SNA
+ JMP ADR
+SCTN, TAD I LTEMP /GET TYPE
+ AND (40 /FORCE BIT
+ SZA CLA
+ ISZ FPP2WD /SET FORCE EXPR SW
+ TAD I X10 /GET ESD FROM SYMBOL
+ AND [7770 /ESD ONLY
+ DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO
+ JMP CLR2 /SO CLEAR WORD 2>
+\fNOTDOT, TAD (256-242 /IS IT DBL QUOTE?
+ SZA CLA
+ JMP ENDEXP
+ ISZ NCHARS /IS THERE ANOTHER CHAR?
+ JMP ISQUOT /YES, USE IT
+ENDEXP, JMS I [BACK1 /PUT IT BACK
+ TAD EXPSW /WAS THERE ANY EXPRESSION AT ALL?
+ SZA CLA
+ JMP BAD /NO, DON'T SKIP
+ IFZERO RALF <
+ TAD LITRL /WAS IT A LITERAL REF?
+ SZA CLA
+ JMS I (CRLIT /YES, STICK IT IN THE POOL>
+ TAD LASTOP /TRAILING OPERATOR?
+ SNA
+ JMP OKEXP /NO, ALL IS FINE
+ CLL RAR /IF PLUS OPERATOR
+ TAD XINCR /AND THATS LEGAL
+ SNA CLA
+OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN
+BAD, JMS CKCTC
+ CLA
+ JMP I EXPR /AND RETURN
+/
+NOSYM, JMS I (NUMBER /LOOK FOR A NUMBER
+ JMP ADREXP /USE NUMBER
+ JMS I [GETCHR /NOT A NUMBER, GET A CHAR
+ JMP ENDEXP+1 /NONE LEFT, END
+ TAD (-256 /IS IT "." ?
+ SZA
+ JMP NOTDOT /NO, TRY FOR QUOTE
+ TAD LOCTR1 /THIS WAS LOC SYMBOL
+ DCA WORD1 /PUT VALUE INTO WORD1,2
+ TAD LOCTR2
+ JMP CLR2 /AND USE VALUE
+ISQUOT, DCA WORD1
+ TAD I CHRPTR
+ JMP CLR2
+CKCTC, 0
+ CLA
+ KSF /IF NOTHING AT THE KEYBOARD,
+ JMP I CKCTC /RETURN
+ TAD [200
+ KRS /ELSE, LOOK AT IT
+ TAD (-203 /IS IT CTRL/C?
+ SNA
+ JMP I [7600 /GO TO MOMMA
+ JMP I CKCTC
+\fADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL
+ AND (40
+ SZA CLA
+ ISZ FPP2WD /AND SET SWITCH IF BIT ON
+ TAD I X10 /GET FIRST WORD OF VALUE
+ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0
+ TAD I X10 /GET REST OF SYMBOL
+CLR2, DCA WORD2
+ CDF FLD0 /FIX FIELD
+ADREXP, DCA EXPSW /KILL FIRST TIME SWITCH
+ TAD LASTOP /PICK UP LAST OPERATOR
+ TAD ADROP /MAKE A JMP I
+ DCA .+1
+ 0 /DO IT
+ADROP, JMP I .
+ ADRADD
+ ADRSUB
+ ADRMUL
+ ADRDIV
+ ADRAND
+ ADROR
+ ADROR
+\fUNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ?
+ SNA CLA
+ JMP .+5 /NO, SKIP AROUND
+ TAD I LTEMP /TURN ON FORCE BIT
+ AND (7737 /FOR THIS SYMBOL
+ TAD (40
+ DCA I LTEMP
+ DCA EXPDEF /SET TYPE TO UNDEFINED
+ CDF FLD0 /FIX FIELD
+ DCA EXPSW /KILL FIRST TIME SWITCH
+ JMS I [ERMSG
+ 2523 /*US*
+OPR8R, TAD (OPR8RS-1 /SET POINTER
+ DCA X11 /TO OPERATOR TABLE
+ DCA LASTOP /ZERO LASTOP
+ JMS I [GETCHR /GET CHAR
+ JMP ENDEXP+1 /NONE, DONE
+ DCA EXTMP /SAVE IT
+FINDOP, ISZ LASTOP
+ TAD I X11 /GET NEXT LIST ENTRY
+ SNA
+ JMP NOOPR /ZERO IS END OF LIST
+ TAD EXTMP /COMPARE
+ SZA CLA
+ JMP FINDOP /LOOP
+ JMP SYMBOL /LOOK FOR OPERAND
+NOOPR, DCA LASTOP /NO MATCH FOUND
+ JMP ENDEXP /PUT IT BACK
+ PAGE
+\fADRADD, IFNZRO RALF <
+ TAD WORD1
+ AND [7770 /IF THIS SYMBOL IS RELOCATABLE,
+ SZA CLA /CHECK FOR EXPR VALIDITY
+ JMS I (RELERR >
+ TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS
+ CLL /ZERO LINK
+ TAD WORD2 /ADD LOW WORDS
+ DCA EXPVAL+2 /SAVE RESULT
+ RAL /PUT CARRY INTO BIT 11
+ TAD WORD1 /ORDER WORDS
+ JMP ADRASX /LOOK FOR OPERATOR
+ADRSUB, IFNZRO RALF <
+ TAD WORD1 /IF SYMBOL IS RELOCATABLE
+ AND [7770 /WE MUST COMPARE SECTIONS
+ CIA /IF EQUAL, EXPR BECOMES ABSOLUTE
+ SNA /ELSE, EXPR IS ILLEGAL
+ JMP .+5 /OK, USE EXPVAL ESD
+ JMS I (RELERR /COMPARE: AC DELIBERATELY NON-ZERO
+ TAD EXPVAL+1
+ AND [7 /IF WORD RELOCATABLE, EXP IS ABS
+ DCA EXPVAL+1 >
+ TAD WORD2 /SUBTR LOW 12 BITS
+ CLL CML CIA
+ TAD EXPVAL+2
+ DCA EXPVAL+2 /SAVE LOW HALF
+ RAL
+ TAD WORD1 /SUBTRACT HIGH HALF
+ CIA
+ AND [7 /DO NOT SUBTR ESD'S
+ADRASX, TAD EXPVAL+1
+ AND (7767 /PREVENT CARRY INTO BIT 8
+ADRASY, DCA EXPVAL+1 /SAVE HIGH HALF
+ JMP I (OPR8R /GET OPERATOR
+/INDXX HERE FOR FLAP
+ IFZERO RALF <
+/ SET BASE AND INDEX LOCS
+INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
+BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
+ DCA X12 /HOPEFULLY UNUSED XR
+ JMS I (ADRGET /COLLECT EXPRESSION
+ TAD EXPVAL+1
+ DCA I X12 /HIGH ORDER AND ESD
+ TAD EXPVAL+2
+ DCA I X12 /LOW ORDER
+ JMP I [NEXTST >
+\fADRAND, TAD WORD1 /AND
+ AND EXPVAL+1 /HIGH
+ AND [7 /3 BITS
+ DCA EXPVAL+1 /HALF
+ TAD WORD2 /THEN
+ AND EXPVAL+2 /LOW
+ JMP ADRAOX
+ADROR, TAD WORD1 /OR IS PERFORMED BY
+ CMA /SETTING THE BITS
+ AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A
+ TAD WORD1 /AND THEN SETTING THE BITS
+ AND [7
+ DCA EXPVAL+1 /THAT ARE ON IN A
+ TAD WORD2
+ CMA
+ AND EXPVAL+2
+ TAD WORD2
+ADRAOX, DCA EXPVAL+2
+ IFNZRO RALF <
+ JMS I (NOREL /**>
+ JMP I (OPR8R /GET NEXT OPERATOR
+/
+\fADRMUL, TAD WORD2 /**RL CODE
+ CIA
+ DCA EXPVAL+1 /MULT BY
+ TAD EXPVAL+2 /REPEATED ADDITIONS
+ ISZ EXPVAL+1
+ JMP .-2
+ JMP ADRAOX
+ADRDIV, DCA WORD1
+ DCA EXPVAL+1
+ TAD WORD2
+ SNA CLA
+ JMP DIVERR
+ TAD EXPVAL+2
+ CIA CLL
+ TAD WORD2
+ SZL
+ JMP .+3 /DIVIDE BY
+ ISZ WORD1 /COUNTING SUBTRACTIONS
+ JMP .-4
+ CLA
+ TAD WORD1
+ JMP ADRAOX
+\fDIVERR, JMS I [ERMSG
+ 0626 /*DV*
+ JMP I (OPR8R /CONTINUE
+\fPDPOPR, TAD CHRPTR
+ DCA CPTMP
+ TAD NCHARS
+ DCA NCTMP
+ JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST
+ JMP TRYEXP /NONE
+ TAD (33 /USE INTERNAL TABLE
+ JMS I [FIND /IS IT THERE ?
+ JMP TRYEXP /NO
+ TAD (-PDPOP /IS IT AN OPERATE ?
+ SZA CLA
+ JMP TRYEXP /NO
+ TAD I X10 /GET VALUE
+ CDF FLD0
+ DCA EXPVAL+2
+PDPOR, TAD EXPVAL+2
+ CMA /OR THEM TOGETHER
+ AND OPCODE
+ TAD EXPVAL+2
+ DCA OPCODE
+ JMS I [GETCHR /MORE CHARS ?
+ JMP I (FPPS3 /NO-DONE
+ TAD [-240 /BLANK ?
+ SNA CLA
+ JMP PDPOPR /YES-PROCESS NEXT
+ JMP I (BADEXP
+TRYEXP, CDF FLD0
+ TAD CPTMP
+ DCA CHRPTR
+ TAD NCTMP
+ DCA NCHARS
+ ISZ NCTMP
+ SKP
+ JMP I (FPPS3
+ JMS I [EXPR
+ JMP I (BADEXP
+ JMP PDPOR
+TXSYM, TEXT " SYMBOLS,"
+ TXSLN=.-TXSYM
+ PAGE
+\f IFZERO RALF <
+/
+/ LITERAL THINGS
+/
+CHKLIT, 0 /CHECK FOR LITERAL
+ DCA PAGENO /ZERO PAGE NUMBER
+ DCA LITRL
+ JMS I [GETCHR /GET CHARACTER
+ JMP I CHKLIT /NO LITERAL
+ TAD (-250 /CHECK FOR (
+ SNA
+ ISZ PAGENO /CURRENT PAGE LITERAL
+ SZA /SKIP IF ALREADY ZERO
+ TAD (-63 /CHECK FOR [
+ SNA
+ ISZ LITRL /SET SWITCH
+ SZA CLA
+ JMS I [BACK1 /PUT BACK NON ([
+ JMP I CHKLIT
+/
+/ CREATE A LINK FOR OFF-PAGE REFERENCE
+/
+MAKLNK, TAD (THSPAG /PROPER RETURN ADDR
+ DCA CRLIT
+ TAD OPCODE /SET INDIRECT BIT
+ TAD (400
+ DCA OPCODE
+ CLA IAC
+ DCA PAGENO /SET INDICATOR
+ ISZ LINKS /COUNT ANOTHER LINK GENERATED
+ ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT
+ JMP NOTP0
+CRLIT, 0 /CREATE LITERAL
+ /VALUE:EXPVAL, IN PAGE:PAGENO
+ TAD PAGENO /CHECK FOR PAGE 0
+ SNA CLA
+ JMP ISP0 /PAGE 0 LITERAL
+NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER
+ DCA LITBAS
+ TAD LOCTR2 /CHECK FOR LIT BUFFER FULL
+ AND [100
+ SNA CLA
+ JMP DOLIT-1 /USE 77 AS LIMIT
+ TAD LOCTR2
+ AND [177
+ JMP DOLIT /USE CURRENT ADDR AS LIMIT
+\fISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER
+ DCA LITBAS
+ TAD [77 /ASSUME FIRST 64 WORDS USED
+DOLIT, DCA NWUSED
+ TAD PAGENO /GET POINTER TO
+ TAD [P0LIT /LITERAL BOUNDARY
+ DCA XPAGE
+ TAD I XPAGE /DISPLACEMENT OF LIT BUFR - 1
+ DCA LITPTR /INTO LITPTR
+NOTIT, TAD LITPTR /POINTER+SIZE
+ TAD (-177 /SHOULD BE LESS THAN 177
+ SMA CLA
+ JMP NEWLIT /ENTER NEW LITERAL
+ TAD LITPTR /NOW GET POINTER
+ TAD LITBAS /TO TABLE
+ DCA X11 /FOR COMPARISON
+ ISZ LITPTR /INCREMENT POINTER
+ TAD I X11 /GET WORD OF LITERAL
+ CIA
+ TAD EXPVAL+2 /COMPARE PROTOTYPE
+ SZA CLA
+ JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY
+LITADR, TAD PAGENO /PAGE 0 ?
+ SZA CLA
+ TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS
+ AND [7600
+ TAD LITPTR /PLUS PAGE DISPLACEMENT
+ DCA EXPVAL+2 /INTO VALUE
+ TAD LOCTR1
+RETLIT, DCA EXPVAL+1
+ JMP I CRLIT
+\fNEWLIT, CLA CMA
+ TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN
+ DCA X10 /ADDRESS OF NEW LITERAL
+ TAD NWUSED /CHECK FOR PAGE OVERFULL
+ CIA
+ TAD X10
+ SMA CLA
+ JMP .+5 /NOT FULL
+ JMS I [ERMSG /*PO*
+ 2017
+ DCA EXPVAL+2 /ZERO ADDRESS
+ JMP RETLIT
+ TAD X10
+ DCA I XPAGE
+ TAD I XPAGE /SET UP POINTER FOR MOVE
+ TAD LITBAS
+ DCA X10
+ TAD EXPVAL+2 /MOVE LITERAL IN
+ DCA I X10
+ TAD I XPAGE /SET UP LITERAL ADDRESS
+ IAC
+ DCA LITPTR
+ JMP LITADR /RETURN LITERAL ADDRESS
+LITBAS, 0
+NWUSED, 0
+LITPTR, 0
+PAGENO, 0
+XPAGE, 0
+ PAGE />
+\f/
+/ FIND SYMBOL TABLE ENTRY
+/ FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3
+/ SKIP IF FOUND WITH TYPE IN AC
+/
+FIND, 0 /SYMBOL TABLE LOOKUP
+ TAD BUCKET /GET BUCKET ADDRESS
+ CDF FLD1 /GO TO FIELD 1
+LOOK, DCA OLDN3 /THIS IS PTR OF PREV ENTRY
+ TAD I OLDN3 /THIS IS ADR OF NEXT ENTRY
+ SNA /IF ZERO, THEN
+ JMP I FIND /IT AIN'T HERE
+ DCA X10 /SAVE NEXT NAME PTR
+ TAD NAME1 /COMPARE NAMES
+ CIA CLL
+ TAD I X10 /WORD 1
+ SZA CLA
+ JMP NOTSAM
+ TAD NAME2
+ CIA CLL
+ TAD I X10 /WORD2
+ SZA CLA
+ JMP NOTSAM
+ TAD NAME3
+ CIA CLL
+ TAD I X10 /COMPARE LAST CHAR
+ AND [7700 /HIGH HALF ONLY
+ SZA CLA
+ JMP NOTSAM
+ ISZ FIND /IF FOUND BUMP RETURN
+ TAD X10
+ DCA LTEMP /ADDR OF TYPE WORD
+ TAD I LTEMP /GET TYPE INTO AC
+ AND [37 /WITHOUT FORCE BIT
+ JMP I FIND /RETURN
+NOTSAM, SZL CLA /IS NAME 1,2,3 .LT. ENTRY
+ JMP I FIND /YES, IT ISN'T HERE
+ TAD I OLDN3 /GET ADDR OF LINK INTO AC
+ JMP LOOK /LOOP
+\f/
+/ FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT
+/
+LOOKUP, 0
+ JMS FIND
+ JMP .+4
+ SZA
+ ISZ LOOKUP /SKIP RETURN IF DEFINED
+ JMP I LOOKUP /RETURN TYPE CODE
+ TAD I OLDN3 /GET FORWARD LINK TO
+ DCA I NEXT /NEXT ENTRY INTO NEW ENTRY
+ TAD NEXT /PUT FORWARD LINK TO NEW
+ DCA I OLDN3 /ENTRY INTO PREVIOUS ENTRY
+ TAD NAME1 /PUT IN NAME
+ DCA I NEXT
+ TAD NAME2
+ DCA I NEXT
+ TAD NAME3
+ DCA I NEXT
+ TAD NEXT /X10=NEXT
+ DCA X10
+ TAD NEXT /LTEMP=NEXT
+ DCA LTEMP
+ DCA I NEXT /INITIAL VALUE IS ZERO
+ DCA I NEXT
+ TAD NEXT /CHECK FOR TABLE FULL
+ CLL
+ TAD [200 /GONNA OVERFLO PS8?
+ SNL CLA
+ JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP)
+ JMS I [ERMSG1
+ 2324 /*ST*
+\f/
+/ COLLECT AN INTEGER IN THE CURRENT RADIX
+/
+NUMBER, 0 /GET INTEGER NUMBER (NO SIGN)
+ DCA NSWTCH /CLEAR SWITCH
+ DCA NOFLO /CLEAR OVRFLO SW
+ DCA WORD1 /CLEAR 24 BIT NUMBER
+ DCA WORD2
+NUMLUP, JMS I (DIGIT
+ JMP NODGT /TOO BAD
+ DCA NUM /YES, SAVE IT
+ TAD WORD1 /SAVE CURRENT VALUE
+ DCA NUM1 /OF NUMBER
+ TAD WORD2
+ DCA NUM2
+ JMS SHIFT /SHIFT WORD1,2, LEFT 1 (MULT BY 2)
+ JMS SHIFT /DO IT AGAIN (MULT BY 4)
+ TAD RADIX /LOOK AT RADIX (1=DECIMAL)
+ SNA CLA
+ JMP OCTNUM /ITS OCTAL
+ CLL /DECIMAL, ADD IN NUMBER
+ TAD NUM2
+ TAD WORD2 /THUS MULTIPLYING BY 5
+ DCA WORD2
+ RAL
+ TAD NUM1
+ TAD WORD1
+ DCA WORD1
+ JMP ADDDGT
+OCTNUM, TAD NUM
+ AND [7770 /CHECK FOR 8 OR 9
+ SZA CLA
+ ISZ NOFLO /SET ERROR FLAG
+ADDDGT, JMS SHIFT /SHIFT LEFT 1 AGAIN, THUS
+ TAD WORD2 /MULTIPLYING BY 8 OR 10
+ CLL /THEN ADD IN NEW DIGIT
+ TAD NUM
+ DCA WORD2
+ RAL
+ TAD WORD1
+ DCA WORD1
+ SZL /BEWARE OF OVERFLO
+ ISZ NOFLO
+ JMP NUMLUP /LOOP
+\fNODGT, TAD NSWTCH /WAS THERE A NUMBER
+ SNA CLA
+ ISZ NUMBER /NO, SKIP
+ TAD WORD1
+ AND [7770 /CHECK FOR MORE THAN 15 BITS
+ SNA
+ TAD NOFLO /OR GROSS OVERFLOW
+ SNA CLA
+ JMP I NUMBER /ALL GREEN
+ JMS I [ERMSG
+ 1605 /*NE*
+ JMP I NUMBER /RETURN
+NOFLO= LOOKUP /ZERO IF NO ERRORS
+NUM= FIND
+NUM1= EXTMP
+NUM2= EXTMP2
+NSWTCH, /ZERO IF NO DIGITS
+SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1
+ TAD WORD2
+ CLL RAL
+ DCA WORD2
+ TAD WORD1
+ RAL
+ DCA WORD1
+ SZL /IF BIT SHIFTED FROM HI WORD,
+ ISZ NOFLO /SET ERROR FLAG
+ JMP I SHIFT
+ PAGE
+\f/
+/ BACK UP GETCHR POINTERS,
+/ WE DON'T WANT THIS ONE
+/
+BACK1, 0
+ CLA CMA /BACKUP COUNT
+ TAD NCHARS
+ DCA NCHARS
+ CLA CMA /AND POINTER
+ TAD CHRPTR
+ DCA CHRPTR
+ JMP I BACK1
+/
+/ GET NEXT CHAR FROM LINE BUFFER
+/ FOR ASSEMBLY PURPOSES ONLY
+/ SKIP UNLESS END OF LINE (CR, ;, OR /)
+/
+GETCHR, 0
+ JMS GETAC
+GETSKP, ISZ GETCHR /SKIP RETURN
+ JMP I GETCHR
+BLANK, JMS GETAC /COME HERE IF BALNK OR TAB
+ TAD (-257 /END OF LINE ON SLASH AFTER BLANK
+ SNA CLA
+ JMP GETCND
+ JMS BACK1 /PUT IT BACK
+ TAD [240 /AND RETURN A SINGLE BLANK
+ JMP GETSKP /SKIP OUT
+SEMICL, ISZ SCSWT
+ JMS BACK1 /PUT BACK SEMI COLON
+ JMP I GETCHR
+GETAC, 0
+ ISZ NCHARS /END OF LINE?
+ JMP .+4 /NO, GET IT
+GETCND, CLA CMA /YES, RESET IN CASE OF
+ DCA NCHARS /ANOTHER CALL
+ JMP I GETCHR /RETURN END OF LINE
+ TAD I CHRPTR /PICK UP NEXT
+ TAD [-240 /CHECK FOR BLANK
+ SZA
+ TAD (240-211 /OR TAB
+ SNA
+ JMP BLANK /THEY GET SPECIAL HANDLING
+ TAD (211-273 /LOOKOUT FOR SEMICOLON
+ SNA
+ JMP SEMICL /ALSO SPECIAL
+ TAD (273-276 /IGNORE CLOSE ANGLE BRACKET
+ SNA
+ JMP GETAC+1 /GET ANOTHER
+ TAD (276 /ELSE, RESTORE CHAR
+ JMP I GETAC /AND PASS IT BACK
+\f/
+/ COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3
+/ NO SKIP ON RETURN IF NO SYMBOL
+/
+GETNAM, 0
+ DCA NAME1 /CLEAR SYMBOL SPACE
+ DCA NAME2
+ DCA NAME3
+ JMS LETTER /GET A LETTER
+ JMP ISSYM
+ JMS GETCHR /CHECK FOR #
+ JMP I GETNAM /NOPE
+ TAD (-"#
+ SNA CLA
+ JMP ISSYM
+ JMS BACK1
+ JMP I GETNAM
+ISSYM, DCA BUCKET
+ ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE
+ JMS GNC /FRIENDLY LOCAL SUBR
+ JMS R6L
+ DCA NAME1
+ JMS GNC
+ TAD NAME1
+ DCA NAME1
+ JMS GNC
+ JMS R6L
+ DCA NAME2
+ JMS GNC
+ TAD NAME2
+ DCA NAME2
+ JMS GNC
+ JMS R6L
+ DCA NAME3
+ JMS GNC /AFTER 6, WE IGNORE
+ SKP CLA
+GNC, 0
+ JMS LETTER
+ JMP I GNC /RETTURN LETTER
+ JMS DIGIT
+ JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER
+ TAD (60
+ JMP I GNC
+\f/
+/ IF NEXT CHAR IS A LETTER, RETURN 6 BITS
+/ IF NOT, REPLACE CHAR AND SKIP.
+/
+LETTER, 0
+ JMS GETCHR
+ JMP NLETR /NO LETTER, SKIP
+ TAD (-333
+ CLL CML
+ TAD (33
+ SZA SNL /DON'T ALLOW 300
+ JMP I LETTER
+ JMS BACK1
+NLETR, ISZ LETTER
+ JMP I LETTER
+/
+/ IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
+/
+DIGIT, 0
+ JMS GETCHR
+ JMP I DIGIT
+ TAD (-272
+ CLL
+ TAD (12
+ SNL
+ JMP NDIGT
+ ISZ DIGIT
+ JMP I DIGIT
+NDIGT, JMS BACK1
+ JMP I DIGIT
+/
+R6L, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I R6L
+/
+R6R, 0
+ RTR
+ RTR
+ RTR
+ AND [77
+ JMP I R6R
+ PAGE
+\f/
+/ BUILD AN INSTRUCTION
+/
+FIXOPC, 0 /COMBINE OPCODE PARTS
+ TAD XFLAG /CHECK INDEX SWITCH
+ SNA CLA
+ JMP ZRONDX /IF ZERO, NO INDEX REG
+ CLA CMA
+ TAD LASTOP /IF INDEX, CHECK FOR INCR
+ SNA CLA
+ TAD [100 /YES, PUT + BIT ON
+ TAD OPCODE /COMBINE WITH OPCODE
+ DCA OPCODE
+ TAD EXPVAL+2 /GET INDEX REG. EXPR
+ AND [7 /ONLY 3 BITS
+ CLL RTL /SHIFT INTO POSITION
+ RAL
+ZRONDX, TAD OPCODE /ADD OPCODE
+ TAD (400 /TURN ON TYPE BIT
+ DCA OPCODE /SAVE OPCODE
+ JMP I FIXOPC /RETURN
+/
+OPR8RS,
+ -253 /PLUS
+ -255 /MINUS
+ -252 /STAR (MULTIPLY) **
+ -257 /SLASH (DIVIDE)
+ -246 /AMPERSAND (AND)
+ -240 /SPACE (OR)
+ -241 /EXCLAMATION (OR)
+ 0 /END OF LIST
+\f/
+/ FATAL ERRORS
+/
+ERMSG1, 0 /PASS 1 (FATAL) MESSAGES
+ CDF
+ TAD I ERMSG1 /GET CODE
+ DCA .+3
+ DCA PASSNO
+ JMS ERMSG /DO THE MSG THING
+ 0
+ IFZERO RALF <
+RETSYS, >
+ TSF /FINISH TYPING
+ JMP .-1
+ JMP I [7600 /EXIT TO PS8
+/
+/ GENERAL GARBAGE TYPE ERRORS
+/
+ERMSG, 0
+ CDF FLD0 /FIX FIELD
+ CLA /NO MESSAGE ON PASS 1
+ TAD PASSNO
+ SMA SZA /IF PASS 3, OUTPUT LEADING CRLF
+ JMS I [CRLF
+ SPA CLA
+ JMP MSGDUN
+ TAD (5555 /MINUSES
+ JMS I [PRINT2
+ TAD I ERMSG /2-CHAR CODE
+ JMS I [PRINT2 /PRINT THE MESSAGE
+ TAD (5555
+ JMS I [PRINT2
+ TAD PASSNO
+ SZA CLA
+ JMP .+4
+ JMS I [PRINT2
+PLINE, JMS I (PRNTLN
+ JMS I [CRLF
+ ISZ ERRORS /BUMP COUNT
+MSGDUN, ISZ ERMSG
+ JMP I ERMSG
+\f/
+/ OUTPUT DECIMAL
+/ SUPPRESS LEADING ZEROS
+/ PRINT "NO" INSTEAD OF "0"
+/
+DECOUT, 0
+ SNA /ZERO IS SPECIAL
+ JMP DECNO /NO INSTEAD OF 0
+ DCA OTEMP
+ DCA OCNT
+ JMS DEC2 /GET THOUSANDS
+ -1750
+ JMS DEC2 /HUNDREDS
+ -144
+ JMS DEC2 /TENS
+ -12
+ TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE)
+ JMS PDIG /PRINT LAST DIGIT
+ JMP I DECOUT /EASY, WHEN YOU KNOW HOW
+/
+DECNO, TAD (1617 /NO
+ JMS I [PRINT2
+ JMP I DECOUT
+/
+/ LAZY MAN'S DIVISION
+/
+DEC2, 0
+ CDF FLD0 /JUST TO MAKE SURE
+DEC3, CLA CLL
+ TAD OTEMP
+ SNA
+ JMP DEC4
+ TAD I DEC2 /SUBTRACT DIVISOR
+ SNL /TOO MUCH?
+ JMP DEC4 /YES, STOP NOW
+ DCA OTEMP /NO, SAVE NEW REMAIN
+ ISZ OCNT /BUMP QUOTIENT
+ JMP DEC3 /DO IT AGAIN
+DEC4, CLA
+ ISZ DEC2 /SKIP RETURN
+ TAD OCNT /CHECK FOR SIGNIFICANCE
+ SNA
+ JMP I DEC2 /NONE
+ JMS PDIG
+ CLA STL RAR /FORCE SIGNIFICANCE
+ DCA OCNT
+ JMP I DEC2
+\f/
+TENTH, -111
+ 1463;1463;1463
+ 1463;1463;1463
+TEN, 1
+PDIG, 0
+ TAD P260
+ JMS I PC
+ JMP I PDIG
+P260, 260
+ 5
+/
+/ OCTAL CONVERSION, THE HARD WAY
+/
+OCTOUT, 0
+ DCA OTEMP
+ STL RAR /NO ZERO SUPPRESS
+ DCA OCNT
+ JMS DEC2
+ -1000
+ JMS DEC2
+ -100
+ JMS DEC2
+ -10
+ TAD OTEMP
+ JMS PDIG
+ JMP I OCTOUT
+ PAGE
+\f/
+/ OUTPUT ONE WORD
+/
+ IFNZRO RALF <
+/
+/ TEXT TYPE CODES:
+TTABS= 0400
+TTORG= 1000
+TTREL= 1400
+/
+OUTREL, DCA WRD /HOLD FIRST WORD
+ DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR
+ TAD FPPADR /GET ESD CODE
+ RTR
+ RTR /RIGHT IN AC
+ AND [177 /STRIP TO ESD ONLY
+ SNA /CHECK FOR ABSOLUTE
+ JMP PUTABS
+ DCA FPPADR /SAVE ESD
+ TAD PASSNO /CHECK FOR PASS 2
+ SZA CLA
+ JMP PRNTRL /IF NOT, TREAT NORMALLY
+ DCA ABSOP
+ CLA STL RTL
+ JMS I (FULCHK /ENSURE 3 WORDS LEFT
+ TAD FPPADR /GET ESD AGAIN
+ TAD (TTREL /INSERT CONTROL CODE
+ DCA I OUTPTR
+ TAD WRD /FIRST DATUM
+ DCA I OUTPTR
+ TAD FPPADR+1
+ DCA I OUTPTR
+ JMS I (FULCHK /IS IT FULL?
+ JMS BMPLOC /TWO WORDS OUT
+ JMS BMPLOC /SO LOCCTR +2
+ JMP I [NEXTST
+PUTABS, ISZ ABREFS /COUNT IT
+ ISZ LINKSW /SET FLAG
+PRNTRL, TAD WRD /GET FIRST WORD
+ JMS OUTWRD
+ TAD FPPADR+1
+ JMS OUTWRD
+ JMP I [NEXTST >
+\f/
+OUTWRD, 0 /OUTPUT ROUTINE
+ DCA WRD /SAVE WORD
+ IFZERO RALF <
+ TAD LOCTR2 /GET LOW 12 BITS OF LOCATION
+ JMS I [R6L
+ AND [37 /GET PAGE NUMBER (WITHIN FIELD)
+ DCA OTEMP /SAVE PAGE NUMBER
+ TAD OTEMP
+ SZA CLA /POINTER TO LITERAL POINTER
+ IAC
+ TAD [P0LIT
+ DCA OWTEMP
+ TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT
+ AND [177
+ CIA /COMPARE WITH LITERAL BOUNDARY
+ TAD I OWTEMP
+ SMA CLA
+ JMP .+3 /NO PAGE OVER FLOW
+ JMS I [ERMSG
+ 2017 /*PO*>
+ TAD PASSNO /CHECK PASS
+ SZA
+ JMP PRNTST /ITS NOT PASS 2
+ IFZERO RALF <
+ TAD WRD /NOW OUTPUT WORD
+ JMS I [R6R
+ JMS OOCHAR
+ TAD WRD
+ AND [77
+ JMS OOCHAR >
+ IFNZRO RALF <
+ TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT
+ SZA CLA
+ JMP INABS /NO PROBLEM
+ CLA IAC
+ JMS I (FULCHK
+ TAD (TTABS /SET ABS CONTROL CODE
+ DCA I OUTPTR
+ TAD OUTPTR /SAVE POINTER FOR FUTRUE REF
+ DCA ABSOP
+INABS, ISZ I ABSOP /BUMP COUNT
+ TAD WRD
+ DCA I OUTPTR
+ JMS I (FULCHK /GOOD!>
+\fPRNTST, SMA SZA CLA
+ TAD LISTSW /IS LIST ON ?
+ SNA CLA
+ JMP ENDOUT /NO, DONT PRINT
+ JMS I [CRLF /NEW LINE
+ TAD LOCTR1 /PRINT LOCATION COUNTER
+ AND [7
+ JMS I (PDIG
+ TAD LOCTR2 /NEXT FOUR DIGITS
+ JMS I [OCTOUT
+ TAD [240
+ JMS I PC
+ TAD WRD /NOW WORD
+ JMS I [OCTOUT
+ TAD LINKSW /LINK GENERATED ON THIS LINE?
+ SZA CLA
+ TAD (4700 /IF SO, GIVE APOSTROPHE SPACE
+ JMS I [PRINT2
+ DCA LINKSW /CLEAR SW
+ JMS I (PRNTLN /PRINT LINE IF NECESSARY
+ENDOUT, JMS BMPLOC /BUMP LOC CNTR
+ JMP I OUTWRD /RETURN
+/
+WRD,
+BMPLOC, 0
+ ISZ LOCTR2 /BUMP LOW ORDER
+ JMP I BMPLOC
+ CLA IAC
+ TAD LOCTR1
+ AND (7767 /STOP CARRY INTO BIT 8
+ DCA LOCTR1
+ JMP I BMPLOC
+\f IFZERO RALF <
+/
+/ PUNCH CONTROL
+/
+NOPNCX, CLA IAC
+ENPNCX, DCA PNCHOF
+ JMP I [NEXTST
+/
+/ OUTPUT AN ORIGIN
+/
+PUTORG, 0
+ TAD PASSNO /CHECK FOR PASS 2
+ SZA CLA
+ JMP I PUTORG /ELSE FORGET IT
+ TAD LOCTR2 /OUTPUT FIRST CHAR
+ JMS I [R6R
+ TAD [100
+ JMS OOCHAR /OUTPUT CHAR
+ TAD LOCTR2 /NOW LOWER HALF OF ORIGIN
+ AND [77
+ JMS OOCHAR
+ JMP I PUTORG
+OWTEMP,
+CHAROO, 0
+OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM
+ DCA CHAROO
+ TAD PNCHOF /PUNCHING?
+ SZA CLA
+ JMP I OOCHAR /NOPE
+ TAD CHAROO
+ TAD CHKSUM
+ DCA CHKSUM
+ TAD CHAROO
+ JMS I [OCHAR
+ JMP I OOCHAR >
+\f/
+/ BEGIN NEXT PASS
+/ WITH APPROPRIATE THINGS RESET
+/ TO DEFAULT VALUES
+/
+RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE
+ TAD USR /EITHER 200 OR 7700
+ SPA CLA /IS USR IN CORE?
+ JMP .+6 /NO
+ CIF 10 /YES, DISMISS IT
+ JMS I USR
+ 11 /USROUT
+ TAD [7700
+ DCA USR /ITS GONE
+ IFNZRO RALF <
+ CLA STL RTL /COUNTING FROM 2,
+ DCA ESDNO /RESET ESD COUNT
+ JMS I (CLRSCT /ZERO ALL SECTION LENGTHS>
+ DCA ASMOF /ZERO CONDITIONAL SWITCH
+ DCA SCSWT /ZERO SEMICOLON SWITCH
+ TAD SYONLY /IF NOT SYM MAP ONLY
+ DCA LISTSW /FORCE LIST ENABLE
+ CLA IAC
+ DCA LPAGE1
+ DCA LPAGE2
+ CLA CMA
+ DCA LINPAG
+ IFZERO RALF <
+ TAD [177
+ DCA P0LIT /RESET LITERAL BUFFER POINTERS
+ TAD [177
+ DCA CPLIT
+ TAD [200 >
+ DCA LOCTR2 /LOCATION COUNTER
+ IFNZRO RALF <
+ TAD (20 >
+ DCA LOCTR1
+ CLL CML RAR /4000
+ DCA BASER /SET BASE BEYOND BELIEF
+ DCA INDXR
+ DCA INDXR+1
+ DCA RADIX /RESET DEFAULT OCTAL
+ DCA ERRORS /ZERO ERROR COUNT
+ DCA LINKS
+ ISZ PASSNO /BUMP PASS NUMBER
+ JMP I (NEWLIN
+ JMP I (NEWLIN /DO NEXT PASS
+ PAGE
+\f/
+/ END OF A PASS
+/
+ENDX, IFZERO RALF <
+ DCA PNCHOF /RE-ENABLE PUNCH>
+ IFNZRO RALF <
+ JMS I (BORG /SET MAX LEN OF CURRENT SECT>
+ TAD PASSNO
+ SMA CLA /WHAT PASS WAS THIS?
+ JMP EOP2 /NOT THE FIRST
+ IFNZRO RALF <
+ TAD (INBUF-400
+ DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD>
+ TAD BFILE
+ SNA CLA
+ JMP START3 /NO BINARY, START PASS 3
+ IFZERO RALF <
+ TAD [200 /START BIN OUT WITH L/T
+ JMS I [OCHAR
+ JMP I (RESET >
+ IFNZRO RALF <
+ JMP I (DMPESD /OUTPUT EXT SYM TABLE>
+/
+EOP2, IFZERO RALF <
+ CLA IAC /DUMP CURRENT PAGE LITERALS
+ JMS I (DMPLIT
+ JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS>
+ TAD PASSNO
+ SMA SZA CLA
+ JMP EOP3 /YES, PRINT SYMBOL TABLE
+ IFZERO RALF <
+ TAD CHKSUM /OUTPUT CHECKSUM
+ JMS I [R6R
+ JMS I [OCHAR
+ TAD CHKSUM
+ AND [77
+ JMS I [OCHAR /LOWER HALF
+ TAD [200 /TRAILER CHAR
+ JMS I [OCHAR >
+ IFNZRO RALF <
+ DCA I OUTPTR /SET OUTPUT END INDICATOR>
+ JMS I (OCLOSE /CLOSE THE BINARY FILE
+START3, DCA PASSNO /SKIP PASS TWO
+ JMS I (OOPEN /OPEN LISTING FILE
+ IFZERO RALF <
+ JMP NOP3 /NO LISTING, GIVE INFO ON TTY>
+ IFNZRO RALF <
+ JMP I (RETSYS >
+ TAD [OCHAR /CHANGE PRINT ROUTINE
+ DCA PC
+ JMP I (RESET /NO,RESET EVERYTHING
+\f/
+/ END OF LAST PASS
+/ GIVE SOME STATISTICS
+/
+EOP3, CLA CMA
+ DCA LINPAG
+ JMS I [CRLF
+NOP3, JMS I (7607 /READ IN OVERLAY
+ 0100
+OVERLY, OVBUFR
+ 40 /USE SYS SCRATCH BLK
+ JMP I (7605
+ JMP I OVERLY
+
+CHCKMR, 0
+ TAD OPCODE /BE SURE ALL REFS ARE
+ AND [200 /ARE ON SAME PG
+ SZA CLA
+ TAD LOCTR2
+ AND [7600
+ CIA
+ TAD EXPVAL+2
+ AND [7600
+ SZA CLA
+ADRERR, JMS I [ERMSG
+ 0201 /**BA**
+ TAD EXPVAL+2
+ AND [177
+ TAD OPCODE
+ JMS I [OUTWRD
+ JMP I [NEXTST
+
+IOERR, TAD INOP /REMOVE JMS PRNTLN
+ DCA PLINE
+ JMS I [ERMSG1
+ 1117 /**IO**
+INOP, NOP
+
+ PAGE
+\f IFZERO RALF <
+/ ORG THINGS FOR ABSOLUTE ASSEMBLIES
+/
+TRYSTR, JMS I [GETCHR
+ JMP I [NEXTST /WHAT CAN YOU DO?
+ TAD (-252 /IS IT AN ORG
+ SZA CLA
+ JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE
+ORGX, JMS I (ADRGET
+ TAD LOCTR1 /CHECK FOR NEW FIELD
+ CIA
+ TAD EXPVAL+1
+ SNA CLA
+ JMP SAMFLD /NOT A DIFFERENT FIELD
+ CLA IAC
+ JMS DMPLIT /DUMP CURRENT PAGE LITERALS
+ JMS DMPLIT /DUMP PAGE 0 LITERALS
+ TAD EXPVAL+1
+ AND [7
+ DCA LOCTR1
+ TAD PNCHOF /PUNCHING ENABLED?
+ SNA
+ TAD PASSNO /PASS 2?
+ SZA CLA
+ JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD
+ TAD LOCTR1 /NEW FIELD BITS
+ RTL CLL
+ RAL
+ TAD (300 /TURN ON THE LEFT TWO BITS
+ JMS I [OCHAR /PUT IT OUT (NOT IN CHECK SUM)
+ JMP SAMPAG /DO THE SAME FOR CURRENT PAGE
+SAMFLD, TAD LOCTR2
+ AND [7600 /CHECK FOR SAME PAGE
+ DCA LTEMP
+ TAD EXPVAL+2
+ AND [7600
+ CIA
+ TAD LTEMP
+ SNA CLA
+ JMP SAMPAG /PAGE IS THE SAME
+ CLA IAC
+ JMS DMPLIT /DUMP CURRENT PAGE LITERALS
+SAMPAG, TAD EXPVAL+2
+ DCA LOCTR2
+ JMS I (PUTORG
+ JMP I [NEXTST /DONE
+PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE
+ CLL
+ TAD [177
+ AND [7600
+ DCA EXPVAL+2
+ RAL
+ TAD LOCTR1
+ DCA EXPVAL+1
+ JMP ORGX+1 /DO ORG THINGS
+\fDMPLIT, 0
+ DCA PAGEN /SAVE PAGE INDICATOR
+ TAD OUTSWT /SAVE OUTPUT SWITCH
+ DCA SWTOUT
+ ISZ OUTSWT /DONT PRINT LINE WITH LITERALS
+ TAD PAGEN
+ TAD [P0LIT /GET BOUNDARY POINTER
+ DCA LTEMP
+ TAD PAGEN /WHICH LITERAL BUFFER ?
+ SNA CLA
+ TAD (P0LBUF-CPLBUF /PAGE 0 BUFFER
+ TAD (CPLBUF /CURRENT PAGE BUFFER
+ TAD I LTEMP /PLUS PAGE ADDRESS
+ DCA X10 /GIVES START OF LITERALS -1
+ TAD PAGEN
+ SZA CLA
+ TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS
+ AND [7600
+ TAD I LTEMP /PLUS LOWER SEVEN
+ IAC /PLUS ONE
+ DCA LOCTR2 /GIVES LOCATION COUNTER
+ TAD LOCTR2
+ AND [177 /ANYTHING TO DUMP?
+ SNA CLA
+ JMP DMPFIN /NO
+ TAD PASSNO
+ SMA SZA CLA
+ JMS I [CRLF /ONLY IF PASS 3
+ JMS I (PUTORG
+ TAD [177 /STORE SPURIOUS LITERAL BOUNDARY
+ DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES
+LITLUP, TAD I X10 /NO, GET NEXT LITERAL
+ JMS I [OUTWRD /OUTPUT WORD AND BUMP LC
+ TAD X10 /DONE?
+ IAC
+ AND [77
+ SZA CLA
+ JMP LITLUP /LOOP
+DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH
+ DCA OUTSWT
+ JMP I DMPLIT /ALL DONE
+SWTOUT, 0 >
+\fEXPON, TAD LASTOP
+ DCA TMP
+ DCA LASTOP
+ JMS I (GETSGN /GET SIGN OF EXPONENT
+ TAD RADIX
+ DCA OTEMP
+ ISZ RADIX /SET RADIX TO DECIMAL
+ JMS I (NUMBER /GET EXPONENT
+ NOP
+ TAD OTEMP
+ DCA RADIX /RESTORE RADIX
+ TAD TMP
+ CLL RAR
+ TAD LASTOP
+ RAR /LASTOP TO LINK,
+ DCA LASTOP /TMP TO SIGN OF LASTOP
+ TAD WORD2
+ SZL
+ CIA /PUT SIGN ON EXP
+ JMP I (OVER
+TMP, 0
+ IFZERO RALF < PAGE / >
+\f IFNZRO RALF <
+/
+/ IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
+/
+RETSYS, JMS I (DELFIL /THIS LOCATION USED BY INIT CODE
+/MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING
+/FROM COMPILER + OUTPUT DEV IS NOT SYS
+ CDF 10
+ TAD (7604 /POINT TO 2ND OUT FILE THING
+ DCA X11
+ TAD (7611 /POINTER TO 3RD
+ DCA X10
+ TAD (-5 /LENGTH OF SUCH THINGS
+ DCA LTEMP
+ TAD I X10 /MOVE 3RD TO 2ND
+ DCA I X11 /FOR LOADER MAP FILE
+ ISZ LTEMP
+ JMP .-3
+ TAD I [7600 /WAS THERE A FIRST OUT FILE
+ AND NP17 /(BINARY OUT)*
+ DCA LTEMP
+ TAD OUTBLK /GET FILE LENGTH
+ AND (377
+ CLL RTL
+ RTL
+ CIA
+ TAD LTEMP /COMBINE UNIT AND LEN
+ DCA I X10 /FOR FIRST INPUT FILE TO LOADER
+ TAD PASBLK /STARTING BLOCK
+ DCA I X10
+ DCA I X10 /THAT'S THE END OF INPUT
+ CDF 0
+ TAD ERRORS /IF NO ERRORS
+ SNA CLA
+ ISZ CHNSW /SHOULD WE CHAIN?
+ JMP I (7605 /NO!!!
+ ISZ I (7746 /**
+ CIF 10
+ JMS I USR
+ 6 /CHAIN
+LDRBLK, 0 /FIRST BLOCK OF LOADER
+/
+PASBLK, 0 /FIRST BLOCK OF FILE PASSED
+CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
+\f/
+/ OUTPUT A BLOCK OF BINARY
+/
+OUTBLK, 0 /AT END OF PASS2, BECOMES
+ /LENGTH OF BINARY FILE
+ TAD (OUCTL /DEV HNDLR CONTROL WORD
+ JMS I (OUTDMP /CALL THE HANDLER
+ TAD MOUBUF
+ DCA OUTPTR /RESET BUFFER POINTER
+ DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL
+ JMP I OUTBLK
+MOUBUF, OUBUF-1
+/
+TYPCOD, 2500 /UNDEFINED
+ 0000 /ADDRESS
+ 3000 /XTERNAL
+ 0300 /COMMON
+ 2300 /SECTION
+ -1 /?
+ -1 /?
+ 7000 /8-M0DE SECTION
+ 3200 /8-MODE PAGE0 COMMON SECTION
+ 0600 /8-MODE FIELD1 SECTION
+\fBORG, 0
+ CDF FLD0
+ TAD LOCTR1
+ RTR
+ RTR
+ AND [177
+ TAD (ESDBUF-1 /POINT INTO ESD TABLE
+ DCA LTEMP
+ TAD I LTEMP
+ TAD (4 /ADDRESS VALUE
+ DCA LTEMP
+ CDF FLD1
+ TAD LOCTR1
+ AND [7 /GET ADDR BITS ONLY
+ DCA BOTMP /SAVE EM
+ TAD I LTEMP /OLD HIGH VALUE BITS
+ AND [7
+ CIA
+ TAD BOTMP /COMPARE THEM
+ SPA
+ JMP BOXIT /NO UPDATE REQUIRED
+ SNA CLA
+ JMP BOCHKL /NO DIFFERENCE YET
+ TAD LOCTR1
+ DCA I LTEMP /RESET TO NEW HIGH
+ ISZ LTEMP
+ JMP BOSETL /SKIP OVER TEST
+BOCHKL, ISZ LTEMP /POINT TO LO-ORDER
+ TAD I LTEMP
+ CIA CLL
+ TAD LOCTR2 /COMPARE LOW ORDERS
+ SNL CLA
+ JMP BOXIT /NO REPLACE
+BOSETL, TAD LOCTR2
+ DCA I LTEMP
+BOXIT, CLA
+ CDF FLD0
+ JMP I BORG /WHEW!
+BOTMP= EXTMP
+ PAGE
+\fNEWESD, 0
+ TAD ESDNO
+ TAD (-177 /CHECK LIMIT
+ SPA CLA
+ JMP .+3
+ JMS I [ERMSG1 /TOO MANY
+ 3023 /*XS*
+ ISZ ESDNO /BUMP COUNT
+ TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1
+ SMA CLA
+ JMP I NEWESD
+ TAD ESDNO
+ TAD (ESDBUF-1 /INDEX BUFFER
+ DCA ESDTMP
+ CDF FLD1
+ TAD I OLDN3 /GET POINTER TO THIS SYMBOL
+ CDF FLD0
+ DCA I ESDTMP
+ TAD ESDTMP
+ TAD [200
+ DCA ESDTMP /NOW ADDRESS CHAR TABLE
+ TAD BUCKET
+ DCA I ESDTMP
+ JMP I NEWESD
+ESDTMP= EXTMP
+/
+/ RELOCATION CONTROL PSEUDO-OPS
+/
+ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT
+ JMP ESDERR
+ JMS I [LOOKUP /FIND IT
+ JMP QENT /UNDEFINED
+ CLL RAR /MUST BE USER ADDR TYPE
+ SNA CLA
+ TAD I X10 /LOOK AT ESD
+ AND [7770
+ SZA CLA /IS IT RELOCATABLE?
+ JMP OKENT /YES
+QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1
+ 1105 /*IE*
+OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT
+ JMP I [NEXTST
+\f/
+EXTRNX, CLA STL RTL
+ DCA STYPE /EXTERNS ARE TYPE 2
+ JMS I [GETNAM
+ JMP ESDERR
+ JMS I [LOOKUP
+ JMS CRESD /IF UNDEFINED, DEFINE IT
+ CLL RTR /IF DEFINED, CHECK LEGALITY
+ SZA CLA
+ESDERR, JMS I [ERMSG
+ 0523 /*ES*
+ JMP I [NEXTST
+/
+ CLA IAC /FIELD1 SECT=11
+ IAC /COMMZ SECT=10
+SECT8X, TAD [7
+ JMP COMMX+1
+SECTX, CLA IAC
+COMMX, TAD (COMMN /GET DESIRED CODE
+ DCA STYPE /FOR SECTION TYPE
+ JMS I [GETNAM
+ DCA BUCKET /IF NO NAME, BLANK COMMON
+ JMS I [LOOKUP
+ JMP NEWSCT /UNDEFINED
+ CIA /OLD FRIEND
+ TAD STYPE /SAME?
+ SNA CLA
+ JMP SETSCT /YUP, DO IT
+ JMP ESDERR
+/
+CRESD, 0
+ JMS NEWESD /CREATE NEW ESD ENTRY
+ CDF FLD1
+ TAD I LTEMP /SET TYPE CODE
+ AND [7700
+ TAD STYPE
+ DCA I LTEMP
+ ISZ LTEMP
+ TAD ESDNO
+ CLL RTL /ESD NO TO SYMBOL VLAUE
+ RTL
+ DCA I LTEMP
+ CDF FLD0
+ JMP I CRESD
+/
+NEWSCT, JMS CRESD /CREATE AN ESD
+SETSCT, JMS I (BORG /ADJUST LOC CTR'S
+ CDF FLD1
+ TAD I X10 /GET NEW LOC CTR VALUE
+ DCA LOCTR1
+ TAD I X10
+ DCA LOCTR2 /LOW LOC CTR
+ CDF FLD0
+ JMP PUTORG
+\f/
+ORGX, JMS I (ADRGET /GET ORG EXPR
+ JMS I (BORG
+ TAD EXPVAL+1
+ AND [7770 /DOES IT HAVE AN ESD?
+ SNA CLA
+ TAD LOCTR1 /IF NOT, KEEP CURRENT ESD
+ AND [7770
+ TAD EXPVAL+1
+ DCA LOCTR1 /RESET PC
+ TAD EXPVAL+2
+ DCA LOCTR2
+PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY
+ SZA CLA
+ JMP I [NEXTST
+ DCA ABSOP /CLEAR ABS OUTPUT SW
+ CLA STL RTL
+ JMS I (FULCHK /ROOM FOR MORE?
+ TAD LOCTR1
+ RTR
+ RTR /GET ESD
+ AND [177
+ TAD (TTORG
+ DCA I OUTPTR
+ TAD LOCTR1
+ AND [7 /FIELD BITS
+ DCA I OUTPTR
+ TAD LOCTR2 /ADDRESS
+ DCA I OUTPTR
+ JMS I (FULCHK
+ JMP I [NEXTST
+ PAGE />
+\f/
+/ VARIOUS PSEUDO-OP HANDLERS
+/
+LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY
+LSTOFX, DCA LISTSW
+ JMP I [NEXTST
+/
+DECX, CLA IAC
+OCTALX, DCA RADIX
+ JMP I [NEXTST
+/
+TEXTX, JMS I [GETCHR /GET DELIMITER
+ JMP I [NEXTST /NULL STMT
+ CIA
+ DCA EXTMP /SAVE - DELIM
+LOOP6B, JMS GETCHT /GET HIG ORDER CHAR
+ JMP I [NEXTST
+ JMS I [R6L /SHIFT IT UP
+ DCA LTEMP /SAVE HALF
+ JMS GETCHT /GET LOWER CHAR
+ JMP OUTTXT /GO PUT LAST
+ TAD LTEMP /PUT 2 CHARS TOGETHER
+ JMS I [OUTWRD /OUTPUT WORD
+ JMP LOOP6B /LOOP
+OUTTXT, TAD LTEMP /PUT OUT HALF WORD
+ JMS I [OUTWRD /OR ZERO WORD
+ JMP I [NEXTST
+GETCHT, 0 /GET CHAR FOR TEXT STMT
+ ISZ NCHARS /BUMP COUNT
+ SKP
+ JMP I GETCHT /END OF TEXT
+ TAD I CHRPTR /GET CHAR
+ DCA BUCKET /SAVE IT
+ TAD BUCKET /IS IT THE DELIM ?
+ TAD EXTMP
+ SNA CLA
+ JMP I GETCHT /YES, RETURN NO SKIP
+ ISZ GETCHT /BUMP RETURN
+ TAD BUCKET /GET CHAR
+ AND [77 /LOW 6 BITS
+ JMP I GETCHT /RETURN
+\f/
+/ CONDITIONAL ASSEMBLY HANDLERS
+/
+IFNZRX, CLA CMA
+IFZROX, JMS GETCON /GET CONDITION EXPR
+ TAD EXPVAL+1 /HIGH ORDER
+ AND [7
+ SNA
+ TAD EXPVAL+2 /LOW ORDER
+SWTCH, SNA CLA
+ JMP TRUE /PRESENT CONDITION OF ASMOF IS OK
+FALSE, TAD ASMOF /GOTTA REVERSE IT
+ CMA
+ DCA ASMOF /THAT DOES IT
+TRUE, CDF FLD0
+ JMS I [GETCHR
+ JMP BADCND /FORGOT THE ANGLE
+ TAD [-240 /IGNORE BLANK, IF ANY
+ SNA
+ JMP TRUE /TRY AGAIN
+ TAD (240-274
+ SNA CLA
+ JMP I (ASMBL /GO FROM HERE
+ JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT
+ JMP BADCND
+/
+GETCON, 0
+ DCA ASMOF /SET INITIAL TRUTH
+ JMS I [EXPR /COLLECT EXPR
+ JMP OKCND /BAD MAY MEAN GOOD
+BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD
+ 1103 /*IC*
+ DCA ASMOF /ENABLE ASSEMBLY
+ JMP I (ASMBL
+OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST?
+ SNA CLA
+ JMP I GETCON /YES
+ JMP BADCND
+/
+IFNEGX, CLA CMA
+IFPOSX, JMS GETCON
+ CLA CLL IAC RTL /4
+ AND EXPVAL+1 /SIGN OF EXPR
+ JMP SWTCH /GO FROM THERE
+/
+IFNDFX, CLA CMA
+IFREFX, DCA ASMOF
+ JMS I [GETNAM /GET SYMBOL NAME
+ JMP BADCND /GOTTA GIVE SOMETHING
+ JMS I [FIND /IS IT KNOWN TO US?
+ JMP FALSE /NOT REFERENCED YET
+ SNA CLA /SKIP IF DEFINED
+ DCA ASMOF /ELSE ASSEMBLE
+ JMP TRUE
+\fIFSWX, CLA CMA
+IFNSWX, DCA ASMOF
+ TAD (7642 /ADDRESS OF OPTION WORDS
+ DCA WORD2 /A TEMP
+ JMS I (LETTER /ALLOW LETTER
+ JMP .+4 /AC BETWEEN 1 AND 32
+ JMS I (DIGIT /OR NUMBER
+ JMP BADCND /ALL ELSE IS BAD
+ TAD (33 /MAKE 0 = Z+1
+ ISZ WORD2 /BUMP POINTER
+ TAD (-14 /IS IT IN THIS WORD?
+ SMA SZA
+ JMP .-3 /NO, POINT TO NEXT
+ CIA
+ CMA STL /BIT COUNT AWAY FROM LINK
+ DCA WORD1
+ RAL /SHIFT
+ ISZ WORD1 /COUNT
+ JMP .-2
+ CDF 10 /OPTIONS FIELD
+ AND I WORD2 /GET SELECTED BIT
+ JMP SWTCH /AND TEST IT
+/
+ZBLKX, JMS I (ADRGET /EVALUATE EXPR
+ TAD EXPVAL+2
+ CIA
+ DCA ZBCNT /HOLD COUNT
+ TAD LISTSW /SAVE LISTSWITCH
+ DCA ZBTMP
+ JMS I [OUTWRD /PUT A WORD
+ DCA LISTSW /NO LIST AFTER FIRST
+ ISZ ZBCNT /COUNT THEM
+ JMP .-3 /MORE
+ TAD ZBTMP /RESTORE
+ DCA LISTSW /LISTING
+ JMP I [NEXTST
+ZBCNT= EXTMP
+ZBTMP= EXTMP2
+ PAGE
+\f PTP=20
+ DCB=7760
+ INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
+ OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
+IN7400, 7400
+NINCTL, INCTL+1
+NINREC, INRECS
+IOPEN, 0
+ TAD (7617
+ DCA INFPTR /RESET FILE POINTER
+ JMS INNEWF /FETCH NEW HNDLR, ETC
+ /WHILE USR IS STILL IN CORE
+ CLA CMA
+ DCA INCHCT /FORCE A READ ON NEXT CHAR
+ JMP I IOPEN
+ICHAR, 0
+IN7600, 7600
+INCHAR, CDF INFLD
+ ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
+ ISZ INCHCT
+INJMPP, JMP INJMP
+ TAD INEOF
+ SZA CLA /DID LAST READ GIVE EOF ?
+GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
+ TAD INCTR
+ CLL
+ TAD NINREC
+ SNL
+ DCA INCTR /RESTORE INCR IF NOT OVERFLOWED
+ SZL /IS THIS THE LAST READ?
+ ISZ INEOF /YES - SET END-OF-FILE FLAG
+ CLL CML CMA RTR /MAKE CONTROL WORD
+ RTR /FROM THE AMOUNT OF THE OVERFLOW
+ RTR /(IF ANY) AND THE STANDARD CNTRL WD
+ TAD NINCTL
+ DCA INCTLW
+ CDF
+ JMS I INHNDL /CALL THE DEVICE HANDLER
+INCTLW, 0
+INBUFP, INBUF
+INREC, 0
+ JMP INERRX /SOME KIND OF HANDLER ERROR
+INBREC, TAD INREC
+ TAD NINREC
+ DCA INREC /UPDATE THE RECORD NUMBER
+ TAD INCTLW
+ AND IN7600
+ CLL RAL
+ TAD INCTLW
+ AND IN7600
+ CMA
+ DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
+ TAD INJMPP
+ DCA INJMP /RESET THE CHARACTER SWITCH
+ TAD INBUFP
+ DCA INPTR /AND THE WORD POINTER
+ JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED
+INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
+ SMA CLA /WHICH TYPE WAS IT ?
+ JMP INBREC /END OF FILE - RESUME PROCESSING
+ JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE
+INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH
+ JMP ICHAR1
+ JMP ICHAR2
+ TAD INJMPP
+ DCA INJMP
+ TAD I INPTR
+ AND IN7400
+ CLL RTR
+ RTR /COMBINE HIGH-ORDER FOUR BITS OF
+ TAD INCTLW
+ RTR /THE 2 WORD TO FORM THE 3RD CHAR
+ RTR
+ ISZ INPTR
+ JMP INCOMN
+ICHAR2, TAD I INPTR
+ AND IN7400
+ DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD
+ ISZ INPTR /BUMP THE WORD POINTER
+ICHAR1, TAD I INPTR
+INCOMN, AND (377
+ TAD (-232
+ SNA /IS THE CHARACTER A ^Z?
+ JMP GETNEW /YES - GET A NEW FILE
+ TAD (232 /RESTORE THE CHARACTER
+ CDF
+ JMP I ICHAR /AND RETURN
+INFPTR, 7617
+INEOF, 1 /PARAMETERS ARE SET UP SO THAT
+INCHCT, /IOPEN IS UNNECESSARY.
+INNEWF, -1
+ TAD NINDEV
+ DCA INHNDL /INITIALIZE HANDLER ADDRESS
+ CDF 10
+ TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
+ CDF
+ SNA /ANY MORE?
+ JMP I (ENDX /NO MORE INPUT
+ CIF 10
+ JMS I USR
+ 1 /ASSIGN, FETCH HANDLER
+INHNDL, 0
+ JMP I [IOERR /HUH?
+ CDF 10
+ TAD I INFPTR
+ AND (7760 /GET LENGTH PART OF WORD
+ SZA /LENGTH OF 0 MEANS LENGTH GE 256
+ TAD [17 /ADD HIGH ORDER BITS
+ CLL CML RTR
+ RTR
+ DCA INCTR /STORE LENGTH OF FILE
+ ISZ INFPTR
+ TAD I INFPTR
+ CDF
+ DCA INREC /STARTING RECORD NUMBER OF FILE
+ ISZ INFPTR
+ DCA INEOF /ZERO END-OF-FILE FLAG
+ JMP I INNEWF
+INCTR, 0
+INPTR, 0
+OUFNAM, 0;0;0;0 /OUTPUT FILE NAME
+NINDEV, INDEVH
+ PAGE
+\fOOPEN, 0
+ TAD OUFILE /INCR OUTPUT FILE POINTER
+ TAD (5
+ DCA OUFILE
+ CDF 10
+ TAD I OUFILE /GET DEVICE CODE, LEN
+ DCA OUELEN /HOLD IT A MO
+ JMS I (OFNAME /GET FILE NAME INTO FIELD 0
+ TAD OUELEN /CHECK FOR NULL FILE
+ SNA CLA
+ JMP ONOFIL /INHIBIT OUTPUT
+ JMS GETUSR /LOAD USR IF NOT ALREADY IN
+ TAD OUNAME /RESET ENTER CALL
+ DCA OUBLK
+ TAD NOUDEV
+ DCA OUHNDL
+ TAD OUELEN /THE UNIT
+ CIF 10
+ JMS I USR
+ 1 /ASSIGN, FETCH HANDLER
+OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
+ JMP I [IOERR /HUH?
+ TAD OUELEN /UNIT AGAIN
+ CIF 10
+ JMS I USR
+ 3 /ENTER OUTPUT FILE
+OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
+OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
+ JMP I [IOERR /YOU BLEW IT!!!
+ DCA OUCCNT
+ DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
+ JMS I (OUSETP
+ ISZ OOPEN
+ JMP I OOPEN
+ONOFIL, ISZ I (OUTINH
+ JMP I OOPEN
+OUTDMP, 0
+ DCA OUCTLW /STORE THE CONTROL WORD
+ TAD OUCCNT
+ SNA
+ ISZ OUCTLW
+ TAD OUBLK
+ DCA OUREC /COMPUTE STARTING BLOCK
+ TAD OUCTLW
+ JMS I [R6L
+ AND [17 /COMPUTE THE NUMBER OF RECORDS
+ TAD OUCCNT /UPDATE SIZE OF FILE
+ DCA OUCCNT
+ TAD OUCCNT
+ CLL CML
+ TAD OUELEN
+ SNL SZA CLA /EXCEED GIVEN LENGTH ?
+ JMP I [IOERR /YES - ERROR
+ CDF
+ JMS I OUHNDL
+OUCTLW, 0
+LOUBUF, OUBUF
+OUREC, 0
+ JMP I [IOERR
+ JMP I OUTDMP
+OCLOSE, 0
+ JMS GETUSR /ENSURE USR IN CORE
+ IFNZRO RALF <
+ TAD PASSNO
+ SZA CLA
+ JMP .+6
+ TAD (377
+ JMS I (FULCHK /DUMP LAST BLOCK
+ TAD OUCCNT /SAVE FILE LENGTH
+ DCA I (OUTBLK /FOR CHAIN
+ JMP NODUMP >
+ JMS I (OTYPE
+ AND (770
+ TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
+ SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
+ TAD (232 /OUTPUT A ^Z
+ JMS I [OCHAR
+FILLLP, JMS I [OCHAR
+ JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
+ SPA CLA
+ TAD [100
+ TAD [77
+ AND I (OUDWCT
+ SZA CLA /UP TO THE BOUNDARY YET?
+ JMP FILLLP /NO - FILL WITH ZEROS
+ TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
+ TAD (OUCTL&3700
+ SNA /A FULL WRITE LEFT?
+ JMP NODUMP /YES DON'T DO IT
+ TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS
+ JMS OUTDMP
+NODUMP, CIF CDF 10
+ TAD I OUFILE
+ CDF
+ JMS I USR
+ 4 /CLOSE THE OUTPUT FILE
+OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
+OUCCNT, 0
+ JMP I [IOERR /ERROR WHILE CLOSING - BAD!!
+ JMP I OCLOSE /ALL DONE
+NOUDEV, OUDEVH
+\f/
+/ LOAD USR IF NOT IN CORE ALREADY
+/
+GETUSR, 0
+ TAD USR /CURRENT CALL ADDR
+ SMA CLA
+ JMP I GETUSR /WE GOT IT
+ CIF 10
+ JMS I USR /THE ANSWERING SERVICE
+ 10 /CALLS THE SR
+ TAD [200
+ DCA USR /RESET THE CALL ADDRESS
+ JMP I GETUSR /JES FINE
+ PAGE
+\fFULCHK, 0
+ IFNZRO RALF <
+/
+/ IF THE RELOCATABLE BINARY OUTPUT
+/ BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
+/ FILL THE REST WITH NOP CODES AND OUTPUT THE
+/ BLOCK.
+/
+ TAD OUTPTR
+ TAD KOUBUF
+ SPA CLA
+ JMP I FULCHK
+FULLUP, TAD OUTPTR
+ TAD KOUBUF
+ SMA CLA
+ JMP .+4
+ CLA IAC
+ DCA I OUTPTR
+ JMP FULLUP
+ JMS I (OUTBLK
+ JMP I FULCHK
+KOUBUF, -OUBUF-377 >
+/
+/
+/ GET SIGN CHARACTER IF ANY
+/ BUMP LASTOP IF MINUS
+/
+GETSGN, 0
+ JMS I [GETCHR
+ JMP I GETSGN
+ TAD (-255 /MINUS?
+ SNA
+ ISZ LASTOP
+ SZA
+ CLL CMA RAR /IF IT WAS PLUS, BECOMES 0
+ SZA CLA /SKIP IF PLUS OR MINUS
+ JMS I [BACK1 /OTHERWISE PUT IT BACK
+ JMP I GETSGN
+\f/ AS PER RICHIE LARY
+/
+/ SINGLE AND DOUBLE PRECISION
+/ FLOATING POINT INPUT
+/
+/
+EX, TAD M3
+FX, TAD M3
+ DCA DESW /STORE LENGTH
+ TAD (-7
+ JMS CLEAR /CLEAR FAC+OP
+ DCA LASTOP
+ JMS GETSGN /GET SIGN
+ STA /CLA CMA
+ DCA DPSW /SET NO DP
+GETD, DCA DCNT
+ JMS I (DIGIT /GET A DIGIT
+ JMP LOOKP /NO
+ DCA OTEMP /SAVE IT
+ JMS I (FMPTEN /MULT FAC*10
+ JMS CLEAR
+ TAD OTEMP
+ SZA
+ JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0
+ TAD DPSW
+ CMA
+ TAD DCNT /BUMP IF FP SEEN
+ JMP GETD
+\fLOOKP, JMS I [GETCHR
+ JMP OVER /DONE
+ TAD (-256
+ SNA
+ JMP DECPT
+ TAD (256-304
+ CLL RAR
+ SNA CLA
+ JMP I (EXPON /E OR D
+DEXERR, JMS I [ERMSG
+ 0620 /FP
+ JMP NOTNEG
+DECPT, ISZ DPSW
+ JMP DEXERR /2 PERIODS
+ JMP GETD
+/
+OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC
+ SNA
+ JMP NOSCAL /NO SCALING NEEDE
+ CLL
+ SMA
+ CIA CML /SIGN IN LINK,MAGNITUDE IN AC
+ DCA DCNT /AS A COUNT
+ SNL
+ TAD (TENTH-TEN /OFFSET KLUDGE
+ DCA OTEMP
+SCALUP, TAD OTEMP
+ JMS I (FMPTEN /MULT BY 10.0 OR 0.1
+ ISZ DCNT
+ JMP SCALUP
+NOSCAL, JMS CLEAR
+ STL RAR
+ DCA OP+5 /ROUNDING CONSTANT
+ JMS I (ADD
+ TAD AC
+ SZA CLA
+ JMS I (NORM /WATCH IT!
+ DCA AC+5
+ TAD LASTOP
+ SNA CLA /SIGN -?
+ JMP NOTNEG /NO
+ TAD (AC+5
+ JMS I (SETUP
+ACNGLP, RAL
+ TAD I P /NEGATE FAC
+ CLL CIA
+ DCA I P
+ STA
+ TAD P
+ DCA P
+ ISZ CT
+ JMP ACNGLP
+NOTNEG, JMS CLEAR /SET UP X10
+ TAD I X10
+ JMS I [OUTWRD
+ ISZ DESW /OUTPUT #
+ JMP .-3
+ JMP I [NEXTST
+\fCLEAR, 0 /AC MAY NOT BE 0
+ TAD (-7
+ DCA CT
+ TAD (OPX-1
+ DCA X10
+ DCA I X10
+ ISZ CT
+ JMP .-2
+ JMP I CLEAR
+ DCNT=FULCHK
+ DPSW=NCTMP
+ DESW=OPCODE
+ PAGE
+\f OVBUFR=.
+FAD, 0 /FLOATING ADD DIGIT IN AC
+ DCA OP
+ TAD (13
+ DCA OPX
+ALNLP, TAD OPX
+ CIA
+ TAD ACX
+ SNA /ALIGNED?
+ JMP GOADD /YES
+ SMA CLA
+ TAD (OPX-ACX
+ JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1
+ JMP ALNLP /TRY AGAIN
+GOADD, JMS ADD /ADD FRACTIONS
+ JMS NORM /NORMALIZE RESULT
+ JMP I FAD /RETURN
+/
+RSHFT, 0 /SHIFT RIGHT
+ TAD (ACX /DEFAULT IS FAC
+ JMS SETUP
+ ISZ I P /BUMP EXPONENT
+RSLP, ISZ P
+ TAD I P
+ RAR
+ DCA I P
+ ISZ CT
+ JMP RSLP
+ JMP I RSHFT
+/
+ADD, 0 /ADD TO FAC
+ TAD (OP+5
+ DCA PP2
+ TAD (AC+5
+ JMS SETUP
+ADDLP, RAL /CARRY
+ TAD I PP2
+ TAD I P
+ DCA I P /ADD ONE WORD
+ STA
+ TAD P /COMPLEMENT LINK
+ DCA P
+ STA
+ TAD PP2 /COMPLEMENT LINK
+ DCA PP2
+ ISZ CT
+ JMP ADDLP
+ JMP I ADD
+\fNORM, 0 /NORMALIZE FAC
+ TAD AC
+ SPA CLA /CHECK FOR OVERNORMALIZATION
+ JMS RSHFT /AND CORRECT
+NORMLP, STL RTR
+ AND AC
+ SZA CLA /NORMALIZED?
+ JMP I NORM /YES
+ TAD (AC+5
+ JMS SETUP
+LSLP, TAD I P
+ RAL /LEFT SHIFT
+ DCA I P /FAC 1 BIT
+ STA CML /COMPLEMENT LINK
+ TAD P
+ DCA P
+ ISZ CT
+ JMP LSLP
+ STA
+ TAD ACX /BUMP EXP
+ DCA ACX /DOWN 1
+ JMP NORMLP
+\fFMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1
+ TAD (TEN
+ JMS SETUP
+ TAD AC
+ SNA CLA /AC=0 MEANS RESULT=0
+ JMP I FMPTEN
+ TAD I P
+ TAD ACX /FUDGE FAC
+ DCA ACX /EXPONENT
+ TAD (MUX
+ DCA X11
+ TAD (ACX
+ DCA SETUP
+ TAD (OPX
+ DCA X10
+ DCA MUX /CLEAR MULT TEMP EXP
+MPLP1, ISZ SETUP
+ TAD I SETUP /MOVE FAC
+ DCA I X10 /TO OP
+ DCA I SETUP /CLEAR FAC
+ ISZ P
+ TAD I P /MOVE MULTIPLIER
+ DCA I X11 /TO MULT TEMP
+ ISZ CT
+ JMP MPLP1
+/
+MPLP2, TAD (MUX-ACX
+ JMS RSHFT /SHIFT MULT TEMP RIGHT 1
+ SZL
+ JMS ADD /ADD IF LOW ORDER BIT WAS 1
+ JMS RSHFT /SHIFT FAC RIGHT
+ TAD MU+5
+ SZA CLA /12 SUCCESSIVE 0 BITS
+ JMP MPLP2 /IN MULTIPLIER MEANS DONE
+ JMS NORM
+ JMP I FMPTEN
+/
+SETUP, 0 /COMMON CODE
+ DCA P
+ TAD (-6
+ DCA CT
+ CLL
+ JMP I SETUP
+/
+MUX, 0 /MULT TEMP
+MU, ZBLOCK 6
+ CT=CPTMP
+ P=EXTMP
+ PP2=PAGEN
+\f PAGE
+\f IFNZRO RALF <
+ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN
+ PNDL /DITTO FOR BLANK COMMON
+ ZBLOCK 376 /FILL TO 400 LOCS
+/
+/ BEGIN OF PASS 2:
+/ DUMP EXTERNAL SYMBOL DICTIONARY
+/ DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
+/
+DMPESD, CLA CLL CMA RAL /-2
+ DCA EXTMP2 /PASS CONTROL
+ TAD (3 /RALF OUTPUT IDENTIFIER
+ DCA I OUTPTR
+ TAD VERS
+ DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES
+ TAD DPFLG /4000=NEED DP HARDWARE
+ DCA I OUTPTR /EXACTLY FILL A BLOCK
+ DCA I OUTPTR
+ESDSCN, TAD (ESDBUF-1
+ DCA X10 /POINT TO POINTERS
+ TAD (ESDBUF+177
+ DCA X12 /POINT TO INITAIL CHARS
+ TAD ESDNO
+ CIA
+ DCA EXTMP
+ESDLUP, TAD (-3
+ DCA LTEMP /NAME LENGTH COUNT
+ TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME
+ DCA X13
+ TAD I X10 /GET POINTER
+ DCA X11
+ TAD I X12 /GET FIRST CHAR
+ SNA /BLANK BECOMES #
+ TAD (43
+ESDNLP, JMS I [R6L
+ DCA EQUN+2
+ CDF FLD1
+ TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE
+ DCA EQUN+3 /HOLD IT
+ CDF FLD0
+ TAD EQUN+3
+ JMS I [R6R /GET LEFT CHAR
+ TAD EQUN+2 /COMBINE THEM
+ DCA I X13
+ TAD EQUN+3 /GET RIGHT HALF OF PAIR
+ AND [77
+ ISZ LTEMP
+ JMP ESDNLP
+ AND [37 /DROP FORCE BIT FROM TYPE
+ DCA EQUN+3
+ CDF FLD1
+ TAD I X11 /HIGH VALUE
+ DCA EQUN+4
+ TAD I X11 /LOW VALUE
+ DCA EQUN+5
+ CDF FLD0
+ TAD EXTMP2 /WHAT PASS IS THIS?
+ RAR /LINK 0 IF FIRST, 1 IF SECOND
+ SNL CLA
+ JMP NOENTS /FIRST, ENTRYS NOT OUTPUT
+ TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND
+ CLL RAR
+ SNA CLA
+ SNL
+ JMP ESDLND /NO GO
+ JMP ESDOUT /YES, PUT IT
+NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN
+ CLL RAR
+ SNA /SKIP IF OK
+ JMP ESDLND /UNDEFINED OR ENTRY
+ RAR
+ SNA CLA
+ JMP ESDOUT /IF EXTERN, DO IT
+ TAD EQUN+4 /IF SECTION, CHECK
+ AND [7 /THAT LENGTH
+ SNA /IS NON-ZERO
+ TAD EQUN+5
+ SNA CLA
+ JMP ESDLND /ZERO LEN JUST GETS IN THE WAY
+ESDOUT, TAD (EQUN-1
+ DCA X13
+ TAD (-6
+ DCA LTEMP
+ TAD I X13 /GET OUTPUT WORD
+ DCA I OUTPTR
+ ISZ LTEMP
+ JMP .-3 /6-WORD ENTRIES
+ TAD OUTPTR
+ TAD OUTBUF
+ SPA CLA
+ JMP ESDLND /NOT END OF BLOCK YET
+ JMS I (OUTBLK
+ TAD (3
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ESDLND, ISZ EXTMP /GO THRU ESD LIST
+ JMP ESDLUP
+ ISZ EXTMP2 /WHOLE LIST TWO PASSES
+ JMP ESDSCN
+ TAD (-6 /THEN STORE END-OF-ESD
+ DCA LTEMP
+ DCA I OUTPTR
+ ISZ LTEMP
+ JMP .-2
+ TAD (377 /FORCE BLOCK OUTPUT
+ JMS I (FULCHK
+ CDF FLD1 /THEN DEFAULT ORG
+ TAD I (LMAIN /IF MAIN LEN .NE. 0
+ AND [7
+ SNA
+ TAD I (LMAIN+1
+ CDF FLD0
+ SNA CLA
+ JMP I (RESET /FIRST SECTION WILL GET IT
+ TAD (TTORG+1 /ORG TO ZERO OF MAIN
+ DCA I OUTPTR
+ DCA I OUTPTR
+ DCA I OUTPTR
+ JMP I (RESET
+OUTBUF, 1001
+ PAGE />
+\f/
+/ INITIALIZATION CODE
+/
+BEGIN, JMP CHNIN /IF ENTERED BY CHAIN
+GCMND, CIF 10 /IF ENTERED BY .R, ETC
+ JMS I USR /USR IS LEFT OVER
+ 5 /DECODE
+ IFZERO RALF <
+ 620 /DEFAULT EXT = .FP>
+ IFNZRO RALF <
+ 2201 /DEFAULT EXT = .RA>
+ DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED
+CHNIN, JMS I (7607
+ 4100 /TEMP WRITE OUT OVERLAY
+ 6600 /NOW AT 6600
+ 40 /TO SYS SCRATCH BLK 40
+ JMP I (7605 /ERROR
+ CDF 10
+ IFNZRO RALF <
+ TAD I [7600 /BIN FILE UNIT
+ AND NP17
+ SNA /IS THERE ONE?
+ JMP DEFBIN /NO, SET DEFAULT
+ TAD (7757 /POINT TO DEV CTRL WORD
+ DCA WORD1
+ TAD I WORD1
+ SPA CLA
+ JMP OKBIN /FILE-STRUCTURED, OK
+ CDF 0
+ JMS I (PRTXT /TYPE MESSAGE
+ TXBBIN-1
+ -TXBLN
+ JMS I [CRLF
+ JMP GCMND /TRY AGAIN
+/
+DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS
+ DCA I [7600 /SET UNIT
+ TAD [7600
+ DCA X10 /SET POINTER
+ TAD (0617 /FO
+ DCA I X10
+ TAD (2224 /RT
+ DCA I X10
+ TAD (2216 /RN
+ DCA I X10 /FORTRN.
+ DCA I X10
+ CDF 0
+ JMP I (NOEXT /NOW, OPEN THE FILE>
+\fOKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE
+ JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE
+GBIN, CDF 10
+ TAD I (7644
+ AND (20
+ SNA CLA
+ ISZ SYONLY /=NO SLASH T
+ CDF 0
+ JMS I (NEW /**SEE IF NEED 2 PG HANDLER
+ 7600
+ JMS I (OOPEN
+ DCA BFILE
+ IFNZRO RALF <
+ TAD R41 /L OR G SWITCH**
+ CDF 10
+ AND I (7643 /TEST /L OR /G SWITCH
+ CDF 0
+ SNA CLA /**
+ JMP KCHN /KILL CHAIN, IT'S SET
+ CIF 10
+ CLA IAC /UNIT IS SYS
+ JMS I USR
+ 2 /LOOKUP
+LBLK, LDRNAM /LOADER.SV
+R41, 41 /**
+ JMP KCHN /NO FIND, NO CALL
+ TAD LBLK /STARTING BLOCK
+ DCA I (LDRBLK /FOR CHAIN
+ TAD I (OUBLK /OUTPUT STARTING BLOCK
+ DCA I (PASBLK /SAVED FOR CHAIN TO LOADER
+ CLA CMA /ENABLE CHAIN
+KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER>
+ JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
+ JMS I (INNEWF /GET INPUT HANDLER
+ CLA CMA
+ DCA I (INCHCT /SET INITIAL COUNT
+ TAD NP7700
+ DCA USR /FROM NOW ON, USE THE HIGH CALL
+\f JMS I (NEW
+ 7605 /CHECK LIST DEV TOO**
+ CDF 10
+ TAD I (7611 /LST FILE EXT
+ SNA
+ TAD (1423 /LS DEFAULT
+ DCA I (7611
+ TAD I (7666 /GET DATE
+ DCA WORD1
+/
+/ MOVE SYMBOL TABLE TO ITS PROPER LOCATION
+/
+ TAD (1777
+ DCA X10 /LOADED ADDRESS OF SYMBOL TABLE
+ CLA CMA
+ DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS
+ TAD (-FREE /LENGTH OF SYMBOL TABLE
+ DCA WORD2 /SET COUNT
+ TAD I X10
+ DCA I X11 /THIS SAVES SWAPS OF USR
+ ISZ WORD2
+ JMP .-3
+ CDF 0
+ JMP I (GDATE /CHECK FOR FPP PRESENCE**
+ PAGE
+\f/
+/ PUT THE DATE INTO THE PAGE HEADING
+/
+GDATE, TAD (1000
+ DCA I (7746 /SET NO-RESTART BIT
+ /PUT VERNUM IN TITLE LINE
+ TAD VMSG
+ DCA I (VMTXT
+ TAD VMSG+1 /PATCH LEVEL
+ DCA I (VMTXT+1
+ DCA OCNT /CLEAR OCNT
+ TAD WORD1 /RE-GET DATE
+ SNA
+ JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED
+ AND (370
+ CLL RTR
+ RAR
+ TAD (-12
+ SPA
+ JMP .+3
+ ISZ OCNT
+ JMP .-4
+ TAD (72 /60+12
+ DCA OTEMP
+ TAD (TITDAT-1
+ DCA X11
+ TAD OCNT
+ JMS I (R6L
+ SZA
+ TAD (6000
+ TAD OTEMP
+ DCA I X11
+ TAD WORD1
+ AND (7400 /MONTH
+ JMS I (R6L
+ TAD (MONTHS-3
+ DCA X10
+ TAD I X10
+ DCA I X11
+ TAD I X10
+ DCA I X11
+ DCA OCNT
+ TAD WORD1
+ AND [7
+ DCA OTEMP
+ TAD I (7777
+ AND (600
+ RTR CLL
+ RTR
+ TAD OTEMP
+ TAD (106
+\f TAD (-12
+ SPA
+ JMP .+3
+ ISZ OCNT
+ JMP .-4
+ TAD (72
+ DCA OTEMP
+ TAD (5560
+ TAD OCNT
+ DCA I 11
+ TAD OTEMP
+ JMS I (R6L
+ TAD (40
+ DCA I X11
+ JMP I (NEWLIN
+VMSG, VNUM&70^10+VNUM&707+6060
+ PATCH&77^100+40
+ IFNZRO RALF <
+LDRNAM, TEXT "LOAD@@SV"
+TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED"
+TXBLN= .-TXBBIN >
+MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
+\f PAGE
+/PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
+NEW, 0
+ TAD NT2 /CHECK IF ALREADY CHECKED
+ SZA CLA
+ JMP NEWDON
+ TAD I NEW /NO. GET THE DEV TO CHECK
+ DCA NTEMP
+ CDF 10
+ TAD I NTEMP /GET DEV.NUM
+ AND [17
+ DCA NT1 /INCHK NEEDS TO KNOW TOO
+ TAD NT1
+ SNA /IF 0,THEN NO DEVICE
+ JMP NEWDON
+ DCA NTEMP
+ CLA CMA
+ TAD I (37 /GET PTR TO DEV TBL
+ TAD NTEMP
+ DCA NTEMP /PTS TO ENTRY IN DEV TBL
+ TAD I NTEMP
+ CDF 0
+ SMA CLA
+ JMP FIX /NOT A 2 PG HANDLER
+ TAD (6377 /FIX ALL LOCATIONS THAT REFER TO
+/THE BUFFER VARIABLES.
+/THE CHANGES ARE:
+/OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
+/INRECS=1,INCTL=200
+ DCA I (BLINE
+ TAD (6000
+ DCA I (NOUBUF
+ IFNZRO RALF <
+ TAD (5777
+ DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS
+ TAD (6601
+ DCA I (NINDEV
+ TAD (201
+ DCA I (NINCTL
+ JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER
+ DCA I (NINREC
+ TAD (6000
+ DCA I (LOUBUF
+ TAD (7201
+ DCA I (NOUDEV
+ TAD (5777
+ DCA I (OUTPTR
+ TAD (6377
+ DCA I (CHRPTR
+ IFNZRO RALF <
+ TAD (1401
+ DCA I (KOUBUF >
+ TAD (7201
+FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN
+NEWDON, ISZ NEW /GET CORRECT ADDR
+ JMP I NEW
+NTEMP, 0
+NT1, 0 /DEV. NUM.
+NT2, 0 /0 IF NO 2PG HANDLERS YET
+INCHK, 0 /CHECK THE INPUT DEVICES
+ JMS NEW
+INLOC, 7617
+ TAD INLOC
+ DCA NEXTIN
+ANOTH, TAD NT1
+ SNA CLA /SKIP IF FILE USED
+ JMP I INCHK
+ TAD NT2
+ SZA CLA /SKIP IF STILL 1 PAGE HANDLERS
+ JMP I INCHK
+ TAD NP2
+ TAD NEXTIN
+ DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR
+ JMS NEW
+NEXTIN, 0
+ JMP ANOTH
+NP2, 2
+NOKBIN, CDF 10 /BELONGS WITH INIT CODE
+ TAD I [7600
+ AND NP17
+ TAD (7646
+ DCA WORD1 /CREATE POINTER INTO DEV TBL
+ TAD I WORD1
+ CDF 0
+ TAD (-7607
+ SNA CLA /IF ITS SYS, NO PROBLEMS
+ DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE
+ CDF 10
+ TAD I (7604
+ SZA
+ JMP FEND /AN EXT WAS SPECIFIED
+ IFZERO RALF <
+ TAD (0216 /.BN DEFAULT FOR FLAP
+ JMP FEND >
+ IFNZRO RALF <
+NOEXT, CDF 10
+ TAD I (7643 /CHECK IF L OR G SPEC
+ AND L41
+ SNA CLA
+ TAD (0610 /NO-NEEDS RL EXT
+ TAD (1404 > /YES-NEEDS LD
+FEND, DCA I (7604
+ CDF 0
+ JMP I (GBIN
+L41, 41
+TPNSH, 0
+ TAD (1401 /CHANGE OUTPUT BUFFER
+ DCA I (OUTBUF
+ IAC
+ JMP I TPNSH
+/
+ PAGE
+\fLDADR, RELOC OVBUFR
+ TAD ERRORS /ERROR COUNT
+ JMS I (DECOUT
+ JMS I (PRTXT /"ERRORS"
+ TXERR-1
+ -TXELN
+ JMS I [CRLF
+ IFZERO RALF <
+ TAD PASSNO /IF NOT LISTING PASS
+ SPA SNA CLA /ERROR COUNT IS ENUF
+ JMP I (RETSYS >
+ TAD NEXT
+ TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS
+ CLL RAR /DIVIDE
+ JMS I (OVER3 /BY 6
+ JMS I (DECOUT
+ JMS I (PRTXT /"SYMBOLS, "
+ TXSYM-1
+ -TXSLN
+ IFZERO RALF <
+ TAD LINKS
+ JMS I (DECOUT
+ JMS I (PRTXT /"LINKS"
+ TXLNK-1
+ -TXLLN >
+ IFNZRO RALF <
+ TAD ABREFS
+ JMS I (DECOUT
+ JMS I (PRTXT /"ABS REFS"
+ TXABR-1
+ -TXALN >
+ JMS I [CRLF
+ TAD (-33 /27 BUCKETS
+ DCA LTEMP
+ DCA BUCKET
+ CLA CMA
+ DCA OPCODE /SYMBOLS PER LINE COUNTER
+\fSTPRNT, TAD BUCKET
+ DCA EXTMP /BUCKET START ADDRESS
+LUPBKT, CDF FLD1
+ TAD I EXTMP /WAS THAT LAST SYMBOL ?
+ SNA
+ JMP NXTBKT /YES, GO GET NEXT BUCKET
+ DCA EXTMP /SAVE LINK ADDR
+ TAD EXTMP
+ DCA X14 /SET UP POINTER FOR NAME
+ ISZ OPCODE /IS LINE FULL?
+ JMP .+4 /NO
+ TAD (-4
+ DCA OPCODE
+ JMS I [CRLF
+ TAD BUCKET
+ SNA /WATCH FOR #
+ TAD (43
+ JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR
+ CDF FLD1
+ TAD I X14 /SYMBOL
+ JMS I [PRINT2 /PRINT 2 AND 3
+ CDF FLD1
+ TAD I X14
+ JMS I [PRINT2 /PRINT 4 AND 5
+ CDF FLD1
+ TAD I X14
+ IFNZRO RALF <
+ DCA OTEMP /HOLD
+ TAD OTEMP >
+ AND [7700 /PRINT 6 AND BLANK
+ JMS I [PRINT2
+ IFNZRO RALF <
+ TAD OTEMP /GET TYPE
+ AND [17
+ TAD (TYPCOD /POINT TO TABLE
+ DCA OTEMP
+ TAD I OTEMP /GET TYPE INDICATOR
+ JMS I [PRINT2 >
+ CDF FLD1
+ TAD I X14 /PRINT FIRST DIGIT
+ AND [7
+ JMS I (PDIG /FIELD DIGIT
+ CDF FLD1
+ TAD I X14 /LOW 12 BITS
+ JMS I [OCTOUT
+ JMS I [PRINT2 /TWO BLANKS
+ JMP LUPBKT
+\fNXTBKT, ISZ BUCKET /NEXT BUCKET CHAR
+ CDF FLD0
+ ISZ LTEMP /INCREMENT COUNT
+ JMP STPRNT
+ JMS I [CRLF /DO FINAL CRLF**
+ TAD (214 /DO NOT PAGEJ
+ JMS I PC /THAT WOULD GIVE A HEADING
+ JMS I (OCLOSE
+ JMP I (RETSYS /FINISH IT OFF
+ PAGE
+ RELOC
+\f/ PAGE 0 LITERALS
+ FIELD 1
+ *10000
+\f/
+/ SYMBOL TABLE IS IN FIELD ONE.
+/ EACH ENTRY HAS THE FOLLOWING FORMAT
+/
+/ 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
+/ 1: 2ND AND 3RD CHARS OF SYMBOL
+/ 2: 4TH AND 5TH
+/ 3: 6TH AND TYPE CODE
+/ 4: ESD # AND HIGH-ORDER VALUE
+/ 5: LOW-ORDER VALUE
+/
+ USER=1
+ XTERN=2
+ COMMN=3
+ SECTN=4
+ PSUDO=5
+ PDPMR=6
+ FPPMRF=7
+ FPPSF1=10 /JXN, TRAP
+ FPPSF2=11 /JA, SETB, SETX
+ FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM,
+ /PAUS, JAC, STARTD, STARTF
+ FPPSF4=13 /ALN, ATX, XTA
+ FPPSF5=14 /ADDX, LDX
+ FPPMRI=15 /%
+ FPPMRS=16 /'
+ FPPMRL=17 /#
+ PDPOP=20
+/
+/ THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
+/ THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
+/ THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
+/ IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
+/ DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
+/
+ *12000
+ NOPUNCH
+ *10000
+ ENPUNCH
+\f/
+/ BUCKETS FOR USER-DEFINED SYMBOLS
+/ AND PDP8 OPERATES AND IOTS
+/
+ PNDL
+ ZBLOCK 33
+\f/
+/ BUCKETS FOR INTERNALLY DEFINED SYMBOLS
+/
+ AL
+ BL
+ CL
+ DL
+ EL
+ FL
+ GL
+ HL
+ IL
+ JL
+ KL
+ LL
+ ML
+ NL
+ OL
+ PL
+ QL
+ RL
+ SL
+ TL
+ UL
+ VL
+ WL
+ XL
+ YL
+ ZL
+\fAL, .+5 /ADDR
+ 0404;2200
+ FPPSF2
+ 0
+ .+5 /ADDX
+ 0404;3000
+ FPPSF5
+ 0110
+ .+5 /ALN
+ 1416;0
+ FPPSF4
+ 0010
+ IFZERO RALF <
+ .+5 /AND
+ 1604;0
+ PDPMR
+ AND 0 >
+ IFNZRO RALF <
+ .+5 /AND .
+ 1604;0
+ PDPMR
+ 200
+ .+5 /AND%
+ 1604;0
+ PDPMR+500
+ 600
+ .+5 /ANDZ
+ 1604;3200
+ PDPMR
+ 0
+ .+5 /ANDZ%
+ 1604;3200
+ PDPMR+500
+ 400 >
+ 0 /ATX
+ 2430;0
+ FPPSF4
+ 0020
+BL, 0 /BASE
+ 0123;0500
+ PSUDO
+ BASEX
+CL, .+5 /CDF
+ 0406;0
+ PDPOP
+ CDF
+ .+5 /CIA
+ 1101;0
+ PDPOP
+ CIA
+ .+5 /CIF
+ 1106;0
+ PDPOP
+ CIF
+ .+5 /CLA
+ 1401;0
+ PDPOP
+ CLA
+ .+5 /CLL
+ 1414;0
+ PDPOP
+ CLL
+ .+5 /CMA
+ 1501;0
+ PDPOP
+ CMA
+ IFZERO RALF < 0 >
+ IFNZRO RALF < .+5 >
+ 1514;0 /CML
+ PDPOP
+ CML
+ IFNZRO RALF <
+ .+5 /COMMON
+ 1715;1517
+ PSUDO+1600
+ COMMX
+ 0 /COMMZ (8-MODE COMM SECT)
+ 1715;1532
+ PSUDO
+ SECT8X-1 >
+\fDL, IFZERO RALF <
+ .+5 /DCA
+ 0301;0
+ PDPMR
+ DCA 0 >
+ IFNZRO RALF <
+ .+5 /DCA .
+ 0301;0
+ PDPMR
+ 3200
+ .+5 /DCA%
+ 0301;0
+ PDPMR+500
+ 3600
+ .+5 /DCAZ
+ 0301;3200
+ PDPMR
+ DCA 0
+ .+5 /DCAZ%
+ 0301;3200
+ PDPMR+500
+ DCA I 0 >
+ IFZERO RALF < 0 > /DECIMAL
+ IFNZRO RALF < .+5 >
+ 0503;1115
+ PSUDO+0100
+ DECX
+ IFNZRO RALF < 0 /DPCHK
+ 2003;1013
+ PSUDO
+ DPCHKX >
+EL, .+5 /E
+ 0;0
+ PSUDO
+ EX
+ .+5 /END
+ 1604;0
+ PSUDO
+ ENDX
+ IFZERO RALF <
+ 0 /ENPUNCH
+ 1620;2516
+ PSUDO+0300
+ ENPNCX >
+ IFNZRO RALF <
+ .+5 /ENTRY
+ 1624;2231
+ PSUDO
+ ENTRX
+ 0 /EXTERN
+ 3024;0522
+ PSUDO+1600
+ EXTRNX >
+\fFL, .+5 /F
+ 0;0
+ PSUDO
+ FX
+ .+5 /FADD
+ 0104;0400
+ FPPMRF
+ 1000
+ .+5 /FADD#
+ 0104;0400
+ FPPMRL+300
+ 1000
+ .+5 /FADD%
+ 0104;0400
+ FPPMRI+500
+ 1000
+ .+5 /FADD'
+ 0104;0400
+ FPPMRS+700
+ 1000
+ .+5 /FADDM
+ 0104;0415
+ FPPMRF
+ 5000
+ .+5 /FADDM#
+ 0104;0415
+ FPPMRL+300
+ 5000
+ .+5 /FADDM%
+ 0104;0415
+ FPPMRI+500
+ 5000
+ .+5 /FADDM'
+ 0104;0415
+ FPPMRS+700
+ 5000
+ .+5 /FCLA
+ 0314;0100
+ FPPSF3
+ 0002
+\f .+5 /FDIV
+ 0411;2600
+ FPPMRF
+ 3000
+ .+5 /FDIV#
+ 0411;2600
+ FPPMRL+300
+ 3000
+ .+5 /FDIV%
+ 0411;2600
+ FPPMRI+500
+ 3000
+ .+5 /FDIV'
+ 0411;2600
+ FPPMRI+700
+ 3000
+ .+5 /FEXIT
+ 0530;1124
+ FPPSF3
+ 0
+ IFNZRO RALF <
+ .+5 /FIELD1 (8-MODE FIELD1 SECT)
+ 1105;1404
+ PSUDO+6100
+ SECT8X-2 >
+ .+5 /FLDA
+ 1404;0100
+ FPPMRF
+ 0000
+ .+5 /FLDA#
+ 1404;0100
+ FPPMRL+300
+ 0000
+ .+5 /FLDA%
+ 1404;0100
+ FPPMRI+500
+ 0000
+ .+5 /FLDA'
+ 1404;0100
+ FPPMRS+700
+ 0000
+\f .+5 /FMUL
+ 1525;1400
+ FPPMRF
+ 4000
+ .+5 /FMUL#
+ 1525;1400
+ FPPMRL+300
+ 4000
+ .+5 /FMUL%
+ 1525;1400
+ FPPMRI+500
+ 4000
+ .+5 /FMUL'
+ 1525;1400
+ FPPMRS+700
+ 4000
+ .+5 /FMULM
+ 1525;1415
+ FPPMRF
+ 7000
+ .+5 /FMULM#
+ 1525;1415
+ FPPMRL+300
+ 7000
+ .+5 /FMULM%
+ 1525;1415
+ FPPMRI+500
+ 7000
+ .+5 /FMULM'
+ 1525;1415
+ FPPMRS+700
+ 7000
+ .+5 /FNEG
+ 1605;0700
+ FPPSF3
+ 0003
+ .+5 /FNOP
+ 1617;2000
+ FPPSF3
+ 0040
+\f .+5 /FNORM
+ 1617;2215
+ FPPSF3
+ 0004
+ .+5 /FPAUSE
+ 2001;2523
+ FPPSF3+0500
+ 0001
+ .+5 /FPCOM
+ 2003;1715
+ PDPOP
+ 6553
+ .+5 /FPHLT
+ 2010;1424
+ PDPOP
+ 6554
+ .+5 /FPICL
+ 2011;0314
+ PDPOP
+ 6552
+ .+5 /FPINT
+ 2011;1624
+ PDPOP
+ 6551
+ .+5 /FPIST
+ 2011;2324
+ PDPOP
+ 6557
+ .+5 /FPRST
+ 2022;2324
+ PDPOP
+ 6556
+ .+5 /FPST
+ 2023;2400
+ PDPOP
+ 6555
+ .+5 /FSTA
+ 2324;0100
+ FPPMRF
+ 6000
+ .+5 /FSTA#
+ 2324;0100
+ FPPMRL+300
+ 6000
+ .+5 /FSTA%
+ 2324;0100
+ FPPMRI+500
+ 6000
+ .+5 /FSTA'
+ 2324;0100
+ FPPMRS+700
+ 6000
+ .+5 /FSUB
+ 2325;0200
+ FPPMRF
+ 2000
+ .+5 /FSUB#
+ 2325;0200
+ FPPMRL+300
+ 2000
+ .+5 /FSUB%
+ 2325;0200
+ FPPMRI+500
+ 2000
+ 0 /FSUB'
+ 2325;0200
+ FPPMRS+700
+ 2000
+\fGL= 0 /AINT NONE
+HL, 0 /HLT
+ 1424;0
+ PDPOP
+ HLT
+IL, .+5 /IAC
+ 0103;0
+ PDPOP
+ IAC
+ .+5 /IFFLAP
+ 0606;1401
+ PSUDO+2000
+ IFZERO RALF <TRUE>
+ IFNZRO RALF <FALSE>
+ .+5 /IFNDEF
+ 0616;0405
+ PSUDO+0600
+ IFNDFX
+ .+5 /IFNEG
+ 0616;0507
+ PSUDO
+ IFNEGX
+ .+5 /IFNSW
+ 0616;2327
+ PSUDO
+ IFNSWX
+ .+5 /IFNZRO
+ 0616;3222
+ PSUDO+1700
+ IFNZRX
+\f .+5 /IFPOS
+ 0620;1723
+ PSUDO
+ IFPOSX
+ .+5 /IFRALF
+ 0622;0114
+ PSUDO+0600
+ IFNZRO RALF <TRUE>
+ IFZERO RALF <FALSE>
+ .+5 /IFREF
+ 0622;0506
+ PSUDO
+ IFREFX
+ .+5 /IFSW
+ 0623;2700
+ PSUDO
+ IFSWX
+ .+5 /IFZERO
+ 0632;0522
+ PSUDO+1700
+ IFZROX
+ .+5
+ 1604;0530
+ PSUDO
+ INDXX
+ .+5 /IOF
+ 1706;0
+ PDPOP
+ IOF
+ .+5 /ION
+ 1716;0
+ PDPOP
+ ION
+ IFZERO RALF <
+ 0 /ISZ
+ 2332;0
+ PDPMR
+ ISZ 0 >
+ IFNZRO RALF <
+ .+5 /ISZ .
+ 2332;0
+ PDPMR
+ ISZ .&7600
+ .+5 /ISZ%
+ 2332;0
+ PDPMR+500
+ ISZ I .&7600
+ .+5 /ISZZ
+ 2332;3200
+ PDPMR
+ ISZ 0
+ 0 /ISZZ%
+ 2332;3200
+ PDPMR+500
+ ISZ I 0 >
+\fJL, .+5 /JA
+ 0100;0
+ FPPSF2
+ 1030
+ .+5 /JAC
+ 0103;0
+ FPPSF3
+ 0007
+ .+5 /JAL
+ 0114;0
+ FPPSF2
+ 1070
+ .+5 /JEQ
+ 0521;0
+ FPPSF2
+ 1000
+ .+5 /JGE
+ 0705;0
+ FPPSF2
+ 1010
+ .+5 /JGT
+ 0724;0
+ FPPSF2
+ 1060
+ .+5 /JLE
+ 1405;0
+ FPPSF2
+ 1020
+ .+5 /JLT
+ 1424;0
+ FPPSF2
+ 1050
+ IFZERO RALF <
+ .+5 /JMP
+ 1520;0
+ PDPMR
+ JMP 0
+ .+5 /JMS
+ 1523;0
+ PDPMR
+ JMS 0 >
+ IFNZRO RALF <
+ .+5 /JMP .
+ 1520;0
+ PDPMR
+ JMP .&7600
+ .+5 /JMP%
+ 1520;0
+ PDPMR+500
+ JMP I .&7600
+ .+5 /JMPZ
+ 1520;3200
+ PDPMR
+ JMP 0
+ .+5 /JMPZ%
+ 1520;3200
+ PDPMR+500
+ JMP I 0
+ .+5 /JMS .
+ 1523;0
+ PDPMR
+ JMS .&7600
+ .+5 /JMS%
+ 1523;0
+ PDPMR+500
+ JMS I .&7600
+ .+5 /JMSZ
+ 1523;3200
+ PDPMR
+ JMS 0
+ .+5 /JMSZ%
+ 1523;3200
+ PDPMR+500
+ JMS I 0 >
+\f .+5 /JNE
+ 1605;0
+ FPPSF2
+ 1040
+ .+5 /JSA
+ 2301;0
+ FPPSF2
+ 1120
+ .+5 /JSR
+ 2322;0
+ FPPSF2
+ 1130
+ 0 /JXN
+ 3016;0
+ FPPSF1
+ 2000
+KL, .+5 /KCC
+ 0303;0
+ PDPOP
+ KCC
+ .+5 /KRB
+ 2202;0
+ PDPOP
+ KRB
+ .+5 /KRS
+ 2223;0
+ PDPOP
+ KRS
+ 0 /KSF
+ 2306;0
+ PDPOP
+ KSF
+LL, .+5 /LAS
+ 0123;0
+ PDPOP
+ LAS
+ .+5 /LDX
+ 0430;0
+ FPPSF5
+ 0100
+ .+5 /LISTOFF
+ 1123;2417
+ PSUDO+0600
+ LSTOFX
+ 0 /LISTON
+ 1123;2417
+ PSUDO+1600
+ LSTONX
+\fML= 0 /NO LIST
+NL, IFZERO RALF < .+5 >
+ IFNZRO RALF < 0 >
+ 1720;0 /NOP
+ PDPOP
+ NOP
+ IFZERO RALF <
+ 0 /NOPUNCH
+ 1720;2516
+ PSUDO+0300
+ NOPNCX >
+OL, .+5 /OCTAL
+ 0324;0114
+ PSUDO
+ OCTALX
+ .+5 /ORG
+ 2207;0
+ PSUDO
+ ORGX
+ 0 /OSR
+ 2322;0
+ PDPOP
+ OSR
+ IFZERO RALF <
+PL, 0 /PAGE
+ 0107;0500
+ PSUDO
+ PAGEX >
+ IFNZRO RALF <PL=0 >
+QL= 0 /WHAT DID YOU EXPECT?
+RL, .+5 /RAL
+ 0114;0
+ PDPOP
+ RAL
+ .+5 /RAR
+ 0122;0
+ PDPOP
+ RAR
+ .+5 /RDF
+ 0406;0
+ PDPOP
+ RDF
+ .+5 /REPEAT
+ 0520;0501
+ PSUDO+2400
+ REPETX
+ .+5 /RIB
+ 1102;0
+ PDPOP
+ RIB
+ .+5 /RIF
+ 1106;0
+ PDPOP
+ RIF
+ .+5 /RMF
+ 1506;0
+ PDPOP
+ RMF
+ .+5 /RTL
+ 2414;0
+ PDPOP
+ RTL
+ 0 /RTR
+ 2422;0
+ PDPOP
+ RTR
+\fSL, .+5 /S
+ 0;0
+ PSUDO
+ SX
+ IFNZRO RALF <
+ .+5 /SECT
+ 0503;2400
+ PSUDO
+ SECTX
+ .+5 /8 MODE SECT
+ 0503;2470
+ PSUDO
+ SECT8X >
+ .+5 /SETB
+ 0524;0200
+ FPPSF2
+ 1110
+ .+5 /SETX
+ 0524;3000
+ FPPSF2
+ 1100
+ .+5 /SKP
+ 1320;0
+ PDPOP
+ SKP
+ .+5 /SMA
+ 1501;0
+ PDPOP
+ SMA
+ .+5 /SNA
+ 1601;0
+ PDPOP
+ SNA
+ .+5 /SNL
+ 1614;0
+ PDPOP
+ SNL
+ .+5 /SPA
+ 2001;0
+ PDPOP
+ SPA
+ .+5 /STARTD
+ 2401;2224
+ FPPSF3+0400
+ 0006
+ .+5 /STARTE
+ 2401;2224
+ FPPSF3+0500
+ 0050
+ .+5 /STARTF
+ 2401;2224
+ FPPSF3+0600
+ 0005
+ .+5 /STL
+ 2414;0
+ PDPOP
+ STL
+ .+5 /SZA
+ 3201;0
+ PDPOP
+ SZA
+ 0 /SZL
+ 3214;0
+ PDPOP
+ SZL
+\fTL, IFZERO RALF <
+ .+5 /TAD
+ 0104;0
+ PDPMR
+ TAD 0 >
+ IFNZRO RALF <
+ .+5 /TAD .
+ 0104;0
+ PDPMR
+ TAD .&7600
+ .+5 /TAD%
+ 0104;0
+ PDPMR+500
+ TAD I .&7600
+ .+5 /TADZ
+ 0104;3200
+ PDPMR
+ TAD 0
+ .+5 /TADZ%
+ 0104;3200
+ PDPMR+500
+ TAD I 0 >
+ .+5 /TCF
+ 0306;0
+ PDPOP
+ TCF
+ .+5 /TEXT
+ 0530;2400
+ PSUDO
+ TEXTX
+ .+5 /TLS
+ 1423;0
+ PDPOP
+ TLS
+ .+5 /TPC
+ 2003;0
+ PDPOP
+ TPC
+ .+5 /TRAP3
+ 2201;2063
+ FPPSF1
+ 3000
+ .+5 /TRAP4
+ 2201;2064
+ FPPSF1
+ 4000
+ .+5 /TRAP5
+ 2201;2065
+ FPPSF1
+ 5000
+ .+5 /TRAP6
+ 2201;2066
+ FPPSF1
+ 6000
+ .+5 /TRAP7
+ 2201;2067
+ FPPSF1
+ 7000
+ 0 /TSF
+ 2306;0
+ PDPOP
+ TSF
+\fUL= 0
+VL= 0
+WL= 0
+XL, 0 /XTA
+ 2401;0
+ FPPSF4
+ 0030
+YL= 0
+ZL, 0 /ZBLOCK
+ 0214;1703
+ PSUDO+1300
+ ZBLKX
+\f IFZERO RALF < PNDL=0 >
+ IFNZRO RALF <
+PNDL, .+6 /BLANK COMMON
+ 0;0
+ 3 /CODE FOR COMMON
+ 40;0 /ESD #2, LEN=0
+ 0 /#MAIN
+ 1501;1116
+ 4 /CODE FOR SECTION
+LMAIN, 20;0 /ESD #1, LEN=0>
+FREE,
+END, END /NICE WHEN FLAP ASSEMBLES
+ $
+\f