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)
$$$$$
