IMD 1.18: 21/01/2023 0:00:41 PRQ-SFT-CND-5 3RCC PERQ SYSTEM D.5 IO SOURCE DISTRIBUTION FLOPPY Copyright (C) Three Rivers Computer Corporation, 1981 single density, double sided D.5 Group name Command file OS.IO.SOURCE SRC.CMD   Jw ;diHp};diH :_s;di:]s;di0:;di:E~;di:X;di@ :q;d)i0:X;di &Q";d i&;di{7F;d!i ,<^;diH Iq;di&;diP&k  ;di f};di`&";d i&y";di yi %iw}w$Hw!}2"jXq0ɜ9z iow M d;dRQPETh~;di x8YR)`I;dMi+it!;d`jf&x io;d iowi i  *********************************} { Version 3.9 26-Jun-81 Brad A. Myers Export all internal procedures CurOn; fixed dot in lower-right corner Version 3.1 19-feb-81 Brad A. Myers BS used by SPutChr for XSPutChr Add new procedure for w to previous line added; restrict number of chars printed on line to indow change to full size. Fixed bug wh 255; Version 3.0 18-feb-81 Brad A. Myers Added Window relative RasterOp and en ask for current window size. Fixed b Line routines; changed windows to be a list rather that ug in SSetSize. Version 3.8 23-May-81 John P. Strait Use IOKeyDisable in ChangeTitle. Version 3.7 13-May-81 Brad A. record; changed module name; added extra Myers Added new exceptions Version 3.6 17-Mar-81 Brad A. Myers Changed SClearChar and SBackSpace to  scan line to title and margin below; changed to separate CR-LF Version 2.2 9- take a char; made name compatible Version 3.5 3-Mar-81 Brad A. Myers Removed BS special char and added SBackSpace and SClearChar procedures  Removed SRasterOp and SLine and SIsCurOn; SCursorOn  vble exported Version 3.4 24-feb-81 Brad A. Myers Added return param to GetWindowParms Module Screen; {***************************************************************} { Perq Screen Driver  to tell HasTitle; Version 3.3 24-feb-81 Brad A. Myers Added param to SSetSize to leave  } { Written By: Miles A. Barel July 1, 1980 } { Three Rivers Computer C screen displayed Version 3.2 20-feb-81 Brad A. Myers Changed to have a fixed number oorporation } { Pittsburgh, PA 15213 } {******************************f windows; added refresh command and SIs   If false then there are 17 windows max, and storage is in screens global data.  winCrsChr: char; winHasTitle, winCursorOn, defined: boolean; {$ifc VarWin then} NOTE: There are still bugs in VarWin true} Type FontPtr = ^Font; Font = Packed Record { Contains  winNext: WindowP; {$endc} end; {$ifc VarWin then} Const MaxWIndx = 32767; character sets } Height:integer; { Height of the KSet } Base: integer; { distance from top of {$elsec} Const MaxWIndx = 17; {$endc} Type WinRange = 0..MaxWIndx; LineStyle = (DrawLine,EraseLine,X characters to base-line } Index: Array [0..#177] of { Index into character patterns } PacorLine); LS = String[255]; Procedure ScreenInit; { CALL THIS ONCE AT BOOT } Procedure ScreenResked Record case boolean of true: (Offset: 0..767; { position of character in patterns } et; { This procedure de-allocates storage for all windows and sets up the default wi Line: 0..63; { Line of patterns containing char } Width: integer); { Width of the character ndow. } Procedure SPutChr(CH:char); { put character CH out to current position } { on the } false:(Loc:integer; Widd: integer) end; Filler: array[0..1] of iscreen. Chars FF, CR, and LF } { have special meanings unless #200 bit set: } nteger; Pat: Array [0..0] of integer; { patterns go here } { We turn  { FF - clear screen { CR - move left to margine off range checking to } { access patterns, hence allowing }  { LF - move vertically down one { BS - erase previouFeb-81 Brad A. Myers fixed broken screen size; make screen export SScreenP and SSc { KSets of different sizes } end; {$ifc VarWin then} WindowP = ^WindowType; {$endc} WreenW Version 2.1 14-Jan-81 Brad A. Myers fixed cursor bug Version 1.0 1-Jul-80 Miles A. Barel started } ExpoindowType = Packed Record {$ifc VarWin then} winNumber: Integer; {this window number} {$endc} rts Imports Raster from Raster; Const ScreenVersion = 'V3.9'; VarWin = false; {if true then can have an arbitr winBY, winTY, winLX, winRX, { Limits of window area } winHX, winHY, winMX, winMY, {ary number of windows and storage for them has to be allocated off a heap.  Limits of useable area } winCurX, winCurY, winFunc: integer; winKSet: FontPtr;   ;{ Read Cursor Position } Procedure SCurOn; { Enable display of Cursor } Procedure SCurOff; tion WBadSize; {parameter to SSetSize bad} {----------------------------------------------------------------------------- Abs { Disable display of Cursor } Procedure SCurChr(C: char); { Set cursor character } Procedure SChrFunc(F: tract: Raised if the lines parameter to SSetSize is not a multiple of 128 or is <=0. Also raised if a window is totinteger); { Set raster-op function for SPutChr } Procedure SSetSize(Lines: integer; complemented, screenOff: Boolean); ally below area to release so will disappear then if window # 0 or is the current window, then Raises WB { Set Screen Size; lines must be a multiple adSize. -----------------------------------------------------------------------------} Exception BadWNum; {indx is invalid}of 128; screenOff if true turns off display in part below lines  {----------------------------------------------------------------------------- Abstract: Raised if a window number parameter in which case, complemented describes off part of screen } Pr is illegal (not defined or out of range. -------------------------------------------------------------------------ocedure CreateWindow(WIndx: WinRange; OrgX, OrgY, Width, Height: integer; Title: string); Procedure Cha----} Exception WTooBig; {----------------------------------------------------------------------------- Abstract: Raised ingeWindow(WIndx: WinRange); Procedure GetWindowParms(var WIndx: WinRange; var OrgX, OrgY, Width, Height: integer; vaf parameters for new window specify an area that would extend off screen. ----------------------------------------r hasTitle: Boolean); Procedure ChangeTitle(Title: string); Procedure SetFont(NewFont: FontPtr); Function GetFont: FontPtr; -------------------------------------} Procedure StartLine; Procedure ToggleCursor; Procedure NewLine; Procedure SaveLineE Procedure SClearChar(c: Char; funct: Integer); {delete prev char} { c BETTER NOT be CRnd(x: Integer); Procedure SFullWindow; Const SScreenW = 48; {for use when want Screen in RasterOp or Line} Var SScr or LF} Procedure Line(Style: LineStyle; X1, Y1, X2, Y2: integer; Origin: RasterPtr); Procedure SBackSpace(c: Char); {move baceenP: RasterPtr; {for use when want Screen in RasterOp or Line} SCursorOn: boolean; SFunc: integer; { Raster-k over last char of curLine} { c BETTER NOT be CR or LF} Procedure RefreshWindow(WIndx:op function for SPutChr } Private s character } Procedure SSetCursor(X,Y: integer); { Set Cursor Position to X,Y } Procedure SReadCursor(var X,Y: integer) WinRange); {redraws window outline and title area. DOES NOT REDRAW TITLE} Excep  right (C) 1981 - The Three Rivers Computer Corporation ----------------------------------------------------------------} {----k } IOEMHA = -20; { Missing header address mark } IOEDNW = -21; { Device not writable } IOECM------------------------------------------------------------ Versions: V1.2 13-May-81 Brad A. Myers Added new error foM = -22; { Cylinder mis-match } IOESNF = -23; { Sector not found } IOEOVR = -24; { Overrun } r Ether3MBaud errors V1.1 12-May-81 Brad A. Myers Added new errors and First and last V1.0 ??-???-?? ??  Started ----------------------------------------------------------------} Exports Imports SystemDefs from SystemDefs; MODULE Raster; {-------------------------------------------------------------- Support definitions for RasterOp Copyw {using Ether3MBaud} Const IOEIOC = 1; { IO Complete } IOEIOB = 0; { IO Busy } IOEBUN rite (C) 1980 - The Three Rivers Computer Corporation --------------------------------------------------------------} {-----= -1; { Bad Unit Number } IOENBD = -2; { Raw Block IO to this device is not implemented } IOEWRF = ---------------------------------------------------------- Versions: 2-Jun-81 Brad Myers Added comments ??-???-80 ??3; { Write Failure } IOEBSE = -4; { BlockSize Error } IOEILC = -5; { Illegal Command for this d Started --------------------------------------------------------------} EXPORTS Const RRpl = 0; { Revice } IOENHP = -6; { Nil Header Pointer } IOEADR = -7; { Address Error } IOEPHC = -8; aster Op function codes } RNot = 1; RAnd = 2; RAndNot = 3; ROr = 4; ROrNo { Physical Header CRC Error } IOELHC = -9; { Logical Header CRC Error } IOEDAC = -10; { Data CRC Ert = 5; RXor = 6; RXNor = 7; Type RasterPtr = ^RasterArray; {a pointer that can be used as Rror } IOEDNI = -11; { Device Not Idle } IOEUDE = -12; { Undefined Error! } IOENCD = -13; asterOp or Line source and destination } RasterArray = Array[0..0] of integer; { Device is not a character device } IOECBF = -14; { Circular Buffer Full } IOELHS = -15; { Logical HePRIVATE ader SerialNum Mismatch } IOELHB = -16; { Logical Header Logical Block Number Mismatch } IOECOR = -17; Module IOErrors; {---------------------------------------------------------------- I/O System Error Code Definitions Copy { Cylinder Out of Range } IOEDNR = -18; { Device not ready } IOEMDA = -19; { Missing data address mar  Module IOErrMessages; {------------------------------------------------------------ This module exports a procedure to return81 JPS V4.8 Split IO into several modules. 6-May-81 JPS V4.7 1. Use new form of the SetCylinder StartIO.  an error string for a disk error Written by : Brad A. Myers May 12, 1981 Copyright (C) 1981 - Three Rivers Compute 2. Don't bother doing 10 trys in FindSize since only the last result was believed rer Corporation ------------------------------------------------------------} {----------------------------------------------gardless of success or failure. 3. Hang if we cannot figure out the size of-------------- Versions: 13-May-81 Brad A. Myers V1.1 Added Ether3MBaud Ethernet message 12-May-81 Brad A. Myers  the disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. 19-Mar-81 BAM V4.5 Changed name of included moduleV1.0 Created ------------------------------------------------------------} {//////////////////////////} EXPORTS {\\\\\\\\\s to IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHeads and FindSize to agree with V4.3.  IOEUEF = -25; { Undetermined equipment fault } IOESOR = -26; { Sector out of range } IOETIM = -27;\\\\\\\\\\\\\\} Function IOErrString(err: integer): String; {//////////////////////////} PRIVATE {\\\\\\\\\\\\\\\\\\\\\\\} { Time out error } IOEFRS = -28; { Floppy recalibrate done } IOEDRS = -29; { Disk recalibrate don e } IOET0 = -30; { Can't find track zero } {$ifc Ether3MBaud then} IOEPTL = -31; { Ether3 - received packet too large } IOEFirstError = -31; {$elsec} IOEFirstError = -30; {$endc} IOELastError = 0; Module IO; {*******************************************} { { PERQ Raw IO Drivers - Compatibility file. { Written by: Mil Private es A. Barel { Copyright (C) 1980 { Three Rivers Computer Corporation { { Design: { 1) Interrupt routines must *never* cause segment faults. { 2) UnitIO must increment and decrement the IOCount of the segments { which are involved in IO. { 3) Segment faults must *never* happen while interrupts are off. { {*******************************************} {*******************************} Exports {*****************************} Const IOVersion = '4.8'; { 11-May-  ions on Disk Physical block numbers; fixed CursorUpdate to allow partial screen Module IO_Others; {----------------------------------------------------------------------------- { { IO_Others - Miscellaneou display and added procedure IOScreenSize to set a new size. 13-Jan-81 JPS V3.3 Move creatis IO routines. { Miles A. Barel ca. 1 Jan 80. { Copyright (C) 1980, Three Rivers Computer Corporation { { Abstract: { on of the IOSeg to memory manager init. Move $R- to private part. 20-Nov-80 JPS V3.2 Initialize IO_Others exports routines for the Cursor, Table, Screen, Time, and { Keyboard. { {---------------------------------- TabFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt table. Check SystemInitial-------------------------------------------} { 25-Jun-81 JPS V5.5 Add new TabletMode: offTablet which disables the ized for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor and Tablet interface. New  tablet. Make all other TabletModes enable it. Get rid of EnTabUpdate and EnCurUp time procedures. Split into another include file. 10-Oct-80 JPS V2.2 Added support for the diagnostic display (DDdate--go back to disabling and enabling interrupts during tablet and cursor coS). 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the hard disk. 19-Sep-80 DAS de. This means that loading and reading the cursor pattern must use IncIOCount to ensure that the  V2.0 Added code for 24 MByte disks. } Imports IO_Init from IO_Init; Imports IO_Unit from IO_Unit; Imports IO_Others f client's segment is swapped in. 4-Jun-81 JPS V5.4 Export new IOKeyClear procedure. 3-Jun-81  2) Teach the HardDisk timeout code about multi-sector operations. 28-Feb-81 JPS V4.3 Nrom IO_Others; {*******************************} Private {*****************************} procedure Foo; begin endo longer do conversions on Disk Physical block numbers (reinstating changes made in V4.0). 25-Feb-. 81 GGR V4.2 Added setting/reading of DskFill1 in UnitIO. Moved new/dispose of CB from UnitIO to IO.Init. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical block numbers; fixed botCursF bug. Del XXX procedures; Changed to use new screen 9-Feb-81 BAM V4.0 No longer does convers   . 31-Mar-81 GGR V5.1 Added 4-button mouse support. 11-May-81 JPS V5.0 Split IO into several modules.  of the IOSeg to memory manager init. Move $R- to private part. 20-Nov-80 JPS V3.2 Initialize T Removed IOSetTime procedure 6-May-81 JPS V4.7 1. Use new form of the SetCylinder StartIO. abFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt table. Check SystemInitializ 2. Don't bother doing 10 trys in FindSize since only the last result was believed regaed for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor and Tablet interface. New rdless of success or failure. 3. Hang if we cannot figure out the size of t time procedures. Split into another include file. 10-Oct-80 JPS V2.2 Added support for the diagnostic display (DDS)he disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. 19-Mar-81 BAM V4.5 Changed name of included modules . 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the hard disk. 19-Sep-80 DAS Vto IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHeads and FindSize to agree with V4.3. 2.0 Added code for 24 MByte disks. } {*******************************} Exports {*****************************}  2) Teach the HardDisk timeout code about multi-sector operations. 28-Feb-81 JPS V4.3 No Imports SystemDefs from SystemDefs; { tablet/cursor procedures } Type CursFunction = (CTWhite, CTCursorOnly, CTBlalonger do conversions on Disk Physical block numbers (reinstating changes made in V4.0). 25-Feb-81ckHole, CTInvBlackHole, CTNormal, CTInvert, CTCursCompl, CTInvCursCompl); TabletMode = (relTab GGR V4.2 Added setting/reading of DskFill1 in UnitIO. Moved new/dispose of CB from UnitIO to IO.Inilet, scrAbsTablet, tabAbsTablet, offTablet); CursMode = (OffCursor, TrackCursor, IndepCursor); CursorPattern =t. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical block numbers; fixed botCursF bu array[0..63,0..3] of integer; CurPatPtr = ^CursorPattern; Var TabRelX, TabRelY: integer; { tablet relatig. Del XXX procedures; Changed to use new screen 9-Feb-81 BAM V4.0 No longer does conversiove coordinates } TabAbsX, TabAbsY: integer; { tablet absolute coordinates } TabFinger: boolean;  JPS V5.3 Add Virgil headers and comments. 23-May-81 JPS V5.2 Replace enable/disable of control-c processing ns on Disk Physical block numbers; fixed CursorUpdate to allow partial screen  (exported by System) with enable/disable of KeyBoard interrupts (exported by IO_Others)display and added procedure IOScreenSize to set a new size. 13-Jan-81 JPS V3.3 Move creation     sets both tablet and cursor. } Procedure IOSetTabPos (x,y: Integer); { if trackCursor is false { finger on tablet } TabSwitch: boolean; { switch pushed down } TabWhite : boolean; { T, then sets tablet x and y pos. If tracking, then rue if white button down } TabGreen : boolean; { True if green button down } TabBlue : boolean;  sets both tablet and cursor } Procedure IOReadCursPicture(pat: CurPatPtr; var { True if blue button down } TabYellow : boolean; { True if yellow button down } TabMouse : intege px, py: integer); { copies current cursor picture into r; { Actual output from mouse } DefaultCursor: CurPatPtr; { default cursor pattern } Procedure IOLoadCur pat and sets px and py with the offsets for the current cursor } sor(Pat: CurPatPtr; pX, pY: integer); { load user cursor pattern } ProcedureProcedure IOGetTime(var t: double); { Get the double word 60 Hertz time } {Procedure to change screen size} P IOReadTablet(var tabX, tabY: integer); { read tablet coordinates } Procedure IOSetFunction(f: CursFunction); Procedure IOrocedure IOScreenSize(newSize: integer; complement: Boolean); { newSize is number of scSetModeTablet(m: TabletMode); { set the mode to tell what kind of tablet is currentlan lines in new screen; must be a multiple of y in use } Procedure IOCursorMode (m: CursMode); { if track is true, then Tablet  128. Complement tells whether the rest of the screen should be the  coordinates are copied every 1/60th second into the cursor position. if  opposite color from the displayed part } { disable/ indep, then coordinates are changed only by userenable keyboard interrupts } Procedure IOKeyDisable( var OldKeyEnable: Boolean ); Procedure IOKeyEnable( OldKeyEnable: Boo. If off, then no cursor displayed } Procedure IOSetCursorPos(x,y: Integer); { lean ); { clear the IO type-ahead buffer } Procedure IOKeyClear; {*******************************} Private {*****if trackCursor is false, then sets cursor x and y pos. If tracking, then ************************}     the last result was believed regardless of success or failure. 3. Haninterface. New time procedures. Split into another include file. 10-Oct-80 JPS V2.2 Added sg if we cannot figure out the size of the disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. 19-Mar-81 BAM upport for the diagnostic display (DDS). 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the V4.5 Changed name of included modules to IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHeads and FindSize to hard disk. 19-Sep-80 DAS V2.0 Added code for 24 MByte disks. } {*******************************} Exports  agree with V4.3. 2) Teach the HardDisk timeout code about multi-sector ope {*****************************} Imports SystemDefs from SystemDefs; Const { Device Code Assignments } Module IO_Unit; {----------------------------------------------------------------------------- { { IO_Unit - Unit IO routinesrations. 28-Feb-81 JPS V4.3 No longer do conversions on Disk Physical block numbers (reinstatin. { Miles A. Barel ca. 1 Jan 80. { Copyright (C) 1980, Three Rivers Computer Corporation { { Abstract: { IO_Unit expg changes made in V4.0). 25-Feb-81 GGR V4.2 Added setting/reading of DskFill1 in UnitIO. Moved orts procedures to perform IO on the various IO Units { (devices). { { Design: { 1) UnitIO must increment and denew/dispose of CB from UnitIO to IO.Init. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical block crement the IOCount of the segments { which are involved in IO. { 2) Segment faults must *never* happen while i numbers; fixed botCursF bug. Del XXX procedures; Changed to use new screen 9-Feb-nterrupts are off. { {-----------------------------------------------------------------------------} { 1-Jul-81 BAM 81 BAM V4.0 No longer does conversions on Disk Physical block numbers; fixed CursorUpdate to allow pV5.4 Change Screen name to ScreenOut. 3-Jun-81 JPS V5.3 Add Virgil headers and comments. 23-May-81 JPS V5.2 Usartial screen display and added procedure IOScreenSize to set a new size. e new IOKeyDisable/IOKeyEnable in place of old DisCtlC/EnaCtlC. 16-Apr-81 GGR V5.1 Add 3MHz E 13-Jan-81 JPS V3.3 Move creation of the IOSeg to memory manager init. Move $R- to private part. thernet Drivers (JEB). 11-May-81 JPS V5.0 Split IO into several modules. 6-May-81 JPS V4.7 1. Use new form  20-Nov-80 JPS V3.2 Initialize TabFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt table. of the SetCylinder StartIO. 2. Don't bother doing 10 trys in FindSize since only  Check SystemInitialized for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor and Tablet    sKey = 16; { Translated Keyboard } ScreenOut = 17; { Screen Display } Clock = 18;  BlockSize: integer; { 0 = variable size } { 1 = ch { Used only for Put/Get Status } LastUnit = Clock; { for unit validity checking } Type IOBufPtr = ^Iaracter device (uses circ buf) } { >1 = fixed blocksize (= blocksize ) } OBuffer; IOBuffer = array[0..0] of integer; CBufPtr = ^CBufr; CBufr = packed array[0..0] of IntrMask: integer; { interrupt mask bits } IntrPriority: integer; { decoded it char; { same as Memory, except for } { character buffers } BigStrerrupt priority (0..14) } PSCode: 0..255; { Special code for PutStatus } GSCod = String[255]; { A big String } UnitRng = 0..MaxUnit; IOStatPtr = ^IOSte: 0..255; { Special code for GetStatus } Name: packed array[0..3] of char end; atus; IOStatus = record HardStatus: integer; { hardware status return } So Const { RS-232 Speeds } RS9600 = 1; RS4800 = 2; RS2400 = 4; RS1200 = 8; ftStatus: integer; { device independent status } BytesTransfered: integer end; RS600 = 16; RS300 = 32; RS150 = 64; RS110 = 87; Type Z80Readings = packed record  MaxUnit = 18; { highest legal device code } FakeUnits = 2; { Number of units which don't have S IOHeadPtr = ^IOHeader; IOHeader = record { Hard disk header record } tartIO's } IOStart = 0; { Master Z-80 control } HardDisk = 1; {$ifc Ether3MBaud then} Eth SerialNum: Double; { Serial number of the file } LogBlock: integer; { The logicaler3 = 2; {$elsec} {$ifc Ether10MBaud then} Ether10 = UnImplemented; {$endc} {$endc} Floppy = 3; S block number } Filler: integer; NextAdr: Double; { Address of next blocpeech = 4; GPIBIn = 11; GPIBOut = 5; Z80Monitor = 6; Tablet = 7; KeyBoard = 8; k in the file} PrevAdr: Double { Address of previous block } end;  RS232In = 9; RS232Out = 10; SpPutSts = 12; { Put/Get Status } SpGetSts = 13; S DevTabPtr = ^DeviceTable; DeviceTable = array [UnitRng] of packed record CtlPtr: IOBufPtr; pPutCir = 14; { Put/Get from Circular Buffer } SpGetCir = 15; { Fake Units Begin Here } Tran { actually pointer to ChrCntlBlk or IOCB, } { but we'll coerce later }     end; Z80Settings = packed record { Z80 Voltage/Temp Monitor Settings }  RSXmitBits: (Send5,Send7,Send6,Send8); RSRcvBits: (Rcv5,Rcv7,Rcv6,Rcv8)); MinGround: integer; MaxGround: integer; Min5: integer; Max5: integer;  Z80Monitor: (Z80Enable: boolean; Z80Fill: 0..32767;  Min12: integer; Max12: integer; MinMinus12: integer; MaxMinus12: in case boolean of { Get or Put; true = Get } true: ( { Get Status } teger; MinVRef: integer; MaxVRef: integer; MinNet: integer;  GetRead: Z80Readings; GetLimits: Z80Settings MaxNet: integer; MinCRTemp: integer; MaxCRTemp: integer; MinBaseTemp: integer ); false:( { Put Status } ; MaxBaseTemp: integer; Min55: integer; Max55: integer; Min2 PutLimits: Z80Settings )); Floppy: (case integer of { 4: integer; Max24: integer end; DevStatusBlock = packed record Get or Put } 1: ( { Get Status } FlpUnit: 0..3;  ByteCnt: integer; { # of status bytes } case UnitRng of KeyBoard,  FlpHead: 0..1; FlpNotReady: boolean;  Tablet, {$ifc Ether3MBaud then} Ether3, {$elsec} {$ifc Ether10MBaud then}  FlpEquipChk: boolean; FlpSeekEnd: boolean; FlpIn Ether10, {$endc} {$endc} Clock: (DevEnable: boolean); RtrCode: 0..3; case integer of 1 {IORead, IOWrite, IOFormat} { Z80 Voltage/Temp Monitor Readings } Ground: integer; Volts5: integer; S232In, RS232Out: (RSRcvEnable: boolean; RSFill: 0..127;  Volts12: integer; Minus12: integer; VRef: integer; Net: integer;  RSSpeed: 0..255; RSParity: (NoParity, OddParity, IllegParity,  CRTemp: integer; BaseTemp: integer; Volts55: integer; Volts24: integer  EvenParity); RSStopBits: (Syncr,Stop1,Stop1x5,Stop2);   : (FlpMissAddr: boolean; { in data or header } FlpNotWr FlpEnable: boolean ); 3: ( { Byteitable: boolean; FlpNoData: boolean; FlpFill1: 0..1;  access } FlpByte1: 0..255; FlpByte2: 0..255;  FlpOverrun: boolean; FlpDataError: boolean; { in data o FlpByte3: 0..255; FlpByte4: 0..255; r header } FlpFill2: 0..1; FlpEndCylinder: boolean;  FlpByte5: 0..255; FlpByte6: 0..255; FlpByte7: 0..255  FlpDataMissAddr: boolean; { in data } FlpBadCylinder: bo ) ) end; Type IOCommands = (IOReset, IOReaolean; FlpFill3: 0..3; FlpWrongCylinder: boolean; d, IOWrite, IOSeek, IOFormat, IODiagRead, IOWriteFirst, IOIdle, IOWriteEOI, IOConfigure); Var D FlpDataDataError: boolean; { in data } FlpFill4: 0..3; evTab: DevTabPtr; { pointer to system device table } CtrlSPending: boolean; { if ^S has halted sc FlpCylinderByte: 0..255; FlpHeadByte: 0..255; reen output } IOInProgress: boolean; { false when speech is active } IO24MByte: boolean;  FlpSectorByte: 0..255; FlpSizeSectorByte: 0..255 { true if the disk is 24 MBytes } Function IOCRead(Unit: UnitRng; var Ch: char): integer;  ); 2 {IOSeek}: (FlpPresen { read a character from a } { character device and return } tCylinder: 0..255 ) ); 2:  { status: IOB no char available } { ( { Put Status } FlpDensity: 0..255; { single = 0,  IOC character returned } Function IOCWrite(Unit: UnitRng; Ch: char): integer;  double = #100 } FlpHeads: 0..255; { 1 or 2 heads }  { write Ch to character device } { and return status: }   lsec} {$ifc Ether10MBaud then} UnImplemented; {$endc} {$endc} {*******************************} Priylinder StartIO. 2. Don't bother doing 10 trys in FindSize since only the lvate {*****************************} ast result was believed regardless of success or failure. 3. Hang if we canModule IO_Private; {----------------------------------------------------------------------------- { { IO_Private - IO system not figure out the size of the disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. 19-Mar-81 BAM V4.5 Chang { IOB buffer full } { IOC characterprivate definitions and interrupt routines. { Miles A. Barel ca. 1 Jan 80. { Copyright (C) 1980, Three Rivers Computer Corpor sent } Procedure UnitIO(Unit: UnitRng; { IO to block structured } ation { { Abstract: { IO_Private exports interrupt routines and definitions which are private { to the modules wBufr: IOBufPtr; { devices } Command: IOCommands; ByteCnt: integer; hich make up the IO system. { { Design: { Interrupt routines must *never* cause segment faults. { {------------------ LogAdr: double; HdPtr: IOHeadPtr; StsPtr: IOStatPtr); Procedure IOWait(var Stats:-----------------------------------------------------------} { 25-Jun-81 JPS V5.7 Get rid of EnTabUpdate and EnCurUpda IOStatus); { hang until I/O completes } Function IOBusy(var Stats: IOStatus): boolean; { true if I/O not complete } te since they didn't work anyway. 4-Jun-81 JPS V5.6 Fix Beep when type ahead too far (for the  Procedure IOPutStatus(Unit: UnitRng; var StatBlk: DevStatusBlock); { Set status onlast time I hope). 3-Jun-81 JPS V5.5 Add Virgil headers and comments. 23-May-81 JPS V5. device Unit } Procedure IOGetStatus(Unit: UnitRng; var StatBlk: DevStatusBlock); 4 Use new IOKeyDisable/IOKeyEnable in place of old DisCtlC/EnaCtlC. Reinstate Beep when type ahead to{ Reads status on device Unit } Procedure IOBeep; { You guessed it, BEEP! } {$ifc Ether3MBaud tho far. 22-May-81 JPS V5.3 Fix control-c processing. Remove Beep when type en} Function Ether3Transmit(Buff: IOBufPtr; WdCnt: integer) : integer; Function Ether3Receive(Buff: IOBufPtr; var WdCnt: int ahead too far. 16-Apr-81 GGR V5.2 Add 3MHz Ethernet Drivers (JEB) 31-Mar-81 GGR V5.1 Added 4-button moueger; timeout: integer) : integer; Function Ether3Start(Promiscuous, Restart: boolean) : integer; {$ese support. 11-May-81 JPS V5.0 Split IO into several modules. 6-May-81 JPS V4.7 1. Use new form of the SetC  en display and added procedure IOScreenSize to set a new size. 13-Jan-SpkPriority = 2; {$ifc Ether3MBaud then} Ether3Priority = 12; {$elsec} {$ifc Ether10MBaud then} Ether10Prio81 JPS V3.3 Move creation of the IOSeg to memory manager init. Move $R- to private part. 20-Novrity = UnImplemented; {$endc} {$endc} GPIBInPriority = 11; GPIBOutPriority = 1; TabPriority = 10; -80 JPS V3.2 Initialize TabFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt table.  KeyPriority = 5; RSIPriority = 6; RSOPriority = 7; Z80Priority = 8; PutPriority = 9; Check SystemInitialized for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor and Tablet interface.  GetPriority = 4; PSFloppy = #14; { Put Status Special Codes } PSGPIB = 0;  New time procedures. Split into another include file. 10-Oct-80 JPS V2.2 Added support for  PSZ80Monitor = #11; PSTablet = 6; PSKeyBoard = 7; PSRS232 = 5; PSClock = #12; the diagnostic display (DDS). 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the hard dis GSFloppy = #40; { Get Status Special Codes } GSGPIB = #100; GSZ80Monitor = #10; GSTed name of included modules to IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHeads and FindSize to agree withk. 19-Sep-80 DAS V2.0 Added code for 24 MByte disks. } {*******************************} Exports {********** V4.3. 2) Teach the HardDisk timeout code about multi-sector operations. *******************} Imports SystemDefs from SystemDefs; Imports IO_Unit from IO_Unit; Imports IO_Others from IO_Othe 28-Feb-81 JPS V4.3 No longer do conversions on Disk Physical block numbers (reinstating changes mrs; Imports Raster from Raster; Const CirBufSize = #100-3; { size of circular buffers - made so thade in V4.0). 25-Feb-81 GGR V4.2 Added setting/reading of DskFill1 in UnitIO. Moved new/disposeat } { total size of CirularBuffer = #100 } DskBlockSize = 512; { block  of CB from UnitIO to IO.Init. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical block sizes for fixed block size devices } FlpBlockSize = 128; { Size is in BYTES } SpkBlockSize = 128;  numbers; fixed botCursF bug. Del XXX procedures; Changed to use new screen 9-Feb-81 BAM V4 TabBlockSize = 8; Z80BlockSize = 20; GPIBBlockSize = 1; Last12Sector = 202 * 4 * 30 -1; {Tracks * He.0 No longer does conversions on Disk Physical block numbers; fixed CursorUpdate to allow partial screads * Sectors. 0 start } DskPriority = 0; { interrupt priorities } FlpPriority = 3;   sition } VisOnly = #2000; { mode bits - Visual screen only } VisAndCur = #2400; { visual screen and  CirBufItem = packed record { what we put in circular buffers } ch: char; { the characcursor } Map = #100000; { cursor map function } CtrlC = chr(#3); CtrlS = ter } case CBType of { and device specific condition bits } KDBType: (KDBUnused: chr(#23); CtrlQ = chr(#21); BlamCh = Chr(#303); { untranslated shift-control-C } DumpCh = Chr(#30..63; KDBOverrun: boolean; { true = overrun } KDBError: bool04); { untranslated shift-control-D } {$ifc Ether3MBaud then} E3TIntEnable = #4; { Ether3 constantsean); { OR of all error bits } RSIType: (RSIUnused: 0..7; RSIBreak: bo } E3TDone = #2000; E3TError = #4000; E3TGo = #10; E3RIntEnable = #1; E3RDone = #40olean; { true=break received } RSIModem: boolean; { true=modem change } 0; E3RPromiscuous = #20; E3RError = #1000; E3RGo = #2; E3XmtMask = E3TDone + E3TError + E3TG RSIParErr: boolean; { true=parity error } RSIOverrun: boolean; { to; E3XmtSucc = E3TDone + E3TGo; E3RecMask = E3RDone + E3RError + E3RGo; E3RecSucc = E3RDone + E3RGo; rue=overrun error } RSIError: boolean); { OR of all error bits } RSOTy PackBuffLen = 511; E3RecCount = PackBuffLen - 4; MAXE3RECERRS = 20; {$elsec} {$ifc Ether1pe: (RSOUnused: 0..255); StdType: (StdHiByte: 0..255) end; Ci0MBaud then} UnImplemented; {$endc} {$endc} Type IOPtrKludge = record case integer of rcularBuffer = packed record { circular buffer used for character } { devices, SpGetCiablet = #2; GSKeyBoard = #4; GSRS232 = #1; GSClock = #20; DisCst0 = #1154; { c 1: (Buffer: IOBufPtr); 2: (Offset: Integer; Segment: Integeronsts to terminate Display List; add in funct } DisCst1 = #1351; MinCurY = 0; { Minimum Y value for ) end; {$ifc Ether3MBaud then} EtherBuff = array [0..PackBuffLen] ocursor } MaxCurY = 1023; { Maximum Y value for cursor } SegSize = 128; { # lines / display segmf integer; pEtherBuff = ^EtherBuff; {$elsec} {$ifc Ether10MBaud then} UnImplemented; {$endc} {$endc} ent } CrsHeight = 64; { Height of the cursor } CrsConst0 = #370; { constants to compute funny X po CirBufPtr = ^ CircularBuffer; CBType = (KDBType, RSIType, RSOType, StdType);{ types of circular bufs }   here to get chrs out } WrPtr: integer; { where to put them in } Buffer: packed array[0ds = 8; { Max number of dsk heads } DskExHds = 0; { Extra heads not in use } DskCyls = 2..CirBufSize-1] of CirBufItem { last, the buffer } end; TabBufP02; { Number of cylinders } FlpUnits = 4; { 0 is the only valid unit } FlpSPC = 26; tr = ^TabletBuffer; TabletBuffer = packed record { buffer used for tablet, clock and } TabX: 0..#77 { numbered 1 to 26 } FlpHds = 2; { numbered 0 to 1 } FlpCyls = 77; { numbered 0 to 7777; { Z80 Monitor Info } TabSwitch: boolean; TabY: 0..#77777; Fill: 07, 0 should not be used } TabAverage = 4; { number of tablet points to average } ..1; ClkTime: double; Z80Mon: Z80Readings end; DispPtr = ^DisplayFile; { this MUST be 4 } TabIgnore = 2; { number of points to ignore when finger is }  DisplayFile = array[0..11] of packed record case boolean of true: (int: integer) { picked up or put down } TabFifoLen = TabAverage + TabIgnore; TabFifoMax = TabFifoLen - 1; ; false:(LineCount: 0..127; StartOver: boolean; Sho GPIBxFudge = 38; { actual range in X and Y for BitPad: 0..2200 } GPIByFudge = 1061; { of TX and TY: wCursor: boolean; VerticalRetrace: boolean; ShowScreen: boolean; 0..1100 } { of TabAbsX: 0..1100 } { of TabAbsY: 0..1100 }  DisableMicroInterrupt: boolean; WriteBadParity: boolean;  { of TabRelX: -38..1062 limited to 0..767 } { of TabRelY: 1061.. Map: (CursOnly, CCursOnly, Compl, ComplInv, Normal, Invert, CursComp, InvCursCompl)) -39 limited to 1023..0 } STopY = 0; SLeftX = 0; SRightX = 767; Type DskCmds = end; ScrCtlPtr = ^ ScrCtlBlock; ScrCtlBlock = packed record Cmd: Disp (DskIdle, DskRdCheck, DskDiagRead, DskWrCheck, DskWrFirst, DskFormat, DskSeek, DskClear); Ptr; ScreenBase: RasterPtr; CursBase: RasterPtr; CursX: integer;  {$ifc Ether3MBaud then} Ether3Cmds = (E3Rset, E3Status, E3Receive, E3PromiscReceive, E3Tranr and SpPutCir } Length: integer; { # chars in the buffer } RdPtr: integer; { w filler: integer end; Const DskSPC = 30; { Sectors Per Cynlinder } DskH   DskNextAdr: double; DskPrevAdr: double; DskCntlError:SpkFill1: array[3..11] of integer; SpkFill2: 0..16383; SpkAddrErr: boolean;  ( OK, AddrsErr, { address error } PHCRC SpkError: boolean; SpkNextIOCB: IOCBPtr); GPIBType: smit); {$elsec} {$ifc Ether10MBaud then} UnImplemented; {$endc} {$endc} FlpCmds = (FlpUnUsed, FlpRead, F, { Physical Header CRC } LHSer, { Logical Serial Wrong } lpWrite, FlpFormat, FlpSeek, FlpReset); GPIBCmds = (GPIBNop, GPIBWrite, GPIBWrEOI, GPIBCntl);  LHLB, { Logical Block Wrong } LHCRC, { { Types of block devices } IOCBType = (DskType, FlpType, SpkType, GPIBType, {$ifc Ether3MBaud then}  Logical Header CRC } DaCRC, { Data CRC }  Ether3Type, {$elsec} {$ifc Ether10MBaud then}  Busy); DskFill2: boolean; DskTrackZero: boolean;  UnImplemented, {$endc} {$endc} GenType); IOCBPtr = ^IOCB;  DskWriteFault: boolean; DskSeekComplete: boolean; DskDriveRead: boolean;  IOCB = packed record { IOCBs must be 8 word aligned } Buffer: IOBufPtr; { data buffer for transaction } DskNextIOCB: IOCBPtr); FlpType: ( FlpUnit: 0..FlpUnits-1;  case IOCBType of DskType: ( DskCommand: 0..255;  FlpHead: 0..FlpHds-1; FlpFill1: 0..31; FlpCylinder: 0..255 DskNumSect: 0..255; (* NEW FS [*) DskAddr: Integer;  { 0..FlpCyls-1 }; FlpSector: 0..255 { 1..FlpSPC }; FlpCommand: 0..255 { FlpCm (* NEW FS *) (* OLD FS [) DskSector: 0..DskSPC-1; ds }; FlpByteCnt: integer { 0..256 }; FlpFill2: array [4..11] of integer; DskHead: 0..DskHds+DskExHds-1; DskCylinder: 0..DskCyls-1; (* OLD FS *)  FlpResult: integer; { Not yet defined } FlpNextIOCB: IOCBPtr);  DskSerialNum: double; DskLogBlk: integer; DskFill1: integer;  SpkType: ( SpkFill0: 0..255; SpkNumBufs: 0..255;    end { IOCB }; Var KRBuf, { Keyboard Raw Buffer } KTBuf { number of heads on this disk. 4 or 8} CursF: integer; { function currently in use} BotCurs, { Keyboard translated buffer } RSIBuf, { RS-232 In Buffer } F: integer; { function for area below used area} BotComplemented: boolean; { whether bot is compleme RSOBuf: CirBufPtr; { RS-232 Out Buffer } TabBuf: TabBufPtr; { Tablet/Clock Buffer } nted or not} SBottomY: integer; { bottom of displayed area } TabMode: TabletMode; { Cu ScrBuf: ScrCtlPtr; { Screen control blocks } DisFile0,DisFile1: DispPtr; { Screen Display lists - dourrent mode of the tablet } CCursMode: CursMode; { Current mode of cursor } newFunct: Boolean; ble bufrs } OldCurY, { previous Cursor Y position } OldCurX: integer; { p { Tells when have a new function to insure that cursor redisplayed }  (GPIBCommand: GPIBCmds; GPIBF0: 0..63; GPIBNumBufs: 0..255; revious Cursor X position MOD 8 } Cursor: CurPatPtr; { Cursor Pattern } CursorX, CursorY: integer GPIBByteCount: 0..255; GPIBF1: array [4..11] of integer; ; { new cursor coordinates } PointX, PointY: integer; { the point of the cursor } TabFifo: array[0 GPIBResult: integer; {Not Implemented} GPIBNextIOCB: IOCBPtr); {$ifc Ether3MBaud then} ..TabFifoMax] of record X,Y: integer end; { fifo of tablet points } TabFifoInx: integer;  Ether3Type: ( Ether3Cmd: integer; Ether3Delay: integer;  { index into tablet fifo } TabCount: integer; { counter for ignoring tablet points } SumX, SumY: Ether3WdCnt: integer; Ether3Status: integer; Ether3NextIOCB: IOCBPt integer; { sum of 4 points for averaging } FlpLastCylinder: integer; { last cylinder referenced } r ); {$elsec} {$ifc Ether10MBaud then} UnImplemented; {$endc} {$endc} GenType:  FlpLastHead: integer; { last head referenced } GPIBTabletState: integer; { GPIB tablet current st{ General Purpose entry } ( GenCmd: 0..255; NumBlks: 0..255; ate } GPIBxTablet, GPIByTablet: integer; { GPIB tablet coordinates } GPIBInBuf: CirBufPtr; { GPIB i GenFill0: array[3..11] of integer; Result: integer; NextIOCB: IOCBPtr) nput buffer } StanleyTablet: boolean; { if Stanley tablet is enabled } CurDskHds: integer;   ean; { ***** Unused ***** } KeyEnable: boolean; { if keyboard interrupts are enabled } {$ifc Ether3MBaud then} Var etherCB: IOCBPtr; { Pointer to IOCB used by Ethernet } pEBuff: IOBufPtr;  { Pointer to Ethernet IO buffer } E3Restart, { Ether3 state } E3IsPromiModule IO_Init; {----------------------------------------------------------------------------- { { IO_Init - Initialize the Iscuous, E3InProgress, E3IsReceiving: boolean; E3RecErrs: integer; {$elsec} {$ifc Ether10MBaud then}O system. { Miles A. Barel ca. 1 Jan 80. { Copyright (C) 1980, Three Rivers Computer Corporation { { Abstract: { IO_ UnImplemented; {$endc} {$endc} { interrupt routines: } Procedure DiskIntr; { hard disk } PrInit initializes the Interrupt Vector Table, the Device Table and { associated buffers, the Screen Package, the tablet anocedure FloppyIntr; { floppy disk } Procedure SpeechIntr; { speech out } Procedure GPIBOutIntr; { GPIB out } d cursor, and { the Z80. { {-----------------------------------------------------------------------------} {  Procedure GPIBInIntr; { GPIB in } Procedure TabIntr; { tablet (actually video retrace } Procedure Z80Intr;  1-Jul-81 BAM V5.7 Changed name of Screen to ScreenOut 25-Jun-81 JPS V5.6 Change EnableTablet to InitGPIB and do not { Z80 monitor } Procedure KeyIntr; { keyboard } Procedure RSIIntr; { RS232 in } Procedure RSOIntr;  enable the tablet. 3-Jun-81 JPS V5.5 Add Virgil headers and commands. 23-May-81 JPS CB : IOCBPtr; { Pointer to IOCB used by UnitIO } Type IntTabPtr = ^IntVecTable;  { RS232 out } Procedure PutIntr; { PutStatus completion } Procedure GetIntr; { GetStatus completion }  IntVecTable = array [0..MaxUnit-FakeUnits] of record { NO Fake Units Included Here!{$ifc Ether3MBaud then} Procedure Ether3Intr; { 3 MBaud EtherNet completion } Function E3Reset: integer; Procedure E3 } SSN: integer; GPtr: integer; Rtn: 0..2RecStart; {$elsec} {$ifc Ether10MBaud then} UnImplemented; {$endc} {$endc} {*******************************} Priva55; SLink: integer end; Var IntTab: IntTabPtr; { te {*****************************} pointer to interrupt vector table } IOPriv1Unused: boolean; { ***** Unused ***** } IOPriv2Unused: bool  .1 Added 4-button mouse support. 11-May-81 JPS V5.0 Split IO into several modules. 6-May-81 JPS V4.7 1. Use te part. 20-Nov-80 JPS V3.2 Initialize TabFifoInx in InitTablet. 17-Nov-80 JPS V3.1 Export the interrupt tablenew form of the SetCylinder StartIO. 2. Don't bother doing 10 trys in FindSize since only . Check SystemInitialized for control-C abort. 16-Nov-80 BAM V3.0 Radically changed Cursor an the last result was believed regardless of success or failure. d Tablet interface. New time procedures. Split into another include file. 10-Oct-80 JPS V2.2 3. Hang if we cannot figure out the size of the disk. 11-Apr-81 JPS V4.6 Changes for virtual memory. 19-Mar- Added support for the diagnostic display (DDS). 27-Sep-80 DAS V2.1 Added timeout code to UnitIO for the 81 BAM V4.5 Changed name of included modules to IO_Init and IO_Proc 3-Mar-81 JPS V4.4 1) Fix LocateDskHeads and Fi hard disk. 19-Sep-80 DAS V2.0 Added code for 24 MByte disks. } {*******************************} ndSize to agree with V4.3. 2) Teach the HardDisk timeout code about multi-sector Exports {*****************************} Procedure InitIO; {*******************************} Private {******* operations. 28-Feb-81 JPS V4.3 No longer do conversions on Disk Physical block numbers (r**********************} einstating changes made in V4.0). 25-Feb-81 GGR V4.2 Added setting/reading of DskFill1 in UnitIO. module FileSystem; {-------------------------------------------------------------------- Spice Interim File System. Writt Moved new/dispose of CB from UnitIO to IO.Init. 16-Feb-81 BAM V4.1 Put back in conversions on Disk Physical block en by: Richard F. Rashid Date : February 24, 1981 Copyright (C) 1981 - Carnegie-Mellon University -------------------- numbers; fixed botCursF bug. Del XXX procedures; Changed to use new screen ------------------------------------------------} {-------------------------------------------------------------------- Ch 9-Feb-81 BAM V4.0 No longer does conversions on Disk Physical block numbers; fixed CursorUpdate tange history 12 May 81 BAM V7.1 Fixed to allow FlushFail on open. 12 May 81 BAM V7.0 Added Exceptions for FSLo V5.4 Initialize new KeyEnable flag. 16-Apr-81 GGR V5.3 Add 3MHz Ethernet Drivers (JEB). 1-Apr-81 GGR V5.2o allow partial screen display and added procedure IOScreenSize to set a new  Moved time base to video refresh (clock is no longer turned on in io_init). 31-Mar-81 GGR V5size. 13-Jan-81 JPS V3.3 Move creation of the IOSeg to memory manager init. Move $R- to priva   { Block number of the first data block } { in a file } LastBlk =#077776; { BlockName:PathName; Var BlkInFile,BitsInLBlk: Integer): FileID; {doesn't use any search lists} function FSSearch(okUp and FSEnter. Catch string too long from FixFileName 9 Apr 81 BAM V6.7 FSClose no longer number of the last data block } { in a file. } FIBlk =-1; { Block number of the  sets any dates (set by open/enter). 3 Apr 81 BAM V6.6 Fixed bug in entering filename with .. in it. 27 Mar 81 BAM File Information Block } BootLength = 60 + 128; { Size of the bootstrap area on disk--the } { V6.5 Fixed Close to do Trucate. 26 Mar 81 BAM V6.4 Added comments. 19 Mar 81 BAM V6.3 import PERQ_String not first n blocks on the disk. the microcode } { boot area is 60 blocks, the Pascal boot }  PERQ.String. 17 Mar 81 BAM V6.2 Added new procedure FSIsFSDev. 10 Mar 81 BAM V6.1 Changed FixFileName to create { area is 128 blocks (32K). } StartBlk =BootLength;{ The block number of the FIBlk of the first}  a full file spec; removed self-init from FixFileName 9 Mar 81 BAM V6.0 changed syntax of d { user file. } SysFile = -1; { File ID of the system area on disk. } SEARCHSIZELISTirectories 5 Mar 81 BAM V5.0 Removed many procedures into FileUtils; removed Import of Disk = 5; { Max number of directories on search list. } type DirBlk= Record IO from export; changed size of FileName strings; improved Scan; 3 Mar 81 BR and JPS Improv { Record for reading disk blocks } Case Integer Of 2: ( Buffer:Array[0..255]e setting of dates in FSEnter/FSClose/FSLookUp. V4.2 Set FileType in FSEnter. M Of Integer ); 3: ( ByteBuffer: Packed Array [0..511] of FSBit8 ) ake Id a Var parameter ro FSScan as it should be. 1 Mar 81 BR V4.1 Set Dates in FSEnter/FSClose. 26 Feb 81 DAS  End; PDirBlk= ^DirBlk; FileID = integer; BlkNumbers = integer; SearchList =and JPS Added FSRename. Exported FixFileName. V4.0 ------------------------------------------------------ array[1..SEARCHSIZELIST] of PathName; ptrSearchList = ^SearchList; var FSDirPrefix:PathName; {--------------} {********************} Exports {********************} imports FileDefs from FileDefs; const FSVersicurrent default directory including device and part} FSSysSearchList: SearchList; function FSLookUp(FileName:PathName;Var on = '7.1'; { File system version number } BlksPerFile =#077777; { Max blocks in each file } FirstBlk =0; BlkInFile,BitsInLBlk: Integer): FileID; {uses current system search list} function FSLocalLookUp(File  ean); Function FSIsFSDev(name: PathName; var devName: String): integer; Exception FSNotFnd(name: PathName); {--------------Module FileDefs; {----------------------------------------------------------------------------- Defines some constants and ty------------------------------------------------------ Abstract: Raised if file looked up is not found. If this exception ispes needed by various people so FileSystem doesn't need to import DiskIO in its export section Written by: Brad A. Myer not handled by client, the lookup or search will return zero Parameters: name is the name not found ----------s 3-Mar-81 Copyright (C) 1981 Three Rivers Computer Corporation -------------------------------------------------------------------------------------------------------------------} Exception FSBadName(name: PathName); {---------------------------------------------} {---------------------------------------------------------------------------- Versions: V1.2 16-var slist : SearchList; var FileName : PathName; var BlkInFile, BitsInLBlk: integer) : FileID; ------------------------------------------ Abstract: Raised if file entered is illegal because: 1) the device  {uses specified search list instead of system one; is var so no copying; changes FileName toor partition specified is not valid 2) a directory name specified does not exist 3) the length of  be full filename actually used} function FSEnter(FileName:PathName): FileID; procedure FSClose(Usthe simpleName is > 25 characters If this exception is not handled by the client, the Enter will returerFile:FileID; Blks,Bits:Integer); procedure FSBlkRead(UserFile:FileID; Block:BlkNumbers; Buff:PDirBlk); procedure FSBlkWrite(n zero Parameters: name is the name that is illegal --------------------------------------------------------------------} UserFile:FileID; Block:BlkNumbers; Buff:PDirBlk); procedure FSInit; procedure FSMount(disk : integer); procedure FSDismount(d Function FSInternalLookUp(FileName:PathName; Var BlkInFile,BitsInLBlk:Integer): FileID; const FSDebug =isk : integer); procedure FSSetPrefix(prefixname : PathName); {FSSetPrefix just assigns the  false; {********************} Private {********************}  vble; use FileUtils.FSSetPath to do processing on new path}  procedure FSGetPrefix(var prefixname : PathName); function FileIDtoSegID(id : FileID) : SegID; function SegIDtoFileID(id : SegID) : FileID; procedure FSSetupSystem(bootchar: integer); procedure FixFilename(var filename : PathName; nulliserror : bool   -1 block of a file} DiskAddr = FSBit32; {The virtual address of a DiskBlock}  SimpleName = string[25]; {only the filename in the directory} PathName = string[100]; {full name of file wmodule DiskIO; {--------------------------------------------------------------------------- This module implements the basic ith partition and dev} PartialPathName = string[80]; {file name including all directories} FSOpenType = (FSNotOpelow level operations to disk devices It services the Hard Disk and the Floppy. When dealing with the floppy here, the strucn, FSOpenRead, FSOpenWrite, FSOpenExecute); FSDataEntry = packed record FileBlocks : integetures on the hard disk are mapped to the structures on the floppy -----------------------------------------------------------r; {Size of file in blocks} FileBits : 0..4096; {Number of bits in last blk} ----------------} {--------------------------------------------------------------------------- Change history. 24 Ju FileSparse : Boolean; {true if can be sparse} FileOpenHow : FSOpenType; {howOpen} n 81 BAM V3.12 Fix to prevent retry if floppy write and device not writable. 28 May 81 BAM V3. FileCreateDate : TimeStamp; FileWriteDate : TimeStamp; File11 Fix bug in floppy header die-On-error. Add Recalibrate light to floppy New Mar-81 Brad A. Myers Changed openType V1.1 11-Mar-81 Brad A. Myers Added sparse and OpenHow bits to FSData V1.0 5AccessDate : TimeStamp; FileType : integer; {see FileType.pas} FileRigh-Mar-81 Brad A. Myers Created by copying text from Arith and DiskIO -------------------ts : integer; {protection code} FileOwner : FSBit8; {UserId of file owner} ---------------------------------------------------------} EXPORTS Imports GetTimeStamp from GetTimeStamp; {Using TimeStam FileGroup : FSBit8; {GroupId} Filename : PartialPathName; endp} const DBLZERO = nil; {a two word 0} type FSBit8 = 0..255; FSBit16 = integ; ptrFSDataEntry = ^FSDataEntry; PRIVATE procedure CompilerBug; begin end. er; FSBit32 = ^integer; {will be a long when compiler knows about 'em} Const DISKBUFSIZE = 256; {defined by hardware, 256 words per sec} type SegID = FSBit32; {In SpiceSeg, the virtual address of the    Removed Procedure DiskError; Use new IO 6 May 81 JPS V3.7 Fix bug in DigMapping parameter to MapAddr by teaching UnitIO not to fool with a hard disk address. -------------skReset by using the new form of the SetCylinder StartIO. 20 Apr 81 JPS V3.6 Use DiskSegment co--------------------------------------------------------------} {******************} exports {***************************} nsistently. Set DiskSegment as UnSwappable for virtual memory. 9 Apr 81 BAM V3.5 Fix Retry so no imports Arith from Arith; imports FileDefs from FileDefs; imports IOErrors from IOErrors; const HARDNUMBER = recal on last time; DiskError tell op. Fixed bug in DoDiskIO exit 30 Mar 81 BAM V3.4 Added Retr 0; {device code of Shugart Disk} FLOPPYNUMBER = 1; {device code of FloppyDisk} {a Diy count to TryDisk and Const NumTries. 27 Mar 81 BAM V3.3 Added comments and WriteLn to DiskError. 19 Mar 81 BAM V3.2sk Address can be distinguished from a Segment Address by the upper two bits (in 32 bits). These bits have a nonzero cod Combined JPS+GGR and BAM's changes. 17 Mar 81 GGR V3.1 Removed WinchDebug and FloppyDebug. 17 Mar 81 JPS V3.0 Chane to which disk the address is part of} RECORDIOBITS = #140000; {VirtualAddress upper 16 bits of diskged MapAddr and UnMapAddr to handle 24 Mbyte drives. Changed harddisk interl} DISKBITS = RECORDIOBITS + (HARDNUMBER*(#20000)); FLOPBITS = RECORDIOBITS + (FLOPPYNUMBER*(#200ace factor to one. Removed partition kind 'node'. Added TryDiskIO, and changed00)); {The following definitions tell how many entries there are in the three pieces of the random index. The firs DiskError printout. Changed FirstDiskBlock for harddisks and LastDiskBlock fot piece (Direct) are blocks whose DiskAddresses are actually contained in the Random Index (which is part of the Filr 24 Mbyte disks. Improved retry and retry messages from DiskIO and FloppyIOeInformationBlock). The second section has a list of blocks each of which contain 128 Disk Addresses of blocks in thlight definitions 26 May 81 JPS V3.10 Use new Lights module. 19 May 81 BAM V3.9 Fixed position of Reset light 12 M. 16 Mar 81 BAM V2.2 Changed directory to have extra bits 5 Mar 81 BR V2.1 Added comments 5 Mar 81 BAM V2.0 ay 81 BAM V3.8 Removed print out for DiskErrors; more accurate print out of errors when happen; bl Changed Definitions and import FileDefs. 3 Mar 81 JPS V1.4 Fix DiskReset to agree with IO V4.4. 1 Mar 81 BR V1.3 ink "light" during IOReset. Added new Exceptions DiskFailure and BadDevice;  Change FileDate to TimeStamp. 1 Mar 81 JPS V1.2 Export the DiskReset routine. 28 Feb 81 JPS V1.1 Get rid of the Lo  e file, forming a one level indirect addressing scheme. For very large files, the third section (DblInd) has DiskAdd ); 4: ( Lng : FSBit32 ) resses of blocks which point to other blocks which contain 128 DiskAddresses of blocks in the file, forming a two le end; { A directory is an ordinary file which contains SegIDs of files alovel indirect scheme.} DIRECTSIZE = 64; { Entries in FIB of blocks directly accessable } INDSIZE ng with their names. Directories are hash coded by file name to make lookup fast. They are often sparse files (ie conta = 32; { Entries in FIB of 1 level indirect blocks } DBLINDSIZE = 2; { Entries in FIB of 2 level indirect blocin unallocated blocks between allocated blocks). The file name is a SimpleName, since a directory can only contaiks } FILESPERDIRBLK = 16; { 256 / SizeOf(DirEntry) } NUMTRIES = 15; { number of tries at transfer n entries for files within the partition (and thus device) where the directory itself is located } DirEntrybefore aborting } type {Temporary segments go away when processes are destroyed, Permanent segments persist un = packed record InUse : boolean; {true if this DirEntry is valid} Deleted : booltil explicitly destroyed Bad Segments are not well formed segments which are not readable by the Segment system} ean; {true if entry deleted but not expunged} Archived : boolean; {true if entry is on backup tape}  SpiceSegKind = (Temporary, Permanent, Bad); PartitionType = (Root, UnUsed, Leaf); {A Root Partition is a device}  UnUsed : 0..#17777; {reserved for later use} ID : SegID; Filename DeviceType = (Winch12, Winch24, FloppySingle, FloppyDouble, UnUsed1, UnUsed2); MyDble = Array [0: SimpleName end; DiskBuffer = packed record case integer of ..1] of integer; DiskCheatType = record case integer of 1: (  1: ( Addr : array [0..(DISKBUFSIZE div 2)-1] of DiskAddr  Addr : DiskAddr ); 2: ( ); 2: ( IntData : array [0..DISKBUFSIZE-1] of FSBit16  Dbl : MyDble { should be IO.Double but don't import IO in export sectio); 3: ( ByteData : packed array [0..DISKBUFSIZE*2-1] of FSBit8 n } ); 3: ( Seg : SegID  ); {4 is format of the FileInformationBlock; the FIB has Logical Block -1 } 4: (    block n may exist when block n-1 has never been alloc Directory} BadSegID : SegID; {where the bad segment ated. NumBlksInUse says how many is} {when booting, the boot character is indexed into the following tab data blocks are actually used by the segment} les to find where code to be boot loaded is found } BootTable : array  FSData : FSDataEntry; {The Random Index is a hint of LastBlk : FSBit16; {Logical Block Number of largest block allocated}  the DiskAddresses of the blocks that form the file. It has three parts  LastAddr : DiskAddr; {DiskAddr of LastBlk } LastNegBlk : FSBit16; {Logias noted above. Notice that all three parts are always there, so that ecal Block Number of largest pointer block ven in a very large file, the first DIRECTSIZE blocks can be located quickly  allocated} LastNegAddr: DiskAddr {Block number of LastNegBlk}  The blocks in the Random index have logical block numbers that are negative. The logical  ); {5 is the format of the DiskInformationBlock} 5: (  block number of Indirect[0] is -2 (the FIB is -1) the last possible block's n {The Free List is a chain of free blocks linked by their headers } umber is -(INDSIZE+DBLINBDSIZE+1)} Direct : array [0..DIRECTSIZE-1 FreeHead : DiskAddr; {Hint of Block Number of the head of the free list] of DiskAddr; Indirect : array [0..INDSIZE-1] of DiskAddr; DblInd } FreeTail : DiskAddr; {Hint of Block Number of the  : array [0..DBLINDSIZE-1] of DiskAddr; SegKind : SpiceSegKind;  tail of the free list} NumFree : FSBit32; {Hint of how many blocks  NumBlksInUse : integer; {segments can have gaps,  are on the free list} RootDirID : SegID; {where to find the Root   kAddr; {Actually has the SegID of the file} LogBlock : integer; {logical block number}  word. The upper byte of the upper word can' Filler : integer; {holds a hint to a candidate for the FreeHead} t have any significant bits for the 12  PrevAdr : DiskAddr; {Disk Address of the next block in this segment}  or 24 megabyte disks. The lower byte of the lower word  NextAdr : DiskAddr; {Disk Address of the previous block in this segment} is always zero (since a disk  end; ptrHeader = ^Header; DiskCommand= (DskRead, DskWrite, DskFirstWrite, DskReset, DskHdraddress is a page address, which is 256 words Read, DskHdrWrite); {last ones for error reporting} var DiskSegment : integer; {a  } function FieldToAddr(disk: integer; fld : integer) : DiskAddr; [0..25] of DiskAddr; {qcode} InterpTable: array [0..25] of DiskAddr; {microcode} memory segment for DiskIO} procedure InitDiskIO; {initialize DiskIO, called at boot time} procedure  PartName : packed array [1..8] of char; PartStart : DiskAddr; PaZeroBuffer(ptr : ptrDiskBuffer); {write zeroes in all words of the buffer. When rertEnd : DiskAddr; SubParts : array [0..63] of DiskAddr; PartRoot : ading an unallocated block, Zeros are returned in the DiskAddr; PartKind : PartitionType; PartDevice : DeviceType  buffer} function WhichDisk(addr : DiskAddr) : integer; {Tells you which disk number a  ); {6 is the format of a block of a Directory} 6: ( Entry : DiskAddr is on} function AddrToField(addr : DiskAddr) : integer; {gives you a one word short  array [0..FILESPERDIRBLK-1] of DirEntry ) end; ptrDiskBuff address by taking the lower er = ^DiskBuffer; Header = packed record {format of a block header} SerialNum : Dis byte of the upper word and the upper byte of the lower   rors occur, exits via nd; numTries: integer) : boolean; {Try a disk operation, but, return  DiskError} function LogAddrToPhysAddr(addr : DiskAddr) : DiskAddr; false if error occurred } Exception DiskFailur {translate a Logical Disk Address (used throughout the system) to and from a e(msg: String; operation: DiskCommand; addr: DiskAddr; softStat: integer); Exception DiskError(msg: Str physical Disk Address (the kind the disk contoller seeing); Exception BadDevice; Var ErrorCnt : Array[IOEFirstError..IOELastError] of integer; {******************} privats) Logical Disk Addresses use a sequential numbering system e {***************************}  Physical Disk Addresses have a Cylinder-Head-Sector system This routine module AllocDisk; {-------------------------------------------------------------------------- AllocDisk: Module to handle all calls MapAddr (a private routine which does the tranocating and freeing of pages off disk Written by CMU-people Copyright (C) 1980 Three Rivers Computer Corporation ----------slation) Map Addr implements interlace algorithm} function PhysAddrToLogAddr(disk : i----------------------------------------------------------------} {---------------------------------------------------------nteger; addr : DiskAddr) : DiskAddr; function LastDiskAddr(DevType : DeviceType) : DiskAddr; {Gets the Disk Address ----------------- Versions: V2.7 15-Jul-81 John Strait Fixed bug in DeallocChain: increment  { Makes a DiskAddr out of a short address and a disk  of the last possible  number } procedure DiskIO(apage on the device} function NumberPages(DevType : DeviceType) : FSBit32; {Return the number of ddr : DiskAddr; ptr : ptrDiskBuffer; hptr : ptrHeader; dskcommand : DiskCommand); {Do a disk  pages on a device} procedure DiskReset; {Reset the disk controller and recalibrate the actu operation, if erater} function TryDiskIO(addr : DiskAddr; ptr : ptrDiskBuffer; hptr : ptrHeader; dskcommand : DiskComma   AllocDisk routine to reduce probability of creating an inconhought of as a partition (the Root Partition) A DiskInformationBlock (DiskInfoBlock or DIB) contains all the fixed inforsistent free list. V2.6 23-Jun-81 Brad Myers Changed UpdatePartInfo to only write PartInfo mation about a disk, including its partion names, locations and sizes. It also contains a table used to locate boot segments  if changed so can boot from write-protected floppies. V2.5 1-Jun-81 Brad Myers  A disk can be 'mounted' which means that its root partition is known to the system as an entry in the DiskTable.  Made UpdatePartInfo more fail-safe. V2.4 12-May-81 Brad Myers New exceptions; no Write statements.  A Partition Information Block (PartInfoBlock or PIB) contains all of the fixed information about a partition, A part Changed addresses to print in unsigned decimal V2.3 20-Apr-81 John Strait Use DiskSegment for allocation. ition can also be 'mounted', and this is usually done as part of mounting the disk itself. Partitions mounted are entries in  V2.2 14-Apr-81 Brad Myers Changed to report "device name" instead of "root partition" the PartTable Within a partition, segments are allocated as doubly linked lists of pages The Free List of a segmin display partitions ForgetAll at end DeviceDismount V2.1 27-Mar-81 Brad Myers Fixed ent is a doubly linked list of free pages This module maintains this list, as well as the DeviceTable and PartTable It cbug in FindPartition for missing device and added comments V2.0 19-Mar-81 Brad Myers ontains procedures for mounting and dismounting disks and partitions, as well as allocating and deallocating space within a Combined previous changes V1.3 ?-Mar-81 ?? Fixed GetPartName V1.2 10-Mar-81 Brad Myers Bit32 => FSBit32partition. When allocating pages, the module updates the PartInfoBlock every MaxAllocs calls on AllocDisk Since the; fixed for new FS syntax V1.0 ??-???-?? CMU people written ----------------------------------------------------------- system may crash some time between updates, the pointers and free list size may not be accurate. When a partition is mo---------------} { The each disk in the file system is divided into named partitions The partition has some number of contunted, the pointers are checked to see if they point to free pages. If not, the head of the pointer is found by looking aiguous pages on it. The number of pages in a partition is specified when the partition is created (using the Partition prt the "filler" word of the block the free head does point to (which presumably was allocated after the last update of PartInf PartNumOps by the length of the deallocated chain. Change order of operations in ogram). Segments can be created within a partition, e.g. segments may not span partitions. The entire disk can be t    PartNumOps : integer; {how many operations done since last update of PartInfo{return a page to the free list} procedure DeallocChain(firstaddr,lastaddr : DiskAddr; numblks : integer); Block} PartNumFree : FSBit32; {HINT of how many free pages} PartInUse : boolean;  {return a bunch of pages to free list} function WhichPartition(addr : DiskAddoBlock). The filler word has a short pointer to the next "free" page, and forms a linked list to the real free list header {this entry in PartTable is valid} PartMounted : boolean; {this partition is mounted} . Likewise, if the Free tail does not have a next pointer of 0, a deallocate is presumed to have been done since a PartIn PartDevice : integer; {which disk this partition is in} PartStart : DiskAddr; {Disk Address of 1stfoBlock update, and NextAdr pointers are chased to find the real end of the Free List. } {******************} exports {** page} PartEnd : DiskAddr; {Disk Address of last page} PartKind : PartitionTy*************************} imports Arith from Arith; imports ReadDisk from ReadDisk; const MAXDISKS = 2; {Flopppe; {Root or Leaf} PartName : PartString {name of this partition} end; var Dy and HardDisk} MAXPARTITIONS = 10; {Maximum number of mounted partitions} MAXPARTCHARS = 8; {how many characters in aiskTable : array [0..MAXDISKS-1] of DeviceRecord; PartTable : array [1..MAXPARTITIONS] of PartRecord; procedure I partition name} type PartString = string[MAXPARTCHARS]; DeviceRecord = record {entry in the DevinitAlloc; {initialize the AllocDisk module, called during boot} procedure DeviceMount(disk: integer); {mount a disk} proceTable} InfoBlk: DiskAddr; {where the DiskInfoBlock is} InUse : boolean; {this Decedure DeviceDismount(disk : integer); {dismount a disk} function MountPartition(name : string) : integer; {mount a partioviceTable entry is valid} RootPartition: PartString {name of this disk} end; PartRn, return PartTable index} procedure DismountPartition(name : string); ecord = record {entry in the PartTable} PartHeadFree : DiskAddr; {pointer to Head of {dismount a partition} function FindPartition(name : string) : integer; {given a partion name, look  Free List} PartTailFree : DiskAddr; {pointer to tail of Free List} PartInfoBlk : Dis for it in PartTable, return index} function AllocDisk(partition : integer) : DiskAddr; {allocate a kAddr; {pointer to PartInfoBlock} PartRootDir : DiskAddr; {pointer to Root Directory} free page from a partition} procedure DeallocDisk(addr : DiskAddr);  !  to be allocated. This means that some files should be deleted and then the Scavenger should be runer; function ChangeDisk(addr : DiskAddr) : ptrDiskBuffer; function ReadHeader(addr : DiskAddr) : ptrHeader; function C. Parameters: partName is the full partition -------------------------------------------------------} {******************hangeHeader(addr : DiskAddr) : ptrHeader; procedure FlushDisk(addr : DiskAddr); procedure WriteDisk(addr : DiskAddr; ptr : ptr} private {***************************} DiskBuffer; hdptr : ptrHeader); procedure WriteHeader(addr : DiskAddr; ptr : ptrDiskBuffer; hdptr : ptrHeader); procedure InitBuffers; function FindDiskBuffer(dskaddr : DiskAddr; alwaysfind : boolean) : integer; procedure ReleaseBuffer(indx : integeModule ReadDisk; {-------------------------------------------------------------------------- Module to Read and write to thr); procedure FlushBuffer(indx : integer); procedure FlushAll; procedure ChangeBuffer(indx : integer); procedure ChgHdr(indxr) : integer; {given a Disk Address, figure out which partition it is in} proceduree disk using a buffer system Written by the CMU Spice Group ------------------------------------------------------------- DisplayPartitions; {print the PartTable} Exception NoFreePartitions; {-----------------------------------------------------------------} {-------------------------------------------------------------------------- Versions: 12 May 81 BA- Abstract: Raised when too many partitions are accessed at one time. The limit is MAXPARTITIONS. ----------M V1.3 Add exception for Flush failure 20 Apr 81 JPS V1.2 Make ReadDisk use its own segment (BufferSegment) ---------------------------------------------} Exception BadPart(msg, partName: String); {---------------------------------- rather than DiskIO's (DiskSegment). Set the BufferSegment and UnSwappable for------------------- Abstract: Raised when there is something wrong with a partition. This means that the Scaven virtual memory. 14 Apr 81 BAM V1.1 Fixed ForgetAll to set Flags to false. 19 Mar 8ger should be run. Parameters: msg is the problem and partName is the partition name. Print error message as: W1 BAM V1.0 Changed Bit32 to FSBit32. 17 Mar 81 GGR V0.1 Changed number of buffers from 4 to 8. ?? ??? ?? CMriteLn('** ',msg,' for ',partName); -------------------------------------------------------} Exception PartFull(partName: SU Spice Group V0.0 Started --------------------------------------------------------------------------} {***************tring); {----------------------------------------------------- Abstract: Raised when there are no free blocks in a partition***} exports {***************************} imports DiskIO from DiskIO; function ReadDisk(addr : DiskAddr) : ptrDiskBuff! "  if flush had been successful) --------------------------------------------------------------------------} {****d to smaller HASHFRAMESIZE and smaller entry size V1.0 ??-???-?? CMU people Starte**************} private {***************************} d -----------------------------------------------------------------------------} {************************}Exports{**********************************} imports FileDefs from FileDefs; function GetFileID(name : PathName) : SegID; function PutFileID(var name : PathName; id : SegID) : boolean; function DeleteFileID(name : PathName) : SegID; function GetDisk(var name : PathName; var partition : integer) : boolean; var DefaultPartitionName : SimpleName; {includes device name and ends in a Module FileDir; {----------------------------------------------------------------------------- The directory structure for P">" } DefaultDeviceName : SimpleName; {ends in a colon} {************************}Private{***************************ERQ FileSystem Written by: CMU Spice Group -----------------------------------------------------------------------------} *******}  {----------------------------------------------------------------------------- Versions: V2.6 20-Apr-81 John Str : integer); procedure UseBuffer(indx,numtimes : integer); function BufferPointer(indx : integer) : ptrDiskBuffer; function ait Use DiskSegment for allocation. V2.5 3-Apr-81 Brad Myers Fixed bug when creating file with name that  HeaderPointer(indx : integer) : ptrHeader; function ReadAhead(addr : DiskAddr) : ptrDiskBuffer; procedure ForgetAll;  contains .. V2.4 30-Mar-81 Brad Myers Changed name from SpiceDir Exception FlushFail; {-------------------------------------------------------------------------- Abstract: Raised when the s Changed length of Default strings V2.3 26-Mar-81 Brad Myers Added comments V2.2 19-Mar-81 Brad Myers PERQystem is unable to flush out a buffer. The buffer is marked as flushed out, however, so the error will not repeat _String V2.1 11-Mar-81 Brad Myers Fixed Get- Put-InDir so don't read filename if no the next time a buffer needs to be flushed Resume: ALLOWED, but has no effect (procedure will return normally ast inuse V2.0 9-Mar-81 Brad Myers Changed directory syntax to dev:part>dir>fn V1.1 1-Mar-81 Brad Myers Change" # ------------------------------------------------------------} {----------------------------------------------------------------------------- Abstract: Raised if try to truncate file to a length < 0 Parameters: len is bad length --------------------------------- Change history. 28 May 81 V1.7 BAM Changes to Lights module. 26 May 81 V1.6 JPS Use new Lights m--------------------------------------------------------} Exception NotAFile(id: SegID); {----------------------------------odule. 19 May 81 V1.5 BAM Fix position of scavenge light. 12 May 81 V1.4 BAM Prevent scavenge from being recursive. ----------------------------------------- Abstract: Raised when an operation is attempted and the SegID passed does not  7 Mar 81 V1.3 JPS Use DiskSegment for memory allocation. 30 Mar 81 V1.2 BAM Renamed from SpiceSeg 27 Mar 81 V1 seem to be the id for a valid file Parameters: id is the bad id ------------------------------------------------------.1 BAM Added comments; fixed truncate 19 Mar 81 V1.0 BAM Changed Bit32 to FSBit32; add FBLANKSIZE to Index 17 Mar 81 ---------------------} {******************} private {***************************}  V0.2 GGR Fixed bug in SegAddr checking for logical block inconsistency. 6 Mar 81 V0.1 JPS Expmodule PMatch; {-------------------------------------------------------------- Abstract: Does pattern matching on strings ort the Index procedure. ? ??? ?? V0.0 CMU-Spice Group Started --------------------------------------------------------- Patterns accepted are as follows: "*" matches 0 or more characters "&" matches 1 or ------------------} {******************} exports {***************************} imports Arith from Arith; imports DiskImore characters "#" matches exactly 1 character "'0" matches any digit "'A" matcO from DiskIO; imports AllocDisk from AllocDisk; function CreateSpiceSegment(partition : integer; kind : SpiceSegKind) : Sehes any alphabetic (capitals only unless casefold) "'a" matches any alphabetic (lower case only unless 'casefoldgID; procedure DestroySpiceSegment(id : SegID); procedure TruncateSpiceSegment(id : SegID; len : integer); procedure ReadSpic') "'@" matches any non-alphanumeric "'*" matches '*', other patterns chars can be quoted also eSegment(id : SegID; firstblk,numblks : integer; ptr : ptrDiskBuffer); procedure WriteSpiceSegment Written by Gene Ball at CMU --------------------------------------------------------------} {--------------module FileAccess; {--------------------------------------------------------------------------- Module to handle reading, wri(id : SegID; firstblk,numblks : integer; ptr : ptrDiskBuffer); procedure Index(logblk : integer; vting, entering and deleting files independant from the directory structure Written by the CMU Spice Group ---------------ar indblk,indoff : integer); Exception BadLength(len: integer); {-----------------------------------------------------------# $  V1.0 PERQ_String; 17 Mar 81 BAM V0.3 New procedures FSPushSearchItem and Pop; 16 Mar 81 BAM V0.2 Fixed Make------------------------------------------------ Versions: 15-May-81 Brad Myers V2.1 Added new exception and changed module name Use the PERQ_String function uppercase Added commmodule FileUtils; {---------------------------------------------------------------------- Filesystem utilities not needed by ents in 3RCC style ??-Apr-81 Gene Ball V2.0 Fixed bugs in PattMatch and added new prthe system Written by Brad Myers. March 5, 1981. --------------------------------------------------------------------ocedures PattMap and IsPattern 13-Mar-81 Brad Myers V1.1 Fixed a small bug and changed import from --} {---------------------------------------------------------------------- Change history 23 Jun 81 BAM V1.8 Fi PERQ.String to PERQ_String ??-Feb-81 Gene Ball V1.0 Started ------------------------------------------xed so rename when couldn't enter file leaves it in old directory 1 Jun 81 BAM V1.7 Added G--------------------} {/////////////////////////////} Exports {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\} Function PattMatch(var stet and Set FSData procedures 27 May 81 BAM V1.6 Added new exception to rename to handle file exists 19 May 81 BAM V1r,pattern: string; fold: boolean): boolean; Function PattMap(var str,inpatt,outpatt,outstr:string; fold:boolean): boolean; Pro.5 Added new procedure for Extension lookup written by JPS; 12 May 81 BAM V1.4 Added excedure PattDebug(v: boolean); Function IsPattern(var str: string): boolean; Exception BadPatterns; {-----------------------ceptions; 16 Apr 81 BAM V1.3 Fixed so Rename xx to y>..>y works; 28 Mar 81 BAM V1.2 Removed SetPath routine (is ---------------------------------------- Abstract: Raised if outPatt and inPatt do not have the same patterns in in shell); Changed Push and Pop to take SearchList as argument. Added AddTthe same order for PattMap ---------------------------------------------------------------} {/////////////////////////////}oTitleLine procedure so programs will display the current path 26 Mar 81 BAM V1.1 Changed Ma Private {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\} keDirectory so doesn't uppercase the name; checks to see if file exists; and changes the arg  to be the full path name of the new directory Added headers; 19 Mar 81 BAM $ % e to title line after the current path} Exception DelError(FileName: PathName); {--ying to push if Push Resume: ALLOWED; if resume then does the operation anyway ---------------------------------------------------------------------------------------------------------------- Abstract: Raised when can't delete file (because not the--------------------------} Exception SrchErr(fileName: PathName); {--------------------------------------------------------re) Parameters: FileName is file that can't delete ----------------------------------------------------------------------} -------------- Abstract: Raised if try to Pop empty list or push onto full list for the Search List Paramet Exception RenError(msg: String; FileName: PathName); {---------------------------------------------------------------------- ers: '' if Pop; name of item trying to push if Push Resume: NOT allowed ----------------------------------------------------Directory to do more error checking; 5 Mar 81 BAM V0.1 Created this module by breaking off from FileSystem;  Abstract: Raised when can't rename file Parameters: msg is reason can't rename and fileName is file with the  Also Made FSScan faster; added FSMakeDirectory --------------------------------------------------------------- problem. To print message, use "WriteLn('** ',msg,filename);" --------------------------------------------------------------------} {********************} Exports {********************} imports FileSystem from FileSystem; type ptrScanRe---------} Exception MkDirErr(msg: String; dirName: PathName); {------------------------------------------------------------cord = ^ScanRecord; ScanRecord = record InitialCall : boolean; Blk : Dis---------- Abstract: Raised when can't make a directory because 1) a file named dirName already exists kAddr; Entry : Integer; DirName : PathName; end;  2) dirName cannot be entered (bad subdir part) 3) dirName is empty 4) dirName is ROOT.DR (rese Procedure FSDelete(filename: PathName); Function FSScan(scanptr : ptrScanRecord; var name : SimpleName; rved directory name) Parameters: msg explains problem with makedir attempt; dirName is name attempted to use var id : FileID) : boolean; Procedure FSRename(SrcName, DestName: PathName); Function FSMakeDirectory(var DirName: Pa. Use "WriteLn('** ',msg,dirName);" ----------------------------------------------------------------------} EthName): FileID; Procedure FSSetSearchList(sList: SearchList); Procedure FSPopSearchItem(var sList: SearchList); Procedure FSxception SrchWarn(fileName: PathName); {---------------------------------------------------------------------- Abstract: RaPushSearchItem(name: PathName; var sList: SearchList); Procedure FSAddToTitleLine(msg: String); {adds as much of msg as possiblised if try to Pop last item or push into last hole of the Search List Parameters: '' if Pop; name of item tr% & id: FileID; pData: ptrFSDataEntry); Procedure FSSetFSData(id: FileID; pData: ptrFSDataEntry); {********************} Priva 2; DirFile = 3; ExDirFile = 4; FontFile = 5; RunFile = 6; TextFile = 7; {for non-Pas texte {********************} t files} CursorFile = 8; {cursor bin files} BinaryFile = 9; BinFile = 10; {microcode output} MicroFile = 11; ComFile = 12; RelFile = 13; IncludeFile = 14; {included in a pas file} SBootFile = 15; {system part of boot file} MBootFile = 16; {microcode part} SwapFile = 17; {a file used for swapping by compilerModule FileTypes; {----------------------------------------------------------------------------- This module exports the Type or editor; length not set} BadFile = 18; {created by the scavenger} {\\\\\\\\\\\\\\s put in the FileType field of File FIBs. The types are stored as integers. Three Rivers reserves the first 512 types for \\\\\\\\\\\\} PRIVATE {/////////////////////////} their use. Customers are encouraged to choose numbers > 512 if they invent new file types Written by Brad A. Myers Feb.------------------} Function FSExtSearch(var SList : SearchList; Extensions: String; var FileName : Pa 2, 1981 Copyright (C) 1980 Three Rivers Computer Corporation ------------------------------------------------------------thName; var BlksInFile, BitsInLBlkInLBlk: Integer) : FileID; -----------------} {----------------------------------------------------------------------------- Versions: V1.2 Exception RenToExist(fileName: PathName); {---------------------------------------------------------------------- Abstract: 1-May-81 Brad Myers Added SwapFile and BadFile Changed name of BootFile to SBootFile to Raised if filename renaming to already exists Parameters: fileName is new name that already exists Resume: ALLOWED; If you remove name conflict V1.1 31-Mar-81 Brad Myers Added BootFile and MBootFile  wish to rename anyway; just continue and FSRename will delete the DestName; In this case; you should be prepared  V1.0 2-Feb-81 Brad Myers Started -----------------------------------------------------------------------------} {\\\\\ to accept DelError; ----------------------------------------------------------------------} Procedure FSGetFSData(\\\\\\\\\\\\\\\\\\\\\} EXPORTS {/////////////////////////} Const UnknownFile = 0; SegFile = 1; PasFile =& ' AS Get IOPRIV.PAS IO_PRIVATE.PAS Get IOINIT.PAS IO_INIT.PAS Get FILESY.PAS FILESYSTEM.PAS Get FILEDE.PAS FILEDEFS.PAS Get DISKIO.PAS DISKIO.PAS Get ALLOCD.PAS ALLOCDISK.PAS Get READDI.PAS  READDISK.PAS Get FILEDI.PAS FILEDIR.PAS Get FILEAC.PAS FILEACCESS.PAS Get PMATCH.PAS PMATCH.PAS Get FILEUT.PAS FILEUTILS.PAS Get FILETY.PAS FILETYPES.PAS Sides 2 Density SINGLE Fast ! OS.IO.SOURCE - INPUT/OUTPUT SYSTEM SOURCE MODULES ! Created 19 Jul 81 17:23:34 Get SCREEN.PAS SCREEN.PAS Get RASTER.PAS RASTER.PAS Get IOERRO.PAS IOERRORS.PAS Get IOERRM.PAS  IOERRMESSAGES.PAS Get IO.PAS IO.PAS Get IOOTHE.PAS IO_OTHERS.PAS Get IOUNIT.PAS IO_UNIT.P' ( ( ) ) * * + + , , - - . . / / 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 : : ; ; < < = = > > ? ? @ @ A A B B C C D D E E F F G G H H I I J J K K L L