COMPILATION LISTING OF SEGMENT gcos_cc_file_cards_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/09/83 1119.8 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* ****************************************************************************************** 12* ******************************************************************************************* 13* * 14* * 15* * G C O S F I L E C A R D P R O C E S S I N G 16* * 17* * 18* * This is the main driving module for the processing of the various gcos file 19* * assignment control cards. Cards processed by this module are the following: 20* * 21* * $ PRINT FC,LUD 22* * $ PUNCH FC,LUD 23* * $ READ (dummy entry - not really implemented ) 24* * $ DISK FC,LUD,ACCESS 25* * $ MASS FC,LUD,ACCESS 26* * $ FILE FC,LUD,ACCESS 27* * $ DRUM FC,LUD,ACCESS 28* * $ TAPE FC,LUD,MULTIREEL,SERIAL NO,SEQ NO,FILE NAME,CLASS,DENSITY 29* * $ PRMFL FC,ACC,MODE,PATH 30* * $ PRMFL FC/LUD,ACC,MODE,PATH 31* * $ DAC FC 32* * $ SYSOUT FC 33* * 34* * 35* * CONTROL CARD FIELDS 36* * 37* * FC FILE CODE 38* * 39* * LUD LOGICAL UNIT DESIGNATOR 40* * Channel letter 41* * followed by a channel number 42* * 1-99 followed by the disposition 43* * and optional abort disposition 44* * (R=release,S=save,D=dismount, 45* * P=purge and release, 46* * C=continue,or blank = R). 47* * 48* * ACCESS FILE LENGTH AND ACCESS 49* * Length of file in 3840 word 50* * links followed by "l" or "r". 51* * "l" stands for linked or sequential files 52* * and "r" stands for random access files. 53* * 54* * MULTIREEL Any non-blank character used to denote a second tape. 55* * (This is referred to as the secondary logical unit 56* * designator in the fib.) 57* * 58* * SERIAL-NO Serial number of first tape 59* * 60* * SEQ-NO The number to the reel within a given file at 61* * which processing is to begin. 62* * 63* * FILE-NAME An external name given to the file. Used in giving 64* * mounting instructions to the operator. 65* 66* * DENSITY Tape density for MPC driven tape units. 67* * 68* * ACC FILE PERMISSION 69* * Letters w,r,a,x, or e for the type 70* * of access to be given to the file (write, read, 71* * append or execute. Multiple access codes are 72* * separated by slashs. 73* * 74* * MODE FILE ACCESS 75* * The letter "l" or "r", indicating linked or random, as described above . 76* * 77* * PATH FILE PATHNAME 78* * Full or partial pathname or GCOS file string of the file to be 79* * associated with the filecode. 80* * 81* * 82* * WRITTEN BY DICK SNYDER DECEMBER 7, 1970 83* * MODIFIED BY T. CASEY DECEMBER 1973, JUNE 1974 84* * MODIFIED BY D. KAYDEN APRIL 1974, JULY 1974, DECEMBER 1974, MARCH 1975 85* * Change: Dave Ward 07/28/81 Allow period in name (By Dick Hemes) 86* * Modified: Ron Barstad 83-05-12 Improve test for path running over cc 72 87* * Modified: Ron Barstad 83-08-02 Added 6250 tape den as per GCOS 88* * 89* * 90* ******************************************************************************************** 91* ****************************************************************************************** */ 92 93 94 gcos_cc_file_cards_: proc (card); 95 96 97 /* D E C L A R A T I O N S */ 98 99 1 1 /* BEGIN INCLUDE FILE gcos_ext_stat_.incl.pl1 */ 1 2 /* 1 3* Changes to gcos_ext_stat_ must be made here AND gcos_ext_stat_.cds 1 4**/ 1 5 /* July 77 (MRJ) Mike Jordan. */ 1 6 /* Change: Mel Wilson Oct 1979 for gtss compatibility (Bell Canada). */ 1 7 /* Change: A. N. Kepner, March, 1978 to allow courtesy call i/o within cc routines. */ 1 8 /* Change: Dave Ward 06/01/81 Reorganized to eliminate alm object (using cds). Use of like structures. */ 1 9 /* Change: Scott C. Akers 01/26/82 Add tape_buffer_size for GEINOS processing. */ 1 10 /* Change: Ron Barstad 83-08-02 Added activity_card_num for execution report */ 1 11 /* Increased size of statistics for 4js3 MMEs */ 1 12 1 13 dcl gcos_ext_stat_$abort_reason char(128) varying /* abort reason from gcos pgm */ ext; 1 14 dcl gcos_ext_stat_$abort_return label /* abort return point */ ext; 1 15 dcl gcos_ext_stat_$activity_card_num pic "9999" ext; /* card number defining current activity */ 1 16 dcl gcos_ext_stat_$activity_name char(8) /* name of activity to be run */ ext; 1 17 dcl gcos_ext_stat_$activity_start_time fixed bin(71) /* TOD start of activity */ ext; 1 18 dcl gcos_ext_stat_$card_num pic "9999" /* ordinal number of card in input stream */ ext; 1 19 dcl gcos_ext_stat_$dbs (36)bit(1) /* Debugging switch. */ ext; 1 20 dcl gcos_ext_stat_$default_nondollar char(2) /* filecode where nondollar cards go by default */ ext; 1 21 dcl gcos_ext_stat_$dir_rings (3) fixed bin(3) /* ring brackets for created catalogs */ ext; 1 22 dcl gcos_ext_stat_$dpno char(100) varying /* arguments for call to dpunch */ ext; 1 23 dcl gcos_ext_stat_$dpo char(100) varying /* arguments for call to dprint */ ext; 1 24 dcl gcos_ext_stat_$endfc char(2) /* endfc value for endcopy processing */ ext; 1 25 dcl gcos_ext_stat_$er ptr /* fib pointer for *er */ ext; 1 26 dcl gcos_ext_stat_$etc_filecode char(2) /* filecode where $ ETC cards should be written */ ext; 1 27 dcl gcos_ext_stat_$gcos_slave_area_seg ptr /* pointer to gcos slave area segment */ ext; 1 28 dcl gcos_ext_stat_$gf fixed bin(24)/* sw used by getfield rtn */ ext; 1 29 dcl gcos_ext_stat_$incode fixed bin(24) /* switches to control incode processing */ ext; 1 30 dcl gcos_ext_stat_$increment_hold fixed bin(24) /* Holds increment for courtesy call returns. */ ext; 1 31 dcl gcos_ext_stat_$initial_cpu_time fixed bin(71) /* vcu time at activity start */ ext; 1 32 dcl gcos_ext_stat_$input_segment_path char(168) varying /* pathname of input segment */ ext; 1 33 dcl gcos_ext_stat_$jcl_warnings fixed bin(24) /* number warnings issued processing control cards */ ext; 1 34 dcl gcos_ext_stat_$job_cpu_time fixed bin(71) /* cpu usage at job start */ ext; 1 35 dcl gcos_ext_stat_$job_id char(18) varying /* unique job id for file naming */ ext; 1 36 dcl gcos_ext_stat_$job_real_time fixed bin(71) /* job start time in microseconds */ ext; 1 37 dcl gcos_ext_stat_$last_mme fixed bin(24)/* number of last mme executed */ ext; 1 38 dcl gcos_ext_stat_$ldrss fixed bin(24) /* loader shared stg. */ ext; 1 39 dcl gcos_ext_stat_$max_activities fixed bin(24)/* max activities in a job */ ext; 1 40 dcl gcos_ext_stat_$max_mem fixed bin(19) /* maximum memory available to an activity */ ext; 1 41 dcl gcos_ext_stat_$mme_rtrn label /* where to return at activity end */ ext; 1 42 dcl gcos_ext_stat_$nondollar char(2) /* non-dollar card file code */ ext; 1 43 dcl gcos_ext_stat_$nongcos char(2) /* filecode where nongcos dollar cards go */ ext; 1 44 dcl gcos_ext_stat_$normal_return label /* nonlocal goto for normal termination */ ext; 1 45 dcl gcos_ext_stat_$patchfile_ptr ptr /* pointer to patchfile */ ext; 1 46 dcl gcos_ext_stat_$pathname_prefix char(168)var ext; 1 47 dcl gcos_ext_stat_$pch ptr /* pointer to fib for syspunch collector file */ ext; 1 48 dcl gcos_ext_stat_$pdir char(168) varying /* pathname of process directory */ ext; 1 49 dcl gcos_ext_stat_$prt ptr /* pointer to fib for sysprint collector file */ ext; 1 50 dcl gcos_ext_stat_$rs ptr /* pointer to fib for geload r* collector file */ ext; 1 51 dcl gcos_ext_stat_$saveseg_ptr ptr /* pointer to save segment used by save/restart */ ext; 1 52 dcl gcos_ext_stat_$save_dir char(168) varying /* pathname of temp save directory */ ext; 1 53 dcl gcos_ext_stat_$seg_rings (3) fixed bin(3) /* ring brackets for created files */ ext; 1 54 dcl gcos_ext_stat_$sig_ptr ptr /* saved pointer to signal_ */ ext; 1 55 dcl gcos_ext_stat_$skip_umc bit(1) ext; 1 56 dcl gcos_ext_stat_$snumb bit (30) aligned /* snumb of the current job */ ext; 1 57 dcl gcos_ext_stat_$sought_label char(8) /* Label from GOTO, IF, or WHEN card */ ext; 1 58 dcl gcos_ext_stat_$statistics (3*44) fixed bin(24) /* mme usage statistics- 3 per mme */ ext; 1 59 dcl gcos_ext_stat_$stop_code fixed bin(24) /* debugging, print results and stop. */ ext; 1 60 dcl gcos_ext_stat_$storage_limit fixed bin(19) /* activity storage limit */ ext; 1 61 dcl gcos_ext_stat_$sysout_limit fixed bin(35) /* sysout line limit */ ext; 1 62 dcl gcos_ext_stat_$sysout_lines fixed bin(35) /* sysout lines used */ ext; 1 63 dcl gcos_ext_stat_$system_free_pointer ptr /* pointer to area for allocating in ext; set by gcos */ ext; 1 64 dcl gcos_ext_stat_$tape_buffer_size fixed bin(35) external static; /* tape buffer size for GEINOS. */ 1 65 dcl gcos_ext_stat_$temp_dir char(168) varying /* pathname of directory to hold temp files */ ext; 1 66 dcl gcos_ext_stat_$temp_seg_ptr ptr ext; 1 67 dcl gcos_ext_stat_$termination_code bit (18) /* termination code from gcos_mme_bort_ */ ext; 1 68 dcl gcos_ext_stat_$time_limit fixed bin(71) /* activity time limit */ ext; 1 69 dcl gcos_ext_stat_$userid char(12) /* the USERID */ ext; 1 70 dcl gcos_ext_stat_$validation_level fixed bin(3) /* current ring of execution */ ext; 1 71 1 72 /* Courtesy Call Queue 1 73* A queue for courtesy call addresses which must be saved during 1 74* execution of courtesy call routines. A courtesy call address is 1 75* saved each time a MME GEROUT or MME GEINOS, which specifies a 1 76* courtesy call, is executed within a courtesy call routine. Each 1 77* time a MME GEENDC is executed a courtesy call address will be 1 78* removed from this FIFO queue and the corresponding courtesy call 1 79* routine executed until the queue is empty. The FIFO "queue" is 1 80* implemented in a circular fashion. "next_avail" points to the 1 81* next empty location in the queue. "next_out" points to the 1 82* entry in the queue which has been in the queue longest. When 1 83* entering or removing entries from the queue the appropriate index 1 84* is incremented modulo the length of the queue. By convention the 1 85* queue is empty when "next_avail" equals "next_out". A 1 86* second convention is that the queue is considered to overflow 1 87* during an attempt to add an entry to the queue which would force 1 88* "next_avail" to "catch up" with "next_out". This means that 1 89* the last empty position in the queue will never be used. 1 90**/ 1 91 1 92 dcl 1 gcos_ext_stat_$courtesy_call_control aligned ext 1 93 , 3 courtesy_call 1 94 , 4 hold like save_machine_conditions /* Mach. conds. restored on courtesy call returns. */ 1 95 , 4 next_avail fixed bin(24) /* next available empty location in cc_queue. */ 1 96 , 4 next_out fixed bin(24) /* next entry to remove from cc_queue. */ 1 97 , 4 queue (6) fixed bin(24) 1 98 ; 1 99 2 1 /* BEGIN INCLUDE FILE gcos_save_mc.incl.pl1 (Wardd Multics) 09/12/81 0905.9 mst Sat */ 2 2 2 3 /* Structure to isolate the definition of the size of the 2 4*space needed to store he machine conditions structure (mc). 2 5**/ 2 6 dcl 1 save_machine_conditions based 2 7 , 3 save_space bit(1728) 2 8 ; 2 9 2 10 /* END INCLUDE FILE gcos_save_mc.incl.pl1 */ 1 100 1 101 1 102 dcl 1 gcos_ext_stat_$fct aligned ext, 1 103 3 fct (40) like fct_entry; 3 1 /* BEGIN INCLUDE FILE gcos_fct_entry.incl.pl1 (Wardd Multics) 05/30/81 1758.6 mst Sat */ 3 2 3 3 dcl 1 fct_entry aligned based, 3 4 2 filecode char(2) aligned, /* file code (or blank) */ 3 5 /* flags */ 3 6 2 sysout bit(1) unaligned, /* 1=file is sysout or dac */ 3 7 2 dac bit(1) unaligned, /* 1=file is dac,0=file is sysout */ 3 8 2 pad bit(34) unaligned, /* unused */ 3 9 2 fibptr ptr aligned /* ptr to fib for this file */ 3 10 ; 3 11 3 12 /* END INCLUDE FILE gcos_fct_entry.incl.pl1 */ 1 104 1 105 1 106 dcl 1 gcos_ext_stat_$save_data aligned ext, 1 107 3 save_data like save_data_entry; 4 1 /* BEGIN INCLUDE FILE gcos_save_data_entry.incl.pl1 (Wardd Multics) 07/01/81 1339.9 mst Wed */ 4 2 /* Change: Dave Ward 07/01/81 include gcos_flags_. */ 4 3 /* Change: Dave Ward 09/10/81 fib changed to fibs & likened to fib. */ 4 4 4 5 dcl 1 save_data_entry aligned based 4 6 ,3 flgs like flags /* system wide flgs */ 4 7 ,3 actid char(8) /* activity no. and accnt i.d. */ 4 8 ,3 short_actid bit(36) aligned /* short form of activity id */ 4 9 ,3 ident char(60) /* holds ident info from snumb card */ 4 10 ,3 psw bit(36) aligned /* program switch word */ 4 11 ,3 last_execute_act_no fixed bin(24)/* activity number of last $ EXECUTE card in job */ 4 12 ,3 activity_no fixed bin(24)/* activity number */ 4 13 ,3 job_time_limit fixed bin(71) /* job time limit */ 4 14 ,3 job_sysout_limit fixed bin(24)/* job sysout line limit */ 4 15 ,3 sysout_queue (10) char(32) /* sysout queue */ 4 16 ,3 sysout_queue_media (10) fixed bin(24)/* medium (print,punch) of each file on queue */ 4 17 ,3 sqindex fixed bin(24)/* curr offset in sysout queue */ 4 18 ,3 pathname_prefix char(168)varying /* prefix for gcos cfdescs */ 4 19 ,3 skip_umc aligned bit(1) /* flag to tell if we should skip umc names */ 4 20 ,3 job_deck pointer /* pointer to seg holding canonicalized job deck */ 4 21 ,3 jd_size fixed bin(24)/* size in words of job deck */ 4 22 ,3 jd_position fixed bin(24) /* position of current block of job deck */ 4 23 ,3 jd_rem_block_len fixed bin(24)/* words remaining in current block of job deck */ 4 24 ,3 syot_dir char(168)varying /* pathname of directory to hold sysout files */ 4 25 ,3 fibs (40) like fib 4 26 ,3 param (32) char(57)varying /* parameters */ 4 27 ; 4 28 5 1 /* BEGIN INCLUDE FILE gcos_flags.incl.pl1 (Wardd Multics) 07/01/81 1344.7 mst Wed */ 5 2 /* Change: Mel Wilson 03/01/79 to add gtssflag & identflag */ 5 3 /* Change: Dave Ward 07/01/81 revised, mad apart of gcos_ext_stat_. */ 5 4 5 5 5 6 /* Declaration of Simulator Wide Flags */ 5 7 5 8 dcl 1 flags aligned based, 5 9 2 ( 5 10 pad1, /* no longer used */ 5 11 copy, /* 1=copy option on|0=off */ 5 12 snumb, /* 1=snumb card read|0=not */ 5 13 ident, /* 1=ident card read|0=not */ 5 14 activ, /* 1=activity being defined|0=not */ 5 15 cc, /* 1=courtesy call active|0=not */ 5 16 pad2, /* no longer used */ 5 17 cksum, /* 1=don't check checksums|0=do */ 5 18 pad3, /* no longer used */ 5 19 wrapup, /* 1=processing wrapup after abort */ 5 20 5 21 /* FOLLOWING ADDED AFTER MARCH 73 */ 5 22 5 23 nosave, /* 1=disable save/restart function,0=not */ 5 24 pad4, /* no longer used */ 5 25 gcos, /* 1=job deck segment in gcos file format */ 5 26 raw, /* 1=sysout punch files to be converted to raw bit strings */ 5 27 list, /* 1=sysout print files to be converted to ascii */ 5 28 brief, /* 1=print nothing but fatal error messages on terminal */ 5 29 debug, /* 1=give option to call debug before aborting */ 5 30 no_canonicalize, /* 1=do NOT canonicalize job deck */ 5 31 5 32 /* 18 bits into first word */ 5 33 5 34 pad5, /* no longer used */ 5 35 dpunch, /* 1=dpunch sysout punch files;0=don't */ 5 36 dprint, /* 1=dprint sysout print files,0=don't */ 5 37 userid, /* 1=userid card read,0=not */ 5 38 userlib, /* 1= -userlib ctl arg given, see gcos_gein_ */ 5 39 dstar, /* 1=current activity card written on d* */ 5 40 write_etc, /* 1 tells get_cc_field to write $ ETC cards on etc_filecode */ 5 41 prev_act_abort, /* turned on by abort and off by $ BREAK */ 5 42 this_act_abort, /* turned on by abort to select abort disp codes */ 5 43 abort_subact, /* 1=processing abort subactivity */ 5 44 dump, /* 1=dump option given on activity card */ 5 45 nondollar, /* 1=reading nondollar card deck in gein */ 5 46 endjob, /* 1=cc_endjob already called once in this job */ 5 47 abort_card, /* 1=the terminator for this activity was a $ ABORT card */ 5 48 truncate, /* 1=truncate option given:truncate long ascii input lines */ 5 49 continue, /* 1=continue option given:continue after nonfatal errors */ 5 50 rout, /* 1=gcos_mme_rout_ was called in this activity */ 5 51 seeking, /* 1=gein is looking for a label and/or terminator */ 5 52 5 53 /* end of first word */ 5 54 5 55 seeking_terminator, /* 1=gein is looking for a terminator */ 5 56 lower_case, /* 1=lower case print conversion wanted */ 5 57 no_bar, /* 1=do not run slave program in BAR mode */ 5 58 long, /* 1=print some lines from execution reort on terminal */ 5 59 endfc, /* 1=process endfc option on endcopy card */ 5 60 gtssflag, /* 1=update gtss_user_state_ during execution */ 5 61 identflag, /* 1= use $ident banner info for print & punch */ 5 62 spawnflag, /* 1= entry due to tss spawn */ 5 63 taskflag /* 1= entry due to tss drl task */ 5 64 ) bit(1) unal, 5 65 2 pad6 bit(27)unal 5 66 ; 5 67 5 68 /* END INCLUDE FILE gcos_flags.incl.pl1 */ 4 29 4 30 4 31 /* END INCLUDE FILE gcos_save_data_entry.incl.pl1 */ 1 108 1 109 6 1 /* BEGIN INCLUDE FILE gcos_file_info_block_.incl.pl1 DAK - APRIL 74 */ 6 2 6 3 /* Declaration of File Information Block (fib) 6 4* 6 5* Change: Mel Wilson 11/01/79 for gtss compatibility 6 6* Change: Dave Ward 05/20/81 *_file constants. 6 7* Change: Dave Ward 05/29/81 separated fct structures. 6 8* Change: Dave Ward 09/02/81 provision for tape density 6250, dens_hist 2 bits (not 3). 6 9**/ 6 10 dcl 1 fib aligned based (fibptr) /* fib structure */ 6 11 6 12 , 2 buffer ptr aligned /* pointer to current buffer (gcos_write_) */ 6 13 , 2 buffer_indx fixed bin /* Index to buffer in use. */ 6 14 , 2 stream char(8)unal /* stream name for attaching this file */ 6 15 , 2 pathnm char(168)unal /* pathname (for disk, print or punch files) */ 6 16 , 2 unique_file_id bit(36) /* multics unique segment id for file */ 6 17 , 2 indicators /* five words of flags */ 6 18 6 19 , 3 indicators_word_1 6 20 , 4 used bit(1) unal /* 1=fib used, 0=fib used */ 6 21 , 4 attached bit(1) unal /* 1=stream is attached */ 6 22 , 4 type bit(1) unal /* 1=random, 0=linked */ 6 23 , 4 perm bit(1) unal /* 1=permanent file, 0=not */ 6 24 , 4 print bit(1) unal /* 1=file type is printer */ 6 25 , 4 punch bit(1) unal /* 1=file type is punch */ 6 26 , 4 reader bit(1) unal /* 1=file type is card reader */ 6 27 , 4 tape bit(1) unal /* 1=file type is tape */ 6 28 , 4 console bit(1) unal /* 1=file type is console typewriter */ 6 29 , 4 read bit(1) unal /* 1=read access permitted */ 6 30 , 4 write bit(1) unal /* 1=write access permitted */ 6 31 , 4 null bit(1) unal /* 1=file is null */ 6 32 , 4 purge bit(1) unal /* 1=purge file at time on release */ 6 33 , 4 gein bit(1) unal /* 1 = this file contains data cards from the job deck */ 6 34 , 4 disp bit(2) unal /* disposition code: 6 35* 00 = dismount 6 36* 01 = release 6 37* 10 = save 6 38* 11 = continue */ 6 39 , 4 adisp bit(2) unal /* abort disp - same codes as disp */ 6 40 , 4 order bit(1) unal /* 1 = write, 0 = read or other */ 6 41 , 4 mode bit(2) unal /* tape i/o mode 6 42* 00 = binary 6 43* 01 = decimal 6 44* 10 = nine */ 6 45 , 4 tracks bit(2) unal /* tape request code: 6 46* 00 = installation default 6 47* 01 = 7 track 6 48* 10 = 9 track */ 6 49 , 4 density bit(4) unal /* tape density from $ TAPE card 6 50* 0000 = site standard high 6 51* 0001 = 200 bpi 6 52* 0010 = 556 bpi 6 53* 0100 = 800 bpi 6 54* 1001 = 1600 bpi 6 55* 1100 = 6250 bpi 6 56* 1111 = handler capable of any appropriate denisty */ 6 57 , 4 dens_hist bit(2) unal /* density history for MME GEFADD */ 6 58 , 4 forced_acl_flag bit(1) unal /* 1 => acl forced for gtss file (2.4) */ 6 59 , 4 fill bit(6) unal /* reserved for future use */ 6 60 , 3 indicators_word_2 6 61 , 4 plud bit(18) unal /* primary log unit designator */ 6 62 /* bcd channel and channel number */ 6 63 6 64 , 4 slud bit(18) unal /* secondary log. unit designator */ 6 65 /* bcd channel and channel number */ 6 66 , 3 indicators_word_3 6 67 , 4 serial_no bit(30) unal /* tape serial number */ 6 68 , 4 pad bit( 6) unal /* unused */ 6 69 , 3 indicators_word_4 6 70 , 4 tape_name bit(72) unal /* tape name */ 6 71 6 72 , 2 current fixed bin(21) /* current file position */ 6 73 , 2 last fixed bin(21) /* eof for sequential disk files */ 6 74 , 2 size fixed bin(24) /* offset of end of file in words */ 6 75 , 2 init_size fixed bin(24) /* file size at start of activity */ 6 76 , 2 init_posit fixed bin(24) /* file position at start of activity */ 6 77 , 2 iocount fixed bin(35) /* total no. of i/o operations */ 6 78 , 2 rec_len fixed bin(24) /* length of current record (gcos_write_) */ 6 79 , 2 command_count fixed bin(17) unal /* size of command table for device (gcos_mme_inos_) */ 6 80 , 2 command_index fixed bin(17) unal /* pointer to command table entry (gcos_mme_inos_) */ 6 81 , 2 error_retry fixed bin(17) unal /* error retry counter */ 6 82 , 2 seq_no fixed bin(17) unal /* tape reel sequence no */ 6 83 ; 6 84 dcl fibptr ptr /* pointer to current fib in gcos_ext_stat_ */; 6 85 6 86 /* File usage classification constants: */ 6 87 dcl linked_file bit(1)static int options(constant)init("0"b); 6 88 dcl random_file bit(1)static int options(constant)init("1"b); 6 89 dcl read_file bit(1)static int options(constant)init("0"b); 6 90 dcl write_file bit(1)static int options(constant)init("1"b); 6 91 6 92 /* END INCLUDE FILE gcos_file_info_block_.incl.pl1 */ 1 110 1 111 1 112 dcl 1 gcos_ext_stat_$mc like mc /* machine condition from abort or fault */ ext; 7 1 /* */ 7 2 /* BEGIN INCLUDE FILE mc.incl.pl1 Created Dec 72 for 6180 - WSS. */ 7 3 /* Modified 06/07/76 by Greenberg for mc.resignal */ 7 4 /* Modified 07/07/76 by Morris for fault register data */ 7 5 /* Modified 08/28/80 by J. A. Bush for the DPS8/70M CVPU */ 7 6 /* Modified '82 to make values constant */ 7 7 7 8 /* words 0-15 pointer registers */ 7 9 7 10 dcl mcp ptr; 7 11 7 12 dcl 1 mc based (mcp) aligned, 7 13 2 prs (0:7) ptr, /* POINTER REGISTERS */ 7 14 (2 regs, /* registers */ 7 15 3 x (0:7) bit (18), /* index registers */ 7 16 3 a bit (36), /* accumulator */ 7 17 3 q bit (36), /* q-register */ 7 18 3 e bit (8), /* exponent */ 7 19 3 pad1 bit (28), 7 20 3 t bit (27), /* timer register */ 7 21 3 pad2 bit (6), 7 22 3 ralr bit (3), /* ring alarm register */ 7 23 7 24 2 scu (0:7) bit (36), 7 25 7 26 2 mask bit (72), /* mem controller mask at time of fault */ 7 27 2 ips_temp bit (36), /* Temporary storage for IPS info */ 7 28 2 errcode fixed bin (35), /* fault handler's error code */ 7 29 2 fim_temp, 7 30 3 unique_index bit (18) unal, /* unique index for restarting faults */ 7 31 3 resignal bit (1) unal, /* recompute signal name with fcode below */ 7 32 3 fcode bit (17) unal, /* fault code used as index to FIM table and SCT */ 7 33 2 fault_reg bit (36), /* fault register */ 7 34 2 pad2 bit (1), 7 35 2 cpu_type fixed bin (2) unsigned, /* L68 = 0, DPS8/70M = 1 */ 7 36 2 ext_fault_reg bit (15), /* extended fault reg for DPS8/70M CPU */ 7 37 2 fault_time bit (54), /* time of fault */ 7 38 7 39 2 eis_info (0:7) bit (36)) unaligned; 7 40 7 41 7 42 dcl (apx fixed bin init (0), 7 43 abx fixed bin init (1), 7 44 bpx fixed bin init (2), 7 45 bbx fixed bin init (3), 7 46 lpx fixed bin init (4), 7 47 lbx fixed bin init (5), 7 48 spx fixed bin init (6), 7 49 sbx fixed bin init (7)) internal static options (constant); 7 50 7 51 7 52 7 53 7 54 dcl scup ptr; 7 55 7 56 dcl 1 scu based (scup) aligned, /* SCU DATA */ 7 57 7 58 7 59 /* WORD (0) */ 7 60 7 61 (2 ppr, /* PROCEDURE POINTER REGISTER */ 7 62 3 prr bit (3), /* procedure ring register */ 7 63 3 psr bit (15), /* procedure segment register */ 7 64 3 p bit (1), /* procedure privileged bit */ 7 65 7 66 2 apu, /* APPENDING UNIT STATUS */ 7 67 3 xsf bit (1), /* ext seg flag - IT modification */ 7 68 3 sdwm bit (1), /* match in SDW Ass. Mem. */ 7 69 3 sd_on bit (1), /* SDW Ass. Mem. ON */ 7 70 3 ptwm bit (1), /* match in PTW Ass. Mem. */ 7 71 3 pt_on bit (1), /* PTW Ass. Mem. ON */ 7 72 3 pi_ap bit (1), /* Instr Fetch or Append cycle */ 7 73 3 dsptw bit (1), /* Fetch of DSPTW */ 7 74 3 sdwnp bit (1), /* Fetch of SDW non paged */ 7 75 3 sdwp bit (1), /* Fetch of SDW paged */ 7 76 3 ptw bit (1), /* Fetch of PTW */ 7 77 3 ptw2 bit (1), /* Fetch of pre-paged PTW */ 7 78 3 fap bit (1), /* Fetch of final address paged */ 7 79 3 fanp bit (1), /* Fetch of final address non-paged */ 7 80 3 fabs bit (1), /* Fetch of final address absolute */ 7 81 7 82 2 fault_cntr bit (3), /* number of retrys of EIS instructions */ 7 83 7 84 7 85 /* WORD (1) */ 7 86 7 87 2 fd, /* FAULT DATA */ 7 88 3 iro bit (1), /* illegal ring order */ 7 89 3 oeb bit (1), /* out of execute bracket */ 7 90 3 e_off bit (1), /* no execute */ 7 91 3 orb bit (1), /* out of read bracket */ 7 92 3 r_off bit (1), /* no read */ 7 93 3 owb bit (1), /* out of write bracket */ 7 94 3 w_off bit (1), /* no write */ 7 95 3 no_ga bit (1), /* not a gate */ 7 96 3 ocb bit (1), /* out of call bracket */ 7 97 3 ocall bit (1), /* outward call */ 7 98 3 boc bit (1), /* bad outward call */ 7 99 3 inret bit (1), /* inward return */ 7 100 3 crt bit (1), /* cross ring transfer */ 7 101 3 ralr bit (1), /* ring alarm register */ 7 102 3 am_er bit (1), /* associative memory fault */ 7 103 3 oosb bit (1), /* out of segment bounds */ 7 104 3 paru bit (1), /* processor parity upper */ 7 105 3 parl bit (1), /* processor parity lower */ 7 106 3 onc_1 bit (1), /* op not complete type 1 */ 7 107 3 onc_2 bit (1), /* op not complete type 2 */ 7 108 7 109 2 port_stat, /* PORT STATUS */ 7 110 3 ial bit (4), /* illegal action lines */ 7 111 3 iac bit (3), /* illegal action channel */ 7 112 3 con_chan bit (3), /* connect channel */ 7 113 7 114 2 fi_num bit (5), /* (fault/interrupt) number */ 7 115 2 fi_flag bit (1), /* 1 => fault, 0 => interrupt */ 7 116 7 117 7 118 /* WORD (2) */ 7 119 7 120 2 tpr, /* TEMPORARY POINTER REGISTER */ 7 121 3 trr bit (3), /* temporary ring register */ 7 122 3 tsr bit (15), /* temporary segment register */ 7 123 7 124 2 pad2 bit (9), 7 125 7 126 2 cpu_no bit (3), /* CPU number */ 7 127 7 128 2 delta bit (6), /* tally modification DELTA */ 7 129 7 130 7 131 /* WORD (3) */ 7 132 7 133 2 word3 bit (18), 7 134 7 135 2 tsr_stat, /* TSR STATUS for 1,2,&3 word instructions */ 7 136 3 tsna, /* Word 1 status */ 7 137 4 prn bit (3), /* Word 1 PR number */ 7 138 4 prv bit (1), /* Word 1 PR valid bit */ 7 139 3 tsnb, /* Word 2 status */ 7 140 4 prn bit (3), /* Word 2 PR number */ 7 141 4 prv bit (1), /* Word 2 PR valid bit */ 7 142 3 tsnc, /* Word 3 status */ 7 143 4 prn bit (3), /* Word 3 PR number */ 7 144 4 prv bit (1), /* Word 3 PR valid bit */ 7 145 7 146 2 tpr_tbr bit (6), /* TPR.TBR field */ 7 147 7 148 7 149 /* WORD (4) */ 7 150 7 151 2 ilc bit (18), /* INSTRUCTION COUNTER */ 7 152 7 153 2 ir, /* INDICATOR REGISTERS */ 7 154 3 zero bit (1), /* zero indicator */ 7 155 3 neg bit (1), /* negative indicator */ 7 156 3 carry bit (1), /* carryry indicator */ 7 157 3 ovfl bit (1), /* overflow indicator */ 7 158 3 eovf bit (1), /* eponent overflow */ 7 159 3 eufl bit (1), /* exponent underflow */ 7 160 3 oflm bit (1), /* overflow mask */ 7 161 3 tro bit (1), /* tally runout */ 7 162 3 par bit (1), /* parity error */ 7 163 3 parm bit (1), /* parity mask */ 7 164 3 bm bit (1), /* ^bar mode */ 7 165 3 tru bit (1), /* truncation mode */ 7 166 3 mif bit (1), /* multi-word instruction mode */ 7 167 3 abs bit (1), /* absolute mode */ 7 168 3 pad bit (4), 7 169 7 170 7 171 /* WORD (5) */ 7 172 7 173 2 ca bit (18), /* COMPUTED ADDRESS */ 7 174 7 175 2 cu, /* CONTROL UNIT STATUS */ 7 176 3 rf bit (1), /* on first cycle of repeat instr */ 7 177 3 rpt bit (1), /* repeat instruction */ 7 178 3 rd bit (1), /* repeat double instruction */ 7 179 3 rl bit (1), /* repeat link instruciton */ 7 180 3 pot bit (1), /* IT modification */ 7 181 3 pon bit (1), /* return type instruction */ 7 182 3 xde bit (1), /* XDE from Even location */ 7 183 3 xdo bit (1), /* XDE from Odd location */ 7 184 3 poa bit (1), /* operation preparation */ 7 185 3 rfi bit (1), /* tells CPU to refetch instruction */ 7 186 3 its bit (1), /* ITS modification */ 7 187 3 if bit (1), /* fault occured during instruction fetch */ 7 188 7 189 2 cpu_tag bit (6)) unaligned, /* computed tag field */ 7 190 7 191 7 192 /* WORDS (6,7) */ 7 193 7 194 2 even_inst bit (36), /* even instruction of faulting pair */ 7 195 7 196 2 odd_inst bit (36); /* odd instruction of faulting pair */ 7 197 7 198 7 199 7 200 7 201 7 202 7 203 /* ALTERNATE SCU DECLARATION */ 7 204 7 205 7 206 dcl 1 scux based (scup) aligned, 7 207 7 208 (2 pad0 bit (36), 7 209 7 210 2 fd, /* GROUP II FAULT DATA */ 7 211 3 isn bit (1), /* illegal segment number */ 7 212 3 ioc bit (1), /* illegal op code */ 7 213 3 ia_am bit (1), /* illegal address - modifier */ 7 214 3 isp bit (1), /* illegal slave procedure */ 7 215 3 ipr bit (1), /* illegal procedure */ 7 216 3 nea bit (1), /* non existent address */ 7 217 3 oobb bit (1), /* out of bounds */ 7 218 3 pad bit (29), 7 219 7 220 2 pad2 bit (36), 7 221 7 222 2 pad3a bit (18), 7 223 7 224 2 tsr_stat (0:2), /* TSR STATUS as an ARRAY */ 7 225 3 prn bit (3), /* PR number */ 7 226 3 prv bit (1), /* PR valid bit */ 7 227 7 228 2 pad3b bit (6)) unaligned, 7 229 7 230 2 pad45 (0:1) bit (36), 7 231 7 232 2 instr (0:1) bit (36); /* Instruction ARRAY */ 7 233 7 234 7 235 7 236 /* END INCLUDE FILE mc.incl.pl1 */ 1 113 1 114 1 115 dcl 1 gcos_ext_stat_$gcos_gtss ext 1 116 , 3 gcos_gtss_ext 1 117 , 4 u_state_ptr ptr 1 118 , 4 snumb_index fixed bin(24) 1 119 , 4 home_path char(168) 1 120 ; 1 121 1 122 /* END INCLUDE FILE gcos_ext_stat_.incl.pl1 */ 100 101 102 103 /* External Entries */ 104 105 106 dcl gcos_cv_ascii_gebcd_ ext entry (ptr, fixed bin(24), ptr, fixed bin(24)); 107 dcl gcos_open_file_ ext entry (char (*), char (*), ptr, bit (1)); 108 dcl gcos_open_file_$sysout ext entry (char (*), bit (1)); 109 dcl gcos_get_cc_field_ ext entry (char (80), char (*), fixed bin(24)); 110 dcl gcos_get_cc_field_$asis entry (char (80), char (*), fixed bin(24)); 111 dcl gcos_error_ ext entry options (variable); 112 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin(35)); 113 dcl gcos_interpret_file_string_ entry (char (*) varying, char (*), fixed bin(24), char (80)); 114 dcl ioa_ entry options (variable); 115 dcl gcos_write_to_er_ entry options (variable); 116 dcl gcos_et_$cc_unimp fixed bin(35) ext; 117 dcl gcos_et_$cc_bad_field fixed bin(35) ext; 118 dcl gcos_et_$cc_missing_field fixed bin(35) ext; 119 dcl gcos_et_$cc_bad_fc fixed bin(35) ext; 120 dcl gcos_et_$cc_bad_lud fixed bin(35) ext; 121 122 123 124 /* Work Variables */ 125 126 127 dcl card char (80); /* input card image */ 128 dcl message char (50); 129 dcl dac_sw bit (1); 130 dcl present bit (1); 131 dcl (null_file, type_file, file_file) bit (1) init ("0"b); 132 dcl fc char (2); /* file code */ 133 dcl lud char (6) init (" "); /* logical unit designator */ 134 dcl disp char (1) ; /* normal disposition */ 135 dcl adisp char (1) ; /* abort disposition */ 136 dcl cfdesc_field char (50); 137 138 dcl field char (6); /* holder for a field from a card */ 139 dcl tape_name char (12); 140 dcl tape_serial_number char (5); 141 dcl prmfl_fc_field char (8); 142 dcl temp_tracks bit (2); /* temporary for fib.tracks */ 143 dcl (i, j, k, digit, cp) fixed bin(24); /* temps */ 144 dcl code fixed bin(35); 145 dcl result fixed bin(24); /* holds result code from gcos_get_cc_field_ */ 146 dcl abs bit (72) aligned; /* an aligned string for xlation */ 147 148 dcl x char (1); /* temp */ 149 dcl path char (200) ; /* holds pathname of permanent file */ 150 dcl prmfl_path char (168*2) varying ; /* to hold the path or file string before we know which it is */ 151 dcl path_type fixed bin(24); /* 0=dont know; 1=path;2=file string */ 152 dcl etc_next_sw bit (1) aligned ; /* if path continued on etc card */ 153 dcl dirname char (168); 154 dcl ename char (32); 155 156 dcl DENS_CHARS (6) char (5) static internal options (constant) 157 init ("den2", "den5", "den8", "den9", "den16", "den62"); 158 dcl DENS_BITS (6) bit (4) static internal options (constant) 159 init ("0001"b, "0010"b, "0100"b, "0000"b, "1001"b, "1100"b); 160 dcl END_OF_CARD fixed bin(24)static internal options (constant) init (2); 161 dcl MULTICS_PATHNAME fixed bin(24)static internal options (constant) init (1); 162 dcl GCOS_CFDESC fixed bin(24)static internal options (constant) init (2); 163 dcl 1 PERM (18) aligned static internal options (constant), 164 2 NAME char (8) init ("r", "w", "a", "e", "x", "rec", "r/c", "w/c", "q", "t", "t/c", "c", "l", "r/w/c", "r/a", "r/w", "a/r", "w/r"), 165 2 READ bit (1) init ("1"b, "1"b, "1"b, "1"b, "1"b, "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, "0"b, "1"b, "1"b, "1"b, "1"b), 166 2 WRITE bit (1) init ("0"b, "1"b, "1"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "1"b, "0"b, "1"b, "1"b, "1"b, "1"b), 167 2 SUPPORTED bit (1) init ("1"b, "1"b, "1"b, "1"b, "1"b, "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, "0"b, "1"b, "1"b, "1"b, "1"b); 168 169 dcl (addr, fixed, index, length, null, substr, unspec, verify) builtin; 170 171 cc_read: entry (card); 172 173 call gcos_error_ (gcos_et_$cc_unimp, "^/^a^2x^a", gcos_ext_stat_$card_num, card); 174 175 cc_print: entry (card); 176 177 call Open_File; /* set up fib */ 178 fib.print = "1"b; /* indicate printfile */ 179 return; 180 181 cc_punch: entry (card); 182 183 call Open_File; /* set up fib */ 184 fib.punch = "1"b; /* indicate punch file */ 185 fib.write = "1"b; 186 return; 187 188 cc_file: entry (card); 189 190 file_file = "1"b; 191 call Open_File; /* set up fib */ 192 if null_file then return; 193 194 cp = 1; /* init scan counter */ 195 call gcos_get_cc_field_ (card, field, result); /* get access field */ 196 if result ^= 0 then fib.size = 3840; 197 else do; 198 j = 0; /* clear accumulator */ 199 200 loop: i = fixed (unspec (substr (field, cp, 1)), 17); /* get next col in numeric form */ 201 202 if i >= 48 then if i <= 57 then do; /* ascii numeral ? */ 203 cp = cp+1; /* advance col indicator */ 204 j = j*10+i-48; /* shift accumulator */ 205 go to loop; /* see if any more digits */ 206 end; 207 208 if j ^= 0 then fib.size = 3840*j; /* set specified no. of links */ 209 else do; 210 call gcos_write_to_er_ ("Warning: File size specified is zero. Assuming 1 link.^/^a^2x^a", 211 gcos_ext_stat_$card_num, card); 212 fib.size = 3840; 213 end; 214 if substr (field, cp) = "r" then /* random file ? */ 215 fib.type = "1"b; /* yes...indicate such */ 216 else if substr (field, cp) = "l" then; 217 else call gcos_write_to_er_ ( 218 "Warning: Unknown access mode ""^a"" specified. Assuming ""l"".^/^a^2x^a", 219 substr (field, cp), gcos_ext_stat_$card_num, card); 220 end; 221 222 223 /* at this point some test should be made for NEW or OLD in the next field */ 224 225 226 fib.read, fib.write = "1"b; /* turn on indicators */ 227 return; 228 229 cc_tape7: entry (card); 230 231 temp_tracks = "01"b; /* indicates 7 track */ 232 goto tape_common; 233 234 cc_tape9: entry (card); 235 236 temp_tracks = "10"b; /* indicates 9 track */ 237 goto tape_common; 238 239 cc_tape: entry (card); 240 241 /* GCOS default is 7track tape; Multics default is installation dependent, 242* and is often 9track, with NO 7track drives installed in the system. 243* 244* 245* /* temp_tracks = "01"b; */ 246 tape_common: 247 call Open_File; /* set up fib */ 248 fib.tape = "1"b; /* indicate tape */ 249 250 fib.tracks = temp_tracks; /* save tape type requested */ 251 252 fib.serial_no = (5)"010000"b; /* blank(bcd) serial no */ 253 fib.tape_name = (12)"010000"b; /* and tape name */ 254 fib.seq_no = 1; /* default reel sequence number */ 255 256 if index (card, " -noring") = 0 & /* see if "no ring" option is present */ 257 index (card, " -nr") = 0 then fib.write = "1"b; /* default is to use a ring */ 258 259 /* For now, the secondary logical unit designator will be ignored since */ 260 /* multi-reel files won't be needed for awhile. */ 261 262 call gcos_get_cc_field_ (card, field, result); /* skip slud */ 263 264 call gcos_get_cc_field_ (card, tape_serial_number, result); /* get serial no. */ 265 266 if result = END_OF_CARD then return; /* done if end of card */ 267 if result = 0 then do; 268 call gcos_cv_ascii_gebcd_ (addr (tape_serial_number), 5, addr (abs), i); /* convert serial no to bcd */ 269 fib.serial_no = substr (abs, 1, 30); /* fill in fib with returned value */ 270 end; 271 272 273 /* Come here to extract reel sequence number */ 274 275 call gcos_get_cc_field_ (card, field, result); /* get it */ 276 if result = END_OF_CARD then return; /* done if end of card */ 277 if result = 0 then do; /* if null field, go get tape name */ 278 279 i = index (field, " ")-1; /* get length of seq_no */ 280 if i < 0 then i = length (field); 281 k = 0; /* init accumulator */ 282 283 do j = 1 to i; /* loop to convert char string to binary */ 284 digit = index ("0123456789", substr (field, j, 1)); /* look up digit */ 285 if digit = 0 then call gcos_error_ (gcos_et_$cc_bad_field, 286 """^a""^/^a^2x^a", field, 287 gcos_ext_stat_$card_num, card); 288 k = k*10+digit-1; /* add to accumulator */ 289 end; 290 291 fib.seq_no = k; /* store in fib */ 292 end; 293 294 295 /* Come here to extract tape name */ 296 297 call gcos_get_cc_field_ (card, tape_name, result); /* get name */ 298 if result = END_OF_CARD then return; /* done if end of card */ 299 if result = 0 then do; 300 call gcos_cv_ascii_gebcd_ (addr (tape_name), 12, addr (abs), i); /* convert to bcd */ 301 fib.tape_name = abs; /* move to fib */ 302 end; 303 304 fib.density = "1111"b; /* set density default */ 305 call gcos_get_cc_field_ (card, field, result); /* skip class field */ 306 if result = END_OF_CARD then return; 307 308 call gcos_get_cc_field_ (card, field, result); /* get density field */ 309 if result ^= 0 then return; /* done if not there */ 310 311 do i = lbound (DENS_CHARS, 1) to hbound (DENS_CHARS, 1); 312 if field = DENS_CHARS (i) then do; 313 fib.density = DENS_BITS (i); 314 return; /* that's all */ 315 end; 316 end; 317 318 call gcos_error_ (gcos_et_$cc_bad_field, 319 "Illegal density specification.^/^a^2x^a""", 320 gcos_ext_stat_$card_num, card); 321 322 cc_type: entry (card); 323 324 type_file = "1"b; 325 call Open_File; 326 return; 327 328 cc_dac: entry (card); 329 330 dac_sw = "1"b; /* share code with cc_sysout */ 331 go to sysout_open; 332 333 cc_sysout: entry (card); 334 335 dac_sw = "0"b; 336 337 sysout_open: ; 338 if ^gcos_ext_stat_$save_data.activ then call gcos_write_to_er_ ( 339 "Warning: The following $ SYSOUT control card has been found outside an activity definition and is being ignored.^/^a^2x^a", 340 gcos_ext_stat_$card_num, card); 341 342 call gcos_get_cc_field_ (card, field, result); 343 if result ^= 0 then call gcos_error_ (gcos_et_$cc_missing_field, 344 "File code missing.^/^a^2x^a", 345 gcos_ext_stat_$card_num, card); 346 347 fc = substr (field, 1, length (fc)); 348 349 if verify (fc, "0123456789.abcdefghijklmnopqrstuvwxyz*") ^= 0 | fc = "00" then 350 call gcos_error_ (gcos_et_$cc_bad_fc, """^a""^/^a^2x^a", fc, 351 gcos_ext_stat_$card_num, card); 352 353 call gcos_open_file_$sysout (field, dac_sw); 354 return; 355 356 cc_prmfl: entry (card); 357 358 /* Pick up the filecode and open the file */ 359 360 call gcos_get_cc_field_ (card, prmfl_fc_field, result); 361 if result ^= 0 then call gcos_error_ (gcos_et_$cc_missing_field, 362 "File code missing.^/^a^2x^a", gcos_ext_stat_$card_num, card); 363 364 fc = substr (prmfl_fc_field, 1, 2); /* pick up filecode */ 365 if verify (fc, "0123456789.abcdefghijklmnopqrstuvwxyz*") ^= 0 | fc = "00" then 366 call gcos_error_ (gcos_et_$cc_bad_fc, 367 """^a"" is not a valid file code.^/^a^2x^a", fc, 368 gcos_ext_stat_$card_num, card); 369 370 x = substr (prmfl_fc_field, 3, 1); /* must be blank or slash */ 371 if x ^= " " then if x ^= "/" then 372 call gcos_error_ (gcos_et_$cc_bad_fc, "^a^2x^a", 373 gcos_ext_stat_$card_num, card); 374 375 /* If FC/LUD was given, process the LUD */ 376 377 if x = "/" then lud = substr (prmfl_fc_field, 4); 378 379 call Open_Prmfl; /* get a fib and decode lud */ 380 381 fib.perm = "1"b; 382 383 /* Set access bits from permit field. */ 384 385 call gcos_get_cc_field_ (card, field, result); 386 if result ^= 0 then call gcos_error_ (gcos_et_$cc_missing_field, 387 "Access field missing from $ PRMFL card.^/^a^2x^a", 388 gcos_ext_stat_$card_num, card); 389 390 do i = lbound (PERM, 1) to hbound (PERM, 1); 391 if PERM (i).NAME = field then do; 392 if ^PERM (i).SUPPORTED then call gcos_error_ (gcos_et_$cc_bad_field, 393 "Unsupported access mode. ""^a""^/^a^2x^a", field, 394 gcos_ext_stat_$card_num, card); 395 fib.write = PERM (i).WRITE; 396 fib.read = PERM (i).READ; 397 goto permissions_done; 398 end; 399 end; 400 call gcos_error_ (gcos_et_$cc_bad_field, 401 "Unrecognized permission ""^a"".^/^a^2x^a", field, 402 gcos_ext_stat_$card_num, card); 403 404 405 permissions_done: 406 407 call gcos_get_cc_field_ (card, field, result); 408 if result ^= 0 then call gcos_error_ (gcos_et_$cc_missing_field, 409 "An access mode is required.^/^a^2x^a", 410 gcos_ext_stat_$card_num, card); 411 412 if substr (field, 2, 1) ^= " " then call gcos_error_ (gcos_et_$cc_bad_field, 413 """^a"" is not a valid access mode.^/^a^2x^a", field, gcos_ext_stat_$card_num, card); 414 if substr (field, 1, 1) = "r" then fib.type = "1"b; /* turn on random bit */ 415 else if substr (field, 1, 1) = "l" then fib.type = "0"b; /* turn off random bit */ 416 else if substr (field, 1, 1) = "s" then fib.type = "0"b; /* same as "l" */ 417 else call gcos_error_ (gcos_et_$cc_bad_field, "Access not ""r"", ""s"", or ""l"".^/^a^2x^a", 418 gcos_ext_stat_$card_num, card); 419 420 /* Process pathname field of the card. Here we deviate from the gcos format of: 421* 422* catalog1$password1/...catalogn$passwordn/filename$password 423* 424* and allow full or partial Multics pathnames to be supplied as an alternative. Continuation 425* of the pathname via a $ etc card is possible by following a > or / with a blank. */ 426 427 path_type = 0; 428 prmfl_path = ""; 429 430 431 get_path: call gcos_get_cc_field_$asis (card, cfdesc_field, result); 432 if result ^= 0 then do; 433 if etc_next_sw then call gcos_error_ (gcos_et_$cc_missing_field, 434 "A $ ETC card is in error or missing at card number ^a.", 435 gcos_ext_stat_$card_num); 436 else call gcos_error_ (gcos_et_$cc_missing_field, 437 "^a^2x^a", 438 gcos_ext_stat_$card_num, card); 439 end; 440 441 i = index (cfdesc_field, " ")-1; /* find the end */ 442 if (i < 0) | (index(substr(card,16,73-15)," ")=0) then do; 443 call gcos_write_to_er_ ("Warning: Check for a pathname or catalog/filename description overflow into column 73.^a^2x^a", 444 gcos_ext_stat_$card_num, card); 445 if ^gcos_ext_stat_$save_data.brief then call ioa_ ("Warning: Check for a pathname or catalog/filename description overflow into column 73.^/^a^2x^a", 446 gcos_ext_stat_$card_num, card); 447 i = length (cfdesc_field); 448 end; 449 x = substr (cfdesc_field, i, 1); /* look at last character */ 450 if x = ">" then do; /* if continued Multics pathname */ 451 etc_next_sw = "1"b; /* remember continuation */ 452 if path_type = GCOS_CFDESC then call gcos_error_ (gcos_et_$cc_bad_field, 453 "Terminator on this $ ETC card is incompatable with the previous card.^/^a^2x^a", 454 gcos_ext_stat_$card_num, card); 455 path_type = MULTICS_PATHNAME; /* remember its a pathname */ 456 end; 457 458 else if x = "/" then do; /* if continued GCOS file string */ 459 etc_next_sw = "1"b; /* remember continuation */ 460 if path_type = MULTICS_PATHNAME then call gcos_error_ (gcos_et_$cc_bad_field, 461 "Terminator on this $ ETC card is incompatable with the previous card.^/^a^2x^a", 462 gcos_ext_stat_$card_num, card); 463 path_type = GCOS_CFDESC; /* remember its a file string */ 464 end; 465 else etc_next_sw = "0"b; 466 467 if length (prmfl_path) >= 168*2 then call gcos_error_ (gcos_et_$cc_bad_field, 468 "Pathname or Catalog/Filename description is too long. ""^a""^/^a^2x^a", prmfl_path, 469 gcos_ext_stat_$card_num, card); 470 prmfl_path = prmfl_path || substr (cfdesc_field, 1, i); /* save (partial?) pathname */ 471 472 if etc_next_sw then do; /* if continuation was indicated */ 473 gcos_ext_stat_$gf = 3; /* fool gcos_get_cc_cfdesc_field_ into reading a $ ETC card */ 474 goto get_path; /* and go call it */ 475 end; 476 477 if path_type = 0 then do; /* if we don't know what kind of path it is 478* we will have to figure it out heuristically */ 479 i = index (prmfl_path, "/"); /* a file string must have at least one slash */ 480 if i = 0 then path_type = MULTICS_PATHNAME; /* if it doesn't, it has to be a pathname */ 481 else do; /* otherwise, we are still not sure, since 482* a pathname could contain a slash */ 483 i = search (prmfl_path, "<>"); /* see if it has a < or > in it */ 484 if i = 0 then path_type = GCOS_CFDESC; /* if not, assume a file string */ 485 else /* but if it does, Multics is going to treat it as a pathname */ 486 path_type = MULTICS_PATHNAME; /* even if the user intended it to be a file string */ 487 end; 488 489 end; 490 491 if path_type = GCOS_CFDESC then call gcos_interpret_file_string_ (prmfl_path, path, k, card); 492 else path = prmfl_path; 493 494 495 /* Path holds pathname of file at this point */ 496 497 call expand_pathname_ (path, dirname, ename, code); 498 if code ^= 0 then call gcos_error_ (code, """^a""^/^a^2x^a", path, 499 gcos_ext_stat_$card_num, card); 500 if dirname = ">" then fib.pathnm = ">" || ename; 501 else fib.pathnm = rtrim (dirname) || ">" || ename; 502 503 exit: return; /* no more to do */ 504 505 506 /* I N T E R N A L P R O C E D U R E S */ 507 508 509 /* get file code and lud from control card */ 510 511 Open_File: proc; 512 513 call gcos_get_cc_field_ (card, field, result); /* get file code from card */ 514 if result ^= 0 then call gcos_error_ (gcos_et_$cc_missing_field, "File code missing.^/^a^2x^a", 515 gcos_ext_stat_$card_num, card); 516 517 fc = substr (field, 1, length (fc)); /* save file code */ 518 if fc = "00" | verify (fc, ".abcdefghijklmnopqrstuvwxyz0123456789*") ^= 0 then 519 call gcos_error_ (gcos_et_$cc_bad_fc, """^a""^/^a^2x^a", fc, gcos_ext_stat_$card_num, card); 520 521 /* Process logical unit designator */ 522 523 lud = ""; 524 call gcos_get_cc_field_ (card, field, result); /* get logical unit designator */ 525 if result = 0 then do; /* if no lud supplied, use defaults */ 526 if field = "null" & file_file then null_file = "1"b; 527 else lud = field; 528 end; 529 530 531 /* Get a fib and process the logical unit designator and disposition */ 532 533 Open_Prmfl: entry; 534 535 if ^gcos_ext_stat_$save_data.activ then do; 536 call gcos_write_to_er_ ( 537 "Warning: The following file card has been found outside an activity and is being ignored.^/^a^2x^a", 538 gcos_ext_stat_$card_num, card); 539 goto exit; 540 end; 541 542 disp, adisp = ""; 543 if lud ^= " " then do; /* check for no lud specified */ 544 if substr (lud, 6, 1) ^= " " then call gcos_error_ (gcos_et_$cc_bad_lud, 545 """^a""^/^a^2x^a", lud, gcos_ext_stat_$card_num, card); 546 if verify (substr (lud, 1, 1), "abcdefghijklmnopqrstuvwxyz0123456789") ^= 0 then 547 call gcos_error_ (gcos_et_$cc_bad_lud, 548 "The first character of a LUD must be alphanumeric. ""^a""^/^a^2x^a", lud, 549 gcos_ext_stat_$card_num, card); 550 cp = verify (substr (lud, 2), "01234567890*")-1; /* separate dispositiin from lud */ 551 552 if cp = 0 then call gcos_error_ (gcos_et_$cc_bad_lud, 553 "Device name LUDs are not supported by the Multics GCOS Environment. ""^a""^/^a^2x^a", 554 lud, gcos_ext_stat_$card_num, card); 555 556 disp = substr (lud, cp+2, 1); 557 if cp+3 < length (lud) then 558 adisp = substr (lud, cp+3, 1); 559 lud = substr (lud, 1, cp+1); 560 end; 561 562 if type_file then do; /* $ TYPE card */ 563 lud = "ty1"; /* "ty1" is always present for t* */ 564 disp, adisp = "s"; 565 end; 566 567 call gcos_open_file_ (fc, lud, fibptr, present); 568 569 if null_file then do; /* is this $ FILE FC,NULL ? */ 570 fib.null = "1"b; 571 goto exit; /* bypass setting of type and access */ 572 end; 573 574 fib.disp = decode_disp (disp); /* decode normal disposition */ 575 576 if adisp ^= " " then /* abort disposition present ? */ 577 fib.adisp = decode_disp (adisp); /* yes - decode it */ 578 579 else fib.adisp = fib.disp; /* no - make it the same as the normal disposition */ 580 581 if present then go to exit; /* do not set other attributes for an existing file */ 582 return; 583 584 decode_disp: proc (dsp) returns (bit (2)); 585 586 587 dcl dsp char (1); 588 589 590 decode_disp: if dsp = " " then return ("01"b); /* blank = release */ 591 if dsp = "r" then return ("01"b); /* R = release */ 592 if dsp = "s" then return ("10"b); /* S = save */ 593 if dsp = "c" then return ("11"b); /* C = continue */ 594 if dsp = "d" then return ("00"b); /* D = dismount */ 595 if dsp = "p" then do; /* P = purge */ 596 fib.purge = "1"b; 597 return ("01"b); 598 end; 599 call gcos_write_to_er_ ( 600 "Warning: ""^a"" is a bad disposition character. A disposition of ""r"" is being assumed.", dsp); 601 return ("01"b); 602 603 end decode_disp; 604 605 606 end Open_File; 607 608 609 end gcos_cc_file_cards_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/09/83 1006.8 gcos_cc_file_cards_.pl1 >spec>on>09/07/83-gcos>gcos_cc_file_cards_.pl1 100 1 09/08/83 1229.3 gcos_ext_stat_.incl.pl1 >spec>on>09/07/83-gcos>gcos_ext_stat_.incl.pl1 1-100 2 03/27/82 0424.8 gcos_save_mc.incl.pl1 >ldd>include>gcos_save_mc.incl.pl1 1-104 3 03/27/82 0424.8 gcos_fct_entry.incl.pl1 >ldd>include>gcos_fct_entry.incl.pl1 1-108 4 03/27/82 0424.8 gcos_save_data_entry.incl.pl1 >ldd>include>gcos_save_data_entry.incl.pl1 4-29 5 09/08/83 1230.3 gcos_flags.incl.pl1 >spec>on>09/07/83-gcos>gcos_flags.incl.pl1 1-110 6 03/27/82 0424.8 gcos_file_info_block_.incl.pl1 >ldd>include>gcos_file_info_block_.incl.pl1 1-113 7 08/17/83 1135.7 mc.incl.pl1 >ldd>include>mc.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. DENS_BITS 000132 constant bit(4) initial array unaligned dcl 158 ref 313 DENS_CHARS 000133 constant char(5) initial array unaligned dcl 156 ref 311 311 312 END_OF_CARD constant fixed bin(24,0) initial dcl 160 ref 266 276 298 306 GCOS_CFDESC constant fixed bin(24,0) initial dcl 162 ref 452 463 484 491 MULTICS_PATHNAME constant fixed bin(24,0) initial dcl 161 ref 455 460 480 485 NAME 000000 constant char(8) initial array level 2 dcl 163 ref 391 PERM 000000 constant structure array level 1 dcl 163 ref 390 390 READ 2 000000 constant bit(1) initial array level 2 dcl 163 ref 396 SUPPORTED 4 000000 constant bit(1) initial array level 2 dcl 163 ref 392 WRITE 3 000000 constant bit(1) initial array level 2 dcl 163 ref 395 abs 000154 automatic bit(72) dcl 146 set ref 268 268 269 300 300 301 activ 0(04) 000014 external static bit(1) level 4 packed unaligned dcl 1-106 ref 338 535 addr builtin function dcl 169 ref 268 268 268 268 300 300 300 300 adisp 000113 automatic char(1) unaligned dcl 135 in procedure "gcos_cc_file_cards_" set ref 542* 557* 564* 576 576* adisp 60(16) based bit(2) level 4 in structure "fib" packed unaligned dcl 6-10 in procedure "gcos_cc_file_cards_" set ref 576* 579* brief 0(15) 000014 external static bit(1) level 4 packed unaligned dcl 1-106 ref 445 card parameter char(80) unaligned dcl 127 set ref 94 171 173* 175 181 188 195* 210* 217* 229 234 239 256 256 262* 264* 275* 285* 297* 305* 308* 318* 322 328 333 338* 342* 343* 349* 356 360* 361* 365* 371* 385* 386* 392* 400* 405* 408* 412* 417* 431* 436* 442 443* 445* 452* 460* 467* 491* 498* 513* 514* 518* 524* 536* 544* 546* 552* cfdesc_field 000114 automatic char(50) unaligned dcl 136 set ref 431* 441 447 449 470 code 000152 automatic fixed bin(35,0) dcl 144 set ref 497* 498 498* cp 000151 automatic fixed bin(24,0) dcl 143 set ref 194* 200 203* 203 214 216 217 217 550* 552 556 557 557 559 dac_sw 000102 automatic bit(1) unaligned dcl 129 set ref 330* 335* 353* density 60(23) based bit(4) level 4 packed unaligned dcl 6-10 set ref 304* 313* digit 000150 automatic fixed bin(24,0) dcl 143 set ref 284* 285 288 dirname 000370 automatic char(168) unaligned dcl 153 set ref 497* 500 501 disp 60(14) based bit(2) level 4 in structure "fib" packed unaligned dcl 6-10 in procedure "gcos_cc_file_cards_" set ref 574* 579 disp 000112 automatic char(1) unaligned dcl 134 in procedure "gcos_cc_file_cards_" set ref 542* 556* 564* 574* dsp parameter char(1) unaligned dcl 587 set ref 584 590 591 592 593 594 595 599* ename 000442 automatic char(32) unaligned dcl 154 set ref 497* 500 501 etc_next_sw 000367 automatic bit(1) dcl 152 set ref 433 451* 459* 465* 472 expand_pathname_ 000032 constant entry external dcl 112 ref 497 fc 000107 automatic char(2) unaligned dcl 132 set ref 347* 347 349 349 349* 364* 365 365 365* 517* 517 518 518 518* 567* fct_entry based structure level 1 dcl 3-3 fib based structure level 1 dcl 6-10 fibptr 000100 automatic pointer dcl 6-84 set ref 178 184 185 196 208 212 214 226 226 248 250 252 253 254 256 269 291 301 304 313 381 395 396 414 415 416 500 501 567* 570 574 576 579 579 596 field 000132 automatic char(6) unaligned dcl 138 set ref 195* 200 214 216 217 217 262* 275* 279 280 284 285* 305* 308* 312 342* 347 353* 385* 391 392* 400* 405* 412 412* 414 415 416 513* 517 524* 526 527 file_file 000106 automatic bit(1) initial unaligned dcl 131 set ref 131* 190* 526 fixed builtin function dcl 169 ref 200 flags based structure level 1 dcl 5-8 flgs 000014 external static structure level 3 dcl 1-106 gcos_cv_ascii_gebcd_ 000016 constant entry external dcl 106 ref 268 300 gcos_error_ 000030 constant entry external dcl 111 ref 173 285 318 343 349 361 365 371 386 392 400 408 412 417 433 436 452 460 467 498 514 518 544 546 552 gcos_et_$cc_bad_fc 000050 external static fixed bin(35,0) dcl 119 set ref 349* 365* 371* 518* gcos_et_$cc_bad_field 000044 external static fixed bin(35,0) dcl 117 set ref 285* 318* 392* 400* 412* 417* 452* 460* 467* gcos_et_$cc_bad_lud 000052 external static fixed bin(35,0) dcl 120 set ref 544* 546* 552* gcos_et_$cc_missing_field 000046 external static fixed bin(35,0) dcl 118 set ref 343* 361* 386* 408* 433* 436* 514* gcos_et_$cc_unimp 000042 external static fixed bin(35,0) dcl 116 set ref 173* gcos_ext_stat_$card_num 000010 external static picture(4) unaligned dcl 1-18 set ref 173* 210* 217* 285* 318* 338* 343* 349* 361* 365* 371* 386* 392* 400* 408* 412* 417* 433* 436* 443* 445* 452* 460* 467* 498* 514* 518* 536* 544* 546* 552* gcos_ext_stat_$gf 000012 external static fixed bin(24,0) dcl 1-28 set ref 473* gcos_ext_stat_$save_data 000014 external static structure level 1 dcl 1-106 gcos_get_cc_field_ 000024 constant entry external dcl 109 ref 195 262 264 275 297 305 308 342 360 385 405 513 524 gcos_get_cc_field_$asis 000026 constant entry external dcl 110 ref 431 gcos_interpret_file_string_ 000034 constant entry external dcl 113 ref 491 gcos_open_file_ 000020 constant entry external dcl 107 ref 567 gcos_open_file_$sysout 000022 constant entry external dcl 108 ref 353 gcos_write_to_er_ 000040 constant entry external dcl 115 ref 210 217 338 443 536 599 i 000145 automatic fixed bin(24,0) dcl 143 set ref 200* 202 202 204 268* 279* 280 280* 283 300* 311* 312 313* 390* 391 392 395 396* 441* 442 447* 449 470 479* 480 483* 484 index builtin function dcl 169 ref 256 256 279 284 441 442 479 indicators 60 based structure level 2 dcl 6-10 indicators_word_1 60 based structure level 3 dcl 6-10 indicators_word_3 62 based structure level 3 dcl 6-10 indicators_word_4 63 based structure level 3 dcl 6-10 ioa_ 000036 constant entry external dcl 114 ref 445 j 000146 automatic fixed bin(24,0) dcl 143 set ref 198* 204* 204 208 208 283* 284* k 000147 automatic fixed bin(24,0) dcl 143 set ref 281* 288* 288 291 491* length builtin function dcl 169 ref 280 347 447 467 517 557 lud 000110 automatic char(6) initial unaligned dcl 133 set ref 133* 377* 523* 527* 543 544 544* 546 546* 550 552* 556 557 557 559* 559 563* 567* mc based structure level 1 dcl 7-12 null 60(11) based bit(1) level 4 packed unaligned dcl 6-10 set ref 570* null_file 000104 automatic bit(1) initial unaligned dcl 131 set ref 131* 192 526* 569 path 000157 automatic char(200) unaligned dcl 149 set ref 491* 492* 497* 498* path_type 000366 automatic fixed bin(24,0) dcl 151 set ref 427* 452 455* 460 463* 477 480* 484* 485* 491 pathnm 5 based char(168) level 2 packed unaligned dcl 6-10 set ref 500* 501* perm 60(03) based bit(1) level 4 packed unaligned dcl 6-10 set ref 381* present 000103 automatic bit(1) unaligned dcl 130 set ref 567* 581 print 60(04) based bit(1) level 4 packed unaligned dcl 6-10 set ref 178* prmfl_fc_field 000142 automatic char(8) unaligned dcl 141 set ref 360* 364 370 377 prmfl_path 000241 automatic varying char(336) dcl 150 set ref 428* 467 467* 470* 470 479 483 491* 492 punch 60(05) based bit(1) level 4 packed unaligned dcl 6-10 set ref 184* purge 60(12) based bit(1) level 4 packed unaligned dcl 6-10 set ref 596* read 60(09) based bit(1) level 4 packed unaligned dcl 6-10 set ref 226* 396* result 000153 automatic fixed bin(24,0) dcl 145 set ref 195* 196 262* 264* 266 267 275* 276 277 297* 298 299 305* 306 308* 309 342* 343 360* 361 385* 386 405* 408 431* 432 513* 514 524* 525 save_data 000014 external static structure level 2 dcl 1-106 save_data_entry based structure level 1 dcl 4-5 save_machine_conditions based structure level 1 packed unaligned dcl 2-6 seq_no 75(18) based fixed bin(17,0) level 2 packed unaligned dcl 6-10 set ref 254* 291* serial_no 62 based bit(30) level 4 packed unaligned dcl 6-10 set ref 252* 269* size 67 based fixed bin(24,0) level 2 dcl 6-10 set ref 196* 208* 212* substr builtin function dcl 169 ref 200 214 216 217 217 269 284 347 364 370 377 412 414 415 416 442 449 470 517 544 546 550 556 557 559 tape 60(07) based bit(1) level 4 packed unaligned dcl 6-10 set ref 248* tape_name 63 based bit(72) level 4 in structure "fib" packed unaligned dcl 6-10 in procedure "gcos_cc_file_cards_" set ref 253* 301* tape_name 000134 automatic char(12) unaligned dcl 139 in procedure "gcos_cc_file_cards_" set ref 297* 300 300 tape_serial_number 000140 automatic char(5) unaligned dcl 140 set ref 264* 268 268 temp_tracks 000144 automatic bit(2) unaligned dcl 142 set ref 231* 236* 250 tracks 60(21) based bit(2) level 4 packed unaligned dcl 6-10 set ref 250* type 60(02) based bit(1) level 4 packed unaligned dcl 6-10 set ref 214* 414* 415* 416* type_file 000105 automatic bit(1) initial unaligned dcl 131 set ref 131* 324* 562 unspec builtin function dcl 169 ref 200 verify builtin function dcl 169 ref 349 365 518 546 550 write 60(10) based bit(1) level 4 packed unaligned dcl 6-10 set ref 185* 226* 256* 395* x 000156 automatic char(1) unaligned dcl 148 set ref 370* 371 371 377 449* 450 458 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abx internal static fixed bin(17,0) initial dcl 7-42 apx internal static fixed bin(17,0) initial dcl 7-42 bbx internal static fixed bin(17,0) initial dcl 7-42 bpx internal static fixed bin(17,0) initial dcl 7-42 gcos_ext_stat_$abort_reason external static varying char(128) dcl 1-13 gcos_ext_stat_$abort_return external static label variable dcl 1-14 gcos_ext_stat_$activity_card_num external static picture(4) unaligned dcl 1-15 gcos_ext_stat_$activity_name external static char(8) unaligned dcl 1-16 gcos_ext_stat_$activity_start_time external static fixed bin(71,0) dcl 1-17 gcos_ext_stat_$courtesy_call_control external static structure level 1 dcl 1-92 gcos_ext_stat_$dbs external static bit(1) array unaligned dcl 1-19 gcos_ext_stat_$default_nondollar external static char(2) unaligned dcl 1-20 gcos_ext_stat_$dir_rings external static fixed bin(3,0) array dcl 1-21 gcos_ext_stat_$dpno external static varying char(100) dcl 1-22 gcos_ext_stat_$dpo external static varying char(100) dcl 1-23 gcos_ext_stat_$endfc external static char(2) unaligned dcl 1-24 gcos_ext_stat_$er external static pointer dcl 1-25 gcos_ext_stat_$etc_filecode external static char(2) unaligned dcl 1-26 gcos_ext_stat_$fct external static structure level 1 dcl 1-102 gcos_ext_stat_$gcos_gtss external static structure level 1 unaligned dcl 1-115 gcos_ext_stat_$gcos_slave_area_seg external static pointer dcl 1-27 gcos_ext_stat_$incode external static fixed bin(24,0) dcl 1-29 gcos_ext_stat_$increment_hold external static fixed bin(24,0) dcl 1-30 gcos_ext_stat_$initial_cpu_time external static fixed bin(71,0) dcl 1-31 gcos_ext_stat_$input_segment_path external static varying char(168) dcl 1-32 gcos_ext_stat_$jcl_warnings external static fixed bin(24,0) dcl 1-33 gcos_ext_stat_$job_cpu_time external static fixed bin(71,0) dcl 1-34 gcos_ext_stat_$job_id external static varying char(18) dcl 1-35 gcos_ext_stat_$job_real_time external static fixed bin(71,0) dcl 1-36 gcos_ext_stat_$last_mme external static fixed bin(24,0) dcl 1-37 gcos_ext_stat_$ldrss external static fixed bin(24,0) dcl 1-38 gcos_ext_stat_$max_activities external static fixed bin(24,0) dcl 1-39 gcos_ext_stat_$max_mem external static fixed bin(19,0) dcl 1-40 gcos_ext_stat_$mc external static structure level 1 unaligned dcl 1-112 gcos_ext_stat_$mme_rtrn external static label variable dcl 1-41 gcos_ext_stat_$nondollar external static char(2) unaligned dcl 1-42 gcos_ext_stat_$nongcos external static char(2) unaligned dcl 1-43 gcos_ext_stat_$normal_return external static label variable dcl 1-44 gcos_ext_stat_$patchfile_ptr external static pointer dcl 1-45 gcos_ext_stat_$pathname_prefix external static varying char(168) dcl 1-46 gcos_ext_stat_$pch external static pointer dcl 1-47 gcos_ext_stat_$pdir external static varying char(168) dcl 1-48 gcos_ext_stat_$prt external static pointer dcl 1-49 gcos_ext_stat_$rs external static pointer dcl 1-50 gcos_ext_stat_$save_dir external static varying char(168) dcl 1-52 gcos_ext_stat_$saveseg_ptr external static pointer dcl 1-51 gcos_ext_stat_$seg_rings external static fixed bin(3,0) array dcl 1-53 gcos_ext_stat_$sig_ptr external static pointer dcl 1-54 gcos_ext_stat_$skip_umc external static bit(1) unaligned dcl 1-55 gcos_ext_stat_$snumb external static bit(30) dcl 1-56 gcos_ext_stat_$sought_label external static char(8) unaligned dcl 1-57 gcos_ext_stat_$statistics external static fixed bin(24,0) array dcl 1-58 gcos_ext_stat_$stop_code external static fixed bin(24,0) dcl 1-59 gcos_ext_stat_$storage_limit external static fixed bin(19,0) dcl 1-60 gcos_ext_stat_$sysout_limit external static fixed bin(35,0) dcl 1-61 gcos_ext_stat_$sysout_lines external static fixed bin(35,0) dcl 1-62 gcos_ext_stat_$system_free_pointer external static pointer dcl 1-63 gcos_ext_stat_$tape_buffer_size external static fixed bin(35,0) dcl 1-64 gcos_ext_stat_$temp_dir external static varying char(168) dcl 1-65 gcos_ext_stat_$temp_seg_ptr external static pointer dcl 1-66 gcos_ext_stat_$termination_code external static bit(18) unaligned dcl 1-67 gcos_ext_stat_$time_limit external static fixed bin(71,0) dcl 1-68 gcos_ext_stat_$userid external static char(12) unaligned dcl 1-69 gcos_ext_stat_$validation_level external static fixed bin(3,0) dcl 1-70 lbx internal static fixed bin(17,0) initial dcl 7-42 linked_file internal static bit(1) initial unaligned dcl 6-87 lpx internal static fixed bin(17,0) initial dcl 7-42 mcp automatic pointer dcl 7-10 message automatic char(50) unaligned dcl 128 null builtin function dcl 169 random_file internal static bit(1) initial unaligned dcl 6-88 read_file internal static bit(1) initial unaligned dcl 6-89 sbx internal static fixed bin(17,0) initial dcl 7-42 scu based structure level 1 dcl 7-56 scup automatic pointer dcl 7-54 scux based structure level 1 dcl 7-206 spx internal static fixed bin(17,0) initial dcl 7-42 write_file internal static bit(1) initial unaligned dcl 6-90 NAMES DECLARED BY EXPLICIT CONTEXT. Open_File 004103 constant entry internal dcl 511 ref 177 183 191 246 325 Open_Prmfl 004311 constant entry internal dcl 533 ref 379 cc_dac 002153 constant entry external dcl 328 cc_file 001152 constant entry external dcl 188 cc_print 001116 constant entry external dcl 175 cc_prmfl 002403 constant entry external dcl 356 cc_punch 001133 constant entry external dcl 181 cc_read 001053 constant entry external dcl 171 cc_sysout 002166 constant entry external dcl 333 cc_tape 001423 constant entry external dcl 239 cc_tape7 001375 constant entry external dcl 229 cc_tape9 001410 constant entry external dcl 234 cc_type 002137 constant entry external dcl 322 decode_disp 004670 constant entry internal dcl 584 in procedure "Open_File" ref 574 576 decode_disp 004672 constant label dcl 590 in procedure "decode_disp" exit 004101 constant label dcl 503 ref 539 571 581 gcos_cc_file_cards_ 001042 constant entry external dcl 94 get_path 003227 constant label dcl 431 ref 474 loop 001220 constant label dcl 200 ref 205 permissions_done 003030 constant label dcl 405 ref 397 sysout_open 002176 constant label dcl 337 set ref 331 tape_common 001431 constant label dcl 246 set ref 232 237 NAMES DECLARED BY CONTEXT OR IMPLICATION. hbound builtin function ref 311 390 lbound builtin function ref 311 390 rtrim builtin function ref 501 search builtin function ref 483 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6142 6216 5620 6152 Length 6664 5620 54 431 322 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcos_cc_file_cards_ 540 external procedure is an external procedure. Open_File internal procedure shares stack frame of external procedure gcos_cc_file_cards_. decode_disp internal procedure shares stack frame of external procedure gcos_cc_file_cards_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcos_cc_file_cards_ 000100 fibptr gcos_cc_file_cards_ 000102 dac_sw gcos_cc_file_cards_ 000103 present gcos_cc_file_cards_ 000104 null_file gcos_cc_file_cards_ 000105 type_file gcos_cc_file_cards_ 000106 file_file gcos_cc_file_cards_ 000107 fc gcos_cc_file_cards_ 000110 lud gcos_cc_file_cards_ 000112 disp gcos_cc_file_cards_ 000113 adisp gcos_cc_file_cards_ 000114 cfdesc_field gcos_cc_file_cards_ 000132 field gcos_cc_file_cards_ 000134 tape_name gcos_cc_file_cards_ 000140 tape_serial_number gcos_cc_file_cards_ 000142 prmfl_fc_field gcos_cc_file_cards_ 000144 temp_tracks gcos_cc_file_cards_ 000145 i gcos_cc_file_cards_ 000146 j gcos_cc_file_cards_ 000147 k gcos_cc_file_cards_ 000150 digit gcos_cc_file_cards_ 000151 cp gcos_cc_file_cards_ 000152 code gcos_cc_file_cards_ 000153 result gcos_cc_file_cards_ 000154 abs gcos_cc_file_cards_ 000156 x gcos_cc_file_cards_ 000157 path gcos_cc_file_cards_ 000241 prmfl_path gcos_cc_file_cards_ 000366 path_type gcos_cc_file_cards_ 000367 etc_next_sw gcos_cc_file_cards_ 000370 dirname gcos_cc_file_cards_ 000442 ename gcos_cc_file_cards_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_pathname_ gcos_cv_ascii_gebcd_ gcos_error_ gcos_get_cc_field_ gcos_get_cc_field_$asis gcos_interpret_file_string_ gcos_open_file_ gcos_open_file_$sysout gcos_write_to_er_ ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. gcos_et_$cc_bad_fc gcos_et_$cc_bad_field gcos_et_$cc_bad_lud gcos_et_$cc_missing_field gcos_et_$cc_unimp gcos_ext_stat_$card_num gcos_ext_stat_$gf gcos_ext_stat_$save_data LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 131 001030 133 001033 94 001037 171 001050 173 001061 175 001113 177 001124 178 001125 179 001130 181 001131 183 001141 184 001142 185 001145 186 001147 188 001150 190 001160 191 001162 192 001163 194 001165 195 001167 196 001211 198 001217 200 001220 202 001230 203 001234 204 001235 205 001242 208 001243 210 001251 212 001276 214 001301 216 001317 217 001324 220 001364 226 001365 227 001372 229 001373 231 001403 232 001405 234 001406 236 001416 237 001420 239 001421 246 001431 248 001432 250 001435 252 001442 253 001444 254 001447 256 001451 262 001472 264 001513 266 001535 267 001540 268 001542 269 001565 275 001570 276 001612 277 001615 279 001617 280 001627 281 001632 283 001633 284 001641 285 001652 288 001713 289 001720 291 001722 297 001725 298 001747 299 001752 300 001754 301 001777 304 002003 305 002006 306 002030 308 002033 309 002055 311 002057 312 002065 313 002072 314 002100 316 002101 318 002103 322 002134 324 002145 325 002147 326 002150 328 002151 330 002161 331 002163 333 002164 335 002174 337 002176 338 002177 342 002227 343 002251 347 002304 349 002307 353 002363 354 002400 356 002401 360 002411 361 002433 364 002466 365 002470 370 002542 371 002546 377 002602 379 002612 381 002613 385 002616 386 002640 390 002673 391 002701 392 002713 395 002754 396 002763 397 002770 399 002771 400 002773 405 003030 408 003052 412 003105 414 003147 415 003160 416 003166 417 003174 427 003225 428 003226 431 003227 432 003251 433 003253 436 003302 441 003332 442 003342 443 003356 445 003403 447 003433 449 003435 450 003442 451 003445 452 003447 455 003503 456 003505 458 003506 459 003510 460 003512 463 003546 464 003550 465 003551 467 003552 470 003612 472 003624 473 003626 474 003631 477 003632 479 003634 480 003646 483 003652 484 003665 485 003671 491 003673 492 003724 497 003730 498 003755 500 004017 501 004040 503 004101 511 004103 513 004104 514 004126 517 004161 518 004163 523 004240 524 004243 525 004265 526 004267 527 004305 533 004310 535 004312 536 004316 539 004342 542 004343 543 004346 544 004357 546 004423 550 004470 552 004501 556 004537 557 004543 559 004552 562 004557 563 004561 564 004564 567 004570 569 004615 570 004617 571 004622 574 004623 576 004636 579 004656 581 004664 582 004667 584 004670 590 004672 591 004706 592 004715 593 004724 594 004733 595 004742 596 004744 597 004747 599 004754 601 004775 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved