ASMB,R,N
*                   <800822.0731> 
* 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
* 
* 
*     'N' ASSEMBLY OPTION: STANDARD RTE 
*     'Z' ASSEMBLY OPTION: DS/1000 LOCAL & REMOTE USE.- DOES NOT WORK !!!!
* 
      IFZ 
* 
*           NAME:   EDIT. 
*           SOURCE: 92074-18001 
*           RELOC:  PART OF 92074-12001 
*           PGMR:   J.D.J.
* 
      NAM EDIT,19,50 92074-1X001 REV.2034 000000  THIS DOES NOT WORK
      EXT DEXEC,#NODE 
      XIF 
      IFN 
* 
*           NAME:   EDIT. 
*           SOURCE: 92074-18001 
*           RELOC:  PART OF 92074-12001 
*           PGMR:   J.D.J.
* 
*                                        <800822.0731>
      NAM EDIT,3,51 92074-1X001 REV.2034 800818 
      XIF 
      HED EDIT/1000    RTE-4B INTERACTIVE SCREEN EDITOR 
* 
* 
* 
******************************************************************
* 
*  MAIN'S EXT 
* 
* 
      EXT .LBT  RPL  105763B
      EXT .MBT  RPL  105765B
      EXT .SBT  RPL  105764B
      EXT .SFB  RPL  105767B
      EXT .CBT  RPL  105766B
      EXT EXEC
      EXT RDREC 
      EXT ADDSK 
      EXT .DFER,REIO,.ENTR,.XFER
      EXT LOGLU,CNUMD,CNUMO,$CVT1,COR.B,SEGLD 
      EXT IFBRK,PNAME 
      EXT .MVW
* 
******************************************************************* 
* 
*  SEGMENT 0   - FMP IO  -
* 
* 
      EXT ED%PS     PRINT SOURCE FILE MESSAGE 
      EXT ED%FI     READ IN NEW SOURCE FILE 
      EXT ED%CS     CLOSE SOURCE FILE 
      EXT ED%CL     CLOSE LIST FILE 
      EXT ED%EF     SET UP FOR NEW SOURCE FILE
      EXT ED%NL     GET NEW LIST LU 
      EXT ED%LP     POST LIST FILE
      EXT ED%.M     M COMMNAD 
      EXT ED%.E     E COMMAND 
      EXT ED%EX     EXIT EDIT 
      EXT ED%WR     WR, WC COMMANDS 
      EXT ED%WF     WRITF CALL
      EXT ED%PF     TURN OFF BREAK MODE PROMPTS 
      EXT ED%PN     TURN ON    "    "     " 
      EXT ED%LK     LOCK A LU 
      EXT ED%TR     TRANFER COCMMAND
      EXT ED%RF     READ COMMAND FORM FILE
      EXT ED%TC     CLOSE COMMAND FILE
      EXT ED%PC     PANIC MOVE GET A TRACK. 
* 
* 
*  SUBROUTINES IN MAIN
* 
      ENT ./B$      SET BEGGING OF SOURCE FILE
      ENT ./B1      ROLL TO BEGGIN OF SOURCE FILE 
      ENT ALCAT     ALLOCATE TRACKS 
      ENT ASK       ASK BEFORE EXCUTION 
      ENT SETOK 
      ENT CSTRP     STRIP COMMA, BLANKS 
      ENT DOUT      WRITE DEST. FILE TO DISK
*     ENT DTCNT     DECR TRACK COUNT
      ENT RQST      REQUEST A TRACK 
      ENT ECH       GET NEXT COMMAND CHAR 
      ENT ERCLN     CLEAN UP AFTER ERROR
      ENT ECHL      GET CASE FOLDED COMMAND CHAR
      ENT ENDCK     CHECK THAT ALL CHAR USED FORM E BUFF
      ENT EOFLN     GET EOF LINE NUMBER 
      ENT EXCER     REPORT EXEC CALL ERROR
      ENT I/PSB     INPUT NEXT SOURCE LINE
      ENT KILL      KILL MULKTIPLE COMMANDS 
      ENT LCASE     FOLD CASE 
      ENT OUTCR     PUT CHARACTER IN OUTPUT BUFFER
      ENT OVTST     TOO MANY LINES OVERFLAW TEST
      ENT PBKE      PUT BACK LAST CHAR
      ENT PRINT 
      ENT PRTER     PRINTER ERROR FLAG
      ENT RALLT     RELASE ALL TRACKS 
      ENT SETSO     SET UP SOURCE 
      ENT SQ        SET UP SOURCE 
      ENT SWPET     SWAP E AND T BUFFERS
      ENT TR        TRANSFER ONE LINE TO DEST 
      ENT TRN       TRANSFER N LINES
      ENT TYPEQ     GET EQT TYPE
* 
**************
* 
*  JMP TO POINTS IN MAIN
* 
      ENT ERR       REPORT ERROR
      ENT ABORT     COMMAND ABORTED PRINTER 
      ENT ./A0
      ENT DISPL     REPORT ERROR
      ENT NODE1     GET NEXT COMMAND
      ENT RQST4     RETURN POINT FOR PANIC TRACK RESUEST
* 
* DATA IN MAIN
* 
      ENT ALTRK     PRE-ALLOCATED TRACK FOR ALCAT 
      ENT ALCLU        DITTO FOR LU                           
      ENT B^FNM     BYTE POINTER TO FILE NAME   
      ENT COMND     FIRST CHAR OF CURRETN COMMAND 
      ENT DBEND 
*     ENT DBFP1 
      ENT DBUF$ 
      ENT DBUFP 
      ENT DCBSZ 
      ENT DVRTY 
      ENT DVTY
      ENT EBUFF 
      ENT RBUFF 
      ENT PATCH 
      ENT CD1ST 
      ENT RLNG
      ENT RCCNT 
      ENT ECCNT 
      ENT ELNG
      ENT ERFLG 
      ENT EXFLG 
      ENT FCARW 
      ENT FTYPW 
      ENT FNAME     SAVE AREA FOR FILE NAME 
      ENT FNSIZ       AND IT'S SIZE 
      ENT FSECW 
      ENT IOPT
      ENT LASTL     NUMBER OF LAST LINE IN SOURCE FILE
      ENT LDCB      LIST DCB
      ENT LINEM 
      ENT LINES 
      ENT LNAM
      ENT LOPNF     LIST FILE OPEN FLAG 
      ENT LCLOF       CLOSE LIST FILE AT NODE 1 FLAG
      ENT CTFLG       CLOSE COMMAND FILE AT NODE 1 FLAG 
      ENT LSTFG     LIST AT TR FLAG 
****  ENT LSTFG     LIST AT TR FLAG 
      ENT LSLUT 
      ENT LULOG 
      ENT LUCMD 
      ENT MODFG 
      ENT NLSFG 
      ENT NOPRN     NO PRINT FLAG 
      ENT NBUF0 
      ENT NAME
*     ENT NOLSF      NO LS SUPPORT
      ENT NEWLU     NEW TRACK LU FOR RQST 
      ENT NWTRK     NEW TRACK FOR RQST
      ENT DSCTR     NUMBER OF SECTORS PER TRACK FOR NWTRK 
      ENT OCCNT 
      ENT OKFLG 
      ENT PASS1 
      ENT POFFG 
      ENT PBFLG 
      ENT PANIC     REPLACE PANIC MODE FLAG - 
      ENT QCSFG     CLOSE SOURCE FLAG 
      ENT QSFLG 
      ENT RCLNG 
      ENT SBUF$ 
      ENT SBUFP 
      ENT SCFLG 
      ENT SLNG
      ENT SPFLG 
      ENT SVSLU 
      ENT SVSSC 
      ENT SVSTR 
      ENT SVSWC 
      ENT T#REC 
      ENT T#REM 
      ENT T#SEC 
      ENT TBUFF 
      ENT TNAME 
      ENT TSFLG     TIME STAMP FLAG 
      ENT TYDCB 
      ENT TRFLG 
      ENT ^LNAM 
      ENT ROFLG 
      ENT TYOPN     COMMNAD FILE OPEN FLAG
      ENT TTYLU 
      ENT LSTLU 
      ENT ^TRK1 
      ENT #TRAK     SOURCE TRACK RELEASE COUNT
      SKP 
*********************************************************** 
*     SEGMENT EDIT1  EDIT'S RUN PROCESSOR SEGMENT 
* 
      EXT ED%RU 
********************************************************* 
* 
* 
* 
* SEGMENT EDIT2      EDIT'S PATTERN MATCHER SEGMENT 
* 
      EXT ED%.B     B COMMNAD 
      EXT ED%.F     F COMMAND 
      EXT ED%.D     D COMMAND 
      EXT ED%.X     EXCAHNGE COMMNADS 
      EXT ED%XU     DO SUBITUTE 
      EXT ED%FS     FORWARD SCAN  SPEC
      EXT ED%BS     BACKWARD SCAN SPEC
      EXT ED%S1     SEARCH FOR LINE SPEC 1
      EXT ED%S2     SEARCH FOR LINE SPEC 2
* 
      ENT .EOF1     DO END OF FILE STUFF
****  ENT DISPL 
      ENT EOFPR     PRINT EOF 
      ENT L1ERR 
      ENT L2ERR 
      ENT .UNDO     UNDO COMMAND
      ENT OFFSP     GO GET LINE OFFSET SPECS
* 
* SUBROUTINE IN MAIN
* 
* 
      ENT ASCII     TEST IF DIGIT 
****  ENT ASK       ASK BEFORE EXCUTION 
****  ENT ./B1      ROLL TO TOP OF FILE 
****  ENT CSTRP     STRIP COMMANS 
      ENT DFL1S 
****  ENT ECHL
****  ENT ECH 
      ENT FLLER     ADD TO EBUFF FROM R BUFF
      ENT GETL2     GET LIN SPEC 2
      ENT LST       LIST SUBROUTINE 
      ENT LSTSB     LIST SOURCE BUFFER
****  ENT PBKE      PUT BACK COMMAND CHAR 
****  ENT PRINT 
      ENT PUNCT 
      ENT PSL1      POSITION AT LINE SPEC 1 
      ENT PSLN      POSITION SOURCE TO  LINE N
      ENT RPRTW     REPORT WINDOW 
      ENT ROLLN      ROLL TO LINE N 
      ENT SCH       GET NEXT SOURCE LINE CHAR 
      ENT SETTY       SET INPUT BACK TO TTY LU
      ENT SETMS     SET DELETED FLAG IN FOLLC 
****  ENT TR        TRANSFER A LINE 
****  ENT TRN       TRANSFER N LINES
****  ENT LCASE     FOLD CASE 
****  ENT OUTCR     PUT CHAR IN TBUFF 
      ENT ./R$      REPLACE SOURCE LINE 
      ENT UNDOD     SET UP TO UNDO A DELETE 
* 
* 
* DATA IN MAIN
* 
      ENT ALLFG     ALL OPTION FLAG 
      ENT ANCCH     ANCHOR CHARACTER
    ENT BAR       COMMAND SEPERATOR CHARACTER 
      ENT BKRTN     RETURN FOR TR AT P+2 IF BREAK FLAG
****  ENT COMND     CURRENT COMAND
****  ENT ECCNT     E BUFFER COUNT
****  ENT ELNG      E BUFFER LENGTH 
      ENT ESCCH     ESCAPE CHAR 
****  ENT EXFLG     EXCHANGE FLAG 
      ENT FBUF0     FIND BUFFER 
      ENT FBUFF      POINTER TO FIND BUFFER 
      ENT FILLC     FILL CHARS ON LIST
      ENT FOLDF     CASE FOLD FLAG
      ENT FDFLG     CASE FOLD FLAG 100000B => DON'T FOLD, 0=>FOLD 
      ENT FLNG      FBUFF LENGTH
      ENT FRTNF     FIND RETURN FLAG
      ENT INDEF     INDEFINATE CHAR 
      ENT L1FLG     LINE SPEC 1 FLAG
      ENT L1PAT     L1 PATTERN GIVEN FLAG 
      ENT NFNDF     IF SET THEN PRINT 'NOT FOUND' AT LXERR
      ENT L1GIV     L1 SECP GIVEN 
      ENT L1LIN     LINE SPEC 1 LINE
      ENT L1SAV     SAVE AREA L1 WITHOUT OFFSET 
      ENT L2FLG     LINE SPEC 2 FLAG
      ENT L2PAT     LINE 2 PATTERN GIVEN
      ENT L2LIN     LINE 2 LINE 
****  ENT LINES 
****  ENT LSTFG     LIST FLAG 
      ENT MAX       MAX BUFFER SIZE IN BYTES
      ENT NLFLG     NUMBERED LIST FLAG
      ENT NWFLG     NO WINDOW FLAG
      ENT QUFLG     QUTIE FLAG
      ENT REFLG     REGULAR EXPERSSION FLGA 
      ENT REVFG     REVERSE FLAG
      ENT RTNFG     RETURN FLAG 
      ENT R$FLG     CURRETN LINE MODIFIED FLAG
      ENT SCCNT     SOURCE LINE COUNT 
****  ENT SBUFP     SOURCE LINE POINTER 
****  ENT SLNG      SOURCE LINE LENGTH
****  ENT T#REC     DECT RECORD NUMBER
****  ENT TRFLG     TRANSFER FLAG 
      ENT UNCON     UNCONDITIONAL FLAG
      ENT WIND1     WINDOW
      ENT WIND2       COLUMNS 
      ENT XLNG
      ENT XYBUF 
      ENT XYBF0 
      ENT YOFFS 
      ENT YLNG
      ENT ZRMVF     ZERO LENGTH REMOVE FLAG 
****  ENT OCCNT       CURRENT TBUFF COUNT 
      ENT MTCH      SUCCESSFUL MATCH FLAG 
* 
      ENT SRTN
****  ENT ERR 
******************************************************
*     SEGMENT 3 
* 
*     EDIT3      EDIT'S HELP SEGMENT
* 
      EXT ED%HE 
      EXT ED%H2 
* 
* 
*  ENTRY POINT IN THE MAIN
* 
****  ENT SRTN
****  ENT ECHL
****  ENT CSTRP 
      ENT KEY 
      ENT KEYFG 
******************************************* 
* 
*   SEGMENT 4 
* 
* 
*     EDIT4      EDIT'S SCREEN MODE  <070880 JDJ> 
* 
      EXT ED%SC     SCREEN COPY 
      EXT ED%SM     SCREEN MODE 
      EXT ED%QP     DVR05 Q COMMAND 
      EXT ED%SL     SCREEN MODE LIST
      EXT ED%SE     SET CODE
      EXT ED%SH     SHOW CODE 
      EXT ED%.T     TABS,TR 
      EXT ED%TI     TI TIME COMMAND 
      EXT ED%.J     JOIN COMMAND
* 
* 
* 
* 
      ENT SNEXT 
****  ENT PSL1
****  ENT L1LIN 
****  ENT L2LIN 
****  ENT ENDCK 
      ENT SETAB     SET LINES SPEC FLAGS TO ABSOLUTE
* 
* 
****  ENT SRTN
* 
****  ENT ./B1
****  ENT TRN 
****  ENT PRINT 
****  ENT PSLN
      ENT ./R 
****  ENT LSTSB 
****  ENT TR
****  ENT ECH 
****  ENT ECHL
****  ENT ECCNT 
****  ENT PBKE
****  ENT ELNG
****  ENT EBUFF 
****  ENT OUTCR 
****  ENT TBUFF 
****  ENT OCCNT 
      ENT OUTBK 
****  ENT EOFLN 
****  ENT LST 
      ENT LSTA
      ENT LSTSZ 
      ENT WRTLN 
****  ENT SWPET 
****  ENT SLNG
      ENT TTYDV 
      ENT ATLOG 
****  ENT LSTLU 
****  ENT ERR 
****  ENT DISPL 
****  ENT NODE1 
      ENT NODE3 
****  ENT EOFPR 
****  ENT L1ERR 
****  ENT L2ERR 
****  ENT CSTRP 
      ENT NUMIN 
      ENT DOUTP 
      ENT TTYNO 
      ENT CDVR5 
****  ENT LULOG 
****  ENT TTYLU 
      ENT MAXOP 
****  ENT LINES 
****  ENT T#REC 
****  ENT TRFLG 
      ENT BKFLG 
****  ENT LSTFG 
****  ENT NLFLG 
      ENT R1STF 
      ENT UNFLG 
****  ENT SPFLG 
      ENT NSAVE 
      ENT PSSAV 
      ENT MLFLG 
      ENT TMSIZ 
      ENT TMDFT 
      ENT ABOVE 
      ENT BELOW 
      ENT OLAP
****  ENT QSFLG 
      ENT DSPFG 
      ENT ^DSPF 
****  ENT B^FNM 
****  ENT FNSIZ 
      ENT SSTRT 
      ENT SMTSV     SAVE SCREEN MODE TOP LINE 
      ENT SMBSV     SAVE SCREEN MODE BOTTOM LINE
      ENT DOWN
      ENT Q#LST 
* 
* 
* 
* 
      ENT ./QT
****  ENT ASK 
****  ENT PUNCT 
      ENT GETNM 
****  ENT NUMIN 
****  ENT LST 
****  ENT SWPET 
****  ENT ASCII 
      ENT NOLSP 
* 
****  ENT ERR 
****  ENT NODE1 
* 
      ENT ASKFG     ASK FLAG
****  ENT FOLDF     CASE FOLDING FLAG 
****  ENT REFLG     REGULAR EXPRESSION FLAG 
****  ENT DSPFG     DISPLAY FUNCTION FLAG 
****  ENT FRTNF     FIND RETURN FLAG
****  ENT ANCCH     ANCHOR CHAR 
****  ENT INDEF     INDEFINATE MATCH CHAR 
****  ENT ESCCH     ESCAPE CAHR 
      ENT DLMTR     PROMPT
      ENT TABCH     TAB CHARACTER 
      ENT VWABV     VERTCAL WINDOW ABOVE
      ENT VWBLW       "      "     BELOW
****  ENT ABOVE     SCREEN WINDOW ABOVE 
****  ENT BELOW     SCREEN WINDOW BELOW 
****  ENT OLAP       SCREEN OVERLAP 
****  ENT WIND1     WINDDOW START COLUM 
****  ENT WIND2     -WINDOW STOP COLUMN 
****  ENT TBUFF     POINTER TO OUTPUT BUFFER
      ENT TAB0      TAB BUFFER
****  ENT MAXOP     MAX LINE LENGTH 
      ENT MAXIN 
****  ENT MAX 
      ENT /         PROMPT
      ENT LN        PROMPT LENGTH 
****  ENT OCCNT     OUTPUT BUFFER COUNT 
****  ENT SPFLG     LEADING SPACES FLAG 
****  ENT TTYDV 
****  ENT TAB0      TAB BUFFER
* 
****  ENT ./R$      REPLACE PENDING LINE
****  ENT OUTCR     PUT CHAR IN T BUFF
****  ENT UNDOD     UNDO SET UP 
****  ENT I/PSB 
****  ENT SCH 
****  ENT ENDCK 
* 
****  ENT DISPL 
****  ENT ERR 
* 
****  ENT SLNG
* 
* 
      IFN 
DEXEC EQU EXEC
      XIF 
      SUP PRESS EXTRANEOUS LISTING
      SPC 1 
TSFLG DEC -1        TIME STAMP FLAG 
FOLDF DEC -1        FOLD FLAG - IF SET CASE FOLDING IS ON 
FDFLG OCT 000000    FOLD FLAG - 10000=> DON'T FOLD 0=> FOLD 
ASKFG DEC -1        ASK WHEN DANGOURS COMMANDS FLAG - INIT TRUE 
REFLG BSS 1   IF SET THEN REGULAR EXPRESSION GIVEN
KEY   BSS 1 
KEYFG BSS 1 
MAXIN DEC -150
MAXOP DEC 150 
MAX   DEC 150 
SPSP  ASC 1,        TWO SPACES
"."   OCT  56 
"B"   OCT 102 
"W"   OCT 127 
"Y"   OCT 131 
"J"   OCT 112 
"Z"   OCT 132 
"P"   OCT 120 
"R"   OCT 122 
"S"   OCT 123 
"T"   OCT 124 
"^"   OCT 136 
STAR  OCT 52
"$"   OCT 44
">"   OCT 76
FSCRH OCT 47        "'" 
BSCRH OCT 140         "`" 
BAR   OCT 174       "|" 
"#"   OCT 43
%E    OCT  6        CONTROL E 
ESC   OCT 33        ESC CHAR
M4    DEC -4
M6    DEC -6
M8    DEC -8
M32   DEC -32 
M16   DEC -16 
.840  DEC 840 
.144  DEC 144 
.128  DEC 128 
DCBSZ NOP 
M48   DEC -48 
M75   DEC -75 
M10   DEC -10 
.2.I  DEF 2,I       WRITE CODE WITH ERROR-RETURN. 
.3.I  DEF 3,I       CONTROL CODE WITH ERROR-RETURN. 
.10   DEC 10
.18   DEC 18
.16   DEC 16
.12   DEC 12
.14   DEC 14
.22   DEC 22
.24   DEC 24
.30   DEC 30
.58   DEC 58
BIT3  OCT 10
B1MSK OCT 10        TERMINAL STATUS BYTE 1 MASK (STRAP D) 
B2MSK OCT  4           "       "      "  2  "   (STRAP G) 
B3MSK OCT 2            "       "      "  3  "   (BLOCK MODE)
LFMSK OCT 4            "       "      "  3  "   (AUTO LF) 
COMND NOP           ALSO TEMP TO STORE NAME 
TRFLG NOP 
MODFG DEC 0         IF SET THEN FILE HAS BEEN MODIFIED
RTNFG DEC 0         IF SET RETURN TO LINE THIS COMMAND STATED FROM
EXFLG DEC -1
TTYLU NOP           LOGICAL UNIT NUMBER OF TELETYPE 
ERRLU NOP           LOGICAL UNIT NUMBER OF TELETYPE TO BE RESTORED TO.
ERDVR BSS 1         TYPE OF DRIVER TO RESTORE TO AFTER ERROR
ERPRN BSS 1         VALUE NO PRINT FLAG SHOULD BE RESTRE TO AFTER ERROR 
TYOPN DEC 0         COMMAND FILE OPEN FLAG
TNAME BSS 10          NAME SAVE AREA FOR COMMAND FILE 
TYDCB BSS 144           COMMAND FILE DCB
CTFLG DEC 0             CLOSE COMMAND FILE AT NODE 1 IF SET 
LULOG NOP           LU OF LOG DEVICE - NO BITS SET
OCCNT NOP           LENGTH OF OUTPUT BUFFER (TBUFF) 
LSTFG NOP           IF SET THEN TR WILL LIST EACH LINE
NLFLG BSS 1         IF SET AND LSTFG SET THE LIST WITH NUMBERS
NWFLG BSS 1         IF SET THE WINDOW DOES NOT APPLY TO FINDS 
LNFLG DEC 0         IF SET THEN L IS LIST WITH NUMBERS
WNFLG DEC -1        IF SET THEN W IS LIST WITH NUMBERS
NFLG  DEC 0         STATE TO RESET NLFLG TO AT NODE 1 
FLAGN DEC 0         FLAG THIS LINE WITH ">" ON LIST 
OKFLG BSS 1         OK GIVEN BY TERMINATING LINE WITH DLMTR 
FRTNF DEC -1        IF SET THEN RETURN WHEN FIND UNSUCCSEEFUL 
ASKF^ DEF ASKFG 
* 
"?"   OCT 77
"A"   OCT 101 
"I"   OCT 111 
"L"   OCT 114 
PLUSS OCT 53
PLUS  EQU PLUSS 
MINUS OCT 55
SLASH OCT 57        ALTERNATIVE FOR + COMMAND.
B76   OCT 76        ">" CHARACTER 
COMMA OCT 54
"E"   OCT 105 
"D"   OCT 104 
"H"   OCT 110 
"M"   OCT 115 
"N"   OCT 116 
"O"   OCT 117 
LINES OCT 1         LINE COUNTER
LINEM NOP           LINE CTR MOST SIG BITS
LSLUT NOP           CURRENT SOURCE LU/TRACK 
PBFLG NOP           PARTIAL BUFFER FLAG 
SCT   NOP           # OF SECTORS PER SORC, DEST BUFR
DBUF$ NOP           PERMANENT POINTER TO DEST BUFFER
SBUF$ NOP           PERMANENT POINTER TO SORC BUFFER
LWA   NOP           PERMANENT POINTER TO LWA JEDIT
ECCNT NOP 
MXSEC BSS 1 
B600  OCT 600 
B25   OCT 25
"F"   OCT 106 
********************************************************************
JUNK  BSS 1          TEMP STORAGE ROOM
GETMB BSS 1          TTYLU STORAGE DURING STATUS READ 
TTYDV BSS 1           TTY DRIVER TYPE 
DOWN  BSS 1         USED BY SEG 4, CURSOR POSITON 
Q#LST BSS 1           USED BY SEG 4, NUMBER OF LINES TO LIST
SSTRT BSS 1         USED BY SEG 4, SOURCE START LINE
SMTSV BSS 1         SAVE AREA FOR SCREEN MODE TOP LINE
SMBSV BSS 1         SAVE AREA FOR SCREEN MODE BOTTON LINE 
B17   OCT 17
TMSIZ BSS 1           264X MEMORY SIZE
TMDFT BSS 1           264X MEMORY SIZE IF DEFUALT REQUESTED 
* 
I.14  OCT 100016     EXEC STRING PASSAGE
      SPC 1 
EDIT  RSS           IN CASE IT EVER GET RESTARTED (BY CMM4) 
      JMP ERR         THE RSS IS REPLACE BY A NOP AND 
EDITX CLA                 AND THERE IS A CHANCE 
      STA EDIT              HE MAY BE ABLE TO RECOVER.
******************************************************
* CHANGE TO ALLOW FILE NAME IN RU STRING
* 
* 
      JSB EXEC      PICK UP RUN STRING
      DEF *+5 
      DEF I.14
      DEF .1
      DEF RBUF0     PUT IT INTO RBUFF 
      DEF MAXRB 
        CLB           IF ERROR THEN ASK FOR FILE
      STB RLNG      SAVE RU STRING LENGHT 
* 
      CLA 
      JSB SLOAD     GET SEGMENT ZERO
* 
      JSB LOGLU     FETCH TURN-ON TERMINAL
       DEF *+2
       DEF JUNK 
      STA LULOG     - PRINT DECIVE
      STA TTYLU     - INPUT DECIVE;ECHO BIT WILL BE SET LATER 
      STA LSTLU     - LIST DEVICE - SOME COMMAND CHANGE( -1 => FILE)
      STA ERRLU     - WHAT TO RETURN TO IN CASE OF ERROR
**********************************************************************
* 
* OLD DS STUFF - SETTING BITS IN TTYLUY 
* 
* 
      IFZ 
      IOR BIT11     SET INTERACTIVE READ BIT
      STA INLU
      XIF 
RCHK  EQU * 
* 
* 
*   B REG USE TO POINT TO NODE NUMBER BUT NO LONGER DOES
*   IF DS IS EVER ADD BACK IN A NEW WAY TO GET THE NODE 
*   NUMBER MUST BE FOUND
      IFZ 
      INB 
      STB DCBSZ     SAVE PARAMETER POINTER, TEMPORARILY.
      ISZ DCBSZ     PREPARE FOR POSSIBLE
      ISZ DCBSZ      NEED TO EXAMINE P5.
      DLD B,I       GET SCHEDULING & SOURCE NODE NO'S.
      CPA #NODE     OUR NODE NUMBER?
      JMP SVNOD      YES, GO TO SAVE SOURCE NODE NO.
      CPA M1        MINUS ONE ALSO
      JMP LOCAL      ADDRESSES THIS NODE. 
      CPA B         LOCAL DEFAULT-SCHEDULE (P3,P4=0)? 
      JMP LOCAL      YES. GO TO SET LOCAL NODE PARAMETER. 
* 
      STA NODE      NO. SAVE NODE AT WHICH TO SCHEDULE
      SSA,RSS       IF NODE IS POSITIVE,
      JMP SCHED      GO TO SCHEDULE REMOTE <JEDIT>; ELSE, 
      SZB             IF NEG.(NEIGHBOR), ARE WE SCHEDULING? 
      JMP SVNOD        NO, WE'VE BEEN SCHEDULED.
      LDA DCBSZ,I   CHECK SPECIAL CASE: SCHED. FROM NODE #0.
      CPA .1        WERE WE SCHEDULED FROM NODE #0? 
      JMP SVNOD      YES, ACCOMMODATE THE REMOTE REQUEST. 
* 
SCHED LDA DCBSZ,I   GET THE FIFTH SCHEDULING PARAMETER. 
      SZA,RSS       OPTIONAL NAME CHARACTERS SUPPLIED?
      JMP DOSCH      NO. GO TO DO THE SCHEDULING. 
      STA TBUFF,I    YES. SAVE THE NAME CHARACTERS. 
      ADA M.100     SUBTRACT 100 FOR ASCII CHECK. 
      SSA,RSS       ARE THEY ASCII CHARACTERS?
      JMP CONFG      YES, GO CONFIGURE THE NAME.
      LDA TBUFF,I    NO. GET THE NUMERIC VALUE. 
      CLB 
      JSB DEC       CONVERT TO ASCII. 
CONFG LDA TBUFF     GET THE ADDRESS OF THE CHARACTERS.
      RAL           FORM A BYTE ADDRESS.
      LDB NAMBA     GET PROGRAM-NAME BYTE ADDRESS.
      MBT .2        CHANGE NAME TO SUIT USER. 
* 
DOSCH JSB DEXEC     DO REMOTE SCHEDULE OF JEDIT 
      DEF *+9 
      DEF NODE
      DEF .10.I 
      DEF ENAME+4 
      DEF TTYLU 
      DEF MAXOP 
      DEF NODE
      DEF #NODE     PASS OUR NODE # 
      DEF .1        NON-ZERO: DETECTION OF DESTINATION =0.
      JMP NOTAV     SCHEDULING ERROR--INFORM USER.
      SZA,RSS       IS THE REMOTE JEDIT AVAILABLE?
      JMP EXIT      YES 
NOTAV CCA           NO. INFORM THE USER.
      STA NODE      GIVE LOCAL MESSAGE
      JSB PRINT 
      DEF EXIT
      DEC 13
ENAME ASC 13,REMOTE EDIT  UNAVAILABLE! 
NAMBA DBR ENAME+5 
M.100 DEC -100
.10.I DEF 10,I
* 
LOCAL LDB M1        GET LOCAL NODE DESIGNATION: -1. 
SVNOD STB NODE      ESTABLISH OPERATOR'S NODAL ADDRESS. 
      SZB           IF DESTINATION NODE IS NON-ZERO,
      JMP INT1       THEN NO FURTHER CHECKING IS NEEDED;
      LDB DCBSZ,I     ELSE, GET THE FIFTH SCHEDULING PARAM. 
      SZB,RSS       IF P5 =0, THEN
      JMP LOCAL      THIS IS A LOCAL-OPERATION REQUEST. 
      XIF 
INT1  LDB SECT2     ASSUME LU2 IS SMALLER 
      LDA SECT3     IF #SECTORS ON
      CMA,INA,SZA,RSS  LU 3 = 0 THEN
      JMP .MXSC       USE LU 2
      ADA SECT2     IF LU 2 IS
      SSA,RSS        LARGER THAN LU 3 
      LDB SECT3      USE LU 3 AS THE LIMIT
.MXSC BRS           CONVERT TO 128 WORD 
      STB MXSEC      SECTORS AND SAVE 
      SPC 1 
