* file$p --- connect SWT i/o to a Pascal file
*
*    declaration:
*
*             type name = array [1..7] of char;
*
*             procedure file$p (var f: text; n: name);
*                       extern;
*
*    calling sequence:
*
*             file$p (pascal_file_variable, 'swt_file');
*
*    entry    (arg 1) = address of Pascal file block.
*             (arg 2) = string containing SWT file name.
*
*    exit     file connected.

            SUBR     FILE$P

            SEG
            RLIT

include "=syscom=/keys.ins.pma"
include "=syscom=/errd.ins.pma"
include "=incl=/swt_def.s.i"
include "=incl=/lib_def.s.i"

            LINK
FILE$P      ECB      CONNECT,,FILE,2
            DATA     6,C'FILE$P'
            PROC

            DYNM     =20,FILE(3),NAME(3),CODE,ADDR(2),INDEX,UNIT
            DYNM     SUNIT,PUNIT,I,PATH(MAXPATH),TREE(MAXPATH)

FCB_FLAG          EQU   XB%+0
FCB_CUR_POS_PTR   EQU   XB%+1
FCB_BUF_SIZE      EQU   XB%+4
FCB_UNIT_NUM      EQU   XB%+6
FCB_NUM_OBJ       EQU   XB%+7
FCB_OBJ_SIZE      EQU   XB%+8
FCB_FILE_NAME     EQU   XB%+10
FCB_TOTAL_OBJ     EQU   XB%+74
FCB_BUFFER        EQU   XB%+75

CONNECT     ARGT                    transfer arguments
            ENTR     FILE$P

            EAL      CONNECTA       set address of first file name
            STL      ADDR

            LDX      =10            get number of SWT file names
            LDY      =2             get offset halfway through name

CONNECT1    LDL      ADDR,*         check first 4 characters of name
            SBL      NAME,*
            BCNE     CONNECT2       if not a match

            LDL      ADDR,*Y        check remainder of name
            ERL      NAME,*Y
            ANL      =-256L         clear last character
            BLEQ     CONNECT3       if a match

CONNECT2    LDL      ADDR           advance address to next entry
            ADL      =4L
            STL      ADDR
            BDX      CONNECT1       continue search

            CALL     ERRPR$         signal bad file name error
            AP       =K$NRTN,S
            AP       =E$BNAM,S
            AP       =0,S
            AP       =0,S
            AP       =C'FILE$P',S
            AP       =6,SL

CONNECT3    STX      INDEX          save loop index
            LDA      =10            calculate index into units
            SUB      INDEX          0 = STDIN, 1 = STDIN1, etc.
            TAX

            LDA      CONNECTB,X     set requested unit number
            STA      UNIT

            CALL     MAPSU          convert unit to SWT unit number
            AP       UNIT,SL
            STA      SUNIT

            CALL     FLUSH$         flush file buffer
            AP       SUNIT,SL

            CALL     MAPFD          convert unit to PRIMOS unit number
            AP       UNIT,SL
            STA      PUNIT

            BLE      CONNECT7       if file is not on disk

            CALL     ATTDEV         attach requested file
            AP       PUNIT,S
            AP       =7,S           select compressed disk file
            AP       PUNIT,S
            AP       =128,SL        buffer is 128 words

            EAXB     FILE,*         get address of file control block

            LDA      INDEX          see if file is input or output
            SUB      =6
            BCLT     CONNECT4       if file is a standard output

            LDA      =B'1110010000000000'    set input file values
            STA      FCB_FLAG

            CRA                     clear number of objects
            STA      FCB_NUM_OBJ

            JMP      CONNECT6

CONNECT4    LDA      =B'0111010000000000'    set output file values
            STA      FCB_FLAG

            LDA      =1             set number of objects to 1
            STA      FCB_NUM_OBJ

            LDA      =C'  '         blank fill the buffer
            LDX      =128
CONNECT5    STA      FCB_BUFFER-1,X
            BDX      CONNECT5

CONNECT6    LDA      PUNIT          set file unit number
            STA      FCB_UNIT_NUM

            JMP      CONNECT11

