SUBROUTINE SYSLISTS_SETALIAS_SUB(VOLUME, ACCOUNT, PASSWORD, TABLE, ALIASNAME, OPTIONS)
$INSERT U2ATVARS
Declare Function DO_XSWAP
*#ADDED 1,2
*#SOURCE SYSPROCS

* MTR 12-6-06  Compiled for Arev32/OI80
*#CTO
*#Precompile
*
*#FLAVOR AREV32


































*÷ COMMON Variables  (Terminate with '%') :

*÷ LABELED COMMON Variables  (Terminate with '@') :

*÷ EQUATE Variables  (Terminate with '$') :

*$INSERT AREV_BP, COPYRIGHT

* This insert contains the copyright message.  This insert should be
* inserted into all programs.

Copy_%%_Right = 'Copyright (C) 1994 Revelation Technologies, Inc.'
* Source Date: 11:35:08  06 MAY 1994  Build ID: AREV_HR*3.1.39  Level: 3.13
*$insert arev_bp, logical
equ otherwise$  to 1
equ true$  to 1
equ false$  to 0
equ yes$  to 1
equ no$  to 0

* Source Date: 12:39:24  10 MAY 1994  Build ID: AREV_HR*3.1.41  Level: 3.13
*$INSERT AREV_BP, FILE.SYSTEM.EQUATES

* Advanced Revelation filing system action codes.

EQU READ.RECORD  TO 1
EQU READO.RECORD  TO 2
EQU WRITE.RECORD  TO 3
EQU DELETE.RECORD  TO 4
EQU LOCK.RECORD  TO 5
EQU UNLOCK.RECORD  TO 6

EQU SELECT  TO 7
EQU READNEXT  TO 8
EQU CLEARSELECT  TO 9

EQU CLEARFILE  TO 10
EQU OPEN.FILE  TO 11
EQU CREATE.FILE  TO 12
EQU RENAME.FILE  TO 13
EQU MOVE.FILE  TO 14
EQU DELETE.FILE  TO 15

EQU OPEN.MEDIA  TO 16
EQU CREATE.MEDIA  TO 17
EQU READ.MEDIA  TO 18
EQU WRITE.MEDIA  TO 19

EQU UNLOCK.ALL  TO 20
EQU FLUSH  TO 21
EQU INSTALL  TO 22

*EQU RESERVED  TO 23
*EQU RESERVED  TO 24
*EQU RESERVED  TO 25

EQU OMNI.SCRIPT  TO 26
* Following OMNI.SCRIPT sub-codes are passed in the FMC
EQU OMNIBUS_LIST$  TO 'GROUP_NUMBER'
EQU OMNIBUS_CALL$  TO 0  ;* Required
EQU SMART_TEST$  TO 1  ;* Required - returns 0 in FLAG if
* bond is NOT smart.  Otherwise returns
* an intelligence factor in FLAG.
EQU SCRIPT_CALL$  TO 2  ;* Intelligent database language script
* for smart bonds only
EQU SCRIPT_OK_CALL$  TO 3  ;* For smart bonds only.  If true then
* asynchronous processesing is used.

EQU CLOSE.MEDIA  TO 27
EQU RECORD.COUNT  TO 28
EQU REMAKE.FILE  TO 29

EQU CREATE.INDEX  TO 30
EQU DELETE.INDEX  TO 31
EQU UPDATE.INDEX  TO 32
EQU SELECT.INDEX  TO 33
EQU READNEXT.INDEX TO 34
* Source Date: 16:41:43  12 JAN 1993  Build ID: OI*1.0.10  Level: 2.0
*$INSERT AREV_BP, FSERRORS_HDR
* Advanced Revelation Filing System Error reporting protocol
*
* Error conditions are to be returned by BFSs and MFSs in the @FILE.ERROR
* variable.  Each error code has an associated severity level.
* If an error condition is encountered, the filing system code should set
* 1. @FILE.ERROR to the associated code and fill in the message and detail
* as appropriate
* 2. Set STATUS() to the associated severity level
* 3. Set the FLAG (7th argument) to FALSE$ to indicate an operational failure.
*
* If FLAG is set to false, then the operation is defined to have failed.
* It is important for the application to know that a WRITE or DELETE was
* in fact not performed.  Setting FLAG to FALSE is not an appropriate protocol
* for communicating any non-failure (informational) condition from the
* filing system.
*
* "Core" error codes are blocked in groups of 100 and are integer codes.
* Block 0 - 99 is allocated for logical error reporting.
* Block 100 - 199 is allocated for Revelation system BFS error codes.
* Block 200 - 299 is allocated for Revelation system MFS error codes.
* Block 300 - 399 is allocated for BOND.SUBS errors
* Blcok 400 - 499 is allocated for System, RTP, and R/BASIC cursor errors
*
* Some codes are intrinsically specific to the function of a particular
* BFS or MFS.  Others may be and should be generally applied to a variety
* of filing systems.  For example, code 100 is the standard status return in
* case of an attempt to read or delete a record which does not exist.
*
* Block BS - Bond-subs - is allocated for codes associated with the BOND.SUBS
* routine.
*
* Every error code should have an associated message in the MESSAGES file.
* The ID of the message should be error code preceeded by "FS".
* For example, code 105 would have an associated message "FS105"
* If any parameters are to be passed to this message they should appear in
* the FSMSG field of @FILE.ERROR.  This field may be multivalued.

