File: RALF.PA of Tape: Original/Originals/AL-4547D-SA
(Source file text)
/ 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.
/
/
/
/
/
/
/ 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 /TEMP 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 >
BASER, 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
LPAGE1, 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
/
/ 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
RDLOOP, 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
FORMFD, 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
/
/ 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
/
/ 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
/
/ 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
TRYEQU, 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
TRYBLK, 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
/
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
FPMRL, 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
FPPS5, 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
/
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>
FPPS4, 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
>
GETADR, 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
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
/
/ 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
/
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
/
/ 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>
NOTDOT, 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
ADR, 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
UNDEF, 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
ADRADD, 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 >
ADRAND, 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
/
ADRMUL, 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
DIVERR, JMS I [ERMSG
0626 /*DV*
JMP I (OPR8R /CONTINUE
PDPOPR, 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
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
ISP0, 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
NEWLIT, 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 />
/
/ 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
/
/ 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*
/
/ 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
NODGT, 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
/
/ 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
/
/ 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
/
/ 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
/
/ 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
/
/ 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
/
/ 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
/
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
/
/ 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 >
/
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!>
PRNTST, 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
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 >
/
/ 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
/
/ 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
/
/ 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
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
DMPLIT, 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 >
EXPON, 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 / >
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
/
/ 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
BORG, 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
NEWESD, 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
/
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
/
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 />
/
/ 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
/
/ 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
IFSWX, 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
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
OOPEN, 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
/
/ 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
FULCHK, 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
/ 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
LOOKP, 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
CLEAR, 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
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
NORM, 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
FMPTEN, 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
PAGE
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 />
/
/ 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>
OKBIN, 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
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
/
/ 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
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"
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
LDADR, 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
STPRNT, 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
NXTBKT, 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
/ PAGE 0 LITERALS
FIELD 1
*10000
/
/ 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
/
/ BUCKETS FOR USER-DEFINED SYMBOLS
/ AND PDP8 OPERATES AND IOTS
/
PNDL
ZBLOCK 33
/
/ 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
AL, .+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 >
DL, 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 >
FL, .+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
.+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
.+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
.+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
GL= 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
.+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 >
JL, .+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 >
.+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
ML= 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
SL, .+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
TL, 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
UL= 0
VL= 0
WL= 0
XL, 0 /XTA
2401;0
FPPSF4
0030
YL= 0
ZL, 0 /ZBLOCK
0214;1703
PSUDO+1300
ZBLKX
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
$