!Revision history:

! 001 19-Jul-88 PSR made output buffer look empty BEFORE writing so that an
!                   event 9 after disk full can be caught & the file closed
! 22-Jun-88 PSR Stopped upper-casing file names
!               Stppped creating output files
! 27-JAN-88 PSR Changes for Springboard (CON, NUL etc)
!             - added a "position fails" message to POSITON IO
! 08-Jul-87 PSR corrected setting dummy handlers on TT: SCBs
!             - corrested resetting EOF on terminal input on RESET INPUT

!
! >>> OPENS <<<
!
! All kinds of OPEN for Brasil
!
! Usage of SCB fields: User1 is the 'file handle' or channel number.
!                      User2 is a collection of flags.
!                      User3 chains together TTY output SCBs
!

%from IMP %include Formats, Streams, Buffers, SysSpecs, Mcode, Handcall, Depio
%externalbyteintegerspec Spring %alias "3L_SPRING"
%externalintegerfnspec File Size %alias "3L_IMP_FILE_SIZE"(%string(255) File)

%const %integer User2 Is a TTY = 1 << 0     {isatty is true for this FD}

!
! >> Fire Error <<
!
%routine Fire Error(%integer Sub Event, %string(255) Message)
   Event_Message = Message
   %signal 9, Sub Event, 0
%end

