Retro1.org codex

PROC FSEFILE;
BEGIN
 
 
#
***       FSEFILE -- SUBROUTINES FOR FILE ACCESS.
*
*         COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
*
*         FSEFILE HAS THE ROUTINES TO TEST THE ATTRIBUTES OF
*         VARIOUS LOCAL FILES.  THIS IS THEREFORE USED ONLY FOR
*         THE SINGLE-USER VERSION OF FSE AND IS NOT PROGRAMMED
*         REENTRANTLY.  THIS MODULE IS A CANDIDATE FOR FUTURE
*         OVERLAY STRUCTURING.  IT MAY BE USED BY THE FSEMAIN MODULE
*         AND THE FILCMD MODULE ONLY.
#
 
  DEF LISTCON #0#;
 
CONTROL EJECT;                         # UNIVERSAL DECLARES          #
 
*IFCALL SINGLE,COMFSGL
*IFCALL ONLY,COMFONL
*IFCALL MULTI,COMFMLT
*CALL COMFFSE
 
                             # EXTERNALS         #
 
 
XDEF
  BEGIN
*CALL COMFXFL
  END
 
XREF ARRAY MAXADDR;;         # KEY ADDRESSES IN BUFFER SEGMENT #
XREF ARRAY WORKBUF;;
 
XREF PROC FASTRLC;
 
XREF
  BEGIN
  PROC PF;
  PROC FILINFO;
  PROC READ;
  PROC READC;
  PROC REWIND;
  PROC FLDLEN;
  PROC RTIME;
  PROC TTLIN;
  PROC TTSTR;
  PROC VDTCLO;
  PROC VDTOPN;
  PROC VDTPRT$;                      # PROMPT ON/OFF #
  END
 
XREF
  BEGIN
*CALL COMFXSB
*CALL COMFXSC
*CALL COMFXED
*CALL COMFXWK
  END
 
                             # COMMON DATA       #
 
*CALL COMFDS1
*CALL COMFVD2
*CALL COMFDS2
*CALL COMSPFM
PAGE                         # HERE WE GO        #
 
 
FUNC MSEQUIP(NAME) B;
  BEGIN
#
**        MSEQUIP - TEST FILE ATTRIBUTES FOR MASS STORAGE.
*
*         ENTRY  NAME - NAME OF FILE TO INSPECT.
*
*         EXIT   MSEQUIP - TRUE IF ALREADY ON MASS STORAGE OR IF
*                    ANTICIPATED TO BE ON MASS STORAGE BY DEFAULT.
*                    OTHERWISE FALSE.
*
*         CALLS  GETINFO, TRIMNAME.
*
*         NOTE   ASSUMES CORRECT DEFINITION OF DEFAULT NAMES
*                FOR INPUT AND OUTPUT FILES.
#
  ITEM NAME C(7);
 
  FILINFSTAT = 0;
  IF B<0,42>NAME EQ 0 THEN
    BEGIN
    MSEQUIP=FALSE;
    RETURN;
    END
  MSEQUIP=TRUE;
  GETINFO(NAME);
  IF FILINFSTAT EQ 0 THEN
    BEGIN
    IF TRIMNAME(NAME) EQ DEFINPNAM THEN MSEQUIP=FALSE;
    IF TRIMNAME(NAME) EQ DEFOUTNAM THEN MSEQUIP=FALSE;
    END
  ELSE
    BEGIN
    IF NOT (FILINFRMS AND FILINFREAD) THEN MSEQUIP=FALSE;
    END
  END                        # OF MSEQUIP        #
 
FUNC TTEQUIP(NAME) B;
  BEGIN
#
**        TTEQUIP - TEST FILE ATTRIBUTES FOR TERMINAL.
*
*         ENTRY  NAME - FILE TO TEST.
*
*         EXIT   TTEQUIP - TRUE IF FILE ALREADY ASSIGNED TO TERMINAL
*                    EQUIPMENT, OR IF ANTICIPATED TO BE SO ASSIGNED
*                    BY DEFAULT.  OTHERWISE FALSE.
*
*         CALLS  GETINFO, TRIMNAME.
*
*         NOTE   ASSUMES CORRECT DEFINITION OF DEFAULT NAMES FOR
*                INPUT AND OUTPUT FILES.
#
  ITEM NAME C(7);
  TTEQUIP=FALSE;
  IF B<0,42>NAME EQ 0 THEN RETURN;
  GETINFO(NAME);
  IF FILINFSTAT EQ 0 THEN  # NOT EXIST         #
    BEGIN
    IF TRIMNAME(NAME) EQ DEFINPNAM THEN TTEQUIP=TRUE;
    IF TRIMNAME(NAME) EQ DEFOUTNAM THEN TTEQUIP=TRUE;
    END
  ELSE                     # FILE ALREADY EXIST          #
    BEGIN
    IF FILINFTTY THEN TTEQUIP=TRUE;
    END
  END                        # OF TTEQUIP        #
 
 
