ASMB,R,Q,C,Z  ** ASSEMBLE DS/1000 VERSION **  
      HED RTE INTERACTIVE EDITOR * (C) HEWLETT-PACKARD CO. 1979 * 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
*  ***************************************************************
* 
*     NAME  : EDITR 
* 
*     SOURCE: 92002-18010  'N' ASSEMBLY OPTION: STANDARD RTE
*     RELOC : 92002-16010  'N' ASSEMBLY OPTION: STANDARD RTE
* 
*     SOURCE: 91740-18022  'Z' ASSEMBLY OPTION: DS/1000 LOCAL & REMOTE USE. 
*     RELOC : 91740-16022  'Z' ASSEMBLY OPTION: DS/1000 LOCAL & REMOTE USE. 
* 
*     PGMR  : TAS,GAA,RMC,EJW,CHW,CCH,GWJ,HLC 
* 
      IFN 
      NAM EDITR,3,50 92002-16010 REV 2026 800501
      XIF 
      IFZ 
      NAM EDITR,19,50 91740-16022 REV 2026 800501 
      EXT DEXEC,#NODE 
      XIF 
      EXT EXEC,$LIBR,$LIBX,OPEN,CLOSE,READF,WRITF 
      EXT CREAT,PRTN,PNAME
      EXT LOGLU,REIO,LURQ,NAMR,.MVW,RMPAR 
      IFN 
DEXEC EQU EXEC
      XIF 
      SUP PRESS EXTRANEOUS LISTING
      SPC 1 
MAXIN DEC -150
MAXOP DEC 150 
MAX   DEC 150 
"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 
"#"   OCT 43
M16   DEC -16 
DCBSZ NOP 
M91   DEC -91 
M10   DEC -10 
.2.I  DEF 2,I       WRITE CODE WITH ERROR-RETURN. 
.1.I  DEF 1,I       READ CODE WITH ERROR-RETURN.
.10   DEC 10
.12   DEC 12
.23   DEC 23
COMND NOP           ALSO TEMP TO STORE NAME 
TRFLG NOP 
EXFLG DEC -1
TTYLU NOP           LOGICAL UNIT NUMBER OF TELETYPE 
OCCNT NOP 
LSTFG NOP 
"A"   OCT 101 
"I"   OCT 111 
"L"   OCT 114 
PLUSS OCT 53
MINUS OCT 55
SLASH OCT 57        ALTERNATIVE FOR + COMMAND.
"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 EDITR
ECCNT NOP           ALSO MXSEC
B600  OCT 600 
"F"   OCT 106 
ERAB? DEC -1        IF NON-ZERO, ABORT EDIT ON ANY ERROR
RBUF  BSS 5         RMPAR PARAMETER BUFFER
      SPC 1 
EDITR JSB RMPAR     GET START-UP PARAMETERS 
      DEF *+2 
      DEF RBUF
      LDA RBUF      FETCH TTY LU
      AND B77 
      CPA RBUF        MUST BE LESS THAN 64
      RSS 
      JMP EXIT      ILLEGAL LU
      IOR B600       SET ECHO BIT OF TELETYPE LU
      CPA B600      IF NO LU
      INA            SPECIFIED USE
      STA TTYLU       LU = 1
      IFZ 
      IOR BIT11     SET INTERACTIVE READ BIT
      STA INLU
      JSB PNAME     MOVE PROGRAM NAME TO BUFFER 
      DEF *+2 
      DEF ENAME+4 
      XIF 
      JSB PNAME 
      DEF *+2 
      DEF NAME
      JSB PNAME     LIST DEVICE WAIT MESSAGE
      DEF *+2 
      DEF NAME1 
      JSB PNAME     TRACK WAIT MESSAGE
      DEF *+2 
      DEF NAME2 
