* 
*  SUBROUTINE TO COMPUTE NEXT BASE ADDRESS FOR A MOVE 
*   CALL: (A) = NO. OF CHARACTERS IN PREVIOUS MOVE
*         (B) = PREVIOUS BASE ADDRESS 
*  RETURN TO (P+1) - (A) = NEXT BASE ADDRESS
NXAD  NOP           ENTRY/EXIT
      SZA,RSS       IF A = ZERO,
      JMP NXEX       EXIT 
      STB NXRA      SAVE REFERENCE ADDRESS
      RAR           CONVERT CHARS. TO WORDS 
      STA NXSG      SAVE RESULT FOR SIGN TEST 
      AND CHMK      REMOVE SIGN BIT 
      SSB           COMPLEMENT REFERENCE
      CMB,INB        ADDRESS IF NEGATIVE
      ADB 0         ADD WORD TO ADDRESS 
      LDA NXRA       CHECK SIGN OF REF. 
      SSA            ADDRESS, IF NEG. 
      JMP NGAD       THEN JUMP
      LDA NXSG      IF SIGN OF RESULT 
      SSA            OF CHAR/WORD 
      CMB,INB        CONVERSION IS NEG. 
NXEX  LDA 1          THEN COMPLEMENT. 
      JMP NXAD,I     A = NEW ADDRESS
NGAD  LDA NXSG      - NEGATIVE REFERENCE ADDR.
      SSA,RSS       IF SIGN OF CHAR/WORD IS 
      CMB            NEG., INCREASE REF. ADDRESS. 
      INB            OTHERWISE COMPLEMENT 
      JMP NXEX       ADDRESS AND EXIT 
*PUNCH SYMBOLIC FILE RECORD 
PUN   NOP 
      LDA SYCT
      LDB SBUF
      JSB UFOUT 
      JMP PUN,I 
      SKP 
* 
*  SUBROUTINE TO POSITION SYMBOLIC FILE TO N1 OR
*    TO N2 IF N2 NOT EQUAL ZERO.  IF INSERT CS, 
*    THEN RECORD N1 IS OUTPUT, OTHERWISE N1 LEFT
*    IN BUFFER
* 
PSFX  NOP           ENTRY/EXIT
      LDA N1XX      INITIALLY, CHECK N1 
      LDB SYSQ       WITH SEQUENCE NO.
      CMB,INB        OF SYMBOLIC FILE 
      ADA 1         SUBTRACT SEQ. NO. 
      SSA            FROM N1. 
      JMP SEQE2     IF NEGATIVE, ERROR
      SZA,RSS       IF ZERO, POSITIONED 
      JMP PX02       PROPERLY 
PX01  JSB SYMI      POSITION TO N1
      SZA,RSS        IF END-OF-TAPE, THEN 
      JMP SEQE2     N1 ERROR
      STA SYCT      SAVE CHARACTER COUNT
      LDA SYSQ      CHECK FOR FILE POSITIONED 
      CPA N1XX      TO N1 
      JMP PX02      YES - POSITIONED TO N1
      JSB PUN       PUNCH SYMBOLIC FILE RECORD
      JMP PX01      GET NEXT RECORD 
PX02  LDA CSFL      POSITIONED TO N1 - CHECK
      SZA            FOR INSERT RECORD
      JMP PX03      NO, OTHER THAN INSERT 
      LDA SYCT       YES, OUTPUT CURRENT
      LDB SBUF      SYMBOLIC RECORD 
      JSB UFOUT     TO PUNCH
      JMP PX05      GO TO CLEAN-UP SECTION
PX03  LDA N2XX      CHECK FOR N2 PRESENT
      SZA,RSS        IF N2 = ZERO,
      JMP PX05       GO TO CLEAN-UP 
      LDB N1XX      N2 PRESENT, SUBTRACT
      CMB,INB        N1 FROM N2 - 
      ADA 1          SET RESULT NEGATIVE
      CMA,INA        FOR COUNTER TO 
      STA FFCT        N2
PX04  JSB SYMI      POSITION TO N2
      SZA,RSS       END-OF-TAPE 
      JMP SEQE2     ERROR 
      ISZ FFCT      REDUCE COUNT
      JMP PX04       LOOP TO READ 
PX05  CLA,INA       SET CONTROL STATEMENT 
      STA CSAF       ACTIVE FLAG
      LDA EDAD      SAVE CURRENT EDIT 
      STA SEDA       FILE ADDRESS 
      JSB GETA      GET ADDRESS OF NEXT EDIT
      JMP PSFX,I    FILE STATEMENT - EXIT 
SEQE2 LDA SEQM
      JMP EDERA 
      SKP 
* 
*  SUBROUTINE TO COMPUTE ADDRESS OF NEXT
*   EDIT FILE STATEMENT AND STORE 
*   ADDRESS AT EDAD.
*   CALL: JSB GETA, RETURN: (P+1) 
GETA  NOP           ENTRY/EXIT
      LDA EDAD,I    GET NO. OF CHARS. FOR 
      RAR            CURRENT RECORD, CONVERT
      SSA            TO WORDS, MAKE EVEN
      INA            NUMBER OF CHARS. 
      AND CHMK      REMOVE SIGN. ADD 1 TO 
      INA            SKIP FIRST WORD AND
      ADA EDAD       ADD CURRENT ADDRESS
      STA EDAD      -SET NEXT ADDRESS 
      JMP GETA,I     AND EXIT 
      SKP 
* 
*  SUBROUTINE TO EXTRACT A CHARACTER FROM AN EDIT 
*   FILE STATEMENT (NORMALLY A CONTROL STATEMENT) 
*   AND RETURN THE CHAR (IN A) TO THE CALLER. 
* 
*   THE FOLLOWING WORDS MUST BE SET BY THE CALLER 
*   ONCE FOR EACH STATEMENT:
*        CHCT - HOLDS NEG. LENGTH+1 OF STATEMENT (CHARS.) 
*        CSAD - HOLDS ADDRESS OF STATEMENT
*        F525 - CHARACTER POSITION FLAG (INITIALLY, 
*               SIGN SET TO ZERO FOR UPPER CHARACTER) 
* 
*  CALLING SEQUENCE:  JSB GETC
*                     (RETURN)  (CHAR IN A(07-00))
*  (A) = ZERO ON RETURN IF END-OF-STATEMENT REACHED 
*  SPACES (BLANKS) ARE IGNORED BY THE ROUTINE 
* 
GETC  NOP           ENTRY EXIT
      CLA           SET A = ZERO FOR END-OF-STATEMENT 
      ISZ CHCT      UPDATE STATEMENT LENGTH COUNTER 
      JMP *+2        NOT END
      JMP GETC,I    END-OF-STATEMENT-EXIT 
      LDB F525      SET B = UPPER/LOWER POSITION FLAG 
      LDA CSAD,I    GET WORD CONTAINING CHARACTER 
      SSB,RSS       IF FLAG SAYS UPPER (SIGN B = 0) 
      ALF,ALF        ROTATE TO LOWER
      AND CHMK       MASK OFF OTHER CHARACTER.
      SSB           ADD 1 TO STATEMENT ADDRESS IF 
      ISZ CSAD       LOWER CHARACTER
      RBL           UPDATE CHAR. POSITION FLAG
      STB F525       AND SAVE 
      CPA BLKX      IF CHAR. IS A SPACE (BLANK) 
      JMP GETC+1     IGNORE IT, GET NEXT CHARACTER
      JMP GETC,I    EXIT - CHAR IN A
* 
* 
* 
      SKP 
* 
*  SUBROUTINE TO CHECK CURRENT EDIT 
*   FILE RECORD FOR A CONTROL STATEMENT-
*   SLASH IN FIRST CHARACTER.  IF SLASH, RETURN 
*   IS TO (P+1), OTHERWISE RETURN TO (P+2). 
CKSL  NOP           ENTRY/EXIT
      LDA EDAD       GET EDIT FILE ADDRESS
      LDB 0,I       SET ONE-S COMPLEMENT OF CHAR. 
      CMB             LENGTH OF STATEMENT IN
      STB CHCT         CHCT FOR -GETC-
      LDB M525      INITIALIZE UPPER/LOWER POSITION 
      STB F525       FLAG TO UPPER
      INA           SET STARTING ADDRESS OF 
      STA CSAD       STATEMENT
      JSB GETC      GET FIRST NON-BLANK CHAR. 
      SZA,RSS        EXIT TO (P+2) IF 
      JMP *+3        ALL-BLANK STATEMENT. EXAMINE 
      CPA SLSH      CHARACTER FOR A 
      JMP CKSL,I    SLASH - YES, EXIT 
      ISZ CKSL      NO, ADJUST RETURN TO
      JMP CKSL,I    (P+2) AND EXIT
* 
      SKP 
****   NUMERIC FIELD CONVERSION SUBROUTINE
*  CALLING SEQUENCE:  (B) = MAXIMUM FIELD LENGTH
*                            IN CHARACTERS
*                     JSB  CONV 
*                     (RETURN)
*  ON RETURN: (A) CONTAINS THE RESULT (BINARY NUMBER) 
*             (B) = ZERO IF THE END OF THE CONTROL
*                  STATEMENT WAS ENCOUNTERED, OTHER-
*                  WISE, (B) IS NON- ZERO.
* 
*  A FIELD IS TERMINATED BY A COMMA, MAXIMUM FIELD
*    LENGTH OR END-OF-STATEMENT 
*  ERRORS ENCOUNTERED IN THE CONVERSION PROCESS 
*    CAUSE A DIRECT JUMP TO -ILCS- OR -NERR-. 
* 
CONV  NOP           ENTRY EXIT
      CMB,INB       SET FIELD LENGTH
      STB MXNO       NEGATIVE FOR COUNTER.
      STB CKSL
      CLA           CLEAR WORD USED FOR 
      STA RSLT       COMPUTING RESULT.
