PROG(BCPL)  
OUTE(PLANSEMI)  
WSF(PLANSEGMENTS)   
PLAN(CR)
#PROGRAM       BCPL/%BEXECUTE   
#              HERE FOLLOWETH SOME MACRO DEFINITIONS
#MACRO  
      INVTZ X   
      TXL   X  '#40'
      BCC      *+2  
      ERN   X  #20  
#MACRO  
      CALL  XY N,P  
      LDX   Y  N
      CALL  X  *+1  
      ADN   X  2
      EXIT  Y  P
#MACRO  
      SAVEX    S
      STO   0  S
      STO   1  S+1  
      LDN   0  2
      LDN   1  S+2  
      MOVE  0  6
      LDX   1  S+1  
      LDX   0  S
#MACRO  
      RESTX    S
      LDN   0  S
      LDN   1  0
      MOVE  0  8
#              HERE ENDETH THE ABOVE MACRO DEFINITIONS  
#PROGRAM
#PAGE   
#DEFINE        EOSCH=255
#DEFINE        MINC=512 
#DEFINE        SETC=2048
#DEFINE        MAXC=3072
#DEFINE        IOSIZE=400          [ ALLOWS 2 DISC FILES + LP,+TR OR CR 
#LOWER         COMMON/%BCOMMUNE/
               MFNO,MFNOL   
               MTIMESTORE(2)
               S07(8)   
               ACCDATA(8)   
#UPPER         COMMON/%BIOAREA/ 
               BUFFERS(IOSIZE)  
#UPPER         COMMON/%BSTACK/  
               STACK(SETC)  