* 
      LDA RBUF+1    FETCH MAX RECRD 
      SSA,RSS       NEW MAX OUTPUT RECORD 
      SZA,RSS        WHICH IS >0 ?
      JMP RCHK      NO, USE DEFAULT MAXOP 
      ADA MAXIN     USE THE SMALLER 
      SSA,RSS         OF THE NEW
      CLA               LIMIT OR
      ADA MAXOP           THE DEFAULT 
      STA MAXOP             LIMIT 
RCHK  EQU * 
      IFZ 
      DLD RBUF+2    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 <EDITR>; ELSE, 
      SZB             IF NEG.(NEIGHBOR), ARE WE SCHEDULING? 
      JMP SVNOD        NO, WE'VE BEEN SCHEDULED.
      LDA RBUF+4    CHECK SPECIAL CASE: SCHED. FROM NODE #0.
      CPA .1        WERE WE SCHEDULED FROM NODE #0? 
      JMP SVNOD      YES, ACCOMMODATE THE REMOTE REQUEST. 
* 
SCHED LDA RBUF+4    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 LDA TTYLU 
      JSB TYPEQ     CHECK FOR INTERACTIVE DEVICE
      STA ERAB?     ABORT ON ERROR IF NON-ZERO
* 
      JSB DEXEC     DO REMOTE SCHEDULE OF EDITR 
      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 EDITR AVAILABLE?
      JMP EXIT      YES 
NOTAV CCA           NO. INFORM THE USER.
      STA NODE      GIVE LOCAL MESSAGE
      JSB ERROR 
      DEF EXIT
      DEC 13
ENAME ASC 13,REMOTE EDITR 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 RBUF+4      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 
      JSB EXEC      SET ALL CORE BIT
      DEF *+3       IN CASE WE ARE IN 
      DEF .22        FOREGROUND 
      DEF .3
      SPC 1 
      LDA XIDT      GET ID-SEG ADDRESS
      ADA .23       STEP TO HIGH MAIN 
      LDA A,I       GET 1ST WORD OF AVAIL. MEMORY 
      SKP 
      SPC 1 
*     SET UP BUFFER AREA TO FILL CORE 
      SPC 1 
*     ****************************************
*     *            LAST WORD AVAILABLE MEMORY*       ^
*     *                                      *       ^
*     *                                      *       ^
*     *  SOURCE BUFFER                       *       ^ SBUFP RANGE
*     *                                      *       ^
*     *                                      *       ^
*     *                   COMPUTED FIRST WORD* SBUF$ ^
*     ****************************************       ^
*     *                                      *       ^
*     *  >= 75 WORDS FOR PARTIAL RECORD      *       ^
*     *                                      *       ^
*     ****************************************
*     *                    COMPUTED LAST WORD*        ^ 
*     *                                      *        ^ 
*     *                                      *        ^ 
*     *  DESTINATION BUFFER                  *        ^ DBUFP RANGE 
*     *                                      *        ^ 
*     *                                      *        ^ 
*     *           FIRST WORD AFTER EDITR CODE* DBUF$  ^ 
*     ****************************************
*     *                                      *
*     *  EDITR 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 M1          AS LAST WORD AVAILABLE
STAD  ADB M16       DCB HEADER SPACE
      STB LWA 
      LDA DBUFP 
      CMA,INA          FOR BUFFERS
      ADA LWA 
      ADA M91       2 16-WORD DCB HEADERS + 75 WORDS BETWEEN DCB'S
      SSA 
      HLT 0         NOT ENOUGH MEMORY 
      CLB 
      ASR 8         DIVIDE BY 256 
      SZA,RSS 
      HLT 0         NOT ENOUGH MEMORY 
      LDB MXSEC     LIMIT BUFFERS 
      CMB,INB 
      ADB A          TO MIN(SECT2,SECT3,FREE MEMORY SIZE) 
      SSB,RSS         128 WORD
      LDA MXSEC        SECTORS (DO NOT EXCEED SMALLEST TRACK) 
      STA SCT   NUMBER OF INPUT/OUTPUT SECTORS
      ASL 7         CONVERT SECTORS TO WORDS
      STA DCBSZ 
      ADA DBUF$ 
      STA DBEND   END OF OUTPUT BUFFER POINTER