*  FOLLOWING SECTION CONVERTS THE CHARACTERS
*    AFTER CHECKING FOR LEGALITY. 
CON1  JSB GETC      GET NEXT CHARACTER IN STATEMENT 
      SZA,RSS       IF END-OF-STATEMENT (A=0),
      JMP CON2       GO TO EXIT SECTION.
      CPA COMA      IF CHAR. IS A COMMA,
      JMP CONX       THEN EXIT. 
*  CHECK FOR NUMERIC
      ADA CM60      SUBTRACT 60(8) FROM ASCII CHAR. 
      SSA           IF NEG. RESULT, CHAR. NOT 
      JMP NERR       NUMERIC AND IS AN ERROR. 
      STA CNBR      SAVE CHAR (0-11(8) IF LEGAL)
      ADA CM12      SUBTRACT 12(8)
      SSA,RSS       IF POSITIVE RESULT, THEN NOT
      JMP NERR       NUMERIC AND IS AN ERROR. 
*  CHARACTER IS 0 - 9 (60-71(8))
      LDA RSLT      MULTIPLY PARTIAL RESULT BY
      ALF,RAR        10(DECIMAL) - I.E. SHIFT LEFT
      ADA RSLT      8 AND ADD RESULT TWICE (EFFECTIVE 
      ADA RSLT        MULT. BY 10). 
      ADA CNBR      ADD CURRENT NUMBER TO RESULT AND
      STA RSLT       SAVE NEW RESULT. 
      ISZ MXNO      CHECK FOR END OF FIELD. 
      JMP CON1       NO, GO FOR NEXT CHARACTER. 
*  IF MAX. FIELD LENGTH REACHED, CHECK NEXT CHAR. 
      JSB GETC      GET NEXT CHARACTER. 
      SZA,RSS        O.K. IF END-OF-STATEMENT 
      JMP CON2       REACHED-EXIT.
      CPA COMA      CHECK FOR A COMMA - 
      JMP CONX       YES, EXIT. 
      JMP NERR      NO, ERROR CONDITION 
*  CONTROL HERE IF END-OF-STATEMENT REACHED 
CON2  CLB           SET B = ZERO. 
*  EXIT POINT 
CONX  LDA MXNO
      CPA CKSL
      JMP ILCS
      LDA RSLT                 SET A=RESULT 
      JMP CONV,I     AND EXIT TO CALLER.
      SKP 
* SUBROUTINE:  <SYMI> 
* 
*  PURPOSE:  THIS ROUTINE CALLS FOR THE 
*            INPUT OF A RECORD FROM THE 
*            SYMBOLIC FILE. 
* 
*            FOR PAPER TAPE INPUT:
*            IF END-OF-INFORMATION (TAPE) IS
*            DETECTED, THE ROUTINE CALLS
*            FOR A 'PROGRAM SUSPENSION'. AFTER
*            A 'GO,EDIT' STATEMENT IS INPUT,
*            THE STATEMENT PARAMETER IS 
*            EXAMINED. IF THE PARAMETER IS '0', 
*            THE INPUT CALL IS REPEATED. IF IT
*            IS '1', RETURN IS MADE TO THE
*            CALLER WITH (A) = 0 TO MEAN TERM-
*            INATION REQUESTED BY THE OPERATOR. 
*            FOR INPUT FROM DISK: 
*            REPEAT INPUT CALL. 
* 
*  CALL:  (P)   JSB  SYMI 
*         (P+1) - RETURN - , ON RETURN, (A) = 
*                    # CHARACTERS INPUT OR
*                    0 FOR TERMINATION AFTER EOT
* 
*          THE RECORD IS INPUT INTO 'INBUF' , A 
*         MAXIMUM LENGTH OF 72 CHARACTERS IS IMPOSED. 
* 
SYMI  NOP 
      JSB %READ     READ RECORD 
      DEF *+5 
      DEF SFLUN 
      DEF SBUF,I
      DEF CM72      -MAX 72 CHARACTERS- 
      JMP SYM1      EOF, TERMINATE
* 
      STA RTRKC     UPDATE CURRENT LUN, READ-TRACK
      LDA B        SET A= # CHARS INPUT 
      SZA,RSS      IF END-OF-INFORMATION, 
      JMP *+3       CALL FOR SUSPENSION.
      ISZ SYSQ     COUNT SYMBOLIC FILE RECORD.
      JMP SYMI,I    -RECORD INPUT, RETURN.
      LDA SFLUN     LUN(INPUT)
      CPA C.02      FROM DISK ? 
      JMP SYMI+1    YES, REPEAT INPUT REQUEST 
* 
* END-OF-INFORMATION: CALL FOR SUSPENSION 
* 
      CCB          SET  B  NEGATIVE 
      JSB EXEC
      DEF *+2 
      DEF C.07
* 
* EXAMINE 'GO' PARAMETER
* 
      SSB          IF B NEG. ASSUME 
      JMP SYMI+1     A ZERO PARAMETER 
      LDA B,I      GET PARAMETER:(B)= ADDRESS 
      SZA,RSS      IF 0, REPEAT 
      JMP SYMI+1    INPUT REQUEST.
* 
SYM1  CLA 
      JMP SYMI,I    TERMINATION 
      SKP 