* ALLOW LARGE BACKGROUND  - GET NAME FROM PNAME <JDJ> 
      JSB PNAME      TRANSFER NAME TO ABORT MESSAGE 
       DEF PNAMR
       DEF NAME 
PNAMR JSB .DFER 
       DEF NAME2      AND WAIT TRACKS MESSAGE 
       DEF NAME 
      JSB .DFER       AND ? COMMAND MESSAGE 
       DEF NAME4
       DEF NAME 
      JSB .DFER       AND IN INVOKED MESSAGE
       DEF NAME5
       DEF NAME 
* 
*********************************************** 
* 
*   USE LIBIARY CALL TO GET MEMORY
      LDA XIDT      GET ADDRESS OF THIS PROG'S ID SEG 
      JSB COR.B     GET 1ST FREE WORD 
* 
      SSA           TEST FOR ERROR
      JMP ./A       YES - ABORT 
      INB           ADD 1 JUST IN CASE. 
      LDA B         WE WANT IT IN A REG.
      SPC 1 
*     SET UP BUFFER AREA TO FILL CORE 
      SPC 1 
*     ****************************************
*     *                                  0   * ZERO STORED IN LAST WORD FOR 
*     *            LAST WORD AVAILABLE MEMORY*       ^       .SFB IN COMPL
*     *                                      *       ^
*     *                                      *       ^
*     *  SOURCE BUFFER                       *       ^ SBUFP RANGE
*     *                                      *       ^
*     *                                      *       ^
*     *                   COMPUTED FIRST WORD* SBUF$ ^
*     ****************************************       ^
*     *                                      *       ^
*     *  >= 75 WORDS FOR PARTIAL RECORD      *       ^
*     *                                      *       ^
*     ****************************************
*     *                    COMPUTED LAST WORD*        ^ 
*     *                                      *        ^ 
*     *                                      *        ^ 
*     *  DESTINATION BUFFER                  *        ^ DBUFP RANGE 
*     *                                      *        ^ 
*     *                                      *        ^ 
*     *           FIRST WORD AFTER JEDIT CODE* DBUF$  ^ 
*     ****************************************
*     *                                      *
*     *  EDIT CODE                           *
*     *                                      *
*     *                                      *
      STA DBUF$ 
      STA DBUFP 
      CMA,INA 
      LDB BKLWA 
      ADA AVMEM     IF PROGRAM IS IN FOREGROUND,
      SSA 
      JMP STAD
      LDB AVMEM      SET END OF FOREGROUND
      ADB =D-1        AS LAST WORD AVAILABLE
STAD  EQU * 
      CLA           PUT IN THE ZERO 
      STA B,I 
      ADB =D-1      BUMP BACK BY ONE
      STB LWA 
      LDA DBUFP 
      CMA,INA          FOR BUFFERS
      ADA LWA 
      STA TEMP      SAVE SIZE WHILE WE TEST IF THERE IS ENOUGH
      ADA =D-1024    MAKE SURE THER IS AT LEAST 1 PAGE OF FREE SPACE
      SSA,RSS 
      JMP SZTS2     STILL POSITIVE SO OK
      JSB PRINT 
      DEF ./A1      GO ABORT
      DEC 11
      ASC 11,EDIT must be sized up. 
* 
SZTS2 EQU * 
      LDA TEMP
      ADA M75       ALLOW 75 WORD BETWEEN BUFFERS 
      CLB 
      ASR 8         DIVIDE BY 256 
*!!!!!!!!!!!!!!!!!!!!!!!! 
* FIX BUG <JDJ>   4-14-80 
*  NEXT LINE ASSUMED THAT THER ARE 48  128-WORD  SECTORS PER TRACK
*     LDB M48       LIMIT BUFFERS 
* 
*     CHANGE TO NUMBER FOR SECTORS WHICH ARE THERE ( 64 FOR 7925 )
      LDB MXSEC     GET THEN NUMBER OF 128W SECTORS PER TRACK 
      CMB,INB       MAKE IT NEG. SO WE LIMIT BUFFER SIZE TO 
*** END OF BUG FIX <JDJ>
      ADB A          TO MIN(SECT2,SECT3)
      SSB,RSS         128 WORD
      LDA MXSEC        SECTORS. 
*   USE 128 WORD SECTORS
*     ALS           CONVERT TO 64 WORD SECTORS
      STA SCT   NUMBER OF INPUT/OUTPUT SECTORS
*     ASL 6         CONVERT SECTORS TO WORDS
      ASL 7         CONVERT SECTORS TO WORDS
      LDB M16       COMPUTE FMGR
      ADB A         BUFFER AREA 
      STB DCBSZ 
      LDB A 
      ADA DBUF$ 
      STA DBEND   END OF OUTPUT BUFFER POINTER
      CMA,INA 
      STA MDBEN   -(DBEND)
      CMB,INB 
      ADB LWA 
      STB SBUF$   START OF INPUT BUFFER.
      LDA TTYLU     GET INPUT DEVICE LU.
      JSB TYPEQ     OBTAIN DEVICE'S EQUIPMENT TYPE. 
      STA NOPRN     IF #0(NOT INTERACTIVE) SET NO-PRINT FLAG. 
      STA ERPRN     ASLO SET AS TYPE TO RESTORE TO AFTER ERROR
      IFZ 
      JSB REMCK     IF THIS IS A REMOTE OPERATION,
      JMP TELND      THEN IDENTIFY THE LOCAL NODE NO.;
      JMP PSF         ELSE, SIMPLY ASK FOR THE FILE ID. 
* 
TELND LDA #NODE     GET THE LOCAL NODE NUMBER.
      CLB 
      JSB DEC       CONVERT THE NODE NO. TO ASCII.
      LDA TBUFF     GET THE ASCII BUFFER ADDRESS. 
      RAL           <A>= SOURCE BYTE ADDRESS. 
      LDB NUMBA     <B>= MESSAGE BYTE ADDRESS.
      MBT OCCNT     MOVE NODE NUMBER(ASCII) TO MESSAGE. 
      LDA MINCT     GET MINIMUM MESSAGE LENGTH (CHARS.) 
      ADA OCCNT     ADD THE NODE NUMBER CHAR. LENGTH, 
      CMA,INA        AND CONVERT TO NEG. CHAR. COUNT. 
      STA TELCN     SET THE MESSAGE LENGTH FOR 'PRINT'. 
      JSB PRINT     PRINT: "EDITING AT NODE XXXXX"
      DEF PSF 
TELCN NOP           CONFIGURED NEG. MESSAGE LENGTH. 
TEMSG ASC 11,EDITING AT NODE 0
MINCT DEC 18
NUMBA DBL TEMSG+8 
      XIF 
PSF   LDA DVTY      CHECK FOR DRIVER 07B
      STA TTYDV       SAVE AS TTY DVR TYPE
      STA ERDVR     SET AS DRIVER TYPE TO RESTORE AFTER ERROR 
      CPA DVR07 
      RSS 
      JMP GETMS     NO, SKIP NEXT CODE
      JSB PRINT      SET TABS AT COLUMN'S 8 AND 23. 
      DEF GETMS 
      DEC -17 
      ASC 9,3&a8C1&a23C1 
********************************************************************* 
* GET TERMINAL MEMORY SIZE IF IT'S A 264X 
GETMS JSB CDVR5       CHECK FOR DVR05 
      JMP INVKM         NO - GOTO GET FILE NAME 
GETM0 EQU * 
      LDA LULOG     GET TERMINALS LU NUMBER 
      IOR =B2500    DRIVER TO READ TERMINAL STRAPS
      STA TEMP
      JSB EXEC      DO A CONTROL REQEST TO READ TERMINAL'S
       DEF GETM6     STRAPS 
       DEF .3.I      NO ABORT BIT SET 
       DEF TEMP 
GETM6  JSB EXCER     REPORT ANY ERROR 
      JSB PRINT       SEND READ STATUS COMMAND
      DEF GETM1 
      DEC -3
      OCT 15536       <ESC>< ^ >
      OCT 57400       < _ ><NUL>
* 
GETM1 JSB EXEC     READ TERMINAL STRAPS 
       DEF GTMER
       DEF I.1
       DEF TTYLU
       DEF EBUFF,I
       DEF MAXIN
GTMER  JSB EXCER  REPORT ERROR
      STB ELNG
      CLA           RESET COUNT SO WE GET THE FIRST CHAR
      STA ECCNT 
      ADB M8        ADD -8
      SSB,RSS       STILL POSITIVE ?
      JMP GETM3       YES - ASSUME 26XX TERMINAL
      LDA ZERO        NO  - MUST BE SOME OTHER TERMINAL 
      STA TTYDV             SO CHANGE DRIVER TYPE TO 00 - NO SCREEN MODE
      STA ERDVR             ALSO CHANGE TYPE TO RESTORE TO AFTER ERROR
      JSB PRINT     GIVE MESSAGE
      DEF INVKM 
      DEC -45 
      ASC 23,non HP26XX terminal - screen mode unavailable
* 
GETM4 JMP GETM7     THIS JUMP IS REPACED SO ONLY ONE
      JSB PRINT        CLOSE IS ATTEMPED. 
      DEF GTMN3 
      DEC 52
      ASC 24,If your terminal has them, disable straps d, g
      OCT 6412  CR LF 
      ASC 27,and enable straps I, T (closed/lower case is disable)
* 
GETM7 CLA     CHANGE JUMP TO HERE INTO A NOP
      STA GETM4 
      JSB PRINT     TRY TO SET STRAPS 
      DEF GETM0     TRY AGAIN 
      DEC 25
      OCT 015446    <ESC>< & >
      ASC 2,s1I 
      OCT 015446    <ESC>< & >
      ASC 21,s0d0g1TSetting terminal straps to d g I T 
* 
GETM5 JSB PRINT 
      DEF GTMN4 
      DEC -22 
      ASC 11,Block mode must be off 
GETM9 JSB PRINT 
      DEF GTMN5 
      DEC 10
      ASC 10,Auto LF must be off
* 
GETM3 EQU *     
      JSB ECH         GET 
      JMP ./A1          THIRD 
      JSB ECH             RESPONSE
      JMP ./A1                CHAR
      JSB ECH                     IF NOT THERE
      JMP ./A1                        ABORT.
      AND B17         MASK OUT UPPER 12 BITS SO ITS K BYTES 
      MPY .10           TO
      CMA,INA            LINES
      STA TMSIZ       SET IT
      JSB ECH        STATUS BYTE 1
      JMP ./A1
      AND B1MSK     CHECK FOR STRAP D CLOSED
      SZA 
      JMP GETM4      NO - GIVES CONFIGURE MESSAGE 
      JSB ECH         GET BYTE 2
      JMP ./A1
* 
* THIS TEST HAS START UP PROBLEMS ON 2635 
*  SO IT IS REMOVED 
*     AND B2MSK     TEST FOR STAP 
*     SZA              G CLOSED 
*     JMP GETM4      NO - GO CONFIGURE
GTMN3 JSB ECH          GET BYTE 3 
      JMP ./A1
      STA TEMP       SAVE IT
      AND B3MSK      TEST FOR NON BLOCK MODE
      SZA 
      JMP GETM5 
GTMN4 LDA TEMP
      AND LFMSK     TEST FOR AUTO LINE FEED 
      SZA 
      JMP GETM9 
GTMN5 LDA TEMP
      AND BIT3        IF BIT 3 SET IT'S A 2645 OR 2648
      SZA,RSS         IS IT SET ? 
      JMP GETM2         NO - SKIP  2645 STUFF 
      LDA =D15         AND  DECREASE MEM SIZE FOR SOFT KEYS 
GETM2 ADA TMSIZ          A REG IS ZERO IF NO SOFT KEYS
      STA TMSIZ 
      LDB =D-100      LIMIT TO MAX OF 100 LINES 
      ADA =D100 
      SSA 
      STB TMSIZ 
      LDA TMSIZ       SET DEFAULT VALUE SAVE AREA 
      CMA,INA 
      STA TMDFT 
* 
* GIVE INVOKED MESSAGE
* 
INVKM LDA TTYLU     SET 
      IOR B600        ECHO BITS ON INPUT LU 
      STA TTYLU 
      JSB PRINT 
      DEF GETFL 
      DEC 11
NAME5 BSS 3 
      ASC 8,: Use ? for help
GETFL EQU * 
* 
RS.1  JSB RCH       STRIP RU, 
      JMP ED%PS       END OF RU STRING - ASK FOR FILE 
      CPA COMMA     COMMA ? 
      RSS             YES - FIND NEXT COMMA 
      JMP RS.1        NO - LOOP 
* 
RS.2  JSB RCH       STRIP JEDIT,
      JMP ED%PS     END OF RU STRING - GO ASK FOR FILE
      CPA COMMA     IS IT A COMMA ? 
      RSS             YES - LOOK FOR FILE NAME
      JMP RS.2        NO - MORE CHARACTERS - LOOP 
* 
RS.3  JSB RCH       MORE SOURCE FILE NAME TO TBUFF
      JMP RS.5        END OF RU STRING - CLEAN UP.
      CPA COMMA     IS CHAR A COMMA ? 
      JMP RS.4        MUST BE START OF A COMMAND
      CPA BAR       IS IT A BAR TO START THE COMMAND
      JMP RS.4        YES - GO SET FLAG 
      JSB OUTCR       NO  - PUT CHAR IN TBUFF 
      JMP RS.3      LOOP TO NEXT CHAR 
* 
RS.4  CCA           SET FLAG THAT THER IS 
      STA PATCH      A COMMAND IN RBUFF 
      LDA RCCNT     SAVE WHERE
      STA TEMP
      JSB SWPET     SWAP FILE NAME INTO EBUFF 
RS.6  JSB RCH       COPY REST INTO TBUFF
       JMP RS.7     END 
      JSB OUTCR 
      JMP RS.6
* 
RS.7  JSB ADDSK     ADD COMMAND TO STACK
       DEF RS.8 
       DEF TBUFF,I
       DEF OCCNT
RS.8  EQU * 
      LDA TEMP      RESTORE R BUFF
      STA RCCNT 
      CLA 
      STA OCCNT 
      JMP ED%FI     GO GET FILE 
* 
RS.5  JSB KILL       NO - ASSUME GARBAGE NOT COMMAND-KILL JUMP
      JSB SWPET     SWAP FILE NAME INTO E BUFFER
      JMP ED%FI     GO READ IN THE FILE IN SEGMENT 0
************************************************************************* 
SCMSK OCT 177763    DON'T USE THIS. IT GETS OVERLAYED 
************************************************************************
* 
* 
*    OVERLAY ONE- TIME CODE 
* 
XYBF0 EQU EDITX      EXCHANGE BUFFER     ( 75 WORDS)
FBUF0 EQU XYBF0+75   DEFAULT FIND BUFFER.( 75 WORDS)
UBUF0 EQU FBUF0+75   UNDO BUFFER         ( 75 WORDS)
LDCB  EQU UBUF0+75   LIST FILE DCB       (144 WORDS)
LERR  EQU *-EDITX-369  CHECK FOR ENOUGH ONE- TIME CODE FORM BUFS
      SPC 1 
* 
*     FBUF0 OVERLAYS CODE AT THE START ('EDIT') WHICH IS
*       NOT NEEDED ONCE SOURCE FILE INFORMATION IS COMPLETE.
*       IT IS ONE OF THE DYNAMICALLY ASSIGNED BUFFERS. SEE
*       COMMENTS FOR EBUF0,ETC. NEAR END OF LISTING.
********
* 
*     UBUF0 IS THE UNDO BUFFER - IT ALSO OVERLAYS CODE
*     LDCB  IS THE LIST FILE DCB
* 
* 
* 
ULNG  BSS 1         LENGTH OF LINE IN UNDO BUFF 
UNFLG DEC 0         IF -1 THEN LAST ./R$ CHANGE CAN BE UNDONE 
R$FLG DEC 0          -1 =>CURRNET LINE HAS BEEN CHANDE BY ./R$
UBUFF DEF UBUF0 
UNTYP DEC 0         UNDO TYPE 
UNNEW DEC 0         TYPE TO BE COPIED TO UNTY AT NODE 2 
UNLIN BSS 1         UNDO INFO - TYPE DEPENDENT
UNREC BSS 1 
UNCNT BSS 1 
* 
FNINT BSS 1         TEMP
* 
      SPC 1 
* 
*** 
* 
L1FLG BSS 1   SET IF LINE SPEC 1 GIVEN
L1GIV BSS 1   SET IF WE SHOULD LOOK FOR  L2 SPEC
L1LIN BSS 1   VALUE OF LINE SPEC 1
L1SAV BSS 1   VALUE OF LINE 1 WITHOUT OFFSET IS SAVED HERE
L1OFF BSS 1   VALUE OF LINE 1 OFFSET
L1PAT BSS 1   FLAG  IF LINE SPEC 1 HAS A MATCH PATTERN
L2FLG BSS 1   SET IF LINE SPEC 2 GIVEN
L2LIN BSS 1   VALUE OF LINE SPEC 2
L2OFF BSS 1   VALUE OF LINE SPEC 2 OFFSET 
L2PAT BSS 1   FLAG FOR L2 MATCH PATTERN 
L2STR BSS 1   FLAG ID STAR SPEC GIVE FOR L2 
* 
LASTL BSS 1   TOTAL NUMBER OF LINES IN SOURCE BUFFER
* 
QUFLG BSS 1   IF SET THEN QUIET OPTION GIVEN
ALLFG BSS 1   IF SET THEN ALL OPTION GIVENEN
REVFG BSS 1   IF SET THEN REVERSE OPTION GIVEN
* 
      SPC 1 
* NOLSF OCT 0         SET TO -1 IF LS UNDEFINED. ! NO LS SUPPORT
N141  OCT -141
N32   OCT -32 
* 
* 
* 
KILL  NOP           SUBROUTINE TO CHANGE SPECIAL COMMAND STRING 
*                     IN TTYIN TO A NOP !!!!
      CLA           GET A NOP INSTRUCTION 
      STA PATCH     AND PATCH IT IN 
      JMP KILL,I    RTN 
* 
* 
* 
POFFG DEC 0        IF SET THEN TERINAL INTERRUPTS ARE OFF 
* 
******************************************************* 
* 
* LCLOS WILL CLOSE THE LIST FILE
* 
* 
LCLOS NOP 
      CLA           CODE
      JSB SLOAD       IS
      JSB ED%CL        IN SEGMENT 0 
      JMP LCLOS,I 
* 
******************************************************* 
*   LSSET RESET THE LIST LU TO THE NUMBER IN A REG
*      AND WILL POST LIST FILE  IOF NEEDED
* 
LSSET NOP 
      LDB LSTLU    GET A COPY OF THE LIST LU
      STA LSTLU 
      SSB,RSS       LISTING TO A FILE ? 
      JMP LSSET,I       NO SKIP POST, RETURN NOW
      CLA           GET SEGMENT 0 
      JSB SLOAD 
      JSB ED%LP     GO POST THE FILE
      JMP LSSET,I   RETURN
* 
***************** 
N1CLR NOP 
      CLA           RESET CHARACTER 
      STA EXFLG      EXCHANGE FLAG
      STA UNCON       AND UNCONDITIONAL EXCHANGE FLAG 
**
      LDB BFLAG     TEST IF BRAK OCCURED
      STA BFLAG     CLEAR FLAG
      SZB                 
      JSB SETTY     YES - RESET TO COMMAND INPUT TO TERMINAL
      LDA CTFLG     SHOULD COMMAND FILE BE CLOSED   ? 
      SSA 
      JMP N1CL5     YES - GO DO IT
N1CL6 LDA LCLOF     SHOUDE WE CLOSE THE LIST FILE ? 
      SSA 
      JSB N1CL3     YES - GO DO IT
      LDA LUCMD     GET THE LAST LU-LOCK COMMAND. 
      SLA           IF THE LIST LU WAS LOCKED,
      JMP N1CL1      THEN GO TO UNLOCK IT.
N1CL2 LDA LULOG     RESET LIST TO TTY 
      JSB LSSET 
      JMP N1CLR,I   RETURN
* 
N1CL3 NOP           GO CLOSE LIST FILE
      CLA 
      STA LCLOF     CLEAR FLAG
      JSB SLOAD     GET SEGMENT 0 
      JSB ED%CL 
      JMP N1CL3,I 
* 
N1CL1 CLA           GET SEGMENT 0 
      JSB SLOAD 
      JSB ED%LK     GO UNLOCK LU
      LDA POFFG     TEST IF BREAK MODE PROMT WAS ALSO OFF 
      SSA 
      JSB ED%PN     YES GO TURN IT BACK ON
      JMP N1CL2     CONTINUE
* 
N1CL5 CLA           CLEAR FLAG
      STA CTFLG 
      JSB SLOAD 
      JSB ED%TC     GO CLOSE COMMAND FILE 
      JMP N1CL6 
* 
******************************
* 
N2CLR NOP 
      LDA SLASH     SET DEFAULT COMMAND TO SLASH
      STA DFCMD 
      LDA NFLG      RESET 
      STA NWFLG       NO WINDOW FLAG
      LDA SPSP      GET TWO SPACES
      STA FILLC     AND SET AS FILL CHAR
      CCA           SET 
      STA LSTFG       LIST FLAG 
      STA SPFLG       AND LEADING SPACE FLAG
      STA R1STF       AND FIRST REPLACE FLAG
      STA BKFLG       AND ALLOW BREAK FLAG
      CLA           CLEAR 
      STA OVFFG     OVERFLOW MESSAGE FLAG 
      STA OKFLG     RE-ENABLE ASKING
      STA FLAGN     LIST FLAG NUMBER
      STA L1FLG     LINE SPEC 1 GIVEN FLAG
      STA L1GIV     LOOK FOR L2 SPEC
      STA L1OFF     LINE SPEC 1 OFFSET
      STA L1PAT     LINE SPEC 1 PATTERN FLAG
      STA L2FLG     LINE SPEC 2 FLAG
      STA L2OFF     LINE 2 OFFSET 
      STA L2PAT     LINE SPEC 2 PATTERN FLAG
      STA L2STR     LINE SPEC RELATIVE LINE SPEC 1 FLAG 
      STA L2DFG     LINE 2 DEFAULTED FLAG 
      STA QUFLG     QUITE FLAG
      STA ALLFG     ALL FLAG
      STA REVFG     REVERSE FLAG
      STA ZRMVF     REMOVE FLAG 
      STA RTNFG       RETURN TO START LINE FLAG 
      STA ROFLG       ER FILE'S DCB FLAG
      STA NLSFG     NEW LIST LU FLAG
      STA NLFLG     NUMBEREDLIST FLAG 
      LDB UNNEW     UPDATE COMMAND TYPE FOR UNDO
      STB UNTYP 
      STA UNNEW 
      LDA MODFG     SET MODFIED FLAG IF NEEDED
      IOR R$FLG     IF COMMAND CALL ./R$ THEN CHANGE
      IOR UNTYP     IF SOME COMMAND SET UNDO TYP THE MOD.OCCURED
      STA MODFG          SET MOD FLAG 
      LDB THIS#     UPDATE POSITIONS FOR RETURN COMMAND 
      STB LAST# 
      LDB T#REC 
      INB 
      STB THIS# 
      JMP N2CLR,I   RETURN
* 
********************************* 
* 
NODE3 JSB N1CLR     DO NODE 1 STUFF 
      JSB N2CLR       AND NODE 2 STUFF
      JMP GETCM     AND START DECODING COMMAND WITHOUT RETRUN 
*                        TO SCREEN MODE CHECK.
DFCMD BSS 1 
* 
********* 
*     READ IN EDIT COMMAND AND ACT ON IT. 
********* 
NODE1 JSB N1CLR     CLEAR FLAGS 
      IFZ 
      CLB 
      LDA INTFL     GET THE INTERACTIVE FLAG. 
      STB INTFL     CLEAR THE INTERACTIVE FLAG. 
      SZA,RSS       IF FLAG WAS SET, SKIP--COMMAND WAS READ.
      XIF 
NODE2 JSB N2CLR     CLEAN UP THINGS 
      CLA           CLEAR E BUFFER
      STA ELNG        IN CASE 
      STA ECCNT         OF A JUMP TO ./QS 
      LDA PATCH    TEST FOR COMMAND LINE EMPTY AND
      CMA           RETURN TO SCREEN MODE FLAG SET. 
      AND QSFLG     SHOULD WE RETURN TO SCREEN MODE ? 
      SLA 
      JMP SMRTN     YES - GO DO IT
GETCM JSB STKIN     INPUT COMMAND AND STACK IT
      LDA ATLOG     TEST FOR EOF
      AND =B240 
      SZA           EITHER BIT SET ?  
      JMP .DOT        YES- TREAT AS A DOT  COMMAND
NODE4 EQU * 
      JSB ECHL      GET FOLDED COMMAND CHAR 
      LDA DFCMD       NONE - USED DEFAULT OF SLASH OR LIST
      STA COMND     SAVE
* 
      CPA "A" 
      JMP ./A 
      CPA "?"       REPORT ER FILE ?
      JMP ./? 
      CPA PLUS      "+" LINE SPEC  ?
      JMP .P/M        YES - GO GET IT 
      CPA MINUS     "-"  LINE SPEC
      JMP .P/M        YES - 
      CPA "^"       ALMOST THE SAME AS "-"
      JMP .ARRW 
      CPA "."       CURRENT LINE  LINE SPEC ? 
      JMP .DOT        YES - 
      CPA STAR      LINE 1 SPEC - 
      JMP .STAR       YES - GO SET
      CPA "$"       LAST LINE LINE SPEC ? 
      JMP .DLLR       YES - 
      CPA ">" 
      JMP .DLLR     SAME AS $ 
      CPA FSCRH     FORWARD SEARCH "'" ?
      JMP .FSRH 
      CPA BSCRH     BACKWARD SEARCH "`" ? 
      JMP .BSRH 
      JSB ASCII     IS IT A ASCCII NUMBER 
      JMP *+2       NO - SKIP 
      JMP .NUMB       YES - GO SET LINE SPEC
      LDA COMND     GET COMMAND BACK
      CPA SLASH     MOVE TO LINE COMMAND
      JMP $SLSH     YES  GO DO IT 
      CPA COMMA     DEFAULT THE LINE ?
      JMP .CMMA       YES - GO SEE IF IT'S LEGAL
      LDB B40       RESET TAB FILL
      STB TBFIL     TO SPACE
      CPA B40         COMMAND?
      JMP O/PEB       NO, OUTPUT LINE 
* 
* ALLOW TAB TO BE SAME AS SPACE COMMAND 
      CPA TABCR      IS COMMAND THE TAB CHARACTER ? 
      JMP O/TAB        YES - GO AND INTERPERT AS IF THERE IS A BLANK
* 
      CPA "P" 
      JMP ./P       DISPLAY CURRENT LINE
      CCB           SET 
      STB TRFLG       LIST
      STB LSTFG         AND TRANSFER FLAGS
      CPA "C"       IF CHARACTER
      JMP $C          COPY OR CHARACTER EDIT ?
      CPA "L" 
      JMP $L
      CLB 
      STB LSTFG     RESET LIST FLAG 
      CPA "K" 
      JMP $K
      CPA "#"       SEQUENCE NUMBER?
      JMP ./# 
      CPA "E" 
      JMP $E
      CPA "N" 
      JMP $N
      CPA "H" 
      JMP $H
      CPA "D" 
      JMP $D
      CPA "J"       JOIN ?
      JMP ./J 
      CCB 
      STB TRFLG     SET TRANSFER FLAG 
      CPA "F" 
      JMP $F
      CPA "B"       COMPLETE TRANSFER AND START SEARCH
      JMP $B          FROM THE BEGINNING
      CPA "S" 
      JMP $S.S
      CPA "O" 
      JMP ./O 
      CPA "M"       MOVE OR MERGE NEW SOURCE? 
      JMP $M       YES GO DO IT 
      CPA "T" 
      JMP $T.S     SET UP SEGMENT FIRST 
      CPA "U" 
      JMP ./U       UNCOND. REPLACE 
      CPA "W"       SPECIFY A WINDOW? 
      JMP $W
      CPA "G" 
      JMP ./G 
      CPA "X" 
      JMP ./X 
      CPA "Y" 
      JMP ./X 
      CLB           CLEAR 
      STB TRFLG       TRANSFER FLAG 
      LDA COMND      RESTORE COMMAND CHARACTER
      CPA "Q"        TERMINAL INTRINSIC EDIT? 
      JMP ./Q        YES, GO TO PROCESS.
      CPA "R" 
      JMP $/R 
      CPA "I" 
      JMP $/I 
ERR   JSB PRTER     PRINT ERROR MESSAGE 
      JMP NODE1     TRY NEXT COMMAND
* 
PRTER NOP 
      JSB ERCLN     CLEAR UP AFTER ERROR
      LDA ECCNT     SAVE CURRENT COMMAND COUNT
      STA TEMP
      CLA 
      STA OCCNT     CLEAR TBUFF COUNT 
      STA ECCNT     RESET COMMAND CHAR COUT TO ZERO FOR RECOPING
      STA SPFLG     AND SPACES FLAG 
      LDA DLMTR     RELIST COMMAND, FIRST OUTPUT DELIM
PERT5 JSB OUTCR 
      JSB ECH       GET CHAR FROM CMMANDF LINE
        JMP PERT6     END OF LINE - BREAK LOOP
      JMP PERT5     LOOP FOR NEXT CHAR
* 
PERT6 LDA TBUFF     RE-LIST LINE
      LDB OCCNT 
      JSB LST           NEXT BUILD A LINE WITH  POINTER 
      CLA           RESET T BUFF COUNT
      STA OCCNT 
      LDA "?"       PUT QMARK IN FIRST CHAR 
      JSB OUTCR 
      LDA TEMP      GET CHAR COUNT OF WHER PARSING FAILED 
**     CPA ELNG       ALL CHAR USED ? 
**     INA           YES- POINT TO LAST CHAR
      ADA =D-1     MOVE IT BACK 
      SSA 
      JMP PRTE2    NEGITIVE SO SKIP LOOP
      CMA,INA,SZA,RSS       MAKE IT A LOOP COUNT
      JMP PRTE2     ZERO SO SKIP LOOP 
      STA TEMP
PRTE1 LDA B40       GET AN BLANK
      JSB OUTCR     OUTPUT IT 
      ISZ TEMP      ENOUGH ?
      JMP PRTE1      NO - DO NEXT 
PRTE2 LDA "^"       GET FLAG TO ERROR 
      JSB OUTCR     OUTPUT IT 
      LDA TBUFF     GET T BUFFER  POINTER 
      LDB OCCNT      AND LENGH
      JSB LST       GO LIST IT
* 
*     JSB PRINT     ERROR 
*     DEF ERCK       IN INPUT 
*     DEC 1           COMMAND 
*     ASC 1,??         PRINT "??" 
*ERCK  JSB KILL      KILL SPECIAL RU STRING PROCESSING
      JMP PRTER,I   RETURN
*** 
THIS# DEC 0         STORAGE FOR . COMMAND 
LAST# DEC 0           " 
R1STF BSS 1         FIRST REPLACE BY ./R$ FLAG
* 
ERCLN NOP           ERROR CLEAN UP
      CLA           CLEAR 
      STA QSFLG       RETURN TO SCREEN MODE FLAG
      STA UNNEW     CLEAR UNDO TYPE 
      STA NLFLG     CLEAR NUMBER LIST LFAG
      JSB KILL      REMOVE ANY REMAINING COMMAND ON A LINE
      JSB SETTY     RESET INPUT, OUTPUT TO TTYLU
      JMP ERCLN,I   REUTRN