* 
      LDB DCBSZ 
      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 ERAB?       ABORT ON ERROR IF NON-INTERACTIVE 
      SZA           INTERACTIVE DEVICE ?
      JMP SRCIN      NO. BYPASS MESSAGES. 
      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
      CPA DVR07 
      RSS 
      JMP PSFC      NO, SKIP NEXT CODE
      STA DVTYX     SAVE CONS. DVR. TYPE. 
      JSB PRINT      SET TABS AT COLUMN'S 8 AND 23. 
      DEF PSFC
      DEC -17 
      ASC 9,3&a8C1&a22C1 
PSFC  JSB PRINT     PRINT "SOURCE FILE" 
      DEF SRCIN 
      DEC 6 
      ASC 6,SOURCE FILE?
SRCIN JSB TTYIP     INPUT RESPONSE
      CPB .1        ONE WORD RESPONSE?
      JMP FTST      YES, CHECK FOR "0", OR ":". 
FPARS JSB SC.CR     PARSE FILE NAME 
      JMP LSFIL     USE LS AREA 
      DLD FSECR     SAVE SC AND CR FOR A
      DST FSECW      POSSIBLE ER. 
      JSB INSRC     FETCH FILE
      JMP PSF       NOT FOUND TRY AGAIN 
* 
      LDA FCARW     GET USER'S CART. SPECIFICATION. 
      SZA           WAS IT SUPPLIED?
      JMP STEOF      YES--NO NEED TO FAKE IT. 
      LDA SBUF$,I    NO. GET FIRST WORD OF DCB. 
      AND B77       ISOLATE THE FILE'S LOCATION LU. 
      CMA,INA       NEGATE, AND SAVE FOR
      STA FCARW      POSSIBLE USE IN FILE REPLACEMENT.
* 
STEOF CCA           SET EOF FLAG
      STA SLNG      IN SOURCE LENGTH
      JSB ./B1      TRANSFER PARTIAL BUFFER 
      JMP STBUF     SET TBUFF.
      SPC 1 
FTST  LDA EBUFF,I   GET SINGLE INPUT CHARACTER
      ALF,ALF       ISOLATE THE 
      AND LBYTE      FIRST-AND 0NLY-INPUT CHARACTER.
      CPA ":"       =":"? 
      JMP ./A1      YES, QUIT NOW 
      CPA B60       ="0"? 
      CLA,RSS       YES, SIMULATE NULL LS 
      JMP FPARS     GO PARSE FILE NAME
      JMP LSNUL 
      SPC 1 
LSFIL EQU * 
      IFZ 
      JSB REMCK     TALKING REMOTE? 
      CLA,RSS       YES,TREAT LS AS UNDEFINED 
      XIF 
      LDA SFCUN     SAVE SYSTEM LS POINTER, 
LSNUL CCB           UNLESS LS UNDEFINED.
      SZA,RSS 
      STB NOLSF 
      STA LSLUT      IN SOURCE FILE POINTER AND 
      STA LSTRK       SET UP RELEASE TRACK PNTR 
      JSB ALCAT     GET LS FILE AND DEST. TRACK 
      CCA           IF THE LOGICAL SOURCE AREA
      CPA NOLSF      IS UNDEFINED, THEN 
      JMP STEOF+1     BYPASS SOURCE INPUTS, AT PRESENT. 
      JSB SQ        FILL INPUT BUFFER 
STBUF LDA TBUFP      POINT TBUFF TO TBUF0 
      STA TBUFF      FOR ALL OTHER EDIT USES. 
      JMP DISPL     PRINT FIRST LINE
      SPC 1 