FUNC WRITEABLE(NAME) B;
  BEGIN
#
**        WRITEABLE - TEST FILE FOR NON-READ-ONLY DISK.
*
*         ENTRY  NAME - FILE TO INSPECT.
*
*         EXIT - WRITEABLE - TRUE IF AND ONLY IF FILE IS ON
*                    MASS STORAGE AND HAS NO ACCESS RESTRICTIONS.
*
*         CALLS  MSEQUIP.
*
*         NOTE   CODING ASSUMES GETINFO WILL BE CALLED FOR THIS
*                FILE NO LATER THAN COMPLETION OF MSEQUIP.
#
  ITEM NAME C(7);
  WRITEABLE=FALSE;
  IF MSEQUIP(NAME) THEN
    BEGIN
    WRITEABLE=FILINFWRIT;
    IF FILINFSTAT EQ 0 THEN WRITEABLE=TRUE;
    END
  END                       # OF WRITEABLE      #
 
 
FUNC LOCALFILE(NAME) B;
  BEGIN
#
**        LOCALFILE - TEST FILE ATTRIBUTES FOR LOFT.
*
*         ENTRY  NAME - FILE TO INSPECT.
*
*         EXIT   LOCALFILE - TRUE IF AND ONLY IF FILE IS ON
*                    MASS STORAGE, HAS WRITE PERMISSION, AND IS OF
*                    LOCAL FILE TYPE.
*
*         CALLS  WRITEABLE.
*
*         NOTE   ASSUMES GETINFO IS CALLED BY WRITEABLE.
#
  ITEM NAME C(7);
  LOCALFILE=FALSE;
  IF WRITEABLE(NAME) THEN
    BEGIN
    IF FILINFFT EQ 0
      OR FILINFFT EQ 6 THEN LOCALFILE=TRUE;
    END
  END                       # OF LOCALFILE      #
 
 
PROC GETINFO(NAME);
  BEGIN
#
**        GETINFO - INTERFACE TO FILINFO MACRO.
*
*         ENTRY  NAME - FILE TO PROCESS.
*
*         EXIT   FILINFPARMS ARRAY IS FILLED IN.
*
*         CALLS  TRIMNAME, FILINFO.
#
  ITEM NAME C(7), NEWNAME C(7);
  NEWNAME=TRIMNAME(NAME);
  FILINFNAME=NEWNAME;
  FILINFO(FILINFPARMS);
  END                         # OF GETINFO        #
 
 
FUNC ASSGNFILE(NAME) B;
  BEGIN
#
**        ASSGNFILE - TEST FILE FOR FNT ASSIGNMENT.
*
*         ENTRY  NAME - FILE TO INSPECT.
*
*         EXIT   ASSGNFILE - TRUE IF AND ONLY IF THIS JOB HAS
*                    AN FNT FOR THE FILE.
*
*         CALLS  GETINFO.
#
  ITEM NAME C(7);
  ASSGNFILE=FALSE;
  IF B<0,42>NAME EQ 0 THEN RETURN;
  GETINFO(NAME);
  IF FILINFSTAT NQ 0 THEN ASSGNFILE=TRUE;
  END                         # OF ASSGNFILE      #
 
 
PROC VFYFILE(NAME,MODE);
  BEGIN
#
**        VFYFILE - VERIFY FILE AS LEGAL TO BE EDITED.
*
*         ENTRY  NAME - FILE TO INSPECT.
*                MODE - POSITIVE IMPLIES USE ERRJUMP FOR FAILURES,
*                    NEGATIVE IMPLIES ABORT THE JOB STEP VIA MORTAL.
*
*         EXIT   TO CALLER IF FILE IS LEGAL, OTHERWISE TO
*                SPECIFIED ERROR ROUTINE WITHOUT RETURN.
*
*         CALLS  ERRJUMP, MORTAL, ERROR(INTERNAL), COMPARE(INTERNAL).
#
  ITEM NAME C(7), MODE I;
 
  PROC ERROR(STR);
    BEGIN
    ITEM STR C(40);
    IF MODE GQ 0 THEN ERRJUMP(STR);
    MORTAL(STR);
    END
 
  PROC COMPARE(PARM);
    BEGIN
    ITEM PARM C(7), NAME1 C(7), NAME2 C(7);
    NAME1=TRIMNAME(NAME);
    NAME2=TRIMNAME(PARM);
    IF NAME1 EQ NAME2 THEN ERROR("RESERVED FILE$");
    END
 
  COMPARE(INPTNAM);
  COMPARE(OUTPNAM);
  COMPARE(WORKNAM);
  COMPARE("ZZZMOVE");
  IF NOT MSEQUIP(NAME) THEN
    BEGIN
    IF FILINFSTAT NQ 0 AND FILINFRMS THEN
      BEGIN                          # IF FILE HAS NO READ PERMISSION #
      ERROR("FILE DOES NOT HAVE READ PERMISSION$");
      END
    ELSE
      BEGIN                          # IF FILE IS NOT ON DISK #
      ERROR("FILE MUST BE ON DISK$");
      END
    END
  END                         # OF VFYFILE        #