* 
* SUBROUTINE: <UFOUT> 
* 
*  PURPOSE: THIS ROUTINE CALLS FOR THE
*           OUTPUT OF A RECORD TO BE IN 
*           THE UPDATED FILE. THE LOGICAL 
*           UNIT REFERENCE IS UNIT #4 (OR 
*           OTHER UNIT IF SPECIFIED BY AN 
*           OPERATOR PARAMETER. 
* 
*           THE PARAMETERS SUPPLIED TO
*           <UFOUT> ARE:
* 
*            (A) = # CHARACTERS IN BUFFER 
*            (B) = ADDRESS OF BUFFER
* 
* 
* CALL:      SET A,B REGISTERS
* 
*      (P)     JSB  UFOUT 
*      (P+1)   ---   RETURN 
* 
* 
* 
UFOUT NOP 
      CMA,INA      SET BUFFER LENGTH NEGATIVE 
      STA UFLNG     FOR CHARACTERS
      STB UFBAD    SET BUFFER ADDRESS 
      STB UFDSK+2 
* 
      LDA UFLUN 
      CPA C.02      UPDATED FILE ON DISK ?
      JMP UFDSK     YES, WRITE  TO DISK 
      JSB EXEC     WRITE
      DEF *+5       UPDATED FILE
      DEF C.02       RECORD 
      DEF UFLUN 
UFBAD NOP 
      DEF UFLNG 
* 
      JMP UFOUT,I   -RETURN TO CALLER.
UFDSK JSB %WRIS     OUTPUT RECORD TO DISK 
      DEF *+4 
      NOP           BUFFER FWA
      DEF UFLNG     BUFFER LENGTH 
      JMP DOVF      DISK OVERFLOW 
      STA WTRKC     SAME OR NEW LUN-TRACK NO. 
      JMP UFOUT,I   EXIT
      SKP 
* 
* SUBROUTINE:  <LT.G> 
* 
*  PURPOSE: THIS ROUTINE CALLS TO 
*           OUTPUT  LEADER/TRAILER FOR
*           THE UPDATED FILE. 
* 
*  CALL: (P)    JSB LT.G
*        (P+1)  -RETURN-
* 
LT.G  NOP 
      LDA UFLUN 
      CPA C.02      OUTPUT TO DISK ?
      JMP LT.G,I    YES,EXIT
* 
      JSB EXEC
      DEF *+3 
      DEF C.03
      DEF LTGCW 
      JMP LT.G,I
* 
LTGCW OCT 1000
* 
      SKP 
* 
* SUBROUTINE: <MOVE>
* 
* PURPOSE: THIS ROUTINE PROVIDES FOR
*         MOVING A STRING OF CHARACTERS 
*         FROM ONE AREA (SOURCE) OF 
*         MEMORY TO ANOTHER (DESTINATION).
*          THE FORMAT OF THE ADDRESSES
*         PASSED TO 'MOVE' DETERMINES THE 
*         STARTING CHARACTER POSITION, I.E, 
*         A POSITIVE ADDRESS MEANS STARTING 
*         WITH THE UPPER CHARACTER, A NEG-
*         ATIVE ADDRESS MEANS THE LOWER 
*         CHARACTER.
* 
* CALLING SEQUENCE: 
* 
*           (A) = # OF SOURCE CHARACTERS
*           (B) = DESTINATION ADDRESS 
* 
*        (P)     JSB MOVE 
*        (P+1)   DEF SOURCE.ADDRESS 
*        (P+2)   - RETURN - 
* 
*        AN IMMEDIATE RETURN IS MADE IF 
*       THE CHAR COUNT = 0. 
* 
* 
MOVE  NOP 
      CMA,INA,SZA,RSS 
      JMP MOVE0     EXIT MOVE 
* 
      STA GCNT      NEGATIVE. 
* 
      CLE,SSB       E=0 FOR + ADDR, 
      CMB,CCE,INB   E=1 FOR - ADDR, SET ADDR +. 
      ELB           CONVERT OT CHARACTER ADDR.
      STB GDES     SET 'DESTINATION' ADDRESS
* 
      LDB MOVE,I    DO SAME 
      CLE,SSB       FOR 
      CMB,CCE,INB   SOURCE
      ELB           ADDRESS.
      STB GSRC     SET 'SOURCE' ADDRESS.
* 
GLUP  LDB GSRC     MOVE SEQUENCE: 
      CLE,ERB       GET SOURCE ADDR - 
      LDA B,I        PICK UP WORD,
      SEZ,RSS        ROTATE FOR 
      ALF,ALF        APPROPRIATE
      AND GMLO       CHAR. AND ISOLATE CHAR. IN A.
* 
      STA GTEM     SAVE CHAR (07-00)
      LDB GDES      GET DEST. ADDR -
      CLE,ERB        PICK UP
      LDA B,I         WORD
      SEZ,RSS        ROTATE WORD
      ALF,ALF        FOR POSITION.
      AND GMHI     REMOVE BITS 07-00
      IOR GTEM      AND INSERT CHARACTER
