IMD 1.18: 21/01/2023 18:39:13 PRQ-SFT-WBD-6 3RCC PERQ DOCUMENTATION DISTRIBUTION FLOPPY Copyright (C) Three Rivers Computer Corporation, 1982 single density, double sided D.6 Group name Command file DOCUMENTATION-3 3DOC.CMD  er is multiplied with the mantissa to produce the real number returned as value. Much care has been  a procedure for the desired format. The design here follows as much as possible the ISO Standard taken to avoid calls to TenPower with actual parameters which are out of range, and also to minimiz description for writing Pascal real numbers, in particular, the choice of many variable names. e the number of real multiplications necessary (this to avoid error propogation). procedure WriteR(var F:  - 155 - POS D.6 Interface Module PERQFileType; e: real; TotalWidth: integer; FracDigits: integer; format: integer); Abstract: This_String 05 Feb 82 Module PERQ_String; PERQ String manipulation routines. Written by: Donald Scelza Copyright (C) 1980 procedure writes a real number to a file F, under the given format specifications.  Three Rivers Computer Corporastion Abstract: This module implements the string manipulation routines for the  - 154 - POS D.6 Interface module PasReal 05 Feb 82 Parameters: Three Rivers PERQ Pascal. Strings in PERQPascal are stored a single character per byte with the byte indexed by 0  F - the file to which to write. e - the value to write. TotalWidth - the minimum number ofbeing the length of the string. When the routines in this module must access the length byte, they must turn o. Effort is taken to ignore zeros whenever possible. If they are insignificant they are ignored,  characters to write. FracDigits - the number of characters in the fractional part (used for fixed if significant they cause an adjustment to the scale_factor and do not affect the mantissa. The variformat only). format - indicates either fixed or floating format. Results: The file bufferables save_scale_factor, save_mant, zero_count, frac_part and sig_digit_in_frac are used for this purp for F is modified by procedures nested in this one. Calls: StreamName - in module Stream forose. To combine this information into a real number, the scale_factor is added to the exponent  the stream name of file F. base2_to_base10 normalize Design: There and this sum is the power of ten exponent of the mantissa. To combine sum with the mantissa, it has tis some initialization, then if the real number to be written is zero, eWritten and ExpValue are obviously zero, o be converted to a real number, which is done by the function TenPower. Then the result of TenPow else the real number needs to be converted to base 10 giving eWritten and ExpValue. Then a call is made to  kf[j ïÎÀÌj PÊÎj SIGGRAPH 80 DEMONSTRATION BINARY FILES file name version file name on floppy --------- short description. ---------------------------- :LIN tr:PString; Index,Size:Integer); Procedure Insert(Var Source,Dest:PString; Index:Integer); Function Pos(Source,Mask:PString): be concatenated. Environment: None Results: This function will return a single string as descr Integer; FUNCTION PosC(s: PString; c: Char): Integer; PROCEDURE AppendString(var s1: PString; s2: PString); PROCEDURE Appeibed by the parameters. Errors: If Length(Str1) + Length(Str2) is greater then MaxPStndChar(var s: PString; c: Char); FUNCTION UpperCase(c: Char): Char; PROCEDURE ConvUpper(Var s: PString); Exception StrBadParingSize then raise StrLong exception. Design: - 157 - POS D.6 Interm; Abstract: Raised when bad index or length parameters passed to procedures or sometimesrface Module PERQ_String 05 Feb 82 Function SubStr(Source:PString; Index, Size:Integer):PStri when string will be too long (other times, StrLong is raised in this case Function RevPosC(s: PString; c:ng; Abstract: This procedure is used to return a sub portion of the string passed as a parameter.  char): integer; - 156 - POS D.6 Interface  Parameters: Source is the string that we are to take a portion of. Index is the starting position  Module PERQ_String 05 Feb 82 Procedure Adjust(var Str:PString; Len:Integer); Abstract: This procedure iin Source of the substring. Size is the size of the substring that we are to take. Environment: None s used to change the dynamic length of a string. Parameters: Str is the string that is to have the length  Results: This function returns a substring as described by the parameter list. Errors: If Index changed. Len is the new length of the string. This parameter must be This value must be no greater than or Size are greater than MaxPStringSize then raise StrBadParm exception. Design: Procedure Delete(va MaxPStringSize. Environment: None Results: This procedure does not return a value. Side Effects: r Str:PString; Index, Size:Integer); Abstract: This procedure is used to remove characters from a striff range checking. Version Number V2.4 {********************} Exports {********************} Const MaxPStringSize=255 This procedure will change the dynamic length of Str. Errors: If Len > MaxPStringSize then raise StrLong; { Length of strings} Type PString = String[MaxPStringSize]; Procedure Adjust(Var STR:PString; LEN:Integer); Fun exception. Design: Simple. Function Concat(Str1,Str2:PString):PString; Abstract: This procedure is ction Concat(Str1,Str2:PString):PString; Function Substr(Source:PString; Index,Size: Integer):PString; Procedure Delete(Var Sused to concatenate two string together. Parameters: Str1 and Str2 are the two strings that are to K - INITDEMO INITDEMO.SEG - INITD.SEG :LINK - PETALDEMO PETALDEMO.SEG - PETALD.SEG :LINK - LINEDEMO LINEDEMO.SEG - LINED.SEG :LINK  - LIFEDEMO LIFEDEMO.SEG - LIFED.SEG :LINK - SEISDEMO SEISDEMO.SEG - SEISD.SEG :LINK - GETSAVE GETSAVE.SEG - GETSAV.SEG :LINK -  CREATEWIN CREATEWIN.SEG - CREWIN.SEG :LINK - SLIDER SLIDER.SEG - SLIDER.SEG :LINK - JUST JUST.SEG - JUST.SEG :LINK - WIPEWIN WIPEW ng. Parameters: Str is the string that is to be changed. Characters will be removed from this string.  - POS D.6 Interface Module PERQ_String 05 Feb 82 PROCEDURE AppendChar(var s: PString;  Index is the starting position for the delete. Size is the number of character that are to be removec: Char); Abstract: puts c on the end of s Parameters : s is the left String and c goes on the end. d. Size characters will be removed from Str starting at Index. Environment: None Results: This pr SideEffects : modifies s. FUNCTION UpperCase(c: Char): Char; Abstract: Changes c to uppercase if letter. ocedure does not return a value. Side Effects: This procedure will change Str.  Parameters: c is any char. Returns: char is uppercase if letter otherwise unchanged. Procedure ConvUppe - 158 - POS D.6 Interface Module PERQ_String 05 Feb 82 Errors: None r(Var s: PString); Abstract: Converts s to all upper case Parameters: s, passed by reference, to be converted  Design: Procedure Insert(var Source, Dest:PString; Index:Integer); Abstract: This procedure is used to ins Function PosC(s: PString; c: char): integer; Abstract: Tests if c is a member of s. Parameters: c is any ert a string into the middle of another string. Parameters: Source is the string that is to be inserted. char; s is string to test for c member of. Returns: index of first c in s (from beginning of string) or zero  Dest is the string into which the inseration is to be made. Index is the starting position, in Dest, for if not there. Function RevPosC(s: PString; c: char): integer; Abstract: Tests if c is a member of s.  the inseration. Environment: None Results: This procedure does not return a value. Side Effects: Parameters: c is any char; s is string to test for c member of. Returns: index of first c in s (from end of string) o This procedure will insert Source in Dest starting at location Index. Errors: If the resulting string is r zero if not there. - 160 - POS D.6 Interface  too long then generate a runtime error. Design: PROCEDURE AppendString(var s1: PString; s2: PStri Module PERQ_String 05 Feb 82 Function Pos(Source, Mask:PString):Integer; Abstract: This procedure ing); Abstract: puts s2 on the end of s1 Parameters : s1 is the left String and s2 goes on the end. s used to find the position of a pattern in a given string. Parameters: Source is the string that is to Calls: PerqString.Concat. SideEffects : modifies s1. - 159 be searched. Mask is the pattern that we are looking for. Environment: None Results: If Mask o er V1.1 exports type AlignedBuffer = array[0..0] of array[0..255] of Integer; AlignedPointer = ^AlignedBuffer; U-people Copyright (C) 1980 Three Rivers Computer Corporation Abstract: Allocdisk allocates and deallocates disk pag procedure NewBuffer( var P: AlignedPointer; S, A: Integer ); exception BadAlignment( A: Integer ); es. The partition has some number of contiguous pages on it. The number of pages in a partition is specified  - 1 - POS D.6 Interface when the partition is created (using the Partition program). Segments can be created within a partition, e.g. se module AlignMemory 05 Feb 82 procedure NewBuffer( var P: AlignedPointer; S, A: Integer ); Abstractgments may not span partitions. The entire disk can be thought of as a partition (the Root Partition) : This procedure is used to allocate buffers which need to be aligned on boundaries that are multiples of 256 words A DiskInformationBlock (DiskInfoBlock or DIB) contains all the fixed information about a disk, including its par. A new segment is allocated which is somewhat larger than the desired buffer size. The segment is set ttion names, locations and sizes. It also contains a table used to locate boot segments A disk can be 'o be unmovable so that the alignment can be guaranteed. Parameters: P - Set to point to a new buffer which is aligned as desired. S - Desired size of the buffer in 256 word blocks.  A - Alignment in 256 word blocks. That is, 1 means aligned on a 256 word boundary, 2 means a 512 word boundary, and so on. Errors: BadAlignment if A is less than one or greater than 256. BadSiz POS D.6 Interface module AlignMemory 05 Feb 82 module AlignMemory; AlignMemory - Ale (memory manager) if S is less than one or S+A-1 is greater than 256. Other memory manager exceptions raised by located aligned buffers. J. P. Strait 29 Sep 81. Copyright (C) Three Rivers Computer Corporation. Abstract: This m CreateSegment. odule is used to allocate buffers which need to be aligned on boundaries that are multiples of 256 words. Version Numb- 2 - POS D.6 Interface module AllocDisk 05 Feb 82 module AllocDisk; Written by CM ; Function IsPattern(var str: pms255): boolean; Exception BadPatterns; Abstract: Raised if outPatt and inPatt do as', 'xtest'0.pas') => TRUE, 'xtest9.pas' PattMap('test9.pas', '*.pas', '*.ada') => TRUE, 'test9.ada' not have the same patterns in the same order for PattMap  Parameters: str - full string to compare against pattern; inpatt - pattern to compare against. It can h - 162 - POS D.6 Interface module PMatch 05 Feb 82 Procedure Pave special characters in it outpatt - pattern to put the parts of str into; it must ccured in Source then the index into Source of the first character of Mask will be returned. If Mask was attDebug(v: boolean); Abstract: Sets the global debug flag Parameters: v is value to set debug to SideEf not found then return 0. Side Effects: None Errors: None Design: fects: Changes debug value Function IsPattern(var str: pms255): boolean; Abstract: Tests to see whether str contai - 161 - POS D.6 Interface ns any pattern matching characters Parameters: str - string to test. If not pattern then removes module PMatch 05 Feb 82 module PMatch; Abstract: Does pattern matching on strings Patterns accepted are a all quotes. Returns: true if str contains any pattern matching characters; else false Function Pats follows: "*" matches 0 or more characters. "&" matches 1 or more characters. "#" matches exactly 1 ctMatch(var str, pattern: pms255; fold: boolean): boolean; Abstract: Compares str against pattern Parameters: strharacter. "'0" matches any digit. "'A" matches any alphabetic (capitals only unless casefold). "'a" matc - full string to compare against pattern; pattern - pattern to compare against. It can have special hes any alphabetic(lower case only unless 'casefold'). "'@" matches any non-alphanumeric. "'*" matches '*', othe characters in it fold - determines whether upper and lower case are distinct. If true then not. r patterns chars can be quoted also. Written by: Gene Ball at CMU Version Number V2.5 {/////////////////////////////}  Returns: true string matches pattern; false otherwise Function PattMap(var str,inpatt,outpatt, outstr:pms255;folExports {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\} Type pms255 = String[255]; Function PattMatch(var str,pattern: pms255; fold: bood:boolean):boolean; Abstract: Compares str against inPatt, putting the parts of str that match inpatt into lean): boolean; Function PattMap(var str,inpatt,outpatt,outstr:pms255; fold:boolean): boolean; Procedure PattDebug(v: boolean)the corresponding places in outpatt and returning the result EXAMPLES: PattMap('test9.pas', 'test'0.p f a segment is a doubly linked list of free pages This module maintains this list, as well as the DeviceTable and rtition name} type PartString = string[MAXPARTCHARS]; DeviceRecord = record {entry in the DeviceT PartTable It contains procedures for mounting and dismounting disks and partitions, as well as allocating and dable} InfoBlk: DiskAddr; {where the DiskInfoBlock is} InUse : boolean; {this Deviceallocating space within a partition. When allocating pages, the module updates the PartInfoBlock every MaxAeTable entry is valid} RootPartition: PartString {name of this disk} end; PartRecordllocs calls on AllocDisk Since the system may crash some time between updates, the pointers and free list  = record {entry in the PartTable} PartHeadFree : DiskAddr; {pointer to Head of Freesize may not be accurate. When a partition is mounted, the pointers are checked to see if they point to free  List} PartTailFree : DiskAddr; {pointer to tail of Free List} PartInfoBlk : DiskAddr pages. If not, the head of the pointer is found by looking at the "filler" word of the block the free head does ; {pointer to PartInfoBlock} PartRootDir : DiskAddr; {pointer to Root Directory} Partpoint to (which presumably was allocated after the last update of PartInfoBlock). The filler word has a short pointerNumOps : integer; {how many operations done since last update of PartInfoBlock to the next "free" page, and forms a linked list to the real free list header. Likewise, if the Free tail does } PartNumFree : FSBit32; {HINT of how many free pages} PartInUse : boolean; {thi not have a next - 3 - POS D.6 Interface module Alls entry in PartTable is valid} PartMounted : boolean; {this partition is mounted} Pamounted' which means that its root partition is known to the system as an entry in the DiskTable. A Partition IocDisk 05 Feb 82 pointer of 0, a deallocate is presumed to have been done since a PartInfoBlock update, and Nextnformation Block (PartInfoBlock or PIB) contains all of the fixed information about a partition, A partition can aAdr pointers are chased to find the real end of the Free List. Version Number V2.8 {******************} exports {*****lso be 'mounted', and this is usually done as part of mounting the disk itself. Partitions mounted are entries i**********************} imports Arith from Arith; imports ReadDisk from ReadDisk; const MAXDISKS = 2; {Floppy an the PartTable Within a partition, segments are allocated as doubly linked lists of pages The Free List ond HardDisk} MAXPARTITIONS = 10; {Maximum number of mounted partitions} MAXPARTCHARS = 8; {how many characters in a pa . See the module PopUp for the definition of pNameDesc and for some useful procedures for creating and destroyiy popUp menus. If cmd is the full name of one of the names in names, even if is also a sub-part of othng pNameDescs. Written by Brad Myers Nov 18, 1981 Copyright (C) 1981 Three Rivers Computer Corperation Verer names, it is returned as the one found. Parameters: Cmd - the command that we are looking for. CmdTable sion Number V1.8 {********************} Exports {********************} Imports CmdParse from CmdParse; Imports PopUp from P- a table of the valid commands. The first valid command in this table must start at index 1. NuopUp; Function PopUniqueCmdIndex(Cmd: CString; Var names: pNameDesc): Integer; Function GetCmdLine(Procedure IdleProc; promCmds - the number of valid command in the table. Returns: The index of Cmd in CmdTable. If Cmd was not found then mpt: String; var line, cmd: CString; var inF: pCmdList; var names: pNameDesc; var firs return NumCmds + 1. If Cmd was not unique then return NumCmds+2. Function GetShellCmdLine(var cmtPress: boolean; popOK: boolean): integer; Function GetShellCmdLine(var cmd: CString; var inF: pCmdList;d: CString; var inF: pCmdList; var names: pNameDesc): integer; Abstract: This routine is similar to GetCmdLine have the same special characters in the same order as in inpatt outStr - the resulting string  var names: pNameDesc): integer; Function GetConfirm(Procedure IdleProc; popOK: boolean; if PattMap returns true; - 163 - POS D.6 Interface mod prompt: String; def: integer; var switches: pSwitchRec): integer; Procedure NullIdleProc; ule PMatch 05 Feb 82 fold-determines whether upper and lower case are distinct. It true then not - 165 - POS D.6 Interface . Returns: true string matches pattern; false otherwise Errors: Raises BadPatterns if outPatt and inPatt do not Module PopCmdParse 05 Feb 82 Procedure NullIdleProc; Abstract: This procedure does nothing. It is u have the same patterns in the same order seful as an IdleProc parameter to other procedures when no IdleProc is needed. Function PopUnique - 164 - POS D.6 Interface ModulCmdIndex(Cmd: CString; Var names: pNameDesc): Integer; Abstract: This procedure is used to do a unique lookupe PopCmdParse 05 Feb 82 Module PopCmdParse; Abstract: This module provides procedures to help with PopUp menus in a popUp command table. It is the same as UniqueCmdIndex except the table of names is the kind used b } PartEnd : DiskAddr; {Disk Address of last page} PartKind : PartitionType; {le} Exception NoFreePartitions; Abstract: Raised when too many partitions are accessed at one time. TRoot or Leaf} PartName : PartString {name of this partition} end; var DiskTahe limit is MAXPARTITIONS. Exception BadPart(msg, partName: String); Abstract: Raised when there is ble : array [0..MAXDISKS-1] of DeviceRecord; PartTable : array [1..MAXPARTITIONS] of PartRecord; procedure InitAllosomething wrong with a partition. This means that the Scavenger should be run. Parameters: msc; {initialize the AllocDisk module, called during boot} procedure DeviceMount(disk: integer); {mount a disk} procedure g is the problem and partName is the partition name. Print error message as: WriteLn('** ',msg,DeviceDismount(disk : integer); {dismount a disk} function MountPartition(name : string) : integer; {mount a partion, ' for ',partName); Exception PartFull(partName: String); Abstract: Raised when there are no free blocks in a partiti return PartTable index} - 4 - POS Don to be allocated. This means that some files should be deleted and then the.6 Interface module AllocDisk 05 Feb 82 procedure DismountPartition(name : string); {dismo Scavenger should be run. Parameters: partName is the full partition unt a partition} function FindPartition(name : string) : integer; {given a partion name, look  - 5 - POS D.6 Interface module AllocDisk 05 Feb 82 Procedure InitAlloc; Abs for it in PartTable, return index} function AllocDisk(partition : integer) : DiskAddr; {allocate a free patract Initialize the AllocDisk module Side Effects Sets Initialized to a magic number; sets all InUse and PartInge from a partition} procedure DeallocDisk(addr : DiskAddr); {returnUse to false Procedure DeviceMount(disk : integer); Abstract: Mount the device specified by disk if not alr a page to the free list} procedure DeallocChain(firstaddr,lastaddr : DiskAddr; numblks : integer); eady mounted Parameters: Disk is a device; it should be zero for HardDisk and 1 for Floppy  {return a bunch of pages to free list} function WhichPartition(addr : DiskAddr) : integer; {given a Disk Address,  Environment: Expects DiskTable to be initialized Side Effects: Sets the DiskTable for device; loads PartTable wirtDevice : integer; {which disk this partition is in} PartStart : DiskAddr; {Disk Address of 1st page figure out which partition it is in} procedure DisplayPartitions; {print the PartTab han numCommands. It will be '' if no command found before the first significant break character.  user can control whether one or more than one command should be selected before window is removed. If a press out inF - a command file list created by InitCmdFile. Just call InitCmdFile and pass in the inF returside outside, no command is executed. In any case, the window is erased and the original contents of that area ned. This procedure manages the list and handles all command files. names -is returned Copyright (C) 1981 - The Three Rivers Computer Corporation Version Number V2.4 {-*-*-*-*-*-*-*-*-*-*-*-*-* a variable length array of names used for popUp menus and for matching the input cmd against. Retur-*-} EXPORTS {-*-*-*-*-*-*-*-*-*-*-*-*-*-*-} EXCEPTION BadMenu; Abstract: Raised when parameters are illegal. EXCEns: Identical to GetCmdLine. Viz: index in the array or numCommands + 1 ==> Name not found in array nPTION Outside; Abstract: raised when press outside of menu. Type s25 = String[25]; NameAr = Array[1..1] of s25;umCommands + 2 ==> Name not unique - 166 - POS D.6 Interface  pNameAr = ^NameAr; NameDesc = Record header: s25; numCommands: integer;  Module PopCmdParse 05 Feb 82 numCommands + 3 ==> Name was empty numCommands + 4 ==> First co commands: NameAr; End; pNameDesc = ^NameDesc; ResRes = ^ResArray; ResArrammand was a switch (it is in Cmd). numCommands + 5 ==> Illegal character found after command. y = Record numIndices: integer; indices: Array[1..1] of integer; End; PR OCEDURE Menu(names: pNameDesc; isList: boolean; first, last, curX, curY, maxYsize: integer; VAR res: ResRes);  except that it works on the command line specified to the Shell. It is should be used by programs  - 167 - POS D.6 Interface Module PopUp 05 Feb 82 Module PopUp; Written by Bradthat use GetCmdLine to parse the Shell command line. Command files are handled by GetShellCmd A. Myers 16-Nov-80 Abstract: This program produces pop up windows that replace the screen area at a specified cursorLine. The user can call ParseCmdArgs after GetShellCmdLine to get the arguments to the command. Parame location. The cursor is then changed and PopUp waits for a press. Whenever the cursor is inside the window, thters: cmd - the first command taken off the line. This will be valid even if the return value is greater te command at that point is highlighted. If a press is done inside the window, the highlighted command is selected. The   names. If dev is specified; then only checks those partitions on that device; name may be in any case s: name is partition name of form "dev:part>" where "dev" and ">" are optional Side Effects: Writes ou Returns: index in PartTable of FIRST partition with name name (there may be more than one partition with the st part information in table if partition InUse and mounted Calls: UpdatePartInfo, ForgetAll Functionth Part names on dev Errors: Error if no free partition slots in PartTable; NOTE: No mention iame name in which case it uses the oldest one) or zero if not found or name malformed; Calls: s made if device has partitions with names same as those already loaded Procedure DisplayPartitions; AUpperEqual Design: No device name specified is signaled by disk=MAXDISKS; otherwise disk is set to be thbstract: Displays information about the current partitions on the screen Environment: Assumes PartTable e device which the device part of name specifies Function MountPartition(name : string) : integer; Abstrand DiskTable set up; Calls: AddrToField; IntDouble, WriteLn; Procedure DeviceDismount(disk : integer); Aact: Searches for partition name in part table and mounts it if not mounted already; tries to read the head and tailbstract: Removes device disk (0 or 1) from DiskTable and removes all its partitions Parameters: Disk is a d of free list to see if valid Parameters: name is partition name of form "dev:part>" where evice (0= HardDisk; 1=Floppy) - 6 - POS D.6 Interface  "dev" and ">" are optional Returns: index in part Table of partition for name or zero if not found  module AllocDisk 05 Feb 82 Side Effects: Sets DiskTable[disk].InUse to false and removes all of  Side Effects: if not mounted already, then reads in PartInfoBlk and sets partTable fields; tries to read the disk's partitions Calls: DismountPartition Function FindPartition(name : string ) : integer; Abstract: Shead and tail of free list to see if valid - 7 - POS D.6 Interface earches through partition table looking for a partition named name; if found; returns its index in the  module AllocDisk 05 Feb 82 Errors: if no free slots for partition then Rais table; Parameters: name is partition name of form "dev:part>" or ":part>" or "part>" whees NoFreePartitions if can't find free list head or tail then Raises BadPart Calls: FindPartitre the final ">" is optional in all forms. If dev isn't specified then searches through all partitionion Procedure DismountPartition(name : string); Abstract: Removes partition name from PartTable Parameter eDesc); PROCEDURE DestroyNameDesc(Var names: pNameDesc); - 168 - POS D.6 Int names is set to NIL. PROCEDURE InitPopUp; Abstract: creates cursors needed to make PopUp windows woerface Module PopUp 05 Feb 82 Procedure AllocNameDesc(numNames, seg: Integer; Var names: pNamrk. This should be called once before calling menu. Environment: sets cursors. PROCEDURE DestroyRes(var eDesc); Abstract: There are two ways to allocate the storage for a NameDesc. One is to declare in yores: ResRes); Abstract: Deallocates storage for res and sets it to NIL Parameters: res is ResRes to destroy ur program a type with an array of the correct size and the other fields exactly the same way. You t - 169 - POS D.6 Interface Module PopUp hen RECAST a pointer to that array into a pNameDesc. The other way is to use this procedure. It all05 Feb 82 PROCEDURE Menu(names: pNameDesc; isList: boolean; first, last, curX, curY, maxYsize: integer; VAR res: ResRocates the storage for numNames out of a segment. Turn off range checking when assigning or accessing the array. es); Abstract: puts up a window with commands commands stacked vertically with the center at curX, cu NOTE: To deallocate the nameDesc returned, use DestroyNameDesc Parameters: numNamesrY. Allocates off the heap enough storage for old picture at that place so can restore it. Deallocat - the number of names in the array. seg - the segment to allocate the nameDesc out of. If zero, tes all storage when done. Parameters: names - a pointer to an array of names to put in the menu. In it hen uses the default segment. This procedure uses NewP so the segment can have other things in it also.  header - is put at the top of the menu. It may be empty in which case there is no header.  names - set with the newly allocated pNameDesc. Its numCommands field is set with numNames.  numcommands - the number of names in the array. commands - an array of names to display. These can be Do not change this size or the deallocation will not work. Procedure DestroyNameDesc(Var names: pNameDesc) generated by having pNameDesc with an array of the correct (or larger than the correct) size an; Abstract: Delete names. It should have been created by AllocateNameDesc. The numCommands field d recasting it into a pNameDesc, or by creating a segment to hold all the names that will be n PROCEDURE InitPopUp; PROCEDURE DestroyRes(var res: ResRes); PROCEDURE AllocNameDesc(numNames, seg: Integer; Var names: pNambetter be the same as set when allocated. Parameters: names - The storage for names is deallocated and  disk address Returns: index of partition addr falls inside of or zero if none Calls: DoubleBetween  2: ( Ptr : FSBit32 ); 3: (  NOTE: DOESN'T CHECK IF ENTRY IN TABLE IS MOUNTED OR INUSE (***Bug***???) Procedure DeallocDisk(addr : Dis Byte0 : FSBit8; Byte1 : FSBit8; Byte2 : FSBit8; Byte3 :kAddr); Abstract: Returns block addr to whatever partition it belongs to Parameters: addr is block to dealloca FSBit8 ) end; function DoubleAdd(a,b : FSBit32) : FSBit32; function DoubleSub(a,b : FSBit32te Side Effects: adds addr to free list; increments PartNumFree Calls: AddToTail, WhichPartition, UpdatePart) : FSBit32; function DoubleNeg(a : FSBit32) : FSBit32; function DoubleMul(a,b : FSBit32) : FSBit32; function DoubleDiv(a,bInfo Procedure DeallocChain(firstaddr,lastaddr : DiskAddr; numblks : integer); Abstract: Deallocates a : FSBit32) : FSBit32; function DoubleInt(a : integer) : FSBit32; function IntDouble(a : FSBit32) : integer; function Dou AllocDisk(partition: integer) : DiskAddr; Abstract: Allocate a free block from partition Parameters: Partiti chain of blocks Parameters: firstAddr and lastAddr are addresses of blocks to deallocate (inclusive) on is the partition index to allocate the block from Returns: Disk Address of newly freed block;  and numBlks is number of blocks to free Side Effects: Frees first and last addr using AddToTail; middle Side Effects: Updates the partition info to note block freed; changes header in buffer of block; writes new blocks not changed Calls: AddToTail, ChangeHeader, WhichPartition, DoubleAdd, FlushDisk, head of free list with its next and prev fields set to zero and its filler set to next free block;  UpdatePartInfo, DoubleInt NOTE: No checking is done to see if numBlks is correct decrements PartNumFree Errors: Raises PartFull if no free blocks in partition Raises BadPart if free li - 9 - POS D.6 Interface module Arith 05 Feb 82 module Arith; Needst inconsistent Calls: ReadHeader, ChangeHeader, FlushDisk, UpdatePartInfo ed until Pascal compiler supports type long. Copyright (C) 1980 Carnegie-Mellon University Version Number V2.2 exports imp - 8 - POS D.6 Interface module AllocDisk 05 Feb 82 Function WhichPartition(orts FileDefs from FileDefs; { to get FSBitnn } type MyDouble = packed record case integer of addr : DiskAddr) : integer; Abstract: Given a disk address; find the partition it is in Parameters: addr is a  1: ( Lsw : integer; Msw : integer );  elected. If not isList then will be 1. If isList, will not be zero indices - a variable length arf text for that sub system> - - - #--- The base unit of the filray of the indices of the names chosen. They are in increasing order irrespecte is a text line. The function that provides values from the profile file will return a line of text each time that eeded. isList - if true says that a number of commands can be selected. if false, Menu returive of the order the names were picked. - 170 - POS D.6 Interface ns as soon as the first command is selected. first - the index of the first command in names^.comm Module PopUp 05 Feb 82 Errors: Catches CtlC and raises CtlCAbort after removing the menu. ands to display. To display all items, use 1. last - the index of the last command in names^.comm Catches CtlShiftC and erases menu then re-raises CtlShiftC. Catches HelpKey and erases menu and then ands to display. To display all items, use names^.numCommands. Last must be greater than first re-raises. If continued, then raises OutSide. Raises OutSide if press outside of the menu window. R. curX - the x position at which to display the menu. If -1 then uses current pen position. aises BadMenu if parameters are illegal. Environment: Requires enough memory be on the heap for picture.  curY - the y position at which to display the menu. If -1 then uses current pen position.  Requires that InitPopup has been called.  maxYsize - the maximum size in bits of the menu. If -1, then menu will be big enough to hold all items - 171 - POS D.6 Interface module Profi (up to the size of the screen). maxYsize must be greater than 4*(fontHeight+4) which is 68 forle 05 Feb 82 module Profile; Abstract: This module is used to get information from the user profile fi the default font. res - is set with an answer array. This array is allocated off the heap by Menle. Written by: Don Scelza Copyright (C) Three Rivers Computer Corperation, 1981 Version Number V1.1 {*****u. Use DestroyRes to deallocate it. If Menu is exited via ^C or a press outside, then res is ***************} Exports {********************} This module provides facilities that will allow a program to get infornot allocated. The fields of res are set as follows: numIndices - the number of items smation from the user profile. The profile file is a text file that has the form: # = start and a <= stop else false  FSBit32 ) : FSBit32; Abstract: Does a two-s complement negation of argument Parameters: a is number to negate  - 12 - POS D.6 Interface module Arith 05 Feb 82 funct Returns: -a Function DoubleAbs(a : FSBit32 ) : FSBit32; Abstract: Does an absolute value of argument ion DblEql(a,b : FSBit32): boolean; Abstract: determines whether a = b Parameters: a and b are doubles R Parameters: a is number to abs Returns: |a| Function DoubleMul(a,b : FSBit32) : FSBit32; Abstract: Multipleturns: true if a = b; else false function DblNeq(a,b : FSBit32): boolean; Abstract: determines whether a <> b ies a and b Parameters: a and b are doubles Returns: a*b  Parameters: a and b are doubles Returns: true if a <> b; else false function DblLeq(a,b : FSBit32) : boolean;  - 11 - POS D.6 Interface module Arith 05 Feb 82 Function DoubleDiv(a,b : FSBit32) : Abstract: determines whether a <= b Parameters: a and b are doubles Returns: true if a <= b; else false  FSBit32; Abstract: Divides a by b Parameters: a and b are doubles Returns: a/b Function DoubleMod( function DblLes(a,b : FSBit32) : boolean; Abstract: determines whether a < b Parameters: a and b are doublesbleBetween(a,start,stop : FSBit32) : boolean; function DoubleMod(a,b : FSBit32) : FSBit32; function DoubleAbs(a : FSBit32)a,b : FSBit32) : FSBit32; Abstract: Mods a by b Parameters: a and b are doubles Returns: a mod b Fu : FSBit32; function DblEql(a,b : FSBit32) : boolean; function DblNeq(a,b : FSBit32) : boolean; function DblLeq(a,b : FSBitnction DoubleInt(a : integer) : FSBit32; Abstract: converts a into a double Parameters: a is integer Ret32) : boolean; function DblLes(a,b : FSBit32) : boolean; function DblGeq(a,b : FSBit32) : boolean; function DblGtr(a,b : FSBiurns: double of a; if a is negative then does a sign extend Function IntDouble(a : FSBit32 ) : integer; Abstract: rt32) : boolean; - 10 - POS D.6 Interface eturns the low word of a Parameters: a is a double Returns: low word Errors: Micro-code raises OvflLI (i module Arith 05 Feb 82 Function DoubleAdd( a,b : FSBit32) : FSBit32; Abstract: Adds two doubles together Pan Except) if a will not fit in one word Function DoubleBetween(a,start,stop : FSBit32) : boolean; Abstra file file. It is only called once per subsystem invocation. It will lookup the profile file and searchpers on its analysis see [Robert Sedgewick, "Implementing Quicksort Programs," in CACM 21(10), 1978.] Becaus for the required subsystem. Parameters: PFileName is the name of the profile file that is to be used. e of rigid type checking of arrays in Pascal, pointers to the arrays to be sorted are passed along with an inte SubSystem is the name of the subsystem that is to be searched for. Side Effects: This pger specifying the length of the array. The procedures require that the array be declared [0..N+1] where the 0th trocedure will change Inited, InLine and PFile. Errors: If PFileName was not found then raise PNotFound.hrough Nth elements are to be sorted. The additional array element is used to speed up the sorting routine. Befo function PFileEntry: ProfStr; Abstract: This procedure is used to get the next profile entry forre passing the array pointer to the sort procedure it is RECAST as either a IntegerArrayPtr or a StringArrayPtr it is called. All text line between the # and the next # are assumed t a subsystem. Results: This procedure will return the next line from the profile file for the curreno be assoicated with the first subsystem. Successive calles to PFileEntry will return the next line of text for thet subsystem. If there are no more lines for the current subsystem return null. Environment: PFileIni current subsystem. Exception PNotFound(FileName: String); Abstract: Raised when profile file cannot be foundt must have been called before this procedure is used. Uses the global InLine. Sets InLine to be Parameters: fileName is profile not found Exception PNotInited; Abstract: Raised when a profile procedure is empty. Errors: If PFileInit was not called then raise PNotInited.  used but PFileInit not called first Type ProfStr = String[255]; procedure PFileInit(PFileNam - 173 - POS D.6 Interface module QuickSort 05 Feb 82 module QuickSort; e, SubSystem: ProfStr); function PFileEntry: ProfStr; - 172 - POS  Copyright (C) 1981 Three Rivers Computer Corporation Written by: Mark G. Faust Abstract: Hoare's Quicksort alD.6 Interface module Profile 05 Feb 82 procedure PFileInit(PFileName, SubSystem: ProfStr); gorithm with some simple optimizations. This module provides two procedures, IntegerSort and StringSort, which sort Abstract: This procedure is called each time a subsystem wishes to start to read information from the pro arrays of integers and strings respectively. For a detailed description of the algorithm and references to pa   boolean; Abstract: determines whether a > b Parameters: a and b are doubles Returns: true if a > b; els module Clock 05 Feb 82 procedure SetTStamp( Stamp: TimeStamp ); Abstract: Sets time to bee false - 13 - POS D.6 Interface module Clock  time specified by Stamp Parameters: stamp is new time SideEffects: Changes current time procedure SetTStri 05 Feb 82 module Clock; Clock - Perq clock routines. J. P. Strait 1 Feb 81. Copyright (C) Three Rivers Computng( String: TimeString); Abstract: Sets time to be time specified by String Parameters: string is the string of er Corporation, 1981. Abstract: Clock implements the Perq human-time clock. Times are represented inthe new time SideEffects: Changes current time Errors: Raises BadTime is string is invalid (malformed or illegalternally by a TimeStamp record which has numeric fields for Year, Month, Day, Hour, Minute, and Second. Times may  time) procedure GetTString( var String: TimeString ); Abstract: Returns the current time as a string  also be expressed by a string of the form YY MMM DD HH:MM:SS where MMM is a three (or more) letter month name and HH Parameters: string is the string to be set with the current time procedure StampToString( Stamp: TimeStamp; var Strin:MM:SS is time of day on a 24 hour clock. The clock module exports routines for setting and reading the g: TimeString ); Abstract: Returns a string for the time specified by stamp Parameters: stamp is time to get s current time as either a TimeStamp or a character string, and exports routines for converting between TimeStamps and tring for; string is set with time represented by stamp procedure StringToStamp( String: TimeString; var Stamp: strings. Version Number V1.6 exports imports GetTimeStamp from GetTimeStamp; const ClockVersion = '1.6'; typeTimeStamp ); Abstract: Converts string into a time stamp Parameters: string is the string containing time; stamp TimeString = String; procedure SetTStamp( Stamp: TimeStamp ); procedure SetTString( String: TimeString); procedure GetTS is stamp set with time according to string Errors: Raises BadTime is string is invalid (malformed or illegatring( var String: TimeString ); procedure StampToString( Stamp: TimeStamp; var String: TimeString ); procedure StringToStamp(l time) - 15 - POS D.6 Interface  Returns: true if a < b; else false function DblGeq(a,b : FSBit32) : boolean; Abstract: determines whether  String: TimeString; var Stamp: TimeStamp); Exception BadTime; Abstract: Raised when a string passed does not represa >= b Parameters: a and b are doubles Returns: true if a >= b; else false function DblGtr(a,b : FSBit32) :ent a valid time - 14 - POS D.6 Interface  tArray; PStrArray = ^StrArray; - 174 - POS D.6 Interface  If True then we fold to UpCase for comparisons. Results: The array from [0..N] is in  module QuickSort 05 Feb 82 procedure IntegerSort(N :integer; A :PIntArray); procedure StringSort(N :integer; A: Pascending order Side Effects: The array is sorted and the N+1st element contains the DEL chaStrArray; Fold :boolean); racter - 176 - POS D.6 Interface module Ra - 175 - POS D.6 Interface module QuickSort 05 FebndomNumbers 05 Feb 82 module RandomNumbers; J. P. Strait 15 Sep 80. Copyright (C) Three Rivers Computer Corporati 82 procedure IntegerSort(N :integer; A :PIntArray); Abstract: Given an integer N and a pointer to an array [0..Non, 1980. Module RandomNumbers contains two routines: InitRandom - initializes the random number generator. Random - +1] of integers, sort [0..N] into ascending order using QuickSort. Parameters: N :intea function which returns a new random number each time it is referenced. There is currently no way to seed the generator. ger One less than the upper bound of the array. It is the largest index of a valid key. A :PIntArr Random is a feedback shift-register pseudo-random number generator. The algorithm used is one described in the article: 'Geay A pointer to an array [0..N+1] of integers. Results: The array from [0..N] is in ascending order Side neralized Feedback Shift Register Pseudorandom Number Generator' T. G. Lewis and W. H. Payne JACM Vol. 20, No. 3, July . An example for the integer sort is given below. The string sort is analogous. program ShowSort(input,output)Effects: The array is sorted and the N+1st element contains MaxInt procedure StringSort(N :integer; A :PStrAr; imports QuickSort from QuickSort; const Size = 99; type MyArray = array[0..Size+1] of integer; ray; Fold :boolean); Abstract: Given an integer N and a pointer to an array [0..N+1] of strings, sort [0. var MyArrayPtr :^MyArray; i :integer; begin new(MyArrayPtr); for i := 0 to Size do readln(MyArrayPtr^[i]); .N] into ascending lexigocraphic order using QuickSort. StringSort is case sensitive (e.g. A < a) unle IntegerSort(Size,recast(MyArrayPtr,PIntArray)); for i := 0 to Size do writeln(MyArrayPtr^[i]); end. exports tyss Fold is True. Parameters: N :integer One less than the upper bound of the array. It is the largpe ss25 = String[25]; IntArray = array[0..0] of integer; StrArray = array[0..0] of ss25; PIntArray = ^Inest index of a valid key. A :PStrArray A pointer to an array [0..N+1] of strings. Fold :boolean  Args(var inputs, outputs: pArgRec; var switches: pSwitchRec; var err: String): boolean; Function ParseStrse 05 Feb 82 Procedure InitCmdFile(var inF: pCmdList; seg: Integer); Abstract: Initializes inF to be a valid Text  Module CmdParse 05 Feb 82 Module CmdParse; This module provides a number of routines to help with cringArgs(s: CString; var inputs, outputs: pArgRec; var switches: pSwitchRec; var err: String): boolean; ommand parsing. Written by Don Scelza April 30, 1980 Copyright (C) 1980 - Three Rivers Computer CorporaProcedure DstryArgRec(var a: pArgRec); Procedure DstrySwitchRec(var a: pSwitchRec); Type pCmdList = ^CmdListRec; CmdLition Version Number V3.6 {********************} Exports {********************} Const CmdPVersion = '3.5'; MaxCmds = stRec = RECORD - 16 - POS D.6 Interface Module CmdPars30; MaxCString = 255; CCR = Chr(13); {same as standard CR} CmdChar = Chr(24); CmdFileChar = Chr(26)e 05 Feb 82 cmdFile: Text; isCharDevice: Boolean; next: pCmdLi; Type CString = String[MaxCString]; CmdArray = Array[1..MaxCmds] Of String; Procedure CnvUpper(Var Str:CString); {st; seg: Integer; END; Procedure InitCmdFile(var inF: pCmdList; seg: Integer); Funct*** USE ConvUpper IN PERQ_String***} Function UniqueCmdIndex(Cmd:CString; Var CmdTable: CmdArray; NumCion DoCmdFile(line: CString; var inF: pCmdList; var err: String): boolean; Procedure ExitCmdFile(var inF: pCmdList); Proceduremds:Integer): Integer; Procedure RemDelimiters(Var Src:CString; Delimiters:CString; Var BrkChar:CStrin ExitAllCmdFiles(var inF: pCmdList); Procedure DstryCmdFiles(var inF: pCmdList); Function RemoveQuotes(var s: CString): boolg); Procedure GetSymbol(Var Src,Symbol:CString; Delimiters:CString; Var BrkChar:CString); Function Nextean; Type ErrorType = (ErBadSwitch, ErBadCmd, ErNoSwParam, ErNoCmdParam, ErSwParam, ErCmdParam, ErSwNotUniID(var id: CString; var isSwitch: Boolean): Char; Function NextIDString(var s, id: CString;var isSwitch: Boolean): Char; Typque, ErCmdNotUnique, ErNoOutFile, ErOneInput, ErOneOutput, ErFileNotFound, ErDirNotFound, e pArgRec = ^ArgRec; ArgRec = RECORD name: CString; next: pArgRec; END; ErIllCharAfter, ErCannotCreate, ErAnyError, ErBadQuote); Procedure StdError(err: ErrorType; param: CString; leaveProg: Boolea pSwitchRec = ^SwitchRec; SwitchRec = RECORD switch: CString; arg: CString; n); Function NextString(var s, id: CString; var isSwitch: Boolean): Char;  correspondingArg: pArgRec; next: pSwitchRec; END; Function ParseCmd - 17 - POS D.6 Interface Module CmdPa  e InitRandom; function Random: integer; - Disk(addr : DiskAddr) : ptrDiskBuffer; function ReadHeader(addr : DiskAddr) : ptrHeader; function ChangeHeader(addr : Di177 - POS D.6 Interface module RandomNumbers 05 Feb 82 Procedure InitRandom; AbskAddr) : ptrHeader; procedure FlushDisk(addr : DiskAddr); procedure WriteDisk(addr : DiskAddr; ptr : ptrDiskBuffer; hdptr : pstract: Initialize the random number generator. Every time this is called, the random numbers start over at thtrHeader); procedure WriteHeader(addr : DiskAddr; ptr : ptrDiskBuffer; hdptr : ptrHeader); procedure InitBuffers; function e same place.  FindDiskBuffer(dskaddr : DiskAddr; alwaysfind : boolean) : integer; procedure ReleaseBuffer(indx : integer); procedure FlushB - 178 - POS D.6 Interface MODULE Raster 05 Feb 82 uffer(indx : integer); procedure FlushAll; procedure ChangeBuffer(indx : integer); procedure ChgHdr(indx : integer); proceduMODULE Raster; Copywrite (C) 1980 - The Three Rivers Computer Corporation EXPORTS Const RRpl = 0; { Rasterre UseBuffer(indx,numtimes : integer); function BufferPointer(indx : integer) : ptrDiskBuffer; function HeaderPointer(indx : Op function codes } RNot = 1; RAnd = 2; RAndNot = 3; ROr = 4; ROrNot =  integer) : ptrHeader; function ReadAhead(addr : DiskAddr) : ptrDiskBuffer; procedure ForgetAll; Exception FlushFail(m5; RXor = 6; RXNor = 7; Type RasterPtr = ^RasterArray; {a pointer that can be used as RasterOp sg: String; operation: DiskCommand; addr: DiskAddr; softStat: integer); Abstract: Raised when th or Line source and destination } RasterArray = Array[0..0] of integer; e system is unable to flush out a buffer. The buffer is marked as flushed out, however, so the err - 179 - POS D.6 Interface or will not repeat the next time a buffer needs to be flushed Parameters: Same as DiskFailure (in DiskIO Module ReadDisk 05 Feb 82 Module ReadDisk; Abstract: Module to Read and write to t) Resume: ALLOWED, but has no effect (procedure will return normally as if flush had 1973, pp. 456-468. Random produces multidimensional pseudo-random numbers equally distributed in the interval -32768..32767he disk using a buffer system Written by the CMU Spice Group Version Number V1.5 {******************} exports {******* and has a period of 2^98. Version Number V1.2 {////////////////////////////} exports {\\\\\\\\\\\\\\\\\\\\\\\\\} procedur********************} imports DiskIO from DiskIO; function ReadDisk(addr : DiskAddr) : ptrDiskBuffer; function Change  and file should be invoked. The application will find a line that begins with an @ and will call themoved from inF unless attempting to remove last command file, when it is simply re-initialized to be the is procedure passing that line. This procedure maintains a stack of command files so that command files can console. It is OK to call this routine even when at the last entry of the list. Sugg contain other command files. Be sure to call InitCmdFile before calling this procedure. Parameteested use: While EOF(inF^.cmdFile) do ExitCmdFile(inF); Procedure ExitAllCmdFiles(var inF: pCrs: line - the command line found by the application. It is OK if it starts with an @ but it is also OK if imdList); Abstract: Remove all command file from list. Use when get an error or a ^SHIFT-C to File corresponding to the keyboard. This must be called before any other command file routines. Tt doesn't. inF - the list of command files. This was originally created by Inihe application should then read from inF^.cmdFile. E.g. ReadLn(inFile^.cmdFile, s); or while nottCmdFile and maintained by these procedures. If the name is a valid file, a new entry  eof(inFile^.cmdFile) do ... Use popup only if inF^.next = NIL (means no cmd File). Is a fileSystem file is put on the front of inF describing it. If there is an error, then inF is not changed. In any case, inF  if not inF^.isCharDevice. InF will never be NIL. The user should not modify the pCmdList pointers; use the will always be valid. err - if there is an error, then set to a string describing  procedures provided. Parameters: InF - is set to the new command list. seg - the segment numberthe error, complete with preceding '** '. If no error, then set to ''. The application can simply do: if not  to allocate the command file list out of. If the application doesn't care, use 0. This is  DoCmdFile(s, inF, err) then WriteLn(err); Returns: True if OK, or false if error. useful for programs like the Shell that require the list of command files to exist even after the program  - 18 - POS D.6 Interface Module CmdParse 05 Feb 82 Procedure E terminates. For other applications, use 0. Function DoCmdFile(line: CString; var inF: pCmdList; var err: StrixitCmdFile(var inF: pCmdList); Abstract: Remove top command file from list. Call this whenever come to end ng): boolean; Abstract: This procedure is meant to handle an input line that specifies that a commof a command file. Parameters: InF - the list of command files. It must never be NIL. The top entry is r  ader read into - 181 - POS D.6 Interface ameters: indx - is entry to mark - 182 - POS D.6 Interface been successful) - 180 - POS D.6 Interface  Module ReadDisk 05 Feb 82 Procedure FlushDisk(addr : DiskAddr); Abstract: Removes block specified from buffer sys Module ReadDisk 05 Feb 82 Function ReadDisk(addr : DiskAddr) : ptrDiskBuffer; Abstract: Read the block tem and writes it out if changed. If addr not in buffer then NO-OP Parameters: addr is block to flush  specified and return the ptr of the buffer read into Parameters: addr is the address of the block to read  Procedure WriteDisk(addr : DiskAddr; ptr : ptrDiskBuffer; hdptr : ptrHeader); Abstract: Writes out a block u Returns: ptr to buffer read into Function ReadAhead(addr : DiskAddr) : ptrDiskBuffer; Abstract: Identical tosing DskWrite. If block for addr is in a buffer then Release it first. Parameters: addr - the address of t ReadDisk Parameters: addr is the address of the block to read Returns: ptr to buffer read into Function Rehe block to write ptr - points to a buffer of data hdptr - points to a buffer of header Procedure WadHeader(addr : DiskAddr) : ptrHeader; Abstract: Reads block specified and returns a ptr to a buffer descriteHeader(addr : DiskAddr; ptr : ptrDiskBuffer; hdptr : ptrHeader); Abstract: Writes out a block using DskFirstribing its header Parameters: addr is the address of the block to read Returns: ptr to header read into FunWrite. If block for addr is in a buffer then Release it first. Parameters: addr is the address of the bloction ChangeDisk(addr : DiskAddr) : ptrDiskBuffer; Abstract: Reads block specified and returns a ptr to its data; in ck to write ptr points to a buffer of data hdptr points to a buffer of header Procedure InitBuffers; Abs addition, mark file as changed so flush will write it out Parameters: addr is the address of the block to read tract: Initializes the buffer system function FindDiskBuffer(dskaddr : DiskAddr; alwaysfind : boolean) : integer;  Returns: ptr to buffer holding the block read into Function ChangeHeader(addr : DiskAddr) : ptrHeader; Abs Abstract: Finds the buffer that contains the data for block dskAddr. Parameters: dskAddr - is tract: Reads block specified and returns a ptr to its data; in addition, mark file as header changed so flush will wraddress to find buffer for alwaysFind tells whether to read in if not found Returns: Index of buffer found ite it out using IOWriteFirst Parameters: addr is the address of the block to read Returns: ptr to heor zero if not there Procedure ReleaseBuffer(indx : integer); Abstract: Mark the table entry as unused. Par  xcept it uses the UsrCmdLine by default. WARNING: It is a bad idea to mix calls to NextID and moved. Function NextIDString(var s, id: CString; var isSwitch: Boolean): Char; Abstract: Gets the next RemDelimiters/GetSymbol since the latter 2 may change UsrCmdLine in a way that causes NextID to inc word off s and returns it. It is OK to call this routine when s is empty (id will be empty and retuorrectly report that an id is not a switch. This procedure also appends a CCR to the end of UsrCmdLrn will be CCR) This procedure also removes comments from s (from to end of line is ignored). This is exactlyine so it should not be printed after this procedure is called. - 19 - like NextID except it allows the user to specify the string to parse. WARNING: It is a bad  POS D.6 Interface Module CmdParse 05 Feb 82 Parameters: id - set to thidea to mix calls to NextIDString and RemDelimiters/GetSymbol since the latter 2 may change s in a way te next word on UsrCmdLine. If there are none, then id will be the empty string. isSwitch - tells hat causes NextIDString to incorrectly report that an id is not a switch. Parameters: s - Striwhether the word STARTED with a slash "/". The slash is not returned as part of the name. Results: Thng to parse. Changed to remove id and separators from front. The final character is also removed. reset all command files. Parameters: InF - the list of command files. It must never be NIL. All entries e character returned is the next "significant" character after the id. The possible choices are "=" "," " but the last are removed. Procedure DstryCmdFiles(var inF: pCmdList); Abstract: Removes all command files from lis " "~" CCR. CCR is used to mean the end of the line was hit before a significant character. If there aret. Parameters: InF - the list of command files. All entries are removed and InF set to NIL. Functio spaces after the id and then one of the other break characters defined above, then the break characten NextID(var id: CString; var isSwitch: Boolean): Char; Abstract: Gets the next word off UsrCmdLine and returns it. Ir is returned. If there is a simply another id and no break characters, then SPACE is returned. t is OK to call this routine when UsrCmdLine is empty (id will be empty and return will be CCR) This proce SideEffects: Puts a CCR at the end of UsrCmdLine so it is a bad idea to print UsrCmdLine after NextID is calldure also removes comments from s (from to end of line is ignored). This is exactly like NextIDString eed the first time. Removes id and separators from front of UsrCmdLine. The final character is also re   Parameters: indx - is buffer Returns: Ptr to buffer Function HeaderPointer(indx : integer) : ptrHeader; stract: Reads a boolean in free format. Parameters: X - the boolean to be read. F - the file fro Abstract: return the header Ptr for a buffer. Parameters: indx - is buffer Returns: ptr to header m which X is read. Errors: PastEof if an attempt is made to read F past the Eof. NotBoolean if a non-b - 183 - POS D.6 Interface module Reader 05 Feb 82 moolean is encountered in the file. procedure ReadCh( var F: FileType; var X: char; Field: integer ); Abstract: odule Reader; Reader - Stream package input conversion routines. J. P. Strait ca. 1 Jan 81. Copyright (C) Three RiveReads a character in fixed or free format. Parameters: X - the character to be read. F - the fil Module ReadDisk 05 Feb 82 Procedure FlushBuffer(indx : integer ); Abstract: Write out the data forrs Computer Corporation, 1981. Abstract: Reader is the character input module of the Stream package. It is cal the buffer indx if changed and then mark the buffer as not changed. Parameters: indx - is buffer to flush led by code generated by the Pascal compiler in response to Read or Readln. It is one level above Module Stream and u Errors: FlushFail - is raised if cannot Flush a buffer due to a write error Procedure FlushAll; ses Stream's lower-level input routines. Version Number V2.1 exports imports Stream from Stream; procedure R Abstract: Writes out the data for all the buffers and then mark them all as unchanged. Errors: FlushFail eadBoolean( var F: FileType; var X: boolean ); procedure ReadCh( var F: FileType; var X: char; Field: integer ); procedure Rea- is raised if cannot Flush a buffer due to a write error. Does not stop at first error, but goes and dChArray( var F: FileType; var X: ChArray; Max, Len: integer ); procedure ReadIdentifier( var F: FileType; var X: integer;  tries all buffers before raising the exception Procedure ChgHdr(indx : integer); Abstract: Mark a buffer as havin var IT: IdentTable; L: integer ); procedure ReadInteger( var F: FileType; var X: integer ); procedure g its header changed. Parameters: indx - is buffer to mark Procedure UseBuffer(indx,numtimes : integer); AReadString( var F: FileType; var X: String; Max, Len: integer ); procedure ReadX( var F: FileType; var X: integer; B: integer )bstract: Mark a buffer as used. Parameters: indx - is buffer to mark numTimes - the number to incrememt use; - 184 - POS D.6 Interface  count by Function BufferPointer(indx : integer) : ptrDiskBuffer; Abstract: return the bufferPtr for a buffer.  module Reader 05 Feb 82 procedure ReadBoolean( var F: FileType; var X: boolean ); Ab   Feb 82 Results: The character returned is the next "significant" character after the id. The possi is used to mean the end of the line was hit before a significant character. If there are spacble choices are "=" "," " " "~" CCR. CCR is used to mean the end of the line was hit before a significes after the id and then one of the other break characters defined above, then the break character isant character. If there are spaces after the id and then one of the other break characters defined abo returned. If there is a simply another id and no break characters, then SPACE is returned. Function Removve, then the break character is returned. If there is a simply another id and no break characters, then SPACE ieQuotes(var s: CString): boolean; Abstract: Changes all quoted quotes ('') into single quotes ('). Parameters:s returned. Function NextString(var s, id: CString; var isSwitch: Boolean): char; Abstract: Gets the n s - string to remove quotes from. It is changed. - 21 - POS D.6 Interfext word off s and returns it. It is OK to call this routine when s is empty (id will be empty and race Module CmdParse 05 Feb 82 Returns: true if all ok. False if a single quote endeturn will be CCR) This procedure also removes comments from s (from to end of line is ignored). The characed the string. In this case s still contains that quote. Function ParseCmdArgs(var inputs, outputs: pArgter after id is NOT removed from s. This is like NextIDString except the character is removed in NextIDRec; var switches: pSwitchRec; var err: String): boolean; Abstract: Parses the command line assuming standard fString. Parameters: s - String to parse. Changed to remove id and separators from frontorm. The command should be removed from the front using NextId before ParseCmdArgs is called. . Final character is NOT removed. id - set to the next word in string. If there are none, theParameters: inputs - set to list describing the inputs. There will always be at least one inpu id - set to the next word in string. If there are none, then id will be the empty string. n id will be the empty string. isSwitch - tells whether the word STARTED with a slash "/". The slaisSwitch - tells whether the word STARTED with a slash "/". The slash is not returned as part of the name. sh is not returned as part of the name. Results: The character returned is the next "significant" c - 20 - POS D.6 Interface Module CmdParse 05haracter after the id. This character remains at the front of s. The possible choices are "=" "," " " "~" CCR. CCR  made to read F past the Eof. - 185 - POS D.6 Interface  -32768..32767. - 186 - POS D.6 Interface  module Reader 05 Feb 82 procedure ReadIdentifier( var F: FileType; var X: integer; var IT: IdentTable module Reader 05 Feb 82 procedure ReadString( var F: FileType; var X: String; Max, Len: inte; L: integer ); Abstract: Reads an identifier and returns its position in a table. A table lookup isger ); Abstract: Reads a string in free or fixed format. If free format is selected, spaces are skipped  performed requiring only that the identifier typed uniquely matches the beginning of a single table entand characters are read until another space is encountered. Parameters: X - the string to be ry. Parameters: X - set to the ordinal of the identifier read. F - the file from which X is readread. F - the file from which X is to be read. Max - the declared maximum length of the string. . IT - the table of identifiers indexed from 0 to L. L - the largest identifier ordinal defined by the tab Len - the size of the field. Len <= 0 selects free format. Errors: PastEof - if an attempt is made to rele. Errors: BadIdTable - if length of the identifier table is less than 1. Pastad F past the Eof. procedure ReadX( var F: FileType; var X: integer; B: integer ); Abstract: Reads an integer ie from which X is to be read. Field - the size of the field X is in. Errors: PastEof if an attempt is madeEof - if an attempt is made to read F past the Eof. NotIdentifier - if a non-identifier is encountered in the  to read F past the Eof. procedure ReadChArray( var F: FileType; var X: ChArray; Max, Len: integer );  file. IdNotDefined - if the identifier is not in the table. IdNotUnique - if the identifier Abstract: Reads a packed character array in free or fixed format. If free format reading is selected, spaces are s is not unique. procedure ReadInteger( var F: FileType; var X: integer ); Abstract: Reads a decimal integer in kipped and characters are read until another space is encountered. Parameters: X - the charactefree format. Parameters: X - the integer to be read. F - the file from which X is to be read. r array to be read. F - the file from which X is to be read. Max - the declared length of X. Le Errors: PastEof - if an attempt is made to read F past the Eof. NotNumber - if non-numeric inpun - the size of the field. Len <= 0 selects free format reading. Errors: PastEof if an attempt is t is encountered in the file. LargeNumber- if the number is not in the range  t, although the name may be empty. outputs - set to list describing the outputs. There will he string to parse. inputs - set to list describing the inputs. There will always be at least always be at least one output, although the name may be empty. switches - set to the l one input, although the name may be empty. outputs - set to list describing the outputs. Therist of switches, if any. Each switch points to the input or output it is attached to. This mae will always be at least one output, although the name may be empty. switches - sey be NIL if the switch appears before any inputs. If a global switch, the application can ignore this t to the list of switches, if any. Each switch points to the input or output it is attached to. This  pointer. If a switch is supposed to be local, the application can search for each input may be NIL if the switch appears before any inputs. If a global switch, the application can ignor and output through the switches looking for the switches that correspond to this arg. e this pointer. If a switch is supposed to be local, the application can search for e Switches may be NIL if there are none. err - set to a string describing the error if there is oneach input and output through the switches looking for the switches that correspond to th. This string can simply be printed. If no error, then set to ''. Returns: false ifis arg. Switches may be NIL if there are none. err - set to a string describing the error if th there was a reported error so the cmdLine should be rejected. In this case, the pArgRecs should be ere is one. This string can simply be printed. If no error, then set to ''. Returns Destroyed anyway. Function ParseStringArgs(s: CString; var inputs, outputs: pArgRec; var switches: pSwitchRec; : false if there was a reported error so the string should be rejected. In this case, the pArgRecs should be Destroyvar err: String): boolean; Abstract: Parses the string assuming standard form. The command should be reed anyway. Procedure DstryArgRec(var a: pArgRec); Abstract: Deallocates the storage used by a ArgRec lmoved from the front using NextId before ParseCmdArgs is called. ist. Parameters: a - the head of the list of ArgRecs to deallocate. It is set to NIL. OK if NIL before ca - 22 - POS D.6 Interface Module CmdParse 05 Feb 82 Parameters: s - tll. Procedure DstrySwitchRec(var a: pSwitchRec); Abstract: Deallocates the storage used by a SwitchRec list.  tEof - if an attempt is made to read F past the Eof. NotNumber- if non-numeric input is encountered in the  TanH). DISCLAIMER: Only the most cursory testing of these functions has been done. No guarantees are ma file. LargeNumber- if the number is not in the range -32768..32767. de as to the accuracy or correctness of the functions. Validation of the functions must be done, but at some late BadBase - if the base is not in 2..36. - 187 - POS Dr date. Design: AdX, IntXp, SetXp, and Reduce are implemented as Pascal functions. It is clear that replaci.6 Interface module RealFunctions 05 Feb 82 module RealFunctions; RealFunctions - Standang the calls with in-line code (perhaps through a macro expansion) would improve the efficiency. Manyrd functions for reals. J. Strait 27 Nov 81. Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: Real temporary variables are used. Elimination of unnecessary temporaries would also improve the efficiency. Many Functions implements many of the standard functions whose domain and/or range is the set of real numbers.  limit constants have been chosen conservatively, thus trading a small loss in range for a guarantee of correctn The implementation of these functions was guided by the book Software Manual for the Elementary Functions, Wiless. The choice of these limits should be re-evaluated by someone with a better understanding of the issues. liam J. Cody, Jr. and William Waite, (C) 1980 by Prentice-Hall, Inc. The domain (inputs) and range (outputs)  Some constants are expressed in decimal (thus losing the guarantee of precision). Others are expressed as Sign,of the functions are given in their abstract. The following notation is used. Parentheses () are used fo Exponent, and Significand and are formed at execution time. Converting these two 32-bit constants which are Rr open intervals (those that do not include the endpoints), and brackets [] are used for closed intervals ecast into real numbers would improve the correctness and efficiency. More thought needs to be given to the vn free format with base B. B may be any integer between 2 and 36, inclusive. Parameters: X - t(those that do include their endpoints). The closed interval [RealMLargest, RealPLargest] is used to mean all real he integer to be read. F - the file from which X is to be read. Field - the size of the field X is in.  numbers, and the closed interval [-32768, 32767] is used to mean all integer numbers. Currently all fun B - the base of X. It may be any integer between 2 and 36, inclusive. Errors: Pasctions described by Cody and Waite are implemented with the exception of the hyperbolic functions (SinH, CosH,  Switch is not unique." ErCmdNotUnique - "** Command is not unique." ErNoOutFile - e table. Results: This procedure will return the index of Cmd in CmdTable. If Cmd was not found then retur"** does not have any outputs." ErOneInput - "** Only one input allowed for ." ErOn NumCmds + 1. If Cmd was not unique then return NumCmds+2. Procedure RemDelimiters(Var Src:CString; DelimineOutput - "** Only one output allowed for ." ErFileNotFound - "** File not found." ters:CString; Var BrkChar:CString); Abstract: This procedure is used to remove delimiters from the  Parameters: a - the head of a list of pSwitchRecs to deallocate. It is set to NIL. OK if NIL before call. ErDirNotFound - "** Directory does not exist." ErIllCharAfter - "** Illegal character after ."  - 23 - POS D.6 Interface Module CmdPa ErCannotCreate - "** Cannot create file ." ErBadQuote - "** Cannot end a line with Quote." rse 05 Feb 82 Procedure StdError(err: ErrorType; param: CString; leaveProg: Boolean); Abstract: Print ErAnyError - "" - 24 - POS D.6 Interface s out an error message with a parameter and then optionally exits the user program. Parameters: err - the e Module CmdParse 05 Feb 82 Procedure CnvUpper(Var Str:CString); Abstract: This procedure rror type found leaveProg - if true then after reporting error, raises ExitProg to return to this used to convert a string to uppercase. Parameters: Str is the string that is to be converted. e shell. If false then simply returns param - parameter for the error. The message printed is:  Side Effects: This procedure will change Str. ****WARNING**** THIS PROCEDURE WILL SOON BE REMOVED. USED TH ErBadSwitch - "** is an invalid switch." ErBadCmd - "** is an invalid command." E PROCEDURE ConvUpper IN PERQ_STRING Function UniqueCmdIndex(Cmd:CString; Var CmdTable: CmdArray;  ErNoSwParam - "** Switch does not take any arguments." ErNoCmdParam  NumCmds:Integer): Integer; Abstract: This procedure is used to do a unique lookup in a command table - "** Command does not take any arguments." ErSwParam - "** Illegal parameter . Parameters: Cmd - the command that we are looking for. CmdTable - a table of the valid commands. The ffor switch ." ErCmdParam - "** Illegal parameter for command ." ErSwNotUnique - "**irst valid command in this table must start at index 1. NumCmds - the number of valid command in th alues which are returned after resuming from an exception. The values that are returned  You may resume from this exception, in which case Sqrt returns Sqrt(Abs(X)). Parameters:  - 188 - POS D.6 Interface module RealFunctions 05 Feb 82 now are the ones X - Argument of Sqrt. exception ExpLarge( X: Real ); - 189 - PO recommended by Cody and Waite. It seems that Indefinite values (NaNs in the IEEE terminology) might make more senS D.6 Interface module RealFunctions 05 Feb 82 Abstract: ExpLarge is raise in some cases. Version Number V1.0 exports const RealPInfinity = Recast(#17740000000,Real); { 1.0 / 0.0 } sed when Exp is passed an argument which is too large. You may resume from this exception, in  RealMInfinity = Recast(#37740000000,Real); { -1.0 / 0.0 } RealPIndefinite = Recast(#00000000001,Real); { 0.0 / 0 which case Exp returns RealPInfinity. Parameters: X - Argument of Exp. exception ExpSmall(.0 } RealMIndefinite = Recast(#20000000001,Real); { -0.0 / 0.0 } RealPLargest = Recast(#17737777777,Real);  X: Real ); Abstract: ExpLarge is raised when Exp is passed an argument which is too s{ largest positive } RealMLargest = Recast(#37737777777,Real); { largest negative } RealPSmallest = Recast(mall. You may resume from this exception, in which case Exp returns 0.0. Parameters: #00040000000,Real); { smallest positive } RealMSmallest = Recast(#20040000000,Real); { smallest negative } fun X - Argument of Exp. exception LogSmall( X: Real ); Abstract: LogSmall is raise when Lction Sqrt( X: Real ): Real; function Exp( X: Real ): Real; function Ln( X: Real ): Real; function Log10( X: Real ): Real; fn or Log10 is passed an argument which is too small. You may resume from this exception unction Power( X, Y: Real ): Real; function PowerI( X: Real; Y: Integer ): Real; function Sin( X: Real ): Real; function Cos(in which case Ln or Log10 returns RealMInfinity if X is zero or the log of Abs(X) if X is  X: Real ): Real; function Tan( X: Real ): Real; function CoTan( X: Real ): Real; function ArcSin( X: Real ): Real; function non-zero. Parameters: X - Argument of Ln or Log10. exception PowerZero( X, Y: Real );  ArcCos( X: Real ): Real; function ArcTan( X: Real ): Real; function ArcTan2( Y, X: Real ): Real; exception SqrtNeg(  Abstract: PowerZero is raised when Power or PowerI is called with X = 0.0 and Y = X: Real ); Abstract: SqrtNeg is raised when Sqrt is passed a negative argument.0.0. You may resume from this exception in which case Power or PowerI returns Real - a string that defines what characters are to be considered delimiters. Any character in this string  { XSTs (must be even) } { Currently contains initial TP and GP }  will be used to terminate the next symbol. BrkChar - used to return the character that stopped the  DefStackSize = #20; { default stack segment size (in blocks) } DefHeapSize = #4; { default heap segmen scan. Side Effects: This procedure will remove the first symbol from Src and place it into t size (in blocks) } DefIncStack = #4; { default stack size increment (in blocks) } DefIncHeap = #4; Symbol. It will place the character that terminated the scan into BrkChar.  { default heap size increment (in blocks) } FudgeStack = #2000; { fudge space between system and user GDB's }  - 26 - POS D.6 Interface  { this must hold all loader variables at } { maximum configurat module Code 05 Feb 82 module Code; Code.Pas - Common definitions for the Linker and Loader. J. P. Strait 1ion in LoadStack } CommentLen = 80; { the length of comment and version str in seg} type SNArr front of a string. Parameters: Src - the string from which we are to remove the delimiters. Delim0 Feb 81. Rewritten as a module. Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: Code.Pas defines iters - a string that contains the characters that are to be considered delimiters. BrkChar - will hconstants and types shared by the Linker and the Loader. These include definitions of the run file and of offsets iold the character that we broke on. Side Effects: This procedure will change both Src and BrkChar. n the stack segment. Design: When the format of run files is changed, the constant RFileFormat must also be ch - 25 - POS D.6 Interface Module CmdParse 05 Feb 82 Procedanged. This is necessary to prevent the procedures which read run files from failing. exports imports GetTimeure GetSymbol(Var Src,Symbol:CString; Delimiters:CString; Var BrkChar:CString); Abstract: This procedure is usStamp from GetTimeStamp; const CodeVersion = '1.7'; RFileFormat = 2; QCodeVersion = 3; { Curred to remove the first symbol from the beginning of a string. Parameters: Src - the string from whent QCode Version Number } FileLength = 100; { max chars in a file name } SegLength = 8; { max ich we are to remove the symbol. Symbol - a string that is used to return the next symbol. Delimiters chars in a segment name } StackLeader = 2; { number of leader words in stack before }   Argument of Power or PowerI. exception PowerSmall( X, Y: Real ); Abstract: - 192 - POS D.6 Interface module RealFunctions 05 Feb 82 exception ArcSinLarge( X: Real PowerSmall is raised when Power or PowerI is called with X and Y for which X raised to the Y is too close ); Abstract: ArcSinLarge is raised when ArcSin is called with an argument which  to zero to be represented. You may resume from this exception in which case Power or PowerIis too large. You may resume from this exception in which case ArcSin returns RealPInfinity. ParametePInfinity. - 190 - POS D.6 Interface module RealFunc returns 0.0. - 191 - POS D.6 Interface module Reations 05 Feb 82 Parameters: X - Argument of Power or PowerI. Y - Argument of Power or lFunctions 05 Feb 82 Parameters: X - Argument of Power or PowerI. Y - Argument of Power PowerI. exception PowerNeg( X, Y: Real ); Abstract: PowerNeg is raised when Power is called or PowerI. exception SinLarge( X: Real ); Abstract: SinLarge is raised when Sin is calle with X < 0.0 or with X = 0.0 and Y < 0.0, or PowerI is called with X = 0.0 and Y < 0. You mayd with an argument which is too large. You may resume from this exception in which case Sin ret resume from this exception in which case Power or PowerI returns Power(Abs(X),Y) in the casurns 0.0. Parameters: X - Argument of Sin. exception CosLarge( X: Real ); Abstrace of X < 0.0 or returns RealPInfinity in the case of X = 0.0 and Y < 0.0. Parameters: t: CosLarge is raised when Cos is called with an argument which is too large. You may resume f X - Argument of Power or PowerI. Y - Argument of Power or PowerI. exception PowerBig( X, Y: Realrom this exception in which case Cos returns 0.0. Parameters: X - Argument of Cos.  ); Abstract: PowerBig is raised when Power or PowerI is called with X and Y for whic exception TanLarge( X: Real ); Abstract: CosLarge is raised when Tan or CoTan is called with h X raised to the Y power is too large to be represented. You may resume from this exception an argument which is too large. You may resume from this exception in which case Tan or CoTan in which case Power or PowerI returns RealPInfinity. Parameters: X - Argument of Power or PowerI. Y -returns 0.0. Parameters: X - Argument of Tan or CoTan.   time } 2: (Word1 : Integer; Word2 : Integer; Word3 : Int RunInfo = record { run header } RFileFormat:integer; Version: integer; eger) end; pSegNode = ^SegNode; pImpNode = ^ImpNode; { Segment informa System: boolean; InitialGP: integer; CurOffset: integer; tion record:} SegNode = record SegId : SNArray; { segment name } RootN StackSize: integer; StackIncr: integer; HeapSize: integer; am : pFNString; { file name without .Pas or .Seg } Hint : SegHint; { hint to the segment file }  - 28 - POS D.6 Interface module Code 05 Feb 82 Hea GDBSize : integer; { size of this segment's GDB } XSTSize : integer; { size of pIncr: integer; ProgramSN: integer; SegCount: integer end; this segment's XST } GDBOff : integer; { StackBase offset to GDB } ISN : inte RunFileType = file of Integer; { Segment file: } pSegBlock = ^SegBlock; SegBlock = pacger; { segment number inside Linker } CodeSize : integer; { number of blocks in .Seg file } ked record case boolean of { .SEG file definition } { first block: } true: (Prog SSN : integer; UsageCnt : integer; ImpList : pImpNode; ramSegment: boolean; SegBlkFiller : 0..127; QVersion : QVerRange;  Next : pSegNode end; { Import information record } ImpNode = record  ModuleName : SNArray; FileName : FNString; ay = packed array[1..SegLength] of Char; { segment name } pFNString = ^FNString; FNString = String[FileLe SId : SNArray; { name of imported segment } FilN : pFNString; { file name of impngth]; { file name } QVerRange = 0..255; { range of QCode version numbers } SegHint = recororted segment } XGP : integer; { global pointer of import } XSN : integer;d case Integer of - 27 - POS D.6 Interface module Code { internal number of import } Seg : pSegNode; Next : pImpNode  05 Feb 82 1: (Fid : Integer; { file id } Update: TimeStamp); { update end; { Run file: } RunElement = (RunHeader,SysSegment,UserSegment,Import,SegFileNames);  nctions 05 Feb 82 function Sqrt( X: Real ): Real; Abstract: Compute the square-root of a number. Doma be greater than zero. 2) X raised to the Y is a representable real number. Parameters: in = [0.0, RealPLargest]. Range = [0.0, Sqrt(RealPLargest)]. Parameters: X - In X - Input value. Y - Input value. Returns: X raised to the Y power. function PowerI( X: Real; Yput value. Returns: Square-root of X. function Ln( X: Real ): Real; Abstract: Compute the : Integer ): Real; Abstract: Compute the result of an arbitrary number raised to an arbitrary integer ponatural log of a number. Domain = [0.0, RealPLargest]. Range = [RealMLargest, Ln(RealPLargest)].wer. The difference between Power and PowerI is that negative values of X may be passed to PowerI. Doma Parameters: X - Input value. Returns: Natural log of X. function Log10( X: Real ): Real; inX = [RealMLargest, RealPLargest]. DomainY = [-32768, 32767]. Range = [RealMLargest, RealPLargest].  Abstract: Compute the log to the base 10 of a number. Domain = [0.0, RealPLargest]. Range = [Real With the restrictions that 1) if X is zero, Y must be non-zero. 2) X raised to the Y is a representablrs: X - Argument of ArcSin. exception ArcCosLarge( X: Real ); Abstract: ArcMLargest, Log10(RealPLargest)]. Parameters: X - Input value. Returns: Log to the base CosLarge is raised when ArcCos is called with an argument which is too large. You may resume from this 10 of X. - 194 - POS D.6 Interface modul exception in which case ArcCos returns RealPInfinity. Parameters: X - Argument of ArcCos.e RealFunctions 05 Feb 82 function Exp( X: Real ): Real; Abstract: Compute the exponential function.  exception ArcTan2Zero( Y, X: Real ); Abstract: ArcTan2Zero is raised when ArcTan2 is calleDomain = [-85.0, 87.0]. Range = (0.0, RealPLargest]. Parameters: X - Input value. Returns: e rad with both X and Y equal to zero. You may resume from this exception in which case Arcised to the X power. function Power( X, Y: Real ): Real; Abstract: Compute the result of an arbitrary number rTan2 returns RealPInfinity. Parameters: Y - Argument of ArcTan2. X - Argument of ArcTan2. aised to an arbitrary power. DomainX = [0.0, RealPLargest]. DomainY = [Re - 193 - POS D.6 Interface module RealFualMLargest,RealPLargest]. Range = [0.0, RealPLargest]. With the restrictions that 1) if X is zero, Y must   integer; Version : String[CommentLen]; Comment : String[Com.15; H: 0..1; W: 0..1; B: 0..1; A: 0..7; Y: 0..2mentLen]); false:(Block: array[0..255] of integer) end; CImpInfo = record c55; X: 0..255); 2: (JmpCnd: 0..255; Fill1: 0..255; SFF: 0..63; ase boolean of { Import List Info - as generated } { by the compiler }  ALU0: 0..1; ALU1: 0..1; ALU23: 0..3) end; MicroBinary = { The format o true: ( ModuleName: SNArray; { module identifier } FileName: FNString { filef a micro-instruction and its address as produced by the micro-assembler. } record Adrs name } ); false:( Ary: array [0..0] of integer) e: integer; MI: MicroInstruction end; TransMicro = { The format of a micro-instruction as needed bynd; SegFileType = file of SegBlock; - 29 the WCS QCode. } packed record case integer of 0: (Word1: integer; Word2: - POS D.6 Interface module ControlStore 05 Feb 82 module ControlStore; ControlSto integer; Word3: integer); 1: (ALU23: 0..3; - 30 - POS D.6 Inre - Load and call routines in the PERQ control-store. J. P. Strait ca. July 80. Copyright (C) Three Rivers Computer Corpterface module ControlStore 05 Feb 82 ALU0: 0..1; W: 0..1; oration, 1981. Abstract: The ControlStore module exports types defining the format of PERQ micro-instructions and ALU1: 0..1; A: 0..7; Z: 0..255; SFF: 0..63; H:  procedures to load and call routines in the control-store. Version Number V1.2 exports type MicroInstruction  0..1; B: 0..1; JmpCnd:0..255) end; MicroFile = file of MicroBinary; { A fi= { The format of a micro-instruction as produced by the micro-assembler. } packed record cale of micro-instructions. } procedure LoadControlStore( var F: MicroFile ); procedure LoadMicroInstruction( Adrs: integerse integer of 0: (Word1: integer; Word2: integer; Word3: integer); 1: (Jmp: 0..1; MI: MicroInstruction ); procedure JumpControlStore( Adrs: integer );  NumSeg : integer; ImportBlock : integer; GDBSize :5; Cnd: 0..15; Z: 0..255; SF: 0..15; F: 0..3; ALU: 0.  function Cos( X: Real ): Real; Abstract: Compute the cosin of a number. Domain = [-1E5, 1E5]. Range97 - POS D.6 Interface module RealFunctions 05 Feb 82 Returns: Arccosin of X.  = [-1.0, 1.0]. Parameters: X - Input value. Returns: Cos of X. function Tan( X: Real ):  Design: It seems that the Domain and Range ought to be closed intervals, however this implementation appareReal; Abstract: Compute the tangent of a number. Domain = [-6433.0, 6433.0]. Range = [RealMInfinntly returns a number very close to zero when X is -1.0, rather than returning -Pi/2 as it should.ity, RealPInfinity]. Parameters: X - Input value. - function ArcTan( X: Real ): Real; Abstract: Compute the arctangent of a number. Domain = [RealMLa 196 - POS D.6 Interface module RealFunctions 05 Feb 82 Returns: Tangent of X. rgest, RealPLargest]. Range = (-Pi/2, Pi/2). Parameters: X - Input value. Return function CoTan( X: Real ): Real; Abstract: Compute the cotangent of a number. Domain = [-6433.0, s: Arctangent of X. Design: Seems fine except for very large numbers. function ArcTan2( Y, X: Real ): Real; 6433.0]. Range = [RealMInfinity, RealPInfinity]. Parameters: X - Input value. Ret Abstract: Compute the arctangent of the quotient of two numbers. One interpretation is that the parametersurns: Cotangent of X. function ArcSin( X: Real ): Real; Abstract: Compute the arcsin of a number.  represent the cartesian coordinate (X,Y) and ArcTan2(Y,X) is the angle formed by (X,Y), (0,0), and Domain = [-1.0, 1.0). Range = [-Pi/2, Pi/2). Parameters: X - Input value. Returns: Arcsin of X.(1,0). DomainY = [RealMLargest, RealPLargest]. DomainX = [RealMLargest, RealPLargest]. Rangee real number. - 195 - POS D.6 Interface  Design: It seems that the Domain and Range ought to be closed intervals, however this implementation  module RealFunctions 05 Feb 82 Parameters: X - Input value. Y - Input value. Retuapparently returns a number very close to zero when X is 1.0, rather than returning Pi/2 as it shorns: X raised to the Y power. function Sin( X: Real ): Real; Abstract: Compute the sin of a number. uld. function ArcCos( X: Real ): Real; Abstract: Compute the arccosin of a number. Domain = (-1.0, Domain = [-1E5, 1E5]. Range = [-1.0, 1.0]. Parameters: X - Input value. Returns: Sin of X.  1.0]. Range = (-Pi/2, Pi/2]. Parameters: X - Input value. - 1  LoadExpr( LOr( Shift(Adrs,8), Shift(Adrs,-8) ) ); InLineByte( #277 ); the JCS QCode *dresses are actually contained in the Random Index (which is part of the FileInformationBlock). The second section h) Note 2: Microcode called by JumpControlStore should terminate with a "NextInst(0)" microcode as a list of blocks each of which contain 128 Disk Addresses of blocks in the file, forming a one level indirect addressin - 31 - POS D.6 Interface module jump instruction. Parameters: Adrs - The address to jump to. ControlStore 05 Feb 82 procedure LoadControlStore( var F: MicroFile ); Abstract: Loads the contents of a Mic - 32 - POS D.6 Interface module DiskIO 05 Feb 82 module DiskIO; Abstract: roFile into the PERQ control-store. The file whould be opened (with Reset) before calling LoadCo This module implements the basic low level operations to disk devices. It services the Hard Disk and the Floppy.ntrolStore. It is read to EOF but not closed; thus it should be closed after calling LoadC When dealing with the floppy here, the structures on the hard disk are mapped to the structures on the floppy. VontrolStore. Parameters: F - The MicroFile that contains the micro-instructions to be loadeersion Number V3.13 {******************} exports {***************************} imports Arith from Arith; imports FileDefs fd. procedure LoadMicroInstruction( Adrs: integer; MI: MicroInstruction ); Abstract: Loads a single micro-inrom FileDefs; imports IOErrors from IOErrors; const HARDNUMBER = 0; {device code of Shugart Disk} struction into the PERQ control-store. Parameters: Adrs - The control store address to be l FLOPPYNUMBER = 1; {device code of FloppyDisk} {a Disk Address can be distinguished from a Segmentoaded. MI - The micro-instruction to be loaded. procedure JumpControlStore( Adrs: integer ); Abstr Address by the upper two bits (in 32 bits). These bits have a nonzero code to which disk the address is part of}act: Transfers control of the PERQ micro engine to a particular address in the control-store. No RECORDIOBITS = #140000; {VirtualAddress upper 16 bits of disk} DISKBITS = RECORDIOBITS + (Hte 1: Values may not be loaded onto the expression stack before calling JumpControlStore. If you wish to pass valuARDNUMBER*(#20000)); FLOPBITS = RECORDIOBITS + (FLOPPYNUMBER*(#20000)); {The following definitions tell hes through the expression stack, the following code whould be used rather than calling LoadControlStore.ow many entries there are in the three pieces of the random index. The first piece (Direct) are blocks whose DiskAd  / X. Design: Seems fine except for very large Y/X. - 198 - POS Dtant RFileFormat in module Code must be changed. This is necessary so that the procedures to read run files will not .6 Interface module RS232Baud 05 Feb 82 module RS232Baud; Abstract: RS232Baud - fail. Version Number V1.1 exports const RunReadVersion = '1.1'; imports Code from Code; procedure ReadRunFiset RS232 baud rate with optional input enable. J. P. Strait 21 Aug 80. Copyright (c) Three Rivers Computer le( var RunFile: RunFileType; Seg: Integer; var Header: RunInfo; var FirstSeg, F Corporation 1980. Version Number V1.1 exports procedure SetBaud(Baud: String; Enable: Boolean); Exception BadBaudRatirstUserSeg, LastSeg: pSegNode; ImportsWanted: Boolean ); procedure ReadSegNames( var RunFile: RunFile; Abstract: Raised if string is not a valid baud rate eType; Seg: Integer; FirstUserSeg: pSegNode );  - 199 - POS D.6 Interface module RS232B - 201 - POS D.6 Interface module RunRead 05 Feb 82 proceduaud 05 Feb 82 procedure SetBaud(Baud: String; Enable: Boolean); Abstract: Sets the baud rate to baud specified re ReadRunFile( var RunFile: RunFileType; Seg: Integer; var Header: RunInfo; var FirstSeg, FirstUserSeg, LastSeg: pSby string arg Arguments: Baud is string of new baud rate (e.g. "2400") Enable says whether to allow tregNode; ImportsWanted: Boolean ); Abstract: ReadRunFile reads a run file and builds a structure tansfers on RS232 SideEffects: Changes status of RS232 Errors: Raises BadBaudRate if string is illegal hat represents that run file. The run file is read up to, but not including, the names of the .Seg files.  - 200 - Parameters: RunFile - A file variable which has been Reset to the desired file. ReadRunFile  POS D.6 Interface module RunRead 05 Feb 82 module RunRead; RunRead - Module to redoes *not* close the file. Seg - Segment number for dynamic allocation. Header - The RunInfo recordad run files. John P Strait 9 Apr 81. CopyRight (C) Three Rivers Computer Corporation, 1981. Abstract: RunRead expo. FirstSeg - Set to point to the first segment in the run file. FirstUserSeg - Set to = [-Pi, Pi]. Parameters: Y - Input value. X - Input value. Returns: Arctangent of Yrts procedures to read and write run files. Design: If and when the format of run files is changed, the cons loppyDouble, UnUsed1, UnUsed2); - 33 - POS D.6 Interface  ID : SegID; Filename : SimpleName end; DiskBuffer = packed record  module DiskIO 05 Feb 82 MyDble = Array [0..1] of integer; DiskCheatType = record  case integer of 1: ( Addr : array [0..(DISKBUFSIZE div 2)-1] of Dis case integer of 1: ( Addr : DiskAddr kAddr ); 2: ( IntData : array [0..DISKBUFSIZE-1] of FS ); 2: ( Dbl : MyDble { should be IO.Double but don't Bit16 ); 3: ( ByteData : packed array [0..DISKBUFSIZE* import IO in export section } ); 2-1] of FSBit8 ); {4 is format of the FileInformationBlock; the FIB has Logical Block -1 } g scheme. For very large files, the third section (DblInd) has DiskAddresses of blocks which point to other bl 3: ( Seg : SegID ); 4: ( ocks which contain 128 DiskAddresses of blocks in the file, forming a two level indirect scheme.} DIRECTSIZE  Lng : FSBit32 ) end; { A directory is an ordina = 64; { Entries in FIB of blocks directly accessable } INDSIZE = 32; { Entries in FIB of 1 level indirect ry file which contains SegIDs of files along with their names. Directories are hash coded by file name to make loblocks } DBLINDSIZE = 2; { Entries in FIB of 2 level indirect blocks } FILESPERDIRBLK = 16; { 256 /okup fast. They are often sparse files (ie contain unallocated blocks between allocated blocks). The file name is a  SizeOf(DirEntry) } NUMTRIES = 15; { number of tries at transfer before aborting } type {Temporary segm SimpleName, since a directory can only contain entries for files within the partition (and thus device) where the dirents go away when processes are destroyed, Permanent segments persist until explicitly destroyed Bad Segments are noectory itself is located } DirEntry = packed record InUse : boolean; {true if this DirEntt well formed segments which are not readable by the Segment system} SpiceSegKind = (Temporary, Permanent, Bad); ry is valid} Deleted : boolean; {true if entry deleted but not expunged} Archived : boo PartitionType = (Root, UnUsed, Leaf); {A Root Partition is a device} DeviceType = (Winch12, Winch24, FloppySingle, Flean; {true if entry is on backup tape} UnUsed : 0..#17777; {reserved for later use}   so that the procedures to read run files will not crap out. Version Number V1.1 exports const RunWriteVersion =  {if true then can have an arbitrary number of windows and storage for them has to be allocated off a '1.1'; imports Code from Code; procedure WriteRunFile( var RunFile: RunFileType; Header: RunInfo; heap. If false then there are 17 windows max, and storage is in screens global data.  point to the first user segment in the run file. LastSeg - Set to point to the last segment in the  FirstSeg, FirstUserSeg: pSegNode ); run file. ImportsWanted - True iff Import entries are to be read from the run file. procedure - 203 - POS D.6 Interface module RunWrite 05 Feb 82 procedure WriteRunFile( v ReadSegNames( var RunFile: RunFileType; Seg: Integer; FirstUserSeg: pSegNode ); Abstract: ReadSegNames ar RunFile: RunFileType; Header: RunInfo; FirstSeg, FirstUserSeg: pSegNode ); Abstract: ReadRunFile writes a rreads .Seg file names from a run file and adds them to a structure that represents that run file. Parameterun file from a structure that represents that run file. Parameters: RunFile - A file varis: RunFile - A file variable which has been Reset to the desired file and already read able which has been Rewritten to the desired file. WriteRunFile does *not* close the file. Header with ReadRunFile. ReadSegNames does *not* close the file. Seg - Segment number for dynamic allo- The RunInfo record. FirstSeg - A pointer to the first segment in the run file. FirstUserSeg - A pointer cation. FirstUserSeg - A pointer to the first user segment in the run file. to the first user segment in the run file.  - 202 - POS D.6 Interface module RunWrite 0 - 204 - POS D.6 Interface Module Scree5 Feb 82 module RunWrite; RunWrite - Module to write run files. John P Strait 9 Apr 81. CopyRight (C) Three Rivers Cn 05 Feb 82 Module Screen; Written By: Miles A. Barel July 1, 1980 Three Rivers Computer Corporation Pittsburgh, omputer Corporation, 1981. Abstract: RunWrite exports procedures to write run files. Design: If and when thPA 15213 Abstract: Provides the interface to the PERQ screen including rudimentary support for multiple windows Exports e format of run files is changed, the constant RFileFormat in module Code must be changed. This is necessary  Imports Raster from Raster; Version Number V3.12 Const ScreenVersion = 'V3.12'; VarWin = false;   The blocks in the Random index have logical block numbers that are negative. The logical  5: ( {The Free List is a chain of free blocks linked  block number of Indirect[0] is -2 (the FIB is -1) the last possible block's by their headers } FreeHead : DiskAddr; {Hint of Block Number of the  number is -(INDSIZE+DBLINBDSIZE+1)} Direct : array [0..DIRECTSIZE- head of the free list} FreeTail : DiskAddr; {Hint of Block Number of the1] of DiskAddr; Indirect : array [0..INDSIZE-1] of DiskAddr; DblInd  tail of the free list} NumFree : FSBit32; {Hi : array [0..DBLINDSIZE-1] of DiskAddr; SegKind : SpiceSegKind; Nnt of how many blocks are on the free list} RootDiumBlksInUse : integer; {segments can have gaps, block n may exist when block rID : SegID; {where to find the Root Directory}  n-1 has never been allocated.  BadSegID : SegID; {where the bad segment is} {when booting, the boot character is indexed in NumBlksInUse says how many data blocks are actually used to the following tables to find where code to be boot loaded is found }  4: ( FSData : FSDataEntry; {The Random Index is a hin by the segment} LastBlk : FSBit16; {Logical Block Number of t of the DiskAddresses of the blocks that form the file. - 34 - largest block allocated} LastAddr : DiskAddr; {Dis POS D.6 Interface module DiskIO 05 Feb 82 It has three partkAddr of LastBlk } LastNegBlk : FSBit16; {Logical Block Number of s as noted above. Notice that all three parts are always there, so that largest pointer block allocated}  even in a very large file, the first DIRECTSIZE blocks can be located quickly LastNegAddr: DiskAddr {Block number of LastNegBlk} ); {5 is the format of the DiskInformationBlock}   { access patterns, hence allowing } { KSets of different sizes }  set: } { FF - clear screen { CR - move left to ma end; {$ifc VarWin then} WindowP = ^WindowType; {$endc} WindowType = Packed Record {$ifc VarWin then} rgine { LF - move vertically down one { BS - erase winNumber: Integer; {this window number} {$endc} winBY, winTY, winLX, winRX,  previous character } Procedure SSetCursor(X,Y: integer); { Set Cursor Position to X,Y } Procedure SReadCursor(var X,Y:  { Limits of window area } winHX, winHY, winMX, winMY, integer);{ Read Cursor Position } Procedure SCurOn; { Enable display of Cursor } Procedure SCurOff;  { Limits of useable area } winCurX, winCurY, winFunc: integer;  { Disable display of Cursor } Procedure SCurChr(C: char); { Set cursor character } Procedure SChr NOTE: There are still bugs in VarWin true} Type FontPtr = ^Font; Font = Packed Record { winKSet: FontPtr; winCrsChr: char; winHasTitle, winCursorOn, define Contains character sets } Height:integer; { Height of the KSet } Base: integer; d: boolean; {$ifc VarWin then} winNext: WindowP; {$endc} end; {$ifc VarWin th { distance from top of characters to base-line } Index: Array [0..#177] of { Index into characen} - 205 - POS D.6 Interface Module Screen 05 Feb 82ter patterns } Packed Record case boolean of true: (Offset: 0..767;  Const MaxWIndx = 32767; {$elsec} Const MaxWIndx = 17; {$endc} Type WinRange = 0..MaxWIndx; LineStyle = { position of character in patterns Line: 0..63; { Line of (DrawLine,EraseLine,XorLine); LS = String[255]; Procedure ScreenInit; { CALL THIS ONCE AT BOOT } Proce patterns containing char } Width: integer); { Width of the character } false:(dure ScreenReset; { This procedure de-allocates storage for all windows andLoc:integer; Widd: integer) end; Filler: array[0..1] of integer; Pat: Arr sets up the default window. } Procedure SPutChr(CH:char); { put character CH out to current position } ay [0..0] of integer; { patterns go here } { We turn off range checking to }  { on the screen. Chars FF, CR, and LF } { have special meanings unless #200 bit Start : DiskAddr; PartEnd : DiskAddr; SubParts : array [0..63] of DieroBuffer(ptr : ptrDiskBuffer); {write zeroes in all words of the buffer. When reskAddr; - 35 - POS D.6 Interface module DiskIO 05 Febading an unallocated block, Zeros are returned in the  82 PartRoot : DiskAddr; PartKind : PartitionType;  buffer} function WhichDisk(addr : DiskAddr) : integer; {Tells you which disk number a  PartDevice : DeviceType ); {6 is the format of a block of a Directory}  DiskAddr is on} function AddrToField(addr : DiskAddr) : integer; {gives you a one word short  6: ( Entry : array [0..FILESPERDIRBLK-1] of DirEntry )  address by taking the lower  end; ptrDiskBuffer = ^DiskBuffer; Header = packed record {format of a block header}  byte of the upper word and the upper byte of the lower  SerialNum : DiskAddr; {Actually has the SegID of the file} LogBlock : integer; {logical block num word. The upper byte of the upper word can'ber} Filler : integer; {holds a hint to a candidate for the Ft have any significant bits for the 12 reeHead} PrevAdr : DiskAddr; {Disk Address of the next block in  or 24 megabyte disks. The lower byte of the lower word  this segment} NextAdr : DiskAddr; {Disk Address of the previous block in  is always zero (since a disk  this segment} end; ptrHeader = ^Header; DiskCommand= (DskRead, DskWrite, DskFirstWriaddress is a page address, which is 256 words  BootTable : array [0..25] of DiskAddr; {qcode} InterpTable: array [0..2te, DskReset, DskHdrRead, DskHdrWrite); {last ones for error reporting} var DiskSegment : intege5] of DiskAddr; {microcode} PartName : packed array [1..8] of char; Partr; {a memory segment for DiskIO} procedure InitDiskIO; {initialize DiskIO, called at boot time} procedure Z  Procedure ChangeWindow(WIndx: WinRange); Procedure GetWindowParms(var WIndx: WinRange; var OrgX, OrgY, Width, HeighveLineEnd(x: Integer); Procedure SFullWindow; Const SScreenW = 48; {for use when want Screen in RasterOp or Line} Vart: integer; var hasTitle: Boolean); Procedure ChangeTitle(Title: string); Procedure SetFont(NewFont: FontPtr); Function GetFo SScreenP: RasterPtr; {for use when want Screen in RasterOp or Line} SCursorOn: boolean; SFunc: integer; { nt: FontPtr; Procedure SClearChar(c: Char; funct: Integer); {delete prev char} { c BERaster-op function for SPutChr } {$ifc VarWin then} FirstWindp, { first window's pointer; better not be NITTER NOT be CR or LF} Procedure Line(Style: LineStyle; X1, Y1, X2, Y2: integer; Origin: RasterPtr); Procedure SBackSpace(c: ChL } CurWindp: WindowP; { current window's pointer } {$elsec} CurWind: WinRange; WinTable: Array[WinRaar); {move back over last char of curLine} { c BETTER NOT be CR or LF} Procedure Refresnge] of WindowType; {$endc} Exception CursOutSide; Abstract: Raised if try to set the cursor outside of the currenthWindow(WIndx: WinRange); {redraws window outline and title area. DOES NOT REDRAW  window. Resume: Allowed. If resume, then cursor is NOT moved (same effect as if TITLE} Exception WBadSize; {parameter to SSetSize bad} Abstract: Raised if the lines parameter to SSetSize is no signal is caught but not resumed). - 207 - POS t a multiple of 128 or is <=0. Also raised if a window is totally below area tD.6 Interface Module Screen 05 Feb 82 Procedure StartLine; Abstract: Resets CurlineFunc(F: integer); { Set raster-op function for SPutChr } Procedure SSetSize(Lo release so will disappear then if window # 0 or is the current window, then Raises WBadSize. ines: integer; complemented, screenOff: Boolean); { Set Screen Size; lines must be a  - 206 - POS D.6 Interface Module Screen 05 Feb 82 Exception BadWN multiple of 128; screenOff if true turns off display in part beloum; {indx is invalid} Abstract: Raised if a window number parameter is illegal (not defined or out w lines in which case, complemented describes off part o of range. Exception WTooBig; Abstract: Raised if parameters for new window specify an area f screen } Procedure CreateWindow(WIndx: WinRange; OrgX, OrgY, Width, Height: integer; Title: string); that would extend off screen. Procedure StartLine; Procedure ToggleCursor; Procedure NewLine; Procedure Sa  calls MapAddr (a private routine which does the translatialzed. Calls: CreateSegment Function NumberPages(DevType:DeviceType) : FSBit32; Abstract: Returns numbe } - 36 - POS D.6 Interface motion) Map Addr implements interlace algorithm} function PhysAddrToLogAddr(disk : intedule DiskIO 05 Feb 82 function FieldToAddr(disk: integer; fld : integer) : DiskAddr; ger; addr : DiskAddr) : DiskAddr; function LastDiskAddr(DevType : DeviceType) : DiskAddr; {Gets the Disk Address  { Makes a DiskAddr out of a short address and a disk  of the last possible pag number } procedure DiskIO(adde on the device} function NumberPages(DevType : DeviceType) : FSBit32; {Return the number of r : DiskAddr; ptr : ptrDiskBuffer; hptr : ptrHeader; dskcommand : DiskCommand); {Do a disk  pages on a device} procedure DiskReset; {Reset the disk controller and recalibrate the actuate operation, if errorr} function TryDiskIO(addr : DiskAddr; ptr : ptrDiskBuffer; hptr : ptrHeader; dskcommand : DiskCommand;s occur, exits via  numTries: integer) : boolean; {Try a disk operation, but, return fal DiskError} function LogAddrToPhysAddr(addr : DiskAddr) : DiskAddr; se if error occurred } Exception DiskFailure(m {translate a Logical Disk Address (used throughout the system) to and from a sg: String; operation: DiskCommand; addr: DiskAddr; softStat: integer); Exception DiskError(msg: String physical Disk Address (the kind the disk contoller sees) ); Exception BadDevice; Var ErrorCnt : Array[IOEFirstError..IOELastError] of integer; Logical Disk Addresses use a sequential numbering system  - 37 - POS D.6 Interface module DiskIO 05 Feb 82 Procedure InitDiskIO; Abs Physical Disk Addresses have a Cylinder-Head-Sector system This routine tract: Initializes the DiskIO package SideEffects: Creates a new segment (DiskSegment). Sets Ini he cursor to the specified screen position. Parameters: x and y are Screen position where the next char will ted describes the off part of the screen and screenOff determines whether it is displayed (false) or not;  go. Note that y specified the BOTTOM of the character. SideEffects: Changes the cur char positions AND sets line to  if displayed then complemented determines whether it is erased white or black. Errors: if linesbe empty (so BS won't work); Errors: Raises CursOutside if try to set the cursor outside the cur a bad value then Raises WBadSize. If a window is totally below area to release and will disappear then if rent window Procedure SReadCursor(var x,y:integer); Abstract: Returns the current screen coords for chars.  window # 0 or is the current window, then Raises WBadSize. SideEffects: Changes the values describing windows. If aParameters: x and y are set to the Screen position where the next char will go Procedure SCurOn; Abstrac window is totally below area to release and will disappear then if not window # 0 or is the currentt: Turns the char cursor on. SideEffects: Changes SCursorOn global vble Procedure SCurOff; Abstract: Turns  window, then makes the window undefined. Procedure NewLine; Abstract: Moves the cursor to the nexthe char cursor off. SideEffects: Changes SCursorOn global vble -t line scrolling if necessary; DOES NOT do a CR SideEffects: Changes the cursor position and may scroll  208 - POS D.6 Interface Module Screen 05 Feb 82 Procedure SCurChr(C: char); Ab Procedure SaveLineEnd(x: Integer); Abstract: Saves x as the end of a line Parameters: x is the xPos of the enstract: Set the character to be used as the cursor. SideEffects: Changes the cursor character Procedure SChrFunc(F:d of a line SideEffects: puts x at the end of LineEnds table; increments lastLineEnd; if table is full t integer); Abstract: Set the function to be used for drawing chars to the screen. SideEffects: Chahen scrolls table - 209 - POS D.6 Interface Modunges the char function Procedure SSetSize(Lines: integer; complemented, screenOff: Boolean); Abstract: Change the le Screen 05 Feb 82 Procedure SBackSpace(c: Char); Abstract: Move the cursor back over c; c BETTER NOT be CR or LF  and variables describing the current line start. Procedure ToggleCursor; Abstract: Inverts Cursor picsize of the screen so rest of memory can be used for other things (if smaller) Parameters: Lines is the numbeture. SideEffects: Changes the picture on the screen; Procedure SSetCursor(x,y: integer); Abstract: Moves tr of lines in the displayed part of the screen. It must be a multiple of 128 and > 0. Complemen  DiskAddr; Abstract: Return a DiskAddress given a short address and the disk device code Parameters : ptrHeader; dskcommand : DiskCommand; numTries: integer) : boolean; Abstract: Calls DoDiskIO with: disk - the disk device code fld - the short address (returned by AddrToField at some  DieOnError set false Parameters: see DoDiskIO Returns: true if tranfer went ok, false if errors occurred  point) Function LogAddrToPhysAddr(addr : DiskAddr) : DiskAddr; Abstract: Convert a Logical DiskAddress to a  - 40 - POS D.6 Interface Physical Disk Address Parameters: addr - the disk address to be converted Calls: MapA module Dynamic 05 Feb 82 module Dynamic; Dynamic - Perq dynamic memory allocation and de-allocation. J. P.r of pages on a disk Parameters: DevType: a device code Function LastDiskAddr(DevType:DeviceType) : DiskAddr; ddr Function PhysAddrToLogAddr(disk : integer; addr : DiskAddr) : DiskAddr; Abstract: Translate a Ph Abstract: Returns Disk Address of last possible page on a disk Parameters: DevType: a device code Callsysical Disk Address to a logical disk address Parameters: disk - Device code of disk : NumberOfPages Procedure ZeroBuffer(ptr : ptrDiskBuffer); Abstract: clear buffer to zeroes Parameters:  addr - Physical address to translate Calls: UnMapAddr - 39 -  ptr - a pointer to a disk buffer Function WhichDisk(addr : DiskAddr) : integer; Abstract: Return disk dev POS D.6 Interface module DiskIO 05 Feb 82 Procedure DiskReset; Abstract: Reset thice of a DiskAddr Parameters addr a DiskAddr that you want the device code for e Hard Disk and recalibrate the drive Calls: UnitIO Design: Assuming that the disk is at track 201, seek in  - 38 - POS D.6 Interface module DiskIO 05 Feb 82 Function AddrToone track until the Track 0 bit in the disk status is set Then force the microcode to believe that this Field(addr : DiskAddr) : integer; Abstract: return a short (one word) disk address by taking the low byteis track 0, and reset the disk controller again Procedure DiskIO(addr: DiskAddr; ptr: ptrDiskBuffer; hptr: ptrH of the most significant word of the Disk Address and the upper byte of the least significant word Parameeader; dskcommand: DiskCommand); Abstract: Calls DoDiskIO with DieOnError set true; does 15 retrters: addr - the Disk Address of to get a short address for Function FieldToAddr(disk: integer; fld : integer) :ies (3 recalibrates) Parameters: see DoDiskIO function TryDiskIO(addr : DiskAddr; ptr : ptrDiskBuffer; hptr  Parameters: WIndx is index to use for the window created; OrgX and OrgY are the upper left corner of the outsideact: Writes out current window's parameters and changes to new one Parameters: WindX is new window's number Parameters: c is the character to backspace over. SideEffects: Moves the cursor back the width of char c; (DOES N of the new window (chars will be at least 5 bits in from that). Width and Height are total outside valOT ERASE CHAR) Procedure SClearChar(c: char; funct: Integer); Abstract: Deletes the c from screen; c BETues for window (NOT the width and height of the character area). Title is title TER NOT be CR or LF Parameters: c is char to be erased; funct is RasterOp function to use in deleting char.  - 210 - POS D.6 Interface Module Screen 05 Feb 82 for window. If noIt should be RXor if chars are black on white and RXNor if chars are white on black. SideEffects: erases thet '' then hairlines and a black area are put around window. SideEffects: Writes current values into current last char of line; Procedure SPutChr(CH: Char); Abstract: Write a char into the current window Parameters: window; creates a new window and erases its area on screen Errors: Raises BadWNum if WIndx invalid Raises WT Ch is char to write. If #200 bit is not set, checks to see if char is one of Bell, BS, FF, LF, CR and does ooBig if window would extend off the screen Procedure SFullWindow; Abstract: Changes the parameters of something special. SideEffects: Writes char to screen, moves cursor; may do a NewLine (and s the current window to be the full screen SideEffects: Changes the size of the current window. Does NOT croll) if at end of Line Procedure ChangeTitle(Title: string); Abstract: Changes the title of the current window ( refresh or change the title line or erase anything or move the cursor Procedure RefreshWindow(WIndx:and displays new one). Parameters: Title is new string. Characters in it are quoted so special  WinRange); Abstract: Redraws window outline and title area (but not title text) Parameters: Windocharacters will be displayed. SideEffects: Changes title on screen Procedure CreateWindow(WIndx: WinRange; Ow to refresh (better be already created) Errors: Raises BadWNum if WIndx undefined Procedure GetWindowParms(var WrgX,OrgY,Width,Height: integer; Title:string); Abstract: Creates new window for Windx (or overwrites old values Indx: WinRange; var OrgX, OrgY, Width, Height: integer; var hasTitle: Boolean); Abstract: Returns parameters for c for that window) and makes it the current window. Writes title (IN CURRENT FONT) if title <> ''; urrent window Parameters: All set to current window's values Procedure ChangeWindow(WIndx: WinRange); Abstr  Next: Integer; Length: Integer; Rest: 2*Length - 2 words end; Where Next*2 is the address of the next fre If the data segment is full and cannot be increased, P is set to nil. L - Length ie node and Length*2 is the number of free words. Version Number V1.4 exports const DynamicVersion = '1.4'; in words, 0 represents a length of 2**16. If L is odd, L+1 words are allocated. Errors: FullSegment mports Memory from Memory; procedure NewP( S: SegmentNumber; A: integer; var P: MMPointer; L: integer ); procedure Disposeif the segment has reached its maximum size and there isn't enough room for the node. FullMemory if P( var P: MMPointer; L: integer ); - 41 - POS D.6NewP tries to expand the segment, but there enough physical memory to do so. UnusedSegment if S is not In Interface module Dynamic 05 Feb 82 procedure DisposeP( var P: MMPointer; L: integer ); Use. NotDataSegment if S is not a DataSegment. - 42 -  Abstract: Deallocate memory. Parameters: P - Pointer to the memory. L - Length in words,  POS D.6 Interface module Ether10IO 05 Feb 82 module Ether10IO; Abstract: This0 represents a length of 2**16. If L is odd, L+1 words are de-allocated. Errors: NilPointer if P is  module provides the client interface to the 10 Mbaud Ethernet microcode. Written by: Don Scelza C Strait 1 Jan 80. Copyright (C) Three Rivers Computer Corporation, 1980, 1981,1982. Abstract: Dynamic implementsnil. BadPointer 1) if the Offset part is odd. 2) if Offset+Length > size of segment. 3) if the nod Pascal dynamic allocation - New and Dispose. Memory of a given size with a given alignment may be allocated fre to be Dispose overlaps some node that is already free. 4) if the segment is not InUse or not a DataSegment. om any data segment. If the data segment is full (doesn't contain enough free memory to allocate), the segment is in procedure NewP( S: SegmentNumber; A: integer; var P: MMPointer; L: integer ); Abstract: Allocate memory.creased in multiples of the segment's increment size until there is enough free memory to allocate. Similarl Parameters: S - Number of segment to allocate from. 0 means the default data segment. y, memory that was once allocated may be deallocated. Design: Free memory within each segment is linked into a cir A - Alignment of node in words relative to beginning of segment, 0 represents an alignment of 2**16cular freelist in order of address. Each free node is at least two words long and is of the form record. if A is odd, A+1 is used as the alignment. P - Set to point to the memory that was allocated.   function for the line; X1, X2, Y1, Y2 are end points of line, Origin is pointer to the memory to draw fset of start of parameters to exception PEnd - offset of end of parameters to exception ExcSeg - the segm lines in. Use SScreenP for Origin to draw lines on the screen. ent number of the exceptions module if (ES = ExcSeg) and (ER = ErrDump) then is ^SHIFT-D For now,  - 212 - POS D.6 Interface Module Scrounge 05 Feb 82 Module Scrounge;  can't tell ^SHIFT-C RaiseAP - the offset for AP for Raise itself (caller is person who did t Abstract: This module contains the procedure Scrounge which allows a small amount of debugging. Since there are no syhe raise) - Errors: Raises BadWNum if WIndx undefined - 211 - POS D.mbol tables or micro-- code support for breakpoints, you can look at the stack trace and examine vbles by offsets. 6 Interface Module Screen 05 Feb 82 Procedure SetFont(NewFont: FontPtr); Abstract: Ch The types of the variables have to be specified by the user. Written by: Brad A. Myers 1-May-1981 Copyright (anges font to be NewFont Parameters: NewFont is font to use SideEffects: Changes font in current window so all fC) 1981 Three Rivers Computer Corporation. Version Number V0.14 {////////////////////////} EXPORTS {\\\\\\\\\\\\\\\\\\\\\\\\urther writes (including titles) will be in this font Function GetFont: FontPtr; Abstract: Returns curre\\\\\\\\} Procedure Scrounge(ES, ER, PStart, PEnd, ExcSeg, RaiseAP: Integer); nt font Returns: font currently in use Procedure ScreenReset; Abstract: Erases screen; Removes all window;  - 213 - POS D.6 Interface  sets Window 0 to have full screen boundary and a blank title SideEffects: Erases or sets all parameter Module Scrounge 05 Feb 82 Procedure Scrounge(ES, ER, PStart, PEnd, ExcSeg, RaiseAP: Integer); Abstract: Scrous; font set to system font Procedure ScreenInit; Abstract: Sets FirstWindP to NIL and sets up defaulnge is called when uncaught signals are noticed or when the user types ^SHIFT-D. It allows looking around at t window; NOTE: CALL THIS PROCEDURE ONCE AT SYSTEM INITIALIZE Calls: ScreenReset; Procedure Line(Style local and global vbles and the stack trace. If ^SHIFT-D then can continue with program, otherwise aborts w: LineStyle; X1, Y1, X2, Y2: integer; Origin: RasterPtr); Abstract: Draws a line. Parameters: Style ishen exit Parameters: ES - segment number of exception ER - routine number of exception PStart - of cument: The Ethernet A Local Area Network Data Link Layer and Physical Layer Specifications DEC - Intel - XEROX nager to place the buffers in a convient place in memory before they are locked down. The Ethernet driver needs to have a fo For details on the Three Rivers hardware interface to the network see: Ethernet Interface Programmers Guide Pradeep Reddur (4) word area of memory in which it can save registers. A pointer to this area of memory is provided by the BuffPtr why For details on the interface presented, to this module, by the Ethernet microcode see the file: Ether10.Micro Den a Reset command is executed. Once the Reset command has been processed this register save area can NOT be moved. To chaonald A. Scelza Following is some general information about the client interface presented by the Ethernet microcode and nge the register save area another Reset command must be executed. The Ethernet DCB must be unmovable while the command is pthis module: It is possible to always have a receive pending. If a send command is executed while a receive is pendinending. To wait for the completion of a command it is possible to spin on the Command-In-Progress bit in the status g the internal state of the interface is saved in a register save area in memory. This is done by saving the VA of the DCblock. This bit will be cleared when the requested command has been completed. After a receive the Bits field of the statB for the receive. After the send has completed the receive state is reloaded and the receive is restarted. In addition us block has the number of bits that were received. To translate this into the number of data bytes you must perform ato the ability to do a Receive followed by a Send, it is also possible to do multiple Receives. The Receives are linked using number of operations. First divide it by 8. This will give the number of bytes that were received. If the number i the NextDCB field of the Ethernet DCB. When a Receive completes the next Receive in the chain is started. Command informas not evenly divisible by 8 then there was a transmissintializeon error. After the division you must subtract the nution for the Ethernet driver is provided in an Ethernet Device Control Block, DCB. All data areas referenced by pointersmber of bytes in the header and the CRC. There is a total of 20 bytes in these two portions of the packet. opyright (C) Three Rivers Computer Corporation, 1981 {********************} Exports {********************} This modul in the DCB - 43 - POS D.6 Interface module Ether10IO 05 Fe provides the raw I/O interface to the Three Rivers Computer Ethernet system. The procedures in this module allow the clieb 82 as well as the DCB itself must be LOCKED in memory until the request has completed. They can NOT be moved. Theent to send and receive packets on the net. For details of the Physical and Data Link layers of the network see the do best way to do this is to mark the segment that the buffers are allocated from as UnMovable. This will allow the memory ma imports FileDefs from FileDefs; const StreamVersion = '1.20'; IdentLength = 8; { significant characters i FNotOpen : boolean; { false if file is open } FNotRewrite: boolean; { set false if a Rewrin an identifier } type pStreamBuffer = ^StreamBuffer; StreamBuffer = record case integer of { element size: } te has been performed on this file } FExternal : boolean;  0: (W: array[0..255] of integer); { 1 or more words, or > 8 bits } 1: (B1: packed array[0..0] of 0..1); { 1 b { not used - will be permanent/temp file flag } FBusy : booleait } 2: (B2: packed array[0..0] of 0..3); { 2 bits } 3: (B3: packed array[0..0] of 0..7); { 3 bits } n; { IO is in progress } FKind : FileKind); 1: (skip1 : 0..3; ReadError : 4: (B4: packed array[0..0] of 0..15); { 4 bits } 5: (B5: packed array[0..0] of 0..31); { 5 bits } 6: (B6: pack0..7); 2: (skip2 : 0..15; WriteError: 0..3) end; EolCh, EofCh, EraseCh, NoiseCh: Conted array[0..0] of 0..63); { 6 bits } 7: (B7: packed array[0..0] of 0..127); { 7 bits } 8: (B8: packed array[0..rolChar; {self explanatory} OmitCh : set of ControlChar; FileNum : integer; { POS file number 0] of 0..255); { 8 bits } 9: (C: packed array[0..255] of char); { for character structured } end; Con} Index : integer; { current word in buffer for un-packed files, cu 214 - POS D.6 Interface module Stream 05 Feb 82 module Stream; Stream - Perq PasctrolChar = 0..#37; { ordinal of an ASCII control character } al stream package. John Strait ca. Jan 80. Copyright (C) Three Rivers Computer Corporation, 1980. Abstract: FileKind = (BlockStructured, CharacterStructured); FileType = { file of Thing } packed record Flag: pack This module implements the low-level Pascal I/O. It is not intended for use directly by user programs, ed record case integer of 0: (CharReady : boolean; { character is in file window } but rather the compiler generates calls to these routines when a Reset, Rewrite, Get, or Put is encountered. High - 215 - POS D.6 Interface module Stream 05 Feb 82 FEoln : er-level character I/O functions (Read and Write) are implemented by the two modules Reader and Writer. Iboolean; { end of line flag } FEof : boolean; { end of file } FNotReset : bn this module, the term "file buffer variable" refers to F^ for a file variable F. Version Number V1.20 exports oolean; { false if a Reset has been performed on this file }   - 44 - POS D.6 Interface RetryTime: 0..15; UnUsed12: boolean; UnUsed13: boolean; SendError: boolean; { Could not  module Ether10IO 05 Feb 82 imports SystemDefs from SystemDefs; imports System from System; { { Define the send packet after 16 tries. } CmdInProg: boolean; { There is a command pending. } BitsRecv: integetypes and variables used by the Network stuff. { } type { { These are the valid commands for the Ethernet interfr; { Number of bits that were received. } end; { { This record defines the header for an Ethernet tace. { } EtherCommand = (EReset, EReceive, EPromiscuousReceive, ESend); { { An Ethernet address is 48 biransfer. - 45 - POS D.6 Interface module Ether10IO 05ts long. It is made up of 6 { octets or in our case 3 words. { } EtherAddress = packed record { An address o Feb 82 { { Alignment: 8 word. { Locked: Yes. { } EtherHeader = packed record Desn the net is 48 bits } High: integer; Mid: integer; Low: integer; end; { { Thit: EtherAddress; Src: EtherAddress; EType: Integer; { Type field defined by XEROX } s record defines an Ethernet status block. The first { 15 bits of the block are defined by the hardware interface. {  end; { { This record provides the definition of an EtherBuffer. { { Alignment: 1k word. { The 16th bit of the first word and the second word are defined by the { Ethernet microcode. { { Alignment: DouLocked: Yes. { } EtherBuffer = array [0..749] of integer; { { Define all of the pointers that we nble word. { Locked: Yes. { } EtherStatus = packed record { The status record. } CRCError: eed. { } pEtherStatus = ^EtherStatus; pEtherBuffer = ^EtherBuffer; pEtherHeader = ^EtherHeader; pEthe boolean; { There was a CRC error.} Collision: boolean; { There was a collision } RecvTrans: brDCB = ^EtherDCB; { { This is the definition of an Ethernet Device Control Block. { { Alignment: Quad woolean; { 0 - receive has finished. 1 for trans. } Busy: boolean; { The interface is bust. } ord. { Locked: Yes. { } EtherDCB = packed record HeadPtr: pEtherHeader; BuffPtr:  UnUsed4: boolean; ClockOver: boolean; { The microsecond clock overflowed. } PIP: bool pEtherBuffer; StatPtr: pEtherStatus; Cmd: EtherCommand; BitCnt: Integer; {ean; { There is a Packet In Progress. } Carrier: boolean; { There is traffic on the net. }  Total bits in buffer and header } NextDCB: pEtherDCB; end; { { This is the definition that is  buffer } LengthInBlocks: integer; { file length in blocks } LastBlockLength:integer; { last block leng function StreamName( var F: FileType ): PathName; function FullLn( var F: Text ): Boolean; procedure StreamKeyBoardReset( vath in bits } SizeInWords : integer; { element size in words, 0 means packr F: Text ); exception ResetError( FileName: PathName ); Abstract: Raised when unable to reseted file } SizeInBits : 0..16; { element size in bits for packed files  a file--usually file not found but also could be ill-formatted name or bad device name. } ElsPerWord : 0..16; { elements per word for packed files } Element: { Thing } record case integer o Parameters: FileName - name of the file or device. exception RewriteError( FileName: PathName );f {The File window} 1: (C: char); 2: (W: array[0..0] of integer) end end; ChArra Abstract: Raised when unable to rewrite a file--usually file unknown device y = packed array[1..1] of char; {For read/write character array} Identifier = string[IdentLength]; IdentTable = or partition but also could be ill-formatted name or bad device name. Parameters: array[0..1] of Identifier; var StreamSegment: integer; { Segment buffer for I/O buffers } KeyBuffer: packed ar FileName - name of the file or device. exception NotTextFile( FileName: PathName ); Abstract: ray[0..255] of char; KeyNext, KeyLength: integer; - 216 - POS D.6 Interface  Raised when an attempt is made to open a non-text file to a character-structured device.  module Stream 05 Feb 82 procedure StreamInit( var F: FileType; WordSize, BitSize: integer - 217 - POS D.6 Interface module Stream 05 Feb 82 Parameters: ; CharFile: boolean ); procedure StreamOpen( var F: FileType; var Name: PathName;  FileName - name of the device. exception NotOpen; Abstract: Raised when an atrrent element for packed files } Length : integer; { length of buffe WordSize, BitSize: integer; CharFile: boolean; OpenWrite: boolean ); procedure StreamClose( var F: Fr in words for un- packed files, in elements for packed ileType ); procedure GetB( var F: Filetype ); procedure PutB( var F: Filetype ); procedure GetC( var F: Filetype ); procedur files } BlockNumber : integer; { next logical block number } Buffer : pStreamBuffer;{ I/O e PutC( var F: FileType ); procedure PReadln( var F: Filetype ); procedure PWriteln( var F: Filetype ); procedure InitStream;  UnUsed5: boolean; UnUsed6: boolean; UnUsed7: boolean; UnUsed8: boolean; Une the procedures exported by this module. { } procedure E10Init; procedure E10IO(Cmd: EtherCommand; Header: pEtherHeader; Used9: boolean; UnUsed10: boolean; UnUsed11: boolean; UnUsed12: boolean; UnUsed13: boo Buff: pEtherBuff; Stat: pEtherStatus; Bytes: Integer); procedure E10Wait(Stat: pEtherStatus); procedure Elean; UnUsed14: boolean; CmdInProg: boolean; end; puSClkDCB = ^uSClkDCB; 10Reset(MyAdr: EtherAddress); function E10DataBytes(RecvBits: Integer): Integer; function E10GetAdr: EtherAddress; procedurused to create the register save { area. { { Alignment: Double word. { Locked: Yes. { }  - 47 - POS D.6 Interface module Ether10IO 05 Feb 82 {  EtherRegSave = record RecvDCB: pEtherDCB; - 46 - POS D.6 Interface  { Define the constants for the address block supplied to Three Rivers by { Xerox. { { High 16 bits (2 octets) are 02 1C (Hex module Ether10IO 05 Feb 82 SendDcb: pEtherDCB; end; pEtherRegSave = ^Et). { Next 8 bits (1 octet) is 7C (Hex). { { The low order byte of the second PERQ word as well as the third PERQ word { are herRegSave; { { Following are the definitions that are used to deal with the { micro-second clock. { }Three Rivers defined. Currently the low order byte of the second word { is used to define the type of interface. The valid va { { The microsecond clock takes a two word combined control and { status block. The first word of the block glues are: { { 0 - Interface is on an IO option board. { 1 - Interface is on the IO board { } const Tives the number { of microseconds to be loaded into the clock. { The second word provides the status information from RCCAdrMid = 31744; { 7C hex in the high order 8 bits. } TRCCAdrHigh = 540; { 02 1C hex. } EBoardOptthe { clock. Once a clock command has been started it is { possible to spin on the CmdInProgress bit in the control ion = 0; { The interface is on an I/O Option board. } EBoardIO = 1; { The interface is on the I/O  { block. When the bit is cleared the specified number of { micro-seconds has elapsed. { { Alignment: Doubboard. } { { These are some other useful constants. { } const MinDataBytes = 46; { Smallest number ofle word. { Locked: Yes. { } type uSClkDCB = packed record uSeconds: integer; UnUsed0 data bytes in a packet. } MaxDataBytes = 1500; { Largest number of data bytes in a packet. } NumDCBs = 16; : boolean; UnUsed1: boolean; UnUsed2: boolean; UnUsed3: boolean; UnUsed4: boolean; { The number of DCBs, commands, possible at } { a single time } { { These ar tempt is made to use a file which is not open. exception NotReset( FileName: PathName ); Abstra automatic initialization of file variables), this may be caused by referencing a file which has nevct: Raised when an attempt is made to read a file which is open but has not been reset. er been opened. exception NotIdentifier( FileName: PathName ); Abstract: Raise Parameters: FileName - name of the file or device. exception NotRewrite( FileName: PathName ); d when an identifier is expected on a file, but something else is encountered. Parameters:  Abstract: Raised when an attempt is made to write a file which is open but has not been rewri FileName - name of the file or device. exception NotBoolean( FileName: PathName ); Abstract: tten. Parameters: FileName - name of the file or device. exception PastEof( FileName: PathName  Raised when a boolean is expected on a file, but something else is encountered. ); Abstract: Raised when an attempt is made to read past the end of the file.  - 219 - POS D.6 Interface module Stream 05 Feb 82 Parameters Parameters: FileName - name of the file or device. exception UnitIOError( FileName: PathName ); : FileName - name of the file or device. exception BadIdTable( FileName: PathName ); Abstract:  - 218 - POS D.6 Interface module Stream 05 Feb 82  Raised by ReadIdentifier when the identifier table is bad. Parameters:  Abstract: Raised when IOCRead or IOCWrite returns an error status. Parameter FileName - name of the file or device. exception IdNotUnique( FileName: PathName; Id: Identifier ); Abstracts: FileName - name of the device. exception TimeOutError( FileName: PathName ); Abstract: : Raised when non-unique identifier is read. Parameters: FileName - name of the file Raised when a device times out. Parameters: FileName - name of the device. exception or device. Id - the identifier which was read. exception IdNotDefined( FileName: PathName; Id: Ide UndfDevice; Abstract: Raised when an attempt is made to reference a file which intifier ); Abstract: Raised when an undefined identifier is read. Parameters: s open to a character-structured device, but the device number is bad. In the current system (lacking  FileName - name of the file or device. Id - the identifier which was read. exception NotNumber(  the valid range. The number of data bytes in an Ethernet packet must be in the range 46  module. It must be called before any other procedure in this package are used. Side Effects: This p<-> 1500, (MinDataBytes <-> MaxDataBytes). exception E10DByteError; Abstract: This exception rocedure will allocate any memory used by this module. procedure E10IO(Cmd: EtherCommand; Header: pEis raised if the number of Bits passed to E10DataBytes does not form a valid packet. exception E10BadCommtherHeader; Buff: pEtherBuff; Stat: pEtherStatus; Bytes: Integer); Abstract: This procedure is used to sand; Abstract: This exception is raised if a bad command is given to any of the routtart an Ethernet I/O operation and return. Parameters: Cmd is the command that is to be executed. ines in this package. exception E10TooMany; - 49 - POS D.6 Interface  Header is a pointer to an Ethernet header block. The client must fill in all fields of this header.  module Ether10IO 05 Feb 82 Abstract: This exception is raised if more than Buff is a pointer to the buffer that is to be sent or filled. Stat is a pointer to a stae E10State(var NumSend, NumReceive: Integer); procedure E10WIO(Cmd: EtherCommand; Header: pEtherHeader; Buf NumDCBs commands are executed at any time. exception E10STooMany; Abstract: Thisf: pEtherBuff; Stat: pEtherStatus; Bytes: Integer); - 48 - POS D.6 Interf exception is raised if more the client tries to execute more than one send. exception E10ReceiveDone(Stace module Ether10IO 05 Feb 82 { { These are the exceptions that may be raised by this modulat: pEtherStatus); Abstract: This exception is raised when a receive command has fe. { } exception E10NInited; Abstract: This exception will be raised if any procedures in this inished. It is raised by the Pascal level interrupt routine for the net. Parameters:  package are called before E10Init. exception E10NReset; Abstract: This exceptio Stat will be set to the status pointer of the command that finished. n will be raised if any transfer commands are executed before a E10Reset is done. exception E10ByteCount; - 50 - POS D.6 Interface module Abstract: This exception is raised if a byte count passed to this interface is not in Ether10IO 05 Feb 82 procedure E10Init; Abstract: This procedure is used to initialize the Ethernet  ); Abstract: Raised when a real number is read from a file, but it is too large. edure StreamClose( var F: FileType ); Abstract: Closes the file variable F. Parameters: F - the f - 221 - POS D.6 Interface module Stream 05 Febile variable to be closed. procedure StreamOpen( var F: FileType; var Name: PathName; WordSize, BitSize: integer; 82 Parameters: FileName - name of the file or device. exception RealWriteError( FileName: PathNa CharFile: boolean; OpenWrite: boolean ); Abstract: Opens the file variable F. This procedure corresponds  FileName: PathName ); Abstract: Raised when a number is expected on a file, but me ); Abstract: Raised when an attempt is made to write a real number which is inval something else is encountered. - 220 - POS D.6 Interface id. Parameters: FileName - name of the file or device. exception NotReal( FileName: PathName ); module Stream 05 Feb 82 Parameters: FileName - name of the file or device. exc Abstract: Raised when a real number is expected on a file, but something else is eeption LargeNumber( FileName: PathName ); Abstract: Raised when a number is read from a file, but it incountered. Parameters: FileName - name of the file or device. s too large. Parameters: FileName - name of the file or device. exception Small - 222 - POS D.6 Interface module StreReal( FileName: PathName ); Abstract: Raised when a real number is read from a file, but it am 05 Feb 82 procedure StreamInit( var F: FileType; WordSize, BitSize: integer; CharFile: boolean ); Abs is too small. Parameters: FileName - name of the file or device. exception BadBase( Filtract: Initializes, but does not open, the file variable F. Automatically called upon entry to the block in whiceName: PathName; Base: Integer ); Abstract: Raised when an attempt is made to read a number with a h the file is declared. (To be written when the compiler generates calls to it.) Para numeric base that is not in the range 2..36. Parameters: FileName - name of the file ormeters: F - the file variable to be initialized. WordSize and BitSize are the size of an elem device. Base - numeric base (which is not in the range 2..36). exception LargeReal( FileName: PathName ent of the file. CharFile - determines whether or not the file is of characters. proc  Send, Receive or PromisciousReceive. E10TooMany: is raised if too many commands are executed at a givbits that were in the packet. This value will come from the BitsRecv field of the status block. en time. E10STooMany: is raised if more than one send command is executed.  Results: This function will return the number of data bytes that were in the packet.  - 51 - POS D.6 Interface module Ether10IO 05 Feb 82 procedure E1 - 52 - POS D.6 Interface module Ether10IO 05 Feb 82 Exception0Wait(Stat: pEtherStatus); Abstract: This procedure will wait for the completion of some Ethernet reques: E10NInited: Raised if this procedure is called before EtherInit. E10NReset: Raised if this procedure st. Parameters: Stat is the pointer to the EtherStatus that was provided when the command was initiatis called before EReset. E10DByteError: Raised if the numebr of bits in the packet was not a multipleed. Exceptions: E10NInited: Raised if this procedure is called before E10Init. E10NReset: Rais of 8 or if the number of data bytes was less than MinDataBytes. function E10GetAdr: EtherAddress; ed if this procedure is called before EReset. procedure E10Reset(MyAdr: EtherAddress); Abstract: This procedure Abstract: This function will return the address of this machine. Exceptions: E10NInited: Raised if this procedure is is used to reset the Ethernet interface. Parameters: MyAdr is an Ethernet address block that contains the  called before E10Init. E10NReset: Raised if this procedure is called before EReset. procedure E1 address of this this interface. Once this address is set any packets that have a Source field that matches MyAdr0State(var NumSend, NumReceive: integer); Abstract: This procedure is used to return the internal state of tus block for use during this command. Bytes is the number of data bytes that are to be  will be received by the network interface. If there are no Receives pending then the packet will b transferred. This value must be between 46 and 1500 Exceptions: E10NInited: Raised if this procedure is callede dumped. Exceptions: E10NInited: Raised if this procedure is called before EtherInit. function E10D before EtherInit. E10NReset: Raised if this procedure is called before EReset. E10ByteCounataBytes(RecvBits: Integer): Integer; Abstract: This procedure is used to obtain the number of data bytt: Raised if Bytes is not in the valid range. E10BadCommand: This is raised if the command passed is not es that are in a packet that was received over the network. Parameters: RecvBits is the number of  Feb 82 procedure GetB( var F: Filetype ); Abstract: Advances to the next element of a block-structured file  F - the file to be advanced. Errors: NotOpen - if F is not open. NotRewrite - if F  and gets it into the file buffer variable. Parameters: F - the file to be advanced. Errors: has not been rewritten. UnitIOError- if IOCWrite doesn't return IOEIOC or IOEIOB. TimeOutError- if RS:NotOpen if F is not open. NotReset if F has not been reset. PastEof if an attempt is made to read F past Eof.  or RSX: times out. UndfDevice - if F is open, but the device number is bad. procedure PReadln( var F: Filety procedure GetC( var F: Filetype ); Abstract: Advances to the next element of a character-structured pe ); Abstract: Advances to the first character following an end-of-line. Parameters: file and gets it into the file buffer variable. Parameters: F - the file to be advanced. Errors:  F - the file to be advanced. procedure PWriteln( var F: Filetype ); Abstract: Writes an end-of-line. NotOpen - if F is not open. NotReset - if F has not been reset. PastEof - if an attempt is m Parameters: F - the file to which an end-of-line is written. procedure StreamKeyBoardReset( var F:  to both Reset and Rewrite. Parameters: F - the file variable to be opened. Name - the file nameade to read F past Eof. TimeOutError - if RS: or RSX: times out. UnitIOError - if IOCRead doesn't return. WordSize - number of words in an element of the file (0 indicates a packed file). B IOEIOC or IOEIOB. UndfDevice - if F is open, but the device number is bad. procedure PutB( var F: Filetype )itSize - number of bits in an element of the file (for packed files). CharFile - true if the fil; Abstract: Writes the value of the file buffer variable to the block-structured file and advances the e is a character file. OpenWrite - true if the file is to be opened for writing (otherwise it is file. Parameters: F - the file to be advanced. Errors: NotOpen - if F is not open. opened for reading). Errors: ResetError if unable to reset the file. RewriteError if unable to rewrite NotRewrite- if F has not been rewritten. - 224 - POS D.6 Interfa the file. NotATextFile if an attempt is made to open a non-text file to a character structured device module Stream 05 Feb 82 procedure PutC( var F: FileType ); Abstract: Writes the ce. - 223 - POS D.6 Interface module Stream 05 value of the file buffer variable to the character- structured file and advances the file. Parameters:   NumReceive will be set to the number of receives that are pending. Exceptions: E10NInited: Raised an one send command is executed. if this procedure is called before E10Init. E10NReset: Raised if this procedure is called before EReset. - 54 - POS D.6 Interface module EtherInterrupt 05 Feb 82 module EtherInterrupt;  procedure E10WIO(Cmd: EtherCommand; Header: pEtherHeader; Buff: pEtherBuff; Stat: pEtherStatus; Bytes: In Abstract: This module provides the interrupt service for the 10 MBaud ethernet. Written by: Don Scelzteger); Abstract: This procedure is used to start an Ethernet I/O operation and wait for it to compa. Copyright (C) Three Rivers Computer Corporation, 1981 {********************} Exports {********************} ilete. - 53 - POS D.6 Interface module Ether1mports Ether10IO from Ether10IO; var StackPointer: Integer; DCBStack: array[1..NumDCBs] of pEtherDCB; RListHea0IO 05 Feb 82 Parameters: Cmd is the command that is to be executed. Header is a pointer to an Ethernet hed, RListTail, SListHead: pEtherDCB; SendsPosted, RecvsPosted: Integer; function PopDCB: pEtherDCB; procedure PushDCB(Ptader block. The client must fill in all fields of this header. Buff is a pointer to the buffer tr: pEtherDCB); procedure E10Srv; hat is to be sent or filled. Stat is a pointer to a status block for use during this com - 55 - POS D.6 Interface module EtherInterrupt 05 Feb 82 function PopDCB: pEtherDCmand. Bytes is the number of data bytes that are to be transfered. This value must be between 46 and 150B; Abstract: Get the next free DCB from the stack. Results: Return a pointer to the next free DCB. 0 Exceptions: E10NInited: Raised if this procedure is called before E10Init. E10NReset: Raised Side Effects: Move the stack pointer. procedure PushDCB(Ptr: pEtherDCB); Abstract: Push a free DCB onto the DC if this procedure is called before EReset. E10ByteCount: Raised if Bytes is not in the valid range. EB stack. Parameters: Ptr is a pointer to the DCB that is to be pushed onto the stack. Side Effect10BadCommand: This is raised if the command passed is not Send, Receive or PromisciousReceive. E10TooMs: Move the stack pointer. procedure E10Srv; Abstract: This is the 10 megabaud Ethernet interrupt routine.  the Ethernet interface. Parameters: NumSend will be set to the number of Sends that are pending. any: is raised if too many commands are executed at a given time. E10STooMany: is raised if more th termines if there is a full line in the keyboard input buffer. This is the case if a carriage-return has ue; { Gather System timing statistics. If this constant is changed, IO, Loader, Memory, Moveme been typed. This function is provided in order that a program may continue to do other things while m, System, and Shell should be re-compiled, and the System should bewaiting for keyboard input. If the file is not open to the console, FullLn is always true.  re-linked. } Type Sys9s = String[10]; Var UsrCmdLine: String[255]; {Command line entered by user} UseCmd: Bo Parameters: F - file to be checked. Returns: True if a full line has been typed. Errors: olean; {Set True to tell shell to execute UsrCmdLine} InCmdFile: Boolean; {True if shell commands from f NotOpen - if F is not open. NotReset - if F has not been reset. function StreamName( var F: FileType ): ile} LastFileName, {Name of file to use if none given} RFileName, {Name of next programPathName; Abstract: Returns the file name associated with the file variable F. For block-struct to run} ShellName: String; {Name of Shell} CurUserID, {Index of user in System.Users} ured files, the full path name including device and partition is returned. For character-structured  CurGroupID: 0..255; {Groupid of current user} CurUserName, {LogIn name of current user} CurPF files, the device name is returned. Parameters: F - file variable whose name is to be returned. ile: String; {Name of current profile file} UserMode: Boolean; {True while executing user program}  - 226 - POS D.6 Interface Prog CtrlCPending: Boolean; {True if one control-C typed} NextSSize: Integer; {Screen size for next program} Text ); Abstract: Clears the keyboard input buffer and the file variable F so that all input typed up to tram System 05 Feb 82 Program System; Perq Software Group. Copyright (C) Three Rivers Computer Corporation, 1980, 1981.his point will be ignored. Parameters: F - file to be cleared.  Abstract: Initialize POS and go into loop alternately running Shell and user program Version Number V2.2 { - 225 - POS D.6 Interface module Stream 05 Feb 82 procedure InitStream; Abst********************} Exports {********************} Const MainVersion = 'D'; DebugSystemInit = False; FirstDDSract: Initializes the stream package. Called by System. function FullLn( var F: Text ): Boolean; Abstract: De = 199; ShellConst = 'Shell.'; LogConst = 'LogIn.'; PFileConst = 'Default.Profile'; SysTiming = Tr  ce the microcode must know this, it is strongly suggested that it not be modified. The routine number of InitEloating point overflow } exception UndeReal; { floating point underflow } exception RealDiv0; { floating point division by zxceptions is not needed by the compiler or Perq.Micro, but it has been assigned routine number 1 so that its ero } exception Real2Int; { floating point real to integer overflow } var ExcSeg: Integer;  Exceptions: This procedure will raise E10ReceiveDone if a receive has completed. number will not change when new exceptions are defined. This means that new exceptions may be defined without  - 56 - POS D.6 Interface module Except 05 requiring that the operating system be re-linked. Version Number V2.9 exports const ExceptVersion = '2.9'; proced Feb 82 module Except; Except - Perq Pascal Exception Routines. J. P. Strait 10 Dec 80. Copyright (C) Three Riversure RaiseP( ES, ER, PStart, PEnd: Integer ); procedure InitExceptions; exception Abort( Message: String ); exception Dump(  Computer Corporation, 1980. Abstract: Module Except provides the following things: 1) Definitions of the microMessage: String ); exception XSegmentFault( S1,S2,S3,S4: Integer ); { segment fault } exception XStackOverflow; code generated exceptions. 2) A procedure to tell the microcode which segment number these exceptions are define { stack overflow } exception DivZero; { division by zero } exception MulOvfl; { overflow in multiplication } ed in. 3) The default handler of all exceptions. The compiler enables this handler in every main program. xception StrIndx; { string index out of range } - 57 - POS D.6 Interface  4) A Pascal routine to search the stack in when an exception is raised. Design: The file Except.Dfs is inclu module Except 05 Feb 82 exception StrLong; { string to be assigned is too long } exception InxCase; ded into Perq.Micro as well as into this module. It defines routine numbers for the exceptions generated  { array index or case expression out of range } exception STLATETooDeep; { parameter in STLATE instruction is too large } ex by the microcode. Note that there must be agreement between these constants and the routine numbers of the exceptception UndfQcd; { execution of an undefined Q-code } exception UndfInt; { undefined device interrupt detected } exceptionion definitions. No program checks these--if you add or remove exception definitions you must be sure to upd IOSFlt; { segment fault detected during I/O } exception MParity; { memory parity error } exception EStack; { E-stack ate Except.Dfs in the appropriate way. The routine number of RaiseP is also defined in Except.Dfs as 0. Sinwasn't empty at INCDDS } exception OvflLI; { Overflow in conversion to integer from Long Integer } exception OverReal; { f  ld display data bits} DefCursFunct: Integer; {What to set curs func to after each prog} DefScrComp: Boolean; number for UserPtr} DemoInt: Integer; {reserved for Demo system} isFloppy: Boolean; {true if bo {Default value for NextSComplemented} DefScrOff: Boolean; {Default value for NextSOff} ShellCtrl: pointeroted from floppy, else false} pointAllowed: Boolean; {true if should use pointing device} {*** WARNING!! IF YOU ; {Pointer to information record for Shell} TimeFID: integer; {File ID of file holding current time} CHANGE THE EXPORTED PROCEDURES AND EXCEPTIONS, MAKE {*** SURE THE NUMBERS FOR THE FOLLOWING EXCEPTIONS ARE UPDATED  CmdSegment: Integer; {SegmentNumber of seg holding command files} InPmd: Boolean; {True if in Scroung{*** AND RECOMPILE SCROUNGE IF CHANGED !!!!! *****} {*** WARNING!! DO NOT CHANGE THE ORDER OF THE ^C EXCEPTIONS !e (PostMortemDump)} SysDisk: Integer; {Number of the disk booted from} - 227!!!! *****} Procedure Command; Procedure SetDDS( Display: Integer ); Procedure SysVers( n: integer; var S: string ); Con - POS D.6 Interface Program System 05 Feb 82 SysBootChar: Integer; {Ord(charst ErrCtlC = 4; {******} Exception CtlC; Abstract: CtlC is raised by the KeyBoard interrupt routine w held down to boot)} StrVersion: string; {System version number as a string} SystemVersion: Integer; {Inhen a control-c is typed. If you handle this exception you should clear CtrlCPending in your teger giving system version number} SystemInitialized: Boolean; {True after system initialized} DDS: Integer; handler. If you are catching control-c's to try to prevent aborts, you should enable CtlC {Keeps current diagnostic display value} ShouldReEnableSwapping: Boolean; {True if swapping must be reenabled} Abort also, since the Stream package will raise it when the control-c is read. Const ErrCtlCAbort = 5; {**SavedSwapId: Integer; {Save id of where to swap to} {$ifc SysTiming then} LoadTime, OldLoadTime: long; Ex****} Exception CtlCAbort; - 228 - POS D.6 Interface ecuteTime, OldExecuteTime: long; SwapTime, OldSwapTime: long; MoveTime, OldMoveTime: long; IOTime, OldIOTime: lon Program System 05 Feb 82 Abstract: CtlCAbort is raised by the KeyBoard interrupt routine g; PrintStatistics: Boolean; {$endc} UserPtr: pointer; {A pointer variable for use between user  when the second of two adjacent control-c's is typed. It is also raised by the Stream package  NextSComplemented: Boolean; {Whether to complement bottom for next pgm} NextSOff: Boolean; {Whether bottom shou programs. (Use IncRefCount to keep segment)} UserInt: integer; {May be a segment ! Number(SomeException) RoutineNumber(SomeException) ParameterSize ============================== RaiseP searches the exception enable list of each routine in the dynamic chain. When it finds one that matches ER an The microcode calls RaiseP in the following way. ============================== Push parametersd ES it searches the dynamic chain again to see if the specified handler is already active. If it  onto the MStack if appropriate. ParameterSize := WordsOfParameters. Error := ErrorNumber, Goto(CallRais active, RaiseP continues searching the exception lists and dynamic chain where it left off. Thisise). ============================== Where CallRaise does the following. ================ is done in order to allow a handler to re-raise the same exception, and to prevent unlimited recursio============== SaveTP := TP. Push ExcSeg onto the MStack. - 59 - n in an exception handler that has a bug. If an exception handler is found, the original parameters a - 58 - POS D.6 Interface  POS D.6 Interface module Except 05 Feb 82 Push Error onto the MStack.  module Except 05 Feb 82 procedure InitExceptions; Abstract: InitExceptions tells the microcod Push SaveTP-ParameterSize+1 onto the MStack. Push SaveTP+1 onto the MStack. call RaiseP. e what segment number to use when raising its own exceptions. The segment number is the one that the sy ============================== Parameters: ER - Routine number of the exception to be raised. stem assigns to this module. Side affects: ExcSeg is set to the current segment number. The current se ES - Segment number of the exception to be raised. PStart- Pointer to the original parameters (as an gment is kept resident. procedure RaiseP( ES, ER, PStart, PEnd: Integer ); Abstract: RaiseP is called to raisoffset from the base of the stack). PEnd - Pointer to the first word after the original e an exception. The compiler generates a call to RaiseP in response to ==============================  parameters (as an offset from the base of the stack). Calls: Appropriate exception handler or HandleAll.  raise SomeException( original parameters ) ============================== in the following Design: See the "PERQ QCode Reference Manual, Q-Machine Architecture" for a description of the f way ============================== Push original parameters onto the MStack. RAISE Segmentormat of exception enable blocks and the format of variable routine descriptors. ! fer for that file, you should call the Stream routine StreamKeyBoardReset(F) (assuming F is th use Long instead} e name of the file). If F is a Text file which is attached to the console, this will get rid of the - 230 - POS D.6 Interface Program System 05 Feb 82 Procedure SetDDS( Display: Integer )when a control-c is read. If you handle this exception you should clear CtrlCPending in you character F^ points to and clear Stream's line editing buffer. Const ErrExitProgram = 7; {*****r handler. When this is raised by the KeyBoard interrupt routine, the KeyBoard type-ahead buf*} Exception ExitProgram; Abstract: ExitProgram is raised to abort (or exit) a program. fer is cleared. If you want to prevent this, you must catch CtlC also. If your program uses  The default handler for CtlCAbort and Scrounge raise this exception. WARNING: No onea Text file and you want to clear the line editing buffer for that file, you should call the S but System and Loader should Handle this exception. Anyone may raise it to exit a program. tream routine StreamKeyBoardReset(F) (assuming F is the name of the file). If F is a Text file which is  - 229 - POS D.6 Interface Program System 05 Feb 82 Const ErrH attached to the console, this will get rid of the character F^ points to and clear Stream's lineelpKey = 8; {******} Exception HelpKey(var retStr: Sys9s); Abstract: HelpKey is raised when the HELP  editing buffer. Const ErrCtlShftC = 6; {******} Exception CtlShftC; Abstract: key is hit. Parameters: retStr - the set of characters to put into the input streamCtlShftC is raised by the KeyBoard interrupt routine when a control- shift-c is typed. If you handle this . This should be set by the handler if it continues from the exception. Likely values are  exception you should clear CtrlCPending in your handler. When this is  "/Help" and chr(7) (the current value returned). The key board interupt routine sets retStr to raised by the KeyBoard interrupt routine, the KeyBoard type-ahead buffer is cleared. You cannot '' before raising this exception so if not set, and the handler resumes, nothing will be put i prevent this. If your program uses a Text file and you want to clear the line editing bufnto the input stream. Resume: Allowed. Should set retStr first. type DoubleWord = ^integer; {should" ************} exports {***************************} imports Arith from Arith; imports DiskIO from DiskIO; imports AllocDisk array index to use in DiskBuffer^.Addr). It is correctly set even if the indBlk is the FIBlk function  from AllocDisk; function CreateSpiceSegment(partition : integer; kind : SpiceSegKind) : SegID; procedure DestroySpiceSegmeCreateSpiceSegment(partition : integer; kind : SpiceSegKind) : SegID; Abstract: Create a new empty file on partitint(id : SegID); procedure TruncateSpiceSegment(id : SegID; len : integer); procedure ReadSpiceSegment(id : SegID; firstblk,numon specified Parameters: partition is the partition in which to allocate file; kind is the Returns: Iblks : integer; ptr : ptrDiskBuffer); procedure WriteSpiceSegment(id : SegID; firstblk,numblks : inD of file created Errors: Raises NotAFile if block at id does not seem to be a valid FIBlk Procedurteger; ptr : ptrDiskBuffer); procedure Index(logblk : integer; var indblk,indoff : integer); Exe DestroySpiceSegment(id : SegID); Abstract: Delete a file Parameters: id is the SegId of file to delete ception BadLength(len: integer); Abstract: Raised if try to truncate file to a length < 0 Parameters: len is bad SideEffects: removes id from filesystem Errors: Raises NotAFile if block at id does not seem to be a va length Exception NotAFile(id: SegID); Abstract: Raised when an operation is attempted and the SegID plid FIBlk Procedure TruncateSpiceSegment(id : SegID; len : integer); Abstract: Removes blocks from file to make theassed does not seem to be the id for a valid file Parameters: id is the bad id  new length len Parameters: id is the SegId of file; len is the new length (one greater than the last logicre pushed onto the MStack and the handler is called with CALLV. If no exception handler is found, Han - 61 - POS D.6 Interface module FileAccesdleAll is called. *** RaiseP may not contain any exception handlers. *** RaiseP must be guaranteed ts 05 Feb 82 Procedure Index(logblk : integer; var indblk,indoff : integer); Abstract: Find the index block and the oo be resident. - 60 - POS D.6 Interface ffset from the top of the block for a logical block of a file Parameters: logBlk - the logical block of the f module FileAccess 05 Feb 82 module FileAccess; Abstract: Module to handle reading, writing, entering and delile to look up; may be negative indBlk - the logical block number of the index block which eting files independant from the directory structure. Written by the CMU Spice Group Version Number V1.7 {****** holds the address for logblk indoff - the offsetin indBlk to use in reading the address (the " stemDefs - Common system definitions. John P. Strait 13 May 81. Copyright (C) Three Rivers Computer Corporation, 1981. AbpID: IDType; { The group ID of the user. } EncryptPass: PassType; { The encrypted password. stract: SystemDefs exports common system Const and Type definitions. The intent is that SystemDefs should not ex } Profile: String; { Path name of the profile file. } end; function FindUser(UserNameport Procedures or Vars since these require a Seg file. It is also intended that SystemDefs be reasonably: String; var UserRec: UserRecord): Boolean; function ValidUser( UserName, Password: String; var UserRec: UserRecord): Boole  short so that it doesn't take long to import. Version Number V1.2 exports const Ether3MBaud = False;  function AddUser(UserName, Password: String; Group: IDType; ProPath: String): Boolean; procedure NewUserFil { no support for 3 MBaud EtherNet } Ether10MBaud = True; { no support for 10 MBaud EtherNet } type Doube; procedure ListUsers; function RemoveUser(UserName: String): boolean; const PassFile = '>System.Users'; const MaxUsers; Abstract: SetDDS sets the diagnostic display to a particular value. Parameters: le = array[0..1] of Integer;  Display - Desired value of the diagnostic display. procedure SysVers( n: integer; var S: string ); Abstract: T - 232 - POS D.6 Interface module UserPass 05 Feb 82 module UserPass; Abstract:his procedure will provide the caller with a string that is the version number of the current system. Pa This module provides facilities for dealing with the password and accounts file for PERQ. The login and protectionrameters: n is the minor version number of the system. S will be set to the current minor version of the system.  facilities for Perq provide a very simple user validification. This system is NOT completly secure. Wri Procedure Command; Abstract: This procedure alternately loads Shell and the user programs whose rutten by: Don Scelza Copyright (C) Three Rivers Computer Corporation, 1981. Version Number V1.3 {*******************nfile names are generated by Shell. It is invoked by the main program in System and can be exited only i*} Exports {********************} type IDType = 0..255; PassType = ^Integer; { a two word value } f the user types ^C or if a runtime error occurs.  UserRecord = packed record InUse: boolean; { is this entry in use. } Name: String[31 - 231 - POS D.6 Interface Module SystemDefs 05 Feb 82 Module SystemDefs; Sy]; { Name of the user } UserID: IDType; { The user ID of the user. } Grou#  - 62 - POS D.6 Interface module FileAccess 05 Feb  Written by: Brad A. Myers 3-Mar-81 Copyright (C) 1981 Three Rivers Computer Corporation Version Number V1.2 EXPORT82 Procedure ReadSpiceSegment(id : SegID; firstblk,numblks : integer; ptr : ptrDiskBuffer); Abstract: Reads oneS Imports GetTimeStamp from GetTimeStamp; {Using TimeStamp} const DBLZERO = nil; {a two word 0} type  or more blocks from file Parameters: id - the SegId of file; firstBlk - the logical blk # of first to  FSBit8 = 0..255; FSBit16 = integer; FSBit32 = ^integer; {will be a long when compiler read numBlks - the number of blocks to read ptr - where the data should be put NOTE: If the blocks knows about 'em} Const DISKBUFSIZE = 256; {defined by hardware, 256 words per sec} type SegID = FSBit32; {I specified to read don't exist; ptr^ is filled with zeros Errors: Raises NotAFile n SpiceSeg, the virtual address of the -1 block of a file} DiskAddr = FSBit32; {Th if block at id does not seem to be a valid FIBlk Procedure WriteSpiceSegment(id : SegID; firstblk,numblks :e virtual address of a DiskBlock} SimpleName = string[25]; {only the filename in the directory} PathName  integer; ptr : ptrDiskBuffer); Abstract: Writes one or more blocks onto file Parameters: id - the  = string[100]; {full name of file with partition and dev} PartialPathName = string[80]; {file name including all directoSegId of file; firstBlk - the logical blk # of first to write numBlks - the number of blocks to write ries} FSOpenType = (FSNotOpen, FSOpenRead, FSOpenWrite, FSOpenExecute); FSDataEntry = packed record  ptr - where the data should come from SideEffects: Changes the data in the file and may cause new  FileBlocks : integer; {Size of file in blocks} FileBits : 0..4096; {Number of blocks to be allocated and file length changed Errors: Raises NotAFile if block at id does not seem to be a bits in last blk} FileSparse : Boolean; {true if can be sparse} FileOpenHo valid FIBlk - 63 - POS w : FSOpenType; {howOpen} FileCreateDate : TimeStamp; FileWriteDate : Tal block number since files start at 0) SideEffects: Shortens the file Errors: Raises BadLength is leD.6 Interface Module FileDefs 05 Feb 82 Module FileDefs; Abstract: Defines some ngth to truncate file to is < 0 Raises NotAFile if block at id does not seem to be a valid FIBlk constants and types needed by various people so FileSystem doesn't need to import DiskIO in its export section #  Results: This procedure will return true if the user UserName was in the user file. It will return False otherwise This procedure is used to create a new user file. Side Effects: This procedure will create a new file. It will . function ValidUser( UserName, Password: String; var UserRec: UserRecord): Boole Abstract: Th destroy any information in the current file. procedure ListUsers; Abstract: This procedure is used tois function is used to see if a user name and password match. Parameters: Username is the name of th supply a list of the valid users. function RemoveUser(UserName: String): boolean; Abstract: This pe user that we want to check. Password is the password for the user. UserRec will be frocedure is usd to remove a user from the list of valid users. Parameters: UserName is the name of the uilled with the user information if the user name and password match. Results: If the password is valid for ser that is to be removed. Results: If the user could be removed the return true. Otherwise the user then return true. Otherwise return false. Side Effects: This function will change the file PassFi return false. - 235 - POS D.6 Interface le. function AddUser(UserName, Password: String; Group: IDType; ProPath: String): Boolean; Abstract: Th Module UtilProgress 05 Feb 82 Module UtilProgress; Progress Reporting Routines Copyright (C) 1981 Three Rivers Compuis function is used to add a new user to the user file or change the parameters of an already existing user. ter Corporation Abstract: Routines to show progress of utilities. Exports Procedure LoadCurs; Procedure ShowProgre = 10; type Users = array[0..MaxUsers] of UserRecord; - 233 -  - 234 - POS D.6 Interface module UserPass 05 Fe POS D.6 Interface module UserPass 05 Feb 82 function FindUser(UserName: String; b 82 Parameters: Username is the name of the user that we want to add or change. Password is thvar UserRec: UserRecord): Boolean; Abstract: This function is used to see if a user exists in the e password for the user. Group is the group number for the new user. ProPath is the path name of the p user file. Parameters: UserName is the name of the user that we are looking for. UserRec isrofile file for this user. Results: If the user could be added or changed then return true. Otherwise retu a var parameter that is used to return the information about the user UserName if he is in the file. rn false. Side Effects: This function will change the file PassFile. procedure NewUserFile; Abstract:$ : Given a name, remove the device and partition specification and find the partition number ParametDY IN THE*** ***DIRECTORY BUT THIS IS ONLY SOMETIMES CAUGHT IF ATTEMPTED*** Calls: ParseFilenimeStamp; FileAccessDate : TimeStamp; FileType : integer; {see FileTypeers: name - the full file name to parse; the device and partition are optional. The device and partition if the.pas} FileRights : integer; {protection code} FileOwner : FSBit8; re are removed from the name string; partition - set to the partition specified or the default Ret{UserId of file owner} FileGroup : FSBit8; {GroupId} Filename : Purns: False if specified device or partition malformed or not there SideEffects: Mounts the partition if notartialPathName; end; ptrFSDataEntry = ^FSDataEntry; -  already Calls: FindPartition, MountPartition Function GetFileID(name : PathName) : SegID; Abstract: Find t64 - POS D.6 Interface Module FileDir 05 Feb 82 Module FileDir; Abstract: he SegID for name (does a lookUp) Parameters: name - the full name (including all directories and optional The directory structure for PERQ FileSystem Written by: CMU Spice Group Version Number V2.6 {*********************device and partition) of the file to look up Returns: The SegID of the file or DBLZERO if not there or ***}Exports{**********************************} imports FileDefs from FileDefs; function GetFileID(name : PathName) : Seg mal-formed Calls: ParseFilename, GetRootDirID, GetIDFromDir Function PutFileID(var name : PathName; id : SegID) :ID; function PutFileID(var name : PathName; id : SegID) : boolean; function DeleteFileID(name : PathName) : SegID; function boolean; Abstract: enters name with SegID id into a directory Parameters: name - the full name (including all  GetDisk(var name : PathName; var partition : integer) : boolean; var DefaultPartitionName : SimpleName; {includes devicedirectories and optional device and partition) of the file to enter; it is changed to remove all ">..> name and ends in a ">" } DefaultDeviceName : SimpleName; {ends in a colon} " and ">.>"s and remove the device (the name returned can be entered in the FileID block's FSDa - 65 - POS D.6 Interface Modta.Filename). id - SegID of file; Returns: True if file successfully entered; false if device, ule FileDir 05 Feb 82 Function GetDisk(var name : PathName; var partition : integer) : boolean; Abstract partition or a sub-directory is mal-formed NOTE: ***IT IS ILLEGAL TO CALL PutFileID FOR A NAME THAT IS ALREA$  - 236 - POS D.6 Interface Module UtilProgress 05 Feb 82 Procedn. NotReset if F is open but not Reset. Procedure ComputeProgress( Current, Max: Integer ); Abstracure LoadCurs; Abstract: Sets up the cursor before showing progress. Procedure LoadBusy; Abstract: Sets up tt: Indicate progress given a current and maximum value. Parameters: Current is the current value. Max is the maxihe cursor so that we can show that we are busy. In busy mode, each ShowProgress moves the cursor by mum value. Side Effects: CursPos is modified. Calls: IOSetCursorPos.  one in a random direction. This should be used when an operation is taking place and the utility cannot te - 238 - POS D.6 Interface ll how long until it is done. Procedure QuitProgress; Abstract: No more progress to report, turn off the module Virtual 05 Feb 82 module Virtual; Virtual - Perq virtual memory manager. J. P. Strait  cursor. Calls: IOCursorMode. Procedure ShowProgress(NumLines: Integer); Abstract: If started by LoadCurs1 Jan 80. Copyright (C) Three Rivers Computer Corporation, 1980. Abstract: Virtual is the Perq virtual memory manager. then Indicate progress by moving the cursor down a certain number of scan lines. If started by LoadBusy It supervises the segment tables and exports procedures for swapping memory segments. Virtual is the p then update busy cursor to show that doing something. Parameters: NumLines is the number of scaortion of the Perq memory manager which must remain memory resident at all times. Perq physical memory is n lines to move the cursor. Side Effects: CursPos is modified. BusyX is modified if <> -1. Envirsegmented into separately swappable items (called segments) which may contain either code or data. Design: Seonment: Assumes LoadCurs or LoadBusy has been called. Calls: IOSetCursorPos. Procedure StreamProgress( var F: File the Q-Code reference manual. Version Number V2.8 exports const VirtualVersion = '2.8'; imports Memory from Memore ); Abstract: Indicate progress reading a Stream file. Parameters: F is a Stream file which has been Reset. y; imports IO_Unit from IO_Unit; imports DiskIO from DiskIO; function ReturnSegment: SegmentNumber; procedure ReleaseSess(NumLines: Integer); Procedure QuitProgress; Procedure StreamProgress( var F: File ); Procedure ComputeProgress( Current, M Side Effects: CursPos is modified. - 237 - POS D.6 Interface ax: Integer ); Procedure LoadBusy;  Module UtilProgress 05 Feb 82 Calls: IOSetCursorPos. Errors: NotOpen if F is not ope% ileDefs; const FSVersion = '7.3'; { File system version number } BlksPerFile =#077777; { Max blocks in each D; - 68 - POS D.6 Interface module FileSystem 05 Feb file } FirstBlk =0; { Block number of the first data block } { in a file } LastB82 {uses current system search list} function FSLocalLookUp(FileName:PathName; Var BlkInFile,BitsInlk =#077776; { Block number of the last data block } { in a file. } FIBlk =-1; LBlk: Integer): FileID; {doesn't use any search lists} function FSSearch(var slist : SearchList; var FileNam { Block number of the File Information Block } BootLength = 60 + 128; { Size of the bootstrap area on disk--the } e : PathName; var BlkInFile, BitsInLBlk: integer) : FileID; {uses specified search lame, GetRootDirID, GetIDFromDir, PutIDInDir - 66 - POS D.6 Interface  { first n blocks on the disk. the microcode } { boot area is 60 blocks Module FileDir 05 Feb 82 Function DeleteFileID(name : PathName) : SegID; Abstract: Remove, the Pascal boot } { area is 128 blocks (32K). } StartBlk =BootLength;{ The block numbers the directory entry for name Parameters: name - the full name (including all directories and optional de of the FIBlk of the first} { user file. } SysFile = -1; { File ID of the system arvice and partition) of the file to remove from directory Returns: SegID of file removed from Directory or Dea on disk. } SEARCHSIZELIST = 5; { Max number of directories on search list. } type DirBlk= Record BLZERO if not there or part of name is mal-formed Calls: ParseFilename, GetRootDirID, GetIDFromDir  { Record for reading disk blocks } Case Integer Of 2: ( Buffer:Array[0..255]  - 67 - Of Integer ); 3: ( ByteBuffer: Packed Array [0..511] of FSBit8 )  POS D.6 Interface module FileSystem 05 Feb 82 module FileSystem; Abstract: S End; PDirBlk= ^DirBlk; FileID = integer; BlkNumbers = integer; SearchList = array[1..SEARpice Interim File System. Written by: Richard F. Rashid Date : February 24, 1981 Copyright (C) 1981 - CCHSIZELIST] of PathName; ptrSearchList = ^SearchList; var FSDirPrefix:PathName; {current default directory including darnegie-Mellon University Version Number V7.3 {********************} Exports {********************} imports FileDefs from Fevice and part} FSSysSearchList: SearchList; function FSLookUp(FileName:PathName;Var BlkInFile,BitsInLBlk: Integer): FileI%  number of the caller. Design: This routine depends on the Perq running a single process operating system  be destroyed. To facilitate segment table scanning loops that contain calls to DeleteSgmentNumber( Seg: SegmentNumber ); function NewSegmentNumber: SegmentNumber; procedure MakeEdge( var E: MMEdge; S: SegmentNumwhere the caller is in the same process as the memory manager. procedure ReleaseSegmentNumber( Seg: SegmentNumber ); procedure DeleteSegment( var S: SegmentNumber ); procedure SwapOut( var E: MMEdge ); procedure SwapIn( E: MMEdge; S: Sber ); Abstract: ReleaseSegmentNumber releases a segment number to the list of segment numbers which are egmentNumber; P: MMPosition ); procedure Compact; procedure KeepSegments; procedure FindHole( Fsize: MMIntSize; ForUserSegmennot in use. Parameters: Seg - Segment number to return to the segment number free list. t: Boolean ); procedure IncIOCount( S: SegmentNumber ); procedure DecIOCount( S: SegmentNumber ); procedure SwapSegmentsIn( S function NewSegmentNumber: SegmentNumber; Abstract: NewSegmentNumber allocates the next unused segment 1, S2, S3, S4: SegmentNumber ); var ScreenLast: Integer; Keep1, Keep2, Keep3, Keep4: SegmentNumber; Kludge: rec number. Errors: NoFreeSegments if there are no unused segment numbers. procedure MakeEdge( var E: MMEdord case Integer of 1: (A: DiskAddress); 2: (D: Double) end; BlockHeader: IOHeadPge; S: SegmentNumber ); Abstract: MakeEdge makes an MMEdge record which the head field set to a certain tr; BlockAddress: Double; BlockSId: SegId; Status: IOStatPtr; BootSerialNum: Double; segment number and the tail field set to the previous segment number (in physical address order). Parame - 239 - POS D.6 Interface module Virtual 05 Feb 82 BootSegId: SegId; ters: E - MMEdge record to build. S - Segment to put in the head field.  SwapSId: SegId;  - 241 - POS D.6 Interface module Virtual 05 Feb 82 Errors: EdgeFailu - 240 - POS D.6 Interface module Virtual 05 Feb 82 re if MakeEdge can't find the previous segment number. procedure DeleteSegment( var S: SegmentNumber );  function ReturnSegment: SegmentNumber; Abstract: ReturnSegment finds the segment number of the caller of  Abstract: DeleteSegment returns a segment to the free memory list. This is done (for example) when the procedure which called ReturnSegment by searching the call stack. Result: ReturnSegment = Segmentthe segment's reference and IO counts both reach zero. Parameters: S - Number of the segment to& me : PathName); function FileIDtoSegID(id : FileID) : SegID; function SegIDtoFileID(id : SegID) : FileID; procedure FSSetup - 70 - POS D.6 Interface System(bootchar: integer); procedure FixFilename(var filename : PathName; nulliserror : boolean); Function FSIsFSDev(name: Pat module FileSystem 05 Feb 82 Function SegIDtoFileID(id : SegID) : FileID; Abstract: Convert a two word SegIhName; var devName: String): integer; Exception FSNotFnd(name: PathName); Abstract: Raised if file looked up isd into a one word fileID Parameters: id is a two word segID Returns: A one word FileID; it may be pos or neg or  not found. If this exception is not handled by client, the lookup or search will return zero Function FileIDtoSegID(id : FileID) : SegID; Abstract: Convert a one word FileID into a two word SegID  zero Parameters: name is the name not found Exception FSBadName(name: PathName); Abstract: Raised  Parameters: id is a one word FileID Returns: a two word SegID Procedure FSInit; Abstract: Initializes the if file entered is illegal because: 1) the device or partition specified is not valid 2) a direFileSystem; call BEFORE FSSetUpSystem; Also initialize SegSystem and DirSystem SideEffects: Initializes; sctory name specified does not exist 3) the length of the simpleName is > 25 characters If this exception ets global Initialized to true; sets Prefix and Search list to null Procedure FixFilename(var filename : PathNamist instead of system one; is var so no copying; changes FileName to be full filename  is not handled by the client, the Enter will return zero Parameters: name is the name th actually used} function FSEnter(FileName:PathName): FileID; procedure FSClose(UserFile:FileID; Blks,Bits:Integer); at is illegal Function FSInternalLookUp(FileName:PathName; Var BlkInFile,BitsInLBlk:Integer): FileID; Exc procedure FSBlkRead(UserFile:FileID; Block:BlkNumbers; Buff:PDirBlk); procedure FSBlkWrite(UserFile:FileID; Block:BlkNumbers; eption FSDirClose; - 69 - POS D.6 Interface moduleBuff:PDirBlk); procedure FSInit; procedure FSMount(disk : integer); procedure FSDismount(disk : integer); procedure FSSetP FileSystem 05 Feb 82 Abstract: Raised if attempt to FSClose a directory file. This is usually refix(prefixname : PathName); {FSSetPrefix just assigns the vble; use FileUtil a bad idea since directories are spare files with an invalid length field. RESUME: Allowed. Wills.FSSetPath to do processing on new path} procedure FSGetPrefix(var prefixna close the file as if nothing had happened. const FSDebug = false; &  module Virtual 05 Feb 82 procedure SwapIn( E: MMEdge; S: SegmentNumber; P: MMPosition ); Abstract:  performed. - 243 - POS D.6 Interface SwapIn swaps a segment in from disk. Parameters: E - An edge describing where to put the segment in memor module Virtual 05 Feb 82 Parameters: Fsize - Minimum size of the hole. This is an internal y. The head is a free segment which will be filled by the segment to be swapped in. The ta size--Fsize=n means n+1 blocks. ForUserSegment - True iff this hole is to be used for a user il is the previous segment. S - The segment to swap in. P - The position (low end or high  segment. System segments may not be allocated in the screen area. procedure IncIOCount( S: SegmentNumegment: * If S was resident, it is changed to be the number of the segment which represents the free end) to use within the head segment of the edge. Errors: SwapInFailure if attempt to swap in a s memory. This may not be the same as the original value if the original segment is coalesced with an egment which was never swapped out. procedure Compact; Abstract: Compact compacts physical memory adjacent free segment. * If S was not resident, it is changed to be the number of the segmby moving as many segments as possible toward low addresses. System segments (those with a reference ent which preceded it in the segment table. * MMFirst is set to have the same value as S on ecount greater than one) will not be moved into the screen area, as segments cannot jump over one another.xit. procedure SwapOut( var E: MMEdge ); Abstract: SwapOut swaps a data segment out to disk. Paramete Errors: CantMoveSegment if attempt to move a segment with non-zero IO count. procedure Keeprs: E - An edge where the head is the segment to be swapped and the tail is the previous segment. Segments; Abstract: KeepSegments marks the segments Keep1 through Keep4 as not RecentlyUsed so that they w Result: E.T and E.H both are set to the number of the new free segment. Errors: Parton't be swapped out. procedure FindHole( Fsize: MMIntSize; ForUserSegment: Boolean ); Abstract: FindHole attempNotMounted if the swapping partition is not mounted. SwapError if attempt to swap segment out while swapping is ts to find a hole (free memory) of a certain size. It performs a first-fit search. If a hole cann disabled. - 242 - POS D.6 Interface ot be found, memory is compacted, and another first-fit search is performed. Eventually, a swap-out pass will be' faultPartition from AllocDisk to front (rest) - adds FSDirPrefix to front; if nmber of bits in the last block respectively. Returns: 0 if file doesn't exist; else the FileID of the file ullIsError-then no change to name if fileName = '' else changes '' to FSDirPrefix Errors: allows STR Errors: This procedure does not raise any errors SideEffects: Sets the FileAccessDate of the file Calls: Long to pass through from PERQ_String; This means that fileName is invalid Procedure FSMount(disk: integer);FixFileName, GetFileID, GetTStamp, SegIDToFileID Function FSLocalLookUp(FileName:PathName;Var  Abstract: Mounts the disk specified and prints all partitions Parameters: Disk is device to mount (0=HardDisk,  BlkInFile,BitsInLBlk:Integer): FileID; Abstract: Does a lookup of FileName in the current path only. 1=Floppy) Calls: DeviceMount and DisplayPartitions - 71 - POS D.6 Int - 72 - POS D.6 Interface module FileSystem 05 Feb 82 erface module FileSystem 05 Feb 82 Procedure FSDismount(disk: integer); Abstract: DisParameters: FileName is a filename. BlkInFile and BitsInLBlk are set with the number of blocks in the file and the mounts the disk specified and prints all partitions Parameters: Disk is device to dismount (0=HardDisk, 1=Floppy) number of bits in the last block respectively. Returns: 0 if file doesn't exist; else the FileID of the file  Calls: DeviceDismount and DisplayPartitions Procedure FSSetPrefix(prefixname : PathName); Abstract: Sets the defa SideEffects: Sets the FileAccessDate of the file Errors: Raises FSNotFnd if file not there (if not caught, thult pathName Parameters: prefixname is new name; no checking is done SideEffects: changes FSDirPrefix Procen lookup returns 0) Calls: InternalLookUp Function FSSearch(var slist : SearchList; var filename : Pathedure FSGetPrefix(var prefixname : PathName); Abstract: Returns the default pathName Parameters: prefixname isName; var blkinfile,bitsinlblk: integer) : FileID; Abstract: Does a lookup of FileName straight first and then wie; nulliserror : boolean); Abstract: Makes fileName a full path name by adding as many defaults as nece current name; it is set with current value Function FSInternalLookUp(FileName:PathName;ssary Parameters: filename is name to fix; it is modified to have the full path name as follows: Var BlkInFile,BitsInLBlk:Integer): FileID; Abstract: Does a lookup of FileName in the current path only. P (dev):(rest) - no change :(rest) - adds DefaultDevice from AllocDisk to front >(rest) - adds Dearameters: FileName is a filename. BlkInFile and BitsInLBlk are set with the number of blocks in the file and the nu' he screen or is non-resident. Parameters: S - Number of the segment. Errors: UnusedSegment if S  ChArray; Max, Field: integer ); procedure WriteIdentifier( var F: FileType; X: integer; var IT: Iis not in use. procedure SwapSegmentsIn( S1, S2, S3, S4: SegmentNumber ); Abstract: SwapSegmentsIn ensures thatdentTable; L, Field: integer ); procedure WriteInteger( var F: FileType; X: integer; Field: integer ); procedure WriteString(  when it returns, S1, S2, S3, and S4 are resident. Parameters: S1, S2, S3, S4 - segments to swap in. var F: FileType; var X: String; Field: integer ); procedure WriteX( var F: FileType; X, Field, B: integer );  - 244 - POS D.6 Interface module Virtual 05 Feb  - 246 - POS D.6 Interface 82 Errors: NilPointer if one of the segments is zero. UnusedSegment if one of the segments is module Writer 05 Feb 82 procedure WriteBoolean( var F: FileType; X: Boolean; Field: integer ); Abstract: not really in use. FullMemory if there isn't enough memory to swap one of the segments in.  Writes a boolean in fixed format. Parameters: X - the boolean to be written. F - the file into  which X is to be written. Field - the size of the field into which X is to be written. procedure WriteCh( var ber ); Abstract: IncIOCount increments the count of input/output references to a data segment. A n - 245 - POS D.6 Interface module Writer 05 Feb 82 module Writer; Writer - Streamon-zero IO count prevents a segment from being moved, swapped, or destroyed. Parameters: S - Se package output conversion routines. J. P. Strait ca. 1 Jan 81. Copyright (C) Three Rivers Computer Corporation, 1981. gment number. Errors: UnusedSegment if S is not in use. FullMemory if S is not resident and there isn' Abstract: Writer is the character output module of the Stream package. It is called by code generated by the Pasct enough memory to swap it in. procedure DecIOCount( S: SegmentNumber ); Abstract: DecIOCount decrements the IOal compiler in response to a Write or Writeln. It is one level above Module Stream and uses Stream's output routine count of a data segment by one. If the reference and IO counts both become zero: * if the segment is a s. Version Number V2.2 exports imports Stream from Stream; procedure WriteBoolean( var F: FileType; X: Boolean; Fidata segment, it is destroyed. * if the segment is a code segment, it is destroyed only if it is in teld: integer ); procedure WriteCh( Var F: FileType; X: char; Field: integer ); procedure WriteChArray( var F: FileType; var X:( th each of the names in slist on the front. Parameters: slist - a searchList; any non-'' entries are assumedlse the FileID of the file SideEffects: Sets the FileAccessDate of the file Errors: Raises FSNotFnd i to be paths and are put on the front of the filename. The first one to be tried is slist[1]. The fif file not there (if not caught, then lookup returns 0) Calls: FSSearch with FSSysSearchList as the sList rst match is the one used; No checking is done on the validity of the entries in slist filena Function FSEnter(FileName:PathName): FileID; Abstract: Enters the file in the current path. Parameters: fime - the file to be looked up; it is changed to be the full name of the file if found. If fileName is lename is the file to be entered. It may or may not exist; if not exists then is created; Returns: 0 if fi empty then file not found. BlkInFile and BitsInLBlk - set with the number of le can't be created because part of its name is invalid (e.g. the device, partition or directory specified  blocks in the file and the number of bits in the last block respectively. Returns: 0 if file does doesn't exist) else the FileID of the file SideEffects: Creates a file if necessary and enters it into the n't exist in any path; else the FileID of the file SideEffects: Sets the FileAccessDate of the file E directory; if creating, then sets size to zero and create date; Sets type to 0 (UnknownFile); whether rrors: Raises FSNotFnd if file not there (if not caught, then lookup returns 0) Calls: FSLocalLookUp, Conc or not creating; sets WriteDate and AccessDate Errors: Raises FSBadName if name passed is illegal duat Function FSLookUp(FileName: PathName; Var BlkInFile, BitsInLBlk: Integer) : FileID; Abstract: Does ae to a device, partition, or directory name in path not existing or target name is longer than 25 charact lookup of fileName first in the current path and then in each of the entries of the system search list. Paraers or illegal in some other way. If this exception is not caught, Enter returns zero. Procedure Fmeters: filename is the file to be looked up; BlkInFile and BitsInLBlk are set with the number of blocks in the filSClose(UserFile:FileID; Blks,Bits:Integer); Abstract: Closes a file (setting size). Parameters: UserFile is ID e and the number of bits in the last block respectively. - 73 - POS D.of file to close; Blks is the size of the file in blks and bits is the number of bits in the last block; 6 Interface module FileSystem 05 Feb 82 Returns: 0 if file doesn't exist in any path; e SideEffects: Truncates file to size specified; does a FlushAll Errors: Raises FSDirClose if attempt to close a( ; Abstract: Writes a packed character array in fixed format. Parameters: X - the character array  F - the file into which X is written. Field - the size of the field into which X is written. procedureto be written. F - the file into which X is to be written. Field - the size of the field into whic WriteX( var F: FileType; X, Field, B: integer ); Abstract: Writes an integer in fixed format with base B. Ph X is to be written. Max - the declared length of X. procedure WriteIdentifier( var F: Fiarameters: X - the integer to be written. F - the file into which X is to be written. Field - leType; X: integer; var IT: IdentTable; L, Field: integer ); Abstract: Writes an identifier fro the size of the field into which X is to be written. B - the base of X. It is an integer whm a table in fixed format. Parameters: X - the ordinal of the identifier in the range 0 to L. ose absolute value must be between 2 and 36, inclusive. - 248F - the file to which X is written. IT - the table of identifier names indexed from 0 to L.  - POS D.6 Interface module Writer 05 Feb 82 Errors: BadBase if the base is not i - 247 - POS D.6 Interface module Writer 05 Feb 82 L - the largesn 2..36. t identifier ordinal defined by the table. Field - the size of the field into which X is written. Errors: - 249 - POS D.6 Interface Index of Exported Routines 05 Feb 82 BadIdTable if the length of the identifier table is less than 1. procedure WriteInteger( var F: FileType; X: 39 AddrToField [ module DiskIO ] 234 AddUser [ module UserPass ] 157 Adjust [ Module PERQ_String ] 8 AllocDisk  integer; Field: integer ); Abstract: Writes a decimal integer in fixed format. Parameters: X - t [ module AllocDisk ] 169 AllocNameDesc [ Module PopUp ] 160 AppendChar [ Module PERQ_String ] 159 AppendString [ ModulF: FileType; X: char; Field: integer ); Abstract: Writes a character in a fixed format. Parameters: he integer to be written. F - the file into which X is to be written. Field - the size of the field  X - the character to be written. F - the file into which X is to be written. Field - the size of the fi into which X is to be written. procedure WriteString( var F: FileType; var X: String; Field: integer eld into which X is to be written. procedure WriteChArray( var F: FileType; var X: ChArray; Max, Field: integer ) ); Abstract: Writes a string in fixed format. Parameters: X - the string to be written. ) vice from which booted; Mounts all of its partitions Sets AllocDisk's DefaultDeviceName and Def= 8; {cursor bin files} BinaryFile = 9; BinFile = 10; {microcode output} MicroFile = 11; ComFiaultPartitionName. Sets FSDirPrefix to be root of current Partition and adds that path to the bottom of thle = 12; RelFile = 13; IncludeFile = 14; {included in a pas file} SBootFile = 15; {system part of boot filee search list Function FSIsFSDev(name: PathName; var devName: String): integer; Abstract: determine wh} MBootFile = 16; {microcode part} SwapFile = 17; {a file used for swapping by compiler or editor; length  directory file. If resume from this exception, then closes normally. ether name is a file that the filesystem knows how to handle Parameters: name is a name of a file; devName  - 74 - POS D.6 Interface module FileSystem 05 Feb 82 Procedure FSBlkWrite(Usewill be assigned the device name IF NOT FSDevice DevName will be in upper case and does NOT contain rFile:FileID; Block:BlkNumbers; Buff:PDirBlk); Abstract: Writes one block onto a file. Parameters: UserFile is Ithe colon. Returns: 0 if name doesn't contain a : or if dev is one the filesystem knows about; the indeD of file to write on Block is number of block to write (starting at zero); Buff is buffer holding datax of the colon otherwise - 75 - POS D.6 Interface  to write onto the file at Block SideEffects: Changes the data of block Block Calls: WriteSpiceSegment Proc Module FileTypes 05 Feb 82 Module FileTypes; Abstract: This module exports the Types put in the FileTypedure FSBlkRead(UserFile:FileID; Block:BlkNumbers; Buff:PDirBlk); Abstract: Reads one block of a file. If block specie field of File FIBs. The types are stored as integers. Three Rivers reserves the first 512 types for their usfied is not part of the file then simply zeros the buffer Parameters: UserFile is ID of file to read from Bloe. Customers are encouraged to choose numbers > 512 if they invent new file types Written by Brad A. Myers Feck is number of block to read (starting at zero); Buff is buffer to copy data into Calls: ReadSb. 2, 1981 Copyright (C) 1980 Three Rivers Computer Corporation Version Number V1.2 {\\\\\\\\\\\\\\\\\\\\\\\\\\} EXPOpiceSegment Procedure FSSetupSystem(bootchar: integer); Abstract: Call this after FSInit to set up the system and pRTS {/////////////////////////} Const UnknownFile = 0; SegFile = 1; PasFile = 2; DirFile = 3; rint a lot of messages Parameters: boot char is ord of key held down to boot SideEffects: Mounts de ExDirFile = 4; FontFile = 5; RunFile = 6; TextFile = 7; {for non-Pas text files} CursorFile ) e PERQ_String ] 197 ArcCos [ module RealFunctions ] 197 ArcSin [ module RealFunctions ] 198 ArcTan [ module RealFunctio AllocDisk ] 6 DeviceMount [ module AllocDisk ] 143 DisableSwapping [ module Memory ] 114 DiskIntr [ Module IO_Privatns ] 198 ArcTan2 [ module RealFunctions ] 183 BufferPointer [ Module ReadDisk ] 181 ChangeDisk [ Module ReadDisk ] 181e ] 40 DiskIO [ module DiskIO ] 40 DiskReset [ module DiskIO ] - 250 - POS D. ChangeHeader [ Module ReadDisk ] 139 ChangeSize [ module Memory ] 210 ChangeTitle [ Module Screen ] 211 ChangeWindow 6 Interface Index of Exported Routines 05 Feb 82 8 DismountPartition [ module AllocDisk ] [ Module Screen ] 183 ChgHdr [ Module ReadDisk ] 142 CleanUpMemory [ module Memory ] 25 CnvUpper [ Module CmdParse ]  6 DisplayPartitions [ module AllocDisk ] 42 DisposeP [ module Dynamic ] 18 DoCmdFile [ Module CmdParse ] 11 Dou 138 CodeOrDataSeg [ module Memory ] 231 Command [ Program System ] 243 Compact [ module Virtual ] 238 ComputeProgressbleAbs [ module Arith ] 11 DoubleAdd [ module Arith ] 12 DoubleBetween [ module Arith ] 12 DoubleDiv [ module Arith [ Module UtilProgress ] 157 Concat [ Module PERQ_String ] 160 ConvUpper [ Module PERQ_String ] 146 CopySegment [ modu ] 12 DoubleInt [ module Arith ] 12 DoubleMod [ module Arith ] 11 DoubleMul [ module Arith ] 11 DoubleNeg [ module MoveMem ] 196 Cos [ module RealFunctions ] 197 CoTan [ module RealFunctions ] 139 CreateSegment [ module Memory ] 6le Arith ] 11 DoubleSub [ module Arith ] 23 DstryArgRec [ Module CmdParse ] 19 DstryCmdFiles [ Module CmdParse ] 232 CreateSpiceSegment [ module FileAccess ] 210 CreateWindow [ Module Screen ] 144 CurrentSegment [ module Memory ] 138 DstrySwitchRec [ Module CmdParse ] 52 E10DataBytes [ module Ether10IO ] 53 E10GetAdr [ module Ether10IO ] 51 E10I DataSeg [ module Memory ] 13 DblEql [ module Arith ] 13 DblGeq [ module Arith ] 13 DblGtr [ module Arith ] 13 nit [ module Ether10IO ] 51 E10IO [ module Ether10IO ] 52 E10Reset [ module Ether10IO ] 56 E10Srv [ module EtherIntDblLeq [ module Arith ] 13 DblLes [ module Arith ] 13 DblNeq [ module Arith ] 9 DeallocChain [ module AllocDisk ] errupt ] 53 E10State [ module Ether10IO ] 52 E10Wait [ module Ether10IO ] 53 E10WIO [ module Ether10IO ] 115 E3Rec 9 DeallocDisk [ module AllocDisk ] 244 DecIOCount [ module Virtual ] 141 DecRefCount [ module Memory ] 158 Delete Start [ Module IO_Private ] 115 E3Reset [ Module IO_Private ] 143 EnableSwapping [ module Memory ] 115 Ether3Intr [ Mo[ Module PERQ_String ] 67 DeleteFileID [ Module FileDir ] 242 DeleteSegment [ module Virtual ] 169 DestroyNameDesc [ Mdule IO_Private ] 126 Ether3Receive [ Module IO_Unit ] 125 Ether3Start [ Module IO_Unit ] 126 Ether3Transmit [ Module Iodule PopUp ] 169 DestroyRes [ Module PopUp ] 62 DestroySpiceSegment [ module FileAccess ] 6 DeviceDismount [ moduleO_Unit ] 19 ExitAllCmdFiles [ Module CmdParse ] 19 ExitCmdFile [ Module CmdParse ] 195 Exp [ module RealFunctions ] * : boolean; Procedure FSRename(SrcName, DestName: PathName); Function FSMakeDirectory(var DirName: PathName): FileID; ProcedurList Parameters: '' if Pop; name of item trying to push if Push Resume: ALLOWED; if resume then does the operatie FSSetSearchList(sList: SearchList); Procedure FSPopSearchItem(var sList: SearchList); Procedure FSPushSearchItem(name: PathNon anyway Exception SrchErr(fileName: PathName); Abstract: Raised if try to Pop empty list or push onto full list ame; var sList: SearchList); Procedure FSAddToTitleLine(msg: String); {adds as much of msg as possible to  for the Search List Parameters: '' if Pop; name of item trying to push if Push Resume:  title line after the current path} Exception DelError(FileName: PathName); Abstract: Raised when NOT allowed Function FSExtSearch(var SList : SearchList; Extensions: String; var FileName : PathName; can't delete file (because not there) Parameters: FileName is file that can't delete Exception RenError(msg: String;  var BlksInFile, BitsInLBlkInLBlk: Integer) : FileID; Exception RenToExist(fileName: PathName); AFileName: PathName); Abstract: Raised when can't rename file Parameters: msg is reason can't rename and fileNambstract: Raised when try to rename to a file that already exists. Not raised if renaming a fi not set} BadFile = 18; {created by the scavenger} e is file with the problem. To print message, use "WriteLn('** ',msg,filename);" Exception - 76 - POS D.6 Interface module FileUtils 05 Feb 82 module FileUt MkDirErr(msg: String; dirName: PathName); Abstract: Raised when can't make a directory because 1) a filils; Filesystem utilities not needed by the system Written by Brad Myers. March 5, 1981. Version Number e named dirName already exists 2) dirName cannot be entered (bad subdir part) 3) dirName is empty V1.10 {********************} Exports {********************} imports FileSystem from FileSystem; type ptrScanRecord = ^ 4) dirName is ROOT.DR (reserved directory name) - 77 - POS D.6 Interface ScanRecord; ScanRecord = record InitialCall : boolean; Blk : DiskAddr;  module FileUtils 05 Feb 82 Parameters: msg explains problem with makedir attempt;  Entry : Integer; DirName : PathName; end; Procedure FSD dirName is name attempted to use. Use "WriteLn('** ',msg,dirName);" Exception SrchWarn(fileNameelete(filename: PathName); Function FSScan(scanptr : ptrScanRecord; var name : SimpleName; var id : FileID) : PathName); Abstract: Raised if try to Pop last item or push into last hole of the Search * stem ] 82 FSPopSearchItem [ module FileUtils ] 82 FSPushSearchItem [ module FileUtils ] 84 FSRemoveDots [ module Fil IOBusy [ Module IO_Unit ] 123 IOCRead [ Module IO_Unit ] 102 IOCursorMode [ Module IO_Others ] 123 IOCWrite [ Module eUtils ] 80 FSRename [ module FileUtils ] 81 FSScan [ module FileUtils ] 73 FSSearch [ module FileSystem ] 83 FSSIO_Unit ] - 252 - POS D.6 Interface Index of Exported etFSData [ module FileUtils ] 72 FSSetPrefix [ module FileSystem ] 81 FSSetSearchList [ module FileUtils ] 75 FSSetuRoutines 05 Feb 82 96 IOErrString [ Module IOErrMessages ] 124 IOGetStatus [ Module IO_Unit ] 104 IOGetTime [ Modul39 FieldToAddr [ module DiskIO ] 71 FileIDtoSegID [ module FileSystem ] 143 FindCodeSegment [ module Memory ] 182 FipSystem [ module FileSystem ] 226 FullLn [ module Stream ] 224 GetB [ module Stream ] 224 GetC [ module Stream ] 66 ndDiskBuffer [ Module ReadDisk ] 243 FindHole [ module Virtual ] 7 FindPartition [ module AllocDisk ] 234 FindUser [ GetDisk [ Module FileDir ] 66 GetFileID [ Module FileDir ] 212 GetFont [ Module Screen ] 116 GetIntr [ Module IO_Pri module UserPass ] 71 FixFilename [ module FileSystem ] 114 FloppyIntr [ Module IO_Private ] 183 FlushAll [ Module Reavate ] 166 GetShellCmdLine [ Module PopCmdParse ] 26 GetSymbol [ Module CmdParse ] 86 GetTStamp [ module GetTimeStampdDisk ] 183 FlushBuffer [ Module ReadDisk ] 182 FlushDisk [ Module ReadDisk ] 82 FSAddToTitleLine [ module FileUtils ] ] 15 GetTString [ module Clock ] 211 GetWindowParms [ Module Screen ] 92 GiveHelp [ Module Helper ] 114 GPIBInIntr 75 FSBlkRead [ module FileSystem ] 75 FSBlkWrite [ module FileSystem ] 74 FSClose [ module FileSystem ] 80 FSDel [ Module IO_Private ] 114 GPIBOutIntr [ Module IO_Private ] 90 gpInit [ module gpib ] 183 HeaderPointer [ Module Reaete [ module FileUtils ] 72 FSDismount [ module FileSystem ] 74 FSEnter [ module FileSystem ] 83 FSExtSearch [ modudDisk ] 244 IncIOCount [ module Virtual ] 140 IncRefCount [ module Memory ] 62 Index [ module FileAccess ] 6 InitAle FileUtils ] 82 FSGetFSData [ module FileUtils ] - 251 - POS D.6 Interface lloc [ module AllocDisk ] 182 InitBuffers [ Module ReadDisk ] 18 InitCmdFile [ Module CmdParse ] 38 InitDiskIO [ mod Index of Exported Routines 05 Feb 82 72 FSGetPrefix [ module FileSystem ] 71 FSInit [ moduule DiskIO ] 59 InitExceptions [ module Except ] 99 InitIO [ Module IO_Init ] 138 InitMemory [ module Memory ] 169 le FileSystem ] 72 FSInternalLookUp: [ module FileSystem ] 75 FSIsFSDev [ module FileSystem ] 72 FSLocalLookUp: [ moduInitPopUp [ Module PopUp ] 178 InitRandom [ module RandomNumbers ] 226 InitStream [ module Stream ] 159 Insert [ Modulle FileSystem ] 73 FSLookUp) [ module FileSystem ] 81 FSMakeDirectory [ module FileUtils ] 71 FSMount [ module FileSye PERQ_String ] 12 IntDouble [ module Arith ] 176 IntegerSort [ module QuickSort ] 126 IOBeep [ Module IO_Unit ] 124 + ; just continue and FSRename will do the operation. RenToExist etc. may still be  done because: 1) - destName already exists 2) - SrcName and destName are in different partitioraised. Procedure FSGetFSData(id: FileID; pData: ptrFSDataEntry); Procedure FSSetFSData(id: FileID; pData: ptrFSDataEntry); ns 3) - SrcName doesn't exist 4) - SrcName or DestName is malformed SideEffects: The name of t Procedure FSRemoveDots(var fname: PathName); - 78 - POS D.6 Interface he file corresponding to SrcName is changed Calls: DeleteFileID; DestroySpiceSegment Errors: Raises R module FileUtils 05 Feb 82 enError(msg, fileName) - if can't rename file where message explains why (do "Write(' ** ',msg,fileName)"  - 79 - POS D.6 Interface  in handler) Raises RenToExist(DestName) - if filename already exists; If you wish to rename anyway; just module FileUtils 05 Feb 82 Procedure FSDelete(filename : PathName); Abstract: Deletes filename from directory a continue and FSRename will delete the DestName; In this case; you should be prepared to accept DelErrnd from filesystem; fileName is deleted from the current path only (not search lists) if it doesn't coor; - 80 - POS D.6 Interface modntain device or partition info Parameters: filename is the name of the file to be deleted SideEffects: filename ule FileUtils 05 Feb 82 Function FSScan(scanptr : ptrScanRecord; var name: SimpleName; var id : FileID): boolean; is deleted from the current directory if it exists; if not then nothing is done (and the user is not n Abstract: At each call returns the next entry in a directory. The names returned are in random order. le to its own name (no-op). Parameters: fileName - new name that already exists Resume: ALLOWED; If you wish to otified) Calls: DeleteFileID; DestroySpiceSegment Errors: Raises DelError(fileName) if can't delete file Prrename anyway; just continue and FSRename will delete the DestName; In this case; you should be ocedure FSRename(SrcName, DestName: PathName); Abstract: Changes the name of SrcName to DestName; both are in  prepared to accept DelError; Exception RenDir(fileName: PathName); Abstract: Raised when try to rename  the current path (not search lists) if not fully specified Parameters: SrcName is the name of the file to cha directory. Parameters: fileName - name of the source directory. Resume: ALLOWED; If you wish to rename anywayange and DestName is the name it should be given Returns: True if rename is successful; false if can't be +  UtilProgress ] 32 LoadControlStore [ module ControlStore ] 237 LoadCurs [ Module UtilProgress ] 32 LoadMicroInstructie IO_Private ] 225 PWriteln [ module Stream ] 237 QuitProgress [ Module UtilProgress ] 59 RaiseP [ module Except ] 18on [ module ControlStore ] 194 Log10 [ module RealFunctions ] 39 LogAddrToPhysAddr [ module DiskIO ] 241 MakeEdge [ m1 ReadAhead [ Module ReadDisk ] 185 ReadBoolean [ module Reader ] 185 ReadCh [ module Reader ] 185 ReadChArray [ moduodule Virtual ] 142 MarkMemory [ module Memory ] 170 Menu [ Module PopUp ] 7 MountPartition [ module AllocDisk ] 148le Reader ] 150 ReadD [ module PasLong ] 181 ReadDisk [ Module ReadDisk ] 181 ReadHeader [ Module ReadDisk ] 186 Read MultiRead [ Module MultiRead ] 2 NewBuffer [ module AlignMemory ] 209 NewLine [ Module Screen ] 42 NewP [ module Identifier [ module Reader ] 186 ReadInteger [ module Reader ] 153 ReadR [ module PasReal ] 202 ReadRunFile [ module RDynamic ] 241 NewSegmentNumber [ module Virtual ] 235 NewUserFile [ module UserPass ] 19 NextID [ Module CmdParse ] 2unRead ] 202 ReadSegNames [ module RunRead ] 63 ReadSpiceSegment [ module FileAccess ] 187 ReadString [ module Reader 0 NextIDString [ Module CmdParse ] 21 NextString [ Module CmdParse ] 166 NullIdleProc [ Module PopCmdParse ] 38 Num] 187 ReadX [ module Reader ] 211 RefreshWindow [ Module Screen ] 182 ReleaseBuffer [ Module ReadDisk ] 241 ReleaseSee IO_Others ] 105 IOKeyClear [ Module IO_Others ] 105 IOKeyDisable [ Module IO_Others ] 105 IOKeyEnable [ Module IO_OthberPages [ module DiskIO ] 22 ParseCmdArgs [ Module CmdParse ] 22 ParseStringArgs [ Module CmdParse ] 163 PattDebug ers ] 102 IOLoadCursor [ Module IO_Others ] 124 IOPutStatus [ Module IO_Unit ] 103 IOReadCursPicture [ Module IO_Others[ module PMatch ] 163 PattMap [ module PMatch ] 163 PattMatch [ module PMatch ] 173 PFileEntry [ module Profile ] 173  ] 104 IOReadTablet [ Module IO_Others ] 104 IOScreenSize [ Module IO_Others ] 103 IOSetCursorPos [ Module IO_Others ]  PFileInit [ module Profile ] 39 PhysAddrToLogAddr [ module DiskIO ] 56 PopDCB [ module EtherInterrupt ] 166 PopUniqu 103 IOSetFunction [ Module IO_Others ] 102 IOSetModeTablet [ Module IO_Others ] 103 IOSetTabPos [ Module IO_Others ] 1eCmdIndex [ Module PopCmdParse ] - 253 - POS D.6 Interface 23 IOWait [ Module IO_Unit ] 163 IsPattern [ module PMatch ] 32 JumpControlStore [ module ControlStore ] 243 KeepSegm Index of Exported Routines 05 Feb 82 161 Pos [ Module PERQ_String ] 160 PosC [ Module PERQ_String ] 195 Power ents [ module Virtual ] 115 KeyIntr [ Module IO_Private ] 38 LastDiskAddr [ module DiskIO ] 212 Line [ Module Screen [ module RealFunctions ] 195 PowerI [ module RealFunctions ] 225 PReadln [ module Stream ] 56 PushDCB [ module EtherIn] 235 ListUsers [ module UserPass ] 194 Ln [ module RealFunctions ] 129 Load [ module Loader ] 237 LoadBusy [ Moduleterrupt ] 224 PutB [ module Stream ] 225 PutC [ module Stream ] 66 PutFileID [ Module FileDir ] 116 PutIntr [ Modul, l should be set to true and scanPtr^.dirName should be set to the directory to scan through. No fit is new search list. It is a bad idea to not include a partition which contains a full set of system elds should be modified by the caller after the initial setting. The dirName field of the scanPtr recor files SideEffects: Changes system search list - 81 - POS D.6 Intd is modified to contain the Full path name of the directory. name is set to the name of the file found oerface module FileUtils 05 Feb 82 Procedure FSPopSearchItem(var sList: SearchList); An this call and id is its fileID; scanPtr is modified after each call so the next call will return the next nbstract: Removes the most recent item from the search list Parameters: sList is search list to pop from (it is modified)ame in the directory Returns: True if a valid name and id returned; false if the directory  Errors: Raises SrchWarn('') if try to pop last item; if continue from it then pops it anyway; Raises Shas been exhausted in which case name and id are NOT valid Function FSMakeDirectory(var dirName: PathName): FilrchErr('') if list empty and try to pop; don't continue from this one Procedure FSPushSearchItem(name: PathName;eID; Abstract: Create a new directory named dirName. Parameters: DirName is the name of the directory to create var sList: SearchList); Abstract: adds name to the front of the search list Parameters: name is new name to add; the name is changed to be the full path name of the directory created Returns: The fileID of to the front of the search list searchList is modified to have name at front Errors: Raises SrchWarn(na the directory SideEffects: Creates a file named dirName (appending a ".DR" to end if not there. Sets thme) if try to push into last item; if continue from it then pushes it anyway; Raises SrchErr(name) if liste FileType field to DirFile; and sets the FileBits to 4096 Errors: Raises MkDirErr(msg, dirName) if 1) a file full and try to push; don't continue from this one Environment: Assumes oldest item in list is at high position  named dirName already exists 2) dirName cannot be entered (bad subdir part) 3) dirName is empty 4)  (e.g. 5) Procedure FSAddToTitleLine(msg: String); Abstract: adds as much of msg as possible to title linedirName is ROOT.DR (reserved directory name) where msg describes error. Do not continue from this sig after the current path which is truncated to 35 characters Parameters: msg is string to be displayed.  Parameters: scanPtr is a pointer to a ScanRecord which controls the scan. At the first call, scanPtr^.InitialCalnal Procedure FSSetSearchList(sList: SearchList); Abstract: Assign the system search list. Parameters: sLis, reen ] 214 Scrounge [ Module Scrounge ] 209 SCurChr [ Module Screen ] 208 SCurOff [ Module Screen ] 208 SCurOn [ Module RealFunctions ] 208 ToggleCursor [ Module Screen ] 62 TruncateSpiceSegment [ module FileAccess ] 40 TryDiskIO [ mule Screen ] 71 SegIDtoFileID [ module FileSystem ] 200 SetBaud [ module RS232Baud ] 231 SetDDS [ Program System ] 21odule DiskIO ] 25 UniqueCmdIndex [ Module CmdParse ] 125 UnitIO [ Module IO_Unit ] 160 UpperCase [ Module PERQ_String 2 SetFont [ Module Screen ] 141 SetIncrement [ module Memory ] 142 SetKind [ module Memory ] 141 SetMaximum [ module ] 183 UseBuffer [ Module ReadDisk ] 234 ValidUsere [ module UserPass ] 38 WhichDisk [ module DiskIO ] 9 WhichPartitMemory ] 140 SetMobility [ module Memory ] - 254 - POS D.6 Interface ion [ module AllocDisk ] 247 WriteBoolean [ module Writer ] 247 WriteCh [ module Writer ] 247 WriteChArray [ module Wr Index of Exported Routines 05 Feb 82 142 SetSharable [ module Memory ] 15 SetTStamp [ module Clock ]iter ] 150 WriteD [ module PasLong ] 182 WriteDisk [ Module ReadDisk ] 182 WriteHeader [ Module ReadDisk ] 247 WriteI 15 SetTString [ module Clock ] 211 SFullWindow [ Module Screen ] 237 ShowProgress [ Module UtilProgress ] 196 Sin dentifier [ module Writer ] 248 WriteInteger [ module Writer ] 154 WriteR [ module PasReal ] 204 WriteRunFile [ module[ module RealFunctions ] 114 SpeechIntr [ Module IO_Private ] 210 SPutChr [ Module Screen ] 194 Sqrt [ module RealFunct RunWrite ] 63 WriteSpiceSegment [ module FileAccess ] 248 WriteString [ module Writer ] 248 WriteX [ module Writer ] ions ] 208 SReadCursor [ Module Screen ] 208 SSetCursor [ Module Screen ] 209 SSetSize [ Module Screen ] 15 StampToS 115 Z80Intr [ Module IO_Private ] 38 ZeroBuffer [ module DiskIO ] - 255 - tring [ module Clock ] 208 StartLine [ Module Screen ] 24 StdError [ Module CmdParse ] 223 StreamClose [ module Strea gmentNumber [ module Virtual ] 25 RemDelimiters [ Module CmdParse ] 21 RemoveQuotes [ Module CmdParse ] 235 RemoveUsem ] 223 StreamInit [ module Stream ] 225 StreamKeyBoardReset [ module Stream ] 226 StreamName [ module Stream ] 223 Sr [ module UserPass ] 241 ReturnSegment [ module Virtual ] 160 RevPosC [ Module PERQ_String ] 115 RSIIntr [ Module IO_treamOpen [ module Stream ] 237 StreamProgress [ Module UtilProgress ] 176 StringSort [ module QuickSort ] 15 StringToPrivate ] 116 RSOIntr [ Module IO_Private ] 209 SaveLineEnd [ Module Screen ] 210 SBackSpace [ Module Screen ] 209 SCStamp [ module Clock ] 158 SubStr [ Module PERQ_String ] 243 SwapIn [ module Virtual ] 242 SwapOut [ module Virtual ] hrFunc [ Module Screen ] 210 SClearChar [ Module Screen ] 212 ScreenInit [ Module Screen ] 212 ScreenReset [ Module Sc 244 SwapSegmentsIn [ module Virtual ] 231 SysVers [ Program System ] 114 TabIntr [ Module IO_Private ] 196 Tan [ mod- f extensions. The search order is as follows: 1) Try the name with each extension in the current  - 84 - POS D.6 Intedirectory. 2) Repeat steps 1 in each path specified in the searchlist. If the file is found, thrface module GetTimeStamp 05 Feb 82 module GetTimeStamp; GetTimeStamp - Perq get time ro The first 43 characters of it are displayed Side Effects: Changes current window's title line Procede FileName is changed to be the full file name actually found. Parameters: SList - Sure FSGetFSData(id: FileID; pData: ptrFSDataEntry); Abstract: Returns the FSDataEntry description of a file Paraearchlist to use. Extensions - List of extensions to try with a single space after each extension. meters: id is the FileID for the file that data wanted for pData is a pointer to a data block to which the FSDa E.g. '.Pas .Micro .Cmd .Dfs '. The string must have a single trailing space. A single leadinta is copied. Memory for this pointer must be allocated before the call g space or a pair of adjacent spaces causes FSExtSearch to look for the file exactly as typed (with  - 82 - POS D.6 Interface module FileUtils 05 Feb 82 Proced no extension appended). Other extra spaces are not allowed. If Extensions does not end in a spure FSSetFSData(id: FileID; pData: ptrFSDataEntry); Abstract: Changes the FSDataEntry of a file Parameters: id ace, then one added. FileName - Name of file to find, set to be the full name of is the fileID of the file to be modified pData is the FSDataEntry to set id to. The entire FSDataEntry the file that was actually found. BlksInFile - Length of file in blocks. BitsInLBlk - Bits in last blo description of id is changed, so the user should use FSGetFSData to read the FSDataEntry and then chck of file. Returns: 0 if file not found or id of file Errors: Raises FSNotFnd if file not found ange the desired fields only Side Effects: Changes the FSDataEntry for id Function FSExtSearch(var SL - 83 - POS D.6 Interface module FileUtils 05 Fist : SearchList; Extensions: String; var FileName : PathName; var BlksInFile, BitsInLBlkInLBlk: Integer) : FileID; eb 82 Procedure FSRemoveDots(var fname: PathName); Abstract: Removes "."s and ".."s from file name leaving correct  Abstract: FSExtSearch performs a breadth-first lookup of a file using a specified searchlist and a list o full name Parameters: fname is file name. It is changed to not have dots. - Sides 2 Density SINGLE Fast ! DOCUMENTATION-3 - DOCUMENTATION ! Created 11 Feb 82 10:46:18 Get POS.DOC  POS.DOC . eger end; procedure GetTStamp( var Stamp: TimeStamp ); var PastStamp: TimeStamp; Past: Timeroup command} gpdcl = #024; {device clear} gpget = #010; {group execute trigger} gpgtl = #001; {go to loReference; - 85 - POS D.6 Interface cal} gplag = #040; {listen address group} gpllo = #021; {local lockout} gpmla = #040; {my listen address module GetTimeStamp 05 Feb 82 procedure GetTStamp( var Stamp: TimeStamp ); Abstract: returns a timeStamp f} gpmta = #100; {my talk address} gpmsa = #140; {my secondary address} gpppc = #005; {parallel poll confor the current time Parameters: Stamp is set to be the stamp for the current time igure} gpppe = #140; {parallel poll enable} gpppd = #160; {parallel poll disable} gpppu = #025; {paralle - 86 - POS D.6 Interfl poll unconfigure} gpscg = #140; {secondary copmmand group} gpsdc = #004; {selected device clear} gpspdutine. J. P. Strait 1 Feb 81. Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: GetTimeStamp iace module gpib 05 Feb 82 module gpib; Abstract: Support routines for PERQ GPIB dmplements the read-time-as-TimeStamp function for the Clock module. See the Clock module for more details. Desievices. The package maintains a buffer (gpCommandBuffer) which holds either data bytes (sent with procedure gpPutgn: GetTimeStamp is a separate module so that it may be imported into the resident system without importing all the Byte) or Auxiliary commands (sent with gpAuxCommand). The buffer is sent to the 9914 when full, or when gother Clock routines. Once virtual memory is implemented, GetTimeStamp and Clock should be merged into a single modpFlushBuffer is called. If the buffdr has data bytes when gpAuxCommand is called, it will do a gpFlushBuffer. Siule. Version Number V1.4 {/////////////////////////} Exports {\\\\\\\\\\\\\\\\\\\\\\\\} const GetTSVersion = '1.4'; milarly, when gpPutByte is called, it will flush the buffer, if auxiliary commands are in gpCommandBuffer. type TimeStamp = packed record { the fields in this record are ordered this way to optimize bits } Hour: 0..23writen by Brian Rosen Copyright(C) 1980, Three Rivers Computer Corporation Version Number V1.3 exports const G; Day: 1..31; Second: 0..59; Minute: 0..59; Month: 1..12; Year: 0..63; { year sinpibVersion = '1.3'; gpBufSize = 32; gpBufMax = 31; {gpBufSize - 1} { the following codes are the IEE488-1975 Cce 1980 } end; TimeReference = record Lower: Integer; Upper: Intontroller Command Codes they are issued by the Controller-In-Charge while asserting ATN } gpacg = #000; {addressed g. / oldoff} gprhdf, {Release RFD holdoff} gphdfa, {Holdoff all d..31; {legal addresses for devices on GPIB} gpBuffer = packed array [gpRange] of gpByte; gppBuffer = ^gpata} - 87 - POS D.6 Interface module gpib 05 Feb 82 Buffer; var gpCommandBuffer: gppBuffer; {place to put commands} gpBufPtr: 0..gpBufSize; {pointer to gp gphdfe, {Holdoff on End} gpnbaf, {Set NewByteAVailable falsCommandBuffer} gpHaveDataBytes, gpHaveAuxiliaryCommands: boolean; {true if buffer in use} { e} gpfget, {Force Group Execute Trigger} gprtl, {Return to  The package maintains a buffer (gpCommandBuffer) which holds either Data bytes (sent with proceedure gpPutByte) or AuLocal} gpfeoi, {force End or Identify} gplon, {Listen Only}xialiary Commands (sent with gpAuxCommand) The buffer is sent to the 9914 when full, or when ghForceBuffer is called.  gpton, {Talk Only} gpgts, {GoTo Standby}  If the buffer has data bytes when gpAuxilairyCommand is called, it will do a gpForceBuffer. Similarly, when gpPutByte  gptca, {Take Control Asynchronously} gptcs, {Take Control Synchronously}  is called, it will force the buffer if auxiliary commands are in gpCommandBuffer } { Initialze GPIB packag gprpp, {Request Parallel Poll} gpsic, {Set Interface Clear}e, called once only, turns off tablet } procedure gpInit; { Send an auxiliary command to TMS9914  = #061; {serial poll disable} gpspe = #060; {serial poll enable} gptct = #011; {take control} gptag = # gpsre, {Set Remote Enable} gprqc, {Request Control} 100; {tahk address group} gpuag = #020; {universal address group} gpunl = #077; {unlisten} gpunt = #137; gprlc, {Release Control} gpdai, {Disable All Interrupts}  {untalk} type { these commands are the major state change control commands of the TMS9914 chip which forms the int gppts, {Pass Through next Secondary} gpstdl, {Set T1 Delay} erface to the GPIB Consult the TI documentation on the TMS9914 for more information} {These definitions are  gpshdw); {Shadow Handshake} gpParmType = (gpOff, gpOn, gpDontCare); {parameters for Aux Comorder dependent} gpAuxiliaryCommands = (gpswrst, {Chip Reset} gpdacr, {Release DAC hmands} gpByte = 0..255; {Data byte for gpib transactions} gpRange = 0..gpBufSize; gpDeviceAddress = 0/ 0 byte is a controller command byte. Must be in Talk Only if a data byte } procedure gpPutByte(gpData: integer); tatus from UnitIO or IOCRead. The condition should be corrected and the operation retried. The  { Sends all bytes in buffer } procedure gpFlushBuffer; { Set TMS9914 to be a Talker, set a device to most likely error is a timeout: IOETIM (See IOErrors).  be a listener - 88 - POS D.6 Interface module gpib 0 - 89 - POS D.6 Interface module gpib 05 Feb 82 procedure 5 Feb 82 This procedure takes control of the bus, unlistens and untalks all devices (including itsgpInit; elf), and sets a listener with MyListenAddress then sets TMS9914 to be the talker with TalkONly } procedure gpITa - 90 - POS D.6 Interface Module Helper 05 Feb 82 Module Helper; lkHeListens(gpAddr: gpDeviceAddress); { Set TMS9914 to be a Listener, set a device to be a talker Th WJHansen Jan 82. Copyright (C) Three Rivers Computer Corporation, 1982. Abstract: Reads an index file and pis procedure takes control of the bus, unlistens and untalks all devices (including itself), and sets a talker witresents options for assistance to the user. Version Number V1.1 exports imports FileDefs from FileDefs; {fh MyTalkAddress then sets TMS9914 to be the listener with ListenONly} procedure gpHeTalksIListen(gpAddr: gpDeviceor PathName} procedure GiveHelp(FName:PathName); Address); { turn the BitPad (device addres #10) off } procedure gpTbltOn; { turn the BitPad back on a - 91 - POS D.6 Interface Module Helper 05 Feb 8gain } procedure gpTbltOff; { Send a buffer of user data to the 9914 } procedure gpSend(var gpBuf: gppBuffer; gpCo2 procedure GiveHelp(FName:PathName); Abstract: Reads a help index and displays it. Lets user ask for unt: gpRange); {Get a buffer of data from the 9914 (Not implemented yet) } procedure gpReceive(var gpBuf: gppBufferinformation on topics in the index and displays the files containing those topics. Parameters: some commands require a parameter (gpOff/gpOn) } procedure gpAuxCommand(gpCmd: gpAuxiliaryCommands; gpParm:gpParmType); ; gpCount: gpRange); { Get a byte of data from the GPIB } function gpGetByte: gpByte; exception GPIBerror(SoftS { Put a data byte or a Control byte out on the data bus TMS9914 must be in Controller Actives State if the tatus: integer); Abstract: Raised when GPIB encounters an error indication in softs0 1  the last result was believed regardless of success or failure.  Check SystemInitialized for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor and TablFName - Name of the file containing the index. The path to this file is used as the path to the individual  3. Hang if we cannot figure out the size of the disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. help files.  19-Mar-81 BAM V4.5 Changed name of included modules to IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHea - 92 - POS D.6 Interface Module IO 05 Feb 82 Module IO; ds and FindSize to agree with V4.3. 2) Teach the HardDisk timeout code about multi-sector  Abstract: PERQ Raw IO Drivers - Compatibility file. Written by: Miles A. Barel Copyright (C) 1980 Three Rivers operations. 28-Feb-81 JPS V4.3 No longer do conversions on Disk Physical block n Computer Corporation The IO module has been split into four modules: IO_Init, IO>Unit, IO_Others, and IOumbers (reinstating changes made in V4.0). 25-Feb-81 GGR V4.2 Added setting/reading of DskFill1 in UnitIO. _Private. This module is provided for compatibility. It imports the first three modules in its exports section.  Moved new/dispose of CB from UnitIO to IO.Init. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical  IO_Private is not exported because it provides definitions which were private in the old IO module and is used block numbers; fixed botCursF bug. Del XXX procedures; Changed to use new scr only by the new IO modules. Design: 1) Interrupt routines must *never* cause segment faults. 2) UnitIO mueen 9-Feb-81 BAM V4.0 No longer does conversions on Disk Physical block numbers; fixed CursorUst increment and decrement the IOCount of the segments which are involved in IO. 3) Segment faults must pdate to allow partial screen display and added procedure IOScreenSize to set a  *never* happen while interrupts are off. {*******************************} Exports {*****************************} C new size. - 93 - POS D.6 Interface Module IO 05 Febonst IOVersion = '4.8'; { Version Number V4.8 11-May-81 JPS V4.8 Split IO into several modules. 6-May-81 JPS V 82 13-Jan-81 JPS V3.3 Move creation of the IOSeg to memory manager init. Move $R- to private4.7 1. Use new form of the SetCylinder StartIO. 2. Don't bother doing 10 trys in FindSize since only part. 20-Nov-80 JPS V3.2 Initialize TabFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt table. 1 2 ace Module IOErrMessages 05 Feb 82 Function IOErrString(err: integer): String; AbstraELHB = -16; { Logical Header Logical Block Number Mismatch } IOECOR = -17; { Cylinder Out of Range } Ict: Returns a string describing a the error number Parameters: err is the error number returned by UnitIO ReturnOEDNR = -18; { Device not ready } IOEMDA = -19; { Missing data address mark } IOEMHA = -20; { Misss: A string describing the error ing header address mark } IOEDNW = -21; { Device not writable } IOECMM = -22; { Cylinder mis-match }  - 96 - POS D.6 Interface Module IOErrors 05 Feb 82 IOESNF = -23; { Sector not found } IOEOVR = -24; { Overrun } IOEUEF = -25; { Undetermined et interface. New time procedures. Split into another include file. 10-Oct-80 JPS V2.2 Added  Module IOErrors; Abstract: I/O System Error Code Definitions Copyright (C) 1981,1982 - The Three Riverssupport for the diagnostic display (DDS). 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the  Computer Corporation Version Number V1.2 Exports Imports SystemDefs from SystemDefs; {using Ether3MBaud} Const  hard disk. 19-Sep-80 DAS V2.0 Added code for 24 MByte disks. } Imports IO_Init from IO_Init; Imports IO_Unit IOEIOC = 1; { IO Complete } IOEIOB = 0; { IO Busy } IOEBUN = -1; { Bad Unit Number }  from IO_Unit; Imports IO_Others from IO_Others;  IOENBD = -2; { Raw Block IO to this device is not implemented } IOEWRF = -3; { Write Failure } IO - 94 - POS D.6 Interface Module IOErrMessages 05 Feb 82 Module IOEEBSE = -4; { BlockSize Error } IOEILC = -5; { Illegal Command for this device } IOENHP = -6; { rrMessages; Abstract: This module exports a procedure to return an error string for a disk error WrNil Header Pointer } IOEADR = -7; { Address Error } IOEPHC = -8; { Physical Header CRC Error } itten by : Brad A. Myers May 12, 1981 Copyright (C) 1981 - Three Rivers Computer Corporation Version Number V1.1 {/ IOELHC = -9; { Logical Header CRC Error } IOEDAC = -10; { Data CRC Error } IOEDNI = -11; { De/////////////////////////} EXPORTS {\\\\\\\\\\\\\\\\\\\\\\\} Function IOErrString(err: integer): String; vice Not Idle } IOEUDE = -12; { Undefined Error! } IOENCD = -13; { Device is not a character device }  - 95 - POS D.6 Interf IOECBF = -14; { Circular Buffer Full } IOELHS = -15; { Logical Header SerialNum Mismatch } IO2 3 nitializes the Interrupt Vector Table, the Device Table and associated buffers, the Screen Package, the tablet andger; CurPatPtr = ^CursorPattern; Var TabRelX, TabRelY: integer; { tablet relative coordinates }  cursor, and the Z80. Version Number V5.9 {******************} Exports {*********************} Procedure TabAbsX, TabAbsY: integer; { tablet absolute coordinates } TabFinger: boolean; { finger on tablet } InitIO; - 98 -  TabSwitch: boolean; { switch pushed down } TabWhite : boolean; { True if white button down } POS D.6 Interface Module IO_Init 05 Feb 82 Procedure InitIO; Abstract: InitIO i TabGreen : boolean; { True if green button down } TabBlue : boolean; { True if blue button dnitializes the Interrupt Vector Table, the Device Table and associated buffers, the Screen Package, the own } TabYellow : boolean; { True if yellow button down } TabMouse : integer; { Actual output f tablet and cursor, and the Z80. rom mouse } DefaultCursor: CurPatPtr; { default cursor pattern } Procedure IOLoadCursor(Pat: CurPatPtr; pX, pY - 99 - POS D.6 Interface Module IO_Others 05 F: integer); { load user cursor pattern } Procedure IOReadTablet(var tabX, tabY: integer); equipment fault } IOESOR = -26; { Sector out of range } IOETIM = -27; { Time out error } IOEFeb 82 Module IO_Others; IO_Others - Miscellaneous IO routines. Miles A. Barel ca. 1 Jan 80. Copyright (C) 1980, ThrRS = -28; { Floppy recalibrate done } IOEDRS = -29; { Disk recalibrate done } IOET0 = -30; { Can'ee Rivers Computer Corporation Abstract: IO_Others exports routines for the Cursor, Table, Screen, Time, and Ket find track zero } {$ifc Ether3MBaud then} IOEPTL = -31; { Ether3 - received packet too large } IOEFirstEryboard. Version Number V5.7 {**********************} Exports {************************} Imports SystemDefs from Sror = -31; {$elsec} IOEFirstError = -30; {$endc} IOELastError = 0; - 97 - ystemDefs; { tablet/cursor procedures } Type CursFunction = (CTWhite, CTCursorOnly, CTBlackHole, CTInvBlackHole,  POS D.6 Interface Module IO_Init 05 Feb 82 Module IO_Init; IO_Init - Initialize the CTNormal, CTInvert, CTCursCompl, CTInvCursCompl); TabletMode = (relTablet, scrAbsTablet, tabAbsT IO system. Miles A. Barel ca. 1 Jan 80. Copyright (C) 1980, Three Rivers Computer Corporation Abstract: IO_Init iablet, offTablet); CursMode = (OffCursor, TrackCursor, IndepCursor); CursorPattern = array[0..63,0..3] of inte3 4 pied every 1/60th second into the cursor position. if indep, then coordinat keyboard interrupts } Procedure IOKeyDisable( var OldKeyEnable: Boolean ); Procedure IOKeyEnable( OldKeyEnable: Boolean )es are changed only by user. If off, then no - 100 - POS D; { clear the IO type-ahead buffer } Procedure IOKeyClear; .6 Interface Module IO_Others 05 Feb 82 cursor displayed } Proce - 101 - POS D.6 Interface Module IO_Others 05 Feb 82 procedure IOCursorMode( M: Cdure IOSetCursorPos(x,y: Integer); { if trackCursor is false, then sets ursMode ); Abstract: Sets the mode for the cursor. If the mode m is set to TrackCursor,cursor x and y pos. If tracking, then sets both tablet and cursor. } Procedure IOSetTabPos (x,y Tablet coordinates are copied every 1/60th second into the cursor position. If it's set to : Integer); { if trackCursor is false, then sets tablet x and y pos.  IndepCursor, coordinates are changed only by the user. If it is set to OffCursor, no cursor is displayed. If tracking, then sets both tablet and cursor } Procedure IOReadCursPicture(pat: CurPatPtr; var  Parameters: m - the new mode for the cursor. procedure IOSetModeTablet( M: TabletMode ); px, py: integer); { copies current cursor picture into pat and sets px Abstract: Sets the mode to tell what kind of tablet is currently in use. Parameters:  and py with the offsets for the current cursor } Procedure IOGetTime(var t: double); { Ge m - the mode for the tablet. procedure IOLoadCursor( Pat: CurPatPtr; pX, pY: integer ); Abstract: t the double word 60 Hertz time } {Procedure to change screen size} Procedure IOScreenSize(newSize: integer; complemen Loads a user cursor pattern into the screen cursor. Parameters: Pat - a pointer to a cursor { read tablet coordinates } Procedure IOSetFunction(f: CursFunction); Procedure IOSetModeTablet(m: TabletMode)t: Boolean); { newSize is number of scan lines in new screen; must be a ; { set the mode to tell what kind of tablet is currently in use } Procedure Imultiple of 128. Complement tells whether the rest of the screen shouOCursorMode (m: CursMode); { if track is true, then Tablet coordinates are cold be the opposite color from the displayed part } { disable/enable4 5 . It should be quad-word aligned. pX and pY - offsets in the cursor where the origin is abPos sets the tablet's x and y positions. If the mode is TrackCursor, both tablet and cursor are thought to be. For example, if the cursor is a bull's eye, 31 bits diameter flushed to the upp set. - 103 - POS D.6 Interface Module IO_Others er left corner of the cursor box, using (pX, pY) = (15, 15) will have the cursor surround the 05 Feb 82 Parameters: x and y - the new tablet coordinates. procedure IOReadTablet( var tabX, tabY: things pointed at. NOTE: This procedure supports a cursor which is 56 x 64; with a scan lininteger ); Abstract: Reads tablet coordinates. Parameters: tabX and tabY - set to e length of 4 - 102 - POS D.6 Interface Module IO_x and y values of the tablet. Procedure IOScreenSize( newSize: Integer; complemented: Boolean ); Abstract: Others 05 Feb 82 procedure IOReadCursPicture( Pat: CurPatPtr; var pX, pY: integer ); Abstract: Copies Changes the amount of screen visible to the user (the rest is turned off, hence not displayed). The the current cursor picture into Pat and sets pX and pY with the offsets for the current cursor. Paramete cursor is prevented from going into the undisplayed part of the screen. Parameters: rs: Pat, pX, and pY are filled with data on the current cursor. Note that Pat must be quad-word aligned newSize - number of scan lines in new screen; it must be a multiple of 128. Complemen. Procedure IOSetFunction( f: CursFunction ); Abstract: Sets the cursor function. Paramet - tells whether the rest of the screen should be the opposite color of the displayed part. Procedurters: f - the function to set the cursor to. procedure IOSetCursorPos( x, y: integer ); Abstract: e IOGetTime( var t : double ); Abstract: Reads the 60 Hertz clock. Parameters: t - If the cursor's mode is not TrackCursor, this procedure sets the cursor's x and y positions. If trackin set to the new time. - 104 - POS D.6 Interface g, it sets both tablet and cursor. Parameters: x and y - the new cursor coordinates.  Module IO_Others 05 Feb 82 procedure IOKeyDisable( var OldKeyEnable: Boolean ); Abstract: IOKeyDisable is used tprocedure IOSetTabPos( x, y: integer ); Abstract: If the cursor's mode is not set to TrackCursor, IOSetTo disable keyboard interrupts. This is used to delay processing of control-c, control-shi5 6  - 105 - POS D.6 Interface Module IO_Private 05 Feb 82y = 7; Z80Priority = 8; - 106 - POS D.6 Interface  Module IO_Private; IO_Private - IO system private definitions and interrupt routines. Miles A. Barel ca. 1 Jan 80.  Module IO_Private 05 Feb 82 PutPriority = 9; GetPriority = 4; PSFloppy = #14; { P Copyright (C) 1980, Three Rivers Computer Corporation Abstract: IO_Private exports interrupt routines and definitions ut Status Special Codes } PSGPIB = 0; PSZ80Monitor = #11; PSTablet = 6; PSKeyBoard = 7; ft-c and control-shift-d at critical times. The old value of the keyboard interrupt enable is returned and  which are private to the modules which make up the IO system. Design: Interrupt routines must *never* cause segm must be passed back to IOKeyEnable when re-enabling keyboard interrupts. Characters typed while ent faults. Version Number V5.9 {*******************************} Exports {*****************************} Impor keyboard interrupts are disabled are remembered. When keyboard interrupts are re-enabled, the charts SystemDefs from SystemDefs; Imports IO_Unit from IO_Unit; Imports IO_Others from IO_Others; Imports Raster from Raster; acters are processed. Parameters: OldKeyEnable - set to the old value of the enable. procedure IOKey Const CirBufSize = #100-3; { size of circular buffers - made so that } { totEnable( OldKeyEnable: Boolean ); Abstract: IOKeyEnable is used to enable keyboard interrupts. The old valual size of CirularBuffer = #100 } DskBlockSize = 512; { block sizes for fixed block size devices } FlpBle of the keyboard interrupt enable (as returned from IOKeyDisable) must be passed to IOKeyEnable when re-enabling ockSize = 128; { Size is in BYTES } SpkBlockSize = 128; TabBlockSize = 8; Z80BlockSize = 20;  keyboard interrupts. If characters were typed while keyboard interrupts were enabled, IOKeyEnable c GPIBBlockSize = 1; Last12Sector = 202 * 4 * 30 -1; {Tracks * Heads * Sectors. 0 start } DskPriority = alls KeyIntr to process those characters. The master interrupt control (INTON and INTOFF QCodes) must 0; { interrupt priorities } FlpPriority = 3; SpkPriority = 2; {$ifc Ether3MBaud then} Ether3Prbe on when this procedure is called. Parameters: OldKeyEnable - the old value of the enable. iority = 12; {$elsec} {$ifc Ether10MBaud then} Ether10Priority = 12; {$endc} {$endc} GPIBInPriority = 11;  procedure IOKeyClear; Abstract: IOKeyClear clears the keyboard type-ahead buffer.  GPIBOutPriority = 1; TabPriority = 10; KeyPriority = 5; RSIPriority = 6; RSOPriorit6 7 3); CtrlS = chr(#23); CtrlQ = chr(#21); BlamCh = Chr(#303); { untranslated shift-control-C } verrun: boolean; { true = overrun } KDBError: boolean); { OR of all error bits }  DumpCh = Chr(#304); { untranslated shift-control-D } {$ifc Ether3MBaud then} E3TIntEnable = #4; { Eth RSIType: (RSIUnused: 0..7; RSIBreak: boolean; { true=break received } er3 constants } E3TDone = #2000; E3TError = #4000; E3TGo = #10; E3RIntEnable = #1;  RSIModem: boolean; { true=modem change } RSIParErr: boolean; E3RDone = #400; E3RPromiscuous = #20; E3RError = #1000; E3RGo = #2; E3XmtMask = E3TDone + E3 { true=parity error } RSIOverrun: boolean; { true=overrun error } TError + E3TGo; E3XmtSucc = E3TDone + E3TGo; E3RecMask = E3RDone + E3RError + E3RGo; E3RecSucc = E3RD RSIError: boolean); { OR of all error bits } RSOType: (RSOUnused: 0..255); one + E3RGo; PackBuffLen = 511; E3RecCount = PackBuffLen - 4; MAXE3RECERRS = 20; {$endc}  StdType: (StdHiByte: 0..255) end; CircularBuffer = packed record { circular buffer used for c PSRS232 = 5; PSClock = #12; GSFloppy = #40; { Get Status Special Codes } GSGPIB = #1 - 107 - POS D.6 Interface Module IO_Private 05 Feb 82 Typ00; GSZ80Monitor = #10; GSTablet = #2; GSKeyBoard = #4; GSRS232 = #1; GSClock = #20e IOPtrKludge = record case integer of 1: (Buffer: IOBufPtr); 2: (Off; DisCst0 = #1154; { consts to terminate Display List; add in funct } DisCst1 = #1351; MinCurY set: Integer; Segment: Integer) end; {$ifc Ether3MBaud then} E= 0; { Minimum Y value for cursor } MaxCurY = 1023; { Maximum Y value for cursor } SegSize = therBuff = array [0..PackBuffLen] of integer; pEtherBuff = ^EtherBuff; {$endc} CirBufPtr = ^ CircularBuffer128; { # lines / display segment } CrsHeight = 64; { Height of the cursor } CrsConst0 = #370; ; CBType = (KDBType, RSIType, RSOType, StdType);{ types of circular bufs } CirBufItem = packed record { w { constants to compute funny X position } VisOnly = #2000; { mode bits - Visual screen only } VisAndhat we put in circular buffers } ch: char; { the character } case CBType of Cur = #2400; { visual screen and cursor } Map = #100000; { cursor map function } CtrlC = chr(# { and device specific condition bits } KDBType: (KDBUnused: 0..63; KDBO7 8  { buffer used for tablet, clock and } TabX: 0..#77777; { Z80 Monitor Info } TabSwitc { Number of cylinders } FlpUnits = 4; { 0 is the only valid unit } FlpSPC = 26; h: boolean; TabY: 0..#77777; Fill: 0..1; ClkTime: double; Z8 { numbered 1 to 26 } FlpHds = 2; { numbered 0 to 1 } FlpCyls = 77; { numbered 0 to 77, 0Mon: Z80Readings end; DispPtr = ^DisplayFile; DisplayFile = array[0..11] of p0 should not be used } TabAverage = 4; { number of tablet points to average } acked record case boolean of true: (int: integer); false:(LineCount: 0..127;  { this MUST be 4 } TabIgnore = 2; { number of points to ignore when finger is }  - 108 - POS D.6 Interface Module IO_Private 05 Feb 82  { picked up or put down } TabFifoLen = TabAverage + TabIgnore; TabFifoMax = TabFifoLen - 1; GPIB StartOver: boolean; ShowCursor: boolean; VerticalRxFudge = 38; { actual range in X and Y for BitPad: 0..2200 } GPIByFudge = 1061; { of TX and TY: 0..1100 } etrace: boolean; ShowScreen: boolean; DisableMicroInterrupt: boolean;  { of TabAbsX: 0..1100 } { of TabAbsY: 0..1100 }  WriteBadParity: boolean; Map: (CursOnly, CCursOnly, Compl, ComplInv,  { of TabRelX: -38..1062 limited to 0..767 } { of TabRelY: 1061..-39 limit Normal, Invert, CursComp, InvCursCompl)) end; ScrCtlPtr = ^ ScrCtlBlocked to 1023..0 } STopY = 0; SLeftX = 0; SRightX = 767; Type DskCmds = (DskIdle, DskRdCheharacter } { devices, SpGetCir and SpPutCir } Length: integer; ; ScrCtlBlock = packed record Cmd: DispPtr; ScreenBase: Integer; Cur{ # chars in the buffer } RdPtr: integer; { where to get chrs out } WrPtr: integer; sorBase: Integer; Unused1: Integer; Unused2: Integer; CursX: integer;  { where to put them in } Buffer: packed array[0..CirBufSize-1] of CirBufItem  filler: integer end; Const DskSPC = 30; { Sectors Per Cynlinder } DskHds  { last, the buffer } end; TabBufPtr = ^TabletBuffer; TabletBuffer = packed record = 8; { Max number of dsk heads } DskExHds = 0; { Extra heads not in use } DskCyls = 202;8 9 Ether3Cmds = (E3Rset, E3Status, E3Receive, E3PromiscReceive, E3Transmit); {$endc}  PHCRC, { Physical Header CRC } LHSer, { Logical Serial W - 109 - POS D.6 Interface Module IO_Private 05 Feb 82 FlpCmds rong } LHLB, { Logical Block Wrong } = (FlpUnUsed, FlpRead, FlpWrite, FlpFormat, FlpSeek, FlpReset); GPIBCmds = (GPIBNop, GPIBWrite, GPIBWrEOI, GPIBCntl); LHCRC, { Logical Header CRC } DaCRC, { Data CRC }  { Types of block devices } IOCBType = (DskType, FlpType, SpkType, GPIBType, {$ifc Ether3MBaud t Busy); DskFill2: boolean; DskTrackZero: boolean; hen} Ether3Type, {$endc} GenType);  DskWriteFault: boolean; DskSeekComplete: boolean; DskDriveRIOCBPtr = ^IOCB; IOCB = packed record { IOCBs must be 8 word aligned } Buffer: IOBufPtr; { data bufferead: boolean; DskNextIOCB: IOCBPtr); FlpType: ( FlpUnit: 0. for transaction } case IOCBType of DskType: ( DskCommand: 0..255; .FlpUnits-1; FlpHead: 0..FlpHds-1; FlpFill1: 0..31; F DskNumSect: 0..255; (* NEW FS [*) DskAddr: Integer; lpCylinder: 0..255 { 0..FlpCyls-1 }; FlpSector: 0..255 { 1..FlpSPC }; FlpComma (* NEW FS *) (* OLD FS [) DskSector: 0..DskSPC-1; nd: 0..255 { FlpCmds }; FlpByteCnt: integer { 0..256 }; FlpFill2: array [4..11 DskHead: 0..DskHds+DskExHds-1; DskCylinder: 0..DskCyls-1; (* ] of integer; - 110 - POS D.6 Interface Module IO_PrivOLD FS *) DskSerialNum: double; DskLogBlk: integer; Date 05 Feb 82 FlpResult: integer; { Not yet defined } FlpNextIOCB: IOCBskFill1: integer; DskNextAdr: double; DskPrevAdr: double; Ptr); SpkType: ( SpkFill0: 0..255; SpkNumBufs: 0..255; ck, DskDiagRead, DskWrCheck, DskWrFirst, DskFormat, DskSeek, DskClear); {$ifc Ether3MBaud then}  DskCntlError: ( OK, AddrsErr, { address error } 9 :  { RS-232 In Buffer } RSOBuf: CirBufPtr; { RS-232 Out Buffer } TabBuf: TabBu { function currently in use} BotCursF: integer; { function for area below used area} BotfPtr; { Tablet/Clock Buffer } ScrBuf: ScrCtlPtr; { Screen control blocks } DisFile0,Complemented: boolean; { whether bot is complemented or not} SBottomY: integer; { bottom of displaye SpkFill1: array[3..11] of integer; SpkFill2: 0..16383; SpDisFile1: DispPtr; { Screen Display lists - double bufrs } OldCurY, { previous Cursor Y posikAddrErr: boolean; SpkError: boolean; SpkNextIOCB: IOCBPtr); tion } OldCurX: integer; { previous Cursor X position MOD 8 } Cursor: CurPatPtr; {  GPIBType: (GPIBCommand: GPIBCmds; GPIBF0: 0..63; GCursor Pattern } CursorX, CursorY: integer; { new cursor coordinates } PointX, PointY: integer; { PIBNumBufs: 0..255; GPIBByteCount: 0..255; GPIBF1: array [4..11] of integer; the point of the cursor } TabFifo: array[0..TabFifoMax] of record X,Y: integer end; { fifo of table GPIBResult: integer; {Not Implemented} GPIBNextIOCB: IOCBPtr); {$ifc Ether3MBat points } TabFifoInx: integer; { index into tablet fifo } TabCount: integer; { counteud then} Ether3Type: ( Ether3Cmd: integer; Ether3Delay: intr for ignoring tablet points } SumX, SumY: integer; { sum of 4 points for averaging } FlpLastCylindeger; Ether3WdCnt: integer; Ether3Status: integer; Eter: integer; { last cylinder referenced } FlpLastHead: integer; { last head referenced } GPIBTher3NextIOCB: IOCBPtr ); {$endc} GenType: { General Purpose entry } ( GenCmd: 0.abletState: integer; { GPIB tablet current state } GPIBxTablet, GPIByTablet: integer; { GPIB tablet coordinates .255; NumBlks: 0..255; GenFill0: array[3..11] of integer; } - 111 - POS D.6 Interface Module IO_Private 05 Feb  Result: integer; NextIOCB: IOCBPtr) end { IOCB }; Var KRBuf, 82 GPIBInBuf: CirBufPtr; { GPIB input buffer } StanleyTablet: boolean; { if Stanley tablet { Keyboard Raw Buffer } KTBuf, { Keyboard translated buffer } RSIBuf,  is enabled } CurDskHds: integer; { number of heads on this disk. 4 or 8} CursF: integer; : ; keyboard interrupts are enabled } {$ifc Ether3MBaud then} Var etherCB: IOCBPtr; { Pointer to IOCB used bring IOInProgress. Procedure SpeechIntr; Abstract: SpeechIntr handles a speech interrupt by cly Ethernet } pEBuff: IOBufPtr; { Pointer to Ethernet IO buffer } E3Restart, earing IOInProgress. Procedure GPIBOutIntr; Abstract: GPIBOutIntr handles a GPIB output interrupt by { Ether3 state } E3IsPromiscuous, E3InProgress, E3IsReceiving: boolean; E3RecErrs: intege clearing IOInProgress. Procedure GPIBInIntr; Abstract: GPIBInIntr handles a GPIB input interrr; {$endc} { interrupt routines: } Procedure DiskIntr; { hard disk } Procedure FloppyIntr; { floppy disk }upt. The assumption is that the only GPIB input device is a BitPad. When a GPIB input interrupt is  Procedure SpeechIntr; { speech out } Procedure GPIBOutIntr; { GPIB out } Procedure GPIBInIntr; { GPIB in } recognized for the first time, the Stanley tablet is turned off. GPIBInIntr gathers characters from td area } TabMode: TabletMode; { Current mode of the tablet } CCursMode: CursMode; { Curr - 112 - POS D.6 Interface Module IO_Private 05 Feb 82 ent mode of cursor } newFunct: Boolean; { Tells when have a new function to Procedure TabIntr; { tablet (actually video retrace } Procedure Z80Intr; { Z80 monitor } Procedure KeyIntr;  insure that cursor redisplayed } CB : IOCBPtr; { Pointer to IOCB used by UnitIO }  { keyboard } Procedure RSIIntr; { RS232 in } Procedure RSOIntr; { RS232 out } Procedure PutIntr; { PutS Type IntTabPtr = ^IntVecTable; IntVecTable = array [0..MaxUnit-FakeUnits] of record tatus completion } Procedure GetIntr; { GetStatus completion } {$ifc Ether3MBaud then} Procedure Ether3Intr; { 3 M { NO Fake Units Included Here! } SSN: integer; GPtr: iBaud EtherNet completion } Function E3Reset: integer; Procedure E3RecStart; {$endc} nteger; Rtn: 0..255; SLink: integer end; V - 113 - POS D.6 Interface ar IntTab: IntTabPtr; { pointer to interrupt vector table } IOPriv1Unused: boolean; { *** Module IO_Private 05 Feb 82 Procedure DiskIntr; Abstract: DiskIntr handles a hard disk interrupt by cleari** Unused ***** } IOPriv2Unused: boolean; { ***** Unused ***** } KeyEnable: boolean; { if ng IOInProgress. Procedure FloppyIntr; Abstract: FloppyIntr handles a floppy interrupt by clea; <  KeyBoard buffer into the (misnamed) translated keyboard buffer (KTBuf). Control-C, Contrinvolved in IO. 2) Segment faults must *never* happen while interrupts are off. Version Number V6.2 {************ol-Shift-C, Control-Shift-D, Control-S, HELP and Control-Q are processed also. function E3Reset: intege*******************} Exports {*****************************} Imports SystemDefs from SystemDefs; Const r; Abstract: E3Reset resets the 3 MBaud EtherNet (?). procedure E3RecStart; Abstract: E3RecStart star{ Device Code Assignments } MaxUnit = 18; { highest legal device code } FakeUnits = 2; { Nuts a receive from the 3 MBaud EtherNet (?). Procedure Ether3Intr; Abstract: E3Reset processes a 3 mber of units which don't have StartIO's } IOStart = 0; { Master Z-80 control } HardDisk = 1; {$ifMBaud EtherNet interrupt (?). Procedure RSIIntr; Abstract: RSIIntr ignores an RS232 input interrupt. c Ether3MBaud then} Ether3 = 2; {$elsec} {$ifc Ether10MBaud then} Ether10 = 2; {$endc} {$endc}  - 115 - POS D.6 Interface Module IO_PrivFloppy = 3; Speech = 4; GPIBIn = 11; GPIBOut = 5; Z80Monitor = 6; Tablet = 7; ate 05 Feb 82 Procedure RSOIntr; Abstract: RSIIntr ignores an RS232 output interrupt. Procedure PutIntr;  KeyBoard = 8; RS232In = 9; RS232Out = 10; SpPutSts = 12; { Put/Get Status } SpG Abstract: PutIntr handles a PutStatus interrupt by clearing IOInProgress. Procedure GetIntr; etSts = 13; SpPutCir = 14; { Put/Get from Circular Buffer } SpGetCir = 15; { Fake Units Begihe BitPad and updates the tablet buffer. Procedure TabIntr; Abstract: TabIntr (misnamed) handles the video retr Abstract: GetIntr handles a GetStatus interrupt by clearing IOInProgress. ace interrupt. It smoothes the tablet data and updates the displayed cursor position (if it is visible and - 116 - POS D.6 Interface  has moved). - 114 - POS D.6 Interface M Module IO_Unit 05 Feb 82 Module IO_Unit; IO_Unit - Unit IO routines. Miles A. Barel ca. 1 Jan 80. Coodule IO_Private 05 Feb 82 Procedure Z80Intr; Abstract: Z80Intr ignores Z80 temperature/voltage monitoring. pyright (C) 1980, Three Rivers Computer Corporation Abstract: IO_Unit exports procedures to perform IO on the various  Procedure KeyIntr; Abstract: KeyIntr processes KeyBoard interrupts by copying characters from theIO Units (devices). Design: 1) UnitIO must increment and decrement the IOCount of the segments which are < =  - 117 - POS D.6 Interface Module IO_Unit 05 Feb 82 Type  { >1 = fixed blocksize (= blocks IntrMask: integer; {  IOBufPtr = ^IOBuffer; IOBuffer = array[0..0] of integer; CBufPtr = ^CBufr; CBufr = packed interrupt mask bits } IntrPriority: integer; { decoded iterrupt priority (0.. PSCode:array[0..0] of char; { same as Memory, except for } { character buffers }  0..255; { Special code for PutStatus } GSCode: 0..255; { Special code for GetS BigStr = String[255]; { A big String } UnitRng = 0..MaxUnit; IOStatPtr = ^IOStattatus } Name: packed array[0..3] of char end; Const { RS-232 Speeds } RS9600us; IOStatus = record HardStatus: integer; { hardware status return } Soft = 1; RS4800 = 2; RS2400 = 4; RS1200 = 8; RS600 = 16; RS300 = 32; RS150 = Status: integer; { device independent status } BytesTransfered: integer end; 64; RS110 = 87; Type Z80Readings = packed record { Z80 Voltage/Temp Monitor Readings }  IOHeadPtr = ^IOHeader; IOHeader = record { Hard disk header record } Ser Ground: integer; Volts5: integer; Volts12: integer; - ialNum: Double; { Serial number of the file } LogBlock: integer; { The logical block number 118 - POS D.6 Interface Module IO_Unit 05 Feb 82 Minus12: integer; } Filler: integer; NextAdr: Double; { Address of next block in the f  VRef: integer; Net: integer; CRTemp: integer; BaseTemp: integer; PrevAdr: Double { Address of previous block } end; DevTabPtr = ^D Volts55: integer; Volts24: integer end; Z80Settings = packed record eviceTable; DeviceTable = array [UnitRng] of packed record CtlPtr: IOBufPtr; { actually  { Z80 Voltage/Temp Monitor Settings } MinGround: integer; MaxGround: integer; n Here } TransKey = 16; { Translated Keyboard } ScreenOut = 17; { Screen Display } Cpointer to ChrCntlBlk { but we'll coerce later } BlockSize: inlock = 18; { Used only for Put/Get Status } LastUnit = Clock; { for unit validity checking } teger; { 0 = variable size } { 1 = character device (uses cir = >  Z80Fill: 0..32767; case boolean of { Get or Put; true = Get } ll2: 0..1; FlpEndCylinder: boolean; FlpDataMissAddr: b Min5: integer; Max5: integer; Min12: integer; Max12: integer;  - 119 - POS D.6 Interface Module IO_Unit 05 Feb 82  MinMinus12: integer; MaxMinus12: integer; MinVRef: integer; MaxVRef: in true: ( { Get Status } GetRead: Z80Readings; teger; MinNet: integer; MaxNet: integer; MinCRTemp: integer;  GetLimits: Z80Settings );  MaxCRTemp: integer; MinBaseTemp: integer; MaxBaseTemp: integer; Min55: integ false:( { Put Status } PutLimits: Z80Settings er; Max55: integer; Min24: integer; Max24: integer end;  )); Floppy: (case integer of { Get or Put } 1: (  DevStatusBlock = packed record ByteCnt: integer; { # of status bytes } case UnitR { Get Status } FlpUnit: 0..3; FlpHead: 0..1; ng of KeyBoard, Tablet, {$ifc Ether3MBaud then} Ether3, {$endc} FlpNotReady: boolean; FlpEquipChk: boolean;  Clock: (DevEnable: boolean); RS232In, RS232Out: (RSRcvEnable:  FlpSeekEnd: boolean; FlpIntrCode: 0..3; case boolean; RSFill: 0..127; RSSpeed: 0..255; integer of 1 {IORead, IOWrite, IOFormat}: (FlpMissAddr: b RSParity: (NoParity, OddParity, IllegParity, EvenParity); oolean; { in data or header } FlpNotWritable: boolean;  RSStopBits: (Syncr,Stop1,Stop1x5,Stop2); RSXmitBits: (Send5,Send7,Send6,Send8);  FlpNoData: boolean; FlpFill1: 0..1; FlpOverrun: boole RSRcvBits: (Rcv5,Rcv7,Rcv6,Rcv8)); Z80Monitor: (Z80Enable: boolean; an; FlpDataError: boolean; { in data or header } FlpFi> ?  ); 3: ( { Byte access } FlpByte1 { and return status: } { IOB buffer full }: 0..255; FlpByte2: 0..255; FlpByte3: 0..255;  { IOC character sent } Procedure UnitIO(Unit: UnitRng;  FlpByte4: 0..255; FlpByte5: 0..255;  { IO to block structured } Bufr: IOBufPtr; { devices } Command: IOCommand FlpByte6: 0..255; FlpByte7: 0..255 ) s; ByteCnt: integer; LogAdr: double; HdPtr: IOHeadPtr; Soolean; { in data } FlpBadCylinder: boolean; FlpFill3: ) - 120 - POS D.6 Interface Module IO_Unit 05 0..3; FlpWrongCylinder: boolean; FlpDataDataError: bo Feb 82 end; Type IOCommands = (IOReset, IORead, IOWrite, IOSeek, IOFormat, IODiolean; { in data } FlpFill4: 0..3; FlpCylinderByte: agRead, IOWriteFirst, IOIdle, IOWriteEOI, IOConfigure); Var DevTab: DevTabPtr; { pointer to system de0..255; FlpHeadByte: 0..255; FlpSectorByte: vice table } CtrlSPending: boolean; { if ^S has halted screen output } IOInProgress: boolean; 0..255; FlpSizeSectorByte: 0..255 );  { false when speech is active } IO24MByte: boolean; { true if the disk is 24 MBytes } Function IOC 2 {IOSeek}: (FlpPresentCylinder: 0..255 Read(Unit: UnitRng; var Ch: char): integer; { read a character from a }  ) ); 2: ( { Put Status }  { character device and return } { status: IOB no  FlpDensity: 0..255; { single = 0, double = #100 } char available } { IOC character returned } Function IOCWrite(Unit: UnitRn FlpHeads: 0..255; { 1 or 2 heads } FlpEnable: boolean g; Ch: char): integer; { write Ch to character device } ? @ rt(Promiscuous, Restart: boolean) : integer; {$endc} - 121 - POS D.6 Interface block that was given to UnitIO when the operation was initiated. Function IOBusy( var Stats: IOSta Module IO_Unit 05 Feb 82 tus): boolean; Abstract: Determines whether or not I/O is complete. Parameters: St - 122 - POS D.6 Interface ats - Status block that was given to UnitIO when the operation was initiated. Returns:  Module IO_Unit 05 Feb 82 Function IOCRead(Unit: UnitRng; var Ch: char): integer; Abstract:  True if IO is not complete, false if it is. Procedure IOPutStatus( Unit: UnitRng; var StatBlk:DevStatusBlock );  Reads a character from a character device and returns a completion or error code. Parameters:  Abstract: Sets device's characteristics. Has no effect if the device has no settable status.  Unit - device from which to read the character. Ch - character to read. Returns:  Parameters: Unit - device whose characteristics are to be set. StatBlk - block containing chaA condition code as defined in the module IOErrors. Function IOCWrite( Unit: UnitRng; Ch: char):integer; Abstraracteristics to be set. Procedure IOGetStatus( Unit: UnitRng; var StatBlk:DevStatusBlock ); Abstract: tsPtr: IOStatPtr); Procedure IOWait(var Stats: IOStatus); { hang until I/O completes } Function IOBusy(var Stats: Ict: Writes a character to a character device and returns a completion or error code. Delays if tOStatus): boolean; { true if I/O not complete } Procedure IOPutStatus(Unit: UnitRng; var StatBlk: DevStatusBlock); he buffer is full. Returns an error if the condition doesn't clear up. Parameters: Unit - d { Set status on device Unit } Procedure IOGetStatus(Unit: UnitRng; var StatBlk: DevStatusBlocevice onto which the character will be written. Ch - character to write. Returns: Condition k); { Reads status on device Unit } Procedure IOBeep; { code as defined by the module IOErrors. Procedure IOWait( var Stats: IOStatus ); Abstract: Hangs You guessed it, BEEP! } {$ifc Ether3MBaud then} Function Ether3Transmit(Buff: IOBufPtr; WdCnt: integer) : integer; Func until an IO operation inititated by UnitIO is complete. - 123 - tion Ether3Receive(Buff: IOBufPtr; var WdCnt: integer; timeout: integer) : integer; Function Ether3Sta POS D.6 Interface Module IO_Unit 05 Feb 82 Parameters: Stats - Status@ A ed. Procedure UnitIO( Unit: UnitRng; Bufr: IOBufPtr; Command: IOCommands; ByteCnt: integer; LogAdr: double; Hdmes Function Ether3Transmit( Buff: IOBufPtr; WdCnt: integer): integer; Abstract: Transmit data to the 3 MBaud EPtr: IOHeadPtr; StsPtr: IOStatPtr ); Abstract: IO to non-character devices. Parameters:therNet (?). Returns: IOEIOC if successful IOEBSE if WdCnt > 512 < -16000 hard status, if transmit fails 10 Unit - the device. Bufr - buffer for data transfers, if requested. Command - operation t times procedure IOBeep; Abstract: Causes the PERQ to beep. o be performed on the device. ByteCnt - number of bytes to be transferred. LogAdr - logical address fo - 126 - POS D.6 Interface module Lights 05 r block structured devices. HdPtr - pointer to the logical header for operations with the hard dFeb 82 module Lights; Lights - Perq Lights. J. P. Strait 26 May 81. Copyright (C) Three Rivers Computer Corporationisk. StsPtr - resultant status from the operation. function Ether3Start( promiscuous, restart: boolean): int, 1981 Abstract: This module defines the screen coordinates and size of the Perq "lights". These are portions eger; Abstract: Restart the 3 MBaud EtherNet (?). Parameters: if promiscuous is TRUE, Ether3Receive takes of the screen that are inverted during tedious operations such as recalibrating the disk and scavenging filpackets for any address. if restart is TRUE, the receiver will be kept active at all times. Res (in FileAccess). Design: The lights must *not* extend below the 128th line of the screen. The Y + Size must beturns: Ether address of this machine. - 125 - POS D.6 Interface e less than or equal to 256. It is a good idea for the lights to be totally inside of the title line. The current Module IO_Unit 05 Feb 82 function Ether3Receive( Buff: IOBufPtr; var WdCnt: integer; timeout:  lights start at the left leave lots of room for new lights to the right of the current one. There is room for 10  Reads device status. Has no effect if the device has no readable status.  integer): integer; Abstract: Receive data from the 3 MBaud EtherNet (?). Returns: IOEIOC if successful, W - 124 - POS D.6 Interface Module IO_Unit 05 Feb 82 Parameters: dCnt := size of received packet in words IOEBSE if WdCnt > 512 IOEPTL if a packet > WdCnt is received I Unit - device whose characteristics are to be read. StatBlk - block to which device status is to be returnOETIM if timeout expires (receiver is still active) < -16000 hardware status, if receive fails 20 tiA B  lights all together Version Number V1.2 exports const LightUsed = TRUE; {whether should use the light the loader which returns to its caller. Parameters: RunFileName - Name of the .RUN files at all} LightY = 3; LightHeight = 14; LightWidth = 18; LightSpacing = 3 to load. ".RUN" is appended if it is not already present. *LightWidth; LightRecalibrate = LightSpacing; LightScavenge = LightRecalibrate + LightWidth + LightSpacing;  - 129 - POS D.6 Interface  LightSwap = LightScavenge + LightWidth + LightSpacing; LightCompiler = LightSwap + LightWidth + LightSpac module Memory 05 Feb 82 module Memory; Memory - Perq memory manager. J. P. Strait 1 Jan 80. Copyrighing; - 127 - POS D.6 Interface t (C) Three Rivers Computer Corporation, 1980. Abstract: Memory is the Perq memory manager. It supervises the segm module Loader 05 Feb 82 module Loader; Loader - Perq system loader. J. P. Strait 10 Feb 81. rewent tables and exports procedures for manipulating memory segments. Perq physical memory is segmented into separitten as a module. Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: This module implements the Perq rately addressable items (called segments) which may contain either code or data. Design: See the Q-Code referenc POS system loader. Given a run-file name as input, it loads and executes that program. When the program termie manual. Version Number V2.13 exports const MemoryVersion = '2.13'; imports SystemDefs from SystemDefs; imports nates (normally or abnormally) it returns to the loader which returns to its caller. Version Number V2.7 exports Code from Code; const SATSeg = 1; { SAT segment } SITSeg = 2; { SIT segement } Font const LoaderVersion = '2.7'; procedure Load( RunFileName: String ); Seg = 3; { font segment } ScreenSeg = 4; { screen segment } CursorSeg = 5; { curso - 128 - POS D.6 Interface module Loar segment } IOSeg = 6; { IO segment } SysNameSeg = 7; { system segment names } Booder 05 Feb 82 procedure Load( RunFileName: String ); Abstract: Given a run-file name as input, this procedure ltedMemoryInBlocks = #1000; { memory in blocks at boot time } MaxSegment = #137; { should be 2**16 - 1 } oads and executes that program. When the program terminates (normally or abnormally) it returns to SetStkBase = #60; SetStkLimit = #120; {$ifc Ether3MBaud then} IOSegSize = 6; { number of blocks in tB C teger) end; pMMArray = ^MMArray; MMPointer = record case integer of 1: (P: ^integer);  DiskUpperAddress: Integer; DiskId: Integer) end;  2: (B: pMMBlockArray); 3: (M: pMMArray); 4: (Offset: MMAddress; Segmen: SegmentNumber) end; case SegmentKind of DataSegment: (Increment : MMIntSize; Maximum : MMIntSize;  SATentry = packed record { Segment Address Table } { **** ENTRIES MUST BE TWO WORDS LONG **** } NotReside Freelist : MMAddress); CodeSegment: (Update : TimeStamp) ); 2: { boohe IOSeg } {$elsec} {$ifc Ether10MBaud then} IOSegSize = 3; { number of blocks in the IOSeg } {$elsec} nt : boolean; { 001 } Moving : boolean; { 002 } RecentlyUsed: boolean; { 004 IOSegSize = 3; { number of blocks in the IOSeg } {$endc} {$endc} SysSegLength = 8; { length of name } Sharable : boolean; { 010 } Kind : SegmentKind; { 020 } Full : boolea of a boot-loaded segment } MMMaxBlocks = #400; { maximum number of blocks in a segment } MMMaxCount = #377n; { 040 } InUse : boolean; { 100 } Lost : boolean; { *** } { 200 } B; MMMaxIntSize = MMMaxBlocks-1; MMMaxExtSize = MMMaxBlocks; - 130 - POSaseLower : MMBit8; BaseUpper : MMBit4; Size : MMBit12 end;  D.6 Interface module Memory 05 Feb 82 type MMBit4 = 0..#17; MMBit8 = 0..#377;  - 131 - POS D.6 Interface module Memory 05 Feb 82 SITentry = packed record case  MMBit12 = 0..#7777; MMIntSize = 0..MMMaxIntSize; MMExtSize = 1..MMMaxExtSize; MMAddress = integer; Minteger of { Segment Information Table } { **** ENTRIES MUST BE EIGHT WORDS LONG **** } 1: { real SIT entry } MPosition = (MMLowPos, MMHighPos); SegmentNumber = integer; SegmentKind = (CodeSegment, DataSegment); Se (NextSeg : SegmentNumber; RefCount : 0..MMMaxCount; IOCount : 0..MMMaxCount; MobigmentMobility = (UnMovable, UnSwappable, LessSwappable, Swappable); MMFreeNode = record N: MMAddress; L: ility : SegmentMobility; BootLoaded : Boolean; SwapInfo : record case {BootLoaded:} Boolean of nteger end; MMBlockArray = array[0..0] of array[0..127] of integer; pMMBlockArray = ^MMBlockArray;  True: (BootLowerAddress: Integer; BootUpperAddress: Integer;  MMArray = record case Integer of 1: (m: array[0..0] of MMFreeNode); 2: (w: array[0..0] of In BootLogBlock: Integer); False: (DiskLowerAddress: Integer; C D  pSysNames = ^SysNameArray; SysNameArray = array[0..0] of SysSegName; procedure InitMemory;  Abstract: NotDataSegment is raised when the number of a code segment is passed to s - 132 - POS D.6 Interface module Memory 05 Feb 82 procedure DataSeg( vaome memory manager routine that requires the number of a data segment. Parameters: S -r S: SegmentNumber ); procedure CodeOrDataSeg( var S: SegmentNumber ); procedure ChangeSize( S: SegmentNumber; Fsize: MMExtSiz Segment number of the code segment. exception BadSize( S: SegmentNumber; Fsize: Integer ); e ); procedure CreateSegment( var S: SegmentNumber; Fsize, Fincrement, Fmaximum: MMExtSize ); proce - 133 - POS D.6 Interface module Memory 05 Feb 82 Abstract: dure IncRefCount( S: SegmentNumber ); procedure SetMobility( S: SegmentNumber; M: SegmentMobility ); procedure DecRefCount( S: BadSize is raised when a bad Size value is passed to some memory manager routine. This usually SegmentNumber ); procedure SetIncrement( S: SegmentNumber; V: MMExtSize ); procedure SetMaximum( S: SegmentNumber; V: MMExtSi means that the size passed to CreateSegment or ChangeSize is greater than the maximum st time information } (BootBlock: record CS: SegmentNumber; { initial code segment } SS: Seze ); procedure SetSharable( S: SegmentNumber; V: boolean ); procedure SetKind( S: SegmentNumber; V: SegmentKind ); proceduregmentNumber; { initial stack segment } XX: Integer; { unused } VN: Integer; { sy MarkMemory; procedure CleanUpMemory; procedure FindCodeSegment( var S: SegmentNumber; Hint: SegHint ); procedure EnableSwappstem version number } FF: SegmentNumber; { first free segment number } FC: SegmentNumber; { firsing( Where: Integer ); procedure DisableSwapping; function CurrentSegment: SegmentNumber; exception UnusedSegment( S: Segmt system code segment } DK: integer; { disk system was booted from } CH: integer { entNumber ); Abstract: UnusedSegment is raised when the memory manager encountchar used in booting } end) end; SATarray = array[0..0] of SATentry; SITarray = array[0..0] oers a segment number which references a segment which is not in use. This may mean that a bad segment f SITentry; pSAT = ^SATarray; pSIT = ^SITarray; MMEdge = record H: SegmentNumber; { Head  number was passed to some memory manager routine or that a bad address was de-referenced. } T: SegmentNumber { Tail } end; SysSegName = packed array[1..SysSegLength] of Char;  Parameters: S - Segment number of the unused segment. exception NotDataSegment( S: SegmentNumber ); D E ent value. exception BadMaximum( S: SegmentNumber; Fmaximum: Integer ); Abstract: BadMaximum is found for a segment which is marked as swapped out. This is an error which should never happen in  raised when a bad Maximum value is passed to some memory manager routine. This usually means a debugged system. It usually means that there is a bug in the memory manager or that the segm that the maximum passed to CreateSegment is greater than 256 or less than one. Parameters: ent tables have been clobbered. Parameters: S - The number of the segment whi Fmaximum - The bad Maximum value. exception FullMemory; Abstract: FullMemory is rach could not be swapped in. exception EdgeFailure; Abstract: EdgeFailure is rised when there is not enough physical memory to satisfy some memory manager request. This is raised by MakeEdge when it discovers that the SIT entries are not linked together into a ciaised only after swapping segments out and compacting memory. exception CantMoveSegment( S: SegmentNumbercular list. This is an error which should never happen in a debugged system. It usually means that r ); - 134 - POS D.6 Interface module Memory 05 F there is a bug in the memory manager or that the segment tables have been clobbered. eb 82 Abstract: CantMoveSegment is raised when the memory manager attempts to move exception NilPointer; - 135 - POS D.6 Interface m a segment which is UnMovable or has a non-zero IO count. Parameters: S - The number odule Memory 05 Feb 82 Abstract: NilPointer is raised when a Nil pointer is used or ize or less than one. Parameters: Fsize - The bad Size value. exception BadIncrement( S: Segmenof the segment which cannot be moved. exception PartNotMounted; Abstract: PartNotMounted is raitNumber; Fincrement: Integer ); Abstract: BadIncrement is raised when a bad Increment value is sed when 1) the memory manager attempts to swap a data segment out for the first time and  passed to some memory manager routine. This usually means that the increment passed to Creat 2) the partition which is to be used for swapping is no longer mounted. exception SwapInFailureeSegment is greater than 256 or less than one. Parameters: Fincrement - The bad Increm( S: SegmentNumber ); Abstract: SwapInFailure is raised when the swap file cannot be E F  is passed to Dispose. Parameters: exception FullSegment; Abstract: F - 137 - ullSegment is raised by New when it discovers that there is not enough room to allocate and the segment POS D.6 Interface module Memory 05 Feb 82 procedure InitMemory; Abstract: InitMemor cannot be enlarged (its size has reached its maximum). exception NoFreeSegments; Abstract: y initializes the memory manager. It is called once at system initialization and may not be called  NoFreeSegments is raised when the memory manager discovers that all of the segment numbers  again. If the system was booted from a floppy, the system segments are all marked as UnSwappable. proceduare in use and it needs another one. This is equivalent to "Segment table full". re DataSeg( var S: SegmentNumber ); Abstract: DataSeg is used to 1) - Determine if a given segment numberexception SwapError; Abstract: SwapError is raised if the one of the memory managers  represents a data segment. 2) - Find the default heap segment (in the case of an input  swapping routines is called when swapping is disabled. This is an error which should never happen in a parameter of zero). Parameters: S - Data segment number--zero means the default heap  debugged system. It usually means that there is a bug in the memory manager. var S segment. Errors: UnusedSegment - if S is not in use. NotDataSegment - if S is not a dataAT: pSAT; SIT: pSIT; MMFirst, MMFree, MMLast, MMHeap: SegmentNumber; - 136 -  segment. procedure CodeOrDataSeg( var S: SegmentNumber ); Abstract: CodeOrDataSeg is used to 1) - D POS D.6 Interface module Memory 05 Feb 82 MMHole: MMEdge; MMState: (MMScan1, MMScaetermine if a given segment number represents a defined segment 2) - Find the default heap sen2, MMScan3, MMScan4, MMScan5, MMScan6, MMScan7, MMScan8, MMScan9, MMScan10, MMScan11, gment (in the case of an input parameter of zero). Parameters: S - Data segment number--z MMNotFound, MMFound); StackSegment: SegmentNumber; FirstSystemSeg: SegmentNumber; BootFileId: Integer; Sero means the default heap segment. Errors: UnusedSegment if S is not in use.  passed to Dispose. exception BadPointer; Abstract: BadPointer is raised when a bad pointerwappingAllowed: Boolean; SwapId: Integer; MemoryInBlocks: Integer; { amount of memory on this machine } F G - if Fincrement is greater than MMMaxExtSize or less than one. BadMaximum - if Fmaximum is greater ts mobility to Swappable (even if it already swappable). Parameters: S - Segment number.  than MMMaxExtSize or less than one. FullMemory - if there is not enough physical memory to  M - Mobility. Errors: UnusedSegment - if S is not in use. CantMoveSegment - if the se - 138 - POS D.6 Interface module Memory 05 Feb 82  create the segment. - 139 - POS D.6 Interface  procedure ChangeSize( S: SegmentNumber; Fsize: MMExtSize ); Abstract: ChangeSize is used to change the size of an  module Memory 05 Feb 82 procedure IncRefCount( S: SegmentNumber ); Abstract: IncRefCounexisting data segment. Parameters: S - Number of the segment whose size is to be changed. t increments the number of references to a segment. A non-zero reference count prevents a segment Fsize - New size of the segment. Errors: UnusedSegment - if S is not in use. BadSize - if from being destroyed. A reference count greater than one indicates a system segment. Fsize is greater than the maximum size of S or less than one. FullMemory - if there is not eno Parameters: S - Number of the segment. Errors: UnusedSegment if S is not in use. proceduugh physical memory to increase the size of S. CantMoveSegment - if the segment must be moved, but re SetMobility( S: SegmentNumber; M: SegmentMobility ); Abstract: SetMobility sets the Mobility of a segment. it is not movable or its IOCount is not zero. procedure CreateSegment( var S: SegmentNumber; Fsize,The mobility may be set to one of the following values: Swappable - segment is a candidate for sw Fincrement, Fmaximum: MMExtSize ); Abstract: CreateSegment is used to create a new data segment. Paraapping or moving. LessSwappable - segment is a candidate for swapping or movinmeters: S - Set to the number of the new segment. Fsize - Desired size of the new segment in blocks. g, but the memory manager will be more reluctant to swap. UnSwappable - segment may not be  Fincrement - Increment size of the new segment in blocks. Fmaximum - Maximum size of the new segment. swapped, but may be moved. UnMovable - segment may not be swapped or moved. The  Errors: BadSize - if Fsize is greater than Fmaximum or less than one. BadIncrement  RecentlyUsed bit of the segment is cleared also. Thus to make a segment a candidate for swapping, set iG H gment if S is not in use. procedure SetIncrement( S: SegmentNumber; V: MMExtSize ); Abstract: SetIncrement chaNew kind of the segment. Errors: UnusedSegment - if S is not in use. procedure MarkMemory; nges the increment size of a data segment. Parameters: S - Number of the segment.  Abstract: MarkMemory marks all currently in use segments as system segments usually before loading a user  V - New increment size. Errors: UnusedSegment - if S is not in use. NotDataSegment - if S iprogram) by incrementing their reference counts. procedure CleanUpMemory; Abstract: CleanUpMemory des not a data segment. BadIncrement - if V is greater than MMMaxExtSize or less than one. pstroys all user segments (usually at the end of a program execution) by deecrementing the referrocedure SetMaximum( S: SegmentNumber; V: MMExtSize ); Abstract: SetMaximum changes the maximum size of a data segmentence count of all segments. - 142 - POS D.6 Interface gment is changing from Swappable to UnMovabl an attempt is made to move the segment to the hig. Parameters: S - Number of the segment. V - New maximum size. Errors: Unush end of memory. If it has a non-zero IO count, or swapping is disabled, this error is issued. FullMedSegment - if S is not in use. NotDataSegment - if S is not a data segment. BadMaximum - if V is greatemory - if the segment is changing from Swappable to UnSwappable, it is swapped out, and there isn't enough er than MMMaxExtSize or less than one. - 141 - POS D.6 Interface  memory to swap it in. - 140 - POS D.6 Interface  module Memory 05 Feb 82 procedure SetSharable( S: SegmentNumber; V: boolean ); Abst module Memory 05 Feb 82 procedure DecRefCount( S: SegmentNumber ); Abstract: DecRefCount decract: SetSharable changes the "sharable" attribute of a segment (this attribute is not currently used). rements the reference count of a segment by one. If reference and IO counts both become zero: - if the se Parameters: S - Number of the segment. V - New value of the "sharable" attribute. Errors: gment is a data segment, it is destroyed. - if the segment is a code segment, it is destroyed only if  UnusedSegment - if S is not in use. procedure SetKind( S: SegmentNumber; V: SegmentKind ); Abstract: S it is in the screen or is non-resident. Parameters: S - Number of the segment. Errors: UnusedSeetKind changes the kind (code or data) of a segment. Parameters: S - Number of the segment. V - H I swapping is not disabled. Errors: FullMemory - if there isn't enough memory to swap all he caller of CurrentSegment.  segments in. procedure FindCodeSegment( var S: SegmentNumber; Hint: SegHint ); Abstract: FindCodeSegment  - 144 - POS D.6 Interface module MoveMem searches for a code segment in the segment table which has a certain SegHint. If such a segment05 Feb 82 module MoveMem; MoveMem - Move memory. J. P. Strait ca. 1 Jan 80. Copyright (C) Three Rivers Computer C is found, its RefCount is incremented and the segment number is returned. Otherwise, a zero segment orporation, 1980, 1981. Abstract: MoveMem is used to move a segment from one location to another in physical memo number is returned. Segments which 1) Have a DiskId equal to Hint.FId, 2) Have an Update datery. The two locations may overlap. Version Number V1.8 exports imports Memory from Memory; procedure CopySegment /time not equal to Hint.Update, and 3) Have a RefCount of zero are deleted. This is done because such a  ( SrcSeg, DstSeg: SegmentNumber; NewDstBase: Integer );  segments reference code files which have been overwritten and are no longer valid. Such segments will not g - 145 - POS D.6 Interface module Movet the memory manager into trouble, but they will never be used again, and it is just as well to get reMem 05 Feb 82 procedure CopySegment( SrcSeg, DstSeg: SegmentNumber; NewDstBase: Integer ); Abstract: C module Memory 05 Feb 82 procedure EnableSwapping( Where: Integer ); Abstract: EnableSwapping turnsid of them. **** Hint must be a valid hint. That is, the file specified **** by Hint.FId must have  the swapping system on, determines where swap files should be created, and locates the boot file.  a FileWriteDate equal to Hint.Update. Parameters: S - Return parameter set to zero or the Parameters: Where - FileId of some file in the partition to be used for swap files. pr number of the code segment. Hint - Desired SegHint. - 143 - ocedure DisableSwapping; Abstract: DisableSwapping attempts to swap in all segments which are swapped out  POS D.6 Interface module Memory 05 Feb 82 function CurrentSegment: SegmentNumber; and then turns the swapping system off. If there is not enough physical memory to swap all segments in,  Abstract: CurrentSegment finds the segment number of its caller. Result: CurrentSegment = Segment number of tI J mber of the segment which represents the destination address. NewDstBase - New value of the bare to read a file very quickly into memory. The memory for the blocks of the file to be read must be allocated conse address for DstSeg. Result: Base address of SrcSeg - set to the old base address of DstStiguously before the call is made. Typically, this will be done by using CreateSegment. Version Number V1.0 {///////eg. Base address of DstSeg - set the NewDstBase. Design: CopySegment moves segments without swapp///////////////////} EXPORTS {\\\\\\\\\\\\\\\\\\\\\\\\\\} Imports FileSystem from FileSystem; Procedure MultiRead ing them, and is designed in such a way that it may move itself or its own stack. In order to be able (fid: FileID; addr: pDirBlk; firstBlock,numBlocks: integer);  to do this, CopySegment is in a code segment by itself so that any call is guaranteed to be a cross-seg - 147 - POS D.6 Interface Module MultiRead ment call. Thus when the move operation is complete, a cross segment return is done, and the CodeBase  05 Feb 82 Procedure MultiRead(fid: FileID; addr: pDirBlk; firstBlock,numBlocks: integer); Abstract: Does a mu micro-code register is reloaded. Movemem executes a special StartIO instruction to cause the micro-code to rellti-sector read on the file specified into the memory pointed to by addr NOTE: This only works for oad its StackBase register. This code segment must never exceed 256 words in length so that when CopySeg contiguous files. Parameters: fid - the fileID of the file to read from. addr - the address of the startment moves itself, the new copy cannot overlap the old one. CopySegment uses RasterOp to copy the me of the memory to read the file into. This must be pre-allocated. firstBlock - the logical block nummory in order that the copy be done as an indivisible operation. DO NOT CHANGE this routine unless you fber of the first to read (the first legal value is 0; -1 will not work). numBlocks - the count of tully understand the entire system. - 146he number of blocks to transfer. opySegment is used to move a segment from one location to another in physical memory. Parameters:  - POS D.6 Interface Module MultiRead 05 Feb 82 Module MultiRead; Written by Bra SrcSeg - Number of the segment which represents the source address and source size. DstSeg - Nud Myers 24 Jul 81. Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: This Module exports a proceduJ K t plus or minus sign, X is read as an unsigned number. Errors: PastEof -if an attempt isriations on Read, Readln, Write and Writeln statements. It is one level above Module Stream and uses Stre - 148 - POS D.6 Interface module PasLong 05 Feb 82 module P made to read F past the Eof. NotNumber - if non-numeric input is encountered in the file. LargeNumber - asLong; PasLong - Extra stream package input conversion routines. J. P. Strait & Michael R. Kristofic ca. 15 Sep 81.  if the number is not in the range -2^31..2^32-1. BadBase - if the base is not in 2..36.  Copyright (C) Three Rivers Computer Corporation, 1981. Abstract: PasLong is the extra character input module of Design: Number is read into the low order word of two double precision integers to avoid overflow.  the Stream package. Its routines are called by code generated by the Pascal compiler in response to variation procedure WriteD( var F: FileType; X: long; Field, B: integer ); Abstract: Writes an double integer in fixed formats on Read, Readln, Write and Writeln statements. It is one level above Module Stream and uses Stream's lower-level  with base B. Parameters: X - the double to be written. F - the file into which X is to be writtinput routines. Version Number V2.2 exports imports Stream from Stream; procedure ReadD( var F: FileType; var X: len. Field - the size of the field into which X is to be written. B - the base of X. It is an integer wong; B: integer ); procedure WriteD( var F: FileType; X : long; Field, B: integer ); hose absolute value must be between 2 and 36, inclusive. If B is less than zero, X is written a - 149 - POS D.6 Interface modus an unsigned number. Errors: BadBase -if the base is not in 2..36. Design: Value written frole PasLong 05 Feb 82 procedure ReadD( var F: FileType; var X: long; B: integer ); Abstract: Reads an double integem two double precision words to avoid overflow. - 150 - POS D.r in free format with base B. B may be any integer between 2 and 36, inclusive. Parameters: X 6 Interface module PasReal 05 Feb 82 module PasReal; PasReal - Scott L. Brown Crea- the double to be read. F - the file from which X is to be read. B - the base of X. It may be any integted: 25-Nov-81 Copyright (C) 1981 - Three Rivers Computer Corporation Abstract: PasReal is an extra character input er between 2 and 36, inclusive. If B is less than zero and the user does not type an explicimodule of the Stream package. Its routines are called by code generated by the Pascal compiler in response to vaK L read from the file F. Results: This procedure modifies the file buffer for F, and stores thn for real numbers is described by a DFA and implemented by a case statement, where each element of thee value of the real number in value. Side Effects: This procedure reads characters from the external f case statement corresponds to a state in the DFA. This case statement stores information about the number read ile F, until it receives a character which cannot be part of the real number, and it leaves this  into (primarily) three variables: 1) mant - the mantissa of the number read (up to 2**24-1), 2) scale_fcharacter in the file buffer. There has been only minimal care taken with the file buffer, sactor - any adjustment to the mantissa (as a power of ten), and 3) exp - the exponent of the number readam's lower-level input routines. Version Number V0.1 exports imports Stream from Stream; procedure ReadR(var F: Fo if an exception is raised during the read, there is no guarantee about its contents. Exceptions: ileType; var value: real); procedure WriteR(var F: FileType; e: real;  PastEof - raised if an attempt is made to read beyond the end of file. NotReal - raised TotalWidth: integer; FracDigits: integer; format: integer);  if the stream of characters in file F does not correspond to a real number. SmallReal - raised if  - 151 - POS D.6 Interface the number read is too small to be represented by a 32-bit IEEE-Standard real number. LargeReal module PasReal 05 Feb 82  - raised if the number read is too large to be represented by a 32-bit IEEE-Standard real number.  - 152 - POS D.6 Interface mod Calls: StreamName - in module Stream for the stream name of file F. GetC - in module Stream for readule PasReal 05 Feb 82 procedure ReadR(var F: FileType; var value: real); Abstract: This procedure ring the next character from - 153 - POS D.6 Interface eads a real number from the file F, and returns its value. Parameters: F - identifies themodule PasReal 05 Feb 82 file F. RealMul TenPower - returns a real number repr file from which to read. value - is a return parameter returning the value of the real number esenting 10.0 raised to an integer (range -37..38) power. Design: The regular expressioL