.22   DEC 22
TBUFP DEF TBUF0 
MBUF0 EQU EDITR     OVERLAY ONE-TIME CODE.
LERR  EQU *-EDITR-75  CHECK ENOUGH ONE-TIME CODE FOR
*                                       75 WORDS OF MBUF0.
      SPC 1 
*     MBUF0 OVERLAYS CODE AT THE START ('EDITR') 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.
      SPC 1 
NOLSF OCT 0         SET TO -1 IF LS UNDEFINED.
N141  OCT -141
N32   OCT -32 
* 
********* 
*     READ IN EDIT COMMAND AND ACT ON IT. 
********* 
* 
NODE1 CLA           RESET CHARACTER 
      STA EXFLG      EXCHANGE FLAG
      LDA LUCMD     GET THE LAST LU-LOCK COMMAND. 
      SLA           IF THE LIST LU WAS LOCKED,
      JSB LULOK      THEN GO TO UNLOCK IT.
      LDA TTYLU     RESET THE 
      STA LSTLU     LIST LU 
      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 TTYIP     INPUT COMMAND 
      JSB ECH 
      JMP ERR 
      JSB LCASE     CONVERT LOWER CASE CHAR.--IF REQUIRED.
      STA COMND     SAVE TEMPORARILY
* 
      CPA "A" 
      JMP ./A 
      LDB ./EFL     IF END ENTERED ANY OTHER COMMAND
      SZB,RSS       IS DISALLOWED 
      JMP NOTEN     OK ALLOW ANY COMMAND
      CPA "E"       END AGAIN?
      JMP ./E2      YES GO TRY THE NEW FILE NAME
      JMP ERR       NO ERROR
NOTEN LDB B40       RESET TAB FILL
      STB TBFIL     TO SPACE
      CPA B40         COMMAND?
      JMP O/PEB       NO, OUTPUT LINE 
      CPA "=" 
      JMP ./= 
      CPA %G
      JMP ./CG      MUTE BELL WITH PROMPT.
      CPA "P" 
      JMP ./P       DISPLAY CURRENT LINE
      CCB 
      STB TRFLG 
      STB LSTFG 
      CPA "C"       IF CHARACTER
      JMP ./C       GO DO IT
      CPA "L" 
      JMP NUMBR 
      CLB 
      STB LSTFG     RESET LIST FLAG 
      CPA "K" 
      JMP ./K 
      CPA "#"       SEQUENCE NUMBER?
      JMP ./# 
      CPA "O" 
      JMP ./O 
      CPA "M"       MERGE NEW SOURCE? 
      JMP ./M      YES GO DO IT 
      CPA SLASH     SLASH AND "+" MEAN THE SAME 
      RSS 
      CPA PLUSS 
      JMP NUMBR 
      CPA "E" 
      JMP ./E 
      CPA "N" 
      JMP ./N 
      CPA "H" 
      JMP ./H 
      CPA "S" 
      JMP ./S 
      CPA "T" 
      JMP ./T 
      CPA "U" 
      JMP ./U       UNCOND. REPLACE W/O LIST. 
      CPA "V" 
      JMP ./V       THIS WITH LIST. 
      CPA "W"       SPECIFY A NEW WINDOW? 
      JMP ./W 
      CPA "G" 
      JMP ./Z 
      CPA "X" 
      JMP ./X 
      CPA "Y" 
      JMP ./X 
      CPA "Z"       DEFINE XCHANGE PATRN W/O LIST 
      JMP ./Z 
      CPA "^" 
      JMP ./^ 
      STB TRFLG     RESET TRANSFER FLAG 
      CPA MINUS 
      JMP NUMBR 
      JSB ASCII     COMMAND CHARACTER 
      RSS             NUMERIC?
      JMP FNUM      YES, GO TO FIND LINE NUMBER 
      JSB TAB       TAB THE COMMAND LINE
      LDA COMND      RESTORE COMMAND CHARACTER
      CPA "Q"        TERMINAL INTRINSIC EDIT? 
      JMP ./Q        YES, GO TO PROCESS.
      CPA "R" 
      JMP ./R 
      CPA "I" 
      JMP ./I 
      JSB SWPET 
      LDA COMND 
      CPA "D" 
      JMP COMPR 
      CPA "J"       JUMP TO NEW LINE W/O TRANSFER 
      JMP ./J 
      CCB 
      STB TRFLG     SET TRANSFER FLAG 
      CPA "F" 
      JMP COMPR 
      CPA "B"       COMPLETE TRANSFER AND START SEARCH
      JMP ./B         FROM THE BEGINNING
