ASMB,R,L,C
      HED "SREAD" DOS ':JF,' -OR- RTE 'LS, READ SOURCE ROUTINE (DLB)
* 
*     NAME:   SREAD 
*     SOURCE: 92068-18027 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   R.A.G.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      NAM SREAD,7 92068-1X027 REV.2013 771116 
      ENT %READ,%JFIL,%RDSC 
      EXT $OPSY,EXEC
      SPC 1 
* 
      SPC 1 
*  PURPOSE: 
*    THIS ROUTINE READS SOURCE DEVICE OR DISC IF LOGICAL UNIT = 2 
      SPC 1 
*  USES:
*    THIS ROUTINE IS USED BY COMPILERS, EDITORS, ASSEMBLERS TO
*    READ SOURCE FROM DEVICES OR FROM RTE/DOS SOURCE DISK FILE
*    AREAS. I.E. DOS IN "JFILE" FORMAT, RTE IN "LS" FORMAT. 
      SPC 1 
*  CALLED:
*      ASSEMBLY ONLY
*               JSB %JFIL    INITIALIZE FOR :JF, OR *LS, POINTER
*               <RETURN>
*      ASSEMBLY ONLY
*               LDA LUTRK    INITIALIZE FOR GIVEN DISCLU/TRACK
*               JSB %RDSC    (IN RTE B-REG MUST = 0)
*               <RETURN>
*      ASSEMBLY ONLY
*               JSB %READ    DEFAULT :JF,*LS IF %JFIL,%RDSC NOT CALLED
*               DEF *+5 
*               DEF LUN      LOGICAL UNIT OF INPUT DEVICE 
*               DEF BUFFR    POINTER TO 1ST WORD OF BUFFER
*               DEF RLEN     -(NUMBER CHARACTERS IN BUFFER) 
*             <EOF RETURN>   END OF FILE RETURN (DISC ONLY) 
*               <RETURN>     A-REG = !15 DISCLU 8!7 TRACK# 0! LAST READ 
*                            B-REG = CHARACTER TRANSMISSION LOG. (POS.) 
      SPC 1 
*  NOTES: 
*    THE B-REGISTER WILL RETURN = 0 IF END OF TAPE IS READ OR 
*    AN IMMBEDDED FILE MARK WHEN READING DISC. IF READING DISC
*    AN EVEN CHARACTER COUNT IS ALWAYS RETURNED.  THE " %JFIL " 
*    AND " %RDSC " ENTRY POINTS MAY BE USED TO RE-INITIALIZE
*    (REWIND) A READ FROM DISC. 
      SPC 1 
%READ NOP 
FTST1 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 NOP           ADDR OF INPUT-LUN OF CONTROL CARD 
FTEST EQU LUNAD     ENTRY 1ST TIME ONLY 
RBFAD JMP BUFFR     ADDR OF READ-BUFFER 
RLGTH NOP           ADDR OF ASKED-FOR RECD LENGTH 
SAVA  EQU RLGTH 
      JMP EXIT,I    EXIT
EXIT  NOP           EXIT POINT
SAVB  EQU EXIT
      SPC 1 
*     JSB %JFIL     DEFAULT THE :JF = *LS AREA
READ1 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
      CMA,SSA,INA,RSS EOF?
      JMP %READ,I   YES, EOF RETURN 
      RBL           A= -(WORDS IN RECORD) 
      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 ACOUN     SET ASKED-FOR RECORD COUNT
MORE1 JSB GETWD     GET WORD FROM DISK
      STA RBFAD,I   WORD TO USER-S BUFFER 
      ISZ RBFAD     BUMP BUFFER ADDR
      ISZ ACOUN     BUMP COUNT
      RSS 
      JMP READ2     READY,FINISH UP 
      ISZ RCOUN     BUMP RECORD COUNT 
      JMP MORE1     CONTINUE
      LDB ALGTH     RETURN ACTUAL RECORD-LENGTH 
      JMP MORE2 
      SPC 1 
READ2 ISZ RCOUN     SKIP TO END OF RECORD 
      JMP MORE3 
      LDB RLGTH,I   READY, RETURN ASKED-FOR REC.LGTH
      CMB,INB       POS LGTH
MORE2 LDA CODE      !15   LU  8!7  TRACK  0!
      JMP EXIT,I
      SPC 1 
MORE3 JSB GETWD     GET NEXT WORD 
      JMP READ2     AND SKIP
      SPC 1 
BFRAD NOP           POINTER FOR INTERNAL BUFFER 
      SPC 1 
GETWD NOP 
      LDA BFRAD,I 
      ISZ BFRAD 
      ISZ BCOUN     BUMP BUFFER COUNTER 
      JMP GETWD,I   EXIT
      ISZ SECTR     BUMP SECTOR NO. 
DOS1  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 TRACK     BUMP TRACK NO.
      JSB EXEC
      DEF *+5 
      DEF .M16      CODE = -16 FOR STATUS 
      DEF .1        1 TRACK 
      DEF TRACK     STARTING TRACK
      DEF TRACK     NEXT GOOD TRACK 
      JMP GETW1+1 
      SPC 1 
RTECD ISZ SECTR     BUMP THE SECTOR 1 MORE TIME 
      LDB O1755 
      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      !15   LU  8!7  TRACK  0!
      STB SECTR     SECTOR NO =0
      LSL 8 
