L *4000 //PROGRAM INSERT INSTRUCTION (XXXX) IN LOCATION //(NNNN). TO AUTOMATICALLY INCREMENT LOCATION //TYPE "I" AFTER THE "*" AND INSERT INSTRUCTIONS ONLY //THERAFTER. TO RESTORE NORMAL OPERATION OR DELETE //AN ERROR TYPE "RUBOUT". STRT,JMS CRLF JMS CRLF DCA FLAG TAD FRST DCA LOC /SET "I" RESPONCE IN "RD" SUBR. RETRN,TAD P252 JMS TYPE /TYPE "*" JMS ROT /GO FORM ADDRESS SNA JMP NXT DCA FLAG TAD P311 /TYPE "I",OPERATOR TO INCR. ADDR'S JMS TYPE JMP RETRN NXT,TAD ACC /GET FORMED ADDR. DCA ADDR /STORE IT NUMB,TAD P240 /TYPE TWO SPACES JMS TYPE TAD P240 JMS TYPE JMS ROT /GO FORM INSTRUCTION TAD ACC /GET FORMED INSTRUCTION DCA I ADDR /SET IT TAD FLAG SNA CLA /INCR. ADDRS. ? JMP STRT /NO ISZ ADDR //YES, INCR. ADDR. JMS CRLF TAD P252 JMS TYPE /TYPE"*" TAD ADDR JMS OCTPCH /GO PRNT. NXT. ADDR. JMP NUMB /GET NXT. NUMB. FLAG,0 FRST,JMP XI P252,252 P311,311 ACC,0 SCND,NOP ADDR,0 P240,240 INDX,0 SAFE,0 P7,7 M260,0-260 CODE,260 M4,0-4 M10,0-10 M311,0-311 M66,0-66 P277,277 LF,212 CR,215 //SUBROUTINE TO TYPE OCTAL NUMB OCTPCH,0 RAL /ROTATE FOR LINK DCA SAFE /STORE ACCUMALATOR TAD M4 DCA INDX /SET COUNTER AGAIN,TAD SAFE RTL RAL /ROTATE FOR A NUMB. DCA SAFE TAD SAFE AND P7 /MASK FOR LAST THREE CHARACTERS TAD CODE /BIAS FOR TTY JMS TYPE ISZ INDX /DONE 4X ? JMP AGAIN JMP I OCTPCH CRLF,0 TAD CR JMS TYPE TAD LF JMS TYPE JMP I CRLF //SUBROUTINE TO FORM FOUR CHAR. NUMB ROT,0 TAD M4 DCA INDX /SET COUNTER ROTS,DCA ACC /SET ACCUMALATOR JMS RD /GET TTY CHAR. SZA JMP I ROT /EXIT IF ACC(=/0) TAD SAFE /GET CHAR. JMS TYPE TAD SCND DCA LOC /DELETE "I" RESPONCE IN "RD" SUBR. TAD SAFE AND P7 /MASK LST. 3 DIGITS TAD ACC ISZ INDX /DONE 3X ? SKP /NO JMP ROTX CLL RTL CLL RAL /ROT. 3 LEFT JMP ROTS /GET NXT. CHAR. ROTX,DCA ACC /FULL NUMB. JMP I ROT TYPE,0 TLS TSF JMP .-1 /WAIT TILL DONE CLA JMP I TYPE //SUBROUTINE TO READ AND TEST TTY CHAR. RD,0 KSF JMP .-1 /WAIT FOR CHAR KRB DCA SAFE TAD SAFE TAD M260 /CHAR<0 SPA JMP WRONG /YES TAD M10 /NO SPA CLA /CHAR>7 ? JMP I RD /NO, EXIT ACC(0) TAD SAFE /YES, WHAT IS CHAR TAD M311 SNA /CHAR =I LOC,JMP XI /YES--(LOC SET BY ENTERANCE TO ROT TAD M66 /NO SNA CLA /CHAR . = "RUB OUT" JMP STRT /YES WRONG,CLA JMP RD+1 /TRY AGAIN XI,IAC JMP I RD /EXIT WITH ACC(1) $$$$$