aboutsummaryrefslogtreecommitdiff
path: root/sys/nmemio/zzfoo.gx
diff options
context:
space:
mode:
Diffstat (limited to 'sys/nmemio/zzfoo.gx')
-rw-r--r--sys/nmemio/zzfoo.gx587
1 files changed, 587 insertions, 0 deletions
diff --git a/sys/nmemio/zzfoo.gx b/sys/nmemio/zzfoo.gx
new file mode 100644
index 00000000..5de60c5b
--- /dev/null
+++ b/sys/nmemio/zzfoo.gx
@@ -0,0 +1,587 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# Test procedures for the NMEMIO interface.
+#
+
+include <mach.h>
+
+
+define MT_HEAP 0 # test heap memory
+define MT_STACK 1 # test stack memory
+
+
+task memtest = t_memtest,
+ stack = t_stack,
+ realloc = t_realloc
+
+
+# MEMTEST -- Task to test new memio interface.
+
+procedure t_memtest ()
+
+int model, nerr
+pointer str, ptr
+
+bool clgetb()
+
+begin
+ if (clgetb ("stack"))
+ model = MT_STACK
+ else
+ model = MT_HEAP
+
+ # Check we can allocate a large array.
+ if (model == MT_HEAP) {
+ call eprintf ("\nBegin large heap malloc tests ....\n\n")
+ call malloc (str, 256000, TY_STRUCT)
+ call mfree (str, TY_STRUCT)
+ call eprintf ("Done\n\n")
+
+ # Print the memory layout.
+ $for (csiblrdx)
+ call mt_print (TY_PIXEL)
+ $endfor
+ call mt_print (TY_STRUCT)
+ call mt_print (TY_POINTER)
+ }
+
+ # Test Mem common assignments
+ call eprintf ("\nBegin assignment tests ....\n\n");
+ call mt_auto_b ("bool ", model)
+ call mt_auto_c ("char ", model)
+ call mt_auto_s ("short ", model)
+ call mt_auto_i ("int ", model)
+ call mt_auto_l ("long ", model)
+ call mt_auto_r ("real ", model)
+ call mt_auto_d ("double ", model)
+ call mt_auto_x ("complex", model)
+ call eprintf ("\nEnd assignment tests ....\n\n");
+
+
+ # Test string memory
+ call eprintf ("Begin Memc test\t\t");
+ call calloc (str, SZ_LINE, TY_CHAR)
+ call aclrc (Memc[str], SZ_LINE)
+ call strcpy ("test string", Memc[str], SZ_LINE)
+ call eprintf ("str = '%s' ch[2] = '%c' (should be 's')\n")
+ call pargstr (Memc[str])
+ call pargc (Memc[str+2])
+ call mfree (str, TY_CHAR)
+
+
+ # Test the struct memory
+ call eprintf ("\n\n")
+ call eprintf ("Begin struct test\n")
+ call mt_struct (model)
+ call eprintf ("Done\n")
+
+
+ # Test memory overflow and then underflow detection.
+ call eprintf ("\n\n")
+ call eprintf ("Testing overflow:\t")
+ nerr = 0
+ $for (csiblrdx)
+ iferr ( call mt_overflow (TY_PIXEL) )
+ nerr = nerr + 1;
+ $endfor
+ iferr ( call mt_overflow (TY_STRUCT) )
+ nerr = nerr + 1;
+ iferr ( call mt_overflow (TY_POINTER) )
+ nerr = nerr + 1;
+ call eprintf ("No. errors detected = %d of 10\t\tDone\n")
+ call pargi (nerr)
+
+
+ call eprintf ("Testing underflow:\t")
+ nerr = 0
+ $for (csiblrdx)
+ iferr ( call mt_underflow (TY_PIXEL) )
+ nerr = nerr + 1;
+ $endfor
+ iferr ( call mt_underflow (TY_STRUCT) )
+ nerr = nerr + 1;
+ iferr ( call mt_underflow (TY_POINTER) )
+ nerr = nerr + 1;
+ call eprintf ("No. errors detected = %d of 10\t\tDone\n")
+ call pargi (nerr)
+
+
+ # Note this test will leak 1024 bytes because of the error recovery.
+ call eprintf ("Testing invalid free:\t")
+ call calloc (ptr, 256, TY_REAL)
+ iferr ( call mfree (ptr, TY_INT) )
+ call eprintf ("Detected\t\t\t\t")
+ else
+ call eprintf ("Undetected\t\t\t\t")
+ call eprintf ("Done\n")
+
+ call eprintf ("Testing double free:\t")
+ call calloc (ptr, 256, TY_INT)
+ call mfree (ptr, TY_INT)
+ iferr ( call mfree (ptr, TY_INT) )
+ call eprintf ("Detected\t\t\t\t")
+ else
+ call eprintf ("Undetected\t\t\t\t")
+ call eprintf ("Done\n")
+
+ call eprintf ("Testing NULL free:\t")
+ iferr ( call mfree (NULL, TY_INT) )
+ call eprintf ("Detected\t\t\t\t")
+ else
+ call eprintf ("Undetected\t\t\t\t")
+ call eprintf ("Done\n")
+
+ call eprintf ("Testing recovered free:\n")
+ call calloc (str, SZ_LINE, TY_CHAR)
+ call eprintf ("Done\n")
+
+ call eprintf ("\n\nEnd of NMEMIO tests\n")
+end
+
+
+
+# Test the SALLOC routine, which allocates storage on the stack.
+
+procedure t_stack ()
+
+int bufsize
+pointer sp, junk
+int clglpi()
+
+begin
+ call smark (sp)
+
+ while (clglpi ("buffer_size", bufsize) != EOF) {
+ call salloc (junk, bufsize, TY_CHAR)
+ call printf ("buffer pointer=%d, size=%d\n")
+ call pargi (junk)
+ call pargi (bufsize)
+ call flush (STDOUT)
+ }
+
+ call sfree (sp)
+end
+
+
+# Test the REALLOC procedure, used to change the size of a buffer.
+# Work with two buffers, so that memory can be fragmented, forcing buffers
+# to move.
+
+procedure t_realloc()
+
+pointer a, b
+int i, sza, new_sza, szb, new_szb
+
+begin
+ sza = SZ_FNAME
+ szb = SZ_LINE
+
+ call malloc (a, sza, TY_CHAR)
+ call malloc (b, szb, TY_CHAR)
+ call strcpy ("abcdefghijk", Memc[a], ARB)
+ call strcpy ("0123456789", Memc[b], ARB)
+
+ call eprintf ("a is at %d, size %d: %s\n")
+ call pargi (a)
+ call pargi (sza)
+ call pargstr (Memc[a])
+ call eprintf ("b is at %d, size %d: %s\n")
+ call pargi (b)
+ call pargi (szb)
+ call pargstr (Memc[b])
+ call eprintf ("-------------------------------\n")
+
+ for (i=1; i <= 10; i=i+1) {
+ if (i < 5) {
+ new_sza = sza + 512 ; new_szb = szb + 256
+ } else {
+ new_sza = sza + 256 ; new_szb = szb + 512
+ }
+ call realloc (a, new_sza, TY_CHAR)
+ call realloc (b, new_szb, TY_CHAR)
+
+ call eprintf ("%2d: a buf %d, size %d --> %d: %s\n")
+ call pargi (i)
+ call pargi (a)
+ call pargi (sza)
+ call pargi (new_sza)
+ call pargstr (Memc[a])
+ call eprintf ("%2d: b buf %d, size %d --> %d: %s\n")
+ call pargi (i)
+ call pargi (b)
+ call pargi (szb)
+ call pargi (new_szb)
+ call pargstr (Memc[b])
+
+ sza = new_sza
+ szb = new_szb
+ }
+
+ call mfree (a, TY_CHAR)
+ call mfree (b, TY_CHAR)
+end
+
+
+
+define SZ_TEST 640
+define F_I1 Memi[$1]
+define F_I2 Memi[$1+1]
+define F_L1 Meml[$1+2]
+define F_L2 Meml[$1+3]
+define F_R1 Memr[$1+4]
+define F_R2 Memr[$1+5]
+define F_D1 Memd[P2D($1+8)]
+define F_D2 Memd[P2D($1+10)]
+define F_I3 Memi[$1+12]
+define F_I4 Memi[$1+13]
+define F_S1 Mems[P2S($1+14)]
+define F_S2 Mems[P2S($1+15)]
+
+
+procedure mt_struct (model)
+
+int model
+
+pointer sp, str
+real x, y, z
+double d1, d2, d3
+
+int locva()
+
+begin
+ if (model == MT_HEAP) {
+ call malloc (str, SZ_TEST, TY_STRUCT)
+ } else {
+ call smark (sp)
+ call salloc (str, SZ_TEST, TY_STRUCT)
+ }
+
+
+ F_I1(str) = 1
+ F_I2(str) = 2
+ F_L1(str) = 3
+ F_L2(str) = 4
+ F_R1(str) = 5.0
+ F_R2(str) = 6.0
+ F_D1(str) = 7.0
+ F_D2(str) = 8.0
+ F_I3(str) = 9
+ F_I4(str) = 10
+ F_S1(str) = 11
+ F_S2(str) = 12
+
+ x = 2.717 ; d1 = F_R1(str)
+ y = 2.717 ; d2 = 3.14159d0 ;
+ z = double(x) ; d3 = double(3.14159)
+
+ call eprintf ("\nd1=%.6g d2=%.6g d3=%.6g x=%.6g y=%.6g z=%.6g)\n\n")
+ call pargd (d1) ; call pargd (d2) ; call pargd (d3)
+ call pargr (x) ; call pargr (y) ; call pargr (z)
+
+ call eprintf ("Done Setting values ....\n\ntest = %d %d %d\n\n")
+ call pargi (str)
+ call pargi (locva(str))
+ call pargi (locva(F_I1(str)))
+
+ # call mdump (str, 64)
+
+ call eprintf ("I1 = %4d I2 = %4d \t%d %d\n")
+ call pargi (F_I1(str)) ; call pargi (F_I2(str))
+ call pargi (locva(F_I1(str))) ; call pargi (locva(F_I2(str)))
+
+ call eprintf ("L1 = %4d L2 = %4d \t%d %d\n")
+ call pargl (F_L1(str)) ; call pargl (F_L2(str))
+ call pargi (locva(F_L1(str))) ; call pargi (locva(F_L2(str)))
+
+ call eprintf ("R1 = %4.1f R2 = %4.1f \t%d %d\n")
+ call pargr (F_R1(str)) ; call pargr (F_R2(str))
+ call pargi (locva(F_R1(str))) ; call pargi (locva(F_R2(str)))
+
+ call eprintf ("D1 = %4.1f D2 = %4.1f \t%d %d\n")
+ call pargd (F_D1(str)) ; call pargd (F_D2(str))
+ call pargi (locva(F_D1(str))) ; call pargi (locva(F_D2(str)))
+
+ call eprintf ("I3 = %4d I4 = %4d \t%d %d\n")
+ call pargi (F_I3(str)) ; call pargi (F_I4(str))
+ call pargi (locva(F_I3(str))) ; call pargi (locva(F_I4(str)))
+
+ call eprintf ("S1 = %4d S2 = %4d \t%d %d\n")
+ call pargs (F_S1(str)) ; call pargs (F_S2(str))
+ call pargi (locva(F_S1(str))) ; call pargi (locva(F_S2(str)))
+
+
+ if (model == MT_HEAP)
+ call mfree (str, TY_STRUCT)
+ else
+ call sfree (sp)
+end
+
+
+define NVALS 3
+
+procedure mt_print (dtype)
+
+int dtype
+
+int i, locva(), coerce()
+real x
+double xx
+pointer p, bp, lwl
+
+begin
+ call calloc (p, NVALS, dtype)
+ bp = coerce (p, dtype, TY_INT)
+
+ # Set the values.
+ for (i=0; i < NVALS; i=i+1) {
+ x = i ; xx = i
+ switch (dtype) {
+ case TY_BOOL: Memb[p+i] = TRUE
+ case TY_CHAR: Memc[p+i] = 'a' + i
+ case TY_SHORT: Mems[p+i] = i
+ case TY_INT: Memi[p+i] = i
+ case TY_LONG: Meml[p+i] = i
+ case TY_REAL: Memr[p+i] = x
+ case TY_DOUBLE: Memd[p+i] = xx
+ case TY_COMPLEX: Memx[p+i] = cmplx(x,-x)
+
+ case TY_STRUCT: Memi[p+i] = i
+ case TY_POINTER: Memi[p+i] = i
+ }
+ }
+
+ # Print the ptr header.
+ call eprintf ("\n")
+ call eprintf (" p = 0x%-15x %-16d\t%d\n")
+ call pargi (p) ; call pargi (p) ; call pargi (locva(Memi[bp]))
+ call eprintf (" fwa = 0x%-15x %-16d\t%d\n")
+ call pargi (bp-5) ; call pargi (Memi[bp-5])
+ call pargi (locva (Memi[bp-5]))
+ call eprintf (" lwl = 0x%-15x %-16d\t%d\n")
+ call pargi (bp-4) ; call pargi (Memi[bp-4])
+ call pargi (locva (Memi[bp-4]))
+ call eprintf (" dtype = 0x%-15x %-16d\t%d\n")
+ call pargi (bp-3) ; call mptype (dtype)
+ call pargi (locva (Memi[bp-3]))
+ call eprintf (" nelem = 0x%-15x %-16d\t%d\n")
+ call pargi (bp-2) ; call pargi (Memi[bp-2])
+ call pargi (locva (Memi[bp-2]))
+ call eprintf ("L sentinal = 0x%-15x %-16d\t%d\n")
+ call pargi (bp-1) ; call pargi (Memi[bp-1])
+ call pargi (locva (Memi[bp-1]))
+
+
+ # Print the values.
+ call eprintf (" data = ")
+ for (i=0; i < NVALS; i=i+1) {
+ switch (dtype) {
+ case TY_BOOL:
+ call eprintf (" %3b\t\t\t\t\t%-15d")
+ call pargb (Memb[p+i])
+ call pargi (locva(Memb[p+i]))
+ case TY_CHAR:
+ call eprintf (" %3c\t\t\t\t\t%-15d")
+ call pargc (Memc[p+i])
+ call pargi (locva(Memc[p+i]))
+ case TY_SHORT:
+ call eprintf (" %3d\t\t\t\t\t%-15d")
+ call pargs (Mems[p+i])
+ call pargi (locva(Mems[p+i]))
+ case TY_INT:
+ call eprintf (" %3d\t\t\t\t\t%-15d")
+ call pargi (Memi[p+i])
+ call pargi (locva(Memi[p+i]))
+ case TY_LONG:
+ call eprintf (" %3d\t\t\t\t\t%-15d")
+ call pargl (Meml[p+i])
+ call pargi (locva(Meml[p+i]))
+ case TY_REAL:
+ call eprintf (" %3g\t\t\t\t\t%-15d")
+ call pargr (Memr[p+i])
+ call pargi (locva(Memr[p+i]))
+ case TY_DOUBLE:
+ call eprintf (" %3g\t\t\t\t\t%-15d")
+ call pargd (Memd[p+i])
+ call pargi (locva(Memd[p+i]))
+ case TY_COMPLEX:
+ call eprintf (" %3x\t\t\t\t\t%-15d")
+ call pargx (Memx[p+i])
+ call pargi (locva(Memx[p+i]))
+ case TY_STRUCT:
+ call eprintf (" %3d\t\t\t\t\t%-15d")
+ call pargi (Memi[p+i])
+ call pargi (locva(Memi[p+i]))
+ case TY_POINTER:
+ call eprintf (" %3d\t\t\t\t\t%-15d")
+ call pargi (Memi[p+i])
+ call pargi (locva(Memi[p+i]))
+ }
+ call eprintf ("\n")
+ if (i < (NVALS-1))
+ call eprintf ("\t\t")
+ }
+
+ lwl = Memi[bp-4]
+ call eprintf ("U sentinal = 0x%-15x %-15d\t\t%d\n\n")
+ call pargi (lwl) ; call pargi (Memi[lwl])
+ call pargi (locva (Memi[lwl]))
+
+ call mfree (p, dtype)
+end
+
+
+procedure mt_overflow (dtype)
+
+int dtype
+
+int i
+real x
+double xx
+pointer p
+
+begin
+ call calloc (p, NVALS, dtype)
+
+ # Set the values.
+ for (i=0; i < NVALS + 4; i=i+1) {
+ x = i ; xx = i
+ switch (dtype) {
+ case TY_BOOL: Memb[p+i] = TRUE
+ case TY_CHAR: Memc[p+i] = 'a' + i
+ case TY_SHORT: Mems[p+i] = i
+ case TY_INT: Memi[p+i] = i
+ case TY_LONG: Meml[p+i] = i
+ case TY_REAL: Memr[p+i] = x
+ case TY_DOUBLE: Memd[p+i] = xx
+ case TY_COMPLEX: Memx[p+i] = cmplx(x,-x)
+ case TY_STRUCT: Memi[p+i] = i
+ case TY_POINTER: Memi[p+i] = i
+ }
+ }
+
+ call mfree (p, dtype)
+end
+
+
+procedure mt_underflow (dtype)
+
+int dtype
+
+int i
+real x
+double xx
+pointer p
+
+begin
+ call calloc (p, NVALS, dtype)
+
+ # Set the values.
+ for (i=0; i < NVALS; i=i+1) {
+ x = i ; xx = i
+ switch (dtype) {
+ case TY_BOOL: Memb[p+i] = TRUE ; Memb[p-1] = FALSE
+ case TY_CHAR: Memc[p+i] = 'a' + i ; Memc[p-1] = '0'
+ case TY_SHORT: Mems[p+i] = i ; Mems[p-1] = 999
+ case TY_INT: Memi[p+i] = i ; Memi[p-1] = 999
+ case TY_LONG: Meml[p+i] = i ; Meml[p-1] = 999
+ case TY_REAL: Memr[p+i] = x ; Memr[p-1] = 999
+ case TY_DOUBLE: Memd[p+i] = xx ; Memd[p-1] = 999
+ case TY_COMPLEX: Memx[p+i] = cmplx(x,-x) ; Memx[p-1] = 999
+ case TY_STRUCT: Memi[p+i] = i ; Memi[p-1] = 999
+ case TY_POINTER: Memi[p+i] = i ; Memi[p-1] = 999
+ }
+ }
+
+ call mfree (p, dtype)
+end
+
+
+procedure mptype (dtype)
+int dtype
+begin
+ switch (dtype) {
+ case TY_BOOL: call pargstr ("TY_BOOL ")
+ case TY_CHAR: call pargstr ("TY_CHAR ")
+ case TY_SHORT: call pargstr ("TY_SHORT ")
+ case TY_INT: call pargstr ("TY_INT ")
+ case TY_LONG: call pargstr ("TY_LONG ")
+ case TY_REAL: call pargstr ("TY_REAL ")
+ case TY_DOUBLE: call pargstr ("TY_DOUBLE ")
+ case TY_COMPLEX: call pargstr ("TY_COMPLEX")
+ case TY_STRUCT: call pargstr ("TY_STRUCT ")
+ case TY_POINTER: call pargstr ("TY_POINTER")
+ }
+end
+
+
+
+# Generic Mem_ test assignment.
+
+define NAVALS 4
+
+$for (bcsilrdx)
+
+procedure mt_auto_$t (ty, model)
+
+char ty[ARB]
+int model
+
+int i
+real x
+pointer sp, ip
+
+begin
+ call eprintf (" %s\t ")
+ call pargstr (ty)
+
+ if (model == MT_HEAP) {
+ call malloc (ip, NAVALS, TY_PIXEL)
+ } else {
+ call smark (sp)
+ call salloc (ip, NAVALS, TY_PIXEL)
+ }
+
+
+ call eprintf ("0x%-15x %-15d\t ")
+ call pargi(ip)
+ call pargi(ip)
+
+ x = 0.0
+ $if (datatype == b)
+ for (i=0; i < NAVALS; i=i+1)
+ Mem$t[ip+i] = TRUE
+ call eprintf ("[ %b %b %b %b ]\n")
+ $endif
+ $if (datatype == c)
+ for (i=0; i < NAVALS; i=i+1)
+ Mem$t[ip+i] = 'a' + i
+ call eprintf ("[ %-3c %-3c %-3c %-3c ]\n")
+ $endif
+ $if (datatype == x)
+ for (i=0; i < NAVALS; i=i+1) {
+ x = i
+ Mem$t[ip+i] = cmplx(x,0.1)
+ }
+ call eprintf ("[ %x %x %x %x ]\n")
+ $endif
+ $if (datatype == sil)
+ for (i=0; i < NAVALS; i=i+1)
+ Mem$t[ip+i] = i
+ call eprintf ("[ %-3d %-3d %-3d %-3d ]\n")
+ $endif
+ $if (datatype == rd)
+ for (i=0; i < NAVALS; i=i+1)
+ Mem$t[ip+i] = i
+ call eprintf ("[ %-3g %-3g %-3g %-3g ]\n")
+ $endif
+ for (i=0; i < NAVALS; i=i+1)
+ call parg$t (Mem$t[ip+i])
+
+
+ if (model == MT_HEAP)
+ call mfree (ip, TY_PIXEL)
+ else
+ call sfree (sp)
+end
+
+$endfor
generated by cgit (git 2.34.1) at 2025-09-20 06:55:13 -0400