* 
* 
%G    OCT 7         BELL  (CONTROL G) 
"="   OCT 75
"G"   OCT 107 
"K"   OCT 113 
"Q"   OCT 121 
"U"   OCT 125 
"V"   OCT 126 
"X"   OCT 000130
B37   OCT 37
B77   OCT 77
DVR07 CCA           MULTIPOINT TYPE CODE
* 
* 
DVR23 OCT 11400     MAG. TAPE TYPE CODE.
DVRTY OCT 37400     DRIVER TYPE MASK
LSTLU BSS 1         LIST LU 
* 
*********************************************************************** 
* 
* 
* 
************************************************************************
* 
*  RPRTW - REPART WINDOW IF DIFFERENT THAN DEFAULT
* 
RPRTW NOP 
      LDA WIND1     GET START OF WINDOW 
      SZA           TEST FOR ZERO 
      JMP RPW.1       NO - SO REPORT WINDOW 
      LDA WIND2     GET END OF WINDOW 
      CPA MAXIN     TEST IF IT'S THE DEFAULT
      JMP RPRTW,I     YES - SO RETURN 
* 
RPW.1 LDA WIND2     MAKE A POSITVE
      CMA,CCE,INA         WIND2,SET E FOR DECIMAL 
      STA TEMP
      JSB CNUMD     CONVERT TO 2 DIGITS 
      DEF RPW.2 
      DEF TEMP
      DEF RPW.E 
RPW.2 LDA "CB"     COMMA BLANK
      STA RPW.E 
      LDA WIND1     GET START OF WINDOW 
      CCE,INA       SET E FOR DECIMAL,INCR SO IT START OF WINDOW
      STA TEMP
      JSB CNUMD 
      DEF RPW.3 
      DEF TEMP
      DEF RPW.S     SET IT IN THE MESSAGE 
RPW.3 LDA "OW"
      STA RPW.S 
      JSB PRINT     PRINT OUT MESSAGE 
      DEF RPRTW,I 
      DEC 8 
      ASC 2,Wind
RPW.S BSS 3 
RPW.E BSS 3 
* 
"CB" ASC 1,,     COMMA BLANK
"OW" ASC 1,ow     LAST PAST OF WINDOW 
* 
******************************************************************* 
* 
*  ./. POSTIONS THE FILE TO WHERE IT WAS BEFORE THE LAST COMMAND
* 
./.   EQU * 
RTN   EQU *         ANOTHER NAME FOR IT 
      LDA LAST#     GET WHERE WE WHERE
      JSB ROLLN     ROLL FILE TO THIS LINE
      JMP DISPL     GO DISAPLAY 
* 
**********************************************************************
* 
**********************************************************************
* 
* ./?  GIVE HELP
* ./?? REPORTS THIS EDITR'S NAME AND ER FILE NAME 
* 
./?   LDA NOPRN     IF NO PRINT MODE
      SZA           THEN DON'T GIVE 
      JMP NODE1      HELP 
      JSB ECH       GET NEXT CHAR 
      JMP ./?2         NONE -GIVE GERNERAL HELP 
      CPA "?" 
      JMP ./??       GIVE DEFAULTS
      JSB PBKE      PUT BACK THE CHARACTER WE ARE LOOKING AT
./?2  JSB NOLSP     MAKE SURE THER WERE NO LINE SPECS 
      LDA .3        GET SEGMENT 3 
      JSB SLOAD 
      LDA UNTYP     UNDO INFO 
      STA UNNEW       STAY THE SAME 
      JSB ED%HE 
       DEF EHELR
       DEF LSTLU
       DEF EBUFF,I
       DEF ELNG 
EHELR EQU * 
      LDA =D4 
      JSB SLOAD 
      JSB ED%H2 
      JMP NODE1     GET NEXT COMMAND
* 
* 
./??  JSB ECH       ANY MORE THAN '??' OR SH
      JMP ./?ER     NO GIVE ER FILE 
      CPA B40       A BLANK ? 
      JMP ./??        YES TRY AGAIN 
      JSB PBKE      PUT BACK THE CHAR 
./SHW LDA .4        REPORT IN SEG 4 
      JSB SLOAD 
      LDA UNTYP     UNDO  
      STA UNNEW       INFO STAYS THE SAME 
      JSB ED%SH     SHOW CODE IN SEG 4
      JMP NODE1 
* 
./?ER LDA FNSIZ     COMPUTE 
      ADA ?MSSZ       MESSAGE SIZE
      CMA,INA 
      STA ./?LE 
* 
      JSB PRINT 
      DEF NODE1 
./?LE BSS 1 
NAME4 BSS 3                                     THIS IS A        !
      ASC 2, on                                   TABLE.         !
FNAME ASC 15,unspecified file               FILE NAMR SAVED HERE !
      BSS 4                 SPACE FOR POSSILE CLOSE MESSAGE 
B^FNM DBL FNAME 
FNSIZ DEC 17        FNAME LENGTH
?MSSZ DEC 10
* 
********************************************************* 
* 
********************************************************* 
* 
ASK   NOP           ASK IF DANGOUS COMMAND ABOUT TO BE EXCUTED
      LDA ASKFG     TEST FLAG 
      SZA,RSS         IF IT IS 0 THEN 
      JMP ASK,I          RETURN NOW.
      LDA OKFLG     TEST IF OK ALREADY GIVEN
      SSA                BY TERMINATING WITH DELIM
      JMP ASK,I     YES - RETURN
      JSB PRINT     SEND MESSAGE
      DEF ASK.1 
      DEC -6
      ASC 2,OK? 
      OCT 003537    < BELL >< _ > 
ASK.1 EQU * 
      JSB YESNO     INPUT YES NO ANSWER 
      JMP ASK,I      YES - RETURN 
      CLA           REMOVE ANY REMAINING COMMANS
      STA PATCH       IN RBUFF
      JSB PRINT       NO - GIVE MESSAGE 
      DEF NODE1       AND ABORT COMMAND 
      DEC 11
      ASC 11,Command not executed.
* 
* 
*************************** 
* 
* PBKE    PUTS BACK  LAST CHAR FOR E BUFF, AREG. IS SAVED 
* 
PBKE  NOP 
      LDB ECCNT     GET CURRENT COUNT 
      ADB M1        BUMP COUNT
      STB ECCNT       BACK ONE
      JMP PBKE,I    RETURN
* 
*************************** 
* YESNO   - RETURN AT P+1 IF YES IS INPUT - ELSE AT P+2 
* 
YESNO NOP 
      CCA           PUT A -1 IN LAST CHAR 
      STA ASKCR      IN CASE THERE ARE NOT ANY CHARS LEFT IN COMMAND
      LDA ELNG      SAVE CURRENT INPPUT 
      STA ASKEL      LENGHT 
      LDA ECCNT        AND
      STA ASKEC          COUNT
      JSB SWPET       NO - SWAP E AND T BUFF
      JSB TTYNO     INPUT WITH NO PROMPT
      LDA ^YES      SET UP
      STA ASKCR       POINTER TO YES. 
YES.1 JSB ECHL      GET FIRST CHARACTER 
      JMP NO..1       NOTHING SO ASSUME NO
      CPA B40       A BLANK ? 
      JMP YES.1       YES - TRY AGAIN 
YES.2 CPA B40       IS IT A BLANK ? 
      JMP YES.4       YES  - TRY NEXT CHAR
      CPA ASKCR,I   IS IT A PART OF Y E S ? 
      JMP YES.3       YES  - CONTINUE LOOKING FOR YES 
NO..1 ISZ YESNO     NOT YES OR BLANK - BUMP RETURN ADDRESS
* 
YES.9 JSB SWPET     CLEAN UP - SWAP T AND E BUFF BACK 
      LDA ASKEL 
      STA ELNG
      LDA ASKEC 
      STA ECCNT 
      JMP YESNO,I   AND RETURN
* 
YES.3 ISZ ASKCR 
YES.4 JSB ECHL
      JMP YES.9     NO MORE CHAR. RETURN AT YES POINT 
      JMP YES.2     MORE CHAR - TRY THIS ONE
* 
ASKEL BSS 1 
ASKEC BSS 1 
ASKCR BSS 1 
YESSG OCT 131       "Y"  THIS        \
      OCT 105       "E"    IS A      !
      OCT 123       "S"      TABLE.  /
^YES  DEF YESSG 
* 
******************************************************************
* 
*  CSTRIP WILL STRIP INPUT BLANKS, STRIP ONE COMMA THEN STRIP 
*    ANY ADDITIONAL BLANKS. 
*     RETURNS AT P+1 IF E BUFF IS EMPTY OR HAS TWO COMMAS SEPERATED ONLY
*        BY BLANKS (DEFAULTED PARAMETER,SECOND COMMA LEFT IN E BUFF)
*     ELSE RETURNS AT P+2 
* 
* 
CSTRP NOP 
CSTR1 JSB ECH       GET CHAR
      JMP CSTRP,I     NONE SO RETURN
      CPA B40       A BLANK ? 
      JMP CSTR1       YES - TRY NEXT C
      CPA COMMA     A COMMA ? 
      JMP CSTR4       YES - THROW IT AWAY 
CSTR2 ISZ CSTRP     SOME IN BESIDES COMMAS OR BLANK SO BUMP RETURN
CSTR3 JSB PBKE      PUT CHAR BACK 
      JMP CSTRP,I   RETURN
* 
CSTR4 JSB ECH       COMMA FOUND - LOOK FOR MORE BLANKS
      JMP CSTRP,I     NOTHING AFTER COMMA SO USE DEFAULT RETURN 
      CPA B40       IS THIS ANOTHER BLANK 
      JMP CSTR4        YES - TRY NEXT 
      CPA COMMA     SECOND COMMA ?
      JMP CSTR3       YES - PUT IT BACK AND USE DEFAULT RETURN
      JMP CSTR2       NO  - PUT IT BACK AND USE NORMAL RETURN 
* 
****************************************************************
* 
****************************************************************
* 
* CDVR5 CHECKS FOR DVR05  AND RETURN TO P+1 IF SO 
CDVR5 NOP 
      LDA TTYDV  GET DRIVER TYE 
      CPA DVR05 
      ISZ CDVR5   YES - BUMP RETURN 
      JMP CDVR5,I RETURN
* 
* O/TAB BACKS UP COMMAND PIONTER SO TAB WILL BE SEEN
O/TAB JSB PBKE
      JMP O/PEB     NOW GO AND PROCESS AS IF A BLANK WAS FIRST
* 
* 
* 
* LIST WITH LINE NUMBERS
* 
#LST  NOP 
      CLA             RESET 
      STA OCCNT   OUTPUT CHAR COUNT 
      STA SCCNT   SOURCE CHAR COUNT 
      LDA B40      SEND FIRST BLANK OR ">"
      LDB FLAGN     FLAGN WILL BE ZERO IF NO ">" WANTED 
      SZB,RSS         ZERO - DON'T OUTPUT ">" 
      JMP #LST1   JUMP OVER TEST FOR EQUAL
      CPB LINES   IS THIS LINE THE CUURENT LINE ? 
      LDA B76       YES - OUTPUT ">" INSTEAD OF BLANK 
#LST1 JSB OUTCR 
      LDA T#REC     GET LINE NUMBER IN DEST FILE
      INA             PLUS 1
      LDB TRFLG     IF WERE ARE IN TRANSFER MODE
      SSB,RSS       USE THIS NUMBER 
      LDA LINES   ELSE USE SOURC LINE NUMBER
      CLB 
      JSB DEC     AND OUTPUT
      LDA B40     ANOTHER BLANK 
      JSB OUTCR   OUTPUT CHAR 
      LDB SLNG    GET SOURCE LENGHT 
      SSB         IF AT EOF 
      JMP #LST,I      RETURN
#NLOP JSB SCH     GET SOURCE CHAR 
      JMP #NDON       LAST CHAR - EXIT
      JSB OUTCR   MOVE TO OUTPUT
      JMP #NLOP       NEXT CHAR 
#NDON LDA TBUFF       GET OUT BUFFER ADDRESS
      LDB OCCNT   AND CHAR COUNT
      JSB LST     WRITE THEM OUT
      JMP #LST,I  RETURN
* 
*  Q COMMAND PROCESSOR
* 
*./Q.. JSB ECHL        GET NEXT CHARACTER 
*      JMP ERR         NOTHING - ERROR
*      CPA "R"       RUN A PROGRAM ?
*      JMP ./QR 
*      CPA "Z"     DEBUG MODE 
*      JMP ./QZ 
* 
*      JMP ERR       NOT KNOWN - ERROR
* 
************************************* 
* 
* SEGMENT LOAD ROUTINE
* 
*   ENTRY - SEGMENT NUMBER IN A REG.
* 
SNUM  DEC -1        CURRENT SEGMENT NUMBER
^SGNM DEF SGNM
EDIT0 ASC 3,EDIT0   THIS     \
EDIT1 ASC 3,EDIT1    IS A    !
EDIT2 ASC 3,EDIT2      TABLE !
EDIT3 ASC 3,EDIT3            !
EDIT4 ASC 3,EDIT4            /
SGNM  EQU EDIT0 
* 
SLOAD NOP 
      CPA SNUM      IS IT EQUAL TO CURRENT SEG? 
      JMP SLOAD,I   YES - RETURN NOW
      STA SNUM      NO -  SET AS NEW NUMBER 
      MPY .3        COMPUTE POINTER 
      ADA ^SGNM      TO SEGMENT 
      STA SLO.1        NAME AND SET IT. 
      JSB SEGLD        DOES NOT RETURN IF SUCCESSFUL
        DEF SLOA1 
SLO.1   DEF *          NAME PATCHED IN HERE 
        DEF JUNK
SLOA1   EQU * 
* 
      CCA           SEG MISSING; SET CURRENT
      STA SNUM        SEGMENT NUMBER TO ILLEGAL VALUE 
      JSB PRINT 
      DEF SEGE1 
      DEC -24 
      ASC 12,SEGMENT LOAD ERROR FOR _ 
* 
SEGE1 LDA SLO.1     GET ADDRESS OF NAME 
      LDB .6        AND IT LENGTH 
      JSB LST       AND PRINT NAME
      JMP ERR       THEN GO TO ERROR POINT
* 
* 
SRTN  JMP SLOAD,I   SEGMENT WILL JUMP TO HERE 
* 
* 
********
* TRANSFER FILE COMMAND 
* 
./QT  EQU * 
***   JSB CSTRP     STRIP A COMMA AND BLANKS
***   JMP ERR       NOTHING SO ERROR
      CLA 
      JSB SLOAD 
      JMP ED%TR 
* 
* 
*     JSB SETOK     STRIP LAST SLASH
*     JSB NUMIN     GET THE LU NUMBER 
*     SZA,RSS       IS IT ZERO
*     JMP ERR       YES - GO GIVE ERROR 
*     STA TEMP
*     JSB ASK 
*     LDA TEMP
*     STA LULOG     SAVE AS INPUT LU
*     IOR =B400 
*     STA TEMP
*     JSB EXEC      REWIND THE LU 
*       DEF ./QT1 
*       DEF I.3       CONTROL REQUEST - REWIND THE LU 
*       DEF TEMP
*./QT1   JMP ERR       REPORT ERROR IF THERE WAS ONE
*      LDA LULOG
*      IOR B600      SET ECHO BITS
*      STA TTYLU
*      STA LSTLU     SAVE AS LIST LU
*      JSB TYPEQ     CHECK EQT TYPE 
*      STA NOPRN     SET LISTING FLAG 
*      LDA DVTY      RESET TYPE LU
*      STA TTYDV
*      JMP NODE1     GET NEXT COMMNAD 
**
* 
./QCL JSB ENDCK     MAKE SURE THERE ARE NO MORE CHARS 
      JSB LCLOS     GO CLOSE LIST FILE
      JMP NODE1     GETR NEXT COMMAND 
* 
***** 
* 
********************************
QCSFG DEC 0         CLOSE SOURCE FLAG - IF SET FILWR WILL JUST CLOSE
* 
./J  JSB DFL1S      REPOSITION IF REQUESTED 
     LDA .4         JOIN CODE IS IN SEGMENT FOUR
      JSB SLOAD 
      JMP ED%.J 
* 
* 
************************************************
*   TERMINAL INTERSINIC LINE EDIT 
* 
./QP  LDA .4        QP CODE IS IN SEGMENT 4 
      JSB SLOAD 
      JMP ED%QP 
* 
$S.S  JSB ECHL      TRY NEXT CHAR 
      JMP SMODE     NONE SO SCREEN MODE 
      CPA B40       A BLANK ? 
      JMP $S.S1 
      STA KMAX      SAVE THE CHAR IN A TEMP 
      JSB NOLSP     MAKE SURE THER WER NO LINE SPECS
      LDA =D4       GET SEGMENT 4 
      JSB SLOAD 
      LDA KMAX      GET CHAR BACK AGAIN 
      CPA "E" 
      JMP ED%SE     GO SET OPTIONS
      CPA "H" 
      JMP ./SHW     GO SHOW OPTIONS 
      JSB ENDCK     CHECK THAT THIS IS LAST CHAR
      LDA KMAX      GET CHAR BACK 
      CPA "C"       SCREEN SNARF (COPY) ? 
      JMP ED%SC       YES - GO TO DO IT IN A SEGMENT
      CPA "Z" 
      JMP ./S       GO SHOW SIZE
$S.S1 JSB PBKE      PUT THE CHAR BACK 
      JSB ENDCK     CHECK IF IF ONLY BLANKS REMAIN
      JMP SMODE       YES - GO TO SCREEN MODE 
* 
* 
************************************************
* 
************************************************
* 
*  GET LINE NUMBER FOR SCREEN MODE IS IN MAIN BECASUE IT
*     USES SEG 0,SEG 2 AND SEG 4
* 
* 
SMRTN LDA T#REC   TEST IF LINE CHANGED ?
      INA 
      CPA DOWN
      JMP SNEXT   YES - LIST SAME SCRREN
* 
SMODE JSB CDVR5 
        JMP ERR     SORRY - SCREEN MODE ONLY WORK ON DRIVER 5 
      LDA T#REC     GET CURRENT LINE
      INA 
      STA DOWN        NUMBER  FOR CURSOR POSITION 
      JMP SMOD0 
* 
* 
SNEXT JSB SETAB   SET ABSOUTE LINE ADRESSING
      LDA DOWN    GET  WHERE TO PUT CUSOR 
      STA L1LIN   SET IT
      CMA,INA     COMPUTE NUMBER OF LINES ABOVE 
      ADA SMTSV    AND SET AS -OFFSET LINES 
      STA L1OFF 
      LDA SMBSV   GET SCREEN MODE SAVED BOTTOM LINE 
      STA L2LIN     SET IT
SMOD0 CLA 
      STA LSTFG 
      LDA R$FLG     COPY
      STA TRFLG       CURRENT LINE CHANGED FLAG TO TRANSFER FLAG
      SZA           IF SET
      JSB TR          THEN TRANSFER CURRENT LINE
      LDA ABOVE     COMPUTE 
      CMA,INA          DEFAULT
      ADA DOWN            START LINE
      SSA 
      CLA,INA       IF <0 USE LINE 1
      JSB PSL1      GET FIRST LINE NUMBER 
      JMP L1ERR 
      LDA LINES     SAVE SOURCE START LINE NUMBER 
      STA SSTRT 
      LDA L1LIN 
      ADA ABOVE 
      ADA BELOW 
      LDB =D32767 
      JSB GETL2 
      JMP L2ERR 
      STA Q#LST     SAVE THE NUMBER TO LIST 
      LDA POFFG     SET IF PROMT IS ALREADY OFF 
      SSA 
      JMP SMOD1       YES - SKIP TURNNING IT OFF AGAIN
      CLA           GET SEGMENT 0 
      JSB SLOAD 
      JSB ED%PF     TURN OF BREAK MODE PROMPT 
SMOD1 LDA =D4       GET 
      JSB SLOAD       SEGMENT 4 
      JMP ED%SM    GO COMPLETE SCREEN MODE
* 
* 
* 
************************************************
* 
*   T CODE IN SEG 4, BUT MUST POSITION FOR TI COMMAND FIRST 
*     BECAUSE IT MAY USE SEG 2
* 
$T.S  EQU * 
      JSB ECHL
       JMP ERR
      CPA "I" 
      JMP .TIME 
      JSB PBKE
      LDA .4
      JSB SLOAD 
      JMP ED%.T 
* 
* 
.TIME JSB NUMIN     GET THE START COLUMN
      STA TEMPT 
      JSB ENDCK     MAKE SURE THERE ARE NO MORE CHARS 
      JSB DFL1S     MOVE TO LINE SPECIFIED
      LDA .4
      JSB SLOAD 
      LDA TEMPT 
      JMP ED%TI     GO DO TIME COMMAND IN SEG 4 
* 
TEMPT BSS 1 
* 
**************************************************
* 
* 
PSSAV BSS 1 
MLFLG DEC 0         MEMORY LOCK FLAG
SPFLG DEC 0         LEADING SPACES FLAG DURING LST
QSFLG DEC 0         IF SET THEN GO TO SCREEN MODE AT NODE2
BYCNT BSS 1         LINE COUNT SENT TO TERMINAL 
ABOVE DEC 10        SCREEN SIZE ABOVE 
BELOW DEC 10        SCREEN SIZE  BELOW
OLAP  DEC 2         SCREEN OVERLAP
VWABV DEC 10        VERT. WINDOW LINES ABOVE
VWBLW DEC 10         "     "      "    BELOW
DSPFG DEC -1        IF -1 THEN DISPLAY FUNCTIONS IN SCREEN MODE 
^DSPF DEF DSPFG 
* 
* 
************************************************
* 
*  RUN A PROGRAM  - WORK IS DONE BY SUBROUTINE RUN
* 
*         CALL RUN(STRING,STR LENGTH,PARAM FOR CLONING CONTROL) 
*                  STRING IS OF FORM :
*                      QR,NAME,PARAMS OR STRING 
* 
./RUN JSB NOLSP     MAKE SURE THERE ARE NO LINE SPECS 
      LDA EBUFF     GET INPUT BUFFER
      STA RUNCM     SET IT IN CALL
      CLA,INA       GET SEGMENT ONE 
      JSB SLOAD 
      JSB ED%RU     GO DO IT
      DEF RUN.R 
RUNCM BSS 1 
      DEF ELNG
      DEF ZERO
RUN.R SZA           CHECK FOR ERROR 
      JMP RUNER       YES - GO PRINT IT 
RUNEX JSB PRINT      PRINT RESUME MESSAGE 
      DEF ./?ER        RETURN TO PRINTING OF NAME 
      DEC -8
      ASC 4,Resume _           *
* 
RUNER LDB SPSP      IS NEGITIVE ? 
      SSA,RSS 
      JMP RUNE1       NO
      LDB SPM 
      CMA,INA       MAKE IT POSITIVE
RUNE1 STB RUNMS 
      CCE           SET E FOR DECIMAL 
      JSB $CVT1 
      STA RUNMN 
      JSB PRINT 
      DEF RUNEX 
      DEC 12
      ASC 10, fmgr cloning error 
RUNMS BSS 1 
RUNMN BSS 1 
* 
SPM   ASC 1, -
* 
*************************** 
* 
./QE  CLA           GET SEGMENT ZERO
      JSB SLOAD 
      JSB ED%WR    GO DO FILE STUFF AND RETURN
      NOP          INGOR ERRORS 
      JMP DISPL    GO DISPLAY CURRENT LINE
* 
********************************* 
* 
* 
* 
* 
* 
******************************* 
**
NSAVE BSS 1 
Q#COP BSS 1 
QAFLG BSS 1 
* 
************************************************************* 
* 
* PSLN - POSITION TO A SOURCE LINE  WITHOUT MOVING DEST FILE. 
*     CLEARS   LIST FLAG,TRANSFER FLAG, 
*     NO BREAKS ARE ALLOW DURING POSITIONG, ALLOW BREAK FLAG IS SET ON EXIT 
* 
PSLN  NOP 
      STA PSSAV       SAVE LINE NUMBER
      CLA 
      STA TRFLG       CLEAR THE TRANSFER FLAG 
      STA BKFLG         AND ALLOW BREAK FLAG
      STA LSTFG         AND LIST FLAG 
      CLA,INA          AND
      STA LINES         THE LINE NMBER
      JSB SETSO       SET UP THE INPUT
      JSB SQ          READ FIRST BLOCK
      LDA SLNG        TEST FOR EOF
      SSA 
      JMP PSLN,I      RETURN IF EMPTY 
      CCA 
      ADA PSSAV       GET BACK (LINE NUMBER -1) 
      JSB TRN          AND MOVE THE LINES 
      CCA             RESET 
      STA BKFLG        ALLOW BREAK FLAG 
      JMP PSLN,I      RETURN
******************************************
* 
*   TRN TRANSFER N LINES (N IN A REG.) USING TR 
*     IF MEMORY LOCK FLAG IS SET THEN LIMIT NUMBER OF BYTES 
*     TO WHAT THE TERMINAL CAN SUPPORT. 
* 
*     IF A BREAK OCCURS THE TEH TRANSFER IS STOPPED 
* 
TRN   NOP             TRANSFER N LINES( N IN A REG.)
      CMA,INA         GET NEGITIVE
      SSA,RSS         IF ZERO OR NOW POSITIVE RETURN
      JMP TRN,I 
      STA TRCNT 
      CCA             SET 
      STA BKRTN        BREAK RETURN FLAG
      LDA TMSIZ       COPY -MAX NUMBER OF LINE TO BYCNT 
      STA BYCNT 
.TRN1 JSB TR          TRANSFER
      JMP .TRN2         NO BREAK
      JMP .TRN3         BREAK OCCURED 
.TRN2 SSB             EOF ? 
      JMP .TRN3         YES - FIX UP AND RETURN 
      LDA MLFLG       GET MEMORY LOCK FLAG
      SSA,RSS         SET ? 
      JMP .TRN4         NO - SKIP BYTE COUNT LIMITING 
      LDA LSTFG       GET LIST FLAG 
      SSA,RSS         SET ? 
      JMP .TRN4         NO - NOT LISTING SO SKIP BYTE COUNT 
      LDB SLNG        TEST IF LINE IS 2 LINES ON THE SCREEN 
      ADB =D-79       78 CHAR WILL FIT ON ONE LINE
      SSB 
      JMP .TRN5         NO - JUST DO ONE ISZ
      ISZ BYCNT 
      JMP .TRN5 
      JMP .TRN3       LIMIT EXCEEDED - GO WRAP UP 
.TRN5 ISZ BYCNT       TEST IF WE HAVE SENT TOO MANY LINES 
      JMP .TRN4       NO - CONTINUE 
      JMP .TRN3         LIMIT EXCEEDED SO WRAP UP 
* 
.TRN4 ISZ TRCNT       DONE ?
      JMP .TRN1           NO - DO NEXT LINE 
.TRN3 CLA                 YES - CLEAR 
      STA BKRTN         BREAK RETURN FLAG 
      JMP TRN,I         RETURN
* 
* 
TRCNT BSS 1 
* 
******************
*^^^^^^^^^^^^^^^^^^^^^^^
./QZ     JMP ERR
*^^^^^^^^^^^^^^^^^^^^^^^
* 
* 
************************* 
NLSFG DEC 0         IF NON-ZERO THEN  LIST LU WAS CHANGED BY BY LSLU
* 
      SPC 1 
* 
**************************************
* 
LOPNF DEC 0         LIST FILE OPEN FLAG. IF -1 THEN OPEN
LCLOF DEC 0         IF SET THEN CLOASE LIST FILE AT NODE 1
^LNAM DEF LNAM
LNAM  BSS 10        LIST FILE NAMR SAVE AREA
* 
******************************************
* 
LUCMD OCT 140001    NO WAIT/NO ABORT/LOCK 
IOPT  OCT 140000    FIRST TIME: UNLOCKS ANY LU'S. 
BIT14 OCT 40000 
DVTY  NOP 
* 
* 
****************************************************
* 
./#   JSB SETOK     GET OK FLAG IF SLASH PRESENT
      JSB NOLSP     MAKE SURE THER ARE NO LINE SPECS
      LDA M3        SKIP OVER 
      STA COUNT     ALPHA COMMENT.
./#0  JSB ECH 
      NOP 
      ISZ COUNT 
      JMP ./#0
      JSB NUMIN     FETCH START NUMBER
      STA BASE       AND SAVE AS BASE 
      JSB NUMIN     FETCH 2ND NUMBER
      SZA,RSS       IF ZERO SET 
      LDA .10        TO 10 AND
      STA INCR        SAVE AS INCREMENT 
******************************************
*  ASK FIRST
* 
      JSB ASK 
* 
******************************************* 
      CCA           SET 
      STA MODFG       MODIFIED FLAG 
      JSB ./B1       GO TO BEGINNING OF FILE
      LDB SLNG      AT EOF ?
      SSB 
      JMP EOFPR       YES- GO PRINT IT
      SPC 1 
./#1  CLA           RESET CHARACTER OUTPUT
      STA OCCNT      COUNTER
      LDA M72       MOVE
      STA COUNT      FIRST 72 
./#2  JSB SCH         CHARACTERS
      JMP SPC          OF SOURCE
      JSB OUTCR         TO OUTPUT 
      ISZ COUNT          BUFFER 
      JMP ./#2
      JMP ./#3
      SPC 1 
SPC   LDA B40       BLANK 
      JSB OUTCR       FILL TO 
      ISZ COUNT       COLUMN 72 
      JMP SPC 
./#3  CLA,INA       SET UP COMMAND
      STA ECCNT      BUFFER COUNTER 
      LDA M3        SET UP LOOP 
      STA COUNT      COUNTER FOR 3 CHARACTERS 
./#4  JSB ECH       FETCH NEXT ALPHA COMMENT
      LDA B40       LOAD BLANKS IF NO COMMENT 
      JSB OUTCR     OUTPUT CHARACTER
      ISZ COUNT     THIRD CHARACTER?
      JMP ./#4      NO, FETCH NEXT CHARACTER
      SPC 1 
      LDA BASE      OUTPUT LINE NUMBER
      CLB 
      JSB DEC        IN ASCII 
      LDA BASE      UPDATE
      ADA INCR       LINE 
      STA BASE        NUMBER
      LDA OCCNT     OUTPUT CHARACTER
      LDB TBUFF       TO DISC BUFFER
      JSB DOUTP 
       JMP ABORT      IF ERROR JUST REPORT MESSAGE
      JSB I/PSB     INPUT NEXT RECORD 
      SSB           AT EOF? 
      JMP EOFPR     YES, PRINT "EOF"
      JMP ./#1      NO, CONTINUE
      SPC 1 
* 
**************************************
DVR05 CLA             USED AS DATA
TBFIL OCT 40
M72   DEC -72 
FLNG  DEC -1
FBUFF DEF FBUF0     CURRENT F MATCH BUFFER
JDEF$ NOP           INDEFINITE PROCESSING FLAG
*                     ALSO USED FOR <BASE>
IDEF$ NOP           FIRST CHAR AFTER INDEF FLAG 
*                     ALSO USED FOR <INCR>
**************************************************************************
* 
*   TAB PERFORMS THE TAB OPERATION
TAB   NOP 
      CCA 
      STA MODFG     SET THE MODIFIED FLAG 
      CLA           RESET OUTPUT
      STA OCCNT      CHARACTER COUNTER AND
      STA CNTRL       NON-CONTROL CHARACTER COUNTER 
      LDA TABUF     RESET 
      STA TBPNT      TAB POINTER
TAB1  JSB ECH      GET NEXT COMMAND CHARACTER 
      JMP TAB,I    END OF COMMAND 
      CPA ESCCH     IS IT THE ESCAPE CHAR 
      JMP TABES       YES GO ESCAPE NEXT CHAR 
      CPA TABCR    TAB CHARACTER ?
      JMP TBFND    YES, GO TO TAB FOUND 
      CPA RCHAR     IS IT A SPECAIL REPACE CHAR 
      LDA RFLAG     YES - REPLACE IT WITH A UNSED CHAR. 