{#################################################}
{#################################################}
{###                                           ###}
{###   I N P U T   S I D E   R O U T I N E S   ###}
{###                                           ###}
{#################################################}
{#################################################}

!
! >> CLOSE INPUT <<
!
%external %routine Close Input %alias "3L___close_input"(%integer SS, Aban)
   %record(SCB Fm) %name S == Record(SS)
   %integer H = S_User1
   *MOV _ R0, #0       {close command}
   *LDR _ R1, H        {file handle}
   *STR _ R9, [Sp, #-4]!
   *SWI _ Brasil Open X
   *LDR _ R9, [Sp], #4
%end

!
! >> POSITION INPUT <<
!
%external %routine Position Input %alias "3L___position_input" -
                                 (%integer SS, Position)
   %record(SCB Fm) %name S == Record(SS)
   %integer H
   %label Ok
   H = S_User1
   %if H # 0 %start
      *MOV _ R0, #1        {write sequential pointer}
      *LDR _ R1, H         {file handle}
      *LDR _ R2, Position  {absolute file position}
      *STR _ R9, [Sp, #-4]!
      *SWI _ Brasil Args
      *LDR _ R9, [Sp], #4
      *BVC _ Ok
         Fire Error(3, "position fails")
   Ok:S_Next       = S_ThisB_Base
      S_Limit      = S_Next           {force a read}
      S_ThisB_Size = 0                {no chars in buffer}
   %finish
   S_Position   = Position
   S_Flags      = S_Flags&(\SCB Eof Pending)
%end

!
! >> RESET INPUT <<
!
%external %routine Reset Input %alias "3L___reset_input"(%integer SS)
   Position Input(SS, 0)
%end

{###################################################}
{###################################################}
{###                                             ###}
{###   O U T P U T   S I D E   R O U T I N E S   ###}
{###                                             ###}
{###################################################}
{###################################################}

%externalroutine MSDOS Break %alias "3L___msdos_break"
   {R1 = addr(SCB)}
   {R0 = Char}
   %record(SCBfm)%name S
   %integer Char

   *STR _ R0, Char
   *STR _ R1, S

   %if Char = NL %start
      %if S_Next >= S_Limit %start
         Call2(S_Buffer Handler, 13, Addr(S))
      %else
         Byte(S_Next) = 13  {CR}
         S_Next = S_Next+1
      %finish
  %finish
  %if S_Next >= S_Limit %start
     Call2(S_Buffer Handler, Char, Addr(S))
  %else
     Byte(S_Next) = Char
     S_Next = S_Next+1
  %finish
%end

%external %routine Break Character %alias "3L___break_character"
   {NOTE - this routine can only be called to output to the terminal}
   {R1 = addr(SCB)}
   {R0 = Char}
   %integer Char, A, Size, S
   %label L1

   {NOTE - there is ALWAYS room for ONE more character past the limit}

   *LDR _ R2, [R1]       {buffer pointer, S_Next}
   *STRB_ R0, [R2], #1   {insert terminator}
   *STR _ R2, [R1]       {update buffer pointer}

   *STR _ R1, S
   Flush TT Output(S)
%end

%routine Write Multiple(%record(SCBfm)%name S)
   %label OK, YY
   %integer H, A, Size
   Size = S_Next - S_ThisB_Base;  %return %if Size = 0
   S_Next = S_ThisB_Base                   {001 moved here to prevent}
   S_Limit = S_Next + S_ThisB_Size-1       {001 loops with DISK full}
   H    = S_User1
   A    = S_ThisB_Base
   *LDR   _ R1, H             {file handle}
   *MOV   _ R0, #2            {write command}
   *LDR   _ R2, A             {address of first byte to write}
   *LDR   _ R3, Size          {number of bytes to write}
   *STR   _ R9, [Sp, #-4]!
   *SWI   _ Brasil Multiple X
   *LDR   _ R9, [Sp], #4
   *BCS   _ YY
   *CMPS  _ R3, #0            {none left?}
   *BEQ   _ OK
   Event_Message = "file ".SCB Name(S)." full"
   %signal 9, 3, 0
YY:Event_Message = "failed to write to ".SCB Name(S)
   %signal 9, 3, 0
OK:
%end

%external %routine File Output Full %alias "3L___output_full"
   {R1 = addr(SCB)}
   {R0 = Char}
   %record(SCB Fm) %name S
   %integer Char, H, A, Size
   *STR _ R0, Char
   *STR _ R1, S
   Write Multiple(S)
   *LDR _ R0, Char
   *LDR _ R2, S
   *LDR _ R3, [R2]      {buffer pointer}
   *STRB_ R0, [R3], #1
   *STR _ R3, [R2]
%end

!
! >> RESET OUTPUT <<
!
%external %routine Reset Output %alias "3L___reset_output"(%integer SS)
   %record(SCB Fm) %name S == Record(SS)
   %integer H
   %label Ok
   H = S_User1
   *MOV _ R0, #1        {write sequential pointer}
   *LDR _ R1, H         {file handle}
   *MOV _ R2, #0        {absolute file position}
   *STR _ R9, [Sp, #-4]!
   *SWI _ Brasil Args
   *LDR _ R9, [Sp], #4
   *BVC _ Ok
      Fire Error(3, "reset output")
Ok:S_Next = S_ThisB_Base
%end

!
! >> CLOSE OUTPUT <<
!
%external %routine Close File Output %alias "3L___close_file" -
                             (%integer SS, Abandon)
   %record(SCB Fm) %name S == Record(SS)
   %integer H, A, Size
   H = S_User1
   Write Multiple(S)
   *MOV _ R0, #0       {close command}
   *LDR _ R1, H        {file handle}
   *STR _ R9, [Sp, #-4]!
   *SWI _ Brasil Open X
   *LDR _ R9, [Sp], #4
%end

%external %record(SCBfm)%map Open SCB %alias "3L___open_scb" -
                                (%string(255) Pure File, %integer RW, Fd, Size)
   !RW&1 =0 READ, =1 WRITE
   !RW&2 =0 TEXT, =2 BINARY

   %integer Sa, Mode, J
   %record(SCB Fm) %name S
   %string(255) File
   %label Bug Ok

   {first convert to upper case & strip spaces}
   File = ""
   %for J = 1, 1, Length(Pure File) %cycle
      Sa = Charno(Pure File, J)
      %if Sa # ' ' %start
         Sa = Sa-32 %if 'a' <= Sa <= 'z'
         File = File.Tostring(Sa)
      %finish
   %repeat

   %if Fd < 0 %start               {not given explicitly}
      %if File = "" %or -
          (Spring=0 %and File = "TT:") %or -
          (Spring#0 %and File = "CON") %start
         Fd = 0
      %else
         File = Pure File.Tostring(13)
         Sa = Addr(File)+1
         %if RW&1 = 0 %start       {open for read only}
            Mode = 16_40
         %else                     {open for write}
!            {BUG in ADFS - create it big enough!!!}
!            %unless Spring # 0 %or File Size(File) >= 16_40000 -
!                               %or Charno(File, Length(File)) = ':' %start
!               *MOV _ R0, #7          {create empty file}
!               *LDR _ R1, Sa
!               *MOV _ R4, #0
!               *MOV _ R5, #16_40000
!               *SWI _ Brasil File X
!               *BVC _ Bug Ok
!               Fire Error(3, "cannot create ". FileName)
!            %finish
!            {end of BUG}
   Bug Ok:  Mode = 16_80
            Size = Size+1          {a hole for newline}
         %finish
         *LDR   _ R0, Mode       {16_40 = Input, 16_80 = Output, 16_C0 = update}
         *LDR   _ R1, Sa         {address of string}
         *STR   _ R9, [Sp, #-4]!
         *SWI   _ Brasil Open X
         *LDR   _ R9, [Sp], #4
         *MVNVS _ R0, #0         {result = -1 on error}
         *STR   _ R0, Fd
         %if Fd <= 0 %start      {an error has occured}
            %if Mode = 16_40 %then Pure File = Pure File." for input" -
                             %else Pure File = Pure File." for output"
            Fire Error(3, "cannot open ".Pure File)
         %finish
      %finish
   %finish


   S == New SCB(Size)                                 {one extra for BREAK}
   S_User1 = Fd {the file handle}
   Set Object Name(S, Pure File)

   %if RW&1 = 0 %start                                {open for input}
      S_Limit      = S_Next                           {nothing in it for now}
      S_ThisB_Size = 0                                {buffer empty currently}
      %if FD = 0 %start                               {terminal input}
         S_User2 = S_User2 ! User2 Is a TTY
         S_Close    Handler = Addr 2(Dummy 2)
         S_Reset    Handler = Addr 1(Reset Input)
         S_Position Handler = Addr 2(Dummy 2)
         S_Buffer   Handler = Addr 0(TT Input Empty)
      %else                                           {file input}
         S_Close    Handler = Addr 2(Close Input)
         S_Reset    Handler = Addr 1(Reset Input)
         S_Position Handler = Addr 2(Position Input)
         %if RW&2 = 0 %start         {text input}
            S_Buffer   Handler = Addr 0(Input Empty)
         %else                       {binary input}
            S_Buffer   Handler = Addr 0(Binary Input Empty)
         %finish
      %finish
   %else                                                 {open for output}
      S_Limit = S_ThisB_Base + S_ThisB_Size-1            {onto final character}
      %if FD = 0 %start                                  {terminal output}
         S_User2 = S_User2 ! User2 Is a TTY
         S_Buffer   Handler = Addr 0(TT Output Full)
         S_Reset    Handler = Addr 1(Reset Output)
         S_Close    Handler = Addr 2(Close TT Output)
         S_Complete Handler = Addr 1(Flush TT Output)
         S_Breaks = NL+1                                 {break on NL}
         S_Break Handler = Addr 0(Break Character)
         Add TTY(S)
      %else                                              {file output}
         S_Buffer   Handler = Addr 0(File Output Full)
         S_Break    Handler = S_Buffer Handler           {for Pascal IO}
         S_Complete Handler = S_Buffer Handler
         S_Reset    Handler = Addr 1(Reset Output)
         S_Close    Handler = Addr 2(Close File Output)
         %if RW&2 = 0 %and Spring # 0 %start             {text output}
            S_Breaks        = NL+1
            S_Break Handler = Addr 0(MSDOS Break)
         %else %if Charno(File, Length(Pure File)) = ':' {break on NL}
            S_Breaks = NL+1
         %finish
      %finish
   %finish
   %result == S
%end