ERR   JSB ERROR     ERROR 
      DEF NODE1      IN INPUT 
      DEC 1           COMMAND 
      ASC 1,??         PRINT "??" 
*** 
%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
DVR12 OCT 5000      LINE PRINTER TYPE CODE. 
DVR23 OCT 11400     MAG. TAPE TYPE CODE.
DVRTY OCT 37400     DRIVER TYPE MASK
N.13I OCT 100015    STATUS REQUEST CODE 
LSTLU OCT 606       LIST LU 
* 
NUMBR JSB NUMIN 
      CMA,INA       COMPLEMENT NUMBER 
      SZA,RSS        AND STORE IN COUNT 
      CCA           IF NUMBER IS ZERO SET 
      STA COUNT      TO -1
      JSB NLSLU     SET UP NEW LU IF GIVEN
./CC  JSB TR
      SSB            EOF FOUND? 
      JMP EOFPR      YES, PRINT "EOF" 
FNUM2 ISZ COUNT     FOUND LINE NUMBER?
      JMP ./CC      NO, FETCH NEXT LINE 
      JMP DISPL     YES, DISPLAY IT 
      SPC 1 
NLSLU NOP 
      JSB NUMIN     GET OPTIONAL NEW LIST LU
      AND B77       SAVE JUST THE LU
      LDB 0 
      SZA,RSS       IF NOT SUPPLIED 
      LDA TTYLU     USE TTY LU
      IOR B600      SET ECHO AND V-BITS 
      STA LSTLU     SAVE THE LU 
      SZB,RSS       SKIP UNLESS NOT SPECIFIED 
      JMP NLSLU,I 
* 
      JSB TYPEQ     GET LIST DEVICE TYPE CODE.
      SZA,RSS       IF IT'S INTERACTIVE,
      JMP NLSLU,I    THEN SIMPLY RETURN; ELSE, CHECK: 
      LDA LSTLU 
      CPA TTYLU     MUST NOT BE SAME AS COMMAND INPUT DEVICE
      JMP ERR 
      JSB LULOK     GO TO LOCK THE LIST DEVICE. 
      JMP NLSLU,I   RETURN. 
      SPC 1 
LULOK NOP           LIST LU LOCKING/UNLOCKING ROUTINE.
      LDA LUCMD     GET THE CURRENT COMMAND.
      XOR .1        CONVERT TO OPPOSITE ACTION. 
      STA LUCMD     SAVE FOR NEXT PASS. 
      STA IOPT      CONFIGURE THE CALL. 
      IFZ 
      JSB REMCK     IF THE LIST DEVICE IS REMOTE, 
      JMP LULOK,I    THEN LOCKING IS NOT REQUIRED.
      XIF 
LOKIT JSB LURQ      REQUEST 
      DEF *+4        LOCK OR
      DEF IOPT        UNLOCK
      DEF LSTLU        FOR THE SPECIFIED
      DEF .1            LIST LOGICAL UNIT.
      JMP LUERR     REPORT THE ERROR. 
* 
      CPA M1        IF NO RN'S AVAILABLE, NOW,
      CLA,INA,RSS    THEN GO BACK AND WAIT. 
      CPA .1        IF LOCKED BY ANOTHER, THEN
      JMP WAITL      GO BACK TO WAIT FOR IT.
      JMP LULOK,I   LOCK/UNLOCK SUCCESSFUL--RETURN. 