*---- FILING SYSTEM SEVERITY LEVEL CODES --------
* Value of STATUS() on return from Filing System.
*
Equate Fs_Informational$ To -2  ;* @File.Error contain FYI info.
EQUATE FS_USER_ABORT$  TO -1  ;* The user pressed [Esc], SPECIAL!
EQUATE FSLOGICAL$  TO 0  ;* Data does not meet logical constraints
EQUATE FSPHYSICAL$  TO 1  ;* Structural or operational error (retryable)
EQUATE FSFATAL$  TO 2  ;* Structural or operational error (fatal)

*---- FILE.ERROR FIELD STRUCTURE -------
EQUATE FSCODE$  TO 1  ;* error or status code identifier
EQUATE FSMSG$  TO 2  ;* error message data
EQUATE FSDETAIL$  TO 3  ;* file system dependent detail data
EQUATE FS_PREFIX$  TO 'FS' ;* used by OE for set_status  Pat Oct/04/91
* Source Date: 11:34:13  10 MAY 1994  Build ID: AREV_HR*3.1.40  Level: 3.13
*$Insert SYSTABLE_NAMES
*compile insert SYSTABLE_NAMES

equ sysdict_file$  to "SYSDICT"
equ sysenv_file$  to "SYSENV"
equ syslists_file$  to "SYSLISTS"
equ syslogins_file$  to "SYSLOGINS"
equ sysobj_file$  to "SYSOBJ"
equ sysprocs_file$  to "SYSPROCS"
equ sysptrs_file$  to "SYSPTRS"
equ systables_file$  to "SYSTABLES"
equ sysviews_file$  to "SYSVIEWS"
equ sysvolumes_file$  to "SYSVOLUMES"
equ systypes_file$  to "SYSTYPES"
equ systypemaps_file$  to "SYSTYPEMAPS"
equ sysprocindex_file$  to "SYSPROCINDEX"
equ syscolumns_file$  to "SYSCOLUMNS"
equ accessible_columns$  to "ACCESSIBLE_COLUMNS"
equ syslhgroup_file$  to "SYSLHGROUP"
equ syslhverify_file$  to "SYSLHVERIFY"
equ importexport_file$  to "IMPORTEXPORT"
equ OsFile$  to "WINDOWS"
equ LogFile$  to "LOG"

equ SYSREPOS_FILE$  to "SYSREPOS"
equ SYSREPOS_TEMP_FILE$  to "SYSREPOS_TEMP"
equ SYSREPOSTYPES_FILE$  to "SYSREPOSTYPES"
equ SYSAPPS_FILE$  to "SYSAPPS"
equ SYSREPOSLOCKS_FILE$  to "SYSREPOSLOCKS"
equ SYSREPOSLOG_FILE$  to "SYSREPOSLOG"
equ SYSREPOSWINS_FILE$  to "SYSREPOSWINS"
equ SYSREPOSWINEXES_FILE$  to "SYSREPOSWINEXES"
equ SYSREPOSEVENTS_FILE$  to "SYSREPOSEVENTS"
equ SYSREPOSEVENTEXES_FILE$  to "SYSREPOSEVENTEXES"
equ SYSREPOSCLASSES_FILE$  to "SYSREPOSCLASSES"
equ SYSREPOSPOPUPS_FILE$  to "SYSREPOSPOPUPS"
equ SYSREPOSMESSAGES_FILE$  to "SYSREPOSMESSAGES"
equ SYSREPOSAPPNOTES_FILE$  to "SYSREPOSAPPNOTES"
equ SYSREPOSREPORTS_FILE$  to "SYSREPOSREPORTS"
equ SYSREPOSRELEASES_FILE$  to "SYSREPOSRELEASES"
equ SYSREPOSVIEWS_FILE$  to "SYSREPOSVIEWS"
equ SYSREPOSSTORAGE_FILE$  to "SYSREPOSSTORAGE"
equ SYSREPOSTYPEFAMILIES_FILE$  to "SYSREPOSTYPEFAMILIES"
equ SYSREPOSDATASOURCES_FILE$  to "SYSREPOSDATASOURCES"
equ SYSREPOSDBCOMPONENTS_FILE$  to "SYSREPOSDBCOMPONENTS"
equ SYSREPOSDBCOMPONENTEXES_FILE$ to "SYSREPOSDBCOMPONENTEXES"
equ sysreposxml_file$  to "SYSREPOSXML"
equ sysreposlanguage_file$  to "SYSREPOSLANGUAGE"
EQU SYSREPOSMENUCONTEXT_FILE$ TO 'SYSREPOSMENUCONTEXT'

EQU AVERYLABELS_FILE$ TO 'AVERYLABELS'
* MTR 12-6-06 FOR aREV32

Equ DefaultSysAliasFile$  To "SYSALIAS"
Equ SysAliasesFile$  To "SYSALIASES"

* Source Date: 10:20:52  22 SEP 2003  Build ID: OI*7.0.0  Level: 2.61
*$INSERT SYSCOMMON
*compile insert SysCommon

