ASMB,R,L,C,F
      HED BSUPV---BASIC SUPERVISOR          A-29102-60004-1 REV. B
      NAM BSUPV,7 29102-60004 REV. B
******************************************************
* 
*      BSUPV
* 
*      LIST:   A-29102-60004-1
*      SOURCE:   29102-80004 REV.B
*      RELOC:    29102-60004
* 
******************************************************
* 
* 
      ENT INIT,GTLYN
      ENT SWLST,LYNCK,LYNC1,LSTIT 
      ENT CHAR,CHARN,DELM,CRLF,ATEMP
      ENT PGOLM,LIMCK,LOLIM,HILIM,CKLLN,INTIN 
      ENT SWDEV,XQCMD 
      ENT ONS,FROMS,ABREV,XSYNF 
      ENT SCR,FRMTO 
      ENT LSTR,PLSTA,LOKCK,CRLF1
* 
      EXT PROGF,PROGL 
      EXT INBAD,INCNT,BLANK,TYPE,GTCHR
      EXT LISTA,LISTR,LINE,MFASE,SBUFA
      EXT .BUFA 
      EXT TFLAG,LIST
      EXT INDCK 
      EXT PRNIN,TSTIT 
      EXT TBSRH,TBLPT,LNGTH 
      EXT DIGCK,INTCK 
      EXT FNDPS 
      EXT DRQST 
      EXT SYE25,CALER,INVSC 
      EXT MAXSN 
      EXT .1,.2,.3,.7,.10,.32,.48 
      EXT M1,M2,M3,M8 
      EXT DEVCT,SETLP 
* 
******************************************************* 
* 
** LOKCK ** DUMMY VERSION, TYPE M, ONE EACH 
* 
LOKCK NOP 
      JMP LOKCK,I 
* 
******************************************************* 
      SKP 
* 
**************************************************
* 
*      START APPROPRIATE PHASE OF BASIC 
* 
**************************************************
* 
**
INIT  JSB RTINT    SET UP FWAM,LWAM FOR RTE TYPE SYSTEMS
      LDA KEYIA      INITIALIZE INPUT DEVICE
      STA READR      TO KEYIN DEVICE
      LDA BUFA
      STA .BUFA     INIT TTY BUFFER POINTER 
      LDA LWAM
      JSB INDCK 
      STA LWAM
      ADA M110
      STA SBUFA     INIT SYNTAX BUFFER POINTER
      JSB PRNIN     INITIALIZE OUTPUT BUFFER POINTER
PATCH JMP SETUP     BECOMES "STF 0" 
      JSB EFASE     EXECUTION PHASE?
       RSS          NO
      JMP MFASE     YES 
      LDA M8
      STA TFLAG     LOKCK THROW OUT OPERATOR INPUT
      LDB RDYA
      JSB DSPLY     DISPLAY "READY" 
      JSB CRLF
GTLYN LDA .32       INITIALIZE
      STA BLANK       DELETE CHARACTER FOR GETCR
      JSB LINE      ACCEPT A BASIC LINE 
      JMP GTLYN 
* 
      SKP 
* 
* ONCE ONLY CODE FOLLOWS - AREA THEN USED FOR I/O BUFFER
* 
SETUP LDA FWAM
      JSB INDCK 
      STA FWAM
      LDB PROGF 
      CPB PROGL     START ADDR=END ADDR?
      JMP SCRCH     YES, SET BOTH TO FWAM, INFORM USER
      CMA,INA 
      ADA PROGF 
      SSA           PROGF < FWAM? 
      JMP SCRCH     YES 
      LDA PROGL 
      CMA,INA 
      ADA LWAM
      SSA           PROGL >= LWAM?
      JMP SCRCH     YES 
ITSOK SSB           ADDRESS NEGATIVE? 
      JMP SCRCH     YES, GO TXPE "SCR"
      CPB PROGL     HAS LAST LINE BEEN DONE?
      JMP GOMAN     YES, GO TYPE "READY"
      LDA 1         INCREMENT LINE'S ADDRESS
      INA           BY LENGTH OF LINE 
      ADB 0,I           TO GET NEXT LINE ADDRESS
      LDA 0,I       CHECK LINE LENGTH 
      ADA M3
      SSA           WAS INCREMENT POSITIVE? 
      JMP SCRCH     NO
      ADA M110
      SSA           WAS INCREMENT REASONABLE? 
      JMP ITSOK     YES 
