TITLE   RDSCRN
      MODULE  RDSCRN
      AREADEF PROG,[CODE,PIC,READ],DOUBLE
      AREADEF DATA,[PIC],DOUBLE
      DEFSB   DATA
      EXPORTC RDSCRN
      IMPORTC info='File'.'GetFileInformation',load='File'.'LoadFile'
      AREA    DATA
BTim  ALLOCD  2
FLoad ALLOCD  1
FExec ALLOCD  1
FLeng ALLOCD  1
FAttr ALLOCD  1
FDat  EQU     FLoad
Start ALLOCD  1
stmd1 DCD     62080
stmd2 DCD     21120
Mode  ALLOCB  1              ;MODE
Packd ALLOCB  1              ;1 for packed screen, 0 for straight dump
      AREA    PROG
RDSCRN ; ('file',MODE,BUF,ERR)
      SPRD    FP,TOS
      LPRD    FP,12(SP)
      MOVD    4(0(FP)),TOS    ;length of 'file'
      MOVD    0(0(FP)),TOS    ;address of 'file'
      ADDR    BTim,TOS        ;BTim result
      ADDR    FDat,TOS        ;File data result
      CXP     info            ;get file info
      CMPQD   0,R0
      BGT     err1            ;failed to get file info
      MOVD    0(4(FP)),R0     ;mode
      CMPQD   0,R0
      BGE     err4
      CMPQD   2,R0
      BLO     err4
      MOVD    R0,Mode
      MOVD    8(FP),R1        ;address of IBUF
      ADDD    stmd1-4[R0:D],R1
      MOVD    R1,Start        ;store starting location for unpacked buffer
      CMPW    =#X2F00,FLoad
      BNE     chk1
      CMPW    =#X5100,FLeng   ;packed record, check it is not too long
      BLO     err2
      MOVQB   1,Packd
      MOVD    8(FP),TOS       ;load at start of buffer
      BR      chk2
chk1  CMPW    =#X3000,FLoad   ;straight screen dump, check load point
      BNE     err2
      CMPW    =#X5000,FLeng   ;check length
      BNE     err2
      MOVQB   0,Packd
      MOVD    Start,TOS       ;load at "Start"
chk2  MOVD    FLeng,TOS       ;length of file
      MOVD    4(0(FP)),TOS    ;length of 'file'
      MOVD    0(0(FP)),TOS    ;address of 'file'
      CXP     load            ;load file
      CMPQD   0,R0
      BGT     err1            ;failed to load file
      MOVD    8(FP),R4        ;address of buffer
      CMPQB   0,Packd
      BEQ     sprd            ;straight screen dump
      MOVD    R4,R2
      ADDD    FLeng,R2        ;end of packed screen
      MOVD    Start,R5        ;beginning of unpacked screen
      ADDR    #X5000(R5),R1   ;end of unpacked screen
u1    ADDQD   -2,R2
      MOVB    0(R2),R3        ;byte to store
      MOVB    1(R2),R0        ;count of bytes
      ADDQB   -1,R0
u2    ADDQD   -1,R1
      MOVB    R3,0(R1)        ;store byte
      ADDQB   -1,R0
      BCS     u2              ;loop over bytes to store
      CMPD    R4,R2
      BGE     u3              ;finished
      CMPD    R5,R1           ;check the unpacked buffer for overflow
      BLT     u1              ;OK
      BR      err3            ;overflow
u3    BGT     err3            ;odd # bytes in input
      CMPD    R5,R1
      BNE     err3            ;wrong # bytes in unpacked screen
sprd  MOVD    Start,R2        ;Start of screen
      ADDR    @31,R7
      ADDQB   -2,Mode
      BCS     mode2
m11   MOVQD   7,R6            ;count of y in row
m12   ADDR    @79,R5          ;count of x
m13   MOVB    R2[R5:Q],R3     ;byte to decode
      ROTB    =4,R3           ;exchange nibbles
      MOVQD   3,R0            ;count of output bytes
      MOVQD   0,R1            ;initialize output bytes
m14   TBITB   =3,R3
      SFSB    R1              ;extract more significant bit
      ADDB    R3,R3           ;shift input byte, overflow into carry bit
      ADDCB   R1,R1           ;insert less significant bit
      ROTD    =-8,R1          ;move to next output byte
      ADDQD   -1,R0
      BCS     m14             ;loop over 4 output bytes
      MOVD    R1,R4[R5:D]     ;store 4 bytes
      ADDQD   -1,R5
      BCS     m13             ;loop over 80 input x-bytes
      ADDQD   1,R2            ;address of next input y
      ADDR    320(R4),R4      ;address of next output row
      ADDQD   -1,R6
      BCS     m12             ;loop over y in 'text' row
      ADDR    632(R2),R2      ;address of next 'text' row
      ADDQD   -1,R7
      BCS     m11             ;loop over 'text' rows
      BR      mfin            ;return
mode2                         ;entered with carry flag set
m21   MOVQD   7,R6            ;count of y in row
m22   ADDR    @79,R5          ;count of x
m23   MOVB    R2[R5:Q],R3     ;byte to decode
      MOVQB   0,R0            ;initialize 1st byte
      MOVQB   0,R1            ;initialize 2nd byte
      ADDCB   R3,R3           ;shift data-byte, inserting 1 in least sig bit
m24   ADDCB   R0,R0           ;insert bit into 1st byte
      ADDB    R3,R3           ;shift data byte
      ADDCB   R1,R1           ;insert bit into 2nd byte
      ADDB    R3,R3           ;shift data byte
      CMPQB   0,R3
      BNE     m24             ;loop until data byte is empty
      MOVB    R0,R4[R5:W]     ;store 1st byte
      MOVB    R1,1(R4)[R5:W]  ;store 2nd byte
      ADDQD   -1,R5
      BCS     m23             ;loop over 80 input x-bytes
      ADDQD   1,R2            ;address of next input y
      ADDR    160(R4),R4      ;address of next output row
      ADDQD   -1,R6
      BCS     m22             ;loop over y in 'text' row
      ADDR    632(R2),R2      ;address of next 'text' row
      ADDQD   -1,R7
      BCS     m21             ;loop over 'text' rows
mfin  MOVQD   0,R0            ;no error
done  MOVD    R0,0(12(FP))     ;store ERR
      LPRD    FP,TOS
      RXP     4               ;return
err1  MOVQD   1,R0
      BR      done
err2  MOVQD   2,R0
      BR      done
err3  MOVQD   3,R0
      BR      done
err4  MOVQD   4,R0
      BR      done
      END