* 
      SEZ,RSS      IF UPPER CHAR TO BE REPLACED,
      ALF,ALF       ROTATE TO UPPER 
      STA B,I       AND STORE AT DESTINATION. 
* 
      ISZ GSRC     INDEX SOURCE AND 
      ISZ GDES      DESTINATION ADDRESSES.
      ISZ GCNT     INDEX CHAR. COUNTER. 
      JMP GLUP      -CONTINUE 
      SEZ 
      JMP MOVE0 
      AND GMHI
      IOR BLKX
      STA B,I 
MOVE0 ISZ MOVE
      JMP MOVE,I   -EXIT. 
* 
GTEM  NOP 
GDES  NOP 
GSRC  NOP 
GCNT  NOP 
GMHI  OCT 177400
GMLO  OCT 377 
      SKP 
* 
*  ERROR CONTROL AND DIAGNOSTIC SECTION 
* 
OVFL  LDA OVFM     EDIT FILE OVERFLOW OF
      JMP EDERA 
* 
CHOV  JSB PUN 
      LDA CHOM      CHAR OVERFLOW OR RANGE ERROR
      JMP EDERR 
* 
C.ER JSB PUN
ILCS  LDA ILCM     ILLEGAL CONTROL STATEMENT
      JMP EDERR 
* 
NERR  LDA NERM     ILLEGAL VALUE ( N OR C ) 
      JMP EDERR 
* 
RPER  JSB PUN 
      LDA RPEM      NO UPDATE AFTER REPLACE 
      JMP EDERR 
* 
INER. JSB PUN 
INER  LDA INEM     NO UPDATE AFTER INSERT 
      JMP EDERR 
* 
FLERR LDA FLUND     DISK-FILE UNDEFINED 
      JSB DIAG      PRINT DIAGNOSTIC
      JMP EN08      ABORT 
DOVF  LDA DOVFM     DISK OVERFLOW ERROR 
      JMP EDERA 
SEQE  LDA SEQM     SEQUENCE ERROR 
* 
EDERR JSB DIAG     PRINT DIAGNOSTIC 
      JSB OUTS     PRINT CONTROL STATEMENT
      ISZ ERCT      BUMP ERROR COUNT
      LDB PSFLG 
      SZB,RSS       PASS 1 ?
      STB SEQN      YES, 0 TO SEQUENCE NO 
      SZB,RSS 
      JMP ED.4      IF PASS 1, DO NEXT EDIT INSTR 
      CLA 
      STA CSAF      CLEAR CONTROL-STATEMENT FLAG
      JMP ED06      PROCESS NEXT STATEMENT
EDERA JSB DIAG      PRINT DIAGNOSTIC
      JSB OUTS      PRINT CONTROL STATEMENT 
      JMP EN08      ABORT EDIT OPERATION
ERCT  NOP           ERROR COUNT 
PSFLG NOP           PASS-FLAG=0 FOR PS1,=1 IN PS2 
      SKP 
*READS SOURCE FROM DISK (IF LUN= 2) OR OTHER DEVICE 
*CALLING SEQUENCE FOR %READ:  JSB %READ 
*                             DEF *+5 
*                             DEF LUNIN  LUN FOR INPUT
*                             DEF BUFFR  FWA OF READ-BUFFER 
*                             DEF RLEN  -(NO OF CHARS)
*                             EOF RETURN
*                             NORMAL RETURN 
*RETURNS WITH: (B) = NO.OF CHARS. 
%READ NOP 
      JSB FTEST     INITIALIZE IF FIRST TIME
      LDA %READ,I 
      STA EXIT      RETURN ADDRESS
      ISZ %READ 
      LDA %READ,I 
      STA LUNAD     ADDR FOR LUN OF INPUT 
      ISZ %READ 
      LDA %READ 
      LDA 0,I 
      RAL,CLE,SLA,ERA    TEST I-BIT AND CLEAR 
      JMP  *-2      INDIRECT, GO ON THRU INDIR.CHAIN
      STA RBFAD     FWA OF READ-BUFFER
      ISZ %READ 
      LDA %READ,I 
      STA RLGTH     RECORD-LENGTH ADDR
      ISZ %READ     BUMP RETURN ADDR FOR EOF RETURN 
      LDA LUNAD,I 
      CPA ..2       LUN = 2 
      JMP READ1     YES 
      JSB EXEC      READ FROM OTHER THAN DISK 
      DEF *+5 
      DEF M1OR1     CODE = 1 OR -1 FOR READ 
LUNAD BSS 1         ADDR OF INPUT-LUN OF CONTROL CARD 
RBFAD BSS 1         ADDR OF READ-BUFFER 
RLGTH BSS 1         ADDR OF ASKED-FOR RECD LENGTH 
      JMP EXIT,I    EXIT
EXIT  BSS 1         EXIT POINT
BUFFR BSS 128       SECTOR-BUFFER 
FIRST OCT 0         FIRST TIME FLAG 
READ1 LDA FIRST 
      SZA           FIRST TIME ?
      JMP *+3       NO
      ISZ FIRST     SET NE.0
      JSB %JFIL     READ IN FIRST SECTOR
      JSB GETWD     GET RECORD HEAD 
      ALF,ALF       (A)= NO OF WORDS
      LDB 0 
      SZA,RSS       END OF TAPE ? 
      JMP EXIT,I    YES, EXIT WITH (B)=0
      SSA           EOF ? 
      JMP %READ,I   YES, EOF RETURN 
      CMA,INA       -( NO OF WORDS IN RECORD) 
      RBL 
      STB ALGTH     RECORD LGTH IN CHARS
      LDB RLGTH,I   ASKED-FOR RECORD-LENGTH (-) 
      BRS           CONVERT TO -(WORD COUNT)
      STA RCOUN     SET CURRENT-RECORD COUNT
      STB ACNT      SET ASKED-FOR RECORD COUNT
      JSB GETWD     GET WORD FROM DISK
      STA RBFAD,I   WORD TO USER-S BUFFER 
      ISZ RBFAD     BUMP BUFFER ADDR
      ISZ ACNT      BUMP COUNT
      RSS 
      JMP READ2     READY,FINISH UP 
      ISZ RCOUN     BUMP RECORD COUNT 
      JMP *-7       CONTINUE
      LDB ALGTH     RETURN ACTUAL RECORD-LENGTH 
      JMP *+5 
READ2 ISZ RCOUN     SKIP TO END OF RECORD 
      JMP *+5 
      LDB RLGTH,I   READY, RETURN ASKED-FOR REC.LGTH
      CMB,INB       POS LGTH
      LDA CODE      RETURN CODE-WORD IN A 
      JMP EXIT,I
      JSB GETWD     GET NEXT WORD 
      JMP READ2     AND SKIP
BFRAD BSS 1         POINTER FOR INTERNAL BUFFER 
GETWD NOP 
      LDA BFRAD,I 
      ISZ BFRAD 
      ISZ BCNT      BUMP BUFFER COUNTER 
      JMP GETWD,I   EXIT
      ISZ SECTR     BUMP SECTOR NO. 
      LDB STYPE 
      SSB 
      JMP RTECD 
      STA SAVE
      LDB SECTR 
      CPB 116B      END OF TRACK? 
      CLB,RSS       YES,SECTOR = 0
      JMP GETW1+1 
      STB SECTR     SECTOR NO = 0 
      ISZ TRCK      BUMP TRACK NO.
      JSB EXEC
      DEF *+5 
      DEF .M16      CODE = -16 FOR STATUS 
      DEF .1        1 TRACK 
      DEF TRCK      STARTING TRACK
      DEF TRCK      NEXT GOOD TRACK 
      JMP GETW1+1 
RTECD LDB =B1755
      ADB RLUN      =1757B FOR SYST, 1760B FOR AUX. 
      LDB 1,I 
      CPB SECTR     END OF TRACK? 
      CLB,RSS       YES, SECTOR NO.= 0
      JMP GETW1 
      STA CODE      SAVE CODE-WORD
      STB SECTR     SECTOR NO =0
      LDA =D-8
      STA N 
      LDA CODE
      CLE,ELA       SHIFT UPPER 8 BITS OF 
      ELB,CLE        A INTO B, OR LSL 8 
      ISZ N 
      JMP *-3 
      ALF,ALF 
      STA TRCK      SET TRACK NO
      STB RLUN      SET LUN 
      JSB READS     READ SECTOR 
      JMP GETWD+1   GET RECORD WORD 
GETW1 STA SAVE
      JSB READS     READ NEXT SECTOR
      LDA SAVE
      JMP GETWD,I 
READS NOP 
      LDA BFWA
      STA BFRAD     BUFFER-POINTER= FWA BUFFER
      LDA MSIZE     -64 OR -128 
      STA BCNT      BUFFER COUNTER
      JSB EXEC      READ SECTOR 
      DEF *+7 
      DEF M1OR1     CODE = 1 OR -1 FOR READ 
      DEF RLUN      LUN 
BFWA  DEF BUFFR     FWA OF READ-BUFFER
      DEF PSIZE     64 OR 128 WORDS 
      DEF TRCK      TRACK NO. 
      DEF SECTR     SECTOR NO.
      JMP READS,I   EXIT