*     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 TRACK     SET TRACK NO
      STB RLUN      SET LUN 
      JSB READS     READ SECTOR 
      JMP GETWD+1   GET RECORD WORD 
      SPC 1 
GETW1 STA SAVE
      JSB READS     READ NEXT SECTOR
      LDA SAVE
      JMP GETWD,I 
      SPC 1 
READS NOP 
      LDA BFWA
      STA BFRAD     BUFFER-POINTER= FWA BUFFER
      LDA MSIZE     -64 OR -128 
      STA BCOUN     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 TRACK     TRACK NO. 
      DEF SECTR     SECTOR NO.
      JMP READS,I   EXIT
      SPC 1 
SAVE  JSB %JFIL     TEMP (PART OF INIT) 
ACOUN LDA SAVA      ASKED-FOR RECD COUNT
RCOUN LDB SAVB      CURRENT-RECORD COUNT
ALGTH JMP FTEST,I   RECD LGTH 
TRACK NOP           CURRENT TRACK NO
SECTR NOP           CURRENT SECTOR NO 
BCOUN NOP           SECTOR-BUFFER COUNTER 
RLUN  NOP           LUN OF CURRENT TRACK
CODE  NOP 
*STYPE NOP           SAVES SYSTEM TYPE CODE FROM OPSY 
*N     NOP           COUNTER
M1OR1 DEC 1         SET FOR RTE, MAY CHANGE 
.M16  DEC -16 
.2OR3 DEC 2 
.2    DEC 2 
.1    DEC 1 
D3    DEC 3 
O1755 OCT 1755
PSIZE DEC 64        CHANGE TO 128 IF DOS-III OR RTE 
MSIZE DEC -64       CHANGE TO -128 IF DOS-III TO RTE
* 
*%RDSC READS A SECTOR 
*CALLING SEQUENCE:       LDA CODE 
*                        LDB SECTR   SECTOR NO. 
*                        JSB %RDSC
*                        RETURN (A)= LAST WORD IN SECTOR
%RDSC OCT -1        INITIALIZED FLAG
FTST2 JSB FTEST     INIT 1ST CAL
      STB SECTR      SECTOR NO. 
      CLB                      FIX GJ 6/76
      LSL 8 
*     LDB =D-8
*     STB N 
*     CLB 
*     CLE,ELA 
*     ELB,CLE       LSL 8 
*     ISZ N 
*     JMP *-3 
      ALF,ALF 
      STA TRACK 
DOS2  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
      LDA LBUFA,I   GET LAST WORD IN ETC. 
      JMP %RDSC,I 
      SPC 1 
*%JFIL GETS SOURCE-FILE CODEWDRD FROM BASE PAGE, FORMS A WORD=
*LUN,TRACK AND CALLS %RDIN WITH IT. 
      SPC 1 
%JFIL OCT -1        INITIALIZED FLAG
FTST3 JSB FTEST     INITIALIZE IF FIRST TIME
*     LDA =D-8
*     STA N 
DOS3  JMP RTEFL     RTE 
      LDB 124B      DOS OR IOMEC/DOS
      LDA .2OR3     LUN = 2 OR 3
      RRL 8 
*     JSB RRL       RRL 8 
      BLF,BLF 
      JMP CONTU 
      SPC 1 
RTEFL LDA 1767B     SOURCE-FILE CODE WORD 
      RAL           POSITION !TRACK!   LU!
      IOR .2        CONVERT LU= 2 OR 3
      ALF,ALF       NOW !   LU!TRACK! 
      STA CODE      SAVE LUN, TRACK NO. 
      CLB           SECTOR NUMBER 
CONTU JSB %RDSC     READ SECTOR 
      JMP %JFIL,I   EXIT
      SPC 1 
LBUFA DEF BUFFR+63
      SPC 1 
BUFFR BSS 128 
      ORG BUFFR 
      STA SAVA
      STB SAVB
      LDA $OPSY 
*     STA STYPE     0 = DOS, 1 = IOMEC/DOS, -2 = RTE
      SSA 
      JMP RTE       RTE 
      CLB 
      STB DOS1
      STB DOS2
      STB DOS3
      CCB           DOS OR IOMEC/DOS
      STB M1OR1     SET M1OR1 = -1
      SLA,RSS 
      JMP DOS       DOS 
DOSM  LDB D3        IF DOS-III, SET LU=3
      STB .2OR3 
RTE   LDB TD128     IOMEC/DOS.  BUFFER SIZE = 128 
      STB PSIZE 
      CMB,INB 
      STB MSIZE 
      LDA DF128     SET LAST WORD IN BUFFER POINTER 
      STA LBUFA 
DOS   CLA           NOP THE 2ND ENTRY PTS.
      STA FTST1 
      STA FTST2 
      STA FTST3 
      LDA %JFIL     FIND OUT IF PRE-INITIALIZED 
      CPA %RDSC     IF BOTH = -1, THEN NOT
      SSA,RSS       DO THE JSB %JFIL OUTSIDE OF BUFFER
      JMP SAVE+1
      JMP SAVE
      SPC 1 
DF128 DEF BUFFR+127 
TD128 DEC 128 
*RL   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 
      SPC 1 
      ORR 
      END 
*