SCRCH JSB SCR 
GOMAN LDA PAT 
      STA PATCH     FROM SETUP ON IS ONCE-ONLY CODE 
      LDA SETLP 
      STA LPCNT     SET UP NBR OF LINE PRTR COLUMNS 
      JMP PATCH 
* 
PAT   NOP 
      BSS SETUP+37-*   37TH WD OF I/O BUFFER HERE 
* 
*      END OF ONCE ONLY CODE
* 
      SKP 
* 
*************************************************** 
* 
*      SETUP FOR I/O, SWITCH TO REQUESTED ROUTINE 
* 
*      CALL SEQ:  JSB SWLST 
*                 DEF (ROUTINE ADDR)
*      RETURN:    P+2: NORMAL EXIT
* 
****************************************************
* 
SWLST NOP 
      LDA LISTA     SOURCE POINTER
      LDB LISTR     DEST POINTER
      JSB MOVE      SAVE PREVIOUS LIST DEVICE STATUS
      LDA SWLST,I   SOURCE POINTER
      JSB INDCK 
      LDB LISTA     DEST POINTER
      JSB MOVE      POST NEW LIST DEVICE STATUS 
      LDA SPTR,I    GET OUTPUT FUNCTION CODE
      STA CRLF1     INITIALIZE FUNCTION WORD PARAMS 
      STA LYNC1 
      ISZ SPTR      POINT AT SUBROUTINE ENTRY 
      LDA SPTR
      STA LISTR     PUT LIST SUBRTN PTR IN LISTR
      ISZ SWLST     SKIP OVER PARAM 
      JMP SWLST,I 
* 
MOVE  NOP 
      ADA M3
      ADB M3
      STA SPTR
      STB DPTR
      LDB M2
      LDA SPTR,I
      STA DPTR,I
      ISZ SPTR
      ISZ DPTR
      INB,SZB 
      JMP *-5 
      JMP MOVE,I
* 
      SKP 
* 
****************************************************
* 
*      CHECK LINE POSITION & DO ASCII OUTPUT
* 
*      CALL SEQ: JSB LYNCK
*      RETURN:   P+1: COMPLETION
* 
*************************************************** 
* 
LYNCK NOP 
      STA TEMPA 
      STB TEMPB 
      LDA LYNCK     ASSUMES JSB LYNCK FOLLOWS ENTRY 
      ADA M2        TO OUTPUT ROUTINE 
      STA *+2       PASS DEVICE STATUS TO SWLST 
      JSB SWLST 
       BSS 1
UPDAT LDA TEMPA 
      CMA,INA 
      ADA TYPE
      STA TYPE      UPDATE CARRIAGE POSITION
      CLA 
      JSB TSTIT 
      SZA,RSS       DID TSTIT DO CR-LF? 
      JMP UPDAT     YES 
      LDA TEMPA 
      LDB TEMPB 
      JSB DOIO
LYNC1  BSS 1        SET UP BY SWLST 
      JMP LYNCK,I 
* 
*************************************************** 
* 
*      LSTIT IS AN ASC OUTPUT ROUTINE SWITCH
*      PLIST WILL START IC TO ASC CONV IN BASIC 
* 
**************************************************
* 
LSTIT NOP 
      JSB LSTR,I      DO LISTING TASK 
      JMP LSTIT,I      & RETURN 
* 
PLIST NOP 
      LDA PLIST      SET UP RETURN
      STA LIST
      LDA LSTAD 
      JSB INDCK 
      ADA .2
      STA PLIST 
      LDA HILIM      PASS LIMITS
      LDB LOLIM 
      JMP PLIST,I    GOTO LIST+2
* 
* 
      SKP 
***************************************************** 
* 
*      CHAR WILL FETCH THE NEXT INPUT CHAR
*      CHARN WILL FETCH THE NEXT NON-BLANK CHAR 
* 
***************************************************** 
* 
CHAR  NOP 
      LDA .10        SET UP FOR 
      STA BLANK      FIXED FORMAT SCAN
      JSB CHRIN      GET INPUT
      JMP CHAR,I
* 
CHARN NOP 
      LDA .32        SET UP FOR 
      STA BLANK      FREE FORMAT SCAN 
      JSB CHRIN      GET INPUT
      JMP CHARN,I 
* 
CHRIN NOP 
CHRN1 JSB GTCHR      FETCH NEXT CHAR
      STA ATEMP 
      CPA .10        EOF? 
      JMP CHRN2 
      JSB DELM       NO, DELIMITER? 
       JMP CHRIN,I       YES, IGNORE
      CLB                NO, CLEAR
      STB CONT.           CONT. FLAG
      JMP CHRIN,I         & RETURN
CHRN2 LDB CONT.      YES, IS CONT.
      SZB,RSS         ENABLED ??
      JMP CHRIN,I        NO, RETURN 
      LDA M2             YES, GIVE 2
      LDB BLNKA           BLANKS
      JSB DSPLY             & 
      JSB DRQST          GET MORE INPUT 
      JMP CHRN1 
* 
      SKP 
* 
****************************************************
* 
*      DELM WILL TEST FOR A DELIMITER 
* 
****************************************************
* 
DELM  NOP 
      CPA .32      BLANK ?
      JMP DELM,I      YES, P+1 RETURN 
      CPA O54        COMMA ?
      JMP DELM1       YES 
      ISZ DELM       NEITHER, TAKE
      JMP DELM,I      P+2 RETURN
DELM1 ISZ CONT.      INSURE CONT. FLAG IS ON
      JMP DELM,I     (FOR INPUT OUTSIDE OF CHRIN) 
* 
************************************************
* 
*      DO CARRIAGE RETURN, LINE FEED OUTPUT 
* 
************************************************
* 
CRLF  NOP           USED AS FLAG BY "LIST" IN BASIC 
      LDA M2
      LDB RDYA
      CPA CRLF1     KLUDGE TO ALLOW BLOCKING UP 
      JMP LYNC1,I   OUTPUT, THIS DOES FLUSH 
      JSB DOIO      DO CARRIAGE RETURN, LINE FEED 
CRLF1  BSS 1        SET UP BY SWLST 
      CLA 
      STA TYPE      DENOTE NEW LINE 
      JMP CRLF,I
* 
      SKP 
* 
******************************************************
* 
*      FIND REQUESTED PROGRAM CORE LIMITS 
* 
*      CALL SEQ:  (A)=NEXT CHAR 
*                 JSB PGOLM 
*      RETURN:    P+1: EOF DETECTED 
*                 P+2: MORE INPUT TO COME 
*                 (A)=NEXT CHAR 
*                 LOLIM=LOW CORE LIMIT
*                 HILIM=HI CORE LIMIT 
* 
***************************************************** 
* 
PGOLM NOP 
      JSB LIMCK      FETCH PROGRAM LIMITS 
      STA ATEMP      SAVE NEXT CHAR 
      LDA LOLIM 
      JSB FNDPS      FIND POSITION
       NOP            OF 1ST STATEMENT
       NOP
      STB LOLIM       SAVE IT 
      LDA HILIM 
      INA 
      JSB FNDPS      FIND POSITION
       NOP            OF LAST STATEMENT 
       NOP
      STB HILIM       SAVE IT 
      LDA ATEMP      RETRIEVE NEXT CHAR 
      CPA .10        EOF ?? 
      JMP PGOLM,I    YES, TAKE P+1 RETURN 
      ISZ PGOLM 
      JMP PGOLM,I    NO, TAKE P+2 EXIT
* 
* 
      SKP 
* 
********************************************************
* 
*      FETCH PROGRAM LIMITS FROM INPUT BUFFER 
*      ACCORDING TO THE FOLLOWING SYNTAX: 
*          ...<NULL>... 
*          ...<LIM1>... 
*          ...<LIM1><DELIMITER><LIM2>...
* 
*      CALL SEQ:  (A)=NEXT CHAR 
*                 JSB LIMCK 
*      RETURN:    (A)=NEXT CHAR 
*                 LOLIM=LO LIMIT
*                 HILIM=HI LIMIT
* 
********************************************************
* 
LIMCK NOP 
      CLB,INB        SET UP 
      STB LOLIM       DEFAULT LIMITS
      LDB .9999       1-9999
      STB HILIM 
      LDB M2
      STB CNT1
      LDB .10        SET UP FOR 
      STB BLANK       FIXED FORMAT SCAN 
      RSS 
      JSB CHAR       FETCH NEXT CHAR
LIM1  JSB DELM       DELIMITER ?
       JMP *-2        YES, IGNORE 
      JSB DIGCK      DIGIT ?
       JMP LIMCK,I    NO,EXIT 
      ADA .48        YES, 
      JSB INTIN      FETCH #
       DEF MAXSN       &
      STB HILIM      SAVE IT
      ISZ CNT1       DONE ? 
      RSS 
      JMP LIM2
      STB LOLIM      NO, CONTINUE 
      JMP LIM1
LIM2  INB            INSURE 
      CMB,INB         LOLIM<=HILIM
      ADB LOLIM 
      SSB,RSS 
      JMP SYE25      IT'S NOT, ERROR
      LDB .32        OK, SET UP FOR 
      STB BLANK       FREE FORMAT INPUT 
      RSS             FETCH NEXT
      JSB CHARN        NON-DELIMITER
      JSB DELM         CHARACTER
       JMP *-2       (A)=NEXT CHAR
      JMP LIMCK,I     & RETURN
* 
      SKP 
* 
****************************************************
* 
*      CHECK LEGAL LINE # LIMITS OF INPUT 
* 
*      CALL SEQ: (A)=CHAR COUNT 
*                (B)=BUFFER ADDRESS 
*                JSB CKLLN
*      RETURN:   P+1: OUTSIDE OF LIMITS 
*                P+2: WITHIN LIMITS 
* 
*************************************************** 
* 
CKLLN NOP 
      CMA            SET UP FOR 
      STA INCNT       GETCR 
      RBL             ROUTINE 
      STB INBAD 
      LDB LOLIM      INPUT LIMITS 
      CPB .1          OTHER THAN
      RSS             1-9999 ???
      JMP CKLL1 
      LDB HILIM 
      CPB .9999 
      JMP CKLL2      NO, TAKE P+2 EXIT
CKLL1 JSB GETCR      YES, FETCH NEXT CHAR 
       JMP CKLLN,I    NULL RECORD, TAKE FAIL EXIT 
      CPA .32        IGNORE PRECEEDING
      JMP CKLL1       BLANKS
      JSB INTIN      GET CURRENT LINE # 
       DEF MAXSN
      LDA LOLIM 
      CMA,INA 
      ADA 1 
      SSA            #>=LOLIM ? 
      JMP CKLLN,I    NO, P+1
      CMB,INB 
      ADB HILIM 
      SSB            #<=HILIM ? 
      JMP CKLLN,I    NO, P+1
CKLL2 ISZ CKLLN 
      JMP CKLLN,I    YES, P+2 
* 
* 
      SKP 