#DEFINE        RPCALL=50           [ GLOBAL LOC. OF "REPORTCALL"
#DEFINE        RPRETURN=51         [ GLOBAL LOC. OF "REPORTRETURN"  
#DEFINE        RPMISSINGFN=52      [ GLOBAL LOC. OF "REPORTMISSINGFNS"  
#DEFINE        GSIZE=RPMISSINGFN+1 [ MIN. GLOBAL VECTOR SIZE
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(2)  
#              G0 IS SET TO SIZE OF GVEC - 1
#              G1 IS SET TO "IG1" IF NOT PRESET.
               ENTRYNO             [ ENTRYUSED STORED HERE  
               0/ACCDATA           [ INITIAL X REGISTERS
               GVEC1(21)
               SYSDATAPTR          [ G25; SYSTEM.DATA.BLOCK 
               GVEC2(GSIZE-26)  
#LOWER         COMMON/%BGLOBALEND/  
GEND           0
#LOWER         COMMON/%BIODATA/ 
START          0/BUFFERS
LENGTH         0/IOSIZE 
LUNA           0/BUFFERS+IOSIZE 
NFBA           0/BUFFERS
               ENVIRONMENT  
#LOWER         COMMON/%BIOCONST/
EOSCHLOC       EOSCH
ISO1           #134 
ASCII1         #44  
ISO2           #44  
ASCII2         #134 
#LOWER         COMMON/%BSYSRBLOCK/  
RBLOCK         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0  
#LOWER         COMMON/%BSYSDATA/
MINCLOC        MINC 
SETCLOC        SETC 
MAXCLOC        MAXC 
CURCLOC        0
CURKLOC        0
GVECLOC        0/GVEC   
               0
               0/%BSTEERSEG              [ SHOULD BE 0/%BSTEERSEG   
               0/START  
               0/EOSCHLOC   
               0/RBLOCK 
               0/MINCLOC
STACKLOC       0/STACK  
               0/EX 
               0/FIN
               0/IG1
               0/GQ 
               0/SWIT   
               0/%BSAVE 
               0/%BRETURN   
               0/KORE   
               0/KORES  
#DEFINE        DATABLOCK=MINCLOC
#PAGE   
#PROGRAM
EX    LDX   3  GVECLOC  
      LDX   3  1(3) 
      LDX   2  STACKLOC 
      CALL  1  %BSAVE   
               0
#CUE           %BFINISH 
FIN   CALL  1  %BIOPSTOP
      SUSWT    2HBH 
      BRN      *-1  
IG1   CALL  1  %BIOPSTOP
      SUSWT    2HG1 
      BRN      *-1  
GQ    SUSWT    2HGQ 
      BRN      RETURN   
#PAGE   
#CUE           %BSWITCHON   
#              SWITCHON COMPILES TO :-  
#                    CALL  1  %BSWITCHON
#                             N    [NUMBER OF CASES 
#                             D    [DEFAULT LABEL - 0/LD
#                             K1   [CASE 1 VALUE
#                             L1   [CASE 1 LABEL
#                                  [AND SO ON   
#                             ..   [AND ON  
#                                  [UNTIL   
#                             KN   [CASE N VALUE
#                             LN   [CASE N LABEL
#              THE CASES ARE IN ASCENDING ORDER OF VALUE
SWIT  LDX   0  0(1)                [GET NUMBER OF CASES 
      LDX   5  1(1)                [GET DEFAULT LABEL VALUE 
      BZE   0  SSDEF               [GOTO DEFAULT LABEL IF NO CASES  
SSLOP ADN   1  2                   [SET FOR NEXT(FIRST) CASE
      LDX   6  0(1)                [GET CASE VALUE  
      SBX   6  4                   [COMPUTE DIFFERENCE  
      BPZ   6  SSEND               [ J IF END OF SEARCH 
      SBN   0  1                   [DECREASE COUNT  
      BNZ   0  SSLOP
SSEND BNZ   6  SSDEF               [ J IF CASE DOES NOT MATCH   
      LDX   5  1(1) 
SSDEF EXIT  5  0                   [GOTO CASE LABEL OR DEFAULT LABEL
#PAGE   
#CUE           %BKORE   
KORE  STO   1  LINK                [SAVE
      STO   0  LINC                [X0,X1   
      BNZ   1  *+2                 [TEST FOR STACK LINKAGE AND  
      LDN   1  2(2)                [IF SO,SET ADDRESS OF PARAMETER IN X1
      LDX   0  CURCLOC             [X0=CORE 
      SBX   0  2                   [X0=CORE ABOVE P 
      NGX   1  0(1)                [X1=-NEEDED CORE ABOVE P 
      ADX   1  0                   [X1=SPARE CORE   
      BNG   1  EXPND               [BRANCH TO EXPANDER  
      TXL   1  MINCLOC             [MINIMUM ALLOWED SPARE CORE  
      BCS      EXPND               [BRANCH TO EXPANDER  
      TXL   1  MAXCLOC             [MAXIMUM ALLOWED SPARE CORE  
      BCS      EXITK               [DON'T CHANGE CORE SIZE  
      SBX   0  1                   [X0=NCAP 
      ADX   0  2                   [X0=NCAP+P   
      ADX   0  SETCLOC             [X0=NCAP+P+SETC  
      LDX   1  0                   [X1=X0   
      GIVE  1  4                   [CONTRACT
      CALL  0  KORES               [SAVE NEW CORE SIZES 
      BRN      EXITK               [EXIT
EXPND SBX   0  1                   [X0=NCAP 
      ADX   0  2                   [X0=NCAP+P   
      ADX   0  SETCLOC             [X0=NCAP+P+SETC  
      ANDX  0  '#17777777'  
      LDX   1  0                   [X1=X0   
      GIVE  1  4                   [EXPAND  
      TXL   1  0                   [CHECK REPLY 
      BCC      *+3                 [BRANCH IF REQUEST     SATISFIED 
      SUSWT    2HST                [HALT   IF REQUEST NOT SATISFIED 
      BRN      *-5                 [AND TRY AGAIN   
      CALL  0  KORES               [SAVE NEW CORE SIZES 
EXITK LDX   0  LINC                [RESET   
      LDX   1  LINK                [X0,X1   
      BZE   1  RETURN              [STACK EXIT  
      EXIT  1  1                   [CALL  EXIT  
#PAGE   
#CUE           %BKORES  
KORES SAVEX    S07                 [SAVE X-REGS 
      LDCT  3  #200                [SET X3 TO LENGTH-CHARACTER  
      ORX   3  RBLOCK              [POINTER TO W1 OF REQUEST BLOCK  
      SLC   1  9                   [SHIFT CORE SIZE TO R-BLOCK FORMAT   
      STO   1  3(3)                [AND STORE IT
      SRC   1  9                   [AND THEN SHIFT BACK 
      STO   1  CURCLOC             [STORING IN NEW CORESIZE WORD
      SBX   1  MINCLOC             [AND COMPUTING   
      STO   1  CURKLOC             [AND STOREING NEW TEST CONSTANT  
      LDCH  1  0(3)                [LOAD R-BLOCK SIZE   
      STOZ     13(3)               [ZERO CHECKSUM WORD  
      SUM   2  0(1)                [COMPUTE AND 
      NGS   2  13(3)               [STORE NEW CHECKSUM  
      LDN   1  0                   [CLEAR X1 FOR MINIMOP
      LDN   2  0                   [CLEAR X2 FOR MINIMOP
      RRQ   1  0(3)                [WRITE REQUEST BLOCK 
      RESTX    S07                 [RESTORE X-REGS  
      EXIT  0  0                   [AND EXIT
#PAGE   
#MACRO  
      SETE     N
      STO   0  ACCDATA  
      CALL  0  STOX 
#PROGRAM
#ENTRY         0
NTRY0 SETE     0
#ENTRY         1
      SETE     1
#ENTRY         2
      SETE     2
#ENTRY         3
      SETE     3
#ENTRY         4
      SETE     4
#ENTRY         5
      SETE     5
#ENTRY         6
      SETE     6
#ENTRY         7
      SETE     7
#ENTRY         8
      SETE     8
#ENTRY         9
      SETE     9
STOX  SBX   0  'NTRY0'  
      SRL   0  1
      SBN   0  1
      STO   0  ENTRYNO  
      STO   1  ACCDATA+1
      LDN   0  2
      LDN   1  ACCDATA+2
      MOVE  0  6
      ON    1  1
      ON    1  3
      LDX   4  45   
      STO   4  MFNO                [ MINI/MAXIMOP FILE UNIT NUMBER  
      LDN   6  0
      LDN   7  0
      GIVE  6  10   
      STO   6  MTIMESTORE   
      STO   7  MTIMESTORE+1 
      NGN   3  2
      ANDN  3  RBLOCK+2 
      STO   3  RBLOCK   
      STOZ     0(3) 
      LDN   4  1(3) 
      MOVE  3  15   
      LDN   1  0
      LDN   2  0
      RRQ   0  0(3) 
      GIVE  0  5                   [ C.P.U PROCESSOR DETAILS
      ANDN  0  7                   [ RETURNS OPERATING SYSTEM CODE  
      STO   0  ENVIRONMENT  
      LDN   1  1
#                    GIVE  1  9 
      GIVE  1  9
      GIVE  1  3
      CALL  0  %BKORES  
      LDX   2  STACKLOC 
#              G0 SET TO LENGTH OF %BGLOBALVEC - 1  
      LDN   0  GEND 
      SBN   0  GVEC+1   
      STO   0  GVEC 
#              SET G1 TO 'IG1' IF NOT PRESET
      LDX   0  GVEC+1   
      BNZ   0  *+2  
      LDPL  0  IG1  
      STO   0  GVEC+1   
      LDX   0  GVEC+RPMISSINGFN 
      BNZ   0  *+2  
      LDPL  0  GQ   
      STO   0  GVEC+RPMISSINGFN 
      LDN   0  DATABLOCK
      STO   0  SYSDATAPTR   
      BRN      EX   
#END
PLAN(CR)
#PROGRAM       /%BEDSFILES  
#MACRO  
      SET      A,B  
      LDX   0  B
      STO   0  A
#MACRO  
      RTAP     F,N  
      LDX   3  F
      CALL  1  %BSAVE   
      LDX   0  N
#MACRO  
      RTRN  
      BRN      RETURN   
#MACRO  
      RES      A
      LDX   4  A
      BRN      RETURN   
#MACRO  
      LN    X  A,B  
      LDX   X  A
      STO   X  B(2) 
#MACRO  
      SL    X  A,B  
      LDX   X  B(2) 
      STO   X  A
#MACRO  
      LP    X  A,B  
      LDX   X  A(2) 
      STO   X  B(2) 
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(42) 
               0/FINDF  
               0/CREAT  
#LOWER         COMMON/%BIODATA/ 
               START,LENGTH,LUNA,NFBA,ENVIRONMENT   
#LOWER  
SKELETON       17   
               #40600000           [ TYPE : ED,REPLACED X   
               0                   [ REPLY WORD 
               128  
               0                   [ BUFFER ADRESS TO BE ADDED  
               1                   [ BUCKET NUMBER  
               0                   [ UNIT NUMBER
               4                   [ REC. ADR - ADD BUFFER ADR  
               4                   [ REC. ADR - ADD BUFFER ADR  
               0                   [ REMAINDER CHARACTER COUNT  
               #74000000
               3                   [ SHIFT CODE 
               0                   [ DEVICE HANDLER 
               0                   [ BUFFER ADDRESS FOR NODE COMPACTER  
               128                 [ BUFFER SIZE
               -1                  [ NUMBER OF BUCKETS LEFT IN S/F  
               16   
#DEFINE        STRING=2 
#DEFINE        MODE=3   
#DEFINE        DEVICE=4 
#PAGE   
#SET           SAVE=3              [ SAVE SPACE FOR THIS FUNCTION   
#PROGRAM
#CUE           FINDFILE 
FINDF LP    0  STRING,STRING+SAVE   
      LN    0  '#200',MODE+SAVE 
      LN    0  '%BEDI',DEVICE+SAVE  
      LDN   0  0
      STO   0  SAVENT   
      RTAP     'OPENC',SAVE 
      LDX   3  4
      LDX   3  0(3) 
      LDN   0  2
      ORS   0  10(3)               [ SET READ PERMIT BIT
      RTRN  
#PAGE   
#CUE           CREATEFILE   
#SET           SAVE=3   
#LOWER  
BKTHD          0
               #02000200
               126  
               496  
#PROGRAM
CREAT LP    0  STRING,STRING+SAVE   
      LN    0  '#300',MODE+SAVE 
      LN    0  '%BEDO',DEVICE+SAVE  
      LDN   0  2
      STO   0  SAVENT   
      RTAP     'OPENC',SAVE 
      LDX   3  4
      LDX   3  0(3) 
      LDN   0  1
      ORS   0  10(3)
      ORS   0  1(3)                [ SET MODE   
      SET      9(3),'496'   
      LDN   5  BKTHD
      LDX   6  4(3) 
      MOVE  5  4                   [ FILL IN BUCKET HEADER. 
      RTRN  
#PAGE   
#SET           SAVE=5   
OPENC LP    0  STRING,STRING+SAVE   
      LP    0  MODE,MODE+SAVE   
      RTAP     'OPENF',SAVE 
      LDX   3  SKELETON            [ NODE LENGTH
      LDX   1  NFBA 
      LDN   0  SKELETON 
      MOVE  0  0(3)                [ MOVE SKELETON NODE TO BUFFER   
      STO   4  6(1)                [ UNIT NUMBER WAS RESULT IN X4   
      ADS   3  NFBA 
      LDX   0  NFBA 
      ADS   0  4(1) 
      ADS   0  7(1) 
      ADS   0  8(1) 
      ADS   0  13(1)
      SET      12(1),DEVICE(2)  
      LDX   0  14(1)
      ADS   0  0(1)                [ SET NODE/BUFFER LENGTH 
      ADS   0  NFBA                [ ADD BUFFER LENGTH  
      LDX   3  LUNA 
      SBN   3  1
      STO   1  0(3) 
      STO   3  LUNA 
      RES      LUNA 
#PAGE   
#              STACK LINKAGE: PARAMETER1 = NAME 
#                             PARAMETER2 = MODE 
#LOWER  
SWIT           0/EXEC   
               0/GEO1   
               0/GEO2   
               0/GEO3   
               0/GEO4   
               0/%BNW   
               0/MAXI   
               0/MINI   
NFN            17,0,0,0,0,0,0,0,0,0 
               #74000001,1,0/%BSSO,0,0,0
               16   
NFNN           0/NFN
NFNLOC         0/NFNN   
PEDI           262/0, 0 
FNAME          12H            ,0,-1,0,0 
MESS1          20HTOO MANY DISC FILES.  
MESS2          40HEDSFILE              NOT OPENED : ERR. ?  
MESS3          20HTOO MANY    FILES 
#LOWER  
               OPEN(9)  
               PSAVE
               MDE,STR,N,UNIT,OKFLAG
#PROGRAM
OPENF SL    3  STR,STRING          [ STORE FIRST PARAMETER IN STR & X3  
      LDX   4  0(3) 
      SRL   4  16   
      STO   4  N
      LDX   6  '#77700000'  
      ANDS  6  PEDI 
      LDX   0  MODE(2)  
      ORS   0  PEDI 
      STO   2  PSAVE
      LDX   1  ENVIRONMENT  
      BNG   1  %BNW 
      BXGE  1  '8',%BNW 
      LDX   0  SWIT(1)  
      EXIT  0  0
EXIT  LDX   2  PSAVE
      RES      UNIT 
EXEC  NULL  
GEO1  NULL  
GEO2  CALL  7  CONFN
EDD   LDN   0  15   
UNOL  ALLOT 0  262  
      LDX   1  9
      BNG   1  *+7  
      SBN   0  1
      BNZ   0  UNOL 
      CALL  1  %BIOPSTOP
      DISTY    '19/MESS1'   
      SUSWT    2HE@ 
      BRN      *-1  
      STO   0  UNIT 
      STOZ     OKFLAG   
OPN   LDX   0  UNIT 
      LDN   6  PEDI 
      LDN   7  OPEN 
      MOVE  6  9
      PERI  0  OPEN 
      LDX   4  OPEN+1   
      BPZ   4  OPNED
      LDN   6  FNAME
      LDN   7  MESS2+2  
      MOVE  6  3
      LDCT  3  #600 
      ORN   3  MESS2+9  
      DCH   4  0(3) 
      NGN   0  1
      STO   0  OKFLAG   
      DISTY    '40/MESS2'   
      SUSWT    2HE@ 
      BNG   0  OPN  
      BNZ   0  EXIT 
      CALL  1  %BIOPSTOP
      SUSWT    2HE6 
      BRN      *-1  
OPNED LDX   3  OKFLAG   
      BZE   3  *+2  
      DISP     2HOK 
      BRN      EXIT 
#LOWER  
               TYPE,STRNO   
#LOWER  
NEDI           17,262/0,0,128,0,1,0,0,0,0   
               #74000002,3,0/%BEDI,0,128,-1 
               16   
COM            48HAS *CR1 ,                     
D0             8H,          
D1             8H, :LIB.
D3             8H   
D4             8H(WRITE)
CICON          60/1,0,48,0/COM  
TRW            8HTR1  TR ,0 
CRW            8HCR1  CR ,0 
EDW            8HED1  ED ,0 
#PROGRAM
GEO3  NULL  
GEO4  CALL  7  CONFN
      LDX   4  MDE  
      BXE   4  '#300',EDD   
      LDX   1  '4HED1 ' 
      STO   1  EDW  
      LDN   2  262  
      CALL  7  PEUN 
      LDN   2  771  
      CALL  7  PEUN 
      LDN   2  768  
      CALL  7  PEUN 
      LDX   1  FNAME
      STO   1  COM+4
      LDX   1  FNAME+1  
      STO   1  COM+5
      LDX   1  FNAME+2  
      STO   1  COM+6
      LDX   1  SAVENT   
      LDX   45 D3(1)
      STO   45 COM+7
      LDN   1  6
      LDN   2  D0   
      LDN   6  2
G34L  LDX   4  TRW(1)   
      STO   4  COM+1
      LDX   45 0(2) 
      STO   45 COM+2
      CALL  7  ASWR 
      SBN   1  3
      BPZ   1  G34L 
      LDN   1  6
      SBN   6  1
      ADN   2  2
      BNZ   6  G34L 
      BRN      EDD  
ASWR  STOZ     CICON+1  
      PERI  0  CICON
      LDX   0  CICON+1  
      BPZ   0  *+2  
      SUSBY 0  60   
      LDCT  0  #020 
      ANDX  0  CICON+1  
      BZE   0  G34AS
      EXIT  7  0
G34AS STO   1  TYPE 
      TXU   1  '6'  
      BCS      *+5  
      LDX   1  EDW+2
      STO   1  UNIT 
      STO   1  NEDI+6   
      BRN      OPN  
      MPY   1  '10' 
      STO   2  STRNO
      CALL  1  FINDINPUT
      LDN   3  STRNO
      LDX   3  4
      LDN   0  3
      TXU   0  TYPE 
      BCS      SETUN
      LDN   0  20   
      ADS   0  NFBA 
      ADS   0  14(3)
      LDX   0  LUNA 
      TXL   0  NFBA 
      BCS      OV                  [UNIT NO IS OK : TRY IT AND SEE  
      LDN   0  160  
      STO   0  3(3) 
SETUN LDX   1  TYPE 
      LDX   0  TRW+2(1) 
      STO   0  6(3) 
      LDX   0  '#20000' 
      ORS   0  10(3)
      BRN      EXIT 
PEUN  LDN   1  5
PEOL  ADN   1  10   
      ALLOT 1  0(2) 
      LDX   0  9
      BNG   0  PEFND
      SBN   1  11   
      BPZ   1  PEOL 
      TXU   2  '262'
      BCC      PEED 
PENP  ANDX  2  '#00000377'  
      LDX   0  TRW+1(2) 
      STO   0  MESS3+2  
      CALL  1  %BIOPSTOP
      DISTY    '17/MESS3'   
      SUSWT    2HE@ 
      BRN      *-1  
PEFND ORX   2  '#60000000'  
      ANDX  2  '#77776377'  
      STO   1  TRW+2(2) 
      TXL   1  '10' 
      BCS      *+2  
      SBN   1  10   
      DCH   1  TRW(2)   
      EXIT  7  0
PEED  ADN   1  10   
      LDX   0  '4HED0 ' 
      STO   0  EDW  
PEEDL ALLOT 1  262  
      LDX   0  9
      BNG   0  PEFND
      SBN   1  1
      BNZ   1  PEEDL
      BRN      PENP 
MINI  BRN      %BNW 
MAXI  BRN      EXEC 
#LOWER  
               LINKA,M,CH   
#PROGRAM
CONFN STO   7  LINKA
      LDN   0  FNAME
      STO   0  NFN+7
      STO   0  NFN+8
      LDN   0  12   
      STO   0  NFN+9
      LDN   0  1
      STO   0  NFN+11   
      LDX   0  '4H    ' 
      STO   0  FNAME
      STO   0  FNAME+1  
      STO   0  FNAME+2  
      LDN   0  8
      STO   0  M
      LDX   2  STR  
FNL   LDX   3  0(2) 
      LDX   1  M
      SRL   3  0(1) 
      BNZ   1  *+3  
      LDN   1  24   
      ADN   2  1
      SBN   1  8
      STO   1  M
      STO   3  CH   
      CALL  1  WRITECH  
      LDN   3  NFNLOC   
      LDN   3  CH   
      LDX   0  N
      SBN   0  1
      STO   0  N
      BNZ   0  FNL  
      LDX   7  LINKA
      EXIT  7  0
OV    CALL  1  %BIOPSTOP
      SUSWT    2HE* 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       /%BSWITCHES  
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(4)  
               0/SWON   
               0/SWOFF  
               0/SWTST  
               0/SWNVT  
#LOWER  
MASK           #40000000
               #37777777
               #40000000
               #40000000
INST  ORS   0  30   
      ANDS  0  30   
      NULL  
      ERS   0  30   
#PROGRAM
SWON  LDN   3  0
      BRN      *+6  
SWOFF LDN   3  1
      BRN      *+4  
SWTST LDN   3  2
      BRN      *+2  
SWNVT LDN   3  3
      LDCT  4  #400 
      LDX   0  MASK(3)  
      LDX   5  INST(3)  
      LDX   3  2(2) 
      SRC   0  0(3) 
      SRC   4  0(3) 
      OBEY     5
      ANDX  4  30   
      BZE   4  RETURN   
      NGN   4  1
      BRN      RETURN   
#END
PLAN(CR)
#PROGRAM       /%BFLOAT 
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(12) 
               0/FPADD  
               0/FPSUB  
               0/FPMUL  
               0/FPDIV  
               0/FPFLO  
               0/FPFIX  
#PROGRAM
FPADD BRN      START
      FAD   0  0(1) 
FPSUB BRN      START
      FSB   0  0(1) 
FPMUL BRN      START
      FMPY  0  0(1) 
FPDIV BRN      START
      FDVD  0  0(1) 
START LDX   1  3(2)          [SECOND ARG IN 1   
      LFP      0(1)          [LOAD NUMBER REFERRED INTO A   
      LDX   1  4(2)          [THIRD ARG 
      OBEY     1(3)          [PERFORM OPERATION 
      LDX   1  2(2)          [ADDRESS FOR ANSWER-- FIRST ARG
      SFP      0(1)          [STORE RESULT  
      BFP   5  OVRFL         [OVERFLOW? 
      LDN   4  0             [NO -- RETURN 'FALSE'  
      BRN      RETURN   
OVRFL NGN   4  1
      BRN      RETURN   
FPFLO LDX   3  3(2)          [            NUMBER TO BE FLOATED  
      STOZ     4
      FLOAT    3
      LDX   1  2(2) 
      SFP      0(1) 
      BRN      RETURN   
FPFIX LDX   1  2(2) 
      LDX   3  3(2) 
      LFP      0(3) 
      FIX      0(1) 
      STOZ     4
      BVC      *+2  
      NGN   4  1
      BRN      RETURN   
#END
PLAN(CR)
#PROGRAM       /%BTYROUTINE 
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(8)  
               0/TYHAL  
               0/TYDIS  
               0/TYDEL  
               0/TYCHA  
#LOWER  
NTY            17,-1,-1,-1,-1,-1,0,0,0,0
               #74000001,3,0/%BSSO,0,0,0
               16   
NTYP           0/NTY
NTYLOC         0/NTYP   
TYPE  SUSTY    CW   
      DISTY    CW   
      DELTY    CW   
      BRN      EDTY 
      SUSWT    2H   
      DISP     2H   
      DEL      2H   
      BRN      EDTY 
INST  NULL  
#LOWER         MSG(10)  
#PROGRAM
TYHAL LDN   0  0
      BRN      *+6  
TYDIS LDN   0  1
      BRN      *+4  
TYDEL LDN   0  2
      BRN      *+2  
TYCHA LDN   0  3
      STO   0  NTY+6
      STO   1  LINK 
      STO   2  PSAVE
      TXU   0  '3'  
      BCS      *+3  
      LDX   5  3(2) 
      STO   5  VEC  
      LDX   3  2(2) 
      STO   3  STR  
      LDX   4  0(3) 
      SRL   4  16   
      STO   4  N
ASMSG LDN   0  MSG  
      STO   0  NTY+7
      STO   0  NTY+8
      LDN   0  40   
      STO   0  NTY+9
      LDN   0  3
      STO   0  NTY+11   
      LDX   0  '4H    ' 
      STO   0  MSG  
      LDN   0  8
      STO   0  M
      LDX   2  STR  
MSGL  LDX   3  0(2) 
      LDX   1  M
      SRL   3  0(1) 
      BNZ   1  *+3  
      LDN   1  24   
      ADN   2  1
      SBN   1  8
      STO   1  M
      STO   3  CH   
      CALL  1  WRITECH  
      LDN   3  NTYLOC   
      LDN   3  CH   
      LDX   0  N
      SBN   0  1
      STO   0  N
      BNZ   0  MSGL 
#              MESSAGE ASSEMBLED
      LDN   0  40   
      SBX   0  NTY+9
      TXL   0  '3'  
      BCS      ENN  
      SLL   0  15   
      ORN   0  MSG  
      STO   0  CW   
TYOP  LDX   1  NTY+6
      OBEY     TYPE(1)  
      LDX   2  PSAVE
      BRN      RETURN   
ENN   LDX   1  MSG  
      SRL   1  12   
      DSA   1  TYPE+4   
      DSA   1  TYPE+5   
      DSA   1  TYPE+6   
      LDN   0  4
      ADS   0  NTY+6
      BRN      TYOP 
EDTY  SBN   1  1
      LDX   0  TYPE(1)  
      STO   0  INST 
      LDX   0  VEC  
      LDN   1  0
      MOVE  0  8
      OBEY     INST 
      BRN      RETURN   
#END
PLAN(CR)
#PROGRAM       /%BSYSTEM
#LOWER         COMMON/%BCOMMUNE/
               MFNO,MFNOL   
               MTIMESTORE(2)
               S07  
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(18) 
               0/GGIVE             [ G18
               0/CORE                [ G19  
               0/RSCLK             [ G20
               0/RDCLK             [ G21
               0/RSOV              [ G22
               0/RDOV              [ G23
               0/EXEC              [ G24
               SYSDATAPTR   
               0/OVLAY             [ G26 - "BRING.SEG"  
#LOWER         COMMON/%BSYSDATA/
               MINCLOC  
               SETCLOC  
               MAXCLOC  
               CURCLOC  
               CURKLOC  
#LOWER  
SW1C  LDN   5  0
      LDX   5  CURCLOC  
      LDX   5  2
      BRN      CORE3
      BRN      CORE4
      BRN      CORE5
SW2C  NULL  
      BRN      CLKRD
#PAGE   
#PROGRAM
GGIVE LDX   3  3(2) 
      LDX   4  0(3) 
      LDX   5  1(3) 
      LDX   3  2(2) 
      GIVE  4  0(3) 
      LDX   3  4(2) 
      STO   4  0(3) 
      STO   5  1(3) 
      BRN      RETURN   
#PAGE   
CORE  LDX   3  2(2) 
      LDX   6  3
      ANDX  3  '#37777777'  
      TXL   3  '6'  
      BCC      COREE
      OBEY     SW1C(3)  
      ADX   5  3(2) 
      LDX   4  5
      GIVE  4  4
      BNG   6  *+5  
      TXL   4  5
      BCC      *+3  
      SUSWT    2HST 
      BRN      *-6  
      LDX   1  4
      CALL  0  %BKORES  
      BRN      RETURN   
CORE3 LDN   3  MINCLOC  
      LDX   4  3(2) 
      BRN      *+3  
CORE4 LDX   3  3(2) 
      LDN   4  MINCLOC  
      MOVE  3  3
      BRN      COREE
CORE5 STOZ     CURKLOC  
      BRN      COREE
COREE LDX   4  CURCLOC  
      BRN      RETURN   
#PAGE   
RSCLK LDN   3  0
      BRN      *+2  
RDCLK LDN   3  1
      LDN   6  0
      LDN   7  0
      GIVE  6  10   
      SBXC  7  MTIMESTORE+1 
      SBX   6  MTIMESTORE   
      OBEY     SW2C(3)  
      ADSC  7  MTIMESTORE+1 
      ADS   6  MTIMESTORE   
CLKRD DVD   6  2(2) 
      LDX   4  7
      BRN      RETURN   
RSOV  LDX   4  1(2)                [ LINK   
      SRA   45 23        [ PROPOGATE BIT 0  
      BRN      RETURN   
RDOV  LDX   4  1(2)                [ LINK   
      SRA   45 23                  [ PROPAGATE BIT 0
      LDX   5  '#37777777'  
      ANDS  5  1(2)                [ CLEAR BIT 0 OF LINK
      BRN      RETURN   
#PAGE   
#LOWER         INST,EXS2,EXS4   
#PROGRAM
EXEC  NGN   4  1
      STO   4  EXS4 
      STO   2  EXS2 
      LDX   0  2(2) 
      STO   0  INST 
      LDX   6  3(2) 
      LDN   7  0
      MOVE  6  8
      OBEY     INST 
      BCS      *+2  
      STOZ     EXS4 
      STO   6  S07+6
      STO   7  S07+7
      LDN   6  0
      LDN   7  S07  
      MOVE  6  6
      LDX   4  EXS4 
      LDX   2  EXS2 
      LDX   0  4(2) 
      MOVE  7  8
      BRN      RETURN   
#PAGE   
#              OVERLAY ROUTINE:- BRINGS IN AN OVERLAY UNIT. USES STACK  
#              LINKAGE.PARAMETER IS WORD CONTAINING OVERLAY AREA AND
#              UNIT NUMBER IN USUAL FORMAT. 
#LOWER  
PSAVE          0
PARAM          0
      LDX   2  PSAVE
      BRN      RETURN   
#PROGRAM
OVLAY STO   2  PSAVE
      LDX   4  2(2) 
      STO   4  PARAM
      LDN   1  PARAM
      BRN      %ROL 
#END
PLAN(CR)
#PROGRAM       /%BEDI   
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
      BRN      *+3  
      SUSWT    2HE# 
      BRN      *-1  
      STO   1  LINK 
      LDX   7  10(3)
      SRL   7  12   
      ANDN  7  #77  
      LDN   0  #20  
      ANDX  0  7
      BNZ   0  EDEOS
      LDX   0  15(3)               [END ON (SUB)FILE LENGTH 
      BZE   0  EDEOS
      SBN   0  1
      STO   0  15(3)
      LDX   6  6(3)                [X6=UNIT NUMBER  
      STOZ     2(3) 
      PERI  6  1(3) 
      LDX   5  2(3)                [TEST IF NEED TO SUSBY   
      BPZ   5  *+2  
      SUSBY 6  262  
      LDCT  5  #150 
      ANDX  5  2(3) 
      BNZ   5  EDERR
      LDX   1  4(3) 
      LDN   2  #2000               [END ON END OF FILE BUCKET   
      ANDX  2  0(1) 
      BNZ   2  EDEOS
      LDX   2  3(1) 
      BPZ   2  *+4                 [IF CH COUNT < 0 
      LDCT  0  #002                [SET FOR END AT END OF BUCKET
      ORS   0  10(3)
      NGX   2  2
      STO   2  9(3) 
      LDX   0  7(3)                [SET FOR FIRST CHARACTER 
      STO   0  8(3) 
      LDN   0  1
      ADS   0  5(3)                [INCREMENT LOG. BKT. NO. 
      NGN   4  1
EXIT  LDX   1  LINK 
      EXIT  1  0
EDEOS CALL  1  %BENDREAD
      LDX   4  EOSCHLOC 
      BRN      EXIT 
EDERR NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2HE6 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       /%BEDO   
#LOWER         S(8) 
#LOWER  
SW1   BRN      CTZE 
      BRN      FECH 
      BRN      SUSP 
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
      BRN      ED0  
      BRN      ED1  
      BRN      ED2  
ED0   LDN   0  0
      BRN      *+4  
ED1   LDN   0  1
      BRN      *+2  
ED2   LDN   0  2
      SAVEX    S
#      SMO      SW1         [ ORIGINAL WAS  
      EXIT  0  SW1       [ EXIT 0 SW1   
EXIT  RESTX    S
      EXIT  1  0
EDERR NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2HE6 
      BRN      *-1  
FECH  TXU   4  EOSCHLOC 
      BCC      EOS  
      NGN   4  1
      STO   4  S+4  
      BRN      EXIT 
EOS   LDX   0  9(3) 
      LDX   1  4(3) 
      SBX   0  3(1) 
      BNZ   0  *+3  
      NGN   0  1
      STO   0  4(1) 
      STO   0  3(1) 
      CALL  7  WRBKT
      CALL  1  %BENDWRITE   
      BRN      EXIT 
WRBKT LDX   6  6(3) 
      STOZ     2(3) 
      PERI  6  1(3) 
      LDX   1  2(3) 
      BPZ   1  *+2  
      SUSBY 6  262  
      LDCT  5  #140 
      ANDX  5  2(3) 
      BNZ   5  EDERR
      LDCT  5  #010 
      ANDX  5  2(3) 
      BNZ   5  LBNOR
      LDX   5  7(3) 
      STO   5  8(3) 
      LDN   5  496  
      STO   5  9(3) 
      LDN   0  1
      ADS   0  5(3) 
      EXIT  7  0
#LOWER  
MESS1          40HEDSFILE BUCKET NO. OUT OF RANGE (OUTPUT)  
MESS2          20HON BUCKET  *  
MESS3          34HDISC EXT. FAILED 3 : RESTART LATER
EXTND          262/#500,0,0,0,0 
EXT            262/#500,0,0,0,0 
#PROGRAM
LBNOR LDN   0  8
      LDN   1  MESS2+3  
      LDX   6  5(3) 
      LDN   5  0
      SLL   56 3
      DCH   5  0(1) 
      BCHX  1  *+1  
      SBN   0  1
      BNZ   0  *-5  
      LDX   6  6(3) 
      STOZ     EXTND+1  
      STOZ     EXTND+2  
      STOZ     EXTND+3  
      STOZ     EXTND+4  
      PERI  6  EXTND
      SUSBY 6  262  
RSXTL LDN   0  80   
      STO   0  EXT+3
SEXTL LDX   0  EXTND+4  
      STO   0  EXT+4
      STOZ     EXT+1
      STOZ     EXT+2
      PERI  6  EXT  
      SUSBY 6  262  
      LDX   0  EXT+1
      BPZ   0  WRBKT
      ANDN  0  #7777
      TXL   0  '8'  
      BCC      SEXT 
      TXU   0  '3'  
      BCC      RSEXT
      DISTY    '40/MESS1'   
      DISTY    '20/MESS2'   
      BRN      EDERR
SEXT  STO   0  EXT+3
      BRN      SEXTL
RSEXT DISTY    '34/MESS3'   
      SUSWT    2HE@ 
      BRN      RSXTL
CTZE  CALL  7  WRBKT
SUSP  BRN      EXIT 
#END
PLAN(CR)
#PROGRAM       /%BTRACESAVE 
#LOWER         COMMON/%BGLOBALVEC/GVEC  
#LOWER         COMMON/%BSYSDATA/
               MINCLOC,SETCLOC,MAXCLOC,CURCLOC,CURKLOC  
#PROGRAM
#DEFINE        RPCALL=50               [ GLOBAL POSITION OF 'REPORTCALL'
#DEFINE        RPRETURN=51             [GLOBALPOSITIONOF'REPORTRETURN'  
#DEFINE        RPMISSINGFN=52   
#DEFINE        MAXARGS=50              [MAX.NO.OFARGSAFUNCTIONCAN TAKE  
#LOWER  
TRAP  BRN      TRAP1
#PROGRAM
#CUE           %BSAVE   
#              RTAP AND FNAP COMPILE TO :-  
#                    CALL  1  SAVE  
#                             N    [SAVE SPACE RELATIVE TO P
#              WITH X3=ADDRESS OF ROUTINE OR FUNCTION   
#              AND X4=RESULT IF ANY 
      ANDX  2  '#17777777'  
      NGN   0  2
      BXE   0  2(3),TRCE
SAVE  LDX   0  2                   [SAVE  P  IN X0 TO STORE LATER   
      ADX   2  0(1)                [SET   P 
      ANDX  2  '#17777777'  
      ADN   1  1                   [SET   L 
      STO   0  0(2)                [SAVE  P 
      STO   1  1(2)                [SAVE  L 
      TXL   2  CURKLOC             [TEST  CORE SIZE AGAINST P POINTER   
      BCS      *+3                 [AND   IF MORE CORE IS NEEDED
      CALL  1  %BKORE   
               2                   [WITH  PARAMETER 2   
      LDN   1  0                   [SET   X1=0, INDICATES STACK LINKAGE 
      LDX   0  TRAP 
      EXIT  3  0                   [ENTER BCPL FUNCTION/ROUTINE 
TRCE  LDX   0  2
      ADX   2  0(1) 
      ANDX  2  '#17777777'  
      STO   3  MAXARGS+4(2)        [ STORE PARAMETER FOR 'REPORTCALL'   
      ADN   1  1
      STO   1  1(2) 
      ORX   0  '#40000000'  
      STO   0  0(2) 
      LDX   3  GVEC+RPCALL  
      CALL  1  SAVE 
               MAXARGS+2
      LDX   3  MAXARGS+4(2)            [ HOPE THIS WAS NOT OVERWRITTEN  
      EXIT  3  0                       [ ENTER FUNCTION 
#CUE           %BRETURN 
#              RTRN AND FNRN COMPILE TO :-  
#                    BRN      RETURN
#              WITH X4=RESULT IF ANY
      LDX   0  0(2) 
      BNG   0  TRACE
#CUE           RETURN   
RETN  ANDX  2  '#17777777'  
      LDX   1  1(2) 
      LDX   2  0(2) 
      EXIT  1  0
TRACE STO   4  4(2) 
      ANDX  0  '#17777777'  
      STO   0  0(2) 
      LDX   3  GVEC+RPRETURN
      CALL  1  SAVE 
               2
      BRN      RETN 
TRAP1 LDX   3  GVEC+RPMISSINGFN 
      EXIT  3  0
#END
PLAN(CR)
#PROGRAM      BCPL/%BSAVE   
#              RTAP AND FNAP COMPILE TO :-  
#                    CALL  1  %BSAVE
#                             N    [SAVE SPACE RELATIVE TO P
#              WITH X3=ADDRESS OF ROUTINE OR FUNCTION   
#              AND X4=RESULT IF ANY 
#DEFINE        RPCALL=50
#DEFINE        RPRETURN=51  
#DEFINE        RPMISSINGFN=52   
#LOWER         COMMON/%BGLOBALVEC/GVEC  
#LOWER         COMMON/%BSYSDATA/
               MINCLOC,SETCLOC,MAXCLOC,CURCLOC,CURKLOC  
#LOWER  
TRAP  BRN      TRAP1
#PROGRAM
      ANDX  2  '#17777777'          [THIS IS A FUDGE
      LDX   0  2                   [SAVE  P  IN X0 TO STORE LATER   
      ADX   2  0(1)                [SET   P 
      ANDX  2  '#17777777'  
      ADN   1  1                   [SET   L 
      STO   0  0(2)                [SAVE  P 
      STO   1  1(2)                [SAVE  L 
      TXL   2  CURKLOC             [TEST  CORE SIZE AGAINST P POINTER   
      BCS      *+3                 [AND   IF MORE CORE IS NEEDED
      CALL  1  %BKORE              [CALL  KORE  ROUTINE 
               2                   [WITH  PARAMETER 2   
      LDN   1  0                   [SET   X1=0, INDICATES STACK LINKAGE 
      LDX   0  TRAP 
      EXIT  3  0                   [ENTER BCPL FUNCTION/ROUTINE 
#CUE           %BRETURN 
#CUE           RETURN   
#              RTRN AND FNRN COMPILE TO :-  
#                    BRN      %BRETURN  
#              WITH X4=RESULT IF ANY
#              'RETURN' USED BY SYSTEM ROUTINES 
      ANDX  2  '#17777777'  
      LDX   1  1(2)                [RESET L 
      LDX   2  0(2)                [RESET P 
      EXIT  1  0                   [RETURN  
TRAP1 LDX   3  GVEC+RPMISSINGFN 
      EXIT  3  0
#END
PLAN(CR)
#PROGRAM       BCPL/%BBASICIO   
#LOWER         COMMON/%BIODATA/ 
               START,LENGTH,LUNA,NFBA,ENVIRONMENT   
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
#CUE           %BIOPSTOP           [ CLOSES ALL CHANNELS
      STO   1  LINK 
      STO   2  PSAVE
      LDX   2  START
      ADX   2  LENGTH   
PNXTN TXU   2  LUNA 
      BCC      PEXIT
      SBN   2  1
      LDX   3  0(2)                [ POINTER VALUE  
      BZE   3   PNXTN              [POINTER=0 -> NODE CLOSED
      LDX   0  10(3)               [SWITCHWORD  
      ANDN  0  1                   [READ PERMIT BIT 
      BNZ   0  *+4  
      CALL  1  ENDREAD  
      LDN   3  2
      BRN      *+3  
      CALL  1  ENDWRITE 
      LDN   3  2
      BRN      PNXTN
PEXIT LDX   1  LINK 
      LDX   2  PSAVE
      BZE   1  RETURN   
      EXIT  1  0
#PROGRAM
COND  STO   3  NODE 
      LDX   2  START               [X2=N=NODE   
      ADX   2  LENGTH   
      LDX   7  START               [X7=NEXT FREE BUFFER SPACE   
NXTN  TXU   2  LUNA 
      BCC      CEXIT
      SBN   2  1
      LDX   3  0(2)                [POINTER VALUE   
      BZE   3  NXTN                [POINTER = 0 -> STREAM CLOSED:DELETE 
      LDX   5  3                   [X5 = MOVE DISPLACEMENT  
      SBX   5  7
      SBS   5  4(3)                [ RESET POINTERS IN NODE 
      SBS   5  7(3) 
      SBS   5  8(3) 
      SBS   5  13(3)
      LDX   6  3
      LDX   3  0(3) 
      MOVE  6  0(3) 
      BZE   5  NOMVE
      STO   7  0(2)                [ RESET POINTER. 
NOMVE ADX   7  3                   [ INCREMENT NEXT FREE BUFFER 
      BRN      NXTN 
CEXIT STO   7  NFBA 
      LDX   3  NODE 
      EXIT  1  0
#LOWER  
CLOSE          262/#1000,0,0
CLOSM          261/#1007,0  
               261/#1000,0  
#PROGRAM
#              %BENDREAD AND %BENDWRITE  ASSUME X3 = NODE   
#CUE           %BENDREAD
      STO   1  ELINC
      LDX   0  11(3)               [EXIT IF ALREADY CLOSED  
      BNG   0  EEXIT
      LDX   0  6(3)                [X0=UNIT NUMBER  
      LDX   1  1(3)                [X1=256+TYPE (REPLACED X)
      SRL   1  15   
      TXU   1  '262'
      BCC      ENDED
      TXU   1  '261'
      BCC      ENDMT
      ALLOT 0  512(1)              [REPLACED X TEST ALLOT   
      LDX   2  9                   [BEFORE DISENGAGE & RELEASE  
      BNG   2  ENDS 
      DIS   0  0(1)                [DISENGAGE - MAKE OPS WORK   
      REL   0  0(1)                [RELESE - I DON'T WANT IT ANY MORE   
      BRN      ENDS 
#CUE           %BENDWRITE   
      STO   1  ELINC
      LDX   0  11(3)               [EXIT IF ALREADY CLOSED  
      BNG   0  EEXIT
      LDX   0  6(3)                [X0=UNIT NUMBER  
      LDX   1  1(3)                [X1=256+TYPE (REPLACED X)
      SRL   1  15   
      TXU   1  '262'
      BCC      ENDED
      TXU   1  '261'
      BCC      ENDMT
      ALLOT 0  512(1)              [REPLACED X TEST ALLOT   
      LDX   2  9                   [BEFORE RELEASE  
      BNG   2  ENDS 
      REL   0  0(1)                [RELEASE - I DON'T WANT IT ANY MORE  
      BRN      ENDS 
ENDED PERI  0  CLOSE
      BRN      ENDS 
ENDMT LDCT  1  #004 
      ANDX  1  10(3)
      BZE   1  *+2  
      LDN   1  2
      PERI  0  CLOSM(1) 
      BRN      ENDS 
ENDS  NGN   0  1                   [SET STREAM CLOSED   
      STO   0  11(3)
#              NOW FIND NODE POINTER FOR THIS NODE,AND SET IT TO ZERO   
      LDX   1  START
      ADX   1  LENGTH   
      LDX   0  1
      SBX   0  LUNA                [ X0 = NUMBER OF NODES CREATED   
LOOPA BZE   0  ERROR               [ NOT FOUND  
      SBN   1  1
      TXU   3  0(1)                [DOES X1 POINT TO NODE POINTER FOR X3
      BCC      FND                 [YES - NODE POINTER FOUND
      SBN   0  1
      BRN      LOOPA
ERROR SUSWT    2HE  
      BRN      *-1  
FND   STOZ     0(1)                [CLOSE NODE  
      CALL  1  COND 
      LDX   1  ELINC
EEXIT LDX   1  ELINC
      EXIT  1  0
#PAGE   
#LOWER               COMMON/%BGLOBALVEC/
               GVEC(39) 
               0/INITI  
               0/PRESE  
               GVEC1(4) 
               0/ENDWR  
               0/ENDRE  
               GVEC2(2) 
               0/EOSMO  
#PROGRAM
#CUE           INITIALIZEI         [OVEC;   
INITI LDX   4  2(2) 
      LDX   5  3(2) 
      ADN   5  1
      STO   4  START
      STO   5  LENGTH   
SETP  ADX   5  4
      STO   5  LUNA 
      STO   4  NFBA 
      BRN      RETURN   
#CUE           PRESETIO 
PRESE LDX   4  START
      LDX   5  LENGTH   
      BRN      SETP 
#CUE           ENDREAD  
#              ENDREAD,ENDWRITE TAKE NODE-POINTERS AS ARGUMENTS 
ENDRE STO   1  ELINK
      STO   2  EPSAVE   
      BNZ   1  ENTE 
      LDX   3  2(2)                [X3=NODE - PRESERVE  
ENTA  LDX   3  0(3)                [POINTER VALUE   
      BZE   3  RET                 [RETURN IF ALREADY CLOSED
      CALL  1  %BENDREAD
      BRN      RET  
#CUE           ENDWRITE 
ENDWR STO   1  ELINK
      STO   2  EPSAVE   
      BNZ   1  ENTF 
      LDX   3  2(2) 
ENTB  LDX   3  0(3)                [POINTER VALUE   
      BZE   3  RET                 [ ALREADY CLOSED 
      LDX   4  EOSCHLOC            [ SET X4 = ENDSTREAMCH   
      CALL  10 12(3),1             [AND SEND IT TO DEVICE HANDLER   
RET   LDX   2  EPSAVE   
      LDX   1  ELINK
      BZE   1  RETURN   
      EXIT  1  1
ENTE  OBEY     0(1) 
      LDX   3  0(3) 
      BRN      ENTA 
ENTF  OBEY     0(1) 
      LDX   3  0(3) 
      BRN      ENTB 
#CUE           EOSMOD   
EOSMO LDX   3  2(2) 
      LDX   3  0(3) 
      LDCT  0  #004 
      ORS   0  10(3)
      BRN      RETURN   
#CUE           %BNN                [ NULL DEVICE HANDLER
#              ???  REVISE  ??? 
      NULL  
      NULL  
      LDX   4  EOSCHLOC 
      EXIT  1  0
#CUE           %BNW                [ FOR UNWRITTEN ROUTINES 
      NULL  
      NULL  
      CALL  1  %BIOPSTOP
      SUSWT    2HNW 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       BCPL/%BBASICPERI    [ PHERALS;   
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(41) 
               0/CREAT             [ EOUTPUT
               GVEC1(6) 
               0/FINDI             [ NPUT   
#LOWER         COMMON/%BIODATA/ 
               START,LENGTH,LUNA,NFBA   
#LOWER  
NNULL          17,-1,-1,-1,-1,-1,0,0,0,0
               #74000003,-1,0/%BNN,0,0,4H****   
               16   
NTR            17,256/2,0,128,0,-1,0,0,0,0  
               #74000002,3,0/%BTR,0,32,4H****   
               16   
NTP            17,257/0,0,128,0,-1,0,0,0,128
               #74000001,3,0/%BTP,0,32,4H****   
               16   
NLP            17,258/0,0,121,0,-1,0,0,0,120
               #74000001,1,0/%BLP,0,31,4H****   
               16   
NCR            17,259/0,0,80,0,-1,0,0,0,0   
               #74000002,1,0/%BCR,0,20,4H****   
               16   
NCP            17,260/0,0,80,0,-1,0,0,0,80  
               #74000001,1,0/%BCP,0,21,4H****   
               16   
#LOWER  
MAX            5                   [NUMBER OF TYPES+1   
NODES          0/NNULL  
               0/NTR
               #400/NTP 
               #400/NLP 
               0/NCR
               #400/NCP 
LABEL          0/FILL              [ NULL   
               0/FILL              [ TR 
               0/FILL              [ TP 
               0/FILP              [ LP 
               0/FILL              [ CR 
               0/FICP              [ CP 
#PROGRAM
#CUE           FINDINPUT
FINDI LDN   7  0                   [X7 GIVES ENTRY  
      BRN      *+2  
#CUE           CREATEOUTPU         [ T; 
CREAT LDX   7  '#40000000'  
      STO   1  LINK 
      STO   2  PSAVE
      BNZ   1  ENTE 
      LDX   1  2(2)                [ PARAMETER  
ENTA  DVS   0  '10'                [X1:=TYPE,X0:=UNIT   
      BNG   1  *+3                 [ TYPE < 0   
      TXL   1  MAX  
      BCS      *+2                 [ TYPE > MAX 
      NGN   1  1                   [ INVALID TYPE   
      ADN   1  1
      LDX   3  NODES(1) 
      ERX   3  7
      BPZ   3  *+3  
      LDN   1  0                   [TYPE/ENTRY WRONG
      LDX   3  NODES(1) 
      LDX   4  NFBA                [ FREE SPACE 
      LDX   2  0(3)                [ NODE SIZE  
      MOVE  3  0(2)                [ MOVE NODE  
      LDX   3  NFBA 
      STO   0  6(3) 
      ADX   2  NFBA                [ X2 -> BUFFER   
      STO   2  8(3)                [ MAY OVERWRITE  
      STO   2  7(3)                [  "    "   "
      STO   2  4(3)                [  "    "   "
      STO   2  13(3)              [ FIXED   
      ADX   2  14(3)
      STO   2  NFBA 
      SBX   2  3                   [ COMPUTE LENGTH 
      STO   2  0(3)                [ AND STORE IN NODE  
      LDX   2  LUNA 
      SBN   2  1
      STO   2  LUNA                [X2 = NODE POINTER   
      STO   3  0(2)                [ SET POINTER
      TXL   2  NFBA 
      BCS      OV                  [ OUT OF SPACE   
      LDX   2  LABEL(1) 
      EXIT  2  0
#              CODE FOR FILLING IN NODES OF EACH TYPE   
FILP  LDCT  4  #600                [ CHAR.MOD (3)   
      ORS   4  4(3)                [ PERI ADDRESS   
FICP  LDN   4  1
      ADS   4  7(3)                [ RECORD ADDRESS 
      ADS   4  8(3) 
      LDCT  2  #600 
      ORX   2  13(3)               [CH.MOD  
      LDN   4  #51                 [ CONTROL CH.
      DCH   4  0(2)                [ DROP INTO BUFFER   
      LDX   1  7(3)                [ RECORD START   
      LDX   0  '4H    ' 
      STO   0  0(1)                [ DROP INTO RECORD   
      LDN   0  0(1) 
      ADN   1  1
      LDX   3  14(3)               [ BUFFER LENGTH  
      SBN   3  2                   [ MOVE LENGTH
      MOVE  0  0(3)                [ BLANK FILL 
      BRN      EXIT 
FILL  BRN      EXIT 
OV    CALL  1  %BIOPSTOP
      SUSWT    2HE* 
      BRN      *-1  
EXIT  LDX   2  PSAVE
      LDX   1  LINK 
      LDX   4  LUNA 
      BZE   1  RETURN   
      EXIT  1  1
ENTE  OBEY     0(1) 
      LDX   1  0(3) 
      BRN      ENTA 
#END
PLAN(CR)
#PROGRAM       BCPL/READCH  
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(47) 
               0/READC  
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
               ISO1,ASCII1,ISO2,ASCII2  
#LOWER  
SW1   BRN      RETN 
      BRN      R1S                 [SINGLE SHIFT CODE   
      BRN      R1S                 [SINGLE SHIFT CODE   
      BRN      R3S                 [THREE  SHIFT CODE   
#PROGRAM
READC STO   1  LINK 
      STO   2  PSAVE               [SAVE P  
      BNZ   1  ENTE 
      LDX   3  3(2)                [PARAMETER 2 
      STO   3  LVCH 
      LDX   3  2(2)                [PARAMETER 1 
#              X3=ADDRESS OF NODE   
ENTA  LDX   3  0(3) 
       BZE   3  RETE                [ CLOSED
      NGN   0  5                   [USET R/W FLAG   
      ANDX  0  10(3)
      STO   0  10(3)
      ANDN  0  2                   [CHECK CAN READ THIS STREAM  
      BNZ   0  READ 
RETN  LDN   4  0
      BRN      RET4 
RET   TXU   4  ISO1 
      BCS      *+3  
      LDX   4  ASCII1   
      BRN      *+4  
      TXU   4  ISO2 
      BCS      *+2  
      LDX   4  ASCII2   
RET4  LDX   3  LVCH                [RETURN THE ASCII CHARACTER IN X4
      STO   4  0(3) 
      LDX   2  PSAVE
      LDX   1  LINK 
      BZE   1  RETURN   
      EXIT  1  2
#PAGE   
READ  LDX   0  11(3)               [CHECK STREAM TYPE   
      BPZ   0  *+3                 [-1=CLOSED,0=OFF 
RETE  LDX   4  EOSCHLOC            [STREAM IS CLOSED
      BRN      RET4 
      BZE   0  RETN                [SUPRESS TRANSFER - RETURN NULL  
      LDX   0  9(3)                [CALL READ ROUTINE IF COUNT=0
      BNZ   0  *+7  
      CALL  10 12(3),0             [LENGTH=4
#              RECORD NOW READ? 
#              IF X4 IS NON-NEGATIVE RETURN THE 
#              ASCII CHARACTER IN X4 IMMEDIATLY 
      BNG   4  READ 
      BRN      RET4 
      LDX   0  11(3)               [CHECK STREAM TYPE   
#      SMO      SW1    [ ORIGINAL WAS   
      EXIT  0  SW1      [ EXIT  0  SW1  
#              GET NEXT CHARACTER SUBROUTINE, LINK=X7, RESULT IN X4 
GNCH  LDX   1  8(3)                [GET CHARACTER POINTER   
      LDCH  4  0(1)                [GET CHARACTER   
      BCHX  1  *+1                 [INCREMENT AND STORE 
      STO   1  8(3)                [CHARACTER POINTER   
      LDN   1  1                   [DECREMENT CHARACTER COUNT   
      SBS   1  9(3) 
      INVTZ 4                      [INVERT ZONE 
      EXIT  7  0                   [EXIT. LINK WAS X7, USED X1, RESULTX4
R1S   CALL  7  GNCH 
      ADN   4  #40  
      BRN      RET  
#PAGE   
R3S   CALL  7  GNCH 
      TXL   4  '#74'               [SHIFT CHARACTER?
      BCS      R3NS 
R3SS  TXL   4  '#76'               [DELTA SHIFT CHARACTER?  
      BCC      RDDI 
      DCH   4  10(3)               [ALPHA OR BETA SHIFT CH. 
      NGN   0  9                   [SET DELTA INDICATOR OFF 
      ANDS  0  10(3)
      BRN      READ 
RDDI  TXU   4  '#76'
      BCS      READ 
RDD   LDN   0  8                   [SET DELTA INDICATOR 
      ORS   0  10(3)
      BRN      READ 
R3NS  LDN   0  8
      ANDX  0  10(3)
      BNZ   0  RDDC                [BRANCH IF IN DELTA SHIFT
      LDCH  0  10(3)               [GET CURRENT SHIFT CHARACTER 
      SLL   0  5                   [GENERATE +VE CONVERSION FACTOR  
      ANDX  0  4                   [X0=0  IF ALPHA OR 0-/,ELSE 32   
      ADN   0  32                  [X0=32 IF ALPHA OR 0-/,ELSE 64   
      ADX   4  0                   [CONVERT CODE
      BRN      RET  
RDDC  NGN   0  9                   [SET DELTA INDICATOR OFF 
      ANDS  0  10(3)
      TXL   4  '#40'               [CONTROL CHARACTER   
      BCS      RET4 
      TXL   4  '#64'               [NOT VALID   
      BCS      RETN 
      TXL   4  '#70'               [ALPHA IN DELTA CHARACTER
      BCS      RDDA 
      TXL   4  '#74'
      BCS      RDDB 
      BRN      R3SS 
RDDB  ADN   4  #34  
RDDA  ADN   4  #50  
      BRN      RET  
ENTE  OBEY     1(1) 
      LDX   3  0(3) 
      STO   3  LVCH 
      LDX   1  LINK 
      OBEY     0(1) 
      LDX   3  0(3) 
      BRN      ENTA 
#END
PLAN(CR)
#PROGRAM       BCPL/WRITECH 
#LOWER         COMMON/%BGLOBALVEC/  
               GVEC(44) 
               0/WRTCH  
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
               ISO1,ASCII1,ISO2,ASCII2  
#LOWER  
SW1   BRN      RETN 
      BRN      W1S  
      BRN      W1S  
      BRN      W3S  
#PROGRAM
WRTCH STO   1  LINK 
      STO   2  PSAVE               [SAVE P  
      BNZ   1  ENTE 
      LDX   4  3(2)                [PARAMETER 2 
      ANDN  4  #377 
      STO   4  CH   
      LDX   3  2(2)                [PARAMETER 1 
ENTA   LDX   3  0(3)
      BZE   3  RETE 
      LDX   0  10(3)               [SET R/W FLAG
      ORN   0  4
      STO   0  10(3)
      ANDN  0  1                   [CHECK CAN WRITE THIS STREAM 
      BNZ   0  WRITE
RETN  STOZ     CH   
RET   LDX   4  CH   
RET4  LDX   1  LINK 
      LDX   1  LINK 
      BZE   1  RETURN   
      EXIT  1  2
#PAGE   
WRITE LDX   0  11(3)               [CHECK STREAM TYPE   
      BPZ   0  *+3                 [-1=CLOSED, 0=OFF
RETE  LDX   4  EOSCHLOC            [STREAM IS CLOSED
      BRN      RET4                [RETURN EOSCH
      BNZ   0  *+3                 [SUPRESS WRITE   
      TXU   4  EOSCHLOC            [IF STREAM SUPRESSED AND 
      BCS      RETN                [CH IS NOT EOSCH 
      LDX   0  7(3) 
      TXU   0  8(3) 
      BCS      *+5                 [ SUSBY IF RECORD EMPTY  
      CALL  10 12(3),2             [LENGTH=4,  SUSBY ???? ????  
      TXU   4  EOSCHLOC            [CALL DEVICE HANDLER IF FE CHARACTER 
      BCC      WFECH
      TXL   4  '#16'
      BCC      WDC  
      TXL   4  '#10'               [CALL DEVICE HANDLER IF FE CHARACTER 
      BCS      WDC  
WFECH CALL  10 12(3),1             [LENGTH=4, FE CHARACTER  
      BPZ   4  RET                 [IF X4<0 TRANSMIT CH AS ANY OTHER
      LDX   4  CH   
WDC   TXU   4  ASCII1   
      BCS      *+3  
      LDX   4  ISO1 
      BRN      *+4  
      TXU   4  ASCII2   
      BCS      *+2  
      LDX   4  ISO2 
      STO   4  CCH  
      LDX   0  11(3)               [CHECK STREAM TYPE   
#      SMO      SW1      [ ORIGINAL WAS 
      EXIT  0  SW1      [ EXIT  0  SW1  
#PAGE   
#              PUT NEXT CHARACTER SUBROUTINE, LINK=X7   
PNCH  LDX   1  9(3)                [CHECK COUNT AND 
      BNZ   1  *+5                 [CALL DEVICE HANDLER IF ZERO 
      CALL  10 12(3),0             [LENGTH=4 - PRESERVE X7, CT=0
      LDX   1  8(3)                [GET CHARACTER POINTER   
      INVTZ 4                      [INVERT ZONE 
      DCH   4  0(1)                [DEPOSIT CHARACTER   
      BCHX  1  *+1                 [INCREMENT AND STORE 
      STO   1  8(3)                [CHARACTER POINTER   
      LDN   1  1                   [DECREMENT CHARACTER COUNT   
      SBS   1  9(3) 
      EXIT  7  0                   [EXIT. LINK WAS X7, USED X01,
W1S   TXL   4  '#40'               [UNPRINTABLE? RETURN 
      BCS      RET4 
      TXL   4  '#140'   
      BCS      *+2  
      SBN   4  #40  
      SBN   4  #40                 [CONVERT TO S1900 AND DEPOSIT
      CALL  7  PNCH 
      TXU   4  '#20'               [S1900 ' '   
      BCC      RET  
      LDX   7  '#77677777'         [UNSET FLAG IF CHARACTER WAS NOT ' ' 
      ANDS  7  10(3)
      BRN      RET  
W3DP  LDN   4  #76                 [LINK=X6, PUTS DELTA AND CH-X5   
      CALL  7  PNCH 
      LDX   4  CCH  
      SBX   4  5
      CALL  7  PNCH 
      EXIT  6  0
W3SCW LDCH  0  10(3)               [LINK=X6, PUTS SHIFT(X5) IF NECESSARY
      TXU   0  5
      BCC      *+5  
      LDX   4  5
      DCH   4  10(3)
      CALL  7  PNCH 
      LDX   4  CCH  
      EXIT  6  0
W3S   TXL   4  '#40'               [CONTROL CHARACTER   
      BCC      W3NCT
      LDN   5  #0                  [HAVE CONTROL CHARACTER  
      CALL  6  W3DP 
      BRN      RET  
W3NCT TXL   4  '#100'              [HAVE SPACE TO DELETE
      BCC      W3ABS
      SBN   4  #40                 [HAVE SPACE TO ? 
      CALL  7  PNCH 
      BRN      RET  
#PAGE   
W3ABS TXL   4  '#140'              [HAVE @ TO DELETE
      BCC      W3BS 
W3AS  TXL   4  '#134'              [HAVE @ TO y 
      BCC      W3ADS
      LDN   5  #74                 [HAVE @ TO [ 
      CALL  6  W3SCW
      SBN   4  #40  
      CALL  7  PNCH 
      BRN      RET  
W3BS  TXL   4  '#174'              [HAVE UNDERLINE TO DELETE
      BCC      W3BDS
      LDN   5  #75                 [HAVE UNDERLINE TO N1
      CALL  6  W3SCW
      SBN   4  #100 
      CALL  7  PNCH 
      BRN      RET  
W3ADS LDN   5  #50                 [HAVE $ TO y 
      BRN      *+2  
W3BDS LDN   5  #104                [HAVE N2 TO DELETE   
      CALL  6  W3DP 
      BRN      RET  
ENTE  OBEY     1(1) 
      LDX   4  0(3) 
      ANDN  4  #377 
      STO   4  CH   
      LDX   1  LINK 
      OBEY     0(1) 
      LDX   3  0(3) 
      LDX   4  CH   
      BRN      ENTA 
#END
PLAN(CR)
#PROGRAM       /%BTR
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
      BRN      *+3  
      SUSWT    2HE# 
      BRN      *-1  
      STO   1  LINK 
      LDX   7  10(3)
      SRL   7  12   
      ANDN  7  #77  
      LDN   0  #20  
      ANDX  0  7
      BNZ   0  TREOS
      LDX   6  6(3)                [X6=UNIT NUMBER  
      LDX   0  7
      ANDN  0  1
      BNZ   0  TRRDT               [READ A LINE 
      ALLOT 6  256                 [REPLACED X TR ALLOT 
      LDX   5  9
      BPZ   5  *+3  
      SUSWT    2HTR 
      BRN      *-4  
      STO   5  5(3)                [STORE REPLY 
      LDX   5  '#10000'            [SET ALLOTED INDICATOR   
      ORS   5  10(3)
TRRDT STOZ     2(3)                [ZERO REPLY WORD 
      PERI  6  1(3) 
      LDX   5  2(3)                [TEST IF NEED SUSBY  
      BPZ   5  *+2  
      SUSBY 6  256                 [REPLACED X SUSBY IF NEED BE 
      LDCT  5  32   
      ANDX  5  2(3) 
      BNZ   5  TRERR
#PAGE   
      LDN   5  #177 
      ANDX  5  2(3)                [X5= REMAINDER COUNT 
      TXU   5  '126'               [CHECK FOR FE2 ONLY  
      BCS      *+11                [BRANCH IF >2 CHARACTERS IN CORE 
      LDX   5  7                   [SKIP IF B10 OF W10 OF NODE ON   
      ANDN  5  2
      BNZ   5  *+7  
      LDX   2  4(3)                [CHECK FOR FE2   
      LDX   5  0(2) 
      SRL   5  12   
      ANDN  5  #7777
      SBN   5  #7632               [READ ANOTHER LINE IF LINE EMPTY 
      BZE   5  TRRDT               [AND B10 OF W10 OF NODE OFF  
      LDN   5  126                 [RESET REMAINDER COUNT   
      NGX   5  5                   [X5=-REMAINDER COUNT 
      ADN   5  128                 [X5=NUMBER OF CHARACTERS READ
      STO   5  9(3)                [STORE COUNT 
      LDX   5  7(3)                [RESET CHARACTER POINTER 
      STO   5  8(3) 
      LDX   5  '#20000'                                     [STOP BLANK 
      ORS   5  10(3)                                        [LINE SKIPS 
      LDN   5  #74                 [SET CURRENT SHIFT TO ALPHA  
      DCH   5  10(3)
      LDX   2  4(3)                [SET START OF BUFFER IN X2   
      LDX   6  15(3)
      TXU   6  0(2) 
      BCS      *+6  
      LDN   0  #40  
      ANDX  0  7
      BZE   0  TREOS
      LDCT  0  #002 
      ORS   0  10(3)
      NGN   4  1
EXIT  LDX   1  LINK 
      EXIT  1  0
TREOS CALL  1  %BENDREAD
      LDX   4  EOSCHLOC 
      BRN      EXIT 
TRERR NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2HE0 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       BCPL/%BTPLPCP
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#LOWER         S(8) 
#LOWER  
TABLE          0,6,12,15,35,60,72,75,80,96,120,160,160  
SW1   BRN      CTZE 
      BRN      FECH 
      BRN      SUSP 
SW2   BRN      FE0                 [BACKSPACE   
      BRN      FE1                 [TAB 
      BRN      FE2                 [NEWLINE 
      BRN      FE3                 [LINEFEED
      BRN      FE4                 [FORMFEED
      BRN      FE5                 [CARRIGE RETURN  
#PROGRAM
#CUE           %BTP 
      BRN      TP0  
      BRN      TP1  
      BRN      TP2  
#CUE           %BLP 
      BRN      LP0  
      BRN      LP1  
      BRN      LP2  
#CUE           %BCP 
      BRN      CP0  
      BRN      CP1  
      BRN      CP2  
TP0   LDN   0  0
      BRN      *+4  
TP1   LDN   0  1
      BRN      *+2  
TP2   LDN   0  2
      STO   2  PSAVE
      LDN   2  1
      BRN      ENT  
LP0   LDN   0  0
      BRN      *+4  
LP1   LDN   0  1
      BRN      *+2  
LP2   LDN   0  2
      STO   2  PSAVE
      LDN   2  2
      BRN      ENT  
CP0   LDN   0  0
      BRN      *+4  
CP1   LDN   0  1
      BRN      *+2  
CP2   LDN   0  2
      STO   2  PSAVE
      LDN   2  4
      BRN      ENT  
#PAGE   
#MACRO  
      PFCCS    N                   [USES X01, SETS PFCC 
      LDN   0  N
      LDX   1  13(3)
      STO   0  0(1) 
#MACRO  
      DCHX  X  N
      LDX   X  N
      SLC   X  2
      SBN   X  1
      SRC   X  2
      STO   X  N
#PROGRAM
ENT   SAVEX    S
#      SMO      SW1      [ ORIGINAL WAS 
      EXIT  0  SW1        [ EXIT  0  SW1
SUS   LDX   6  6(3)                [LINK=X0, X6=UNIT NUMBER, X1=TYPE+256
      LDX   1  1(3) 
      SRL   1  15   
      SUSBY 6  0(1) 
      EXIT  0  0
ALOT  LDX   0  10(3)
      ANDX  0  '#10000' 
      BNZ   0  ALOK+2   
      LDX   0  6(3) 
      LDX   1  1(3) 
      SRL   1  15   
      ALLOT 0  0(1) 
      LDX   0  9
      BPZ   0  ALOK 
      SBN   1  257  
      BNZ   1  *+3  
      SUSWT    2HTP 
      BRN      ALOT+3   
      SBN   1  1
      BNZ   1  *+3  
      SUSWT    2HLP 
      BRN      ALOT+3   
      SBN   1  2
      BNZ   1  *+3  
      SUSWT    2HCP 
      BRN      ALOT+3   
      SUSWT    2HUP 
      NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2H   
      BRN      *-1  
#PAGE   
ALOK  STO   0  5(3)                [STORE REPLY 
      LDX   0  '#10000' 
      ORS   0  10(3)
      EXIT  6  0
SPFB  LDX   2  '4H    '            [LINK=X0, USES X123, RESTORES X3 
      LDX   1  7(3)                [X1=ADDRESS START DATA PART OF BUFFER
      STO   2  0(1)                [SET FIRST WORD TO SPACES
      LDN   2  1(1)                [SET SECOND X REG FOR MOVE   
      LDX   3  14(3)               [GET BUFFER LENGTH   
      SBN   3  2                   [CALCULATE MOVE LENGTH   
      MOVE  1  0(3)                [SPACE FILL BUFFER   
      LDX   3  S+3                 [RESTORE NODE INTO X3
      EXIT  0  0
OUTP  CALL  6  ALOT 
      LDX   6  6(3) 
      STOZ     2(3)                [ZERO REPLY WORD 
      PERI  6  1(3)                [REPLACED X PERI 
      LDX   1  2(3)                [CHECK IF NEED TO SUSBY  
      BPZ   1  *+2  
      CALL  0  SUS                 [SUSBY IF NEED BE
      LDCT  1  32                  [CHECK FOR TRANSFER ERROR
      ANDX  1  2(3) 
      BNZ   1  PEERR               [PERIPHERAL ERROR
      CALL  0  SPFB                [SPACE FILL BUFFER   
      LDCT  0  #001 
      ORS   0  10(3)
      EXIT  7  0
EXIT  RESTX    S
      LDX   2  PSAVE
      EXIT  1  0
SUSP  LDX   6  2(3) 
      BPZ   6  EXIT 
      CALL  0  SUS  
      BRN      EXIT 
FECH  LDN   0  1
      TXU   0  S+2  
      BCC      FECHT
#              LP OR CP DROP THROUGH
      TXU   4  EOSCHLOC 
      BCC      EOS  
      SBN   4  #10  
#      SMO      SW2      [ ORIGINAL WAS 
      EXIT  4  SW2        [ EXIT  4  SW2
#PAGE   
FE0   LDCT  0  #001 
      ANDX  0  10(3)
      BNZ   0  *+2  
      CALL  7  OUTP 
      LDX   0  14(3)
      SBN   0  1
      SLL   0  2
      TXU   0  9(3) 
      BCS      *+2  
      BRN      EXIT 
      PFCCS    #40  
      LDN   0  1                   [INCREMENT REMAINDER COUNT   
      ADS   0  9(3) 
      DCHX  0  8(3)                [DECREMENT CHARACTER POINTER 
      BRN      EXIT 
FE2   CALL  7  OUTP 
      PFCCS    #41  
SNL   LDX   0  14(3)               [RESET COUNT 
      SBN   0  1
      SLL   0  2
      STO   0  9(3) 
      LDX   0  7(3)                [RESET CHARACTER POINTER 
      STO   0  8(3) 
      BRN      EXIT 
FE5   LDCT  0  #001 
      ANDX  0  10(3)
      BNZ   0  SNL  
      CALL  7  OUTP 
      PFCCS    #40  
      BRN      SNL                 [AS FE2 BUT SAME LINE
FE3   CALL  7  OUTP 
      PFCCS    #41                 [NEWLINE, NO POINTERS RESET  
      BRN      EXIT 
FE4   CALL  7  OUTP 
      PFCCS    #51                 [PAPERTHROW  
      BRN      EXIT 
#PAGE   
FE1   NGN   1  1                   [THE NASTY ONE :- TAB
      LDN   1  0(1) 
      ORX   1  '#60000000'  
      LDX   4  8(3) 
      ANDX  4  1
      SLC   4  2
      LDX   5  7(3) 
      ANDX  5  1
      SLC   5  2
      SBX   4  5                   [X4= 0-ORIG. CH NO OF NEXT CH
      LDN   1  TABLE
      LDN   6  12   
      TXL   4  0(1) 
      BCS      *+4  
      ADN   1  1
      SBN   6  1
      BNZ   6  *-4  
      LDX   5  0(1)                [X5= 0-ORIG. CH NO OF CH AFTER TAB   
      LDX   6  14(3)
      SBN   6  1
      SLL   6  2
      TXL   6  5
      BCC      *+2                 [TAB PAST END OF LINE TREATED AS 
      LDX   5  4                   [TAB  TO  END OF LINE
#              X4=NEXT CH, X5=REQUIRED NEXT CH  
      SBX   4  5                   [X4=INCREMENT TO COUNT - IS -VE  
      SRC   5  2                   [X5=REQUIRED NEXT CH REL BUFFER START
      ADX   5  7(3)                [X5=REQUIRED NEXT CHARACTER  
      STO   5  8(3)                [SET CHARACTER POINTER   
      ADS   4  9(3)                [ADJUST COUNT
      BRN      EXIT 
FECHT TXU   4  EOSCHLOC 
      BCC      EOST 
      CALL  2  FENT 
      BRN      EXIT 
CTZE  LDN   0  1
      TXU   0  S+2  
      BCS      FE2                 [LP OR CP ONLY BRANCH HERE   
      BRN      CTZET
#PAGE   
OUTPT CALL  6  ALOT 
      LDX   5  9(3) 
      SBS   5  3(3) 
      ADX   5  3(3) 
      LDX   6  6(3) 
      STOZ     2(3) 
      LDX   0  3(3) 
      BZE   0  *+2  
      PERI  6  1(3) 
      LDX   1  2(3) 
      BPZ   1  *+2  
      CALL  0  SUS  
      LDCT  1  32   
      ANDX  1  2(3) 
      BNZ   1  PEERR
      STO   5  3(3) 
      STO   5  9(3) 
      LDX   1  7(3) 
      STO   1  8(3) 
      LDN   0  #74  
      DCH   0  10(3)
      EXIT  7  0
CTZET CALL  7  OUTPT
      BRN      EXIT 
#MACRO  
      NOCH  X  N
      LDX   X  3(3) 
      SBN   X  N
      STO   X  9(3) 
#PROGRAM
FENT  CALL  7  OUTPT
      LDX   1  4(3) 
      LDX   0  4
      ORN   0  #7620
      SLL   0  12   
      STO   0  0(1) 
      NOCH  0  2
      CALL  7  OUTPT
      EXIT  2  0
#PAGE   
EOST  LDCT  0  #004 
      ANDX  0  10(3)
      BNZ   0  RELT 
      LDN   4  #12                 [=NL 
      CALL  2  FENT 
      LDN   0  16   
      ORS   0  1(3) 
      NOCH  0  72   
      CALL  7  OUTPT
      NGN   0  17   
      ANDS  0  1(3) 
      NOCH  0  72   
      LDX   0  15(3)
      LDX   1  7(3) 
      STO   0  0(1) 
      LDN   0  0(1) 
      ADN   1  1
      MOVE  0  17   
      LDN   4  #12  
      CALL  2  FENT 
      CALL  2  FENT+1   
      CALL  2  FENT+1   
      NOCH  0  72   
      LDN   0  16   
      ORS   0  1(3) 
      CALL  7  OUTPT
      NOCH  0  72   
      CALL  7  OUTPT
RELT  CALL  1  %BENDWRITE   
      BRN      EXIT 
#PAGE   
EOS   LDCT  0  #005                [ CHECK WHETHER LINE BLANK OR
      ANDX  0  10(3)               [ TERMINATOR NOT TO BE WRITTEN   
      BNZ   0  REL  
      CALL  7  OUTP                [ EMPTY BUFFER   
REL   CALL  1  %BENDWRITE   
      BRN      EXIT 
PEERR LDX   1  1(3) 
      SRL   1  15   
      DISP     #4500(1) 
      NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2HE? 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       /%BCR
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
      BRN      *+3  
      SUSWT    2HE# 
      BRN      *-1  
      STO   1  LINK 
      LDX   7  10(3)
      SRL   7  12   
      ANDN  7  #77  
      LDX   0  7
      ANDN  0  4
      BZE   0  CRRD                [READ A CARD 
      LDX   0  '#77737777'         [0->READ INDICATOR   
      ANDS  0  10(3)
      LDN   4  #12                 [ =NL = *N = 
  ETC.
      BRN      EXIT 
CRRD  LDN   0  #20  
      ANDX  0  7
      BNZ   0  CREOS
      LDX   6  6(3)                [X6=UNIT NUMBER  
      LDX   0  7
      ANDN  0  1
      BNZ   0  CRRDC
      ALLOT 6  259                 [REPLACED X CR ALLOT 
      LDX   5  9
      BPZ   5  *+3  
      SUSWT    2HCR 
      BRN      *-4  
      STO   5  5(3)                [STORE REPLY 
      LDX   5  '#10000'            [SET ALLOTED INDICATOR   
      ORS   5  10(3)
CRRDC STOZ     2(3)                [ZERO REPLY WORD 
      PERI  6  1(3) 
      LDX   5  2(3)                [TEST IF NEED TO SUSBY   
      BPZ   5  *+2  
      SUSBY 6  259                 [REPLACED X CR SUSBY IF NEED BE  
      LDCT  5  32   
      ANDX  5  2(3) 
      BNZ   5  CRERR
#PAGE   
      LDX   2  4(3)                [SET START OF BUFFER IN X2   
      LDX   5  15(3)               [CHECK FOR TERMINATOR IN FIRST WORD  
      TXU   5  0(2) 
      BCS      *+6  
      LDN   0  #40  
      ANDX  0  7
      BZE   0  CREOS
      LDCT  0  #002 
      ORS   0  10(3)
      ADX   2  14(3)
      SBN   2  1
      LDX   5  '4H    ' 
      TXU   5  0(2) 
      BCS      CRNSP
      TXU   2  4(3) 
      BCC      *+3  
      SBN   2  1
      BRN      *-5  
      LDX   0  7                   [READ ANOTHER CARD IF CARD BLANK 
      ANDN  0  2                   [AND B10 OF W10 OF NODE OFF  
      BZE   0  CRRDC
      BRN      *+2                 [COUNT WOULD OTHERWISE BE 4  
CRNSP ADN   2  1
      SBX   2  4(3) 
      SLL   2  2
      STO   2  9(3)                [STORE COUNT 
      LDX   5  7(3)                [RESET CHARACTER POINTER 
      STO   5  8(3) 
      LDX   5  '#60000'            [1->READ INDICATOR -     [STOP BLANK 
      ORS   5  10(3)               [RETURN FE2 ON NEXT ENTRY[LINE SKIPS 
      NGN   4  1
EXIT  LDX   1  LINK 
      EXIT  1  0
CREOS CALL  1  %BENDREAD
      LDX   4  EOSCHLOC 
      BRN      EXIT 
CRERR NGN   0  1
      STO   0  11(3)
      CALL  1  %BIOPSTOP
      SUSWT    2HE3 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       /%BSSO   
#LOWER         DUMMY,S  
#LOWER         COMMON/%BIOCONST/
               EOSCHLOC 
#PROGRAM
      BRN      TTNN 
      BRN      FECH 
      EXIT  1  0
EOS   STO   0  S
      LDN   0  1
      NGS   0  11(3)
      BRN      *+4  
TTNN  STOZ     11(3)
      STO   0  S
      LDN   0  1
      ADS   0  9(3) 
      LDN   0  DUMMY
      STO   0  8(3) 
      LDX   0  S
      EXIT  1  0
FECH  TXU   4  EOSCHLOC 
      BCC      EOS  
      NGN   4  1
      EXIT  1  0
#END
PLAN(CR)
#PROGRAM       /%ROL
#LOWER  
INST  BRN      ERROR
#PROGRAM
      EXIT  1  1
      NULL  
      NULL  
      BRN      *+3  
      NULL  
      NULL  
      LDX   3  1(1) 
      DLA   3  INST 
      OBEY     INST 
ERROR SUSWT    2HEO 
      BRN      *-1  
#END
PLAN(CR)
#PROGRAM       /%BOVERLAY(DBM,15AM) 
#LOWER         COMMON/%AAOVDIR/ 
               L10(1)   
#LOWER         COMMON/%BSYSDATA/
               L18(4)   
               L1(1)
#LOWER         COMMON/%BGLOBALVEC/  
               G0(34)   
G34            /L16                     [ %BOVERLAY+34  
#LOWER  
L11            0                        [ 4H0000
               950272                   [ 4H3H00
#PROGRAM
#CUE           %BSAVE(4)
      LDX   0  2                        [ 4H0002
      ADX   2  0(1)                     [ 4H 500
      STO   0  0(2)                     [ 4H0B00
      ADN   1  1                        [ 4H<401
      STO   1  1(2)                     [ 4H8B01
      TXL   2  L1                       [ %BSYSDATA+4   
      BCC      L2                       [ %BOVERLAY+9   
      CALL  1  %BKORE   
      LDX   0  2                        [ 4H0002
L2    BZE   3  L3                       [ %BOVERLAY+13  
L6    BNG   3  L4                       [ %BOVERLAY+17  
L9    LDN   1  0                        [ 4H<000
      EXIT  3  0                        [ 4H+H00
L3    LDX   3  L5                       [ %BGLOBALVEC+52
      BNZ   3  L6                       [ %BOVERLAY+10  
L7    SUSWT    2545                     [ 4H74GQ
      BRN      L7                       [ %BOVERLAY+15  
L4    LDX   0  3                        [ 4H0003
      ANDX  0  '4161536'                [ 4H?X00
      BNZ   0  L8                       [ %BOVERLAY+22  
L12   ANDX  3  '-6291457'               [ 4HGyyy
      BRN      L9                       [ %BOVERLAY+11  
L8    SRL   0  15                       [ 4H4H ?
      LDX   1  0                        [ 4H8000
      LDX   0  L10(1)                   [ %AAOVDIR  
      STO   0  L11                      [  LP   
      LDN   1  L11                      [  LP   
      CALL  0  %ROL 
      ANDX  3  '-4161537'               [ 4HP7yy
      BRN      L12                      [ %BOVERLAY+20  
#CUE           %BRETURN(4)  
      ANDX  2  '4194303'                [ 4H?yyy
#CUE           RETURN(4)
      LDX   1  1(2)                     [ 4H8201
      LDX   2  0(2)                     [ 4H 200
      EXIT  1  0                        [ 4H;H00
L16   LDX   0  3(2)                     [ 4H0203
      SLL   0  15                       [ 4H4@ ?
      ORX   0  4(2)                     [ 4H1604
      LDN   1  L13                      [ %AAOVDIR+1
L15   LDX   4  0(1)                     [ 4H@100
      BZE   4  L14                      [ %BOVERLAY+44  
      TXU   0  4                        [ 4H1(04
      BCC      L14                      [ %BOVERLAY+44  
      ADN   1  2                        [ 4H<402
      BRN      L15                      [ %BOVERLAY+38  
L14   SBN   1  L10                      [ %AAOVDIR  
      LDX   4  1                        [ 4H@001
      ORN   1  256                      [ 4H=440
      SLL   1  15                       [ 4H<@ ?
      LDX   3  2(2)                     [ 4H(202
      ORS   1  0(3)                     [ 4H9G00
      BRN      RETURN   
#END
ENDPROG 
****
****
    