* 
WAITL IOR BIT14     INCLUDE NO-ABORT BIT, 
      STA IOPT       AND SET COMMAND: WAIT FOR LU/RN. 
      JSB PRINT     INFORM
      DEF LOKIT      THE USER 
      DEC 15          THAT WE MUST WAIT.
NAME1 ASC 15,EDITR WAITING FOR LIST DEVICE. 
* 
LUERR DST LUMSG+7   CONFIGURE ERROR MESSAGE.
      LDA TTYLU     REPORT TO THE CONSOLE, INSTEAD, 
      STA LSTLU      DUE TO LIST-DEVICE PROBLEM.
      JSB ERROR     PRINT THE ERROR MESSAGE,
      DEF LULOK,I    AND DO THE REQUESTED LISTING.
      DEC 9 
LUMSG ASC 9,LU LOCK ERROR XXXX
LUCMD OCT 140001    NO WAIT/NO ABORT/LOCK 
IOPT  OCT 140000    FIRST TIME: UNLOCKS ANY LU'S. 
BIT14 OCT 40000 
DVTY  NOP 
DVTYX NOP 
* 
TYPEQ NOP           EQUIPMENT TYPE CODE DETERMINATION.
      STA LULOK     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 LULOK      FOR THE SPECIFIED LOGICAL UNIT NO. 
      DEF TAB       EQT5 RETURNED TO 'TAB'. 
      DEF SWPET     EQT4 RETURNED, BUT NOT USED.
      DEF CHKN      SUBCHANNEL RETURNED TO 'CHKN'.
TYRTN JMP ERR       ** ERROR: ISSUE "??" ** 
      LDA TAB       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?
DVR05 CLA            YES, CLEAR "A" 
      JMP TYPEQ,I     ELSE RETURN: <A> #0 (NON-INTERACTIVE).
* 
TYPE5 LDA CHKN      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 .4        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 
COMPR JSB TR        TRANSFER PENDING LINE 
COMP1 JSB ECH       MATCH FIELD SUPPLIED? 
      JMP EOFTS     NO USE OLD ONE
COMP2 LDA EBUFF     YES  SWAP EBUFF 
      LDB MBUFF      AND MBUFF
      STA MBUFF     SET UP THE
      STB EBUFF     NEW MATCH FIELD 
      LDA ELNG      SET THE NEW MATCH LENGTH
      STA MLNG      FOR MBUFF 
EOFTS LDA SLNG      IF AT 
      SSA            END OF FILE
      JMP EOFPR       PRINT "EOF" 
      JMP COMP4     START SEARCH
COMP3 JSB TR
      SSB           EOF FOUND?
      JMP EOFPR     YES, PRINT "EOF"
COMP4 CLA           CLEAR 
      STA WINDF      WINDOW FLAG
      STA MCCNT 
      STA JDEF$     ZERO THE INDEFINITE 
      STA IDEF$      FLAGS. 
CMPR1 JSB MCH 
      JMP DISPL 
      CPA INDEF     INDEFINITE CHARACTER? 
      JMP CMPR2     YES - GO SET UP.
      CPA DLMTR     WINDOW SPECIFIED
      JMP CMPR5      ON SEARCH
CMPR7 STA NUM1      NO - SAVE THE CHARACTER 
CMPR6 LDA WIND2     PAST
      ADA SCCNT      WINDOW AND 
      LDB WINDF       WINDOW
      SLB              FLAG 
      SSA               SET?
      RSS           NO -- CONTINUE SCAN 
      JMP COMP3     YES -- PATTERN NOT FOUND
      SPC 1 
      JSB SCH       GET SOURCE CHARACTER. 
      JMP EOL       END OF INPUT
      CPA NUM1      COMPARE WITH PATTERN
      JMP CMPR3     COMPARES SO JUMP TO INDEF TEST
      LDB IDEF$ 
      INB,SZB,RSS   IF FIRST CHARACTER SEARCH 
      JMP CMPR6     TRY THE NEXT CHARACTER. 
      ISZ JDEF$     END OF INDEF MATCH? 
      JMP COMP3     NO - SO NO MATCH. 
      SPC 1 
      LDA SCCN$     RESET SOURCE POINTER
      STA SCCNT     AND 
      LDA MCCN$     PATTERN 
      STA MCCNT     LOCATION THEN 
      LDB WINDF     RESET THE WINDOW FLAG 
      BRS           IF TWO SET TO 1 ELSE 0. 
      RSS           SKIP THE CLEAR. 
      SPC 1 