PAGE                         # FILE READ SUBROUTINE        #
 
 
PROC FILEREAD;
  BEGIN
#
**        FILEREAD - READ A LOCAL FILE INTO FILE IMAGE BRACKET.
*
*         NOTE THAT TO SAVE THE CPU OVERHEAD OF RELOCATING THE
*         POINTER STACKS FOR EVERY INSERTION, WE CALL WORKIO
*         DIRECTLY, THEN WE CALL RELOCATE TO CORRECT FOR BYPASSING
*         THE "INSY" INTERFACE.
*
*         NOTE THAT THE "USRBRK" FLAG IS CONTINUALLY CHECKED
*         TO DETECT AN EXTERNAL INTERRUPT.
*
*         ENTRY  FILNUM - WHICH BRACKET.
*                FILEFET - ALREADY INITIALIZED.
*                ASCII[FILNUM] - CHARACTER SET.
*
*         EXIT   NUMBERED[FILNUM] - WHETHER FILE REALLY NUMBERED.
*                FILEFET - AT EOI, OR INDETERINATE IF USER BREAK.
*
*         CALLS  READ, READC, CONVIN, GETLNUM, TRIMPAD, INS, FASTRLC.
*
*         USES   WIDTHFOUND.
#
  DEF  AVERAGE    #500#;             # AVERAGE FILE SIZE #
  DEF  TWOANAHALF #2500#;            # TWO AND A HALF SECONDS #
  ITEM LOOPCTL, RESULT, LASTNUM, ASCIITYPE, MAXL, RECYCLE, FIRSTPOS;
  ITEM ZERO=0;
  ITEM COUNTER    I;                 # LINE COUNTER #
  ITEM SAMPLE     I;                 # LINE SAMPLE RATE #
  ITEM STARTTIME  I;                 # REAL TIME CLOCK (START) #
  ITEM CHECKTIME  I;                 # REAL TIME CLOCK (CHECK) #
  IF SCREENMODE OR DONTPRINT OR NOT INTERACT
    OR READNAM EQ "FSEPROC" THEN
    BEGIN                            # IF NO MESSAGE SHOULD BE SENT #
    COUNTER = 0;
    END
  ELSE
    BEGIN                            # MESSAGE MAY BE SENT #
    COUNTER = 1;
    SAMPLE = AVERAGE;
    RTIME(STARTTIME);
    STARTTIME = B<24,36>STARTTIME;
    END
  REWIND(FILEFET,1);
  READ(FILEFET,0);
  FIRSTPOS=CURRENT;
  RESULT=0;
  MAXL=0;
  RECYCLE=0;
  LASTNUM=0;
  FOR LOOPCTL=LOOPCTL WHILE RESULT EQ 0 AND USRBRK EQ 0 DO
    BEGIN
    ASCIITYPE=ASCII[FILNUM];         # CHARACTER SET FOR FILE #
    LINE[0]=0;
    READC(FILEFET,TMPLIN,BUFWID2P1,RESULT);
    IF COUNTER NQ 0 THEN
      BEGIN                          # IF MESSAGE STILL TO ISSUE #
      COUNTER = COUNTER + 1;
      IF COUNTER GR SAMPLE THEN
        BEGIN                        # IF SAMPLE SIZE REACHED #
        RTIME(CHECKTIME);
        CHECKTIME = B<24,36>CHECKTIME - STARTTIME;
        IF CHECKTIME GR TWOANAHALF THEN
          BEGIN                      # IF ENOUGH TIME HAS PASSED #
          TTSTR("BUILDING: $");
          TTLFN(READNAM);
          TTLIN(" ONE MOMENT PLEASE$");
          COUNTER = 0;               # ONE MESSAGE IS ENOUGH #
          VDTCLO(COUNTER);           # FLUSH OUTPUT,NO RECALL #
          END
        ELSE
          BEGIN                      # COMPUTE PROBABLE SAMPLE COUNT #
          SAMPLE = (SAMPLE*TWOANAHALF)/CHECKTIME;
          END
        END
      END
    IF RESULT GR 0 THEN
      BEGIN
      ASCIITYPE=1;                   # CHARACTER SET FOR EORCON #
      TMPLINE[0]=EORCON;
      FILECODE=1;
      READ(FILEFET,1);
      IF FILECODE EQ O"31" THEN RESULT=-1;
      ELSE IF FILECODE NQ O"1031" OR FILEIN NQ FILEOUT THEN
        BEGIN
        RESULT=0;
        END
      END
    IF RESULT EQ -1 THEN
      BEGIN
      ASCIITYPE=1;                   # CHARACTER SET FOR EOFCON #
      RESULT=0;
      TMPLINE[0]=EOFCON;
      FILECODE=1;
      READ(FILEFET,0);
      END
    IF RESULT EQ 0 THEN              # PREPARE LINE OF TEXT #
      BEGIN
      MAXL=MAXL+1;                   # COUNT RELOCATION FACTOR     #
      CONVIN(LIN,ASCIITYPE);
      IF NUMBERED[FILNUM] NQ 0 THEN  # VERIFY/ADJUST SEQUENCE NUMBERS #
        BEGIN
        GETLNUM;
        IF LINENO LQ LASTNUM THEN    # FILE IS NOT REALLY SEQUENCED #
          BEGIN
          NUMBERED[FILNUM]=0;
          CHANGED[FILNUM]=0;         # TAKE BACK FLAG FOR ADJUSTMENTS #
          IF MAXL GR 1 THEN
            BEGIN
            REWIND(FILEFET,1);
            READ(FILEFET,0);
            POSZ(FIRSTPOS);
            RECYCLE=MAXL-1;
            MAXL=0;
            TEST LOOPCTL;
            END
          END
        ELSE                         # ADJUST SEQUENCING DIGITS #
          BEGIN
          IF WIDTHFOUND EQ NUMWIDTH THEN
            BEGIN                    # FIX INTERVENING BLANK #
            GETCHAR(LINE,NUMWIDTH,LINCTR);
            IF BLANKS NQ 0 AND LINCTR NQ CBLANK THEN
              BEGIN
              RSHIFT(LIN,NUMWIDTH,1);
              SETCHAR(LINE,NUMWIDTH,CBLANK);
              CHANGED[FILNUM]=1;     # FLAG THAT WE ADJUSTED TEXT #
              END
            END
          IF WIDTHFOUND GR 0 AND WIDTHFOUND LS NUMWIDTH
            AND NUMMODE EQ NUMST"PREFER" THEN
            BEGIN                    # ADJUST DIGITS #
            CHANGED[FILNUM]=1;       # FLAG THAT WE ADJUSTED TEXT #
            SETLNUM;
            GETLNUM;
            END
          END
        END
      LASTNUM=LINENO;
      TRIMPAD;
      IF RECYCLE NQ 0 THEN
        BEGIN
        ZERO = = P<LINEBUF>;         # POSITION INVISIBLY #
        FWDZ;                        # POSITION INVISIBLY #
        ZERO = = P<LINEBUF>;         # POSITION INVISIBLY #
        REP;
        RECYCLE=RECYCLE-1;
        END
      ELSE INS;
      END
    END
  FASTRLC(REGSTACK,MAXREG+1,CURRENT-MAXL+1,MAXL);
 
  END                          # OF FILEREAD       #
