From 14d6de059d8bd17afa76d0fee9e88eaf97d1337e Mon Sep 17 00:00:00 2001 From: slederer Date: Sun, 31 Aug 2025 23:30:40 +0200 Subject: [PATCH] implement newOrNil, changes to stdlib - newOrNil works like new, but sets the variable to nil if the heap allocation failed - change stdlib to use newOrNil in openfile and openvolumeid - changes to programs that use openvolumeid --- doc/pascalprogramming.md | 3 +- lib/corelib.s | 3 ++ lib/stdlib.inc | 7 +++-- lib/stdlib.pas | 60 ++++++++++++++++++++++++---------------- pcomp/pcomp.pas | 26 +++++++++-------- progs/dumpdir.pas | 4 +-- progs/reclaim.pas | 5 ++-- progs/recover.pas | 4 +-- progs/shell.pas | 2 +- progs/xfer.pas | 2 +- 10 files changed, 68 insertions(+), 48 deletions(-) diff --git a/doc/pascalprogramming.md b/doc/pascalprogramming.md index b534f2b..1c53cc1 100644 --- a/doc/pascalprogramming.md +++ b/doc/pascalprogramming.md @@ -193,7 +193,8 @@ Possible error codes from _IOResult_ are: | 8 | IOReadOnly | file is readonly | | | 9 | IOInvalidOp | invalid operation | | | 10 | IOInvalidFormat | invalid format | when parsing numbers with _read_ | -| 11 | IOUserIntr | interrupted by user | program terminated by ^C, not visible from _IOResult_ | +| 11 | IONoMem | not enough memory | heap allocation failed inside the standard library, e.g. open() | +| 12 | IOUserIntr | interrupted by user | program terminated by ^C, not visible from _IOResult_ | ### Read, Readln and Line Input In Turbo Pascal, using _read_ (and _readln_) from the console always waits until a complete line has been entered. diff --git a/lib/corelib.s b/lib/corelib.s index 6970971..8b8f403 100644 --- a/lib/corelib.s +++ b/lib/corelib.s @@ -612,6 +612,9 @@ WAIT1LOOP: ; length must be multiple of wordsize. ; if it is not, the last (partial) word is not cleared. _CLEARMEM: + OVER ; check for null pointer + CBRANCH.Z CLEARMEM_X + SHR SHR ; calculate length in words diff --git a/lib/stdlib.inc b/lib/stdlib.inc index 3ba4a4c..5304403 100644 --- a/lib/stdlib.inc +++ b/lib/stdlib.inc @@ -18,8 +18,9 @@ const IONoError = 0; IOReadOnly = 8; IOInvalidOp = 9; IOInvalidFormat = 10; - IOUserIntr = 11; - IOMaxErr = 11; + IONoMem = 11; + IOUserIntr = 12; + IOMaxErr = 12; const PArgMax = 7; @@ -206,7 +207,7 @@ procedure readvolumeblks(volumeid:integer; destbuf:^iobuffer; blkno:integer; blk procedure writevolumeblks(volumeid:integer; srcbuf:^iobuffer; blkno:integer; blkCount: integer; var error:integer); external; function findvolume(name:string):integer; external; -procedure openvolumeid(volid:integer); external; +procedure openvolumeid(volid:integer;var error:integer); external; procedure closevolumeid(volid:integer); external; function IOResult(var fil:file):integer; external; function ErrorStr(err:integer):string; external; diff --git a/lib/stdlib.pas b/lib/stdlib.pas index dc122eb..dd6294c 100644 --- a/lib/stdlib.pas +++ b/lib/stdlib.pas @@ -26,8 +26,9 @@ const IONoError = 0; IOReadOnly = 8; IOInvalidOp = 9; IOInvalidFormat = 10; - IOUserIntr = 11; - IOMaxErr = 11; + IONoMem = 11; + IOUserIntr = 12; + IOMaxErr = 12; const PArgMax = 7; @@ -133,7 +134,7 @@ var DefaultVolumeId:integer; character to the runtime error routine which takes null-terminated strings. *) -var ioerrordesc: array [0..11] of string[20] = ( +var ioerrordesc: array [0..IOMaxErr] of string[20] = ( 'No error', 'File not found', 'Volume not found', @@ -145,6 +146,7 @@ var ioerrordesc: array [0..11] of string[20] = ( 'File is readonly', 'Invalid operation', 'Invalid format', + 'Not enough memory', 'Interrupted by user' ); @@ -1554,13 +1556,17 @@ begin end; end; -procedure openvolumeid(volid:integer); +procedure openvolumeid(volid:integer;var error:integer); begin + error := 0; with volumeTable[volid] do begin if dirCache = nil then - new(dirCache); - openFilesCount := openFilesCount + 1; + newOrNil(dirCache); + if dirCache <> nil then + openFilesCount := openFilesCount + 1 + else + error := IONoMem; end; end; @@ -2036,23 +2042,28 @@ begin aFile.typ := IODiskFile; aFile.mode := mode; - new(aFile.buffer); - aFile.bufpos := 0; - aFile.bufsize := DefaultBufSize; - aFile.needsflush := false; - aFile.changed := false; - aFile.lastError := 0; - aFile.errorAck := false; - aFile.volumeid := volid; - aFile.fileno := slotno; - aFile.filpos := 0; - aFile.bufStart := 1; - aFile.size := dirslot.sizeBytes; - aFile.sizeExtents := dirslot.sizeBytes div extentSize + 1; - aFile.bufBlocks := DefaultBufBlocks; - aFile.extentBlocks := extentSize div 512; + newOrNil(aFile.buffer); + if aFile.buffer = nil then + fileerror(aFile, IONoMem) + else + begin + aFile.bufpos := 0; + aFile.bufsize := DefaultBufSize; + aFile.needsflush := false; + aFile.changed := false; + aFile.lastError := 0; + aFile.errorAck := false; + aFile.volumeid := volid; + aFile.fileno := slotno; + aFile.filpos := 0; + aFile.bufStart := 1; + aFile.size := dirslot.sizeBytes; + aFile.sizeExtents := dirslot.sizeBytes div extentSize + 1; + aFile.bufBlocks := DefaultBufBlocks; + aFile.extentBlocks := extentSize div 512; - seek(aFile,0); + seek(aFile,0); + end; end; procedure updatedirslot(var aFile:file); @@ -2269,8 +2280,9 @@ begin if volid > 0 then begin - openvolumeid(volid); - slotno := findfile(volid, fname, dirs, error) + openvolumeid(volid, error); + if error = 0 then + slotno := findfile(volid, fname, dirs, error) end else error := IOVolNotFound; diff --git a/pcomp/pcomp.pas b/pcomp/pcomp.pas index d7be8a5..73947a1 100644 --- a/pcomp/pcomp.pas +++ b/pcomp/pcomp.pas @@ -43,7 +43,7 @@ type TokenType = ( ArrayType, RecordType, PointerType, StringCharType, EnumType, SetType, UnresolvedType ); - SpecialProc = ( NoSP, NewSP, DisposeSP, ReadSP, WriteSP, ReadlnSP, WritelnSP, + SpecialProc = ( NoSP, NewSP, New0SP, DisposeSP, ReadSP, WriteSP, ReadlnSP, WritelnSP, SetlengthSP, ValSP, StrSP, ExitSP ); SpecialFunc = ( NoSF, TruncSF, FracSF, IntSF, SqrSF, SuccSF, PredSF, OddSF, ChrSF, OrdSF, AbsSF); @@ -291,7 +291,7 @@ var 'UNIT', 'IMPLEMENTATION', 'INTERFACE', 'USES', '_' ); specialprocnames: array [SpecialProc] of string[12] = ( - '_', 'NEW', 'DISPOSE', 'READ', 'WRITE', 'READLN', 'WRITELN', 'SETLENGTH', + '_', 'NEW', 'NEWORNIL', 'DISPOSE', 'READ', 'WRITE', 'READLN', 'WRITELN', 'SETLENGTH', 'VAL','STR', 'EXIT'); specialfuncnames: array [SpecialFunc] of string[8] = ( '_', 'TRUNC', 'FRAC', 'INT', 'SQR', 'SUCC', 'PRED', 'ODD', @@ -4500,7 +4500,7 @@ begin isFunction := aProc^.returnType.baseType <> NoType; end; -procedure parseNew; +procedure parseNew(checkNil:boolean); var memLoc: MemLocation; typeReturn: TypeSpec; begin @@ -4526,17 +4526,17 @@ begin emitLoadConstantInt(memLoc.typ.pointedType^.size); emitMemAlloc; + (*We need to call CLEARMEM when the allocated type + contains strings. + INITSTRING checks if the header is non-zero to see if + the string is already initialized, and the allocated + chunk might contain random data so it would look + like an initialized string. *) if typeContainsString(memLoc.typ.pointedType^) then emitClearAlloc(memLoc.typ.pointedType); end; - emitCheckAlloc; - - (*We need to call CLEARMEM when the allocated type - contains strings. - INITSTRING checks if the header is non-zero to see if - the string is already initialized, and the allocated - chunk might contain random data so it would look - like an initialized string. *) + if checkNil then + emitCheckAlloc; writeVariable(memLoc); @@ -5017,7 +5017,9 @@ begin NoSP: errorExit2('internal error in parseSpecialProcCall', lastToken.tokenText); NewSP: - parseNew; + parseNew(true); + New0SP: + parseNew(false); DisposeSP: parseDispose; ReadSP: diff --git a/progs/dumpdir.pas b/progs/dumpdir.pas index 584e812..7411cae 100644 --- a/progs/dumpdir.pas +++ b/progs/dumpdir.pas @@ -14,8 +14,8 @@ var dirs:DirectorySlot; error:integer; begin lastSlot := volumeTable[volid].part.dirSize - 1; - openvolumeid(volid); - + openvolumeid(volid, error); (* we just ignore error here because + we should always have enough heap space *) for i := 0 to lastSlot do begin getdirslot(volid, i, dirs, error); diff --git a/progs/reclaim.pas b/progs/reclaim.pas index 9983501..fed0e90 100644 --- a/progs/reclaim.pas +++ b/progs/reclaim.pas @@ -123,7 +123,8 @@ begin freeAreaCount := 0; lastUsed := 0; - openvolumeid(volid); + openvolumeid(volid, error); + (* ignoring theoretically possible out-of-heap-error *) i := 0; endSlot := volumeTable[volid].part.dirSize - 1; @@ -308,7 +309,7 @@ begin writeln('Volume ', volname, ' not found.') else begin - openvolumeid(volid); + openvolumeid(volid, error); endSlot := volumeTable[volid].part.dirSize - 1; extentSize := volumeTable[volid].part.extentSize; diff --git a/progs/recover.pas b/progs/recover.pas index cca6204..b2303b2 100644 --- a/progs/recover.pas +++ b/progs/recover.pas @@ -102,8 +102,8 @@ begin count := PageMargin; lastSlot := volumeTable[volid].part.dirSize - 1; - openvolumeid(volid); - + openvolumeid(volid, error); + (* ignoring theoretically possible out-of-heap-space error *) for i := 0 to lastSlot do begin getdirslot(volid, i, dirs, error); diff --git a/progs/shell.pas b/progs/shell.pas index 6423b3f..84920d6 100644 --- a/progs/shell.pas +++ b/progs/shell.pas @@ -149,7 +149,7 @@ begin count := PageMargin; writeln('reading directory of ', DefaultVolume); - openvolumeid(volid); + openvolumeid(volid, error); readdirfirst(volid, index, dirs, error); while index > 0 do begin diff --git a/progs/xfer.pas b/progs/xfer.pas index 7a4a389..13a7cc2 100644 --- a/progs/xfer.pas +++ b/progs/xfer.pas @@ -398,7 +398,7 @@ begin writeln('Volume ', DefaultVolume, ' not found.') else begin - openvolumeid(volid); + openvolumeid(volid, error); readdirfirst(volid, index, dirs, error); while (index > 0) and (error = 0) do begin