      SKP 
* 
*     HERE IS WHERE WE COME ON END OF LINE CONDITION
*     ROUTINE CALLED BY CRLF (DEFINED IN BSUPV) 
* 
ENDLN NOP 
ENLN1 LDA CBUFL     GET CURRENT LENGTH OF LINE
      SZA,RSS       ANYTHING TO OUTPUT? 
      JMP ENLN3     NO
      INA           SET FOR ONE PAST LENGTH 
      CLE,ERA       CONVERT TO WORD LENGTH
      STA PBUFA,I   SAVE LENGTH OF LINE 
      ADA PBUFL     CHECK IF BUFFER IS FULL?
      SSA,INA 
      JMP ENLN2     NO...ROOM IN BUFFER 
      CLA           SET FOR BUFFER FULL, NOT DONE 
      JSB FLUSH     YES...BUFFER FULL...FLUSH IT
      JMP ENLN1     TRY AGAIN 
ENLN2 STA PBUFL     SAVE LENGTH AFTER MOVE
      LDA CBUFL     GET CURRENT LENGTH AGAIN
      CMA           NEGATE LENGTH,INCLUDE SPACE CHAR
      STA ENLNA     SAVE FOR MOVE 
      ISZ PBUFA     GET TO FIRST DATA WORD
      LDB PBUFA     GET ADDRESS OF PACKING BUFFER 
      RBL           CONVERT TO BYTE ADDRESS 
      LDA SBUFA     GET ADDRESS OF LINE TO BE MOVED 
      RAL           CONVERT TO BYTE ADDRESS 
      JSB MOVE      MOVE LINE 
ENLNA NOP 
      LDA CBUFL     GET CURRENT LENGTH AGAIN
      INA           GET ONE MORE
      CLE,ERA       CONVERT TO WORD LENGTH
      ADA PBUFA     RESET CURRENT OUTPUT POINTER
      STA PBUFA     SAVE FOR NEXT TIME
      CLA           CLEAR OUT CURRENT COUNTS
      STA TYPE      DEFINED IN BASIC
      STA CBUFL     DEFINED LOCALY
ENLN3 LDB CRLF      GET RETURN ADDRESS
      JMP B,I       RETURN
      SKP 
* 
*     SUBROUTINE TO MOVE A BUFFER FROM ONE AREA 
*     TO ANOTHER
*     CALLING SEQUENCE
*     JSB MOVE
*     DEC - # OF WORDS...THIS WORD IS LOST!!!!
*     A REQ=SOURCE ADDRESS (BYTE) 
*     B REG=DESTINATION ADDRESS (BYTE)
*     UPON RETURN B REG= NEXT BYTE ADDRESS
* 
MOVE  NOP 
      STA MOVA      SAVE SOURCE BYTE ADDRESS
      STB MOVB      SAVE DESTINATION BYTE ADDRESS 
MOV1  LDB MOVA      GET SOURCE BYTE ADDRESS 
      JSB ABYTE     GET A BYTE
      LDB MOVB      GET DESTINATION BTYE ADDRESS
      JSB SBYTE     STORE THE BYTE
      ISZ MOVA      GET NEXT SOURCE BYTE ADDRESS
      ISZ MOVB      GET NEXT DESTINATION BYTE ADDRESS 
      ISZ MOVE,I    DONE? 
      JMP MOV1      NO...CONTINUE 
      ISZ MOVE      GET TO RETURN ADDRESS 
      LDB MOVB      GET NEXT DESTINATION BYTE ADDRESS 
      JMP MOVE,I    RETURN
      SPC 1 
MOVA  NOP 
MOVB  NOP 
      SKP 
* 
*     SUBROUTINE TO FILL A BUFFER 
*     CALLING SEQUENCE
*     JSB FILBF 
* 
FILBF NOP 
FLBF1 JSB FNDBF     GET SOME BUFFER SPACE 
      STA CLOC      SAVE STARTING BUFFER ADDRESS
      CLE           SET FOR READ A RECORD 
      JSB RWREC     GO READ FROM CENTRAL
      JMP FILBF,I   NO ERRORS...RETURN
      JMP FLBF1     NO ROOM AT CENTRAL...TRY AGAIN
CLOC  NOP 
      SKP 
* 
*     ROUTINE TO FLUSH A BUFFER BY SHIPPING IT TO CENTRAL 
*     CALLING SEQUENCE
*     JSB FLUSH 
*     A REG= END OF LINE CONDITION (NORMALLY 0 EOL OR -1
*     EOL AND EOF)
* 
FLUSH NOP 
      STA PBUFA,I   SAVE END OF BUFFER CONDTION 
FLSH1 LDB RRECA     GET ADDRESS OF BEGINING OF BUFFER 
      CMB,INB       NEGATE BUFFER ADDRESS 
      ADB PBUFA     GET DIFFERENCE
      INB           INCLUDE END OF BUFFER CONDITION IN LENGTH 
      LDA RRECA     GET BUFFER ADDRESS
      CCE           SET FOR WRITE REQUEST 
      JSB RWREC     GO WRITE THE RECORD 
      RSS           NO ERRORS 
      JMP FLSH1     TRY AGAIN 
      LDA RRECA     RESET PACKING BUFFER
      LDB RRECB     GET LENGTH AGAIN
      STA PBUFA 
      STB PBUFL     SAVE ADDRESS AND LENGTH 
      JMP FLUSH,I   RETURN
      SKP 