* 
***************************************************** 
* 
*      INTIN WILL BUILD AN INTEGER FROM INPUT 
* 
*      CALL SEQ: (A)=CURRENT CHAR 
*                JSB INTIN
*                DEF (MAX #)
*     RETURN:    (B)=INTEGER
* 
***************************************************** 
* 
INTIN NOP 
      STA ATEMP      SAVE CUR. CHAR.
      LDA INTIN,I    FETCH
      JSB INDCK       MAXIMUM 
      STA INTI1        ALLOWABLE
      ISZ INTIN         LIMIT 
      LDA SBPTR      SAVE 
      STA TEMP1       SBPTR 
      LDA TEMAD        STATUS 
      STA SBPTR 
      LDA ATEMP      RECOVER CUR.CHAR.
      JSB INTCK      FETCH INTEGER
INTI1  BSS 1
      STA ATEMP 
      LDA TEMP1      RESTORE
      STA SBPTR       SBPTR STATUS
      LDA ATEMP 
      JMP INTIN,I 
* 
      SKP 
*************************************************** 
* 
*      SEARCH COMMAND DEVICE TABLE FOR VALID SYNTAX 
* 
*      CALL SEQ:  (A)=CURRENT CHAR
*                 (B)=-TAB LENGTH 
*                 JSB SWDEV 
*                 DEF (TABLE START ADDRESS) 
*      RETURN:    P+2: FAIL RETURN
*                      (A)=CURRENT CHAR 
*                 P+3: SUCCES RETURN
*                      (A)=CURRENT CHAR 
*                      (B)=TABLE POSITION 
*                      TBLPT=ENTRY ADDRESS
* 
**************************************************
* 
SWDEV NOP 
      STA ATEMP      SAVE CURRENT CHAR
      LDA SWDEV,I    FIND TABLE START 
      JSB INDCK 
      STA SWDV1 
      ISZ SWDEV 
SWDV0 LDA ATEMP      RETRIEVE CURRENT CHAR
      SZB,RSS        ANY ENTRIES ?
      JMP SWDEV,I     NO, TAKE FAIL EXIT
      JSB TBSRH       YES, SEARCH DEVICE
SWDV1 NOP               TABLE 
       JMP SWDV3      NOT FOUND 
* 
      JSB CHARN       FOUND,FETCH NEXT CAHR 
      JSB DELM      IGNORE DELIMITERS 
       JMP *-2
      STA ATEMP      SAVE A 
      LDA COUNT      FIND 
      JSB INDCK       CURRENT 
      ADA M2           COUNT
      LDB 0,I 
SWDV2 CMB                   & 
      ADB LNGTH          COMPUTE
      CMB,INB         TABLE POSITION
      LDA ATEMP 
      ISZ SWDEV       MOVE TO SUCCES RETURN 
      JMP SWDEV,I      & EXIT 
* 
SWDV3 LDB LNGTH 
SWDV4 LDA SWDV1,I    ALLOW 0 LENGTH SYMBOL
      AND .7           AS VALID TABLE ENTRY 
      SZA,RSS         0 LENGTH ?
      JMP SWDV5 
      ADA .3          NO, MOVE TO NEXT ENTRY
      ARS 
      ADA SWDV1 
      STA SWDV1 
      INB,SZB         END OF TABLE ?
      JMP SWDV4       NO, CONTINUE
      JMP SWDV0       YES, NO MATCH 
* 
SWDV5 LDA SWDV1      0 LNGTH SYMBOL FOUND 
      STA TBLPT      SAVE ENTRY ADDRESS 
      JMP SWDV2 
* 
     SKP
******************************************************* 
* 
*      EXECUTE SPECIFIED COMMAND
* 
*      CALL SEQ:  (A)=NEXT CHARACTER
*                 (B)=EXECUTION TABLE POSITION
*                 JSB XQCMD 
*                 DEF (EXECUTION TABLE START) 
*                 NOP (USED FOR STORAGE BY XQCMD) 
*      RETURN:    P+3: COMPLETION RETURN
*                 P+4: CONTINUATION RETURN (WHEN REQUIRED)
* 
********************************************************* 
* 
XQCMD NOP 
      STA ATEMP      SAVE CURRENT CHAR
      ADB M1         FIND EXECUTION 
      RBL,SLB         TABLE ADDRESS 
      JSB CALER 
      LDA XQCMD,I 
      JSB INDCK 
      ADB 0          (B)=EXECUTION TABLE ENTRY
      ISZ XQCMD 
      STB XQCMD,I   SAVE IT IN USER SUPPLIED STORAGE
      INB 
      LDA 1,I       GET ADDRESS OF I/O ROUTINE
      JSB INDCK      FROM BRTBL 
      ISZ XQCMD 
      LDB XQCMD     SAVE IT IN CALLER 
      STB 0,I         SUPPLIED STORAGE
      INA 
      STA TEMPX 
      LDB TBLPT     GET ADDRESS OF MNEM ENTRY AND 
      LDB 1,I        EXTRACT THE LOGICAL UNIT NO. 
      LSR 9           AND RIGHT JUSTIFY 
      LDA ATEMP      RECOVER CURRENT CHAR 
      JMP TEMPX,I     TRANSFER TO REQUESTED ROUTINE 
* 
      SKP 
****************************************************
* 
*      CHECK OCCURANCE OF "ON" OR "FROM" SYNTAX 
*      IF XSYNF=1 ON/FROM/TO MUST OCCUR IN COMMAND SYNTAX 
*      IF XSYNF=1 ON/FROM MUST OCCUR IN COMMAND SYNTAX
*      IF XSYNF=0 ON/FROM MAY BE OMITTED FROM COMMAND 
* 
*      CALL SEQ:  JSB ONS 
*      RETURN:    P+1: FOUND, (A)=NEXT CHAR 
* 
*      CALL SEQ:  JSB FROMS 
*      RETURN:    P+1: FOUND, (A)=NEXT CHAR 
* 
* 
***************************************************** 
* 
ONS   NOP            CHECK "ON" SYNTAX
      LDB ONA 
      JSB SYNCH 
      CLB           SET ON/FROM FLAG TO ZERO
      STB FRMTO     FRMTO FLAG=0 FOR "ON" 
      LDB DEVCT     GET -# OF DEVICE MNEM.
      JMP ONS,I      OK, RETURN 
* 
FROMS NOP            CHECK "FROM" SYNTAX
      LDB FROMA 
      JSB SYNCH 
      CLB,INB       FRMTO FLAG=1 FOR "FROM" 
      STB FRMTO 
      LDB DEVCT     GET -# OF DEVICE MNEM.
      JMP FROMS,I    OK, RETURN 
* 
SYNCH NOP 
      STB SYNC1 
      CCB 
      JSB TBSRH      SEARCH INPUT BUFFER
SYNC1  NOP
       JMP SYNC2     NOT FOUND
      JSB CHARN      FETCH NEXT NON-BLANK CHAR
      JSB DELM       DELIMITER ?
       JMP *-2        YES, IGNORE 
      CPA .10        EOF ?? 
      JMP INVSC      YES, INPUT ERROR 
      JMP SYNCH,I    NO, OK EXIT
SYNC2 LDB XSYNF      IS SYNTAX REQUIRED 
      SZB             ??? 
      JMP INVSC      YES, ERROR 
      JMP SYNCH,I    NO, OK EXIT
      SKP 
* 
*************************************************** 
* 
*      ALLOW SYNTAX ABREVIATION 
* 
*      CALL SEQ:  JSB ABREV 
*                 DEF (ABREVIATED SYNTAX) 
*      RETURN:    P+1: FOUND
*                 P+2: NOT FOUND, (A)= NEXT CHAR
* 
**************************************************
* 
ABREV NOP 
      LDA ABREV,I 
      STA ABRE1 
      ISZ ABREV 
      JSB CHARN 
      CCB 
      JSB TBSRH 
ABRE1  BSS 1
      ISZ ABREV 
      JMP ABREV,I 
* 
      SKP 
****************************************************
* 
*      SCRATCH SUBROUTINE 
* 
*      CALL SEQ:  JSB SCR 
*      RETURN:    P+1: NORMAL 
* 
*************************************************** 
* 
SCR   NOP 
      LDA FWAM
      STA PROGF 
      STA PROGL 
      JMP SCR,I 
* 
      SKP 
* 
*      STORAGE & CONSTANTS & OTHER THINGS OF INTEREST 
* 
      SUP 
BUFA  DEF SETUP      I/O BUFFER ADDRESS 
LSTAD DEF LIST       INDEX TO LIST ROUTINE IN BASIC 
COUNT DEF LNGTH      INDEX TO TABLE POSITION IN TBSRH 
LSTR  DEF PLIST      INIT TO PLIST
PLSTA DEF PLIST      ADDRESS OF PLIST ROUTINE 
* 
CONT. NOP            KBD INPUT CONTINUATION FLAG
ATEMP NOP            CURRENT CHARACTER
XSYNF OCT 1          ON.FROM SYNTAX SWITCH, INIT. TO YES
LOLIM NOP            LOW LIMIT
HILIM NOP            HIGH LIMIT 
* 
O54   OCT 54
.9999 DEC 9999
M110  DEC -110
* 
RDYA  DEF *+1        BASIC'S "READY" MESSAGE
      OCT 6412
      ASC 3,READY 
* 
BLNKA DEF *+1        INPUT CONTINUATION PROMPT
      ASC 1,
* 
ONA   DEF *+1        "ON" SYNTAX
      OCT 2 
      ASC 1,ON
* 
FROMA DEF *+1        "FROM" SYNTAX
      OCT 4 
      ASC 2,FROM
* 
* 
TEMAD DEF TMP 
TMP   BSS 1 
TEMP1 BSS 1 
TEMPA BSS 1 
TEMPB BSS 1 
TEMPX BSS 1 
CNT1  BSS 1 
SPTR  BSS 1 
DPTR  BSS 1 
FRMTO BSS 1 
      HED ****** DOIO ******                A-29102-60004-1 REV. B
* 
********************************************* 
*      DOIO 
* 
* 
********************************************
* 
* 
      ENT DOIO
* 
      EXT EXEC
      EXT B2000,B777,.63,M1,.1,.2 
* 
DOIO  NOP 
      STA LENTH 
      STB BUFAD         STORE ADDRESS OF BUFFER 
      LDB DOIO,I        GET CONTROL WORD
      ISZ DOIO
      LDA 1 
      AND FMASK         EXTRACT FUNCTION CODE 
      ALF 
      STA ICODE         AND STORE IT AWAY 
      LDA 1 
      AND CMASK         EXTRACT CONTROL INFO
     STA ICNWD          AND STORE IT AWAY 
      AND DMASK         EXTRACT LOGICAL UNIT NBR
      CPA .2
      RSS 
      JMP SETX
      LDA M1
      ADA ICNWD 
      STA ICNWD         LU 2 CHANGE TO LU 1 
SETX  LDA ICODE         SET X BIT FOR HONESTY MODE ON 
      CPA .1            INPUT 
      JMP DOIT
      LDA ICNWD 
      IOR BIT10 
      STA ICNWD 
DOIT  JSB EXEC          MAKE EXEC CALL
      DEF *+5 
      DEF ICODE 
      DEF ICNWD 
BUFAD DEF BUFAD 
      DEF LENTH 
      AND .32       BIT 5 SET MEANS EOF 
      SZA           MAKE SURE EOF SHOWS 
      CLB           ZERO LENGTH RECORD
      STB 0            SET CHAR COUNT IN AREG 
      JMP DOIO,I
LENTH NOP 
ICODE NOP 
ICNWD NOP 
BIT10 EQU B2000 
FMASK OCT 170000
CMASK EQU B777
DMASK EQU .63 
      HED * BASIC I-O ROUTINES FOR RTE-B *  A-29102-60004-1 REV. B
* 
************************************************
* 
*      READR
* 
* 
************************************************
* 
* 
FCINP EQU 10400B    FUNCTION CODE FOR INPUT 
FCOUT EQU 24000B    FUNCTION CODE FOR OUTPUT
* 
****************************************************
* 
* ENTRY POINTS: 
* 
* 
      ENT LOAD,LOADA,L.RDR
      ENT EREED,RDNBR,REDNO 
      ENT L.PUN,LEADR,ERCRD,RCRD
      ENT LIST.,L.LST,ELIST 
      ENT DSPLY,DSPLA,EDSPL 
      ENT KEYIA,KEYIN,EINP,ETTYS
      ENT LPPOS 
* 
* 
* EXTERNAL REFERENCES:
* 
      EXT .10,INVSC,MO100,READR 
      EXT EINPT 
      EXT TFLAG,ZERO,EFASE,EFIO,READS 
      EXT EREAD 
      EXT GETCR,BCKSP,SBPTR,M1
      EXT FSC,M2,SYMCK,COMM1,ERROR,.STOP
      EXT TEMPS 
      EXT MO133 
      EXT PRINS,EPRIN 
      EXT .1
      EXT SEQNO 
      EXT M6,.7,.23 
* 
* 
******************************************************* 
* 
      SKP 
                                                                                                                                                                                            