TAB2  LDB A         IS CHARACTER
      CMB            CONTROL
      ADB B40         CHARACTER 
      SSB           IF YES DO NOT INCREMENT 
      ISZ CNTRL      NON-CONTROL CHARACTER COUNTER
TAB3  JSB OUTCR    NO, OUTPUT CHARACTER 
      JMP TAB1
* 
TABES JSB ECH       GET NEXT CHAR 
       LDA ESCCH      NONE SO ESCAPE CHAR AT END OF LINE IS ITSELF
      JMP TAB2      CONTINUE TABBING LINE 
* 
TBFND CCB          SET SPACE COUNTER
      STB CNT1     TO -1
      LDB TBPNT,I    TAB POINTER
      SZB,RSS         ZERO? 
      JMP SPACE     YES, OUTPUT SPACE 
      ISZ TBPNT    BUMP TAB POINTER ADDRESS 
      ADB CNTRL      PAST 
      SSB,RSS         TAB?
      JMP TBFND+2  YES, GET NEXT TAB
      STB CNT1     STORE SPACE COUNTER
SPACE LDA TBFIL    LOAD SPACE 
      JSB OUTCR    OUTPUT SPACE 
      ISZ CNTRL     BUMP NON-CONTROL CHAR. CNTR.
      ISZ CNT1     LAST SPACE?
      JMP SPACE    NO, CONTINUE SPACING 
      JMP TAB1     GET NEXT CHARACTER 
* 
************************************* 
RFLAG OCT 200       UNSED CHAR  - NULL WITH PARITY BIT SET
RCHAR BSS 1           CHAR TO BE REPLACE BY RFLAG 
* 
ANCCH OCT 136       "^"     !THESE
ESCCH OCT 134       "\"     !   MAY BE
INDEF OCT 100       "@"     !    CHANGED
WIND1 NOP        WINDOW     !       WITH THE
WIND2 DEC -150     COLUMNS. !          SET COMMAND. 
      SPC 1 
* 
B54   OCT 54        "," 
* 
B200  OCT 200       PARITY BIT
* 
TABUF DEF TAB0
* 
*   DEFAULT TABS ARE COLUMNS 7 AND 21 
TAB0  DEC -6,-20,0,0,0,0,0,0,0,0,0
* 
TABCR OCT 11        DEFAULT TAB CHARACTER = "HORIZONAL TAB" 
TABCH EQU TABCR 
* 
TBPNT NOP 
      SPC 1 
* 
********************************************* 
* 
*  SWPET  SWAPS EBUFF AND TBUFF 
* 
SWPET NOP           USED AS TEMP <CNTRL>
      LDA TBUFF     SWAP
      LDB EBUFF      EBUFF
      STA EBUFF       AND 
      STB TBUFF        TBUFF
      LDA OCCNT     STORE OUTPUT CHARACTER
      STA ELNG       LENGTH IN COMMAND LENGTH 
      CLB           RESET COMMAND 
      STB ECCNT      AND OUTPUT 
      STB OCCNT       CHARACTER POINTERS
      JMP SWPET,I 
      SPC 1 
******************************************************* 
* 
*     TR TRANSFERS CURRENT SOURCE LINE TO DEST. AND GETS NEXT LINE
* 
BKFLG OCT 0           TR BREAK ALLOW IF SET TO -1 
* 
TR    NOP 
      CLB           CLEAR 
      STB UNFLG       UNDO FLAG 
      STB R$FLG       CURRENT LINE CHANGER FLAG 
      LDB SLNG      IF AT 
      SSB            EOF, 
      JMP TR,I        RETURN
      LDA OVFFG     TEST OVERFLOW FILE SIZE 
      SSA 
      JMP BREAK       SET;TREAT AS A BREAK! 
      LDA BKFLG     SHOULD WE 
      SSA,RSS       LOOK FOR  BREAKS ?
      JMP NOBRK       NO - SKIP IFBRK CALL
      JSB IFBRK     GET BREAK STATUS AND CLEAR. 
        DEF IFBRR 
IFBRR EQU * 
      SZA            IF NOT 0 THEN STOP WHAT IS GOING ON. 
      JMP BREAK 
NOBRK LDB LSTFG     LIST CURRENT
      SZB            RECORD?
      JSB LSTSB      YES, PERFORM LIST
      LDB LEFLG     ERROR DURRING LIST
      SSB 
      JMP LEBRK     YES - TREAT AS A BREAK
      LDB TRFLG     TRANSFER RECORD TO
      SZB,RSS        DESTINATION FILE?
      JMP TR1          NO SKIP OUTUT
      JSB O/PSB     YES, OUTPUT RECORD
        JMP BREAK     ERROR OCCURED - TREAT AS A BREAK
TR1   JSB I/PSB      GET NEXT RECORD
      JMP TR,I
      SPC 1 
* 
LEBRK CLA           CLEAR LIST ERROR FLAG 
      STA LEFLG     LISTING WITH NO BREAK IS ILLEGAL
* 
BREAK IOR BFLAG     SAVE FLAG TO TERMINATE TRANFER FILE 
      STA BFLAG 
      LDA BKFLG     IS A BREAK OK ? 
      SSA,RSS 
      JMP NOBRK       NO - IGNORE IT
      LDA BKRTN   TEST FOR BREAK RETURN 
      SSA,RSS         IS RETURN REQUESTED ? 
      JMP DISPL         NO - DISPLAY CURRENT LINE 
      ISZ TR            YES - 
      JMP TR,I            RETURN AT P+2 
* 
BFLAG OCT 0           IF SET THE BREAK OCCURED -
*                         CLEARED AT NODE 1 
BKRTN OCT 0           IF -1 RETURN AT P+2 IF BREAK, ELSE P+1
LEFLG OCT 0           IF -1 THEN ERROR DURRING LIST 
* 
      SPC 1 
* 
******************************************
* 
* NUMIN FETCHES A NUMBER -
*   LEADING SPACE ARE STRIPED AND ONE COMMA - IF COMMA COMMA THEN DEFAULT 
*     NUMBERS MUST START WITH A DIGIT AND END WITH  SPACE OR
*     COMMA.
*      IF NOT NUMBER WILL *JUMP* TO ERR 
* 
* 
*   XYZ 123,  IS OK 
*   XYZ  , 123  IS OK 
*   XYZ  , ,    RETURNS ZERO
* 
* 
NUMIN NOP 
      CLA           CLEAR 
      STA NISAV        THE REUTRNED VALUE 
      JSB CSTRP     STRIP BLANKS, ONE COMMA 
        JMP NMIN3     DEFAULTED - SO RETURN 
      JSB ECH       GET THE NEXT CHAR 
        JMP NMIN3      NONE SO DEFAUTL
      JSB ASCII     CHECK IF IT IS A DIGIT
      JMP ERR          NO - SO ERROR
* 
      JSB PBKE
      JSB GETNM     GET THE NUMBER
      STA NISAV 
NMIN3 LDA NISAV     GET NUMBER
      JMP NUMIN,I     RETURN
* 
NISAV DEC 0 
* 
       SPC 1
******************************************************* 
*     ASCII CHECK IF CHAR IN A REG IS A DIGIT 
*       RETURNS AT P+2 WITH INTEGER VALUE IF IT IS A DIGIT
*                  P+1 IF CHAR IS NOT A DIGIT 
* 
ASCII NOP 
      STA ASCTP     SAVE CHARACTER
      ADA M58       GREATER THAN
      SSA,RSS        "9" ?
      JMP ASCII,I   YES, RETURN 
      ADA .10       LESS THAN 
      SSA,RSS        "0" ?
      ISZ ASCII     NO, BUMP RETURN ADDRESS 
      JMP ASCII,I 
* 
ASCTP BSS 1 
      SPC 1 
COUNT NOP 
MTCH  NOP           ALSO <NEGFL>
NUM1  NOP           ALSO <T1> 
NUM2  NOP 
WINDF NOP 
NUM10 NOP           ALSO <T2> 
UNCON NOP 
* 
* 
* 
XLNG  DEC -1
YLNG  NOP 
YOFFS NOP 
* 
* "OUTCR" OUTPUTS ONE CHARACTER TO TBUFF
OUTCR NOP 
      LDB OCCNT     TEST IF 
      CPB MAX         LINE WOULD BE TO LONG 
      JMP OUTCR,I   YES - RETURN NOW
      CLE,ERB 
      ADB TBUFF 
      SEZ,RSS 
      JMP OUTC1     CHAR TO GO IN HIGH BYTE 
      XOR B,I       CHAR TO GO IN LOW BYTE
      AND LOWBT     USE RULES OF
      XOR B,I         OF WOO TO REPLACE LOW BYTE. 
OUTC2 STA B,I 
      ISZ OCCNT 
      JMP OUTCR,I 
* 
OUTC1 ALF,ALF       SHIFT CHAR TO HIGH BYTE 
      IOR B40       OR IN A BLANK 
      JMP OUTC2     GO SET IT 
* 
      SPC 1 
* 
************************
* 
* 
DLMTR OCT 57        DEFAULT DELIMITER IS "/"
.6400 OCT 6400
* 
DLMST STA DLMTR 
      IOR .6400     SET UP PROMPT 
      STA /          CHARACTER
      JMP NODE1 
* 
****
* 
* 
XYBUF DEF XYBF0     POINTS TO EXCHANGE BUFFER 
* 
TBUFF DEF TBUF0     CHANGES POINTS TO CURRENT CONSOLE 
*                                      OUTPUT BUFFER. 
XLIST DEC -1        LEAVE THIS FLAG SET SO X,U WILL LIST
* 
      SKP 
O/PSB NOP 
      LDA EXFLG     PATTERN REPLACEMENT 
      SZA,RSS        FLAG SET?  
      JMP OPSB2     NO, MOVE CURRENT SOURCE LINE  
      JSB ED%XU     YES GO DO EXCHANGE IN SEG 2 
        JMP OPSB3     NO OUTPUT RETURN - GO BUMP AND RETURN 
OPSB2 LDA SLNG        OUTPUT SBUFF - GET LENGTH 
      LDB SBUFP     AND POINTER TO SOURCE LINES 
      JSB DOUTP     OUTPUT IT 
        JMP O/PSB,I  IF ERROR RETURN AT P+1 
OPSB3 ISZ O/PSB     BUMP RETURN 
      JMP O/PSB,I   RETURN  
* 
************************************
********************************************************* 
* 
* 
ZRMVF OCT 0         IF -1 THE DON'T OUTPUT ZERO LEN. RECORDS
* 
      SKP 
* 
* 
* 
O/PEB LDA SLNG      IF AT 
      SSA            EOF THEN 
      JMP ./R1        GO COMPLETE AS AN R COMMAND 
      JSB O/PSB     OUTPUT CURRENT LINE 
        JMP ABORT     IF ERROR GO ABORT COMMAND 
      JMP ./R1      GO COMPLETE AS AN R COMMAND 
* 
$/R   EQU * 
      JSB ECHL
      JMP ./R0      REPLACE WITH A ZERO LEN LINE  
      CPA "U" 
      JMP ./RUN     IT IS A RUN COMMAND 
      JSB PBKE      NOT A RUN COMMAND - PUT BACK THE CHAR.
./R0  JSB DFL1S     POSTION TO LINE SPEC 1
./R1  JSB TAB       TAB COMMAND LINE
./R   JSB ./R$      PERFORM REPLACEMENT 
      ISZ COMND     IF P COMMAND SKIP 
      JMP NODE1        GET NEXT COMMAND 
      ISZ CFLG      IF C COMMAND SKIP 
      JMP DISPL     GO DISPLAY THE NEW LINE 
      JSB TR         TRANSFEDR LINE FOR C COMMAND 
      JMP DISPL 
* 
* ./R$ REPLACES CURRENT LINE ON INPUT BUFFER WITH LINE IN COMMAND BUFFER
./R$  NOP 
***** 
*  SAVE CURRENT LINE  <JDJ> 
* 
      LDA SLNG     IF AT
      SSA             EOF 
      JMP ./R$0        SKIP SAVE
      ISZ R1STF     IS THIS THE FIRST TIME FOR THIS COMMAND ? 
      JMP ./R$0       NO - SKIP SAVE
      STA ULNG        YES - SAVE LENGTH 
      INA           ROUND UP
      CLE,ERA       DIVIDE BY 2 TO GET WORD COUNT 
      STA TEMP
      LDA SBUFP     GET WHERE THIS LINE IS AT 
      LDB UBUFF     AND WHERE TO SAVE THIS LINE 
      JSB .MVW      AND COPY IT 
      DEF TEMP
      NOP 
      CCA           SET UNDO FLAG 
      STA UNFLG 