* 
*     ROUTINE TO READ OR WRITE A RECORD TO CENTRAL
*     CALLING SEQUENCE
*     JSB RWREC 
*     B REG= BUFFER LENGTH
*     A REG= BUFFER ADDRESS 
*     E REG= 0,READ   1,WRITE 
* 
RWREC NOP 
      STB BUFL      SAVE BUFFER LENGTH
      STB LSBLN     SAVE BUFFER LENGTH IN PARMB 
      STA DADR      SAVE DATA BUFFER ADDRESS
      CLA,INA       SET FOR DATA AND REQ..E REG ALREADY SET 
      JSB %TAM      GO DO THE CALL
      DEF STRM      REPLY BUFFER...SAME AS SEND BUFFER
      DEF DADR
      JSB LINST     CHECK LINE STATUS 
      JSB EXEC      RING BELL...TELL THEM WE ARE DOING ARE THING
      DEF *+5 
      DEF .2
      DEF .1
      DEF DINGA 
      DEF DINGL 
      LDB LSST      GET STATUS OF TRANSACTION 
      SZB           NO ERRORS 
      CPB M1        OR EOF
      JMP RWREC,I   RETURN
      LDA FERC      GET FMGR STATUS WORD
      CPB M2        IS IT A FILE MANAGER ERROR? 
      JMP FERR      YES 
      LDA M103      DED WE LOOSE THE DCB??
      CPB M4
      JMP FERR      YES...TELL THEM WE HAD SYSTEM PROBLEM 
      JSB EXEC      CENTRAL BUFFERS FULL...TELL THEM TO STAND BY
      DEF *+5 
      DEF .2
      DEF .1
      DEF STBYA 
      DEF STBYL 
      CLA           SET UP WAIT LOOP
      LDB M6
WLOP1 INA,SZA       INTER LOOP
      JMP WLOP1 
      INB,SZB       OUTER LOOP
      JMP WLOP1 
      ISZ RWREC     SET UP FOR RETRY RETURN 
      JMP RWREC,I   RETURN
      SPC 2 
DADR  NOP 
BUFL  NOP 
      DEF STRM      STARTING ADDRESS OF PARMB 
      ABS LSPSZ     IGNORED BY DS1-B' 
      SPC 1 
M103  DEC -103
STBYA ASC 4,STANDBY 
STBYL DEC 4 
      SPC 1 
DINGA OCT 3537      RING THERE BELL!!!
DINGL OCT 1 
      SKP 
* 
*     SUBROUTINE TO FIND AND SIZE UP SOME BUFFER
*     CALLING SEQUENCE
*     JSB FNDBF 
*     UPON RETURN 
*     B REG=WORD COUNT
*     A REG=STARTING ADDRESS
* 
FNDBF NOP 
      LDA PROGL     CALCULATE STARTING ADDRESS OF BUFFER
      ADA B200      SA=PROGL+(3/8)*(LWAM-200B-PROGL)
      CMA,INA       AS PER RAY FARITO 
      ADA LWAM      (LWAM-200B-PROGL) 
      CLB 
      MPY .3        3*(LWAM-200B-PROGL) 
      DIV .8        3*(LWAM-200B-PROGL)/8 
      ADA PROGL     WE HAVE THE STARTING ADDRESS
      ADA B200      GET PAST TEMP TABLES
      LDB MBUFS     FIND OUT IF MESSAGE BUFFER LARGER 
      CMB,INB       MBUFS=-BUFFER BYTE COUNT
      CLE,ERB       CONVERT TO + WORD COUNT 
      STB FNDBL     SAVE BUFFER LENGTH
      ADB A         ADD TO S.A. OF POSSIBLE BUFFER
      CMB,INB       AVAIL BUFFER<MESSAGE BUFFER?
      ADB LWAM
      SSB           AVAILABLE BUFFER LARGER?
      JMP FNDB1     NO
      ADB FNDBL     YES...GET BUFFER SIZE 
      STB FNDBL     SAVE BUFFER SIZE
      ADB M511      CHECK IF BUFFER TO LARGE
      SSB 
      JMP FNDB2     NO...USE CURRENT ACTUAL BUFFER
      LDB D511      GET MAX BUFFER SIZE 
      STB FNDBL     SAVE AS BUFFER SIZE 
      RSS           SKIP OF MESSAGE BUFFER SIZE 
FNDB1 LDA MBF2A     GET ADDRESS OF MESSAGE BUFFER 
      JSB INDCK     STRIP OFF INDIRECTS 
FNDB2 LDB FNDBL     GET BUFFER LENGTH 
      JMP FNDBF,I   RETURN
      SPC 1 
FNDBL NOP 
D511  DEC 511 
M511  DEC -511
      SKP 