******************************************************************************
*
* This program is proprietary and is not to be used by or disclosed
* to others, nor is it to be copied without written permission from
* Revelation Technologies, Inc.
*
* Name  : SysCommon
* Description: OpenEngine System Common variable declarations
*
* History  : (date, initials, notes)
* 08-13-91 ba  original programmer
* 10-31-91 rkh  removed SC_TIMEDATE_FMT (#215), per fix 4831 and 4813
* 01-18-94 gg  changed SC_UNUSED73 to SC_CONCURRENCY
* 04-05-94 Pat  changed SC_UNUSED_107 to SC_ENGINE_LOGGING_REQ;the
* semaphore between oengine.exe and revexec.dll
* 04-25-94 Slj  changed SC_UNUSED_78 to SC_ATWINDOW for event handlers
* 05-16-94 Pat  change SC_UNUSED_165 to SC_CTRL_TYPES
* 06-13-94 tmc  10695 changed SC_ARRAY_VOLUMES to dim of 6 (was 5)
* 06-24-95 gg  11322 changed SC_UNUSED_155 to SC_DATASOURCETYPE
* 07-17-95 cp  11322 changed SC_UNUSED_154 to SC_XO_DEFAULTS
* 03-05-96 cp  11777 added SC_LHLICENSING SC_LHENABLED SC_LHFILESUSED
* (160-162)
* 08-05-96 gg  11853 changed PROGRAMS_DIM$ from '0299' to '0499'
* 06-23/97 cp  added support for SYSLOGINS table (201-203)
*
******************************************************************************

equ FRAMES_DIM$  to 49
equ PROGRAMS_DIM$  to '0499' ;* appears in obj code's literal pool
equ SC_ARRAY_VOLUMES_OFFSET$  to 17
equ SC_ARRAY_TABLES_OFFSET$  to 19

*
SYSCOM SC_ATRM  
SYSCOM SC_ATFM  
SYSCOM SC_ATVM  
SYSCOM SC_ATSVM  
SYSCOM SC_TM  
SYSCOM SC_STM  
SYSCOM SC_CRLF  
SYSCOM SC_FILE_SYSENV  
SYSCOM SC_TIMEDATA
SYSCOM SC_FILE_SYSPTRS  
SYSCOM SC_PROGLIST  
SYSCOM SC_PROGRAMS(PROGRAMS_DIM$) 
SYSCOM SC_FSTACK(1)
SYSCOM SC_FRAMELIST
SYSCOM SC_FRAMES(FRAMES_DIM$) 
SYSCOM SC_FILE_VOLUMES  
SYSCOM SC_ARRAY_VOLUMES(6) 
SYSCOM SC_FILE_TABLES  
SYSCOM SC_ARRAY_TABLES(5) 
SYSCOM SC_FILES_NO_DETACH  
SYSCOM SC_RTP1  
SYSCOM SC_AFSNAMES  
SYSCOM SC_FILE_SYSOBJ  
SYSCOM SC_FILE_SYSDICT  
SYSCOM SC_USER  
SYSCOM SC_DBID  
SYSCOM SC_LIST
SYSCOM SC_TODAY  
SYSCOM SC_SUNDAY0  
SYSCOM SC_SUNDAY7  
SYSCOM SC_ATUSER0  
SYSCOM SC_ATUSER1  
SYSCOM SC_ATUSER2  
SYSCOM SC_ATUSER3  
SYSCOM SC_ATUSER4  
SYSCOM SC_CURR_PROGRAM  
SYSCOM SC_CURRENT_LINE  
SYSCOM SC_SYSTEM_STATE  
SYSCOM SC_DBG_BUFFER  
SYSCOM SC_WORKLIST  
SYSCOM SC_ATID  
SYSCOM SC_ATREC  
SYSCOM SC_DATA_LIST  
SYSCOM SC_ADMIN  

SYSCOM SC_SQL_PARAMS  
SYSCOM SC_SQL_CURSPARAMS  
SYSCOM SC_SQL_NCACHEIDS  
SYSCOM SC_SQL_NCACHEDATA(8) 

SYSCOM SC_FILE_SYSPROCS  
SYSCOM SC_FLAGS  
SYSCOM SC_SYSPROCNAMES  

SYSCOM SC_SQL_SQBUFFS(20) 
SYSCOM SC_SQL_SQBUFF_CURS  
SYSCOM SC_SQL_CURS_SQBUFF  
SYSCOM SC_SQL_CURSSLOTS  
SYSCOM SC_SQL_PROJEX  

SYSCOM SC_ATLIMIT  
SYSCOM SC_NEXT_GROUP  
SYSCOM SC_PRI_NAME
SYSCOM SC_PRI_DICT
SYSCOM SC_PRI_FILE  
SYSCOM SC_COMPILER  
SYSCOM SC_ATLIST_ACTIVE  
SYSCOM SC_LIST_OFF  
SYSCOM SC_REDUCTION_SPEC
SYSCOM SC_SORT_SPEC
SYSCOM SC_ATANS  
SYSCOM SC_ATDICT  

SYSCOM SC_SQL_FIRSTIDS  
SYSCOM SC_SQL_LASTIDS  
SYSCOM SC_SQL_SKIPWHERE  
SYSCOM SC_SQL_LIKE  

SYSCOM SC_CONCURRENCY  

SYSCOM SC_ATCONV
SYSCOM SC_ATFORMAT
SYSCOM SC_ATHEADER  
SYSCOM SC_DATE_FORMAT  

SYSCOM SC_ATWINDOW  

SYSCOM SC_IO_PROC  
SYSCOM SC_ATRECUR0  
SYSCOM SC_ATRECUR1  
SYSCOM SC_ATRECUR2  
SYSCOM SC_ATRECUR3  
SYSCOM SC_ATRECUR4  
SYSCOM SC_MVCOUNT  
SYSCOM SC_ATRECCOUNT  
SYSCOM SC_ATQUERY_DICT  

SYSCOM SC_DST_RECORDS(9) 
SYSCOM SC_DST_OFFSETS(9) 
SYSCOM SC_DST_HANDLES(9) 
SYSCOM SC_DST_HASHTABLES(9) 

SYSCOM SC_ATLPTRWIDE  
SYSCOM SC_ATLPTRHIGH  

SYSCOM SC_FVSYSREPOS  
SYSCOM SC_FVSYSREPOSLOG  
SYSCOM SC_FILE_REPOSEXE  
* SYSCOM SC_UNUSED_97  
SYSCOM SC_ATTCL_STACK  

SYSCOM SC_DRIVER  
SYSCOM SC_LONG_LIST  
SYSCOM SC_LIST_LEVEL  
SYSCOM SC_ATCURSORS(8,12) 
SYSCOM SC_SORT_FILE  

SYSCOM SC_APPID
SYSCOM SC_APPINFO
SYSCOM SC_NEXTREQARGS  
SYSCOM SC_IDXSVR  
SYSCOM SC_ENGINE_LOGGING_REQ
SYSCOM SC_HUSH  
SYSCOM SC_UNUSED_109  

SYSCOM SC_ATSTATION  
SYSCOM SC_UNUSED_111  
SYSCOM SC_LINEAR_HASH_FRAMES  
SYSCOM SC_ATHEADING  
SYSCOM SC_ATFOOTING  
SYSCOM SC_ATPAGE  
SYSCOM SC_ATBREAK1
SYSCOM SC_ATBREAK2
SYSCOM SC_ATBREAK3
SYSCOM SC_ATFIRST_PAGE
SYSCOM SC_ATFIRST_COLHEAD  
SYSCOM SC_ATCOLHEADING  
SYSCOM SC_ATCOLLENGTH  
SYSCOM SC_ATCOLHEAD  
SYSCOM SC_ATCHACTIVE  
SYSCOM SC_EXT_LIST  
SYSCOM SC_CMDLINE  
SYSCOM SC_LOCKED_USER_ID  
SYSCOM SC_LABELED_COMMON_NAMES  
SYSCOM SC_LABELED_COMMON_SPTS  
SYSCOM SC_ATREDUCTION_DONE  
SYSCOM SC_ATRETURN_VALUE  
SYSCOM SC_XLATE_KEYS
SYSCOM SC_XLATE_LRU
SYSCOM SC_SYS_LOCKS(8)

SYSCOM SC_USER_LIST  
SYSCOM SC_ADMIN_LIST  
SYSCOM SC_PASSWORD_LIST  

SYSCOM SC_XLATE_RESET  

SYSCOM SC_PROT_DOCONV  
SYSCOM SC_PROT_DEFCONV  
SYSCOM SC_PROT_LOCKMODE  
SYSCOM SC_PROT_HANDLES  
SYSCOM SC_PROT_TABLEDATA  
SYSCOM SC_PROT_TRANSSTATE  
SYSCOM SC_PROT_TRANSDATA  
SYSCOM SC_PROT_CONSISTENCY  
SYSCOM SC_PROT_TABLELOCKS(8) 
SYSCOM SC_PROT_LOCKDATA(7) 
SYSCOM SC_PROT_TRANSHANDLES  
SYSCOM SC_PROT_CURSCONV  
SYSCOM SC_PROT_SPECS  
SYSCOM SC_PROT_SPECS_LRU  

SYSCOM SC_UNUSED_153  
SYSCOM SC_XO_DEFAULTS  
SYSCOM SC_DATASOURCETYPE  

SYSCOM SC_ATPSEUDO  

SYSCOM SC_UNUSED_157  

SYSCOM SC_ATUPPER_CASE  
SYSCOM SC_ATLOWER_CASE  

SYSCOM SC_LHLICENSING  
SYSCOM SC_LHENABLED  
SYSCOM SC_LHFILESUSED  
SYSCOM SC_UNUSED_163
SYSCOM SC_UNUSED_164
SYSCOM SC_CTRL_TYPES  
SYSCOM SC_REPOSMIRROR  

SYSCOM SC_ATDEFAULT_STOPS  

SYSCOM SC_UNUSED_168  
SYSCOM SC_QHANDLE  
SYSCOM SC_REQID  
SYSCOM SC_EXEC_COMMAND  
SYSCOM SC_SPSTATUS  
SYSCOM SC_SPSTATCODE  
SYSCOM SC_SPSTATTEMPL  
SYSCOM SC_SPABORT  
SYSCOM SC_SPTYPE  
SYSCOM SC_SPARGDTYPES  
SYSCOM SC_SPRECDTYPES  
SYSCOM SC_SPWRECDTYPES  

SYSCOM SC_UNUSED_180  
SYSCOM SC_UNUSED_181
SYSCOM SC_UNUSED_182
SYSCOM SC_UNUSED_183
SYSCOM SC_UNUSED_184
SYSCOM SC_UNUSED_185
SYSCOM SC_UNUSED_186
SYSCOM SC_UNUSED_187
SYSCOM SC_UNUSED_188
SYSCOM SC_UNUSED_189
SYSCOM SC_ENCACTIVE  
SYSCOM SC_UNUSED_191
SYSCOM SC_UNUSED_192
SYSCOM SC_UNUSED_193
SYSCOM SC_UNUSED_194
SYSCOM SC_DICT_MODE  
SYSCOM SC_UNUSED_196
SYSCOM SC_UNUSED_197
SYSCOM SC_UNUSED_198
SYSCOM SC_UNUSED_199
SYSCOM SC_UNUSED_200

SYSCOM SC_FILE_SYSLOGINS  
SYSCOM SC_KEY_SYSLOGINS  
SYSCOM SC_LOGGED_ON  

SYSCOM SC_CHAR_MAPS  
SYSCOM SC_ATFILE_ERROR  
SYSCOM SC_MEM_ALLOC  
SYSCOM SC_INDEXLIST  
SYSCOM SC_ATROLLOUT_FILE  
SYSCOM SC_ATFILE_ERROR_MODE  
SYSCOM SC_LOCKED_TABLES
SYSCOM SC_EP  
SYSCOM SC_LND_DATA  
SYSCOM SC_LND_NAMES  
SYSCOM SC_LND_POINT  
*SYSCOM SC_UNUSED_215
SYSCOM SC_HW_ENV  


* MTR 11-3-06 SYSCOM SC_UNUSED_216
SYSCOM SC_ATLEVEL  

SYSCOM SC_ATPRECISION  
SYSCOM SC_CM_NAMES  
SYSCOM SC_CM_POINT  
SYSCOM SC_ATENVIRON_SET  
* 
* mtr 12-6-06
* We extended the SC addressspace to 250 today in order to bring back more of the system common needed for Arev32, and to add some more as needed for the pick compatibility.

SYSCOM SC_SAVE(8,26) 
SYSCOM SC_ATCRT_MAX_Y  
SYSCOM SC_DEMO  
SYSCOM SC_TCL_STATE  
SYSCOM SC_RESET_ROUTINE  
SYSCOM SC_ATSENTENCE  
SYSCOM SC_FILE_VOC  
SYSCOM SC_DICT_VOC  
SYSCOM SC_CHAIN_LINE  
SYSCOM SC_PARSE_TCL  
SYSCOM SC_VERB  
SYSCOM SC_VERBS_FILE  
SYSCOM SC_BREAKKEY  
SYSCOM SC_ABORT_FLAG  
SYSCOM SC_ATSCREEN_SAVE  
SYSCOM SC_ATVIEW_MODE  
SYSCOM SC_VIEW_SCREEN  
SYSCOM SC_VIEW_PARAMS
SYSCOM SC_MULTI_LIMIT
SYSCOM SC_CURR_EXEC_CNT  
SYSCOM SC_FROM_PROC
SYSCOM SC_ATSAVE_SELECT
SYSCOM SC_BREAK_TABLE  
SYSCOM SC_TRACE_TABLE  
SYSCOM SC_PROMPT_STR
SYSCOM SC_OPTIONS  

SYSCOM SC_OPTLIST  
SYSCOM SC_MOD_FLAGS  
SYSCOM SC_LOADER_SEMAPHORE  

*
EQU NETWORK.FLAG TO BITAND(RUNTIME(),32768)
EQU NETWORK.MASK TO \48692047656E6521\
*
* Meta objects are stored in the FRAMES array so they can be thrown
* out by the garbage collect if necessary.
*
EQU ROS.FRAME.CACHE  TO  0
EQU ROS.FRAME.CACHE.TOP TO  9
EQU OCONV.RUN  TO SC_FRAMES(10)
EQU WITH.RUN  TO SC_FRAMES(11)
EQU WITH0.RUN  TO SC_FRAMES(12)
EQU SORT.RUN  TO SC_FRAMES(13)
EQU TEMPLATE.CACHE  TO  14
EQU TEMPLATE.NAMES  TO SC_FRAMES(14)
EQU TEMPLATE.CACHE.TOP  TO  40
EQU XLATE.CACHE  TO  41
EQU XLATE.CACHE.TOP  TO  49


EQU NULL$  TO ""
EQU SPACE$  TO \20\
EQU DBODELIM$  TO \2E\  ;* Databse owner delimiter "."

*÷ MESSAGES called  (Terminate with '$') :
EQU BADPASS$  TO "W125" ;* Incorrect password
EQU BADACCT$  TO "W116" ;* Invalid account name
EQU UNAVAIL$  TO "W505" ;* X is unavailable after Y
EQU MISMATCH$ TO "W500" ;* Mismatch between volumes and files
EQU NOEXIST$  TO "W517" ;* Unable to attach "file" in the "account" on the "volume"

*÷ DECLARED - FUNCTIONS  called :
DECLARE FUNCTION UNASSIGNED

*÷ DECLARED - SUBROUTINES called :
DECLARE SUBROUTINE RTP49





*÷÷ PROGRAM TOP
!
IF UNASSIGNED(Options) THEN Options = NULL$
IF UNASSIGNED(AliasName) THEN
AliasName = DefaultSysAliasFile$
END

SaveAlias  = AliasName
@FILE.ERROR = NULL$
Errors  = NULL$

SysUser = SC_USER
CONVERT ".$-" TO "___" IN SysUser
*
IF @USERNAMENE 'SYSPROG' THEN
IF Account NE 'GLOBAL' THEN
IF Account NE @USERNAMETHEN
READ Rec FROM SC_FILE_SYSENV, Account THEN
IF Rec<1> = 'ACCOUNT' THEN
Encrypt.Data = Password
IF LEN(Encrypt.Data) THEN
gosub ENCRYPT.DATA
END
IF Rec<6> = Encrypt.Data ELSE
IF Rec<7> THEN
EncryptedPassword = Encrypt.Data
Ok  = FALSE$
Cnt = COUNT(Rec<7>, @VM) + (Rec<7> NE NULL$)
For J = 1 to Cnt
Encrypt.Data = Rec<7, J>
gosub ENCRYPT.DATA
IF Encrypt.Data = EncryptedPassword THEN
Ok = TRUE$
END
Next J
IF Ok ELSE

Errors := @RM : BADPASS$
END
END ELSE

Errors := @RM : BADPASS$
END
END
END ELSE

Errors := @RM : BADACCT$ : @fm : Account
END
END ELSE

Errors := @RM : BADACCT$ : @fm : Account
END
END
END
END

IF Errors ELSE
IF Table[1, 5] = "DATA." THEN
RealName = Table[6, len(table)]
END ELSE
RealName = Table
END

RTP49(Volume, 0, VolumeRec, NULL$)

IF @FILE.ERROR THEN
Errors := @RM : @FILE.ERROR
END ELSE
VolumeFiles = VolumeRec<3>
MapFS = VolumeRec<4>
CONVERT @VM TO @SVM IN MapFS
Pos = COUNT(MapFS, @SVM)
IF Pos THEN
MapFS1 = MapFS<1, 1, 1>
MapBFS = MapFS<1, 1, Pos + 1>
END ELSE
MapFS1 = MapFS
MapBFS = MapFS
END
MapHandle = VolumeRec<5>

gosub SET_QFILE

IF Status THEN
IF WRITE.OPT OR INDEX(Options, "W", 1) THEN
* FOO If DO_OPEN('',SysAliasesFile$ ,FileQfiles ) ELSE
OPEN SYSALIASESFILE$ TO FILEQFILES ELSE
FileQfiles = SC_FILE_VOC
END
CTO%KPLK=0;CALL WRITE_LOCK(FileQfiles,AliasName ,DefaultSysAliasFile$:@FM:Account:@FM:Table:@fm:Volume ,'',CTO%KPLK);if CTO%KPLK = '0'  ELSE
Errors := @RM : @FILE.ERROR
END
END

IF Table[1, 5] = "DICT." OR TABLE[1, 5] = "DATA." or table[1,1] = '!' ELSE

RealName  = 'DICT.' : Table
AliasName = 'DICT.' : AliasName
gosub SET_QFILE
IF Status THEN
RealName  = '!' : Table
AliasName = '!' : AliasName[6,len(aliasname)]
gosub SET_QFILE
END
END
VolumeRec<3> = VolumeFiles
GOSUB_PARAM = Volume:@FM:VolumeRec
gosub WRITE_VOLUMES
END ELSE
Errors := @RM : NOEXIST$ : @FM : RealName : @VM : Account : @VM : Volume
END
END
END

IF Errors THEN
@FILE.ERROR = Errors[2, LEN(Errors)]
STATUS() = FSLOGICAL$
END ELSE
@FILE.ERROR = NULL$
END
TRANSFER SaveAlias TO AliasName
return 

*-----------------------------------------------------------------------------
SET_QFILE:

Status = FALSE$

IF RealName = "REVMEDIA" THEN
IF Account = "SYSPROG" THEN
gosub DETACH_FILE
GOSUB_PARAM = AliasName:@FM:Volume:@FM:RealName:@FM:Account:@FM:MapFS:@FM:MapHandle
gosub WRITE_FILES
LOCATE AliasName IN VolumeFiles USING @VM SETTING I ELSE
VolumeFiles = INSERT(VolumeFiles,1,I,0,AliasName)
END
Status = TRUE$
return 
END
END

gosub GET_FILE_REC

IF Status THEN
gosub DETACH_FILE
FileRec = FileRec<2>
IF MapBFS NE "RTP59" THEN
IF RealName[1, 5] = "DICT." THEN
FileRec = INSERT(FileRec, 1, 1, 0, "DICT.MFS")
END
LOCATE "PROTECT.MFS" IN FileRec USING @VM SETTING Pos THEN
IF POS > 1 THEN
FileRec = DELETE(FileRec, 1, Pos, 0)
FileRec = INSERT(FileRec, 1, 1, 0, "PROTECT.MFS")
END
END
END
*--> 12-25-93 - janem - bug #12320, #13921
If Table[1,5] = 'DATA.' Then
Locate "SI.MFS" in FileRec Using @vm Setting Pos Then
FileRec = Delete(Filerec,1,Pos,0)
End
End
*--> 12-25-93 - janem - bug #12320, #13921
GOSUB_PARAM = AliasName:@FM:Volume:@FM:RealName:@FM:Account:@FM:INSERT(FileRec,1,-1,0,MapFS)
gosub WRITE_FILES

LOCATE AliasName IN VolumeFiles USING @VM SETTING Pos ELSE
VolumeFiles = INSERT(VolumeFiles, 1, Pos, 0, AliasName)
END

BEGIN CASE
CASE AliasName = SysPtrs_File$
If DO_OPEN('',SysPtrs_File$ ,SC_FILE_VOC ) ELSE
Status = FALSE$
END

CASE AliasName = SysDict_File$
If DO_OPEN('',SysDict_File$ ,SC_DICT_VOC ) ELSE
Status = FALSE$
END

CASE AliasName = SysObj_File$
If DO_OPEN('',SysObj_File$ ,SC_FILE_VERBS ) ELSE
Status = FALSE$
END

END  CASE
IF Status ELSE
Errors := @RM : UNAVAIL$ : @FM : AliasName : @VM : "SetAlias_Sub"
END
END

return 

*----------------------------------------------------------------------------
GET_FILE_REC:

Status = FALSE$

NameTemp = RealName
IF NameTemp[1,1] = '!' THEN
Bang = '!'
NameTemp[1,1] = NULL$
END ELSE
Bang = ''
END

IF NameTemp[1,5] = "DICT " OR NameTemp[1,5] = "DICT." THEN
Dict = "DICT."
NameTemp[1,5] = ''
NameTemp = DO_XSWAP('TRIM',NameTemp)
END ELSE
Dict = NULL$
END

If NameTemp[1,5] = "DATA " or NameTemp[1,5] = "DATA." Then
Dict = "DATA."
NameTemp[1,5] = ''
NameTemp = DO_XSWAP('TRIM',NameTemp)
End
UserSpec = ''
AtIX = INDEX(NameTemp, DBODELIM$, 1)
IF AtIX THEN
UserSpec = NameTemp[1, AtIX - 1]
NameTemp[1,AtIX] = ''
END

IF UserSpec THEN
RealName = Bang:Dict:UserSpec:DBODELIM$:NameTemp
END ELSE
RealName = Bang:Dict:SysUser:DBODELIM$:NameTemp
END

call @MapFS1(READO.RECORD, MapFS, MapHandle, RealName:'*':Account, '', FileRec, Status)
if status else
CALL @MapFS1(READO.RECORD, MapFS, MapHandle, RealName:'*GLOBAL', '', FileRec, Status)
if status then
Account = 'GLOBAL'
end else
RealName = Bang:Dict:NameTemp
CALL @MapFS1(READO.RECORD, MapFS, MapHandle, RealName:'*':Account, '', FileRec, Status)
if status else
CALL @MapFS1(READO.RECORD, MapFS, MapHandle, RealName:'*GLOBAL', '', FileRec, Status)
if status then
Account = 'GLOBAL'
end
end
end
end
return 

*----------------------------------------------------------------------------
DETACH_FILE:
GOSUB_PARAM = AliasName
gosub READ_FILES
IF GOSUB_RETURN THEN
OrgVolume = GOSUB_RETURN<1>
IF OrgVolume NE Volume THEN
GOSUB_PARAM = OrgVolume
gosub READ_VOLUMES
IF GOSUB_RETURN THEN
LOCATE AliasName IN GOSUB_RETURN<3> USING @VM SETTING I THEN
GOSUB_PARAM = OrgVolume:@FM:DELETE(GOSUB_RETURN, 3, I, 0)
gosub WRITE_VOLUMES
END ELSE
Errors := @RM : MISMATCH$ : @FM : "SetAlias_Sub"
END
END ELSE
Errors := @RM : MISMATCH$ : @FM : "SetAlias_Sub"
END
END
END
return 

*$INSERT AREV_BP, FILE_VOL_GOSUB
*
*
!
*
* This  program  is  proprietary and is not  to be used  by or  disclosed to others, nor is it to be copied
* without written permission from COSMOS, INC.
*
!
*
*÷ VERSION  : Arev 2.0
*
*÷ PURPOSE  : Simulate READ, WRITE and DELETE calls to the FILES and
* VOLUMES files.
* It is 3 times faster to retrieve information directly
* from the system variables as opposed to using the
* RTP50 filing system.
*
*÷ AUTHOR  : John Paul Voelk
*
*÷ CREATED  : 9-11-89
*
*÷ PROCEDURES :
*
*÷ WARNINGS  :
*

!
*÷ REVISION HISTORY  (Most CURRENT first) :

* DATE  IMPLEMENTOR  FUNCTION
* -------- ----------- --------
* DD-MM-YY  initials  Modification

!

*÷ THEORY OF OPERATION :

READ_FILES:
*
* Pass in Record to be read in GOSUB_PARAM variable.  Record is returned
* in the GOSUB_RETURN variable.  If this is null (0 length) then the
* record doesn't exist.
*


GOSUB_RETURN = ''
LOCATE GOSUB_PARAM IN SC_ARRAY_TABLES(0) USING @FM SETTING GOSUB_TMP THEN
GOSUB_RETURN = SC_ARRAY_TABLES(1)<GOSUB_TMP>:@FM:SC_ARRAY_TABLES(2)<GOSUB_TMP>:@FM:SC_ARRAY_TABLES(3)<GOSUB_TMP>:@FM:SC_ARRAY_TABLES(4)<GOSUB_TMP>
END
return 

WRITE_FILES:
*
* Pass in all fields to be written (including the key), in order and @FM
* delimited in the GOSUB_PARAM variable.
*
LOCATE GOSUB_PARAM<1> IN SC_ARRAY_TABLES(0) USING @FM SETTING GOSUB_TMP THEN
SC_ARRAY_TABLES(1)<GOSUB_TMP> = GOSUB_PARAM<2>
SC_ARRAY_TABLES(2)<GOSUB_TMP> = GOSUB_PARAM<3>
SC_ARRAY_TABLES(3)<GOSUB_TMP> = GOSUB_PARAM<4>
SC_ARRAY_TABLES(4)<GOSUB_TMP> = GOSUB_PARAM<5>
SC_ARRAY_TABLES(5)<GOSUB_TMP> = GOSUB_PARAM<6>
END ELSE
SC_ARRAY_TABLES(0) := @FM:GOSUB_PARAM<1>
SC_ARRAY_TABLES(1) := @FM:GOSUB_PARAM<2>
SC_ARRAY_TABLES(2) := @FM:GOSUB_PARAM<3>
SC_ARRAY_TABLES(3) := @FM:GOSUB_PARAM<4>
SC_ARRAY_TABLES(4) := @FM:GOSUB_PARAM<5>
SC_ARRAY_TABLES(5) := @FM:GOSUB_PARAM<6>
END
return 

DELETE_FILES:
*
* Pass in key name or filename of file to be removed in the GOSUB_PARAM
* variable.
*
LOCATE GOSUB_PARAM IN SC_ARRAY_TABLES(0) USING @FM SETTING GOSUB_TMP THEN
SC_ARRAY_TABLES(0) = DELETE(SC_ARRAY_TABLES(0), GOSUB_TMP, 0, 0)
SC_ARRAY_TABLES(1) = DELETE(SC_ARRAY_TABLES(1), GOSUB_TMP, 0, 0)
SC_ARRAY_TABLES(2) = DELETE(SC_ARRAY_TABLES(2), GOSUB_TMP, 0, 0)
SC_ARRAY_TABLES(3) = DELETE(SC_ARRAY_TABLES(3), GOSUB_TMP, 0, 0)
SC_ARRAY_TABLES(4) = DELETE(SC_ARRAY_TABLES(4), GOSUB_TMP, 0, 0)
SC_ARRAY_TABLES(5) = DELETE(SC_ARRAY_TABLES(5), GOSUB_TMP, 0, 0)
END
return 

*
READ_VOLUMES:
*
* Pass in Record to be read in GOSUB_PARAM variable.  Record is returned
* in the GOSUB_RETURN variable.  If this is null (0 length) then the
* record doesn't exist.
*
GOSUB_RETURN = ''
LOCATE GOSUB_PARAM IN SC_ARRAY_VOLUMES(0) USING @FM SETTING GOSUB_TMP THEN
GOSUB_RETURN = SC_ARRAY_VOLUMES(1)<GOSUB_TMP>:@FM:SC_ARRAY_VOLUMES(2)<GOSUB_TMP>
GOSUB_RETURN := @FM:SC_ARRAY_VOLUMES(3)<GOSUB_TMP>:@FM:SC_ARRAY_VOLUMES(4)<GOSUB_TMP>
GOSUB_RETURN := @FM:SC_ARRAY_VOLUMES(5)<GOSUB_TMP>
END
return 

WRITE_VOLUMES:
*
* Pass in all fields to be written (including the key), in order and @FM
* delimited in the GOSUB_PARAM variable.
*
LOCATE GOSUB_PARAM<1> IN SC_ARRAY_VOLUMES(0) USING @FM SETTING GOSUB_TMP THEN
SC_ARRAY_VOLUMES(1)<GOSUB_TMP> = GOSUB_PARAM<2>
SC_ARRAY_VOLUMES(2)<GOSUB_TMP> = GOSUB_PARAM<3>
SC_ARRAY_VOLUMES(3)<GOSUB_TMP> = GOSUB_PARAM<4>
SC_ARRAY_VOLUMES(4)<GOSUB_TMP> = GOSUB_PARAM<5>
SC_ARRAY_VOLUMES(5)<GOSUB_TMP> = GOSUB_PARAM<6>
END ELSE
SC_ARRAY_VOLUMES(0) := @FM:GOSUB_PARAM<1>
SC_ARRAY_VOLUMES(1) := @FM:GOSUB_PARAM<2>
SC_ARRAY_VOLUMES(2) := @FM:GOSUB_PARAM<3>
SC_ARRAY_VOLUMES(3) := @FM:GOSUB_PARAM<4>
SC_ARRAY_VOLUMES(4) := @FM:GOSUB_PARAM<5>
SC_ARRAY_VOLUMES(5) := @FM:GOSUB_PARAM<6>
END
return 

DELETE_VOLUMES:
*
* Pass in key name or filename of file to be removed in the GOSUB_PARAM
* variable.
*
LOCATE GOSUB_PARAM IN SC_ARRAY_VOLUMES(0) USING @FM SETTING GOSUB_TMP THEN
SC_ARRAY_VOLUMES(0) = DELETE(SC_ARRAY_VOLUMES(0), GOSUB_TMP, 0, 0)
SC_ARRAY_VOLUMES(1) = DELETE(SC_ARRAY_VOLUMES(1), GOSUB_TMP, 0, 0)
SC_ARRAY_VOLUMES(2) = DELETE(SC_ARRAY_VOLUMES(2), GOSUB_TMP, 0, 0)
SC_ARRAY_VOLUMES(3) = DELETE(SC_ARRAY_VOLUMES(3), GOSUB_TMP, 0, 0)
SC_ARRAY_VOLUMES(4) = DELETE(SC_ARRAY_VOLUMES(4), GOSUB_TMP, 0, 0)
SC_ARRAY_VOLUMES(5) = DELETE(SC_ARRAY_VOLUMES(5), GOSUB_TMP, 0, 0)
END
return 
* Source Date: 11:38:47  13 NOV 1990  Build ID: AREV*2.0.108  Level: 2.1
*$INSERT AREV_BP, ENCRYPT.DATA.GOSUB
ENCRYPT.DATA:
I = 1234567
LOOP
WHILE ENCRYPT.DATA NE ''
I = MOD(I,390001) * SEQ(ENCRYPT.DATA[1,1]) + 1
ENCRYPT.DATA[1,1] = ''
REPEAT
LOOP
ENCRYPT.DATA := CHAR(65+MOD(I,50))
I = INT(I/50)
WHILE I
REPEAT
return 
* Source Date: 10:20:16  03 FEB 1988  Build ID: 1.0  Level: 2.0
* Source Date: 09:49:41  16 JUN 1994  Build ID: AREV_HR*3.1.56  Level: 3.13
 
* PreCompiled On 12/06/2006 at 04:41:49PM OpenInsight version CTO