ACNT  BSS 1         ASKED-FOR RECD COUNT
RCOUN BSS 1         CURRENT-RECORD COUNT
ALGTH BSS 1         RECD LGTH 
TRCK  BSS 1         CURRENT TRCK  NO
SECTR BSS 1         CURRENT SECTOR NO 
BCNT  BSS 1         SECTOR-BUFFER COUNTER 
SAVE  BSS 1         TEMP STORAGE
RLUN  BSS 1         LUN OF CURRENT TRACK
CODE  BSS 1 
STYPE BSS 1         SAVES SYSTEM TYPE CODE FROM OPSY
N     BSS 1         COUNTER 
M1OR1 DEC 1         SET FOR RTE, MAY CHANGE 
.M16  DEC -16 
.2OR3 DEC 2 
..2   DEC 2 
.1    DEC 1 
PSIZE DEC 64
MSIZE DEC -64 
* 
*%RDSC READS A SECTOR 
*CALLING SEQUENCE:       LDA CODE 
*                        LDB SECTR   SECTOR NO. 
*                        JSB %RDSC
*                        RETURN (A)= LAST WORD IN SECTOR
%RDSC NOP 
      STB SECTR      SECTOR NO. 
      LDB =D-8
      STB N 
      CLB 
      CLE,ELA 
      ELB,CLE       LSL 8 
      ISZ N 
      JMP *-3 
      ALF,ALF 
      STA TRCK
      LDA STYPE 
      SSA 
      JMP *+3                           DONT CHANGE UNIT FOR RTE
      CPB =D3       SET LU NEG IF = 3 
      CMB,INB 
      STB RLUN      LUN= 2 OR 3 
      JSB READS      READ SECTOR
      LDB STYPE 
      LDA BUFFR+63  LAST WORD IN 64 WORD SECTOR 
      SLB 
      LDA BUFFR+127 LAST WORD IN 128 WORD SECTOR
      JMP %RDSC,I 
*%JFIL GETS SOURCE-FILE CODEWDRD FROM BASE PAGE, FORMS A WORD=
*LUN,TRACK AND CALLS %RDIN WITH IT. 
%JFIL NOP 
      JSB FTEST     INITIALIZE IF FIRST TIME
      LDA =D-8
      STA N 
      LDA STYPE 
      CLE,SSA 
      JMP RTEFL     RTE 
      LDB 124B      DOS OR IOMEC/DOS
      LDA .2OR3     LUN = 2 OR 3
      JSB RRL       RRL 8 
      BLF,BLF 
      JMP CONTU 
RTEFL LDB 1767B     SOURCE-FILE CODE WORD 
      CLA 
      CLE,ELB       RRL 1 
      ELA 
      ADA .2OR3 
      JSB RRL       SHIFT TRACK NO INTO A 
      STA CODE      SAVE LUN, TRACK NO. 
      CLB 
CONTU JSB %RDSC     READ SECTOR 
      JMP %JFIL,I   EXIT
FTEST NOP           INITIALIZES RTE,DOS,OR DOSM STUF
      LDA FIRST     FIRST TIME ?
      SZA 
      JMP FTEST,I   NO. 
      JSB .OPSY 
      STA STYPE     0 = DOS, 1 = IOMEC/DOS, -2 = RTE
      SSA 
      JMP FTEST,I   RTE 
      CCB           DOS OR IOMEC/DOS
      STB M1OR1     SET M1OR1 = -1
      SLA,RSS 
      JMP FTEST,I   DOS 
      LDB =D128     IOMEC/DOS.  BUFFER SIZE = 128 
      STB PSIZE 
      CMB,INB 
      STB MSIZE 
      LDB =D3 
      STB .2OR3     LOGICAL UNIT = 3
      JMP FTEST,I 
RRL   NOP           PERFORMS RRL N
      CLE,SSA       IF MSB = 0, E=0 
      CCE            ELSE E=1 
      ELB           SHIFT E INTO B
      ELA           SHIFT E INTO A
      ISZ N 
      JMP RRL+1 
      JMP RRL,I 
      SKP 
*%WRIS WRITES SOURCE ONTO DISK. RECORD FORMAT:1ST WORD=-N,IT IS 
*FOLLOWED BY N CHARACTERS. RECORDS ARE PACKED WITHIN TRACKS,
*TRACKS ARE LINKED. INITIALIZATION IS ACCOMPLISHED BY CALLING 
*%WRIN. IT WILL ASK FOR A TRACK, INITIALIZE %WRIS,AND RETURN
*A WORD=LUN,FIRST TRACK NO. 
* 
*CALLING SEQUENCES: 
*                        JSB %WRIS
*                        DEF *+4
*                        DEF BUFFR      FWA OF OUTPUT BUFFER
*                        DEF RLEN       -(NO OF CHARS), 0 FOR EOT 
*                        ERROR RETURN (DISK FULL) 
*                        NORMAL RETURN WITH (A)= LUN,TRACK NO 
* 
*                        JSB %WRIN
*                        ERROR RETURN (NO MORE TRACKS)
*                        NORMAL RETURN WITH (A)= LUN,TRACK NO 
* 
*TO END A FILE, CALLING SEQUENCE IS: JSB %WEOF
*GETRK REQUESTS A TRACK FROM EXEC. IF NO TRACKS ARE AVAILABLE,
*THE ERROR RETURN WILL BE TAKEN 
*CALLING SEQUENCE:       JSB GETRK
*                        ERROR RETURN 
*                        NORMAL RETURN
GETRK NOP 
      JSB EXEC      GET TRACK 
      DEF *+6 
      DEF .4        REQUEST CODE = 4
      DEF TCONS     =100001 FOR 1 TRACK, NO SUSPENS.
      DEF NTRAC     TRACK NO
      DEF NLUN      LUN 
      DEF S/TRK     NO OF SECTRS/TRACK
      LDA NTRAC 
      SSA           TRACK HERE ?
      JMP GETRK,I   NO, ERROR RETURN
      ISZ GETRK     BUMP FOR
      JMP GETRK,I   NORMAL RETURN 
