From 19876ca805828d1d59625790bd443fdecfc43e63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Sat, 22 May 2021 14:48:00 +0000 Subject: [PATCH] qlunits: added channel definition structures based on C equivalents, added test code git-svn-id: trunk@49396 - --- .gitattributes | 1 + packages/qlunits/fpmake.pp | 1 + packages/qlunits/src/qdos.pas | 178 ++++++++++++++++++++++++++++ packages/qlunits/tests/trecsize.pas | 59 +++++++++ 4 files changed, 239 insertions(+) create mode 100644 packages/qlunits/tests/trecsize.pas diff --git a/.gitattributes b/.gitattributes index 256a76f823..d5710999c0 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8833,6 +8833,7 @@ packages/qlunits/src/qlutil.pas svneol=native#text/plain packages/qlunits/src/sms.pas svneol=native#text/plain packages/qlunits/src/sms_sysvars.inc svneol=native#text/plain packages/qlunits/src/smsfuncs.inc svneol=native#text/plain +packages/qlunits/tests/trecsize.pas svneol=native#text/plain packages/qlunits/tests/tsysvars.pas svneol=native#text/plain packages/regexpr/Makefile svneol=native#text/plain packages/regexpr/Makefile.fpc svneol=native#text/plain diff --git a/packages/qlunits/fpmake.pp b/packages/qlunits/fpmake.pp index aa43fc7550..60dac04392 100644 --- a/packages/qlunits/fpmake.pp +++ b/packages/qlunits/fpmake.pp @@ -41,6 +41,7 @@ begin P.ExamplePath.Add('tests'); T:=P.Targets.AddExampleProgram('tsysvars.pas'); + T:=P.Targets.AddExampleProgram('trecsize.pas'); {$ifndef ALLPACKAGES} Run; diff --git a/packages/qlunits/src/qdos.pas b/packages/qlunits/src/qdos.pas index d20d8482f1..59d30b7478 100644 --- a/packages/qlunits/src/qdos.pas +++ b/packages/qlunits/src/qdos.pas @@ -23,7 +23,14 @@ type Tchanid = longint; Tjobid = longint; Ttimeout = smallint; + Tcolour = byte; +type + Pqlstr = ^Tqlstr; + Tqlstr = record + qs_strlen: word; + qs_str: array[0..0] of char; + end; const ERR_NC = -1; { Operation not complete } @@ -143,6 +150,177 @@ type end; PWindowDef = ^TWindowDef; +type + Pqdos_queue = ^Tqdos_queue; + Tqdos_queue = record + q_nextq: Pqdos_queue; + q_end: pchar; + q_nextin: pchar; + q_nxtout: pchar; + q_queue: array[0..1] of char; + end; + +const + QDOSQUEUE_SIZE = $12; + +type + Tchan_defb = record + ch_len: dword; + ch_drivr: pbyte; + ch_owner: Tjobid; + ch_rflag: pbyte; + ch_tag: word; + ch_stat: byte; + ch_actn: byte; + ch_jobwt: Tjobid; + end; + +const + CHAN_DEFBSIZE = $18; + +type + Pser_cdefb = ^Tser_cdefb; + Tser_cdefb = record + ser_cdef: Tchan_defb; + ser_chnq: word; + ser_par: word; + ser_thsx: word; + ser_prot: word; + ser_rxq: Tqdos_queue; + ser_dum1: array[0..79] of byte; + ser_txq: Tqdos_queue; + ser_dum2: array[0..79] of byte; + end; + +const + SER_CDEFBSIZE = $E4; + +type + Tnet_cdefb = record + net_cdef: Tchan_defb; + net_hedr: byte; + net_self: byte; + net_blkl: byte; + net_blkh: byte; + net_type: byte; + net_nbyt: byte; + net_dchk: byte; + net_hchk: byte; + net_data: array[0..254] of byte; + net_rpnt: byte; + end; + +const + NET_CDEFBSIZE = $120; + +type + Tpipe_cdefb = record + ch_cdef: Tchan_defb; + ch_qin: Pqdos_queue; + ch_qout: Pqdos_queue; + end; + +const + PIPE_CDEFBSIZE = $20; + +type + Tscrn_info = record + sd_xmin: word; + sd_ymin: word; + sd_xsize: word; + sd_ysize: word; + sd_borwd: word; + sd_xpos: word; + sd_ypos: word; + sd_xinc: word; + sd_yinc: word; + sd_font: array[0..1] of pointer; + sd_scrb: pointer; + sd_pmask: dword; + sd_smask: dword; + sd_imask: dword; + sd_cattr: byte; + sd_curf: byte; + sd_pcolr: Tcolour; + sd_scolr: Tcolour; + sd_icolr: Tcolour; + sd_bcolr: Tcolour; + sd_nlsta: byte; + sd_fmod: byte; + sd_xorg: Tqlfloat; + sd_yorg: Tqlfloat; + sd_scal: Tqlfloat; + sd_fbuf: pointer; + sd_fuse: pointer; + sd_linel: word; + end; + +const + SCRN_INFOSIZE = $4E; + +type + Pscr_cdefb = ^Tscr_cdefb; + Tscr_cdefb = record + scr_cdef: Tchan_defb; + scr_info: Tscrn_info; + end; + +const + SCR_CDEFBSIZE = CHAN_DEFBSIZE + SCRN_INFOSIZE; + +const + CA_UNDERLINE = $1; + CA_FLASH = $2; + CA_TRANS = $4; + CA_XOR = $8; + CA_DOUBLE_HEIGHT = $10; + CA_EXT_WIDTH = $20; + CA_DBLE_WIDTH = $40; + CA_GRAF_POS_CHAR = $80; + +type + Tcon_union1 = record + sdu_linel: longint; + sdu_kbd: Tqdos_queue; + end; + + Pcon_cdefb = ^Tcon_cdefb; + Tcon_cdefb = record + con_cdef: Tchan_defb; + con_info: Tscrn_info; + case boolean of + false: ( sd_js: Tcon_union1 ); + true: ( sd_jm: Tqdos_queue ); + end; + +const + CON_CDEFBSIZE = SCR_CDEFBSIZE + QDOSQUEUE_SIZE + 4; + +type + Pfs_cdefb = ^Tfs_cdefb; + Tfs_cdefb = record + fs_cdef: Tchan_defb; + fs_next: Pfs_cdefb; + fs_access: byte; + fs_drive: byte; + fs_filnr: word; + fs_nblok: word; + fs_nbyte: word; + fs_eblok: word; + fs_ebyte: word; + fs_cblock: pointer; + fs_updt: byte; + fs_res1: shortint; + fs_res2: longint; + fs_name: Tqlstr; + fs_pad: array[0..105] of byte; + end; + +const + FS_CDEFBSIZE = $a0; + FSCDEF_SIZE = FS_CDEFBSIZE; { inconsistently named alias, from C code } + + { Variable/type includes before function declarations } {$i qdos_sysvars.inc} diff --git a/packages/qlunits/tests/trecsize.pas b/packages/qlunits/tests/trecsize.pas new file mode 100644 index 0000000000..3acfc49e2c --- /dev/null +++ b/packages/qlunits/tests/trecsize.pas @@ -0,0 +1,59 @@ +{ + Copyright (c) 2021 Karoly Balogh + + Test system record/structure sizes on a Sinclair QL + A test program for Free Pascal's Sinclair QL support + + This test program is in the Public Domain under the terms of + Unlicense: http://unlicense.org/ + + **********************************************************************} + +program trecsize; + +uses + qdos; + +type + size_test = record + name: string[16]; + size: longint; + size_of: longint; + end; + +const + record_sizes: array of size_test = ( + { extend with more, as needed } + ( name: 'TQDOS_QUEUE'; size: QDOSQUEUE_SIZE; size_of: sizeof(Tqdos_queue) ), + ( name: 'TCHAN_DEFB'; size: CHAN_DEFBSIZE; size_of: sizeof(Tchan_defb) ), + ( name: 'TSER_CDEFB'; size: SER_CDEFBSIZE; size_of: sizeof(Tser_cdefb) ), + ( name: 'TNET_CDEFB'; size: NET_CDEFBSIZE; size_of: sizeof(Tnet_cdefb) ), + ( name: 'TSCRN_INFO'; size: SCRN_INFOSIZE; size_of: sizeof(Tscrn_info) ), + ( name: 'TSCR_CDEFB'; size: SCR_CDEFBSIZE; size_of: sizeof(Tscr_cdefb) ), + ( name: 'TCON_CDEFB'; size: CON_CDEFBSIZE; size_of: sizeof(Tcon_cdefb) ), + ( name: 'TFS_CDEFB'; size: FS_CDEFBSIZE; size_of: sizeof(Tfs_cdefb) ) + ); + +function test_record_sizes: boolean; +var + i: longint; +begin + test_record_sizes:=false; + for i:=low(record_sizes) to high(record_sizes) do + begin + with record_sizes[i] do + begin + writeln(name,' is ',size_of,' bytes, expected: ',size); + if size_of <> size then + exit; + end; + end; + test_record_sizes:=true; +end; + +begin + if test_record_sizes then + writeln('All OK!') + else + writeln('Error! Wrong size!'); +end.