CONNECT7    EAXB     FILE,*         get address of file control block

            LDA      INDEX          see if file in input or output
            SUB      =6
            BCLT     CONNECT8       if file is a standard output

            LDA      =B'1110011000000000'    set input file value
            STA      FCB_FLAG

            CRA                     clear number of objects
            STA      FCB_NUM_OBJ

            JMP      CONNECT10

CONNECT8    LDA      =B'0111011000000000'    set output file values
            STA      FCB_FLAG

            LDA      =1             set number of objects
            STA      FCB_NUM_OBJ

            LDA      =C'  '         blank fill the buffer
            LDX      =128
CONNECT9    STA      FCB_BUFFER-1,X
            BDX      CONNECT9

CONNECT10   LDA      =1             set terminal file unit
            STA      FCB_UNIT_NUM


CONNECT11   EAL      FCB_BUFFER     get a pointer to the buffer
            STL      FCB_CUR_POS_PTR
            CRA                     clear bit offset
            STA      FCB_CUR_POS_PTR+2

            LDA      =256           initialize the buffer size
            STA      FCB_TOTAL_OBJ
            XCA
            STL      FCB_BUF_SIZE

            LDL      =1L            set object size to 1 byte
            STL      FCB_OBJ_SIZE

CLEAR_FNAME LDA      =C'  '         blank out the file name
            LDX      =64
CONNECT12   STA      FCB_FILE_NAME-1,X
            BDX      CONNECT12

GET_FNAME   CALL     GFNAM$         get the name of the file
            AP       UNIT,S
            AP       PATH,S
            AP       =MAXPATH,SL

            CAS      =ERR           did we get it?
            SKP
            JMP#     STORE_BAD_PATH    nope, store bad pathname

CHECK_TTY   CALL     PTOC           is the file
            AP       DEV_TTY,S      is connected to the
            AP       =PERIOD,S      terminal device ("/dev/tty") ?
            AP       TREE,S
            AP       =MAXPATH,SL

            CALL     EQUAL
            AP       PATH,S
            AP       TREE,SL

            CAS      =YES
            SKP
            JMP#     STORE_TTY

CHECK_NULL  CALL     PTOC           is the file
            AP       DEV_NULL,S     connected to the
            AP       =PERIOD,S      null device ("/dev/null") ?
            AP       TREE,S
            AP       =MAXPATH,SL

            CALL     EQUAL
            AP       PATH,S
            AP       TREE,SL

            CAS      =YES           Yes it is, Pascal doesn't
            SKP                     support I/O to /dev/null
            JMP#     STORE_TTY      use /dev/tty as filename


            CALL     MKTR$          it is a valid disk file
            AP       PATH,S
            AP       TREE,SL

            LDA      =1             store the file name into
            STA      I              the Pascal file control
            CALL     CTOP           block
            AP       TREE,S
            AP       I,S
            AP       FILE,*
            AP       FCB_FILE_NAME,S
            AP       =64,SL

            PRTN

STORE_TTY   CALL     MOVE$          store the TTY name into
            AP       TTY_PATH,S     the Pascal file control
            AP       FILE,*         block
            AP       FCB_FILE_NAME,S
            AP       =2,SL

            PRTN

STORE_BAD_PATH CALL  MOVE$          store the Bad Pathname message
            AP       BAD_PATH,S     into the Pascal file control
            AP       FILE,*         block
            AP       FCB_FILE_NAME,S
            AP       =9,SL

            PRTN

            LINK

CONNECTA    BCI      'STDIN  '      table of SWT file names
            BCI      'STDIN1 '
            BCI      'STDIN2 '
            BCI      'STDIN3 '
            BCI      'ERRIN  '
            BCI      'STDOUT '
            BCI      'STDOUT1'
            BCI      'STDOUT2'
            BCI      'STDOUT3'
            BCI      'ERROUT '

CONNECTB    DATA     STDIN          table of corresponding units
            DATA     STDIN1
            DATA     STDIN2
            DATA     STDIN3
            DATA     ERRIN
            DATA     STDOUT
            DATA     STDOUT1
            DATA     STDOUT2
            DATA     STDOUT3
            DATA     ERROUT

DEV_NULL    BCI      '/dev/null.'

DEV_TTY     BCI      '/dev/tty.'

BAD_PATH    BCI      'path unobtainable '

TTY_PATH    BCI      'TTY '

            END