* 
*     SUBROUTINE TO MOVE THE STANDARD PART OF A PARMB 
*     CALLING SEQENCE 
*     JSB PRMIN 
* 
PRMIN NOP 
      CLA           GET A ZERO
      LDB FRMTO     GET FROM TO FLAG
      CLE,SZB,RSS   LOAD? 
      CCE           NO...SAVE 
      ERA           SET SIGN BIT...DEPENDING ON DIRECTION 
      STA LSFG      SAVE LOAD SAVE FLAG 
      CLA           CLEAR OUT DCB# CURRENT LOCATION 
      STA DCB#
      STA CLOC
      LDA .2        GET STREAM TYPE 
      STA STRM      SAVE STREAM TYPE
      LDA RLU       GET CENTRAL LU #
      STA RRLU      SAVE FOR CENTRAL TO USE 
      LDA HILIM     GET UPPER LIMIT 
      LDB LOLIM     GET LOWER LIMIT 
      CPA .9999     UPPER LIMIT?
      CLA           NO
      CPB .1        LOWER LIMIT?
      CLB           NO
      STA ULIM
      STB LLIM      SAVE LIMITS FOR CENTRAL 
      JMP PRMIN,I   RETURN...DONE 
      SPC 2 
.9999 DEC 9999
      SKP 
* 
*     SUBROUTINE TO GET A BYTE
*      CALLING SEQUENCE 
*     JSB ABYTE 
*     B REG CONTAINS BYTE ADDRESS 
*     UPON RETURN A REG CONTAINS BYTE 
* 
ABYTE NOP 
      CLE,ERB       GET WORD ADDRESS
      LDA B,I       GET WORD
      SEZ,RSS       RIGHT OR LEFT HALF? 
      ALF,ALF       LEFT HALF...SHIFT 
      AND B377      MASK ALL BUT LOWER 8 BITS 
      ELB,CLE       GET BYTE ADDRESS AGAIN
      JMP ABYTE,I   RETURN
      SPC 3 
* 
*     SUBROUTINE TO STORE A BYTE
*     CALLING SEQUENCE
*     JSB SYBTE 
*     A REG CONTAINS BYTE 
*     B REG CONTAINS BYTE ADDRESS 
* 
SBYTE NOP 
      AND B377      MASK ALL BUT LOWER 8 BITS 
      STA STEMP     SAVE IN TEMP LOCATION 
      CLE,ERB       CHANGE FROM BYTE TO WORD ADD
      LDA B,I       GET WORD
      SEZ,RSS       RIGHT OR LEFT HALF
      ALF,ALF       LEFT
      AND CM377     MASK ALL BUT UPPER 8 BITS 
      IOR STEMP     OR IN NEW BYTE
      SEZ,RSS       LEFT OR RIGHT 
      ALF,ALF       LEFT
      STA B,I       STORE WORD BACK 
      ELB,CLE       GET BYTE ADDRESS AGAIN
      JMP SBYTE,I   RETURN
      SPC 2 
STEMP NOP 
CM377 OCT 177400
      SKP 
* 
*     SUBROUTINE TO CHECK FOR LINE STATUS 
*     A REG CONTAINS LINE STATUS
*     IF ERROR WILL PRINT ERROR MESSAGE AND RETURN TO 
*     INIT. 
* 
LINST NOP 
      AND B377      MASK ALL BUT ERROR
      CPA .1        ALL OK? 
      JMP LINST,I   YES 
      LDB M51       SET FOR GENERAL LINE ERROR
      CPA B100      IS IT A PARITY ERROR
      LDB M52       PARITY ERROR
      LDA B         GET IN A REG FOR FERR 
      JMP FERR      SEND ERROR TO WORLD 
      SPC 2 
M51   DEC -51 
M52   DEC -52 
B100  OCT 100 
      SKP 
* 
*     ROUTINES TO HANDLE ERRORS 
* 
      SPC 2 
* 
*     SYNTAX ERRORS 
*     CALL IERR WHICH GENERATES A 
*     "ERROR 3 IN LINE 0" 
* 
IERR  JMP INVSC     GO TO MESSAGE ROUTINE IN BASIC
      SPC 2 
* 
*     ON FILE MANAGER ERRORS
*     CALL FERR WHICH GENERATES A 
*     "ERROR DS/RFA -XX IN LINE 0"
*     WHERE XX IS FILE MANAGER ERROR CODE 
*     WHICH IS IN THE A REG WHEN THE ROUTINE IS 
*     CALLED. 
*     CALLING SEQUENCE
*     JMP FERR
*     A REG= NEGATIVE ERROR CODE
* 
FERR  CMA,INA       COMPLEMENT ERROR CODE 
      STA TEMP1     SAVE ERROR CODE 
      JSB ERROR     SEND ERROR MESSAGE
      DEF *+3 
      DEF TEMP1     FMGR ERROR CODE 
      DEF FERMG     "DS"
      JMP INIT      RETURN TO READY STATE 
      SPC 1 
FERMG DEC 4 
      ASC 2,DS
SBUF  BSS SBUFL 
END   EQU * 
      END 
                                                                                                                                                                            