Digital Research
This commit is contained in:
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions

View File

@@ -0,0 +1,11 @@
GENCMD status: debugging CS version 2/21/83
GENCMD notes
2/22/83 got Chuck Spitz version from Kathy, along with directions
on how to fix for >62K data segs
2/9/83 Kathy promises latest version asap. whf
10/21/82 I got this version from CCPMPC.
GENCMD ISSUE: this does not include latest changes, allowing "data[b1000"...
I get the impression from Jeff that this latest version is not exactly
being supported, whatever that means...
I think the only diffs are bigger buffers.

View File

@@ -0,0 +1,15 @@
$ !
$ ! Compile, link, locate and generate hex for
$ ! 'GENCMD'
$ ! Concurrent CP/M-86
$ !
$ util := GENCMD
$ ccpmsetup ! set up environment
$ plm86 'util'.plm xref 'p1' optimize(3) debug
$ link86 f1:scd.obj, 'util'.obj to 'util'.lnk
$ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
$ h86 'util'
$ !
$ !pclean

View File

@@ -0,0 +1,353 @@
:020000021000EC
:0100040000FB
:020000021000EC
:020006000000F8
:020000021005E7
:0700000000000000000000F9
:020000021007E5
:04000C0000000000F0
:020000021010DC
:080000000000000000000000F8
:020000020000FC
:10000000EB4B90EB7690434F505952494748542060
:1000100028432920313938332C2044494749544159
:100020004C2052455345415243482020434F4E43B4
:10003000555252454E542043502F4D2D38362032C4
:100040002E302C2030332F33312F3833209C58FA68
:100050008CD98ED18D262807509DE9B100558BECA7
:100060008B56048B4E06CDE0A30001891E02018948
:0F0070000E0401891606015DC204009090909065
:0200000210727A
:1000080020434F505952494748542028432920310A
:100018003938332C204449474954414C20524553E0
:060028004541524348204F
:02000002101BD1
:10000400434F44452000004441544120FFFF4558DC
:10001400545241FFFF535441434B000058312020B8
:1000240020000058322020200000583320202000D7
:100034000058342020200000383038302000004E92
:0D0044005A45524F00004E4845414400000F
:020000021020CC
:1000010000000000000000000000000000000000EF
:1000110000000000000000000000000000000000DF
:1000210000000000000000000000000000000000CF
:1000310000000000000000000000000000000000BF
:1000410000000000000000000000000000000000AF
:10005100000000000000000000000000000000009F
:10006100000000000000000000000000000000008F
:10007100000000000000000000000000000000007F
:070081000000000000000078
:02000002107577
:080003004552524F523A2024ED
:02000002107577
:10000B002C204C4F4144204144445245535320240F
:02000002107676
:0B000B004449534B20575249544524F0
:02000002107478
:05000E000D5B5D2C20DC
:02000002107775
:0A0006004449534B20524541442465
:02000002107874
:10000000494E53554646494349454E54204D454D6A
:100010004F525920544F2043524541544520434D9F
:08002000442046494C45202410
:02000002107A72
:0F0008004C4F414420204144445245535320243F
:02000002107B71
:0F0007004552524F5220414444524553532024F6
:02000002107C70
:0C000600425954455320524541443A24CD
:02000002107D6F
:10000200494E56414C4944204845582044494749A5
:02001200542474
:02000002107E6E
:10000400434845434B2053554D204552524F5220AF
:0100140024C7
:02000002107F6D
:0F00050042595445532052454144202020202485
:0200000210806C
:100004005245434F524453205752495454454E206D
:0100140024C7
:0200000210816B
:040005004838360041
:0200000210816B
:1000090043414E4E4F54204F50454E20534F555269
:0300190043452438
:0200000210826A
:03000C00434D441D
:0200000210826A
:10000F004E4F204D4F5245204449524543544F5275
:08001F005920535041434524D0
:02000002108468
:1000070043414E4E4F5420434C4F53452046494C95
:0200170045247E
:020000020010EC
:0E000000558BECB000B4005050E851FF5DC3CA
:020000020010EC
:03000E00558BEC23
:02000002001CE0
:10000200558BECB002508A4604B40050E88CFE5D79
:03001200C2020027
:02000002001DDF
:10000500558BECB00D50E8E4FFB00A50E8DEFF5D1B
:01001500C327
:02000002001EDE
:10000600558BEC807E040976098A460404412C0A45
:0F001600EB058A4604043050E8C1FF5DC20200CA
:020000020020DC
:10000500558BEC8A4604B104D2E850E8D3FF8A4602
:0B00150004240F50E8CAFF5DC2020087
:020000020022DA
:10000000558BEC8B460488E050E8D9FF8B460450B2
:07001000E8D2FF5DC202000F
:020000020023D9
:10000700558BECB00950FF7604E81AFE5DC202007A
:020000020024D8
:10000700558BECE888FFFF7604E8E4FF5DC2020049
:020000020025D7
:10000700558BECB8530750E8E6FFFF7604E8D0FFBE
:10001700B85B0750E8C9FFFF361001E8ABFFE88877
:05002700FE5DC20200B5
:020000020027D5
:0C000C00558BECB86B0750E8D1FF5DC3CA
:020000020028D4
:10000800558BECB01A50FF7604E8C9FD5DC20200BA
:020000020029D3
:10000800558BECB00F50FF7604E8B9FDA2AD065D44
:03001800C2020021
:02000002002AD2
:10000B00558BECB01050FF7604E8A6FDA2AD065D53
:03001B00C202001E
:02000002002BD1
:10000E00558BECB01150FF7604E893FDA2AD065D62
:03001E00C202001B
:02000002002DCF
:10000100558BECB01250B8000050E87FFDA2AD0650
:020011005DC3CD
:02000002002ECE
:10000300558BECB01350FF7604E86EFD5DC2020021
:02000002002FCD
:10000300558BECB01450FF7604E85EFD5DC2020030
:020000020030CC
:10000300558BECB01550FF7604E84EFD5DC202003F
:020000020031CB
:10000300558BECB01650FF7604E83EFDA2AD065DBD
:03001300C2020026
:020000020032CA
:10000600558BECB01750FF7604E82BFD5DC202005D
:020000020033C9
:10000600558BEC8A4604FEC88846043CFF74128B66
:100016005E088A078B5E068807FF4608FF4606EBE2
:05002600E25DC20600CE
:020000020035C7
:10000B00558BECE874FEC606AF0601A0AF06B40034
:10001B003B060C01770F89C6FFB48000E848FEFE53
:10002B0006AF0675E6B03F50E83CFEE84CFEE874C0
:03003B00FD5DC3A5
:020000020038C4
:10000E00558BECA10C0140A30C018A0E8000B500AB
:10001E003BC1770889C68A8480005DC3B00D5DC37D
:02000002003AC2
:10000E00558BEC807E04207304B00DEB108A4604F1
:10001E002C613C1973048066045F8A46045DC2023B
:01002E0000D1
:02000002003CC0
:10000F00558BECE8B9FF50E8D5FFA2AE06803EAEA7
:06001F00062074EF5DC332
:02000002003EBE
:10000500558BEC8A46042C303C0976148A46042C20
:10001500413C057604B0FFEB078A46042C41040AEF
:040025005DC20200B6
:020000020040BC
:10000900558BEC8A4606B400B108D3E08A4E04B594
:07001900000BC15DC20400F1
:020000020042BA
:10000000558BECC606B00600803EB006047719A0FA
:10001000AE068A1EB006B7003A874E077504B001D7
:0C0020005DC3FE06B00675E0B0005DC3D5
:020000020044B8
:10000C00558BECC70612010000E836FFA2AE06E8DD
:10001C00C2FFF6D0D0D87328FF36AE06E87AFFA21E
:10002C00AE063CFF7505E8E6FEEBDEA11201B91049
:10003C0000F7E18A0EAE06B50003C1A31201EBC9AD
:05004C00A112015DC3DB
:020000020049B3
:10000100558BECA10A0140A30A013DFF0377088942
:10001100C38A87A9025DC3C7060A010000EB0881F4
:10002100060A018000724A813E0A01FF037742B845
:10003100880250E82CFEA2B10608C07515B88000F0
:10004100508B1E0A018D87A90250B08050E855FEE1
:10005100EBCD803EB106017407B8760750E866FD26
:100061008B1E0A01C687A9021AC7060A01FF03EB04
:0C007100AEC7060A010000A0A9025DC392
:020000020050AC
:03000D00558BEC24
:02000002008676
:10000C00558BECA110010560083B060600760AB87A
:10001C00800750E8C5F9E87BF88A46048B1E0E0170
:0A002C008B36100188005DC202004F
:02000002008973
:10000600558BECA110010560083B060600B0FF7297
:1000160001408A0EAB06F6D122C1D0D873118B1ED1
:100026000E018B361001C60000FF061001EBD45DF1
:01003600C306
:02000002008C70
:03000700558BEC2A
:0200000200926A
:10000100558BECE8AEF8FF361601E8F2F8B03A503D
:0B001100E88EF8B02050E888F85DC3CE
:02000002008C70
:10000A00B8A80750E876F9FF361601E848F9B8B7F4
:10001A000750E868F9FF361001E83AF9B8C6075000
:10002A00E85AF9E83100A116013B0610017320A82D
:10003A000F7503E821008B1E0E018B361601FF3067
:10004A00E8F8F8FF061601B02050E8ABF8EBD7E85D
:07005A00B9F8E8E1F75DC30E
:02000002009369
:10000C00558BECFF363001E842F9B85C0050E8B68D
:0E001C00F908C07403E828F9FE06B8065DC3B3
:02000002009567
:10000A00558BECC70630016008A1300183C07F8B95
:10001A000E1A0181C160083BC1770BE8C4FF810653
:10002A0030018000EBE3A0B606F6D0D0D87305E81D
:10003A00B0FF5DC3FF363001B86008508B0E1A015D
:10004A0003C8412B0E3001890E100151E88DF95D6C
:01005A00C3E2
:02000002009A62
:10000B00558BECE8E0FA50E830FAA2B9063CFF74E5
:10001B0005A0B9065DC3B8D20750E87FF8E8FCFE2F
:02002B005DC3B3
:02000002009C60
:10000D00558BECE8D8FFB104D2E050E8D0FF590A87
:03001D00C15DC3FF
:02000002009E5E
:10000000558BECE8E7FFA2BA060006B306A0BA06D5
:020010005DC3CE
:02000002009F5D
:10000200558BEC803EB406027407803EB4068476BB
:1000120010E8DAFF50E8D6FF50E8FBF9A31E01EB27
:1000220026A0B206FEC8A2B2063CFF740DE8BEFFCF
:1000320050E846FEFF061001EBE7A110013B061A4D
:1000420001760448A31A01E891FF0206B306740A76
:0C005200B8E40750E8FEF7E87BFE5DC351
:0200000200A458
:10000E00558BECC606B60601803EB406847507C64F
:10001E0006B40683EB0C803EB406837505C606B4A3
:10002E0006848A1EB40680EB81B700D1E3A0B20627
:10003E00B4000306100148A332013987200177303E
:10004E0009C07506C706320101008A1EB40680EB90
:10005E0081B70053D1E3A1320189872001A0B406F4
:10006E002C808746FEB109F6E189C359888F0102BB
:02007E005DC360
:0200000200AC50
:10000000558BECA11001250F00508A4604B107F66C
:10001000E189C38B1618012B97B901B104D3E258BB
:0600200003C25DC20200F4
:020000020051AB
:10000000B80000A31801A31A01A31C01A2B806C6D8
:1000100006A9021AA27C00A0AC06D0D87305C606B9
:100020007C0001B000A2B606B400A31E01A2B50672
:10003000803EB5060777148A1EB506B700D1E3C720
:100040008720010000FE06B50675E5E83803C706FF
:1000500016010000C70610010100E824FFA2B70640
:100060003C3A740C803EB7061A7503E9F400EBEADB
:10007000C606B30600E85804A2B206B40001061C86
:1000800001E84C0450E8480450E86DFEA31601A3B3
:100090001001A11001B104D3E803061E01A3180149
:1000A000E82D04A2B4063C81B0FF77014050803EA9
:1000B000B40685B0FF7201405922C1D0D87313A095
:1000C000AA06F6D0D0D87305E87304EB8DE81204C5
:1000D000EB88803EB40681750AE80604C606010274
:1000E00001EBED803EB40602742C823EB40600B0F3
:1000F000FF7401408B0E1801503B0EC001B0FF721F
:1001000001405A22C2503B0EB901B0FF7301405961
:1001100022C1D0D87311B00050E89404A31001E8B4
:10012000C003C606010201823EB4060075A2A118F2
:10013000013B06C0017299C606B60601B00150E83F
:100140006E048A0EB206B50003C148A33201390617
:100150002201738DA13201A32201C6060A0202E91F
:10016000F8FEE8E502A11001B9100003C14825F02E
:10017000FFA31601A11A0131D2F7F140A3020283B5
:100180003E060200750BA11A0131D2F7F140A30619
:1001900002A11601A31A01A0B606F6D0D0D87303A7
:1001A000E95401E8E001B000A2B606A29402A2A8B8
:1001B00002B8880250E8D0FBB8800050E8B9FBC60E
:1001C00006B50601A0B5063C077746B400D1E08924
:1001D000C383BF20010074338B8F2001BA1000034A
:1001E000CA81E1F0FF898F200189C889D631D2F711
:1001F000F650A0B506B209F6E289C759898D020208
:1002000083BD0602007504898D0602FE06B50675DB
:10021000B3C7061E010000A11601A32001C7060AEC
:10022000010004E85BFDA2B7063C3A7409803EB7C2
:10023000061A7431EBEDC606B30600E89202A2B2CC
:1002400006E88C0250E8880250E8ADFCA31001A13A
:100250001001B104D3E803061E01A31801E87002DF
:10026000A2B4063C1A7503E98A00803EB406847580
:1002700007C606B40683EB0C803EB406837505C63C
:1002800006B40684803EB406817630803EB406858E
:100290007329C606B50600A0B4062C823806B5063A
:1002A00077168A1EB506B700D1E38B8720010106B9
:1002B0001001FE06B50675DFE82702803EB406028F
:1002C000741F823EB40600B0FF7401408B0E18010B
:1002D000503B0EC001B0FF7301405922C1D0D8730A
:1002E00010B00150E8C90203062001A31001E8F193
:1002F00001E92FFFE85301B8F50750E839FAFF3656
:100300001C01E80BFAB8040850E82BFAA0B806FE66
:10031000C050E8E0F9E8ADF9B85C0050E87CFAA01C
:10032000AC06D0D87334C606680000C6067C000050
:10033000B85C0050E851FAB8010250B8800050B0E3
:100340008050E8E1FAB8800050E82CFAB85C005020
:0C035000E8A0FA08C07403E812FA5DC3CC
:0200000200AE4E
:10000600558BECC7060C010000BE00008A848000F8
:10001600A2AE06E8D3F88B360C018A848000A2AE25
:0D002600063C207406FF060C01EBEB5DC3E9
:0200000200B14B
:03000300558BEC2E
:0200000200B646
:10000E00558BECC606BF0600803EBF06047731E86E
:10001E00A0F8D0D8730D8A1EBF06B700C687C106DA
:10002E0020EB17A0AE068A1EBF06B7008887C10652
:10003E00E8EDF750E809F8A2AE06FE06BF0675C851
:10004E00C606BC0600C606C00601C606BE06018070
:10005E003EBC060BB0FF7201402206C006D0D8731C
:10006E0057C606BE0601C606BD0600A0BD063C0468
:10007E00B0FF7601402206BE06D0D87327A0BC067C
:10008E00B107F6E18A1EBD06B7008A8FC1069389B5
:10009E00C63A88B4017407C606BE0600EBCDFE064E
:1000AE00BD06EBC7A0BE06D0D87307C606C00600B5
:1000BE00EB9DFE06BC06EB97A0C006D0D87305C616
:0900CE0006BC06FFA0BC065DC3E0
:0200000200C339
:10000700558BEC803EAE065DB0FF75014050803EDB
:10001700AE060DB0FF7501405922C1D0D87203E971
:100027008B00E873F7803EAE06417514E8E6F7509B
:10003700A0BC06B109F6E189C359898F0402EBC355
:10004700803EAE064D7528E8CBF750A0BC06B10937
:10005700F6E189C359898F0602A0BC06FEC050A0ED
:10006700BC06B109F6E189C359888F0102EB948078
:100077003EAE06587514E89CF750A0BC06B109F6C9
:10008700E189C359898F0802EBE3803EAE064275CA
:1000970014E881F750A0BC06B107F6E189C3598976
:0F00A7008FB901EBC8E87CF6E81EF4EBC05DC32F
:0200000200B14B
:10000600E8B6F8803EAE060D75025DC3E849003CD1
:10001600FF7503E82FF8803EBC06087316803EAED7
:10002600065D7407803EAE060D7503E817F8E8F026
:1000360000EBCD803EBC06087507C606AA0601EB96
:10004600BF803EBC06097507C606AB0601EBB1C606
:0800560006AC0600EBAA5DC335
:020000020011EB
:1000010089E0A30801BB80008D87340189C4B80051
:1000110000A31001C7060E016008A2AA06A2AB0642
:10002100C606AC0601C7060A010004B85C0050B858
:10003100880250B02150E8EC01B8150850B891027F
:1000410050B00450E8DE01B8880250E83901803E22
:10005100AD06FF7507B8190850E8EA00B82C08503A
:10006100B8650050B00350E8BB01B85C0050E861CE
:1000710001B85C0050E88A01B85C0050E8080180D2
:100081003EAD06FF7505B82F08EB1AE84709E87180
:1000910009E86803B85C0050E8FF00803EAD06FF48
:1000A1007507B8470850E89D00E81800E840FF5D73
:0100B100C38B
:00000001FF

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,771 @@
GENCMD:
DO;
/* CP/M 8086 CMD file generator
COPYRIGHT (C) 1983
DIGITAL RESEARCH
BOX 579 PACIFIC GROVE
CALIFORNIA 93950
*/
/**** The following commands were used on the VAX to compile GENCMD:
$ util := GENCMD
$ ccpmsetup ! set up environment
$ plm86 'util'.plm xref 'p1' optimize(3) debug
$ link86 f1:scd.obj, 'util'.obj to 'util'.lnk
$ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
$ h86 'util'
**** Followed on the micro by:
A>vax gencmd.h86 $fans
A>gencmd gencmd data[b1000 m86 xfff]
****/
DECLARE
digital$code literally '0081h', /*DR code record */
digital$data literally '0082h', /* DR data record */
digital02 literally '0085h', /* DR 02 records */
paragraph literally '16',
ex literally '12', /* extent */
nr literally '32', /* current record */
maxb address external,
fcba(33) byte external, /* DEFAULT FILE CONTROL BLOCK */
buffa(128) byte external; /* DEFAULT BUFFER ADDRESS */
DECLARE COPYRIGHT(*) BYTE DATA
(' COPYRIGHT (C) 1983, DIGITAL RESEARCH ');
MON1: PROCEDURE(F,A) EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON1;
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
DECLARE F BYTE, A ADDRESS;
END MON2;
DECLARE SP ADDRESS;
BOOT: PROCEDURE;
call mon1 (0,0);
END BOOT;
declare segmts(11) structure (name(5) byte,begin$add address)
initial ('CODE ',00h,'DATA ',0ffffh,'EXTRA',0ffffh,'STACK',0,
'X1 ',0,'X2 ',0,'X3 ',0,'X4 ',0,'8080 ',0,'NZERO',0,
'NHEAD',0);
declare header (15) structure
(typseg byte,file$length address,absolute$add address,
minimum$mem address,
maximum$mem address) initial (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
plmstart: PROCEDURE public;
DECLARE FCB (33) BYTE AT (.FCBA),
DFCBA LITERALLY 'FCBA';
DECLARE BUFFER (128) BYTE AT (.BUFFA),
DBUFF LITERALLY 'BUFFA';
DECLARE SFCB(33) BYTE, /* SOURCE FILE CONTROL BLOCK */
BSIZE LITERALLY '1024',
EOFILE LITERALLY '1AH',
SBUFF(BSIZE) BYTE, /* SOURCE FILE BUFFER */
RFLAG BYTE, /* READER FLAG */
SBP ADDRESS; /* SOURCE FILE BUFFER POINTER */
declare tbp address; /* pointer to command tail */
declare count$command$tail byte at (.buffa);
declare (t8080,nozero) byte;
DECLARE
TRUE LITERALLY '1',
FALSE LITERALLY '0',
FOREVER LITERALLY 'WHILE TRUE',
CR LITERALLY '13',
LF LITERALLY '10',
WHAT LITERALLY '63';
PRINTCHAR: PROCEDURE(CHAR);
DECLARE CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;
CRLF: PROCEDURE;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;
PRINTNIB: PROCEDURE(N);
DECLARE N BYTE;
IF N > 9 THEN CALL PRINTCHAR(N+'A'-10); ELSE
CALL PRINTCHAR(N+'0');
END PRINTNIB;
PRINTHEX: PROCEDURE(B);
DECLARE B BYTE;
CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
END PRINTHEX;
PRINTADDR: PROCEDURE(A);
DECLARE A ADDRESS;
CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
END PRINTADDR;
PRINTM: PROCEDURE(A);
DECLARE A ADDRESS;
CALL MON1(9,A);
END PRINTM;
PRINT: PROCEDURE(A);
DECLARE A ADDRESS;
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
CALL CRLF;
CALL PRINTM(A);
END PRINT;
declare mbuffadr address,
LA ADDRESS; /* CURRENT LOAD ADDRESS */
declare head byte;
PERROR: PROCEDURE(A);
/* PRINT ERROR MESSAGE */
DECLARE A ADDRESS;
CALL PRINT(.('ERROR: $'));
CALL PRINTM(A);
CALL PRINTM(.(', LOAD ADDRESS $'));
CALL PRINTADDR(LA);
CALL BOOT;
END PERROR;
diskerror: procedure;
call perror(.('DISK WRITE$'));
end diskerror;
DECLARE DCNT BYTE;
setdma: procedure(a);
declare a address;
call mon1 (26,a);
end setdma;
OPEN: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(15,FCB);
END OPEN;
CLOSE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(16,FCB);
END CLOSE;
SEARCH: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(17,FCB);
END SEARCH;
SEARCHN: PROCEDURE;
DCNT = MON2(18,0);
END SEARCHN;
DELETE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(19,FCB);
END DELETE;
DISKREAD: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(20,FCB);
END DISKREAD;
DISKWRITE: PROCEDURE(FCB) BYTE;
DECLARE FCB ADDRESS;
RETURN MON2(21,FCB);
END DISKWRITE;
MAKE: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
DCNT = MON2(22,FCB);
END MAKE;
RENAME: PROCEDURE(FCB);
DECLARE FCB ADDRESS;
CALL MON1(23,FCB);
END RENAME;
MOVE: PROCEDURE(S,D,N);
DECLARE (S,D) ADDRESS, N BYTE,
A BASED S BYTE, B BASED D BYTE;
DO WHILE (N:=N-1) <> 255;
B = A; S=S+1; D=D+1;
END;
END MOVE;
declare char byte;
comline$error: procedure;
declare i byte;
call crlf;
do i = 1 to tbp;
call printchar (buffer(i));
end;
call printchar ('?');
call crlf;
call boot;
end comline$error;
retchar: procedure byte;
/* get another character from command tail */
if (tbp :=tbp+1) <= count$command$tail then
return buffer(tbp);
else return (0dh);
end retchar;
tran: procedure(b) byte;
declare b byte;
if b < ' ' then return 0dh; /* non-graphic */
if b - 'a' < ('z' - 'a') then
b = b and 101$1111b; /* upper case */
return b;
end tran;
next$non$blank: procedure;
char=tran(retchar);
do while char= ' ';
char= tran(retchar);
end;
end next$non$blank;
CHECK$ONE$HEX: PROCEDURE (h) BYTE;
/* READ ONE HEX CHARACTER FROM THE INPUT */
DECLARE H BYTE;
IF H - '0' <= 9 THEN RETURN H - '0';
IF H - 'A' > 5 THEN
return (0ffh);
RETURN H - 'A' + 10;
END CHECK$ONE$HEX;
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
DECLARE (H,L) BYTE;
RETURN SHL(DOUBLE(H),8) OR L;
END MAKE$DOUBLE;
delimiter: procedure byte; /* logical */
declare i byte;
declare del (*) byte data (0dh,'[], ');
do i = 0 to last(del);
if char = del(i) then return true;
end;
return false;
end delimiter;
get$num: procedure address;
declare paradd address;
paradd = 0;
char = retchar;
do while not delimiter ;
if (char:=check$one$hex(char)) = 0ffh then
call comline$error; else
paradd = paradd * 16 + char;
char = retchar;
end;
return paradd;
end get$num;
GETCHAR: PROCEDURE BYTE;
/* GET NEXT CHARACTER FROM DISK BUFFER */
DECLARE I BYTE;
IF (SBP := SBP+1) <= LAST(SBUFF) THEN
RETURN SBUFF(SBP);
/* OTHERWISE READ ANOTHER BUFFER FULL */
DO SBP = 0 TO LAST(SBUFF) BY 128;
IF (I:=DISKREAD(.SFCB)) = 0 THEN
CALL MOVE(.buffer,.SBUFF(SBP),80H); ELSE
DO;
IF I<>1 THEN CALL PERROR(.('DISK READ$'));
SBUFF(SBP) = EOFILE;
SBP = LAST(SBUFF);
END;
END;
SBP = 0; RETURN SBUFF(0);
END GETCHAR;
DECLARE
STACKPOINTER LITERALLY 'STACKPTR';
/* INTEL HEX FORMAT LOADER */
RELOC: PROCEDURE;
DECLARE (RL, CS, RT,K) BYTE;
declare multi$segments byte;
DECLARE
tabs address, /* temporary value */
TA ADDRESS, /* TEMP ADDRESS */
SA ADDRESS, /* PARAGRAPH LOAD ADDRESS */
FA ADDRESS, /* FINAL ADDRESS */
NB ADDRESS, /* NUMBER OF BYTES LOADED */
nxb byte, /* next byte in stream */
segadjst address, /* segment adjust */
seg$length (8) address, /* length of each segment */
write$add address,
MBUFF based mbuffadr (256) BYTE,
P BYTE;
declare high$add address;
SETMEM: PROCEDURE(B);
/* set mbuff to b at location la */
DECLARE (B) BYTE;
if ((.memory+la) < 0) or ((.memory+la) > maxb) then
do;
call print (.('INSUFFICIENT MEMORY TO CREATE CMD FILE $'));
call boot;
end;
MBUFF(LA) = B;
END SETMEM;
zero$mem: procedure;
do while (.memory +la) <maxb and not nozero;
mbuff(la) = 0;
la = la +1;
end;
end zero$mem;
DIAGNOSE: PROCEDURE;
DECLARE M BASED TA BYTE;
NEWLINE: PROCEDURE;
CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
CALL PRINTCHAR(' ');
END NEWLINE;
/* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
CALL PRINT(.('LOAD ADDRESS $')); CALL PRINTADDR(TA);
CALL PRINT(.('ERROR ADDRESS $')); CALL PRINTADDR(LA);
CALL PRINT(.('BYTES READ:$')); CALL NEWLINE;
DO WHILE TA < LA;
IF (LOW(TA) AND 0FH) = 0 THEN CALL NEWLINE;
CALL PRINTHEX(MBUFF(TA)); TA=TA+1;
CALL PRINTCHAR(' ');
END;
CALL CRLF;
CALL BOOT;
END DIAGNOSE;
write$record: procedure;
call setdma(write$add);
if diskwrite(.fcba) <> 0 then call diskerror;
p = p+1;
end write$record;
empty$buffers: procedure;
write$add = .memory;
do while write$add+127 <= (.memory+fa);
call write$record;
write$add = write$add+128;
end;
if not multi$segments then
do;
call write$record;
return;
end;
call move (write$add,.memory,(la:=.memory+fa+1-write$add));
end empty$buffers;
READHEX: PROCEDURE BYTE;
/* READ ONE HEX CHARACTER FROM THE INPUT */
declare khex byte;
if (khex := check$one$hex(getchar)) <> 0ffh then return khex;
else
DO; CALL PRINT(.('INVALID HEX DIGIT$'));
CALL DIAGNOSE;
end;
end readhex;
READBYTE: PROCEDURE BYTE;
/* READ TWO HEX DIGITS */
RETURN SHL(READHEX,4) OR READHEX;
END READBYTE;
READCS: PROCEDURE BYTE;
/* READ BYTE WHILE COMPUTING CHECKSUM */
DECLARE B BYTE;
CS = CS + (B := READBYTE);
RETURN B;
END READCS;
hex$input: procedure;
if rt = 2 or rt > 84h then
segadjst = make$double(readcs,readcs); else
do;
/* PROCESS EACH BYTE */
DO WHILE (RL := RL - 1) <> 255;
CALL SETMEM(READCS); LA = LA+1;
END;
IF LA > FA THEN FA = LA - 1;
end;
/* NOW READ CHECKSUM AND COMPARE */
IF CS + READBYTE <> 0 THEN
DO; CALL PRINT(.('CHECK SUM ERROR $'));
CALL DIAGNOSE;
END;
end hex$input;
get$buffer$len: procedure;
multi$segments = true;
if rt = 84h then rt = 83h;
else if rt = 83h then rt = 84h;
if seg$length (rt-81h) <= (high$add:=la+rl-1) then
do;
if high$add=0 then high$add = 1;
seg$length (rt-81h) = high$add;
header(rt-81h).typseg = rt-80h;
end;
end get$buffer$len;
compute$la: procedure (j) address;
declare j byte;
return (la and 000Fh)+shl((sa-segmts(j).begin$add),4);
end compute$la;
/* INITIALIZE */
SA, FA, NB = 0;
P = 0; /* PARAGRAPH COUNT */
SBUFF(0) = EOFILE;
fcb(nr) = 0;
if head then fcb(nr) = 1;
multi$segments = false;
segadjst = 0;
do k= 0 to 7;
seglength(k) = 0;
end;
call zero$mem;
ta=0;
la=1;
/* READ RECORDS UNTIL :00XXXX IS ENCOUNTERED */
DO FOREVER;
/* SCAN THE : */
DO WHILE (nxb:=getchar) <> ':';
if nxb = eofile then go to second;
/* MAY BE THE END OF TAPE */
END;
/* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
CS = 0;
nb = nb +(rl:=readcs);
TA, LA = MAKE$DOUBLE(READCS,READCS) ;
sa = segadjst + shr(la,4);
/* READ THE RECORD TYPE */
/* skip all records except type 0 2 81 */
if (rt:=readcs) > digital$code and rt < digital02 then
do;
if not t8080 then
call get$buffer$len; else
call hex$input;
end; else
do;
if (rt = digital$code) then
do;
call hex$input;
header(0).typseg = 1;
end; else
do;
if (rt = 0 and sa < segmts(1).begin$add and sa >= segmts(0).begin$add)
or rt = 2 then
do;
la = compute$la(0);
call hex$input;
header(0).typseg = 1;
end;
if (rt = 0 and sa >= segmts(1).begin$add) then
do;
multi$segments = true;
if seg$length(1) <
(high$add:=compute$la(1) +rl-1) then
do;
seg$length(1) = high$add;
header(1).typseg=2;
end;
end;
end;
end;
end;
second:
call empty$buffers;
ta = (la+paragraph-1) and 0fff0h;
header(0).file$length=fa/16+1;
if header(0).minimum$mem = 0 then header(0).minimum$mem = fa/16+1;
fa=ta;
if not multi$segments then go to fin;
call zero$mem;
multi$segments = false;
sfcb(ex),sfcb(nr) = 0;
call open(.sfcb);
call setdma(.buffer);
do k = 1 to 7;
if seg$length(k) <> 0 then
do;
seg$length(k) = seg$length(k)+paragraph and 0fff0h;
header(k).file$length = seg$length(k)/16;
if header(k).minimum$mem=0 then
header(k).minimum$mem=seg$length(k)/16;
end;
end;
segadjst = 0;
seg$length(0) = ta;
sbp=length(sbuff);
DO FOREVER;
/* SCAN THE : */
DO WHILE (nxb:=getchar) <> ':';
if nxb = eofile then go to afin;
END;
cs = 0;
rl = readcs;
la = make$double(readcs,readcs);
sa = segadjst + shr(la,4);
if (rt := readcs) = eofile then go to afin;
if rt = 84h then rt = 83h;
else if rt = 83h then rt = 84h;
if rt > digital$code and rt < digital02 then
do;
do k = 0 to (rt-82h);
la = la + seg$length(k);
end;
call hex$input;
end;
if (rt = 0 and sa >= segmts(1).begin$add) or rt = 2 then
do;
la = compute$la(1) + seg$length(0);
call hex$input;
end;
END;
afin:
call empty$buffers;
FIN:
/* PRINT FINAL STATISTICS */
CALL PRINT(.('BYTES READ $')); CALL PRINTADDR(NB);
CALL PRINT(.('RECORDS WRITTEN $')); CALL PRINTHEX(P+1);
CALL CRLF;
/* write the header record */
call close(.fcba);
if head then
do;
fcb(ex),fcb(nr) = 0;
call open(.fcba);
call move (.header,.buffer,128);
call setdma(.buffer);
if diskwrite(.fcba) <> 0 then call diskerror;
end;
END RELOC;
declare seg$number byte;
ignore$filename: procedure;
tbp = 0;
char = buffer(tbp);
call next$non$blank;
do while (char:=buffer(tbp)) <> ' ';
tbp = tbp +1;
end;
end ignore$filename;
parse$tail: procedure;
declare seg$index byte;
get$segmt: procedure byte;
/* get the segment name */
declare ( kentry, match$flag,j, no$match) byte;
declare user$segmt(5) byte;
do j = 0 to last (user$segmt);
if delimiter then
user$segmt(j) = ' '; else
do;
user$segmt(j) = char;
char = tran(retchar);
end;
end;
seg$index = 0;
no$match, matchflag = true;
do while no$match and seg$index < 11;
match$flag=true;
kentry = 0;
do while match$flag and kentry <= last (segmts.name);
if usersegmt(kentry) <> segmts(seg$index).name(kentry) then
matchflag = false; else
kentry = kentry +1;
end;
if matchflag then no$match = false; else
seg$index = seg$index +1;
end;
if no$match then seg$index = 0ffh;
return seg$index;
end get$segmt;
get$switches: procedure;
do while char <> ']' and char <> cr;
call next$non$blank;
if char= 'A' then header(seg$index).absolute$add = (get$num);
else if
char= 'M' then
do;
header(seg$index).minimum$mem = (get$num);
header(seg$index).typseg = seg$index+1;
end;
else if
char= 'X' then header(seg$index).maximum$mem = (get$num);
else if
char= 'B' then segmts(seg$index).begin$add = (get$num);
else do;
call comline$error;
call boot;
end ;
end;
end get$switches;
do forever;
call next$non$blank;
if char = cr then return;
if get$segmt = 0ffh then
do;
call comline$error;
end;
if seg$index < 8 then
do;
if char = ']' or char = cr then call comline$error;
call get$switches;
end;
else
do;
if seg$index = 8 then t8080 = true; else
do;
if seg$index = 9 then nozero = true; else
head = false;
end;
end;
end;
end parse$tail;
/* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
/* SET UP STACKPOINTER IN THE LOCAL AREA */
DECLARE STACK(64) ADDRESS;
SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
LA = 0h;
mbuffadr = .memory;
t8080 = false;
nozero = false;
head = true;
SBP = LENGTH(SBUFF);
/* SET UP THE SOURCE FILE */
CALL MOVE(.FCBA,.SFCB,33);
CALL MOVE(.('H86',0),.SFCB(9),4);
CALL OPEN(.SFCB);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));
CALL MOVE(.('CMD'),.FCBA+9,3);
/* REMOVE ANY EXISTING FILE BY THIS NAME */
CALL DELETE(.FCBA);
/* THEN OPEN A NEW FILE */
CALL MAKE(.FCBA); CALL OPEN(.FCBA);
IF DCNT = 255 THEN CALL PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
DO;
call ignore$filename;
call parse$tail;
CALL RELOC;
CALL CLOSE(.FCBA);
IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
END;
CALL CRLF;
CALL BOOT;
END plmstart;
END;