runtime: bugfix stack corruption in MEMAVAIL

- 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

@@ -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.

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
 

lib/runtime.s

@@ -1787,6 +1787,7 @@ MAV_L:
 	CMPU NE
 	CBRANCH MAV_L       ; if not equal, loop
 MAX_XT:
+	DROP	; drop chunk ptr
 	LOAD 0	; put result value on stack
 	FPADJ 4
 	RET

lib/stdlib.inc

@@ -18,8 +18,9 @@ const IONoError 	=  0;
       IOReadOnly 	=  8;
       IOInvalidOp	=  9;
       IOInvalidFormat   = 10;
-      IOUserIntr	= 11;
+      IONoMem		= 11;
-      IOMaxErr          = 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;

lib/stdlib.pas

@@ -26,8 +26,9 @@ const IONoError 	=  0;
       IOReadOnly 	=  8;
       IOInvalidOp	=  9;
       IOInvalidFormat   = 10;
-      IOUserIntr	= 11;
+      IONoMem		= 11;
-      IOMaxErr          = 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);
+			newOrNil(dirCache);
-		openFilesCount := openFilesCount + 1;
+		if dirCache <> nil then
+			openFilesCount := openFilesCount + 1
+		else
+			error := IONoMem;
 	end;
 end;
 
@@ -2036,7 +2042,11 @@ begin
 
 	aFile.typ := IODiskFile;
 	aFile.mode := mode;
-	new(aFile.buffer);
+	newOrNil(aFile.buffer);
+	if aFile.buffer = nil then
+		fileerror(aFile, IONoMem)
+	else
+	begin
 		aFile.bufpos := 0;
 		aFile.bufsize := DefaultBufSize;
 		aFile.needsflush := false;
@@ -2054,6 +2064,7 @@ begin
 
 		seek(aFile,0);
 	end;
+end;
 
 procedure updatedirslot(var aFile:file);
 var dirs: DirectorySlot;
@@ -2269,7 +2280,8 @@ begin
 
 	if volid > 0 then
 	begin
-		openvolumeid(volid);
+		openvolumeid(volid, error);
+		if error = 0 then
 			slotno := findfile(volid, fname, dirs, error)
 	end
 	else

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;
 
-		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 typeContainsString(memLoc.typ.pointedType^) then
+			emitClearAlloc(memLoc.typ.pointedType);
+	end;
+	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:

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);

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;

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);

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

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