PAGE                         # ADDFILE CONTROLS FILEBUILD  #
 
 
PROC ADDFILE;
  BEGIN
#
**        ADDFILE - ADD AN EXTERNAL FILE TO INTERNAL FILES.
*
*         ENTRY  FILNUM - WHICH BRACKET.
*                READNAM - FILE NAME.
*                CHARPARM - CHARACTER SET PREFERENCE OR DEFAULT.
*                GETPARM - PERMANENT/LOCAL PREFERENCE OR DEFAULT.
*                ALLASCII - DEFAULT CHARACTER SET.
*                SMALLFIELD - WHETHER FIELD LENGTH NOW SMALL OR LARGE.
*                BOTC(FILECTL) - BRACKETS FILE DIRECTORY AREA.
*                TOPA(AUDITCTL) - BRACKETS AUDIT TRAIL.
*                NUMMMODE - WHAT TO DO WITH EMPTY FILE.
*                SCNFDINIT - 1 IF FILE IS INITIAL EDIT FILE,
*                            0 OTHERWISE.
*
*         EXIT   GETPARM - INDICATES WHETHER GET REALLY DONE.
*                LOCKED[FILNUM] - SET BY FILE ATTRIBUTES.
*                ASCII[FILNUM] - SET BY PARAMETER.
*                CHANGED[FILUM] - FALSE.
*                NUMBERED[FILNUM] - SET BY NUMMODE AND FILE CONTENT.
*                BOTC, TOPA - RELOCATED, ALSO VARIOUS OTHERS.
*                CURRENT, CURF(FILNUM) - TOP OF FILE.
*                FDLF(FILNUM) - UPDATED.
*                TOPF(FILNUM), BOTF(FILNUM) - BRACKET THE FILE.
*
*         USES   FILEFET, DSKSIZ, UTILFET.
*
*         CALLS  VFYFILE, FLDLEN, PAUSEIO, TRIMNAME, ASSGNFILE,
*                MAKEFET, GET, WRITEABLE, POSZ, FORMFDL, INSY,
*                FILEREAD, REWIND.
#
  ITEM NEWNAME C(7);
 
  VFYFILE(READNAM,0);
 
  IF SMALLFIELD THEN
    BEGIN
    FLDLEN(LOC(MAXADDR)+4);
    PAUSEIO;                   # DRAIN BUFFERS SO WE CAN ... #
    DSKSIZ=INIDSKSIZ;          # ... ENLARGE BUFFERS         #
    END
 
  NEWNAME=TRIMNAME(READNAM);
  IF GETPARM EQ 1 AND NOT ASSGNFILE(READNAM) THEN GETPARM=2;
  IF GETPARM EQ 2 THEN
    BEGIN
    PF("GET",READNAM,READNAM,"RC",PFMERROR,"EM",PFMMSG,"EL","40",0);
    IF PFMERROR EQ 0 THEN
      BEGIN                          # IF POSSIBLE CALL TO *CPUPFM* #
      IF SCREENMODE AND TABTYPHEAD[0] THEN
        BEGIN                        # IF RUNNING WITH TYPE AHEAD #
        VDTPRT$(0);                  # ASSURE PROMPT IS OFF #
        END
      END
    IF PFMERROR EQ FNF THEN
      BEGIN
      PF("ATTACH",READNAM,READNAM,"RC",PFMERROR,"M","W","NA","YES",
        "SR","NF","EM",PFMMSG,"EL","40",0);
      END
    IF PFMERROR NQ 0 THEN
      BEGIN
      C<0,18>ERRSTRING="USING LOCAL FILE -";
      C<18,40>ERRSTRING=C<0,40>PFMMSG;
      C<58,1>ERRSTRING="$";
      END
    END
  IF GETPARM GQ 2 THEN GETPARM=0;
  FILENAM[FILNUM]=NEWNAME;
  CHANGED[FILNUM]=0;
  LOCKED[FILNUM]=0;
  INITFILE[FILNUM]=SCNFDINIT;
  ASCII[FILNUM]=CHARPARM;
  IF CHARPARM EQ 0 AND ALLASCII THEN ASCII[FILNUM]=2;
  IF NOT WRITEABLE(READNAM) THEN LOCKED[FILNUM]=1;
  POSZ(BOTC(FILECTL)-1);
  FORMFDL(FILNUM);
  INSY;
  FDLF(FILNUM)=CURRENT;
 
  # NEW FILE BRACKET GOES BEFORE AUDIT TRAIL BRACKET #
  POSZ(TOPA(AUDITCTL)-1);
  TOPF(FILNUM)=CURRENT;
  MAKEFET(FILEFET,READNAM,FILEBUF,DSKSIZ);
  IF ASSGNFILE(READNAM) THEN
    BEGIN
    FILEREAD;
    REWIND(FILEFET,0);
    END
  LINE[0]=NULLIN;
  INSY;
  BOTF(FILNUM)=CURRENT;
 
  IF BOTF(FILNUM) EQ TOPF(FILNUM)+1 THEN
    BEGIN
    POSZ(TOPF(FILNUM));
    IF NUMMODE EQ NUMST"INTERPRET" THEN NUMBERED[FILNUM]=0;
    END
  ELSE POSZ(TOPF(FILNUM)+1);
  CURF(FILNUM)=CURRENT;
 
  IF SMALLFIELD THEN
    BEGIN
    PAUSEIO;                   # DRAIN BUFFERS SO WE CAN ... #
    DSKSIZ=DISKSIZE;           # ... SHRINK BUFFERS BACK     #
    FLDLEN(LOC(WORKBUF)+DSKSIZ+4);
    END
 
  END                         # OF ADDFILE     #
 
 
END TERM