* 
./R$0 CCA           SET 
      STA MODFG     SET MODIFIED FLAG 
      STA R$FLG     CURRENT LINE CHANGED FLAG 
      LDA SLNG      IF AT EOF 
      SSA            INSERT NEW LINE BEFORE 
      LDA M2          EOF AND MAKE IT PENDING 
      SLA,ARS       COMPUTE ADDRESS 
      INA            OF NEXT
      ADA SBUFP       SOURCE RECORD 
      LDB OCCNT     REPLACE CURRENT RECORD LENGTH 
      STB SLNG       WITH COMMAND RECORD LENGTH 
      CMB,INB       CONVERT # CHARS TO
      BRS            MINUS # OF WORDS 
      STB CNT1        STORE COMPLEMENT IN COUNTER 
      ADA B         ADD -(# OF WORDS) TO NEXT RECORD ADRS 
      STA SBUFP      TO GET NEW SOURCE FILE POINTER 
      SZB,RSS       ZERO LENGTH RECORD? 
      JMP ./R$,I    RETURN
      STA P1
      LDB TBUFF     STARTING ADDRESS OF COMMAND RECORD
CTOS  LDA B,I       MOVE
      STA P1,I       COMMAND
      INB             RECORD
      ISZ P1           TO 
      ISZ CNT1          SOURCE
      JMP CTOS           FILE 
      JMP ./R$,I
      SPC 1 
$/I   JSB DFL1S     REPOSTION IF REQUESTED
      JSB UNDOD     SET UP FOR UNDO 
      JSB TAB       TAB THE LINE
      LDA OCCNT     LOAD RECORD LENGTH
      LDB TBUFF     LOAD RECORD LOCATION
      JSB DOUTP     OUTPUT RECORD 
        JMP ABORT     IF ERROR REPORT 
      JMP NODE1 
* 
* 
*  ./Q ALLOWS USE OF 264X TERMINAL EDIT INTRINSICS TO REPLACE PENDING 
*     LINE. 
* 
**** ADD TO  Q COMMAND **************************************************** 
*./Q   JSB ECH       TEST FOR ONLY Q IN LINE
*      JMP ./Q%      YES USE TERMINAL EDIT INTRINSICS 
*      CPA B40       Q BLANK ?
*      JMP ./Q%        YES - GO TEST FOR MORE 
*      JSB PBKE      NO 
*      JMP ./Q..        - MORE PROCESSING 
* 
./Q   JSB DFL1S     POSITION TO LINE IF REQUESTED 
      JSB ENDCK     MAKE SURE THERE ARE NO MORE CHARS 
      LDA TTYDV     TEST FOR DRIVER TYPE 07B
      CPA DVR07 
      JMP ./Q07     YES, GO ON
      CPA DVR05      TEST FOR DRIVER TYPE 05B 
      JMP ./QP      YES - GO PROCESS
      JMP ERR       NO, ERROR 
* 
./Q07 CLA           CLEAR 
      STA NLFLG       NUMBER LIST FLAG
      JSB LSTSB     LIST THE PENDING LINE 
      LDA SLNG      CHECK FOR LINE>77 CH. 
      CMA,INA 
      ADA           .77 
      SSA 
      JMP ./Q1      YES, MOVE CURSOR UP TWO LINES 
      JSB PRINT     POSITION CURSOR 
      DEF ./Q2       AND SET LEFT 
      DEC -9          DELIMITER FOR INTRINSIC EDITING.
      OCT 015520    <ESC>< P >
      OCT 015501    <ESC>< A >
      OCT 020033    <   ><ESC>
      OCT 057435    <137><GS >
      OCT 057400    <137><NUL>
* 
./Q1  JSB PRINT     SAME AS ABOVE BUT UP TWO
      DEF ./Q2
      DEC -11 
      OCT 015520    <ESC>< P >
      OCT 015501    <ESC>< A >
      OCT 015501    <ESC>< A >
      OCT 020033    <   ><ESC>
      OCT 057435    <137><GS >
      OCT 057400    <137><NUL>
* 
./Q2  LDA NOPRN     SAVE NON-PRINTING FLAG
      STA SCH        TEMORARALY 
      CCA           SET CONDITIONS FOR INPUT ONLY,
      STA NOPRN      OF THE MODIFIED LINE.
      STA COMND     SET FOR DISPLAY OF THE MODIFIED LINE. 
      JSB TTYIP     REQUEST INPUT 
      SZB,RSS 
      JMP ZER        ZERO LTH. READ 
      JSB TAB 
      LDA SCH       RESTORE NON-PRINTING FLAG.
      STA NOPRN 
      JSB PRINT      MAKE SURE INSERT IS OFF. 
      DEF ./Q3
      DEC -3
      ASC 2,R_ 
./Q3  JMP ./R       COMPLETE THE REPLACEMENT OPERATION. 
ZER   CLA            RESET COMMAND
      STA COMND 
      LDA SCH        RESTORE NON-PRINTING FLAG
      STA NOPRN 
      JMP NODE1 
* 
.77   DEC 77
* 
* 
* 
*  SCH FETCHES NEXT SOURCE CHARACTER
* 
SCH   NOP           ENTER WITH CHARACTER COUNT
      LDA SCCNT      SCCNT AND SOURCE BUFFER START
      CPA SLNG        ADDRESS IN SBUFP. 
      JMP SCH,I 
      ISZ SCCNT     IF AT END OF SOURCE RECORD, 
      ISZ SCH        EXIT TO P+1. 
      CLE,ERA 
      ADA SBUFP     IF NOT AT END OF SOURCE RECORD, 
      LDA A,I        EXIT TO P+2 WITH ASCII OF NEXT 
      SEZ,RSS         CHARACTER IN LOW BYTE OF A. 
      ALF,ALF 
      AND LOWBT 
      JMP SCH,I 
* 
      SKP 
* "ECH" FETCHES NEXT COMMAND CHARACTER
* 
ECH   NOP 
      LDA ECCNT 
      CPA ELNG
      JMP ECH,I 
      ISZ ECCNT 
      ISZ ECH 
      CLE,ERA 
      ADA EBUFF 
      LDA A,I 
      SEZ,RSS 
      ALF,ALF 
      AND LOWBT 
      JMP ECH,I 
****************************************************
* 
* 
* "RCH" FETCHES NEXT COMMAND CHARACTER FROM RUN STRING
* 
RCH   NOP 
      LDA RCCNT 
      CPA RLNG
      JMP RCH,I 
      ISZ RCCNT 
      ISZ RCH 
      CLE,ERA 
      ADA RBUFF 
      LDA A,I 
      SEZ,RSS 
      ALF,ALF 
      AND LOWBT 
      JMP RCH,I 
* 
RCCNT DEC 0         RUN STRING OUTPUTED COUNT 
RLNG  BSS 1         RUN STRING LENGHT 
RBUFF DEF RBUF0 
* 
******************************************************************
* 
*  "LCASE" CONVERTS LOWER-CASE COMMAND CHAR. TO UPPER CASE ASCII. 
* 
LCASE NOP           ENTER WITH CHARACTER IN <A>.
      STA JUNK      SAVE, TEMPORARILY.
      ADA N141      CHECK FOR LOWER-CASE ASCII. 
      SSA           >140B?
      JMP LCXIT       NO. NOT LOWER-CASE. 
      ADA N32         YES. CHECK FOR ALPHA LOWER-CASE.
      SSA,RSS       <173B?
      JMP LCXIT       NO. RETURN. 
      LDA B40         YES. CONVERT TO 
      XOR JUNK              UPPER-CASE ALPHA ASCII, 
      JMP LCASE,I            AND RETURN WITH <A>=CHARACTER. 
LCXIT LDA JUNK      RETRIEVE THE ORIGINAL CHARACTER,
      JMP LCASE,I    AND RETURN.
* 
* 
      SKP 
**************************************
* 
/     OCT 6457,57407   "CR / _ BELL"
      SPC 1 
* 
******************************************************
* 
* 
*************************************************************** 
NPMFG OCT 0  NOT PROMPT FLAG - IF == 0 THEN PROMPT FOR INPUT
* 
TTYNO NOP 
      CCA           SET NO PROMPT FLAG
      STA NPMFG 
      JSB TTYIP     DO INPUT
      CLA           CLEAR NO PROMPT FLAG
      STA NPMFG 
      JMP TTYNO,I   RETURN
* 
* 
*************************************************************** 
STKFG OCT 0  STACK COMMAND FLAG IF == -1 THEN STACK INPUT 
* 
STKIN NOP 
      CCA           SET COMMAND STACK FLAG
      STA STKFG 
      JSB TTYIP     DO INPUT
      CLA           CLEAR NO COMMAND STACK FLAG 
      STA STKFG 
      JMP STKIN,I   RETURN
* 
************************************************************
* 
PATCH DEC 0        IF NON-ZERO THE GET COMMAND FROM RBUFF 
* 
******************************************
* 
* 
TTYIP NOP 
      CLA           RESET 
      STA ECCNT      ALL
      STA SCCNT       CHARACTER 
      STA OCCNT        COUNTERS 
* 
      IFZ 
      JSB REMCK     TALKING REMOTELY? 
      JMP DOCOM     YES!
      XIF 
* 
      LDA NOPRN     IF INPUT IS 
      IOR NPMFG      NO PROMPT MODE  OR 
      SZA            NON-INTERACTIVE, THEN
      JMP TTYIN       IGNORE THE PROMPT.
      JSB EXEC      PRINT 
       DEF *+5         PROMPT 
       DEF .2.I          CHARACTER
       DEF LULOG
       DEF /
       DEF LN        ALTERNATE -4 & -3. 
      JSB EXCER     REPORT ANY ERRORS 
TTYIN EQU * 
      LDA PATCH     SHOULD WE READ NEXT COMMAND ? 
      AND STKFG      AND THIS IS A COMMAND
      SZA 
      JMP TTYI0     FLAG SET SO GET NEXT COMMAND FROM RBUFF 
      LDA EBUFF     ASSUME NORMAL READ
      STA TTYRB 
      LDB STKFG     IF THE STACK IN FLAG IS NOT SET 
      SSB,RSS 
      JMP TTYR1       SKIP COMMAND INPUT STUFF
      LDA RBUFF     THIS IS A COMMAND INPUT 
      STA TTYRB       SET THE INPUIT BUFFER TO R BUFF 
      CCA           SET 
      STA CD1ST       FIRST COMMAND FORM THIS LINE FLAG 
      STA PATCH       SET PATCH SO WE MAY SKIP READ NEXT TIME 
      CLA           RESET 
      STA RCCNT      USED CHAR COUNT
      LDA TTYLU 
      SSA,RSS       IF SIGN BIT SET THEN FILE 
      JMP STKRD       NO - READ FORM TERMINAL 
      CLA           GET SEGMENT ZERO
      JSB SLOAD       
      JSB ED%RF 
        DEF FILRD 
        DEF TTYRB,I 
FILRD  JMP TTYER    ERROR RETURN
      JMP EBRET     GOOD RETURN 
* 
STKRD JSB CDVR5     DIRVER 5 ?
      JMP TTYR1       NO - NORMAL READ
      LDA NOPRN     IF NO PRINT MODE
      IOR NPMFG       OR NO PROMPT MODE 
      SSA                    THEN DON'T CALL TERMINAL STACK HANDLER.
      JMP TTYR1                 USE NORMAL INPUT CALL . 
      JSB RDREC     INPUT 
       DEF RDRTN       COMMAND AND ALLOW USER TO GET AT THE STACK 
       DEF RBUF0
       DEF TTYLU
       DEF ATLOG    TRANSMISSION LOG
       DEF RLNG       COMMAND LENGTH
* 
RDRTN SSA           TEST FOR ERROR
      JMP TTYER       YES - GO HANDLE 
      JMP TTYS0       NO  - GO STACK COMMAND
* 
TTYR1 JSB REIO      INPUT COMMAND FORM TTY
        DEF *+5 
        DEF I.1 
        DEF TTYLU 
TTYRB   BSS 1 
        DEF MAXIN 
      JMP TTYER     IF ERROR TREAT AS EOF 
EBRET STA ATLOG 
      STB ELNG
      LDA STKFG     SHOULD THIS LINE BE PUT IN THE COMMAND STACK ?
      SSA,RSS 
      JMP TTYI5     NOT A COMMAND READ SO SKIP MULTI COMMDS STUFF 
* 
      STB RLNG      IT WAS NOT A STACK SO SET RBUFF LENGTH
TTYS0 JSB ADDSK     AD COMMAND TO THE STACK 
        DEF TTYS1 
        DEF RBUF0 
        DEF RLNG
TTYS1   EQU * 
TTYI0 CLA 
      STA ELNG
      JSB FLLER     COPY NEXT COMMAND FROM RBUFF TO EBUFF 
      ISZ CD1ST     TEST IF THIS IS THE FIRST COMMAND ON LINE 
      CLA,RSS       NO  - CLEAR A REG AND SKIP
      JMP TTYI5     YES - SKIP LIST 
      STA SPFLG       CLEAR SPACES FLAG 
      LDA EBUFF     GET BUFFER
      LDB ELNG        AND LENGTH
      JSB LST        GO LIST
      CCA           RESET 
      STA SPFLG        SPACES FLAG
* 
TTYI5 LDA ATLOG       NO - GET BACK TRANSMISSION LOG
      AND =B240     TEST EOF BITS 
      SZA           EITHER SET ?
TTYER JSB SETTY       YES - SET INPUT TO TTY
      JMP TTYIP,I    REUTRN 
* 
CD1ST DEC 0         IF SET THEN FIRST COMMAND ON LINE 
ATLOG BSS 1 
* 
* 
FLLER NOP           COPY COMMAND FOR RBUFF TO *END*  OF EBUFF 
*                      END IS USED BECAUSE FCOPY MAY MAKE EBUFF LONGER
      CLA           SCAN FOR MULTIPLE COMMANDS
      STA TEMP        ON A LINE.
TTYI1 JSB RCH       GET NEXT  CHAR   FROM R BUFF
       JMP TTYI7       END FOUND - GO SET FLAG FOR NEXT READ
      CPA BAR       IS IT SPECIAL COMMAND SEPERATOR 
      JMP TTYI3        YES - GO TEST IF IT WAS ESCAPED
TTYI2 STA TEMP      SAVE THIS CHAR AS LAST CHAR 
      LDB EBUFF     MAKE EBUFF A BYTE ADDRESSS
      CLE,ELB 
      ADB ELNG      BUMP BY LENGTH
      ISZ ELNG
      JSB .SBT      AND SET THE BYTE IN 
      JMP TTYI1     LOOP FOR NEXT CHAR
* 
TTYI3 LDB TEMP      GET LAST CHAR 
      CPB ESCCH     WAS IT THE ESCAPE CHAR
      JMP TTYI6       YES - SO BAR IS ESCAPED 
TTYI4 JMP FLLER,I   NO SO RETURN
* 
TTYI6 LDB ELNG     BUMP OF
      SZB            LAST (ESCAPE) CHAR 
      ADB =D-1        OF EBUFF IF 
      STB ELNG         THERE IS ONE 
      JMP TTYI2     AND CONTINUE SCAN 
* 
TTYI7 CLA           END IF STRING FOUND 
      STA PATCH        SET FLAG SO WE WILL READ NEXT TIME 
      JMP TTYI4     ERROR - GO HANDLE 
* 
EBUFF  DEF EBUF0    CHANGES, POINTS TO CURRENT COMMAND
* 
****************************
* 
* 
*********************** 
* 
SETTY NOP            SET TURN TERNIMAL AS INPUT 
      LDA TYOPN     TEST IF A COMMAND FILE IS OPEN
      SSA 
      JMP CTTYF     GO CLOSE IT 
STTY1 LDA ERRLU      GET TURN ON TERMINAL 
      STA LULOG 
      IOR B600      SET ECHO BITS 
      STA TTYLU 
      JSB LSSET     SET LIST LU (THIS WILL LOAD SEG 0 IF THERE
*                        LIST FILE TO POSTED SO BE SURE THERE IS NO LIST
*                        LIST FILE YOU CALL TTYIN 
*                        FROM A SEGMENT ).
      LDA ERPRN        RESTORE PRINT FLAG 
      STA NOPRN 
      LDA ERDVR     GET COPY OF DRIVER TYPE 
      STA TTYDV        ADJUSTED FOR SCREEN MODE COMPATABLITY. 
      JMP SETTY,I   RETURN
* 
CTTYF CLA 
      JSB SLOAD 
      JSB ED%TC 
      JMP STTY1 
* 
* 
CFLG  NOP           ALSO <NT> 
SBUFP NOP           POINT TO CURRENT LOC IN SORC BUFFER 
SLNG  NOP           LENGTH OF SOURCE RECORD (EVEN)
ELNG  NOP 
LOWBT OCT 377   LOWER BYTE MASK 
LN    OCT -3        ALTERN. WITH -4 AFTER CONTROL G.
NOPRN NOP           SUPPRESS PRINTING IF #0.
SCCNT NOP 
.10K  DEC 10000 
.1000 DEC 1000
.100  DEC 100 
**********
* 
      SKP 
* 
      IFZ 
DOCOM CLA           PREPARE FOR NON-INTERACTIVE INPUT.
      CPA NOPRN      IF DEVICE IS INTERACTIVE, THEN 
      LDA LN          GET THE PROMPT LENGTH.
      STA PRMTL     INITIALIZE PROMPT LENGTH. 
      SZA           CHECK FOR A ZERO LTH. 
      JMP INWR      NO, GO ON 
      LDA INLU      YES, REMOVE INTERACTIVE BIT 
      XOR BIT11 
      STA INLU
INWR  JSB DEXEC     DO INTERACTIVE REMOTE READ
      DEF *+8 
      DEF NODE
      DEF RCODE 
      DEF INLU
      DEF EBUFF,I 
      DEF MAXIN 
      DEF /         OPT.PARAMS=PROMPT CHARS 
      DEF PRMTL      AND PROMPT LENGTH. 
      JMP ./A0      ABORTIVE COMM. ERROR
      LDA INLU      MAKE SURE INTERATIVE BIT IS SET 
      IOR BIT11 
      STA INLU
      JMP EBRET 
* 
* 
*  RETURN+1 IF CRT IS REMOTE, RETURN+2 IF NOT 
REMCK NOP 
      LDB NODE
      CPB M1
      ISZ REMCK 
      JMP REMCK,I 
* 
PRMTL NOP           INTERACTIVE PROMPT LENGTH.
RPRMT OCT 6412,27537   REMOTE PROMPT: "CR LF / _" 
BIT11 OCT 4000
INLU  NOP 
NODE  NOP 
INTFL NOP           INTERACTIVE WRITE-READ FLAG.
WRLEN NOP           WRITE LENGTH (-CHARS) FOR WRITE-READ. 
TEMPZ EQU REMCK     TEMPORARY.
SVTMP NOP           TEMPORARY STORAGE FOR 
      NOP            OVERLAYED WORDS. 
* 
* INTERACTIVE REMOTE WRITE-READ ROUTINE: DISPLAY LINE & READ COMMAND. 
* 
INTER NOP 
      STA BUFAD     CONFIGURE WRITE-BUFFER ADDRESS IN CALL. 
      STB WRLEN     SAVE NEG. CHAR. COUNT, TEMPORARILY. 
      BRS           COMPUTE BUFFER LENGTH 
      CMB,INB        IN WORDS.
      ADA B         FORM ADDRESS OF NEXT WORD,
      STA TEMPZ      IMMEDIATELY FOLLOWING WRITE BUFFER.
      DLD TEMPZ,I   GET NEXT TWO WORDS-AFTER BUFFER-
      DST SVTMP      AND SAVE, TEMPORARILY. 
      DLD RPRMT     OVERLAY TWO WORDS FOLLOWING WRITE BUFFER
      DST TEMPZ,I    WITH THE COMMAND-INPUT PROMPT CHARS. 
      LDB WRLEN     GET THE ORIGINAL NEG. CHARACTER COUNT.
      SLB           IF THE COUNT WAS ODD, 
      ADB M1         ADD ONE FOR THE WORD BOUNDRY.
      ADB LN        ADD THE LENGTH OF PROMPT (-CHARS),
      STB WRLEN      AND CONFIGURE CALL WITH TOTAL LENGTH.
* 
      JSB DEXEC     CALL REMOTE 'EXEC' ROUTINE. 
      DEF ERABT      ERROR-RETURN ADDRESS.
      DEF NODE       DESTINATION NODE.
      DEF RCODE      READ REQUEST--NO ABORT.
      DEF INLU       REMOTE TTY LU W/INTERACTIVE BIT(#11).
      DEF EBUFF,I    INPUT BUFFER ADDRESS.
      DEF MAXIN      MAXIMUM NO. OF INPUT CHARACTERS. 
BUFAD DEF *          CONFIGURED WRITE BUFFER ADDRESS. 
      DEF WRLEN      CONFIGURED WRITE BUFFER LENGTH.
ERABT JMP ./A0      ** COMMUNICATION ERROR: ABORT!! 
* 
      STB ELNG      SAVE READ LENGTH (+CHARS).
      DLD SVTMP     RESTORE THE 
      DST TEMPZ,I    OVERLAYED BUFFER CHARACTERS. 
      CLA           RESET 
      STA ECCNT       ALL 
      STA SCCNT        CHARACTER
      STA OCCNT         COUNTERS. 
      LDB ELNG      RESTORE <B>= TRANSMISSION LOG.
      JMP INTER,I   RETURN. 
      XIF 
* 
*************************************************************** 
* 
      SKP 
CVX   JSB DEC       CONVERT NUMBER TO ASCII 
      IFZ 
      JSB REMCK     IF COMMUNICATING REMOTELY,
      ISZ INTFL      SET THE INTERACTIVE FLAG.
      XIF 
      LDB OCCNT     CALL
      LDA TBUFF      PRINT
      JSB LST         ROUTINE 
      JMP NODE1     PROCESS THE NEXT COMMAND
      SPC 1 
* 
************* 
*  PRINT OUT RULER LINE 
* 
./HL  JSB ENDCK     MAKE SURE THERE ARE NO MORE CHARS 
      JSB NOLSP     MAKE SURE THERE WERE NO LINE SPECS
      JSB CDVR5    TEST IF THIS IS SCREEN MODE TERMINAL 
      JMP ./HL1      NO JUST PRINT LINE 
      JSB PRINT 
      DEF ./HL1 
      DEC -3
      ASC 2,A_     MOVE CURSOR UP
./HL1 JSB PRINT 
      DEF NODE1 
      DEC 39
      ASC 21,  ''''/''''1''''/''''2''''/''''3''''/''''4 
      ASC 19,''''/''''5''''/''''6''''/''''7''''/''' 
      SPC 1 
* 
********* 
*     SHOW SIZE 
* 
./S   CLB 
      LDA T#SEC     COMPUTE NUMBER OF WORDS 
*     ASL 6          ALREADY STORED ON DISC,
      ASL 7          ALREADY STORED ON DISC,(128 WORDS/SECT.) 
      STA DEC         SAVE, THEN COMPUTE
      LDA DBUF$        # OF WORDS IN DEST 
      CMA,INA           BUFFER. 
      ADA DBUFP 
      CLE 
      ADA DEC        ADD BACK LSB'S OF MPY
      SEZ             AND BUMP B IF E SET.
      INB 
      JMP CVX 
      SPC 1 
DEC   NOP 
      CLE,SZB,RSS   >65K? 
      JMP SNGLP 
      DIV .10K      WORK ON EXCESS FIRST
      STB I/PSB     SAVE REMAINDER FOR NEXT PASS. 
      CLB 
      JSB DEC4
      LDA I/PSB 
      CCE           SKIP DIV .10K THIS TIME 
SNGLP JSB DEC4
      LDA B60       GET A ASCII ZERO
      LDB OCCNT     TEST IF WE SUPPRESSED ALL CHARS 
      SZB,RSS 
      JSB OUTCR       YES - PUT OUT ONE ZERO
      JMP DEC,I 
      SPC 1 
DEC4  NOP 
      SEZ           IF NUMBER >65K, SKIP
      JMP THOU       FIRST DIVIDE, PASS 2.
      DIV .10K      OUTPUT TEN THOUSANDS
      JSB CONVT      DIGIT
THOU  DIV .1000     OUTPUT THOUSANDS
      JSB CONVT      DIGIT
      DIV .100      OUTPUT HUNDREDS 
      JSB CONVT      DIGIT
      DIV .10       OUTPUT TENS 
      JSB CONVT      DIGIT AND
      JSB CONVT       ONES DIGIT
      JMP DEC4,I
      SPC 1 
CONVT NOP 
      STB NT        SAVE REMAINDER
      SZA           IF
      JMP CONV1      LEADING
      CPA OCCNT       ZERO
      JMP CONV2        DO NOT OUTPUT IT 
CONV1 IOR B60       CONVERT NUMBER TO ASCII 
      JSB OUTCR     MOVE CHARACTER TO BUFFER
CONV2 CLB           SET REGISTERS UP
      LDA NT         FOR NEXT DIVIDE
      JMP CONVT,I 
* 
* 
*     I/PSB FETCHES NEXT RECORD FROM SOURCE BUFFER
*      RETURNS WITH AN EOF FLAG, I.E. B=-1 EOF FOUND, B=0 NO EOF
I/PSB NOP 
      JSB DINP
*     CLB                           !NO LS
*     STB NOLSF     RESET LS FLAG.  ! SUPPORT 
      LDB SLNG      LOAD RECORD LENGTH
      SSB           IF LENGTH < 0, RETURN WITH
      JMP I/PSB,I    EOF FLAG SET IN REGISTER 
      CLB           CLEAR EOF FLAG
      STB SCCNT     RESET SOURCE CHARACTER CNTR 
      JMP I/PSB,I 
* 
DISPL CLB           RESET 
      STB EXFLG      EXCHANGE FLAG
      STB NLFLG      NUMBERED LIST FLAG 
      CCB            SET
      STB SPFLG       LEADING SPACES FLAG 
      LDB SPSP      GET TWO SPACES
      STB FILLC      AND SET AS FILL CHAR 
      LDA LULOG     RESET THE 
      JSB LSSET      LIST LU
* 
      IFZ 
      JSB REMCK     IF COMMUNICATING REMOTELY,
      ISZ INTFL      SET THE INTERACTIVE FLAG.
      XIF 
* 
      JSB LSTSB      LIST CURRENT LINE
      JMP NODE1     PROCESS THE NEXT COMMAND. 
      SPC 1 
* 
******************************************* 
*  DFL1S  MOVE TO LINE 1 SPEC, DFAULT IS CURRENT LINE 
* 
DFL1S NOP 
      JSB NOL2S     MAKE SURE THERE IS NO LINE 2 SPEC 
      LDA T#REC     DEFUALT IS CURRENT LINE 
      INA 
      JSB PSL1      MOVE THE THE LINE SPECIFIED 
      JMP L1ERR        SOMETHING WRONG - REORTT 
      JMP DFL1S,I   RETURN
* 
******* 
* COPY PENDING LINE AND DO LINE EDIT ON COPY
* 
./O   JSB DFL1S     REPOSTION IF REQUESTED
      LDA SLNG      IF
      SSA             AT
      JMP EOFPR        EOF - REPORT IT
      JSB UNDOD     SET UP FOR UNDO 
      JSB O/PSB     OUTPUT PENDING LINE, THEN 
        JMP ABORT    IF ERROR GO REPORT 
      LDA DVTY       IF DRIVER TYPE IS 07B GO TO "Q"
      CPA DVR07         COMMAND.
      JMP ./Q07 
      JMP ./P1       OTHERWISE USE THE  P COMMAND.
      SPC 2 
./C   CCB 
      STB CFLG      SET THE "C"FLAG TO -1.
      JSB DFL1S     REPOSTION IF REQUESTED
      JSB UNDOD     SET UP NUDO 
      JMP ./P1
* 
./P   JSB DFL1S     REPOSTION IF REQUESTED
./P1  LDA RFLAG     SET REPLACE FLAG AS TAB FILL CHAR 
      STA TBFIL 
      LDA DLMTR 
      STA RCHAR     SET DLMTR AS SPECAL REPACE CHAR 
      JSB TAB       TAB THE LINE
      CCA           RESET TO SOMETHING THAT DOES NO MATCH 
      STA RCHAR 
      LDA SLNG      IF AT EOF 
      SSA            PRINT EOF AND GET
      JMP EOFPR       NEXT COMMAND. 
      JSB SWPET     SET UP INPUT BUFFER 
      CCA           SET LIST FLAG 
      STA COMND     FOR ./R 
      CLB 
MODE  STB PMODE     INITIAL MODE IS REPLACE 
PNXT  JSB ECH       GET A CHARACTER 
      JMP PFIN      IF EOL THEN EXIT
      CLB           SET B FOR MODE CHECK
      CPA %R        CONTROL R?
      JMP MODE      YES GO RESET MODE 
      INB           INSERT MODE?
      CPA %I
      JMP MODE      YES GO RESET
      CPA %S          ALTERNATE COMMAND 
      JMP MODE
      INB           SET FOR DELETE MODE 
      CPA %C        DELETE MODE?
      JMP MODE      YES GO RESET
      CPA %T        TRUNCATE LINE MODE? 
      JMP ./R       YES GO WRAP UP
************************************************************************
      CPA %B          IS IT A BREAK LINE CHARACTER ?
      JMP .P%B         YES - GO TRASNSFER CURRENT TBUFF 
      CPA %X          IS IT A EXTEND LINE CHARACTER ? 
      JMP .P%X         YES - GO MOVE CHARACTERS TO TBUFF
      LDB PMODE     GET THE CURRENT MODE
      CPB ZERO      IF REPLACE
      JMP PRPL      GO REPLACE
      CPB .1        IF INSERT 
      JMP PINS      GO INSERT 
      CPB .2        IF DELETE 
      JMP PDLS      GO DELETE 
      SPC 2 
PRPL  CPA RFLAG     IS IT REALLY COPY 
      JMP PCOPY     YES GO COPY 
      JSB OUTCR     OUTPUT THE NEW CHARACTER
      SPC 1 
PDLS  JSB SCH       GET THE OLD CHARACTER 
      NOP           IGNOR EOL 
      JMP PNXT      BURN THE OLD AND GO GET THE NEXT
      SPC 1 
PCOPY JSB SCH       GET THE CURRENT CHARACTER 
      LDA B40       USE BLANK IF UNDEFINED
      JMP PINS2 
      SPC 1 
PINS  CPA RFLAG     INSERT SPACES FOR 
      LDA B40        DELIMITER
PINS2 JSB OUTCR     SEND IT OUT 
      JMP PNXT      GO PROCESS THE NEXT CHAR. 
      SPC 1 
PFIN  JSB SCH       MOVE THE REST 
      JMP ./R       OF THE LINE 
      JSB OUTCR     TO THE OUTPUT 
      JMP PFIN      BUFFER
****************************************************************************
.P%B  LDA OCCNT     GET FIRST PART'S CHAR COUNT 
      LDB TBUFF     AND LOCATION  
      JSB DOUTP     THEN OUTPUT IT  
        JMP ABORT     IF ERROR  GO GIVE ABORT MESSAGE 
      CLA           RESET 
      STA OCCNT       OUTPUT CHAR COUNT 
      JMP PNXT      CONTINUE WITH P COMMAND 
* 
.P%X  LDA OCCNT     STORE OUTPUT COUNT INTO LAST NONBLANK 
      STA LNG%X       COUNT IN CASE OF ALL BLANKS LEFT. 
LOP%X JSB SCH       GET NEXT SOURCE CHAR  
      JMP NXT%X     NO MORE - FINISH  
      CPA B40       IS CHAR A BLANK  ?  
      JMP BLK%X       YES - DONT UPDATE 
      LDB OCCNT       NO - UPDATE COUNT 
      INB           INCREMENT COUNT 
      STB LNG%X     AND SAVE  
BLK%X JSB OUTCR     OUTPUT THE CHAR 
      JMP LOP%X     CONTINUE GETTING CHARS  
* 
NXT%X LDA LNG%X     SET OUTPUT LENGHT TO  
      STA OCCNT      LAST NON BLANK CHARACTER.  
      JMP PNXT      CONTINUE P COMMAND  
* 
LNG%X BSS 1 
* 
      SPC 1 
%B    OCT 2            CONTROL B - BREAK LINE 
%X    OCT 30           CONTROL X - EXTEND LINE  
************************************************************************* 
%R    OCT 22        CONTROL R 
%I    OCT 11        CONTROL I 
%C    OCT 3         CONTROL C 
%S    OCT 23        CONTROL S 
%T    OCT 24        CONTROL T 
PMODE NOP 
* 
      SPC 1 
      SPC 1 
LSTB2 NOP 
      SPC 1 
LSTSB NOP           USED AS TEMP <RQSTC>  
* 
      LDB NLFLG       NUMBERED LIST ? 
      SZB,RSS 
      JMP LTSB1      NO - NORMAL LIST 
      JSB #LST        YES, NUMBERED PERFORM LIST  
      JMP LSTSB,I      RETURN 
LTSB1 LDA SBUFP     FETCH RECORD LENGTH 
* 
      LDB SLNG       AND LOCATION 
      SSB           IF AT EOF 
      JMP EOFPR     GO PRINT "EOF"  
      JSB LST       PERFORM LIST  
      JMP LSTSB,I 
* 
* 
STRK# NOP           SOURCE TRACK #
SRCLU NOP           SOURCE DISK LU
NWTRK NOP           RETURN OF TRACK FROM DISC ALLOC REQ.
DTRK# NOP           DESTINATION TRACK # 
NEWLU NOP           RETURN OF LU FROM DISK ALLOC REQ. 
DSTLU NOP           DESTINATION LU
DSEC# NOP           DESTINATION SECTOR #
SSEC# NOP           SOURCE SECTOR # 
.4    OCT 4 
RCODE OCT 100001
^TRK1 DEF TRAK1 
^TRK2 DEF TRAK2                                     
TRAK1 DEC 0         IF THESE ARE NOT ZERO THEN RQST !THIS 
TRLU1 BSS 1                                         !IS 
TRAK2 DEC 0           WILL USE ONE OF THESE LU,TRACK!DON'T
TRLU2 BSS 1                                         !MOVE 
* 
*     RQST REQUESTS A TRACK FROM SYSTEM 
RQST  NOP 
      LDA RCODE     SET ONE TRACK REQUEST 
      STA RQSTC      CODE WITH UNAVAIL. RETURN
      SPC 1 
RQ.TR JSB EXEC      ********************************* 
      DEF *+6 
      DEF I.4       REQUEST 
      DEF RQSTC      TRACK
      DEF NWTRK       FROM
      DEF NEWLU        SYSTEM 
      DEF DSCTR     ************************************
      JSB EXCER     REOPRT ANY ERRORS 
      SPC 1 
      LDA DSCTR     CONVERT 
      RAR             TO
      STA DSCTR         128 WORD SECTORS
**
      LDA NWTRK     WAS THE REQUEST 
      SSA            HONORED? 
      JMP NOTRK       NO - GO ASK WHAT WE SHOULD DO 
RQST4 EQU *         RETURN POINT FROM ED%PC 
* NO LS SUPPORT  - TRACK COUNT NO LONGER NEEDED 
*   RQST2 ISZ #TCNT       YES, ADD 1 TO OUTSTANDING TRACK COUNT.
      ISZ RQST        BUMP TO GOOD RETURN 
      JMP RQST,I       RETURN 
* 
* 
* GET HERE WHEN REQUEST FOR AT TRACK FAILED - WE'RE IN TROUBLE !!!
* 
NOTRK EQU * 
******* 
*  TEST FOR POSSIBLE SCREEN MODE
      JSB CDVR5 
      JMP NTRK1 
      JSB PRINT   PUT IN 2 LINES IN CASE WERE IN SCREEN MODE
      DEF NTRK1 
      DEC -5
      OCT 015515   <ESC>< M > INSERT LINE 
      OCT 015515   <ESC>< M > INSERT LINE 
      ASC 1,_       BACKARROW 
* 
****
NTRK1 EQU * 
      LDA PANIC     IF THIS IS PANIC REPLACE MODE 
      SSA             THEN
      JMP ED%PC         GO COMSUME SOURCE TRACKS. 
      LDA NOPRN     IF NO PRINT MODE ALWAYS WAIT. 
      SZA 
      JMP NTRK3 
      JSB PRINT 
      DEF NTRK2 
      DEC 31
      ASC 11,System out of tracks  
      ASC 20, (NO aborts command, YES waits).  Wait?_ 
NTRK2 EQU * 
      JSB YESNO 
       JMP NTRK3    YES ENTERED - GO WAIT 
      JMP RQST,I    NO  ENTERED - RETURN AT ERROR POINT 
* 
NTRK3 CLA,INA           NO ABORT - PRINT MESSAGE
      STA RQSTC          AND REQUEST
      JSB PRINT            TRACK WITH               
      DEF RQ.TR              SUSPENSION IF          
      DEC 12                   UNAVAILABLE. 
NAME2 ASC 12,EDITx waiting for tracks 
* 
PANIC DEC 0         TRACK PANIC FLAG - IF SET USE SOURCE TRACKS 
* NO LS SUPPORT  - TRACK COUNT NO LONGER NEEDED 
*#TCNT NOP           CURRENT # TRACKS OBTAINED FROM SYSTEM. 
* 
I.4 OCT 100004      TRACK REQUEST WITH NO ABORT BIT SET 
* 
SETSO NOP           SET UP THE SOURCE ROUTINE 
      LDA LSLUT     LOAD LS LU AND TRACK
* 
* NEW FORMAT FOR RTE-6
* 
*     LDB .2        ASSUME LU 2 
*     CLE,ELA       SHIFT LU FLAG INTO E
*     ALF,ALF       MOVE TRACK TO LOWER BYTE
*     STA STRK#     STORE SOURCE TRACK #
*     CLA,SEZ       LU = 3 ?
*     INB           YES, INCREMENT LU 
*     STB SRCLU     STORE SOURCE LU # 
* 
*                 ------------------- 
*  NEW FORMAT IS  !LU!         TRACK!   ALLOWS 15 BIT TRACK NUMBER
*                 ------------------- 
*                  15 14            0 
* 
      LDB .2        ASSUME LU 2 
      RAL,CLE,SLA,ERA  TEST AND CLEAR BIT 15
      LDB .3        BIT 15 WAS SET - GET LU 3 
      STB SRCLU 
      STA STRK#     STORE SOURCE TRACK #
* 
      CLA           CLEAR   AREG
      STA #TRAK     ZERO THE TRACK-RELEASE COUNT. 
      STA SSEC#     RESET SOURCE SECTOR NUMBER
      CCA           INITIALIZE THE
      STA SNTRF      NEW-TRACK FLAG =-1 
      JMP SETSO,I   RETURN
      SPC 1 
*    ALCAT SETS SOURCE TRACK AND LU AND REQUESTS A DESTINATION
*     TRACK FROM SYSTEM.
* 
*    THERE SHOULD ALWAYS BE A TRACK IN ALTRK FOR ALCAT TO USE.
*    ( THE LAST RELASED SOURCE TRACK IS PUT THERE). IF NOT ALCAT
*     REQUEST A TRACK.  THERE MAY NOT BE A TRACK IF THE LAST COMMANDYT
*     WAS A PANIC MODE ER OR WR AND ALL THE SOURCE TRACK WERE USED. 
* 
*    IF THE TRACK REQUEST FAILS WE'RE IN BIG TROUBLE, SO WE 
*     WILL LOOP UNTIL WE GET A TRACK. 
* 
ALCAT NOP 
      JSB SETSO     SET UP THE SOURCE 
      LDA ALTRK       GET SAVED TRACK WORD
      SSA 
      JMP ALCT2     NO TRACK HERE SO GO REQUEST ONE.
      STA NWTRK     SAVE TRACK
      CCA 
      STA ALTRK     ZAP  OUT THE SAVED TRACK WORD 
      LDA ALCLU     COPY THE SAVED LU 
      STA NEWLU 
      LDB SECT2     ASSUME LU 2 
      CPA .3
      LDB SECT3     SET  SECTORS PER TRACK
      RBR           CONVET TO 128 WORD SECTORS
      STB DSCTR 
      JMP ALCT3     SKIP TRACK REQUEST
* 
ALCT1 JSB PRINT 
      DEF ALCT2 
      DEC 13
      ASC 13,A track is need to continue
ALCT2 JSB RQST      REQUEST TRACK FROM SYSTEM 
        JMP ALCT1     IF WE COME BACK HERE - TRY AGAIN
ALCT3 LDA NWTRK     STORE NEW 
      STA DTRK#      TRACK NUMBER 
      LDB NEWLU     STORE 
      STB DSTLU      NEW LU 
* 
* NEW TRACK WORD FORMAT FOR RTE-6 
* 
*     ALF,CLE,ALF   MOVE TRACK # TO UPPER BYTE
*     SLB           LU = 3 ?
*     CCE           YES, SET E BIT
*     ERA           SHIFT E INTO DESTINATION FILE 
* 
      CPB .3        LU 3 ?
      IOR =B100000    YES - SET BIT 15
      STA DSTRT     SET DEST. LU AND TRACK WORD 
      CLA           RESET 
      STA DSEC#      DEST. SECTOR POINTER AND 
      STA T#SEC       TOTAL # OF DEST. SECTORS AND
      STA T#REM 
      STA T#REC        TOTAL # OF DEST. RECORDS 
      JMP ALCAT,I 
* 
P1    NOP 
P2    NOP 
DSTRT NOP 
ALTRK DEC -1        IF THIS IS NON-NEGITVE THEN ALCAT 
ALCLU NOP           SHOULD USE THIS TRACK/LU. 
* 
DINPE JSB $$$ER     GIVE COURRPT FILE MESSAGE 
      CCB           AND PERTERN THER WAS AN EOF 
EOFND STB SLNG
      JMP DINP,I
* 
DINP  NOP 
      LDA SLNG      FETCH RECORD LENGTH 
      SSA,INA      AT EOF?
      JMP DINP,I   YES, RETURN
      ISZ LINES     BUMP SOURCE LINE COUNTER
      JMP *+2        ALLOWING HUGE NUMBER 
      ISZ LINEM       (DOUBLE WORD).
      ARS           COMPUTE ADDRESS 
      ADA SBUFP      OF NEXT RECORD 
      CPA SBEND     IF AT END OF BUFFER 
      JMP DINP3      GO TO INPUT FROM DISC
      LDB A,I       LOAD RECORD LENGTH OF NEXT RECORD 
      INA           STORE ADDRESS OF NEXT 
      STA SBUFP       RECORD IN INPUT BUFFER
      SSB           IF RECORD LENGTH < 0, 
      JMP EOFND      THEN GO TO EOF FOUND 
      BLF,BLF       CONVERT 
      BLR            TO # OF
      STB SLNG        CHARACTERS AND SAVE 
      ADB MAXIN     IF RECORD GREATER 
      CMB,SSB,INB,SZB  THAN MAX. LENGTH 
      JMP DINPE        GIVE CORRUPT FILE ERROR
      LDB SLNG      FETCH RECORD
      BRS            LENGTH IN WORDS
      ADB A         IF RECORD IS
      CMB,INB        CONTAINED IN 
      ADB SBEND       INPUT BUFFER
      SSB,RSS          THEN 
      JMP DINP,I        RETURN
      LDB SLNG      FETCH RECORD LENGTH 
      BRS            IN WORDS 
      CMB,INB       COMPLEMENT FOR LOOP COUNTER 
      STA P1        SET UP
      ADA MWDC1      POINTERS 
      STA P2          FOR 
      STA SBUFP        RECORD MOVE
      LDA P1        GET SOURCE BEGIN ADDR 
      CMA,INA        NEGATE WITH REC SIZE 
      ADA B          TO COMPUTE NUMBER
      INA            OF WORDS WHICH ARE 
      ADA LWA        PAST LWA 
      SSA,RSS 
      JMP DINP0     NONE, SO (B) IS SIZE
      CMA,INA 
      ADB A         NEG WDS PAST, SUBTR FROM (B)
DINP0 SZB,RSS 
      JMP DINP2     GO READ DISC IF 0 TO MOVE 
      SPC 1 
DINP1 LDA P1,I      MOVE
      STA P2,I       RECORD 
      ISZ P1          RESIDUE 
      ISZ P2          IN FRONT OF 
      INB,SZB          INPUT BUFFER 
      JMP DINP1 
DINP2 JSB MIN       READ BUFFER FROM DISC 
      JMP DINP,I
DINP3 JSB SQ
      JMP DINP,I
* 
SQ    NOP 
      JSB MIN       FILL INPUT BUFFER FROM DISC 
      LDA SBUF$,I   FETCH RECORD LENGTH 
      LDB SBUF$     COMPUTE START OF
      INB            RECORD ADDRESS 
      STB SBUFP       AND SAVE
      ALF,ALF       CONVERT RECORD LENGTH 
      ALS            WORD TO NUMBER 
      STA SLNG        OF CHARACTERS AND SAVE
      SSA,RSS       IF EOF SKIP 
      ADA MAXIN     IF RECORD LENGTH GREATER
      CMA,SSA,INA,SZA  THAN MAX ALLOWED 
      JMP SQERR       GIVE CORRUPT FILE ERROR 
      JMP SQ,I
* 
SQERR JSB $$$ER     GIVE ERROR
      CCB 
      STB SLNG      SET END OF FILE 
      JMP SQ,I      RETURN
* 
* 
DSCTR NOP           DESTINATION SECTORS PER TRACK 
DNTRF NOP           DEST. FILE NEW TRACK FLAG 
SNTRF NOP           SOURCE FILE NEW TRACK FLAG
.5    OCT 5 
SEC#  NOP 
WDCNT NOP 
* 
* 
*     MIN MOVES SOURCE FILE INTO CORE 
MIN   NOP 
      LDA SNTRF     READ FROM NEW 
      SSA           SOURCE TRACK? 
      ISZ #TRAK     YES, BUMP RELEASE TRACK COUNT 
      CLA           RESET 
      STA SNTRF      NEW TRACK FLAG 
      LDA SSEC#     GET NEXT SECTOR POINTER 
*     STA SVSSC     SAVE THE SOURCE SECTOR. 
      ADA SCT       ADD BUFFER SECTOR SIZE
      RAL           CONVERT TO 64 WORD SECTORS
      CMA 
      LDB SRCLU     GET READ LU 
      STB SVSLU     SAVE SOURCE LU FOR MERGES.
      SLB,RSS       IF LU = 2 
      ADA SECT2      USE #SEC FOR LU2 
      SLB             ELSE LU 3 
      ADA SECT3     WOULD READ CROSS
      SSA,RSS        TRACK BOUNDARY?
      JMP RDISC     NO, GO TO READ
      RAR          CONVERT BACK TO 128 WORD SECTORS 
      CCB           SET 
      STB SNTRF      NEW TRACK FLAG 
      ADA SCT       READ TO END OF CURRENT
      INA,RSS        TRACK, SKIP NEXT INSTRUCTION 
      SPC 1 
RDISC LDA SCT       LOAD NUMBER OF SECTORS
*     ASL 6         CONVERT SECTORS TO WORDS
      ASL 7         CONVERT SECTORS TO WORDS (128 WORS PER SECT.) 
      STA WDCNT 
      STA SVSWC     SAVE THE WORD COUNT 
      CMA,INA       STORE 
      STA MWDC1      -(WORD COUNT)
      LDA STRK# 
      STA SVSTR     SAVE SOURCE TRACK FOR MERGES. 
**
      LDA SSEC#     CONVERT 
      RAL             TO 64 WORD
      STA SVSSC           SECTOR AND SAVE FOR MERGES
      SPC 1 
      JSB EXEC      **************************
      DEF *+7 
      DEF I.1       READ
      DEF SRCLU      THE
      DEF SBUF$,I     DISC
      DEF WDCNT 
      DEF STRK# 
      DEF SVSSC     *************************** 
      JSB EXCER     REPORT ANY ERROR
      SPC 1 
      LDA WDCNT     STORE END 
      ADA SBUF$      OF DATA ADDRESS
      STA SBEND       IN SBEND
      LDA SNTRF 
      SSA           NEW TRACK?
      JMP NTRAK     YES, GO TO NEW TRACK PROCESSING 
      LDA SSEC#     MOVE
      ADA SCT        SOURCE SECTOR
      STA SSEC#       POINTER 
      JMP MIN,I 
NTRAK CLA           RESET SOURCE
      STA SSEC#      SECTOR POINTER 
      CPA RELS      IF RELEASE FLAG IS ZERO 
      JSB RELSR       RELEASE SOURCE TRACK
      CCA            MOVE BUFFER END POINTER
      ADA SBEND       SO CODE WORD IS NOT 
      STA SBEND        INCLUDED IN SOURCE 
      ISZ MWDC1     INCREMENT -(WORD COUNT) 
      LDA SBEND,I   GET CODE WORD 
* 
* NEW RTE-6 FORMAT IS LU IN BIT 15 AND TRACK IN BITS 14-0 
* 
*     AND LOWBT      (LAST WORD ON TRACK) 
*     STA STRK#       AND SET TRACK 
*     XOR SBEND,I      AND LU POINTERS
*     ALF,ALF           TO NEXT TRACK 
*     STA SRCLU          IN SOURCE
      LDB .2         ASSUME LU 2
      RAL,CLE,SLA,ERA  TEST BIT 15 AND CLEAR IT 
      LDB .3        IT WAS LU 3 
      STA STRK#     SET  NEXT SOURCE TRACK
      STB SRCLU       AND LU
      JMP MIN,I 
* 
*     RELSR RELEASES SOURCE TRACK 
RELSR NOP 
      JSB EXEC      YES, RELEASE TRACK
      DEF *+5 
      DEF I.5 
      DEF .1
      DEF STRK# 
      DEF SRCLU 
      JSB EXCER     REPORT ANY ERROR
* 
* NO LS SUPPORT - TRACK COUNT NO LONGER NEEDED
*     JSB DTCNT 
      JMP RELSR,I 
* 
* NO LS SUPPORT - TRACK NO LONGER NEEDED
*DTCNT NOP
*      LDA #TCNT     GET OUTSTANDING TRACK COUNT. 
*      SZA           IF NON-ZERO, 
*      ADA M1         SUBTRACT THE ONE JUST RELEASED, 
*      STA #TCNT       AND UPDATE THE COUNT.
*      JMP DTCNT,I   RETURN.
**
.3    OCT 3 
I.1   OCT 100001    READ CODE WITH NO ABORT BIT 
I.5   OCT 100005    RELASE TRACT CODE WITH NO ABORT BIT 
SVSSC NOP 
SVSLU NOP 
SVSWC NOP 
SVSTR NOP 
      SKP 
******************************************************
* 
* FILE OVERFLOW TEST - WHEN T#REC GET IS 32767  GIVE MESSAGE AND RETURN 
*                       AT P+1, SET OVFFG FOR SIMULATED BRAEK 
*                      ELSE RUTERN AT P+2 
* 
OVTM1 BSS 1 
OVFFG DEC 0         FILE SIZE OVERFLA FLAG -1 => MWAASGE GIVEN
* 
OVTST NOP 
      STA OVTM1     SAVE A  REG.
      LDA T#REC 
      CPA =D32700   LINE NUMBER AT MAX ?
      JMP OVTS2       YES -  GIVE MESSAGE 
      LDA OVTM1     RESTORE A 
      ISZ OVTST     BUMP RETURN 
      JMP OVTST,I     RETURN
**
OVTS2 LDA OVFFG     HAS MESSAGE BEEN GIVEN ?
      SZA 
      JMP OVTST,I     YES- RETURN AT ERROR POINT
      CCA             NO -
      STA OVFFG     NO SET FLAG 
      JSB PRINT     GIVE MESSAGE
      DEF OVTST,I   AND RETURN  AT ERROR POINT
      DEC 28
      ASC 28,File too large! Lines after the first 32700 are deleted   
* 
* 
* 
*************************************** 
* 
*  DOUTP OUTPUTS A RECORD TO THE DEST. FILE 
*     CALLED WITH THE RECORD ADDRESS IN TEH A REG.
*                            LENTGH IN B REG. 
* 
*     IF OVTST GIVE AN ERROR THE LINE IS JUSTED DELETED.
* 
* 
*     RETURNS AT P+1 IF ERROR 
*                P+2 IF NO ERROR
* 
*     ERRORS: 
*        NO TRACKS AND THE USER DOES NOT WANT TO WAIT 
* 
DOUTP NOP 
* 
**
*  LIMIT  TO FILES LESS THAN 32K LINES  <JDJ> 
* 
      JSB OVTST 
      JMP DOUP7     FILE TO BIG - RETURN AT NO ERROR POINT NOW! 
* 
      CMA           TRUNCATE
      STA ODDF                (ALWAYS -VE)
      ADA MAXOP      OUTPUT 
      CMA,SSA,RSS    LENGTH 
      CLA              TO MAXOP.
      ADA MAXOP 
      CPA MAXOP     IF RECORD LENGTH=MAXOP
      JMP ODD?       TEST FOR ODD # CHARACTERS. 
DOUP1 STB P1        SAVE BUFFER ADDRESS 
      LDB DBUFP     SAVE CURRENT POINTER IN CASE OF ERROR 
      STB DBPSV 
      SLA,ARS       CONVERT # CHARS. TO # WORDS 
      INA           ADD ONE WHEN ODD
      ALF,ALF       MOVE WORD COUNT TO
      STA DBUFP,I    UPPER BYTE AND STORE 
      ALF,ALF 
      STA CNT1       SAVE IT. 
**
**USE MOVE WORD INSTRUCTION IF WE CAN MOVE THE COMPLETE RECORD
**
      ADA DBUFP     ADD COUNT TO POINTER
      LDB MDBEN     GET NEGITIVE END OF BUFFER
      ADB A 
      SSB,RSS       TEST IF RECORD FITS IN BUFFER 
      JMP NOMVW       NO - MOVE PARTIAL BUFFER
      LDB DBUFP       YES - GET WHERE TO PUT RECORD 
      INB 
      STA DBUFP     SET NEXT BUFFER POINTER 
      LDA P1        GET WHERE RECORD IS COMMING FROM
      JSB .MVW      MICRO-CODE MOVE WORDS 
        DEF CNT1      (MOVE WORDS WITH ZERO COUNT WORKS)
        NOP 
**
**
DOUP9 LDA ODDF      IF RECORD LENGTH NOT ODD, 
      SZA 
      JMP DOUP5       GO AWAY NORMALLY. 
      LDA DBUFP,I   BUT WITH RECORD LENGTH ODD, 
      AND HBYTE      REPLACE THE EVEN CHARACTER 
      IOR TBFIL       BEYOND DESIRED LENGTH WITH
      STA DBUFP,I      A BLANK. 
DOUP5 ISZ DBUFP     BUMP DEST. BUFR PNTR. 
      LDB DBUFP 
      CPB DBEND     IF AT END OF DEST. BUFFER 
      JSB DOUTX      OUTPUT BUFFER TO DISC. 
DOUP6 ISZ T#REC     BUMP NUMBER OF RECORDS CNTR.
      JMP *+2         ALLOWING HUGE NUMBER
      ISZ T#REM       (DOUBLE INTEGER)
DOUP7 ISZ DOUTP     BUMP RETURN ADDRESS 
      JMP DOUTP,I     RETURN
* 
DOUTX NOP           (SHOULD ONLY BE CALLED FROM DOUTP)
      JSB DOUT       OUTPUT BUFFER TO DISC, 
        JMP DOUX1      ERROR - GO USE ERROR RETURN OF DOUTP 
      JMP DOUTX,I      SUCCESS - RETURN 
* 
DOUX1 LDA DBPSV     RESTORE POINTER TO ORGINAL
      STA DBUFP       POSITION. 
      JMP DOUTP,I   RETURN AT P+1 
* 
DBPSV BSS 1 
**
      SPC 1 
NOMVW LDA CNT1      BUILD LOOP COUNT
      CMA,INA,SZA,RSS TEST FOR ZERO 
      JMP DOUP5        YES - SKIP LOOP
      STA CNT1
DOUP2 ISZ DBUFP     BUMP DEST. BUFFER POINTER 
      LDB DBUFP 
      CPB DBEND     END OF BUFFER?
      JSB DOUTX     YES, OUTPUT IT
      LDA P1,I      MOVE NEXT WORD
      STA DBUFP,I    TO OUTPUT BUFFER 
      ISZ P1        BUMP SOURCE ADDRESS 
      ISZ CNT1      LAST WORD IN RECORD?
      JMP DOUP2     NO, CONTINUE MOVE 
      JMP DOUP9 
**
      SPC 1 
ODD?  SLA,RSS 
      JMP DOUP1     EVEN. NO FIXUP NEEDED.
      CLA 
      STA ODDF      SET TO SHOW ODD.
      LDA MAXOP     RESTORE FOR MORE PROCESSING.
      JMP DOUP1 
      SPC 1 
HBYTE OCT 177400    MASK FOR HIGH BYTE. 
ODDF  OCT -1        0 MEANS ODD, -VE MEANS EVEN.
      SKP 
* 
* 
*  ABORT PRINTS A MESSABE THAT THE COMMAND WAS ABORTED. 
*     IT IS CALLED WHEN A COMMAND HANDLER GET A ERROR RETURN
*     FROM DOUTP
* 
ABORT JSB PRINT 
      DEF ABRT1 
      DEC 8 
      ASC 8,Command aborted 
ABRT1 JMP DISPL 
* 
* 
* 
*     DOUT WRITES THE DESTINATION BUFFER ON A SYSTEM-ASSIGNED TRACK.
*       WHEN THE TRACK WILL BE FILLED BY A WRITE, DOUT REQUESTS A 
*       NEW TRACK, MERGES THE RETURNED LU AND TRACK, AND STORES THE 
*       RESULTING CODE WORD INTO THE LAST WORD OF THE CURRENT TRACK.
*       THE REST OF THE DESTINATION BUFFER (IF ANY) IS THEN WRITTEN 
*       ON THE NEW DESTINATION TRACK. 
* 
*       RETURN AT P+2 IF WRITE IS SUCCESSFUL, AT P+1 IF NOT 
* 
      SPC 2 
DOUT  NOP 
      CLA           RESET NEW 
      STA DNTRF      DEST. TRACK FLAG 
      LDA SCT       LOAD OF SECTRS TO BE WRITTEN
      LDB PBFLG     PARTIAL BUFFER TO 
      SZB             BE WRITTEN? 
      LDA B         YES, A_# OF SECTORS 
PBTRB STA SEC#      STORE NUMBER OF SECTORS OF WRITE
      ADA DSEC#     TRACK 
      CMA            BOUNDARY 
      ADA DSCTR       CROSSED?
      SSA,RSS 
      JMP WDISK     NO, PERFORM WRITE 
      STA DNTRF     SET NEW TRACK FLAG
      JSB RQST      REQUEST NEW TRACK FROM SYSTEM 
       JMP DOUT,I     ERROR - SO RETURN NOW 
      LDA DNTRF     GET NEW TRACK FLAG
      ADA SEC#
      INA,RSS 
WDISK LDA SEC#
      LDB T#SEC     ADD NUMBER
      ADB A          OF SECTORS TO
      STB T#SEC       TOTAL NUMBER OF SECTORS 
*     ASL 6         CONVERT SECTORS TO WORDS
      ASL 7         CONVERT SECTORS TO WORDS(128 WORDS/SECTOR)
      STA WDCNT 
      LDA DNTRF 
      SSA,RSS       NEW TRACK?
      JMP ECALL     NO, GO TO EXEC CALL 
      CCB           GET ADDRESS 
      ADB DBUF$      OF LAST WORD 
      ADB WDCNT       ON TRACK
      LDA B,I       SAVE DISPLACED WORD 
      STA TEMP       IN TEMP
      LDA NEWLU     SET UP
* 
* NEW RTE-6 FORMAT IS LU IN BIT 15 AND TRACK IN BITS 14-0 
* 
*     ALF,ALF        AND
*     IOR NWTRK       STORE 
* 
      RAR           ROTATE LU BIT INTO BIT 15 
      AND =B100000  CLEAR ALL OTHER BITS
      IOR NWTRK     OR IN TRACK 
      STA B,I          CODE WORD
      INB           STORE ADDRESS OF
      STB RESDU       BUFFER RESIDUE
      SPC 1 
ECALL LDA DSEC#     CONVERT TO 64 WORD SECTORS
      RAL 
      STA T3
      JSB EXEC      ****************************
      DEF *+7 
      DEF I.2       WRITE DESTINATION 
      DEF DSTLU      FILE BUFFER
      DEF DBUF$,I     ON DISC 
      DEF WDCNT 
      DEF DTRK# 
      DEF T3        ************************
      JSB EXCER     REPORT ANY ERRORS 
      SPC 1 
      LDB DBUF$     RESET DESTINATION 
      STB DBUFP      BUFFER POINTER 
      LDA DNTRF 
      SSA           NEW TRACK?
      JMP NTRK
      LDA DSEC#     COMPUTE 
      ADA SEC#       NEXT SECTOR
      STA DSEC#       POINTER 
DOUT1 ISZ DOUT      BUMP TO GOOD RETURN 
      JMP DOUT,I
      SPC 1 
NTRK  LDB NEWLU     STORE 
      STB DSTLU      NEW LU 
      LDB NWTRK     STORE NEW 
      STB DTRK#      TRACK NUMBER 
      CLA           RESET NEXT
      STA DSEC#      SECTOR POINTER 
      LDB TEMP      MOVE WORD DISPLACED BY CODE 
      STB DBUFP,I     WORD TO START OF BUFFER 
      ISZ DBUFP 
      LDA DNTRF 
      CMA,SZA,RSS 
      JMP PBCHK     BUFR ENDED ON TRK BOUDARY, CHECK PBFLG
*     ASL 6 
      ASL 7         CONVERT SECTORS TO WORDS
*      CMA,INA
*MVR   LDB RESDU,I   MOVE RESIDUE TO START OF BUFFER
*      STB DBUFP,I
*      ISZ RESDU
*      ISZ DBUFP
*      INA,SZA
*      JMP MVR
      STA TEMP
      LDA RESDU 
      LDB DBUFP 
      JSB .MVW      MOVE REDIDUW TO START OF BUFFER 
       DEF TEMP 
       NOP
      LDB DBUFP 
      ADB TEMP
      STB DBUFP 
PBCHK LDA PBFLG 
      SZA,RSS       PARTIAL BUFFER? 
      JMP DOUT1     NO,RETURN 
      LDA DNTRF     YES, OUTPUT BUFFER RESIDUE
      CMA,SZA,RSS   COMPL. TO GET SECTR RESID., IF 0
      INA           INCREMENT FOR WRITE OF CODE WORD
      CLB 
      STB DNTRF     RESET NEW TRACK FLAG
      JMP PBTRB 
* 
I.2   OCT 100002    WRITE CODE WITH NO ABORT BIT
I.3   OCT 100003    CONTROL CODE WITH NO ABORT BIT
T3    NOP 
RESDU NOP 
MWDC1 NOP 
DBUFP NOP           POINT TO CURRENT LOC IN DEST BUFFER 
CNT1  NOP           ALSO  <RCLNG> 
T#REC NOP           CURRENT # OF REC IN DEST FILE 
T#REM NOP             MOST SIG BITS FOR >65K
T#SEC NOP           CURRENT # OF SCTRS IN DEST FILE 
B60   OCT 60
TEMP  NOP 
#TRAK NOP           TRACK-RELEASE COUNT.
RELS  DEC -1
./EFL NOP 
./EFS BSS 1 
PASS1 DEC -1        FIRST PASS FLAG 
LS#TR NOP 
      SKP 
* 
********************************************* 
* KILL TRAILING BLANKS
* 
./K   JSB NOLSP     MAKE SURE THERE ARE NO LINE SPECS 
      JSB ENDCK     MAKE SURE THIS IS END OF LINE 
      JSB ./B1      RESET TO START OF FILE. 
      CCA           SET 
      STA MODFG       MODIFIED FLAG 
./K0  LDA SLNG      RECORD LENGTH, CHARS. 
      LDB MAXOP     REQUESTED FIELD WIDTH.
      CMB,INB 
      ADB A         IF > OR = SPECIFIED MAX., 
      SSB,RSS 
      LDA MAXOP     SET TO REQUEST MAX. 
      SSA           IF EOF, PRINT EOF 
      JMP EOFPR      AND GET NEXT COMMAND.
      SLA           DON'T THROW AWAY ODD CHARACTER, 
      INA            BUMP COUNT TO EVEN.
      ARS 
./K1  ADA M1
      SZA,RSS 
      JMP ./K2      PROCESS THIS RECORD.
      LDB SBUFP 
      ADB A         POINT TO NEXT CHAR. PAIR
      LDB B,I 
      CPB SPSP      IF THEY ARE BOTH BLANKS,
      JMP ./K1      CONTINUE TO SHORTEN RECORD. 
./K2  INA           CORRECT TO NEW # OF WORDS.
      ALS           CONVERT TO CHARACTER COUNT. 
      LDB SBUFP 
      JSB DOUTP     SEND RECORD TO DEST. FILE 
        JMP ABORT     ERROR SO ABORT COMMAND
      JSB DINP      GET NEXT RECORD.
      JMP ./K0
* 
***************************************** 
* 
*     ./B1 RESETS SOURCE POINTER TO BEGINNING OF FILE BY
*     COMPLETION OF TRANSFER OF SOURCE FILE TO DESTINATION
*     FILE THEN DEFINING THE DEST. FILE AS THE SOURCE FILE
* 
* 
      SPC 1 
./B1  NOP 
      JSB ./B$      COMPLETE TRANSFER.
      CLA 
      STA EXFLG     RESET EXCHANGE FLAG 
      STA PBFLG     RESET PARTIAL BUFFER FLAG 
      CLA,INA 
      STA LINES     RESET LINE COUNTER
      JSB ALCAT     GET NEW SOUCE AND DEST. FILE
      JSB SQ        READ IN FIRST BLOCK 
      JMP ./B1,I    FILL INPUT BUFFER 
* 
*./B$ COMPLETES TRANSFER OF SOURCE TO DESTINATION.
./B$  NOP 
      JSB TR        TRANSFER SOURCE 
      SSB,RSS        TO DESTINATION 
      JMP *-2         FILE
      LDA T#REC     COPY LAST RECORD NUMBER 
      STA LASTL     TO LAST LINE NUMBER 
      CCA           PUT END OF
      STA DBUFP,I    FILE RECORD IN 
      ISZ DBUFP       OUTPUT BUFFER 
      LDA DBUF$     DETERMINE 
      CMA,INA        SIZE 
      ADA DBUFP       OF BUFFER 
      CLB           CONVERT SIZE
***   ASR 6          TO SECTORS 
      ASR 7          128 WORD TO SECTORS
      INA             ROUNDING UP FOR ANY FRACTION
      STA PBFLG     STORE IN PARTIAL BUFR FLAG
      JSB DOUT      OUTPUT BUFFER TO DISC 
       JMP ./B3 
      LDA #TRAK     GET THE # OF TRACKS 
      LDB LSLUT      AND FIRST SOURCE TRACK 
      ISZ PASS1     FIRST PASS AT SOURCE? 
      JMP ./B2      NO - GO RELEASE TRACKS
      STA LS#TR     YES - SAVE TRACK COUNT
      RSS             BUT SKIP RELEASE
./B2  JSB RELTR     RELEASE OLD SOURCE TRACKS 
      LDA DSTRT     SET SOURCE FILE POINTER TO
      STA LSLUT      START OF DEST. FILE
      JMP ./B$,I
* 
* GET HERE WHEN THERE IS A ERROR FORM DOUT
./B3  CLA 
      STA PBFLG     CLEAR PARTIAL BUFFER FLAG 
      LDA DBUFP     BUMP DEST POINTER BACK
      ADA =D-1
      STA DBUFP 
      JMP ABORT     GO ABORT COMMAND
      SPC 1 
RELTR NOP 
      SZA,RSS 
      JMP RELTR,I   IF NONE RETURN NOW. 
      ADA =D-1      DON'T RELEASE LAST TRACK
      CMA,INA       FORM A NEGATIVE TRACK COUNT 
      STA TEMP        AND SAVE
      STB LSLUT     STORE START TRACK 
      CLA           CLEAR THE RELEASE INHIBIT 
      STA RELS      FLAG
      JSB SETSO     SET UP TO READ THE SOURCE 
      LDA TEMP
      SZA,RSS       TEST FOR ONLY ONE TRACK 
      JMP TRK3        YES - GO SAVE IT
TRK2  LDA SRCLU     GET THE LU
      LDB SECT2     GET SECTOR COUNT FOR LU 2 
      SLA           IF LU 3 
      LDB SECT3     USE LU 3 COUNT
      RBR           CONVERT TO 128 WORD SECTORS 
      ADB =D-1      SUBTRACT FOR ONE SECTOR READ
      STB SSEC#     SET DISC ADDRESS FOR MIN
READT JSB MIN       GO READ TRACK AND RELEASE IT
      LDA SNTRF     GET THE NEW TRACK FLAG. 
      SSA,RSS       WAS A TRACK RELEASED? 
      JMP READT      NO. CONTINUE READING.
      ISZ TEMP      DONE? 
      JMP TRK2      NO - DO NEXT ONE
TRK3  CCA           YES - CLEAR THE FLAG
      STA RELS      SO NO MORE ARE RELEASED.
* 
*  DEBUG CODE - TEST IF THERE IS ALREADY A TRACK IN ALTRK 
**
*      LDA ALTRK
*      SSA
*      JMP ALER9
*      JSB PRINT
*        DEF ALER1
*        DEC 15 
*        ASC 15,BUG IN ALCAT/RELTR, SUSPENDING 
*ALER1 JSB EXEC 
*        DEF ALER9
*        DEF .7 
*ALER9   EQU *
***  END DEBUG CODE 
* 
      LDA SRCLU 
      STA ALCLU     COPY LAST TRACK AND LU
      LDA STRK#        AND TRACK AND LU TO
      STA ALTRK          BE THE NEXT USED BY NEXT ALCAT.
* NO LS SUPPORT - TACK NO LONGER NEEDED 
*     JSB DTCNT     DECREMENT THEN OUTSTAND TRACK COUNT.
      JMP RELTR,I 
* 
*EOFPR PRINTS "EOF THEN RETURNS FOR NEXT COMMAND
* 
EOFPR CLA           PREPARE FOR NON-INTERACTIVE DEVICE. 
      CPA NOPRN     IF IT'S INTERACTIVE,
      JMP EOFPN      PROCEED TO PRINT THE MESSAGE.
      IFZ 
      STA INTFL     CLEAR REMOTE COMMAND READ INDICATOR.
      XIF 
      JMP .EOF1     GO TEST FOR RETURN
EOFPN EQU * 
      IFZ 
      JSB REMCK     IF COMMUNICATING REMOTELY,
      JMP REMEO      PERFORM WRITE-READ.
      XIF 
      JSB PRINT     NO  - GIVE EOF MESSAGE
      DEF .EOF1 
EFLNG DEC -4
EOFMS ASC 2,EOF 
* 
.EOF1 EQU * 
      LDA RTNFG     SHOULD WE RETURN TO STARTING LINE ? 
      AND FRTNF     AND FIND RETRUN FLAG SET ?
      SSA 
      JMP .EOF2     YES - GO DO SPECIAL STUFF 
      JMP NODE1     NO  - GO GET NEXT COMMAND 
* 
* 
.EOF2 CLA           CLEAR FLAG SO WE DON'T GET INTO A LOOP
      STA RTNFG 
      LDA THIS#     NO -  GET WHERE WE STARTED
      STA LAST#     SET IT INTO LAST# FOR ./. PROCESSING
      JMP ./.       GO DO IT
* 
* 
      IFZ 
EOFAD DEF EOFMS 
* 
REMEO LDA EOFAD     GET BUFFER ADDRESS. 
      LDB EFLNG     GET MESSAGE LENGTH. 
      ISZ INTFL     SET THE INTERACTIVE FLAG. 
      JSB INTER     WRITE EOF MESSAGE/READ NEXT COMMAND.
      JMP NODE1     GO TO PROCESS THE COMMAND.
      XIF 
      SPC 1 
****
* RALLT RELEASES ALL TRACKS 
* 
RALLT NOP 
      JSB EXEC      RELAESE ALL TRACKS
        DEF AEXRT 
        DEF I.5 
        DEF M1
AEXRT   JSB EXCER   REOPRT ANY ERRORS 
      JMP RALLT,I   RETURN
* 
********************************************
* ./A TERMINATES EXECUTION  RELEASING ALL TRACKS
* 
* 
*   ASK FIRST 
./A   JSB SETOK     GO SET OK FLAG IF TRAILING DELIM
      JSB NOLSP     SET FOR NO LINE SPECS 
      JSB ENDCK     TEST FOR ONLY 'A' 
* 
./A00 LDA MODFG     TEST IF FILE
      SZA             HAS BEEN MODIFIED 
      JSB ASK           YES -  GO ASK BEFORE ABORT
      LDA =D12      LENGTH ABORT MESSAGE
      STA ABLEN 
./A0  JSB RALLT     RELEASE ALL TRACKS
./A1  CLA           GET SEGMENT 0 
      JSB SLOAD 
      JSB PRINT 
      DEF ED%EX 
ABLEN DEC 7 
NAME  ASC 12,XXXX  aborted by user
      SPC 1 
*********************** 
* 
* 
*     ./E COMPLETES TRANSFER OF SOURCE TO DESTINATION THEN
*     TERMINATES IF THERE IS NO INPUT ERROR.
************************************************* 
*   ADD CODE TO SAVE TBUFF  AND T#REC 
* 
./E   EQU * 
      JSB NOLSP     TEST FOR NO LINE SPECS
      CLA           GET SEGMENT 0 
      JSB SLOAD 
      JMP ED%.E     GO EXCUTE 
* 
********************************* 
ROFLG OCT 0         IF EQUAL TO 'R' THEN ER FILE'S DCB IS GOOD
SCFLG OCT 0         IF -1 THEN CREATE SOURCE FILE NAME ON ER
ERFLG OCT 0         IF -1 THEN ER FILE GIVEN
SAVL  OCT 0         SAVE PARAMETER FOLLOWING /E 
.6    DEC 6 
B40   OCT 40
M58   DEC -58 
M2    DEC -2
"C"   OCT 103 
M1    DEC -1
.1    OCT 1 
.2    OCT 2 
M3    DEC -3
DBEND NOP 
MDBEN NOP           -(DBEND)
SBEND NOP 
      SPC 1 
$$$ER NOP 
      JSB PRINT 
      DEF $$$ER,I   DON'T KNOW WHAT WILL HAPPEN, BUT BETTER 
      DEC 6             THAN ABORTING !!! 
      ASC 6,CORRUPT FILE
      SPC 1 
PRINT NOP 
      LDA NOPRN     GET THE INTERACTIVE DEVICE FLAG.
      SZA           IF IT'S NON-INTERACTIVE 
      JMP PRNTX      THEN, FORGET THE MESSAGE.
      LDA PRINT 
      INA 
      STA ERMEC 
      INA 
      STA ERMEP 
      JSB DEXEC 
      DEF PRNER 
      IFZ 
      DEF NODE
      XIF 
      DEF .2.I
      DEF LULOG 
ERMEP NOP 
ERMEC NOP 
PRNER EQU * 
      CCB,RSS 
      CLB 
PRNTX LDA PRINT,I 
      JMP A,I 
* 
.75   DEC 75
ZERO  NOP 
* 
      SPC 1 
NBUF0 ASC 3,        FILE NAMR BLOCK FOR ER  ! THIS
      BSS 1          IS                     !  IS 
FSECW BSS 1            SAVED                !  A
FCARW BSS 1              HERE               !  TABLE
FTYPW BSS 1                                 ! 
      BSS 3 
      SPC 1 
*  RECORD BUFFERS - THESE BUFFERS ARE DYNAMICALLY ASSIGNED
* 
TBUF0 BSS 75    
EBUF0 BSS 75    
*********************************************************** 
MAXRB DEC -150   NEGITIVE SO B REG IS CHAR COUNT
* 
*     FBUF0 IS A BUFFER WHICH OVERLAYS ONE-TIME CODE
*     RBUF0       DITTO 
*     UBUF0       DITTO 
*     LDCB   IS THE LIST FILE DCB WHICH OVERLAYS CODE 
*                                            STARTING AT 'EDIT0'. 
RBUF0 BSS 75        INPUT BUFFER
      SPC 2 
* 
      SKP 
A     EQU 0 
B     EQU 1 
AVMEM EQU 1751B     END OF FOREGROUND+1 
BKLWA EQU 1777B  LAST WORD OF AVAILABLE MEMORY
*TAT   EQU 1656B TRACK ASSGNMNT TABLE ADDRESS 
XIDT  EQU 1717B EDIT  ID TABLE ENTRY ADDRESS
TATSD EQU 1756B # OF TRACKS ON SYSTEM DISC
*SFCUN EQU 1767B SYSTEM LS AREA (LU/TRACK)
*                                    BIT 15=LU
SECT2 EQU 1757B     # SECTORS PER TRACK LU 2
SECT3 EQU 1760B     # SECTORS PER TRACK LU 3
CNTRL EQU SWPET     USE ENTRY POINT AS TEMP 
NEGFL EQU MTCH
T1    EQU NUM1
T2    EQU NUM10 
NT    EQU CFLG
RQSTC EQU LSTSB     ENTRY POINT USED AS TEMP
RCLNG EQU CNT1
BASE  EQU JDEF$ 
INCR  EQU IDEF$ 
      SKP 
*************************************************************** 
      HED $C        COPY CODE 
* 
* 
$M    LDA L1FLG     LINE SPEC 1 GIVEN ? 
      SSA,RSS 
      JMP ./M       NO - MUST BE A MERGE
      JSB ECHL      TRY NEXCH CHAR
      JMP ERR       NOTHING SO ERROR
      CPA "O"       O FOR MOVE ?
      JMP $CM       YES - GO DO IT
      JSB PBKE      NO - TREAT AS A MERGE 
./M   JSB NOLSP     MAKE SURE THER ARE NO LINE SPECS
      CLA           GET 
      JSB SLOAD       SEGMENT 0 
      JMP ED%.M 
* 
$C    LDA L1FLG     GET LINE 1 SPEC FLAG
      SSA,RSS       SET ? 
      JMP ./C         NO GO DO OLD C COMMAND
      JSB ECHL
      JMP ERR       NOT CO SO ERROR 
      CPA "O"       IS IT A O 
      JMP $CM       YES SO IT IS A COPY 
      JMP ERR        NO ERROR 
* 
$CM   JSB CSTRP     STRIP COMMAS,BLANKS 
       JMP $CM5       NOTHING SO USE DEFAULT  OF NOT QUIET
      JSB ECHL      GET NEXT COMMAND CHAR 
        JMP $CM5      NO MORE 
      CPA "Q"       QUIET OPYION ?
      JMP $CM2      YES - GO SET QUFALG 
      JMP ERR       NO - GIVE ERROR 
* 
$CM2  CCA          SET
      STA QUFLG     QUITE FLAG
      JMP $CM       GO TEST NEXT CHAR 
* 
$CM5  JSB MOVE      GO DO MOVE/COPY -DOES NO RETURN IF ERROR
      LDA QUFLG     QUIET MODE ?
      SSA 
      JMP DISPL     YES - DISPLY LAST LINE MOVED
      JMP NODE1     NO  - LINE ALREADY DISPLAYED - GET NEXT COMND 
* 
* 
* 
MOVE  NOP           DO MOVE/COPY (ALSO CALLED BY UNDO)
      CCA            SET
      STA TRFLG        TRANSFER FLAG
      CLA 
      STA LSTFG 
      JSB TR        MOVE CURRENT LINE 
      LDA T#REC     SAVE CURRENT POSITION 
      INA 
      STA NSAVE 
      JSB PSL1      WE KNOW LINE ONE HAS BEEN GIVEN 
      JMP L1ERR       ERROR 
      LDA L1LIN     DEFAULT IS L1 LINE
      LDB =D32767 
      JSB GETL2 
      JMP L2ERR 
      STA #COPY     SAVE THE NUMBER TO MOVE 
      CCA           SET TRANFER 
      STA TRFLG       FLAG
      JSB ./B1      ROLL TO TOP TO BE SURE WE HAVE CLEAR COIPY
      LDA NSAVE     REPOSITION
      JSB ROLTS     TEST IF WE NEED OT ROLL FILE
      JSB ROLLN      TO START LINE
      LDA COMND     TEST IF MOVE OR COPY
      CPA "C" 
      JMP $CM6      COPY SO OVERLAP IS OK 
      CCB           B=-1 => MOVE IS AFTER CURRENT LINE
      LDA L1LIN     GET NUMBER OF FIRST LINE MOVED
      CMA,INA       TEST IF IT IS GREATER THAN DEST LINE
      ADA  NSAVE
      SSA,RSS       IF NEGITIVE THE IT IS GREATER 
      CLB              NO - B=0 => MOVE IS BEFORE CURRENT 
      STB MAFTR     SAVE FLAG 
      SZB           TEST FOR BEFORE OR AFTER
      JMP $CM6        B SET SO MOVE IS AFETERT CURRENT LINE 
      LDB NSAVE     TEST FOR OVERLAP -GET DEST LINE NUMBER
      CMB,INB       TEST IF IT GREATER THAN LAST LINE MOVES 
      ADB L2LIN 
      SSB,RSS       IF NEGITVE THEN BLOCK WAS ABOVE DEST LINE 
      JMP MOVLP       IT'S POSITVE - NO MOVE SHOULD OCCUR 
* 
$CM6  EQU * 
      LDA L1LIN     POSITION SOURCE TO
      JSB PSLN         WHE TO START COPING
      LDA QUFLG     GET QUIET FLAG
      CMA 
      STA LSTFG     SET COMPLEMENT AS LIST FLAG 
      CCA           SET 
      STA TRFLG      TRANSFER FLAG
      LDA #COPY 
      JSB TRN       MOVE N LINES WHICH WILL COPY
      CCA 
      ADA LINES     GET WHERE WE STOPED IN CASE OF A BREAK
      STA L2LIN     AND SAVE
      LDA L1LIN     GET WHERE WE STARTED
      CMA,INA       MAKE IT NEGITIVE
      ADA L2LIN      AND ADDING TO WHERE WE STOPED
      INA             PLUS 1 GIVES
      STA #COPY         THE NUMBERED COPIED.
      STA UNCNT           ALSO SAVE AS THE UNDO COUNT.
      LDA NSAVE     GET START POSITION IN SOURCE FILE 
      JSB PSLN      GO BACK THERE 
      LDA COMND     GET BACK COMMAND
      STA UNNEW     SAVE AS UNDO TYPE 
      CPA "M"       WAS IT MOVE?
      JMP $MM       YES - GO FINISH UP
      LDA NSAVE     SET 
      STA UNLIN      START OF DELETING FOR UNDO 
      ADA #COPY     INCLUDE NUMBER OF LINE COPIES 
      ADA =D-1      BUMP BACK BY ONE
      JSB ROLLN     AND GO THERE ( ROLLN SETS TRANSFER FLAG)
      JMP MOVE,I    RETURN
* 
* 
$CM01 LDA NSAVE     ERROR IN LINE SPEC
      JSB PSLN       WHERE IT STARTED AT. 
      JMP L1ERR     GO REPROT 
* 
$CM02 LDA NSAVE     ERROR IN LINE SPEC 2
      JSB PSLN       TO WHERE IT STARTED AT.
      JMP L2ERR     GO REPORT 
* 
MOVLP LDA NSAVE     MOVE OVERLAP
      JSB PSLN        REPOSITION TO START LINE
      JSB PRTER     DO ERROR FIX UP STUFF 
      JSB PRINT 
      DEF NODE1 
      DEC -7
      ASC 4,Overlap 
* 
MAFTR BSS 1 
* 
$MM   CCA           SET 
      STA TRFLG       TRANSFER FLAG 
      ISZ MAFTR     TEST BEFORE/AFTER FLAG; -1=>AFTER 
      JMP $MB        NOT SET => BEFORE
      LDA NSAVE 
      CMA,INA       COMPUTE LINES TO GET TO DELETE AREA 
      ADA L1LIN     GET NUMBER OF FIRST LINE MOVED
      JSB TRN       MOVE LINES TO GET TO THERE
      JSB QMRMV     REMOVE THE LINES, ROLL TO TOP 
      LDA NSAVE     COMPUTE WHERE TO STOP AT
      ADA =D-2      BUMP BACK BY 1 SO WERE AT LAST MOVED LINE 
      ADA #COPY 
      JSB TRN       AND MOVE THAT MANY
      LDA NSAVE     SAVE UNDO INFO
      STA UNREC 
      LDA L2LIN 
      STA UNLIN 
      JMP MOVE,I    RETURN
* 
$MB   JSB QMSRT     ROLL FILE TO START LINE 
      JSB QMRMV     REMOVE THE COPIED LINES 
      LDA NSAVE       YES - RETURN TO ORGINAL LIN NUMBER
      ADA =D-1      MINUS ONE 
      JSB TRN       MOVE THE LINE 
      LDA UNCNT 
      CMA,INA 
      ADA NSAVE 
      STA UNREC 
      CCA 
      ADA L1LIN     NOTE THIS MAY BE 0
      STA UNLIN 
      JMP MOVE,I    RETURN
* 
*NOMOV LDA NSAVE     MOVE OVER LAPED - DELETE THE LINE COPIED 
*      JSB ROLLN     POSITIN FILE TO FIRST LINE COPIESLST 
*      CLA           CLEAR
*      STA TRFLG        TRANSFER FLAG 
*      LDA #COPY       REMOVE THE 
*      JSB TRN         LINES
*      LDA L2LIN     ROLL TO LAST LINE DISPLAYED
*      JSB ROLLN
*      JMP NODE1
**
*     QMRMV       REMOVE #COPY  LINES FROM CURRENT POSTION - ROLL TO TOP
QMRMV NOP 
      CLA             CLEAR 
      STA TRFLG        TRANSFER FLAG
      STA BKFLG        AND ALLOW BREAK FLAG 
      LDA #COPY       GET # LINES COPIED
      JSB TRN         AND JUMP OVER THAT MANY 
      CCA             RESET 
      STA TRFLG         TRANSFER FLAG 
      STA BKFLG         AND ALLOW BREAK FLAG
      JSB ./B1        TRANSFER TO BEGINING
      JMP QMRMV,I     RETURN
* 
* 
*** 
* QMSRT - ROLL FILE TO TOP THEN MOVE TO LINE SPEC 1 
QMSRT NOP 
      CCA             SET 
      STA TRFLG        TRANFER FLAG 
      JSB ./B1        GOTO BEGINING OF FILE 
      LDA L1LIN       COMPUTE LINES NEEDED TO GET TO WHERE
      ADA M1              THEY WERE  MOVED FROM.
      JSB TRN         GO TRANFER
      JMP QMSRT,I   RETURN
* 
******
* 
* 
#COPY BSS 1 
* 
* 
* 
* 
* 
* 
      SKP 
      HED UNDO CODE 
* 
.UNDO JSB NOLSP     MAKE SURE THER WERE NO LINE SPECS 
      LDA UNTYP 
      CPA "D"       DELETE/EXCAHNGE TYPR
      JMP UDODE       YES 
      CPA "M"       MOVE TYPE 
      JMP UNDOM       YES - 
      CPA "C"       COPY TYPE 
      JMP UNDOC 
      ISZ UNFLG     CURRENT LINE EXCHANGE 
      JMP ERR         NO - NOT KNOWN
      JSB UNDOP       YES - UNDO CURRENT LINE EXCHANGE
      JMP DISPL     AND DISPLAY IT
* 
******
* 
*     UNDO PENDING LINE CHANGE - REPLACES SOURCE LINE WITH UBUFF
* 
UNDOP NOP           UNDO PENDING LINE CHANGE, FIRST COPY TO TBUFF 
      LDA ULNG      SET 
      STA OCCNT      COUNT IN TBUFF 
      INA           ROUND UP
      CLE,ERA       CONVERT TO WORDS
      STA UNDOT 
      LDA UBUFF     MOVE WORD TO TBUFF
      LDB TBUFF 
      JSB .MVW
      DEF UNDOT 
      NOP 
      JSB ./R$      AND REPLACE LINE WITH SAVE LINE 
      JMP UNDOP,I   RETURN
* 
* 
*************************************************************** 
* 
* UNDO A DELETE  OR EXCHANGE - RECOVER ORGIANL LINES FROM SOURCE
*                              ROLL FILL, THEN DELETE THE LINES 
*                              ADDED TO DEST FILE.
*                              FINALLY REPLACE PENDEING LINE WITH 
* 
* 
UDODE LDA UNLIN     REPOSITION FILE TO
      JSB  PSLN           STARTING LINE TO RECOVER LOST LINES 
      ISZ UNCNT     TEST IF WE NEED TO UNDO PENDING LINE EXCHANGE 
      JMP UDOD1       NO -  SKIP
      JSB UNDOP       YES - GO DO IT
UDOD1 LDA UNREC     COPMUTE NUMBER OF LINES 
      CMA,INA         PUT IN DEST FILE FOR LATER DELETING 
      ADA T#REC 
      STA UNCNT     SAVE THIS VALUE 
      CCA           SET TRANSFER FLAG 
      STA TRFLG 
      JSB ./B1      ROLL TO TOP 
      LDA UNREC     GO TO WHERE THE 
      INA                NEW LINES
      JSB ROLLN           STARTED 
      CLA           CLEAR TRANFER TO DELETE THE LINES 
      STA TRFLG       PUT IN DEST FILE
      LDA UNCNT     GET THERE TO REMOVE 
      JSB TRN       GO DO IT
      JMP DISPL     GO DISPLAY CURRENT LINE 
* 
********************************
* UNDO A MOVE - SET LINE SPECS AND DO ANOTHER MOVE
* 
* 
UNDOM JSB SETAB     SET TO ABSOLUTE LINE NUMBER 
      LDA "M"       FAKE A MOVE COMMAND 
      STA COMND 
      LDA UNREC     GET WHERE MOVE DESTATION
      STA L1LIN     AND SET AS 1ST LINE OF UNDO MOVE
      ADA UNCNT     ADD THE NUMBER OF LINE TO MOVE
      ADA =D-1
      STA L2LIN     AND SET AS WHERE TO STOP
      CCA           SET 
      STA QUFLG       QUIET FLAG
      LDA UNLIN     GET WHERE THE LINE CAME FROM
      SZA,RSS       TEST IF ZERO
      JMP UNDMZ     MUST UNDO A MOVE FORM LINE ZERO 
UNDM1 JSB ROLLN     GO THERE
      JSB MOVE      MOVE THE LINES
      JMP DISPL       AND DISPLY CURRENT LINE 
* 
UNDMZ CLA,INA       UNDO A MOVE STARTING AT LINE ZERO 
      JSB ROLLN       ADD A DUMMY LINE
      CLA 
      LDA SBUFP 
      JSB DOUTP    OUTPUT A ZERO LENGTH LINE
       JMP ABORT     ERROR SO ABORT 
      CLA,INA       NOW ROLL TO THIS NEW LINE 
      JSB ROLLN 
      ISZ L1LIN    BUMP LINE NUMBERS TO REFLECT NEW LINE
      ISZ L2LIN 
      JSB MOVE     UNDO THE MOVE
      CLA,INA 
      JSB ROLLN    GET BACK TO LINE 1 
      CLA 
      STA TRFLG     CLEAR TRANFER FLAG
      JSB TR        REMOVE  ADDED LINE
      JMP DISPL 
* 
*  UNDO A COPY - DELETE THE LIONE COPIED
* 
* 
UNDOC EQU *         GET POSITION BEFOR COPY STARTED 
      LDA UNLIN 
      JSB ROLLN     GO THERE
      CLA           CLEAR 
      STA TRFLG       TRANSFER FLAG 
      LDA UNCNT     GET NUMBER OF LINES COPEIS
      JSB TRN       AND DELETE THEM 
      JMP DISPL     GO DISPLAY CURRENT LINE 
* 
UNDOT BSS 1 
* 
* 
* 
* 
      SKP 
      HED SETAB  SET ABSOLUTE ADDRESS 
* 
***************************** 
*     SET UP LINE SPEC FLAG SO THAT THE LXLIN WILL RE 
*     USED AS AND ABSOLUTE LINE NUMBER
* 
* 
SETAB NOP 
      CLA 
      STA L1OFF 
      STA L1SAV 
      STA L1PAT 
      STA L2FLG 
      STA L2OFF 
      STA L2PAT 
      STA L2STR 
      CCA 
      STA L1FLG 
      STA L2FLG 
      JMP SETAB,I 
      SKP 
      HED $CMDS  DECODE/EXCUTE COMMANDS 
* 
ENDCK NOP 
ENDC1 JSB ECH      GET NEXT CHAR
      JMP ENDCK,I  NONE SO OK 
      CPA B40       IS IT A BLANK ? 
      JMP ENDC1       THEY ARE OK 
      JMP ERR      THERE IS SOME OTHER CHAR SO ERROR
* 
$E    JSB ECHL      GET CHAR AFTER E
      JMP ERR       NONE SO ERROR 
      JSB PBKE      PUT BACK FOR RESCAN LATER 
      CPA "R"       REPLACE 
      JMP ./E 
      CPA  "C"
      JMP ./E 
      JSB ECHL      GET BACK THE CHAR BECAUSE SES AND EL DON'T RESACN 
      HLT 0         BETTER BE THERE ! 
      JMP ERR       NOT KNOWN - GIVE ERROR MESSAGE
* 
$H    JSB ECHL
      JMP ./?       NONE SO GIVE GENERAL HELP 
      CPA "E" 
      JMP ./?       GO GIVE HELP
      CPA "L" 
      JMP ./HL      GO PRINT OUT LINE 
      JSB PBKE      H FOLLOWED BY SOMETHING - MUST BVE HELP KEY 
      JMP ./?        PUT IT BACK AND GO GIVE HELP 
* 
$K    CLA,INA       SET MAX KILL TO 1 
      STA KMAX
      JSB ECHL      GET NEXT CHAR 
      JMP $KL       NONE SO USE DEFAULT 
      CPA "B"       KILL BLANKS ? 
      JMP ./K        YES GO DO IT 
      JSB PBKE
$KL   LDA KMAX       GET K/L DEFAULT MAX
      LDB L2FLG     LINE SPEC 2 GIVEN ? 
      SSB 
      LDA =D32767     YES - USE A LARGE NUMBER FOR MAX
      STA KMAX
      JSB SETOK    SET OK FLAG IF DELIMTER
      JSB NUMIN     GET NUMBER - IF NOT NUMB WILL JMP TO ERR
      SZA           IF ZERO THEN DEFAULT
      STA KMAX
$K4   EQU * 
      LDA T#REC     DEFFAULT START IS 
      INA            CURRENT LINE 
      JSB PSL1      GO TO LINE SPEC 1 
      JMP L1ERR      SOMETHING WRONG - GIVE ERROR 
      LDA =D32767   DEFAULT FOR LINE 2 IS LAST LINE 
      LDB KMAX      BUT MAX IS SPECIAL
      JSB GETL2     GET L2 SPEC 
      JMP L2ERR     SOMETHING WRONG - GIVE ERROR
      STA KMAX      SAVE THE NUMBER OF LINES TO TRANSFER
      JSB NWLST     GET POSSIBLE NEW LIST LU
      JSB ENDCK     TEST IF ANYTHING LEFT ON LINE 
      LDA LNFLG     COPY L NUMBER 
      STA NLFLG       TO NUMBER LIST FLAG 
      CCA           ASSUME L, SET LIST AND TRANSFER FLAGS 
      LDB COMND     GET COMMAND 
      CPB "L"       WAS IT LIST ? 
      JMP $K5         YES - SET LIST AND TRANSFER FLAGS 
      JSB UNDOD      NO IT WAS A K COMMAND - SET UNDO INFO
      LDA NLSFG     NEW LIST LU ? 
      SZA 
      JMP $K3       YES - SKIP ASKING 
      LDA KMAX      ASK IF MORE THAN ONE LINE 
      ADA =D-2
      SSA,RSS 
      JSB ASK       ASK FIRST 
$K3   CLA           CLEAR LIST AND TRANSFER FLAGS 
      STA NLFLG     ALWAYS CLEAR NUMBER LIST FLAG 
      JMP $K6 
* 
$K5   LDB NLSFG      WAS NEW LIST LU GIVEN
      SZB 
      JMP $K6       YES - THEN LINE NUMBER IS RIGHT 
      CCB           IT'S A LIST TO SCREEN 
      ADB KMAX         WE 
      SSB               WANT TO MOVE
      CLB                 ONE LESS LINE ( NOT -1 THOUGH)
      STB KMAX
$K6   STA TRFLG 
      STA LSTFG 
      LDA NLSFG     NEW LIST LU GIVEN ? 
      CCB 
      SZA 
      STB LSTFG     IF SET THEN ALSO SET LIST FLAG
      LDA KMAX
      JSB TRN       MOVE THE LINES
      LDA NLSFG 
      SZA           NEW LIST LU GIVEN ? 
      JMP DISPL      YES - LET DISPL RESET LSTLU AND LIST CURRENT LINE
      JSB LSTSB     ELSE LIST CURRETN LINE WITH/WITOUT NUMBERS
      JMP NODE1     GO GET NEXT COMMAND 
* 
******************* 
**
* SETOK             WILL SET OK FLAG AN STRIP TRAILING DELIMTET 
* 
SETOK NOP 
      JSB ECH       CHEECK FOR MORE CHAR
      JMP SETOK,I    NONE SO RETURN NOW 
      JSB PBKE      PUT THE CHAR BACK 
      CCA           SET LAST CHAR 
      STA STOKC       TO SOMETHINBG THAT DOES NOT MATCH DLMTR 
      LDA ECCNT     SAVE CURRENT POSITONS 
      STA STOKT 
STOK1 JSB ECH       GET CHAR
        JMP STOK2      END FOUND
      CPA B40       A BLANK?
       JMP STOK1      STRIP IT
      STA STOKC     SAVE IT 
      LDA ECCNT     SAVE CURRENT POSITON
      STA TEMP
      JMP STOK1     LOOP TIL END FOUND
* 
STOK2 LDA STOKC     WAS LAST NON BLANK CHAR THE DELIMTER ?
      CPA DLMTR 
      JMP STOK4       YES - GO SET OK FLAG AND STRIP IT.
STOK3 LDA STOKT     RESOTRE ORGIANL POSITION
      STA ECCNT 
      JMP SETOK,I   RETURN
* 
STOK4 CCA           SET 
      STA OKFLG        OK FLAG
      LDA TEMP      GET WHERE CHAR WAS FOUND
      ADA =D-1      BUMP IT OFF 
      STA ELNG      TRUNCATE LENGTH 
      JMP STOK3     GO RETURN 
* 
STOKT BSS 1 
STOKC BSS 1 
* 
************************************
* 
* 
$L    LDA VWABV     DEFAULT LIST SIZE TO W DEFAULTS 
      ADA VWBLW 
      STA KMAX
      JSB ECHL      GET NEXT COMMAND CHAR 
      JMP $KL         NONE SO USE DEFAULT 
      CPA "N"       NUMBERED LIST 
      JMP $L10      YES - GO SET FLAG 
      CPA "U"       SET UNNUMBERED LISD ? 
      JMP $L11
      CPA "E"       LIST LINE LENGTH
      JMP ./LE         YES - GO DO IT 
      CPA "I"       REPORT LINES
      JMP $LI       YES GO DO IT
      JSB PBKE     ELSE PUT IT BACK AND LET $KL SCAN
      JMP $KL       GO PROCESS
* 
* 
* 
$L11  CLA,RSS       'U' GIVEN,CLEAR FLAG
$L10  CCA           'N' GIVEN ,SET
      STA LNFLG        NUMBER LIST FLAG 
      JMP $KL 
* 
*** 
* 
./LE  JSB ENDCK     MAKE SURE THIS IS LAST CHAR 
      JSB DFL1S     POSITION TO LINE IF REQUESTED 
      LDA SLNG      TEST FOR AT EOF 
      CLB 
      SSA,RSS 
      JMP CVX         NO - LIST LENGTH
      JMP EOFPR       YES - GIVE EOF
      SPC 1 
* 
*** 
* 
$LI   JSB ENDCK 
      JSB NOLSP     MAKE SURE THERE ARE NO LINE SPECS 
      JSB EOFLN     GET LINE NUMBER 
      CLB 
      JMP CVX       REPORT
* 
* 
************************************
* 
* NWLST WILL GET A NEW LIST LU OR FILE IT SPECIFIED 
*  SEGMENT WILL BE CALL IF THE PARAMTER IS NOT DEFAULTED
* 
NWLST NOP 
      CLA           CLEAR 
      STA NLSFG       NEW LIST LU FLAG
      JSB CSTRP     STRIP BLANKS, ONE COMMA 
        JMP NWLST,I   DEFAUTLED SO RETURN NOW 
      CLA           GET SEGMENT 
      JSB SLOAD      ZERO 
      JSB ED%NL     GO DO IT IN A SEGMENT 
      JMP NWLST,I   REUTRN
* 
****************************
* 
$N    JSB ENDCK     CHECK THAT THIS IS THE LAST CHAR
      JSB NOLSP     MAKE SURE THER WERE NO LINE SPECS 
      LDA SLNG      TEST IF WE ARE AT 
      SSA           END OF FILE 
      JMP EOFPR       YES - PRINT EOF 
      CLB           REPORT
      LDA T#REC       DEST COUNT
      INA               PLUS  ONE 
      JMP CVX 
* 
**
* 
$SLSH JSB NOL2S     MAKE SURE ONLY LINES SPEC GIVEN 
      JSB ENDCK     MAKE SURE THER ARE NO MORE CHAR 
      CLA           CLEAR 
      STA LSTFG       LIST FLAG 
      CCA           SET 
      STA TRFLG       TRANSFER FLAG 
      LDA T#REC     DEFAULT IS
      ADA =D2        NEXT LINE
      JSB PSL1
      JMP L1ERR     GO PRINT EOF
$SLS1 JMP DISPL     GO DISPLY LINE
* 
*$SLS2 JSB PRINT
*      DEF $SLS1
*      DEC 4
*      ASC 4,Past EOF 
* 
$W    JSB ECHL      TRY NEXT CHAR 
      JMP $W1       NONE SO DEFAULT 
      CPA "N"       WINDOW WITH NUMBERS ? 
      JMP $W10      YES - GO SET UP 
      CPA "U"       UNNUMBERED LIST 
      JMP $W11       YES - GO SET UP
      CPA "R" 
      JMP ./WRC 
      CPA "C" 
      JMP ./WRC 
      JSB PBKE      PUT BACK THIS CHAR
      JSB ENDCK     CHECK IF THER ARE ONLY BLANKS LEFT
      JMP $W1       YES - NORMAL WINDOE COMMNAD 
* 
./WRC JSB NOLSP     MAKE SURE THER WE NO LINE SPECS 
      JSB PBKE      FILE CODE WILL RESCAN 
      JMP ./QE      GO DO IT
* 
$W1   CLA           CLEAR 
      STA LSTFG      LIST FLAG
      CCA           SET TRANSFER FLAG 
      STA TRFLG 
      LDA T#REC     SAVE CURRENT POSITION 
      INA 
      STA FLAGN 
      LDA VWABV     COMPUTE LINES ABOVE 
      CMA,INA 
      ADA FLAGN 
      SSA 
      CLA,INA 
      JSB PSL1      JUMP IN SOURCE TO L1 SPEC 
      JMP L1ERR     SOMETHING WRONG - 
      LDA L1LIN     COMPUTE 
      ADA VWABV       DEFAULT 
      ADA VWBLW         BELOW 
      LDB =D32767 
      JSB GETL2     GET THE NUMBER
      JMP L2ERR 
      STA KMAX      SAVE THE NUMBER TO LIST 
      LDA FLAGN     GET WHERE TO ROLL FILE BACK TO
      JSB ROLTS     IF NO ROLL OCCURED YET THEN GO DO IT
      JSB ROLLN     RETURN TO START POSITION
      LDA L1LIN     GET START OF WINDOW 
      JSB PSLN      MOVE SOURCE FILE TO THERE 
      CCA           SET 
      STA LSTFG      LIST FLAG (PSLN CLEARS TR FLAG)
      LDA WNFLG     COPY W NUMBERS FLAG 
      STA NLFLG       TO NUMBERED LIST FLAG 
      LDA KMAX      GET THE NUMBER TO LIST
      JSB TRN       AND LIST THEM 
      LDA FLAGN 
      CLB           CLEAR THE PRINT POINTER FLAG
      STB FLAGN 
      JSB PSLN      POSITION AT THIS LINE NUMBER
      JSB PRINT     ADD A BLANK LINE
      DEF DISPL+0   GO DISPLAY CURRENT LINE 
      DEC 1 
      ASC 1,
* 
$W11  CLA,RSS       U GIVEN - CLEAR W NUMBERS FLAG
$W10  CCA            N GIVEN - SET NUMBERS FLAG 
      STA WNFLG 
      JMP $W        CONTINUE SCAN 
* 
* 
ROLTS NOP 
      CPA L1LIN     IF RESTORE LINE MATCH L1 LINE 
      JMP ROLT1       THEN THE FILE PROBABLY WAS NOT ROLLED 
      JMP ROLTS,I   DOES NOT MATCH SO JUST RETURN 
ROLT1 STA ROLTM     SAVE A REG
      CLA 
      STA LSTFG 
      CCA 
      STA TRFLG     ROLL TO 
      JSB ./B1      LINE 1
      LDA ROLTM     RESTORE A 
      JMP ROLTS,I   RETURN
* 
ROLTM BSS 1 
* 
* 
* 
KLFLG BSS 1         K OR L COMMAND FLAG 
KMAX  BSS 1         MAX LINE TO MOVE FOR K/L
* 
* 
* 
* 
      SKP 
      HED TRL2  TRANSFER TO LINE SPEC 2 
* 
*     TRANSFER LINES UNTIL L2 SPEC FOUND OR MAX REACHED 
*      TRANSFERS LAST LINE SO ITS GONE UPON RETURN
* 
*     A REG HAS DEFALUT STOP LINE 
*     B REG HAS MAX NUMBER OG LINES TO TRANSFER 
* 
*    TRL2 RETURN AT P+1 IF ERROR AND P+2 IF NO ERROR
* 
* 
* 
*     BREAKS ARE ALLOW AND L2LIN IS UPDATE TO THE ACTUAL
*     STOPING LINE NUMBER.
* 
* 
TRL2  NOP           POSTION FILE AT LINE SPEC 1, A REG HAS DEFAULT
      JSB GETL2     GET NUBMER OF LINE TO MOVE
      JMP  TRL2,I   ERROR SO RETURE 
      JSB TRN       MOVE N LINES
      LDA LINES     GET CURRENT LINE NUMBER 
      ADA =D-1
      STA L2LIN     AND SET AS STOPPING POINT 
      ISZ TRL2      BUMP RETIRN ADDRESS 
      JMP TRL2,I    RETURN
* 
* 
L1ERR CLA 
      STA ECCNT 
      JSB PRTER     PRINT OUT QUESTION MARK 
      LDA NFNDF     GET NOT FOUND FLAGG 
      SSA 
      JMP LXNFD     SET SO  GO PRINT NOT FOUND
      JSB PRINT 
      DEF NODE1+0 
      DEC 6 
      ASC 6,Start > EOF 
* 
L2ERR LDA L2ARW     RESET POINTER TO L2 SPEC
      STA ECCNT 
      JSB PRTER 
      LDA NFNDF 
      SSA 
      JMP LXNFD     NOT FOUND SO GO PRINT MESSAGE 
      JSB PRINT 
      DEF NODE1+0 
      DEC 6 
      ASC 6,Start > stop
* 
LXNFD CLA 
      STA NFNDF 
      JSB PRINT 
      DEF LXNFW   
      DEC 5 
      ASC 5,Not found 
LXNFW JSB RPRTW     REPORT WIND IF NOT THE DEFAULT
      JMP NODE1 
* 
NFNDF DEC 0         IF SET THEN LINE SPEC NOT FOUND 
L2ARW BSS 1         WHER TO PUT ARROW ON L2 PROBLEM 
* 
      HED LSPEC     FIND LINE SPECS 
* 
* 
.STAR LDA L1GIV     HAS L1 SPEC BEEN GIVEN ?
      SSA,RSS 
      JMP ERR        NO - ERROR 
      STA L2STR      YES SET L2 STAR FLAG 
      JMP OFFSP 
* 
.CMMA LDA L1GIV     LINE 1 SPEC ALREADY GIVEN ? 
      SSA 
      JMP ERR       YES 
      JMP .STG1       NO GO SET G1 FLAG 
* 
.NUMB JSB PBKE      NUMBER FOUND - PUT BACK THE FIRST CHAR
      JSB GETNM     GET THE NUMBER
      JMP OFFSP     GO LOOK FOR OFFSET SPEC 
* 
.FSRH LDA =D2       FORWARD SEARCH GET SEGMENT 2
      JSB SLOAD 
      JMP ED%FS 
* 
.BSRH LDA =D2       BACKWARDS SEARCH
      JSB SLOAD     GET SEGEMNT 2 
      JMP ED%BS 
* 
* 
.ARRW EQU * 
.P/M  JSB PBKE      PLUS OR MINUS - TREAT AS IF DOT GIVEN 
.DOT  LDA T#REC     DOT ENTERED - GET DEST FILE LINE NUMBER 
      INA           BUMP IT BY ONE
      JMP OFFSP     GO LOOK FOR OFFSET SPEC 
* 
.DLLR JSB EOFLN     DOLLAR GIVEN - GET LAST LINE NUMBER 
* 
OFFSP STA LXLIN     SAVE THE LINE NUMBER
      JSB ECH       GETR POSSILE OFFSET 
      JMP OFFS0     NONE SO CONTINUE WITH COMMAND DISPACH 
      CPA PLUS      PLUS SIGN ? 
      JMP OFFS1       YES - GO GET NUMBER 
      CPA MINUS     MINUS SIGN ?
      JMP OFFS2        YES - GO GET NUMBER
      CPA "^"       UP ARROW SAME AS MINUS
      JMP OFFS2 
      JSB PBKE      NEITHER - PUT CHAR BACK 
OFFS0 CLA           ZERO FOR OFFSET 
      JMP SETLS     GO SET THE LINE NUMBER
* 
OFFS1 JSB GETNM     PLUS FOUND- GET THE NUMBER
      JMP SETLS     GO SET LINE SPEC
* 
OFFS2 JSB GETNM     MINUS FOUND - GET THE NMBVER
      CMA,INA       MAKE IT NEGITIVE
* 
SETLS LDB L1GIV    TEST IF THIS IS LINE 1 SPEC
      SZB 
      JMP L2SPC     NO  - TRY L2 SPEC 
      STA L1OFF     SET L1 OFFSET 
      LDA LXLIN     GET BACK THE LINE NUMBER
      STA L1LIN     SET IT INTO LINE 1
      CCA           SET LINE 1 SPEC GIVEN FLAG
      STA L1FLG 
.STG1 CCA 
      STA L1GIV     SET L1 GINEN SO NEXT TIME WE SET L2 
      JSB CSTRP     STRIP POSSIBLE BLANKS OR COMMAS 
        JMP L2DFT      GO  DEFAULT L2 
      LDA ECCNT     SAVE CURRENT COMMAND POSITION+1 
      INA               AS START
      STA L2ARW           LINE SPEC 2.
      JMP NODE4 
* 
L2SPC LDB L2FLG     TEST IF LINE 2 SPEC ALREADY GIVEN 
      SZB 
      JMP ERR       YES - GO GIVE ERROR 
      LDB L2DFG     TEST FOR L2 ALREADY DEFAULTED 
      SZB 
      JMP ERR        YES- GIVE ERROR
      STA L2OFF     NO - SAVE OFFSET VALUE
      LDA LXLIN     GET LINE NUMBER 
      STA L2LIN     SET INTO LINE 2 NUMBER
      CCA 
      STA L2FLG     SET L2 FLAG 
      LDA "L"       SET DEFAULT COMMAND TO LIST 
      STA DFCMD 
L2SP1 JSB CSTRP     STRIP COMMANS AND BLANKS
      NOP            DEFAULTS ARE NOT SPECIAL 
      JMP NODE4     GET COMMAND 
* 
L2DFT CCB           SET LINE 2 DEFAULTED
      STB L2DFG        FLAG 
      JMP L2SP1     FINSISH UP
* 
LXLIN BSS 1 
L2DFG BSS 1         SET IF LINE SPEC 2 IS DEFAULTED 
* 
      SKP 
      HED PSL1      POSITION TO LINE SPEC 1 
* 
*    PSL1 RETURN AT P+1 IF ERROR AND P+2 IF NO ERROR
* 
*     CLEARS LIST FLAG
*     EXPECTS ROLLN TO SET TRANSFER FLAG
*      DOES NOT ALLOW BREAKS WHILE IN PROGESS, RESETS THE FLAG AT EXIT
* 
PSL1  NOP           POSTION FILE AT LINE SPEC 1, A REG HAS DEFAULT
      CLB           CLEAR LIST FLAG 
      STB LSTFG 
*     STB BKFLG     AND THE ALLOW BREAK FLAG
*                       ROLLN WILL SET TRANSFER FLAG
      LDB L1FLG     LINE SPEC 1 
      SZB,RSS          GIVEN ?
      JMP PSL11           NO - USE DEFAULT FROM A REG 
      LDA L1PAT     LINE 1  PATTERN GIVEN 
      SZA,RSS 
      JMP PSL10     NO - SKIP SEGLOAD 
      JSB ED%S1     SEARCH FOR LINE 1 
        JMP PSL12     NOT FOUND - USE ERROR RETURN
PSL10 LDA L1LIN     GET LINE NUMBER 
      STA L1SAV     SAVE IT WITHOUT OFFSET
      LDB L1OFF      GET OFFSET 
      JSB LXADD     GO ADD WITH PROPER OVERFLOW 
      STA PSL1T     SAVE IN TEMP
      JSB EOFLN     TEST FOR BEYOND END OF FILE, GET LAST LINE
      LDB PSL1T     GET BACK THE LINE NUMBER
      CMB,INB       MAKE NUMBER NEGITVE 
      ADB A         SUBTRACT LINES NUMBER FORM LAST LINE
      SSB           IF B IS NEGITIVE THE BEYOND EOF 
      JMP PSL12       SO USE ERROR REUTRN 
      LDA PSL1T     GET BACK THE LINE NUMBER
PSL11 JSB ROLLN     ELSE ROLL THE FILE TO LINE NUMBER 
      LDA T#REC     GET CURRENT LINE NUMBER 
      INA            ( USE THIS INSTEAD OF LINES IN CASE OF 
      STA L1LIN           IN CORE LINE AFTER SOURCE EOF)
      ISZ PSL1      BUMP RETURN ADDRESS 
PSL12 EQU * 
*     CCA           RESET 
*     STA BKFLG       ALLOW BREAK FLAG
      JMP PSL1,I    RETURN
* 
PSL1T BSS 1 
* 
* 
*********************** 
* 
*   LXADD  - ADD LINE NUMBER IN AREG TO OFFSET IN B REG 
*     IF OVERFLOW AND OFFSET IS NEGITIVE THEN USE LINE 1
*               ELSE OFFSET IS POSITIVE USE LINE 32K
* 
LXADD NOP 
      ADA B         ADD LINE RO OFFSET
      SSA,RSS        DID IT GO NEGITIVE?
      JMP LXADD,I      NO - JUST RETURN 
      SSB           WENT NEGITIVE,TEST SIGN OF OFFSET 
      CLA,INA,RSS     NEGITIVE OFFSET - GET A 1 AND SKIP
      LDA =D32767     POSITIVE OFFSET - US A LARGE POS NUMBER 
      JMP LXADD,I   RETURN
      SKP 
******************************************************************* 
      HED GETL2     GET LINE SPEC 2 LINE NUMBER 
* 
*     GET LINE SPEC LINE NUMBER 
*       MAY NEED TO SEARCH BUT WILL RETURN TO ORGIANL POSITION
* 
* 
*     A REG HAS DEFALUT STOP LINE 
*     B REG HAS MAX NUMBER OF LINES ( OFFSET FROM CURRENT POSITION) 
* 
*     GETL2 RETURN AT P+1 IF ERROR AND P+2 IF NO ERROR
* 
*     ONLY ERROR IS L2 SPEC < L1 SPEC 
* 
*     GET RETURNS THE NUMBER OF LINES TO MOVE IN THE A REG. 
*     IT SETS L2LIN TO THE ABSOLUTE LINE NUMBER - L2OFF BECOMES MEANINGLESS 
* 
GETL2 NOP           GET LINE2 NUMBER, FILE MUST BE A LINE SPEC 1
      STB L2MAX     SAVE MAX COUNT
      LDB L2FLG     LINE SPEC 2 
      SZB,RSS          GIVEN ?
      JMP GTL21           NO - USE DEFAULT FROM A REG 
      LDB L2STR     TEST IF THIS IS L1 SPEC RELATIVE
      LDA L1LIN     GET L1 ONE POSITION 
      SSB           TEST
      STA L2LIN       STAR FLAG SET SO USE  L1 SPEC 
      LDA L2PAT     PATTERN GIVEN ? 
      SZA,RSS 
      JMP GTL20     NO - SKIP PATTERN SEARCH
      JSB ED%S2     DO SEARCH FOR LINE SPEC 2 
       JMP GETL2,I   NOT FOUND - RETURN AT P+1
GTL20 LDA L2LIN     GET LINE NUMBER 
      LDB L2OFF     GET OFFSET
      JSB LXADD 
GTL21 LDB L1LIN     TEST FOR
      CMB,INB         LINE 1
      ADB A             <= LINE 2 
      SSB 
      JMP GETL2,I   NEGITIVE SO RETURN
      LDA B         A GETS L2LIN - L1LIN
      INA           BUMP BY ONE SO WE THE THE NUMBER TO MOVE
      CMB,INB       TEST IF MAX SHOULD BE USED
      ADB L2MAX 
      SSB           IF NEGITIVE THEN TO MANY
      LDA L2MAX       SO USE MAX INSTEAD
      LDB L1LIN 
      ADB A 
      ADB =D-1      BUMP BACK SO IT IS THE LINE NUMBER
      SSB           DID WE GO NEGITIVE ?
      JMP GETL2,I    YES - RETURN NOW 
      STB L2LIN 
      ISZ GETL2     BUMP RETIRN ADDRESS 
      JMP GETL2,I   RETURN
* 
L2MAX BSS 1 
* 
* 
* 
ECHL  NOP 
      JSB ECH       GET NEXT COMMAND CHAR 
      JMP ECHL,I      NONE SO RETURN
      JSB LCASE     FOLD CASE 
      ISZ ECHL      BUMP RETURN ADDRESS 
      JMP ECHL,I    RETURN
      SKP 
      HED ROLLN ROLL TO LINE IN A REG 
* 
ROLLN NOP           A REG HAS LINE TO POSITION TO 
      SZA,RSS       IF ZERO 
      INA           USE LINE ONE
      CCB           SET 
      STB TRFLG       TRANSFER FLAG 
      LDB T#REC     GET CURRENT RECORD NUMBER 
      INB           BUMP IT 
      CMB,INB       B REG HAS LINE NUM, MAKE IT NEGITIVE
      ADB A         TEST IF REQUESTED 
      SSB              LINE IS ABOVE OR BELOW CURRENT LINE
      JMP ROLL1          NEGITIVE - MUST ROLL FROM TOP
      LDA B              POSITIVE - JUST MOVE DIFFERENCE IN LINES 
      JMP ROLL2     GO DO IT
* 
ROLL1 STA ROLL#       NO - SAVE LINE NUMBER 
      JSB ./B1      ROLL TO TOP 
      CCA           MOVE ONE LINE LESS THAN END POSITION
      ADA  ROLL#     COMPUTE NUMBER OF LINES TO MOVE
ROLL2 JSB TRN       TRANSFER THEM 
      JMP ROLLN,I   RETURN
* 
* 
ROLL# BSS 1         REQUESTER LINE NUMBER SAVED HERE
* 
      SKP 
      HED PUNCT     CHECK FOR PUNCT.
* 
* 
PUNCT NOP           CHECK IF CHAR IN AREG IS PUCTION OR NOT 
      STA PNCTT     SAVE IT 
*      ADA =D-33     TEST FOR <= SPACE
*      SSA
*      JMP PNCT2     YES - SO GOTO BAD RETURN 
* 
*     ALLOW ANY OF THE FIRST 48 CHAR AS PUNCTION. 
* 
      ADA =D-48     NEXT 15 CHAR ARE PUNCTION 
      SSA 
      JMP PNCT1     GOOD SO GO TO GOOD RETURN 
      ADA =D-10     NEXT TEN ARE THE NUMBERS
      SSA 
      JMP PNCT2     GOTO BAD RETURN 
      ADA =D-7      NEXT 7 ARE :;<=>?@
      SSA 
      JMP PNCT1     GOOD RETURN 
      ADA =D-26     NEXT ARE A-Z
      SSA 
      JMP PNCT2     BAD 
      ADA =D-6      NEXT 6 ARE [\]^_` 
      SSA 
      JMP PNCT1     GOOD
      ADA =D-26     LOWER CASE A-Z
      SSA 
      JMP PNCT2     BAD 
PNCT1 ISZ PUNCT     CHAR IS PUNCT - BUMP RETURN 
PNCT2 LDA PNCTT     GET BACK ORGINAL CHAR 
      JMP PUNCT,I   RETURN
* 
PNCTT BSS 1 
* 
      SKP 
      HED  EDIT'S EXCHANGE CODE 
* 
* EXCHANGE CODE IS IN SEG 2 
* 
* 
* 
./Y  JSB DFL1S      MOVE TO LINE 1 IF REOQESTED 
./X   EQU * 
./U   EQU * 
./G   EQU * 
      LDA =D2       GET SEGMENT 2 
      JSB SLOAD 
      JMP ED%.X      DO DO COMMAND
* 
* 
* 
****
*     SET UP DO AN UNDO OF DELETE/EXCAHNGE COMMAND
*     - SET FLAG TO D TYPE UNDOS
*     - SAVE CURRENT SOUECE AND DEST FILE POSITIONS 
*     - CONDITIOALLY COPIES THE CURRERT SOURCE LINE TO UBUF0
*     IF PENDING LINE HAS BEEN CHANGED THE THE UNFLG WILL BE
*     SET. THIS MEANS THE IN CORE LINE DOES NOT MATCH THE DISK VERSION
*     DO WE MUST SAVE THIS  PENDING AND REPALCE IT LATER. 
* 
* 
UNDOD NOP 
      LDA "D"       SET UP FOR UNDO 
      STA UNNEW 
      LDA UNFLG     TEST IF PENDLING LINE HAS BEEN CHANGED
      STA UNCNT     COPY FLAG TO UNCNT WHICH UNDO WILL TEST 
      SSA,RSS 
      JMP UNDD1      FLAG CLEAR=> DON'T NEED TO SAVE
      LDA SLNG            SET => SAVE - GET SOURCE LINE LENGTH
      SSA           TEST IF WE ARE AT EOF - SHOULD NOT HAPPEN 
      JMP ERR         - GIVE ERROR
      STA ULNG      SET AS LENGTH 
      INA           ROUND UP
      ARS 
      STA UNLIN     SET AS WORD COUNT ( UNLIN USED AS TEMP) 
      LDA SBUFP 
      LDB UBUFF    GET POINTER TO SAVE AREA 
      JSB .MVW      COPY PENDING LINE TO IT 
      DEF UNLIN 
      NOP 
UNDD1 LDA LINES 
      STA UNLIN 
      LDA T#REC 
      STA UNREC 
      JMP UNDOD,I   RETURN
      SKP 
      HED NOLSP TEST FOR NO LINE SPEC 
* 
NOLSP NOP 
      LDA L1FLG     GET L1 FLAG 
      SSA             TEST
      JMP ERR         SET SO GIVE ERROR 
      JSB NOL2S     TEST L2 SPEC
      JMP NOLSP,I   RETURN
* 
NOL2S NOP 
      LDA L2FLG 
      SSA 
      JMP ERR       ALREADT GIVE , REPORT ERRR
      JMP NOL2S,I   OK SO RETURN
      SKP 
      HED $F EXECUTE FIND COMMAND 
******* 
$FCLS JSB NOLSP     MAKE SURE THERE ARE NO LINE SPECS 
      CLA           GET SEGMENT ZERO
      JSB SLOAD 
      JSB ECHL      GET NEXT CHAR 
      JMP ERR       NONE SO ERR 
      CPA "S" 
      JMP ED%CS 
      CPA "L" 
      JMP CLLST 
      JMP ERR       NOT KNOWN 
* 
CLLST JSB ED%CL     GO CLOSE IT 
      JMP NODE1     GET NEXT COMMAND
* 
* 
* 
$F    JSB ECHL      GET NEXT CHAR 
      JMP $FIND     NONE GOTO FIND
      CPA "I"      FI - NEW FILE
      JMP $FI 
      CPA "C"       FCL,FCS CLOASE FILE ? 
      JMP $FCLS 
      JSB PBKE      NOT PUT CHAR BACK FOR RESACN
$FIND LDA =D2       GET SEGMENT 2 
      JSB SLOAD 
      JMP ED%.F     GO DO FIND IN SEGMENT 2 
* 
$FI   JSB NOLSP     MAKE SURE THER ARE NO LINES SPECS 
      CLA           READ IN NEW FILE
      JSB SLOAD       CODE IS IN SEGMENT 0
      JMP ED%EF 
********************************* 
*  $B FIND FROM BEGGING  - CODE IS IN SEGMENT 2 
* 
$B    LDA =D2 
      JSB SLOAD 
      JMP ED%.B 
* 
************************************
* 
*  $D DELETE UNTIL FIND FIELD  - CODE IS IS SEGMENT 2 
* 
$D    LDA =D2 
      JSB SLOAD 
      JMP ED%.D 
* 
*********************************** 
* 
******************************
* 
      HED GETNM     GET A NUMBER
* 
* 
* 
* 
* 
* 
GETNM NOP 
      CLB           RESET 
      STB NUM1       NUMBER 
      STB NUM10       ACCUMULATORS
      JSB ECH       FETCH FIRST CHAR
      JMP GTNM9     NULL PARAM, USE DEFAULT OF 1
      JSB ASCII     IF CHARACTER IS NON-NUMERIC 
      JMP GTNM8       THEN GO PUT IT BACK AND USE DEFAULT 
GTNM1 ADA NUM10     ADD NUMBER TO PREVIOUS TOTAL
      SSA           OVERFLOW ENCOUNTERED
      JMP ERR       YES, ERROR IN PARAM.
      STA NUM1      SAVE NEW TOTAL
      MPY .10       COMPUTE NEXT PARTIAL SUM
      SZB,RSS       IF OVERFLOW FROM
      SSA            MULTIPY, SET PARTIAL TO VALUE WHICH
      LDA M10         WILL CAUSE OVERFLOW WITH NEXT CHAR. 
      STA NUM10     SAVE PARTIAL SUM
PARM1 JSB ECH       FETCH NEXT CHARACTER
      JMP GTNM5     LAST CHAR.?  GO TO END
      JSB ASCII     ASCII TO NUMERIC
      JMP GTNM4       NOT NUMERIC - GO PUT IT BACK
      JMP GTNM1     GO TO TOTALIZE
      SPC 1 
GTNM4 JSB PBKE      PUT BACK LAST CHAR
GTNM5 LDA NUM1      GET NUMBER
      JMP GETNM,I   RETURN
* 
GTNM8 JSB PBKE      PUT BACK THE FIRST CHAR 
GTNM9 CLA,INA       GET THE DEFAULT 1 
      JMP GETNM,I   RETURN
      SKP 
      HED EXCER     REPORT EXEC CALL ERROR
* 
EXCRX BSS 6         EXEX CALL ADDRESSES PUT HERE !THIS
EXCRA BSS 1         A REGISTER SAVE              !  IS
EXCRB BSS 1         B REGISTER SAVE              !   A
EXCER NOP                                        !    TABLE 
      STA EXCRA 
      STB EXCRB 
      JSB PRINT 
      DEF EXCR1 
      DEC 16
      ASC 16,EXEC ERROR. P1 - P6, A, B, RTN. 
EXCR1 JSB PRINT 
      DEF EXCR2 
      DEC 6 
      ASC 6,ADDRESS DATA
EXCR2 LDA EXCER     GET ADDRESS 
      ADA =D-7
      LDB ^EXCX 
      JSB .MVW      COPY ADDRESS
      DEF .6
      NOP 
      LDA =D-9      SET LOOP COUNT
      STA EXCRL 
      LDA ^EXCX 
      STA EXCRP 
EXCR8 JSB CNUMO 
        DEF EXCR3 
        DEF EXCRP,I 
        DEF EXCRM 
EXCR3 LDA EXCRP,I     GET ADDRESS 
      LDB EXCRL 
      ADB =D3 
      SSB,RSS 
      CLA 
      LDA A,I         GET DATA
      STA EXCRX     SAVE
      JSB CNUMO 
       DEF EXCR4
       DEF EXCRX
       DEF EXCRD
EXCR4 JSB PRINT 
      DEF EXCR5 
      DEC 7 
EXCRM BSS 3         ADDRESS 
      ASC 1,          SPACE 
EXCRD BSS 3         DATA
EXCR5 ISZ EXCRP     BUMP POINTER
      ISZ EXCRL     TEST LOOP COUNT 
      JMP EXCR8     LOOP
      JSB PRINT 
      DEF EXEC7 
      DEC 6 
      ASC 6,Suspending. 
EXEC7 JSB EXEC
      DEF EXCRT 
      DEF .7
EXCRT EQU * 
      JMP EXCER,I   REUTRN
* 
.7    DEC 7 
* 
^EXCX DEF EXCRX 
EXCRL BSS 1 
EXCRP BSS 1 
      SKP 
      HED LST      EDIT'S LIST SUBROUTINE 
* 
LST   NOP 
      STA LSTA      SAVE <A> AS OUTPUTED BUF ADDRESS
      STB LSTSZ     AND SET AS LEN OF BUF TO BE LISTED. 
      CLB           PREPARE FOR NON-INTERACTIVE DEVICE. 
      CPB NOPRN     IF DEVICE IS INTERACTIVE, 
      JMP LST.1      THEN PROCEED TO LIST THE LINE. 
      IFZ 
      STB INTFL     CLEAR COMMAND-READ INDICATOR. 
      XIF 
      JMP LST,I     NON-INTERACTIVE: RETURN IMMEDIATELY.
* 
**************************************************************************
LST.1 CPB MLFLG     TEST SCREEN MODE FLAG.
      JMP LST.2       NOT SET - DON'T DO SCREEN MODE LIST.
      LDA .4        MAKE SURE WE HAVE SEGMENT 4 
      JSB SLOAD 
      JSB ED%SL     GO DO SCREEN MODE LIST
      JMP LST,I     RETURN
* 
* 
*  TEST FOR FILL LEADING CHARS MODE 
* 
LST.2 LDA SPFLG     GET SPACES FLAG 
      SZA,RSS       TEST
      JMP LST.3        FLAG = 0 ; DON'T PUT OUT SPACES
      LDA NLFLG     GET NUMBERED LIST FLAG
      SZA            AND TEST 
      JMP LST.3         SET - SO DON'T PUT OUT SPACES 
      LDA FILLC     TEST IF 
      LDB FLAGN       WE SHOULD 
      CPB LINES        USE FILL CHAR
      LDA FLGCH          ARE " >" 
      STA LSTB2           FLAG. 
      ISZ LSTSZ     BUMP LENGHT 
      ISZ LSTSZ       BY 2. 
      CCA           A GETS -1 
      ADA LSTA        BACK ADDRESS UP ONE 
      STA LSTA          AND SET.
      LDB A,I       GET DATA THERE
      STB LSTB1       AND SAVE
      LDB LSTB2     GET FILL CHAR 
      STB A,I         AND SET IT. 
      SPC 1 
LST.3 JSB WRTLN     GO WRITE OUT THE LINE 
      SPC 1 
      LDA SPFLG       GET LEADING SPACE FLAG
      SZA,RSS          IS IT ZERO  ?
      JMP LST,I        YES - RETURN NOW 
      LDA LSTB1        NO  - RESTORE THE
      STA LSTA,I                  OLD WORD. 
      JMP LST,I     RETURN
* 
FLGCH ASC 1, >
FILLC ASC 1,        FILL CHARACTER IN FRONT OF LINE 
* 
MSPSP DEF SPSP
* 
LSTB1 BSS 1         TEMP STORAGE (LST DISPLACED WORD) 
* 
* 
* 
SETMS NOP 
      LDA MSP       GET A MINUS SPACE 
      STA FILLC     SET IT AS FILL CHAR 
      JMP SETMS,I   RETURN
* 
MSP   ASC 1,~ 
      SKP 
      HED WRTLN EDIT'S WRITE A LINE SUBROUTINE
* 
* WRTLN - WRITE OUT ONE LINE TO A LU OR FILE
* 
*     LSTA   -  ADDRESS 
*     LSTSZ  -  LENGTH (BYTES, POSITIVE)
* 
*     LSTLU  -  IF POSITIVE =>LU WITH CONTROL BITS ALREADY SET
*               IF NEGATIVE =>FILE WHO'S DCB IS LDCB
* 
WRTLN NOP 
      LDB LSTSZ     GET LENGHT
      CMB,INB,SZB   COMPLEMENT CHARACTER COUNT
      JMP WRT.1     CONTINUE IF NOT ZERO
      LDA MSPSP      OTHERWISE OUTPUT SPACES
      STA LSTA
      LDB M2
WRT.1 STB LSTSZ     SET -(LENGTH)  THE FOR EXEC CALL
* 
      IFZ 
      LDA INTFL     IF THE INTERACTIVE
      SZA            FLAG IS SET, 
      JMP LSINT       GO SET UP FOR WRITE-READ. 
      XIF 
      SPC 1 
*********************************** 
* ALLOW LIST TO FILES 
      LDA LSTLU     GET LIST LU FLAG
      SSA           IF NEGITIVE THEN FILE 
      JMP FLST
      SPC 1 
      JSB DEXEC     ***************** 
      DEF LSRTN 
      IFZ 
      DEF NODE
      XIF 
      DEF .2.I      LIST
      DEF LSTLU      RECORD 
LSTA  NOP           ADDRESS SET HERE
      DEF LSTSZ 
**************
* IF ERROR SET LIST ERROR FLAG
* 
LSRTN JSB LSTER 
      SPC 1 
      IFZ 
LSINT LDA LSTB1     GET BUFFER ADDRESS. 
      LDB LSTB2     GET BUFFER CHARACTER COUNT. 
      JSB INTER     WRITE BUFFER & READ COMMAND.
      XIF 
      JMP WRTLN,I   RETURN
      SPC 1 
* 
* LIST TO A FILE
* 
FLST  LDA LSTSZ     GET LENGTH IN CHAR
      CMA,INA       MAKE IT POSITIVE
      INA           ROUND UP
      CLE,ERA       CHANGE TO WORDS 
      STA LFLNG 
      LDA LSTA      COPY ADDRESS
      STA FLSTA 
      CLA           GET SEGMENT ZERO. 
      JSB SLOAD 
      JSB ED%WF     WRITE ROUTINE IN SEG 0
        DEF FLST0 
        DEF LDCB
        DEF JUNK
FLSTA   BSS 1 
        DEF LFLNG 
        DEF LNAM   NAMR BLOCK FOR ERROR REPORTS 
FLST0 SSA,RSS       IF NEGATIVE THEN ERROR
      JMP WRTLN,I     NO ERROR - RETURN 
      JSB LSTER       ERROR    - SET THE LIST ERROR FLAG
      JSB LCLOS        AND GO CLOSE THE FILE
      LDA LULOG     RESET THE 
      STA LSTLU       LIST LU 
      JMP WRTLN,I  RETURN 
* 
LSTER NOP 
      CCA           SET LIST
      STA LEFLG       ERROR FLAG
      JMP LSTER,I   RETURN
* 
LSTSZ BSS 1         BYTE COUNT TO LIST (CANNGED BY WRTLN) 
* 
LFLNG BSS 1         RECORD LENGTH FOR FILE LIST 
      SKP 
      HED OUTBK EDIT OUTPUT A BLOCK INTO TBUFF
* 
* 
* OUTBK  - OUTBPUT A BLOCK OF CHAR TO TBUFF 
*     A REG - BYTE COUNT
*     B REG - STRING ADDRESS
* 
OUTBK NOP 
      CMA,INA,SZA,RSS MAKE COUNT A LOOP COUNT 
      JMP OUTBK,I   ZERO SO RETURN NOW
      STA OTBKT     SET AS COUNT
      CLE,ELB       CHANGE ADDRESS TO BYTE ADDRESS
      STB OTBKA     SAVE IT 
OTBK1 LDB OTBKA     GET THE BYTE ADDRESS
      JSB .LBT      GET THE BYTE
      STB OTBKA     SAVE BUMPED ADDRESS 
      JSB OUTCR     OUTPUT THE CHAR 
      ISZ OTBKT     CHECK THE COUNT 
      JMP OTBK1       NOT DONE - LOOP 
      JMP OUTBK,I     DONE     - RETURN 
* 
OTBKT BSS 1         LOOP COUNT
OTBKA BSS 1         BYTE ADDRESS
* 
      SKP 
      SKP 
      HED EOFLN     FIND EOF LINE NUMBER
* 
EOFLN NOP           COMPUTE LAST LINE IN FILE 
      LDA LINES     COMPUTE REMATIN SOURCE LINES
      CMA,INA 
      ADA LASTL     SOURCE LINE CAN BE > LASTL IF IT IS PAST EOF
      SSA            SO TEST. 
      JMP EOFL2       YES - GO SEE IF THERE IS A SOURCE LINE
EOFL1 ADA T#REC     ADD LINES IN DEST FILE
      INA           AND BUMP BY ONE TO MAKE IT RIGHT SOURCE LINE #
      JMP EOFLN,I   REUTRN
* 
EOFL2 LDB SLNG
      CLA           ASSUME LINE IS THERE, INA, WILL ADD IT
      SSB 
      CCA           LENGTH NEGITIVE SO NOT THERE, -1+1 = 0
      JMP EOFL1 
      SKP 
* 
TYPEQ NOP           EQUIPMENT TYPE CODE DETERMINATION.
      STA TYPT1     SAVE LOGICAL UNIT, TEMPORARILY. 
      JSB DEXEC     GO TO GET I/O STATUS FOR THE DEVICE.
      DEF TYRTN 
      IFZ 
      DEF NODE
      XIF 
      DEF N.13I     NO-ABORT STATUS REQUEST 
      DEF TYPT1      FOR THE SPECIFIED LOGICAL UNIT NO. 
      DEF ECH       EQT5 RETURNED TO 'ECH'. 
      DEF SWPET     EQT4 RETURNED, BUT NOT USED.
      DEF RUBSH     SUBCHANNEL RETURNED TO RUBSH
TYRTN JMP ERR       ** ERROR: ISSUE "??" ** 
      LDA ECH       ISOLATE THE DEVICE TYPE CODE
      AND DVRTY      FROM EQUIPMENT-TABLE WORD #5.
      STA DVTY       SAVE IT
      SZA,RSS       IF IT'S TYPE <00> (INTERACTIVE),
      JMP TYPEQ,I    THEN RETURN IMMEDIATELY: <A>=0.
* 
      CPA DVR05     IF IT'S A 264X TERMINAL, THEN 
      JMP TYPE5      GO TO EXAMINE THE LU SUBCHANNEL; 
      CPA DVR07      2645 MP TERMINAL?
      CLA            YES, CLEAR "A" 
      JMP TYPEQ,I     ELSE RETURN: <A> #0 (NON-INTERACTIVE).
* 
TYPT1 BSS 1           
* 
TYPE5 LDA RUBSH     GET SUBCHANNEL FOR DEVICE.
      AND B37       ISOLATE SUBCHANNEL BITS(#4-0).
      STA B         SAVE IT TEMPORARILY.
      SZA,RSS       IF THE SUBCHANNEL IS ZERO, THEN RETURN
      JMP TYPEQ,I    WITH SIMULATED TYPE <00> CODE IN <A>.
      LDA DVR23     PREPARE TO SIMULATE MAG. TAPE TYPE<23>. 
      CPB =D4       IF THE SUBCHANNEL IS FOUR, THEN 
      LDA DVR12      SIMULATE TYPE <12> LINEPRINTER.
      JMP TYPEQ,I   RETURN--DEVICE TYPE: <12>,LP OR <23>,MT.
      SPC 1 
******* 
* 
      SPC 1 
* 
N.13I OCT 100015    STATUS REQUEST CODE 
RUBSH NOP           ANYTHING I DON'T WANT GOES HERE 
************************************************************
* 
DVR12 OCT 5000      LINE PRINTER TYPE CODE. 
DVR37 OCT 17400     HPIB TYPE CODE. 
***************************** 
* 
      ENT CBYTE 
      EXT .ENTR,.CBT
* 
* STRING COMPARISON ROUTINE 
* PASS STRING BLOCKS AND INDICES FOR THE FIRST BYTE OF EACH 
*    AND THE NUMBER OF BYTES TO COMPAIR 
* <VALUE> = CBYTE(BUF1,IND1,BUF2,IND2,SIZE) 
* <VALUE> IS >0 IF STRING1 > STRING2
*            =0 IF STRING1 = STRING2
*            <0 IF STRING1 < STRING2
* 
BUF1  BSS 1 
IND1  BSS 1 
BUF2  BSS 1 
IND2  BSS 1 
SIZE  BSS 1 
CBYTE BSS 1 
      JSB .ENTR 
      DEF BUF1
      LDA BUF1      SET UP PTR TO STRING 1
      RAL 
      ADA IND1,I
      ADA =D-1
      LDB BUF2      SAME FOR STRING 2 
      RBL 
      ADB IND2,I
      ADB =D-1
      JSB .CBT
      DEF SIZE,I
      DEC 0         SPECIAL WORD FOR UCODE USE
      JMP RET0
      JMP RETM1 
      CLA,INA       RETURN 1
      JMP CBYTE,I 
RET0  CLA           RETURN 0
      JMP CBYTE,I 
RETM1 CCA           RETURN -1 
      JMP CBYTE,I 
*    NAM LOWBT,8 2015 WHH Byte load routine 
     ENT LBYTE
     EXT .ENTR,.LBT 
* 
* LOAD BYTE FROM ARRAY, CALL IS:
*    <VALUE> = LBYTE(IARRAY,IWHICH) 
* ODD BYTES ARE IN BITS 15-8, EVEN BYTES ARE IN BITS 7-0
* FIRST BYTE IS ONE (NOT ZERO)
* 
LBP1  BSS 1         ARRAY ADDRESS 
LBP2  BSS 1         WHICH BYTE
LBYTE BSS 1 
      JSB .ENTR 
      DEF LBP1
      LDB LBP1
      CLE,RBL 
      ADB LBP2,I
      ADB =D-1
      JSB .LBT
      JMP LBYTE,I 
*    NAM SBYTE,8 2015 WHH Byte store routine
     ENT SBYTE
     EXT .ENTR,.SBT 
* 
* STORE A BYTE INTO ARRAY, CALL IS: 
*    CALL SBYTE(IARRAY,IWHICH,NEWVAL) 
* ODD BYTES IN BITS 15-8, EVEN BYTES IN BITS 7-0
* FIRST BYTE IS ONE (NOT ZERO)
* 
ARRAY BSS 1         ARRAY ADDRESS 
WHICH BSS 1         WHICH BYTE
VALUE BSS 1         NEW VALUE 
SBYTE BSS 1 
      JSB .ENTR 
      DEF ARRAY 
      LDB ARRAY 
      CLE,RBL 
      ADB WHICH,I 
      ADB =D-1
      LDA VALUE,I 
      JSB .SBT
      JMP SBYTE,I 
*     NAM BLT,7 2015 WHH Block transfer routine 
      ENT BLT 
      EXT .ENTR,.MVW
* 
* ROUTINE TO MOVE WORDS WITH THE MICRO-INSTRUCTION "MVW"
*    CALL BLT(SOURCE,DEST,HOWBIG) 
* 
SRC   BSS 1 
DST   BSS 1 
BSIZE BSS 1 
BLT   BSS 1 
      JSB .ENTR     RESOLVE ENTRY STUFF 
      DEF SRC 
      LDA SRC       SOURCE ADDR 
      LDB DST       DEST ADDR 
      JSB .MVW      USE UCODE IF POSSIBLE 
      DEF BSIZE,I 
      DEC 0         SPECIAL UCODE WORD
      JMP BLT,I 
      END EDIT
                                          