%WRIN NOP 
      JSB GETRK     GET TRACK 
      JMP %WRIN,I   ERROR RETURN,NO TRACKS LEFT 
      ISZ %WRIN     BUMP FOR NORMAL RETURN
      JSB WINIT     INITIALIZE FOR NEW TRACK
      JMP %WRIN,I   EXIT
WINIT NOP 
      LDA NTRAC 
      STA WTRAC     SET TRACK NO. 
      LDB NLUN
      STB WLUN      SET LUN 
      BLF,BLF 
      ADA 1         (A)= LUN,TRACK NO.
      STA LUNTR     LUN,TRACK TO RETURN ON EXIT 
      LDB WBFWA 
      STB WBFAD     BUFFER ADDR= BUFFER FWA 
      LDB =D-64     -64 
      STB BCOUN     BUFFER COUNT
      CLB 
      STB WSECT     SECTOR NO =0
      JMP WINIT,I   NORMAL EXIT 
TEMP  BSS 1 
WEXIT BSS 1 
%WRIS NOP 
      LDA %WRIS,I 
      STA WEXIT     EXIT POINT
      ISZ %WRIS 
      LDA %WRIS 
      LDA 0,I 
      RAL,CLE,SLA,ERA    TEST I-BIT AND CLEAR 
      JMP *-2       INDIRECT,CONTINUE THRU I-CHAIN
      STA SBUFR     SOURCE-BUFFER ADDR
      ISZ %WRIS 
      LDA %WRIS,I 
      LDA 0,I       -(NO OF CHARS)
      ISZ %WRIS 
      ARS 
      STA 1 
      CMB,INB 
      BLF,BLF 
      ADA =D-1
      STA ACOUN     -(NO OF WORDS +1) 
      STB WBFAD,I   NO. OF WORDS IN UPPER 
      JMP WRIS1+3 
WRIS0 LDA WSECT 
      INA 
      CPA S/TRK     END OF TRACK
      JMP WRIS3     YES 
      JSB WOUT      NO,OUTPUT SECTOR
      ISZ WSECT     BUMP SECTOR NO. 
      LDA WBFWA 
      STA WBFAD     BUFFER ADDR = BUFFER FWA
      LDA =D-64 
      STA BCOUN     BUFFER COUNT = -64
      JMP WRIS2 
WRIS3 STB TEMP      SAVE CURRENT WORD 
      JSB GETRK     GET TRACK 
      JMP %WRIS,I   ERROR RETURN,NO TRACKS AVAILABLE
      LDA NLUN      NEW LUN 
      ALF,ALF 
      ADA NTRAC     NEW TRACK NO
      STA WBUFR+63  LUN,TRACK NO TO LAST WD OF TRACK
      JSB WOUT      OUTPUT LAST SECTOR
      JSB WINIT     INITIALIZE FOR NEW TRACK
      LDA TEMP
      STA WBFAD,I   WORD TO DISK
      JMP WRIS1+3 
WRIS1 LDB SBUFR,I 
      STB WBFAD,I   WORD TO DISK
      ISZ SBUFR     BUMP SOURCE POINTER 
      ISZ WBFAD     BUMP OUTPUT-BUFFER POINTER
      ISZ BCOUN     END OF SECTOR ? 
      RSS           NO
      JMP WRIS0 
WRIS2 ISZ ACOUN     END OF TRANSFER ? 
      JMP WRIS1     NO, CONTINUE
      CCA 
      STA WBFAD,I   SET CURRENT EOF 
      LDA LUNTR     (A)= LUN,TRACK NO.
      JMP WEXIT,I   RETURN
WOUT  NOP 
      JSB EXEC
      DEF *+7 
      DEF .2        CODE=2
      DEF WLUN      LUN OF CURRENT WRITE-TRACK
WBFWA DEF WBUFR     WRITE-BUFFER
      DEF .64       =64 
      DEF WTRAC     TRACK NO
      DEF WSECT     SECTOR NO 
      JMP WOUT,I
WBUFR BSS 64        WRITE-BUFFER
WTRAC BSS 1         CURRENT TRACK 
WSECT BSS 1         CURRENT SECTOR
WBFAD BSS 1         WRITE-BUFFER ADDR 
NTRAC BSS 1         NEW TRACK NO (TEMP) 
WLUN  BSS 1         LUN FOR CURRENT TRACK 
NLUN  BSS 1         NEW LUN ( TEMP) 
SBUFR BSS 1         SOURCE BUFFER ADDR
ACOUN BSS 1         SOURCE COUNT
BCOUN BSS 1         BUFFER COUNT
LUNTR BSS 1        LUN, TRACK NO. FOR RETURN
S/TRK BSS 1 
.2    DEC 2 
.64   DEC 64
.4    DEC 4 
TCONS OCT 100001    CONS TO INDICATE 1 TR,NO SUSP 
      SKP 
%WEOF EQU WOUT
* 
      SKP 
                                                                                    