CMPR2 CLB           CLEAR 
CMPR8 STB WINDF      WINDOW FLAG
      LDA MCCNT     SET UP FOR INDEFINITE 
      STA MCCN$     CHARACTER 
DVR07 CCA           SAVE THE PATTERN LOCATION AND 
      STA IDEF$     SET THE FIRST CHAR. FLAG
      STA JDEF$     AND THE INDEF FLAG
      JMP CMPR1     GO GET THE FIRST PATTERN CHARACTER. 
      SPC 1 
CMPR3 ISZ IDEF$     FIRST CHAR FOUND AFTER INDEF CHAR?
      JMP CMPR1     NO CONTINUE 
      LDB WINDF     GET WINDOW FLAG AND 
      CPB .1        IF ONE SET TO 
      ISZ WINDF     SET TO TWO
      LDA SCCNT     YES - SET 
      STA SCCN$     CURRENT SOURCE POSITION.
      JMP CMPR1     CONTINUE MATCH
      SPC 1 
CMPR5 CLB,INB       IS WINDOW CHARACTER 
      CPB MCCNT      THE FIRST CHAR. OF COMMAND?
      RSS           YES -- CONTINUE 
      JMP CMPR7     NO, IGNORE
      LDA WIND1     START SEARCH AT 
      STA SCCNT      BEGINNING OF WINDOW
      CMA,INA       IF WINDOW 
      ADA SLNG       STARTS BEYOND
      SSA             END OF LINE 
      JMP COMP3        DO NOT SEARCH
      JMP CMPR8     CONTINUE SEARCH WITH INDEF. 1ST 
      SPC 1 
* 
EOL   CCA 
      ADA MLNG      IF THE ONLY CHARACTER IN THE MATCH FIELD
      IOR NUM1        IS ZERO (CNTR-@)
      IOR SLNG          AND THE CURRENT LINE IS LENGTH ZERO,
      SZA,RSS 
      JMP DISPL           THEN DISPLAY IT.
      JMP COMP3     ELSE, NOT FOUND 
* 
* 
FNUM  CLA           RESET COMMAND 
      STA ECCNT       CHARACTER POINTER 
      JSB NUMIN     COMPUTE LINE NUMBER 
      CMA,INA,SZA,RSS  COMPLEMENT AND IF ZERO 
      CCA             SET TO -1 
      STA COUNT         AND SAVE
      STA TRFLG     SET TRANSFER FLAG 
      JSB NLSLU     SET UP NEW LU IF GIVEN
      LDA COUNT     LOAD -(LINE NUMBER DESIRED) 
      ADA LINES     ADD CURRENT POSITION
      SSA,RSS       IF POSITIVE 
      JMP FNUM3      GO TO BEGINNING OF FILE
      STA COUNT      ELSE USE DIFFERENCE AS LOOP CNTR 
      JMP ./CC      GO FIND LINE
      SPC 1 
FNUM3 JSB ./B1      COMPLETE TRANSFER 
      JMP FNUM2     SPACE FORWARD TO DESIRED LINE 
      SPC 1 
./#   LDA M3        SKIP OVER 
      STA COUNT     ALPHA COMMENT.
./#0  JSB ECH 
      NOP 
      ISZ COUNT 
      JMP ./#0
      JSB NUMIN     FETCH START NUMBER
                                                                                                                        