[net.micro.atari16] XBIOS and command line arguments for TDI Modula-2

rling@uw-june (Robert Ling) (04/05/86)

Here is a module to interface with the extended BIOS.  I took it off
Compuserve and is posted here unmodified.  The author's name is Bob
Debula.  Also included is a module I wrote to get the arguments in
the command line.  It's nothing amazing but handy if you haven't written
one yourself.  The program, of course, has to be 'TTP' if invoked from
the desktop.

- Robert Ling   <rling@uw-june.arpa>

#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	xbioscalls.def
#	xbioscalls.mod
#	commandl.def
#	commandl.mod
export PATH; PATH=/bin:$PATH
echo shar: extracting "'xbioscalls.def'" '(4777 characters)'
sed 's/^X//' << \SHAR_EOF > 'xbioscalls.def'
XDEFINITION MODULE XBIOScalls;
X
XFROM SYSTEM IMPORT ADDRESS , BYTE , CODE , SETREG , REGISTER;
X
XEXPORT QUALIFIED initmous, ssbrk, physbase, logbase, getrez, setscreen,
X                 flopfmt, setpalette, setcolor, floprd, flopwr, midiws,
X                 mfpint, iorec, rsconf, keytbl, random, protobt,
X                 flopver, scrdmp, cursconf, settime, gettime, bioskeys,
X                 ikbdws, jdisint, jenabint, giaccess, offgibit, ongibit,
X                 xbtimer, dosound, setprt, kbdvbase, kbrate, prtblk, wvbl, 
X                 puntaes; 
X
XPROCEDURE initmous( type : CARDINAL; parameter, vector : ADDRESS );
X                                                 (* XBIOS call #0 *)
X
XPROCEDURE ssbrk( number : CARDINAL ) : ADDRESS;  (* XBIOS call #1 *)
X
XPROCEDURE physbase() : ADDRESS;                  (* XBIOS call #2 *)
X
XPROCEDURE logbase() : ADDRESS;                   (* XBIOS call #3 *)
X
XPROCEDURE getrez() : CARDINAL;                   (* XBIOS call #4 *)
X
XPROCEDURE setscreen( logadr, physadr : ADDRESS; res : INTEGER );
X                                                 (* XBIOS call #5 *)
X
XPROCEDURE setpalette( paletteptr : ADDRESS );    (* XBIOS call #6 *)
X
XPROCEDURE setcolor( colornum : CARDINAL; VAR color : INTEGER );
X                                                 (* XBIOS call #7 *)
X
XPROCEDURE floprd( buffer : ADDRESS; filler : LONGINT; dev, sector,
X                  track, side, count : CARDINAL ) : INTEGER ;
X                                                 (* XBIOS call #8 *)
X
XPROCEDURE flopwr( buffer : ADDRESS; filler : LONGINT; dev, sector, 
X                  track, side, count : CARDINAL ) : INTEGER ;
X                                                 (* XBIOS call #9 *)
X
XPROCEDURE flopfmt( buffer : ADDRESS; filler : LONGINT; dev, spt, track, 
X                   side, interleave : CARDINAL; magic : LONGCARD;
X                   virgin : CARDINAL ) : INTEGER ;
X                                                 (* XBIOS call #10 *)
X
XPROCEDURE midiws( count : CARDINAL; ptr : ADDRESS );
X                                                 (* XBIOS call #12 *)
X
XPROCEDURE mfpint( number : CARDINAL; vector : ADDRESS );
X                                                 (* XBIOS call #13 *)
X
XPROCEDURE iorec( dev : CARDINAL ) : ADDRESS;     (* XBIOS call #14 *)
X
XPROCEDURE rsconf( baud, ctrl, ucr, rsr, tsr, scr : INTEGER );
X                                                 (* XBIOS call #15 *)
X
XPROCEDURE keytbl( unshift, shift, capslock : ADDRESS ) : ADDRESS;
X                                                 (* XBIOS CALL #16 *)
X
XPROCEDURE random() : LONGCARD;                   (* XBIOS call #17 *)                                                    
X
XPROCEDURE protobt( buffer : ADDRESS; serialno: LONGINT; 
X                   disktype, execflag : INTEGER ); 
X                                                 (* XBIOS call #18 *)
X
XPROCEDURE flopver( buffer : ADDRESS; filler : LONGINT; dev, sector,
X                   track, side, count : CARDINAL ) : INTEGER;
X                                                 (* XBIOS call #19 *)
X
XPROCEDURE scrdmp();                              (* XBIOS call #20 *)
X
XPROCEDURE cursconf( function, rate : CARDINAL ) : CARDINAL ; 
X                                                 (* XBIOS call #21 *)
X
XPROCEDURE settime( time : LONGCARD ) ;           (* XBIOS call #22 *)
X
XPROCEDURE gettime() : LONGCARD ;                 (* XBIOS call #23 *)
X
XPROCEDURE bioskeys() ;                           (* XBIOS call #24 *)
X
XPROCEDURE ikbdws( number : CARDINAL; pointer : ADDRESS ) ; 
X                                                 (* XBIOS call #25 *)
X
XPROCEDURE jdisint( number : CARDINAL ) ;         (* XBIOS call #26 *)
X
XPROCEDURE jenabint( number : CARDINAL ) ;        (* XBIOS call #27 *)
X
XPROCEDURE giaccess( data, register : BYTE ) : BYTE; 
X                                                 (* XBIOS call #28 *)
X
XPROCEDURE offgibit ( bitnumber : CARDINAL );     (* XBIOS call #29 *)
X
XPROCEDURE ongibit ( bitnumber : CARDINAL );      (* XBIOS call #30 *)
X
XPROCEDURE xbtimer ( timer : CARDINAL; control, data : BYTE;
X                    vector : ADDRESS );          (* XBIOS call #31 *)
X
XPROCEDURE dosound ( pointer : ADDRESS );         (* XBIOS call #32 *)
X
XPROCEDURE setprt ( config : INTEGER ) : CARDINAL;
X                                                 (* XBIOS call #33 *)
X
XPROCEDURE kbdvbase () : ADDRESS;                 (* XBIOS call #34 *)
X
XPROCEDURE kbrate ( delay, repeat : INTEGER ) : CARDINAL;
X                                                 (* XBIOS call #35 *)
X
XPROCEDURE prtblk ( parameter : ADDRESS );        (* XBIOS call #36 *)
X
XPROCEDURE wvbl ();                               (* XBIOS call #37 *)
X
XPROCEDURE puntaes ();                            (* XBIOS call #39 *)
X
X
X
X
X
XEND XBIOScalls.
SHAR_EOF
if test 4777 -ne "`wc -c 'xbioscalls.def'`"
then
    echo shar: error transmitting "'xbioscalls.def'" '(should have been 4777 characters)'
fi
echo shar: extracting "'xbioscalls.mod'" '(20471 characters)'
sed 's/^X//' << \SHAR_EOF > 'xbioscalls.mod'
XIMPLEMENTATION MODULE XBIOScalls;
X
XFROM SYSTEM IMPORT ADDRESS , BYTE , CODE , SETREG , REGISTER;
X
X
X
XPROCEDURE initmous ( type : CARDINAL; parameter, vector : ADDRESS ) ; 
X                                                     (* XBIOS call #0 *)
X
XBEGIN;
X
X  SETREG(7,vector);            (* vector address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,parameter);         (* parameter address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(type));     (* parameter type *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,0,4E4EH);         (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND initmous;
X
X
X
XPROCEDURE ssbrk ( number : CARDINAL ) : ADDRESS;  (* XBIOS call #1 *)
X
XBEGIN;
X
X  CODE ( 7000H );                (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(number));     (* # bytes memory *)
X  CODE ( 3F07H );                (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,1,4E4EH);          (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);            (* return address of memory area *)
X
XEND ssbrk;
X
X
X
XPROCEDURE physbase () : ADDRESS;                    (* XBIOS call #2 *)
X
XBEGIN;
X
X  CODE ( 7000H );                (* MOVEQ.L #0,D0       clear reg D0 *)
X  CODE (3F3CH,2,4E4EH);          (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);            (* return screen RAM base address *)
X
XEND physbase;
X
X
X
XPROCEDURE logbase () : ADDRESS;                     (* XBIOS call #3 *)
X
XBEGIN;
X
X  CODE ( 7000H );                (* MOVEQ.L #0,D0       clear reg D0 *)
X  CODE (3F3CH,3,4E4EH);          (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);            (* set logical screen base *)
X
XEND logbase;
X
X
X
XPROCEDURE getrez () : CARDINAL;                     (* XBIOS call #4 *)
X
XBEGIN;
X
X  CODE ( 7000H );                (* MOVEQ.L #0,D0       clear reg D0 *)
X  CODE (3F3CH,4,4E4EH);          (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN CARDINAL(REGISTER(0));  (* return screen resolution *)
X
XEND getrez;
X
X
X
XPROCEDURE setscreen ( logadr, physadr : ADDRESS; res : INTEGER );
X                                                    (* XBIOS call #5 *)
XBEGIN;
X
X  SETREG(7,logadr);             (* logical screen base into reg D7 *) 
X  CODE ( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,physadr);            (* physical screen base into reg D7 *)
X  CODE ( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(res));       (* put vector number into register D7 *)
X  CODE ( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,5,4E4EH);         (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND setscreen;
X
X
X
XPROCEDURE setpalette ( paletteptr : ADDRESS ) ;      (* XBIOS call #6 *)
XBEGIN;
X
X  SETREG(7,paletteptr);        (* address of new color pallette *) 
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,6,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND setpalette;
X
X
XPROCEDURE setcolor( colornum : CARDINAL; VAR color : INTEGER );
X                                                    (* XBIOS call #7 *)
XBEGIN;
X
X  SETREG(7,ADDRESS(color));     (* color *) 
X  CODE ( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(colornum MOD 16));  (* color number *)
X  CODE ( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,7,4E4EH);         (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  IF (color = -1) THEN          (* is this call to return color? *)
X     color := INTEGER(REGISTER(0)); (* return color *)
X  END;
X
XEND setcolor;
X
X
XPROCEDURE floprd ( buffer : ADDRESS; filler : LONGINT; dev, sector,
X                   track, side, count : CARDINAL ) : INTEGER; 
X                                                   (* XBIOS call #8 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(count));    (* count of sectors to read *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(side MOD 2));  (* side to read *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(track));    (* track # to read *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(sector));   (* # of 1st sector to be read *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(dev MOD 2));   (* drv # to read *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(filler));   (* useless (but required) filler *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,buffer);            (* buffer address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,8,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN INTEGER(REGISTER(0)); (* return read error code *)
X
XEND floprd;
X
X
X
XPROCEDURE flopwr ( buffer : ADDRESS; filler : LONGINT; dev, sector,
X                   track, side, count : CARDINAL ) : INTEGER; 
X                                                     (* XBIOS call #9 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(count));    (* count of sectors to written *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(side MOD 2));  (* side to write *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(track));    (* track # to write *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(sector));   (* # of 1st sector to be written *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(dev MOD 2));   (* drv # to write *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(filler));   (* useless (but required) filler *)
X  CODE( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,buffer);            (* buffer address *)
X  CODE( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE(3F3CH,9,4E4EH);         (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN INTEGER(REGISTER(0)); (* return read error code *)
X
XEND flopwr;
X
X
X
XPROCEDURE flopfmt ( buffer : ADDRESS; filler : LONGINT; dev, spt, track,  
X                    side, interleave : CARDINAL; magic : LONGCARD; 
X                    virgin : CARDINAL ) : INTEGER;  (* XBIOS call #10 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(virgin));   (* sector format value *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(magic));    (* magic constant $87654321 *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(interleave));  (* order in which sectors are written *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(side MOD 2));  (* side to format *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(track));    (* track # to format *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(spt));      (* sectors/track *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(dev MOD 2));   (* drv # to format *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(filler));   (* useless (but required) filler *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,buffer);            (* buffer address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,10,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN INTEGER(REGISTER(0)); (* return format error code *)
X
XEND flopfmt;
X
X
X
XPROCEDURE midiws ( count : CARDINAL; ptr : ADDRESS );
X                                                   (* XBIOS call #12 *)
XBEGIN;
X
X  SETREG(7,ptr);               (* pointer to MIDI output string *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(count));    (* # of characters to send *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,12,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND midiws;
X
X
X
XPROCEDURE mfpint ( number : CARDINAL; vector : ADDRESS );
X                                                   (* XBIOS call #13 *)
XBEGIN;
X
X  SETREG(7,vector);            (* pointer to MIDI output string *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(number));   (* # of characters to send *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,13,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND mfpint;
X
X
X
XPROCEDURE iorec ( dev : CARDINAL ) : ADDRESS;       (* XBIOS call #14 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear reg D0 *)
X  SETREG(7,ADDRESS(dev MOD 3));  (* input device *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,14,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);          (* return ptr to buffer data record *)
X
XEND iorec;
X
X
X
XPROCEDURE rsconf ( baud, ctrl, ucr, rsr, tsr, scr : INTEGER );
X                                                    (* XBIOS call #15 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(scr));      (* MFP synch char register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(tsr));      (* MFP tx status register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(rsr));      (* MFP receiver staus register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(ucr));      (* MFP USART control register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(ctrl));     (* handshake mode *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(baud));     (* baud rate *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,15,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND rsconf;
X
X
X
XPROCEDURE keytbl ( unshift, shift, capslock : ADDRESS ) : ADDRESS;
X                                                    (* XBIOS call #16 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear reg D0 *)
X  SETREG(7,capslock);          (* capslock key tbl address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,shift);             (* shift key tbl address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,unshift);           (* unshifted key tbl address *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,16,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);          (* return address of vector tbl *)
X
XEND keytbl;
X
X
X
XPROCEDURE random () : LONGCARD;                     (* XBIOS call #17 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear reg D0 *)
X  CODE (3F3CH,17,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN LONGCARD(REGISTER(0));   (* return random # *)
X
XEND random;
X
X
X
XPROCEDURE protobt ( buffer : ADDRESS; serialno : LONGINT;
X                    disktype, execflag : INTEGER );
X                                                    (* XBIOS call #18 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(execflag));  (* flag to indicate if executable *)
X  CODE ( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(disktype));  (* disktype *)
X  CODE ( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(serialno));  (* diskette serial # *)
X  CODE ( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,buffer);             (* buffer address *)
X  CODE ( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,18,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND protobt;
X
X
X
XPROCEDURE flopver ( buffer : ADDRESS; filler : LONGINT; dev, sector,
X                    track, side, count : CARDINAL ) : INTEGER; 
X                                                    (* XBIOS call #19 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(count));    (* number of sectors *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(side MOD 2));  (* side to verify *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(track));    (* track # to verify *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(sector));   (* # of 1st sector to be verified *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(dev MOD 2));   (* drv # to verify *)
X  CODE( 3F07H );               (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(filler));   (* useless (but required) filler *)
X  CODE( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,buffer);            (* buffer address *)
X  CODE( 2F07H );               (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE(3F3CH,19,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN INTEGER(REGISTER(0)); (* return read error code *)
X
XEND flopver;
X
X
X
XPROCEDURE scrdmp();            (* XBIOS call #20 *)
X
XBEGIN;
X
X  CODE (3F3CH,20,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND scrdmp;
X
X
X
XPROCEDURE cursconf ( function, rate : CARDINAL ) : CARDINAL; 
X                                                    (* XBIOS call #21 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear reg D0 *)
X  SETREG(7,ADDRESS(rate));     (* cursor flash rate *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(function MOD 6)); (* cursor function *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,21,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN CARDINAL(REGISTER(0));  (* return ptr to buffer data record *)
X
XEND cursconf;
X
X
X
XPROCEDURE settime ( time : LONGCARD );              (* XBIOS call #22 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(time));     (* clock time & date to set *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE (3F3CH,22,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND settime;
X
X
X
XPROCEDURE gettime () : LONGCARD;                     (* XBIOS call #23 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear reg D0 *)
X  CODE (3F3CH,23,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN LONGCARD(REGISTER(0)); (* return clock time & date *)
X
XEND gettime;
X
X
X
XPROCEDURE bioskeys ();                             (* XBIOS call #24 *)
X
XBEGIN;
X
X  CODE (3F3CH,24,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND bioskeys;
X
X
X
XPROCEDURE ikbdws ( number : CARDINAL; pointer : ADDRESS ); 
X                                                   (* XBIOS call #25 *)
X
XBEGIN;
X
X  SETREG(7,pointer);           (* address of tx command string *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(number));   (* length of string -1 *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,25,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND ikbdws;
X
X
X
XPROCEDURE jdisint ( number : CARDINAL );           (* XBIOS call #26 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(number MOD 16));  (* MFP interrupt # to disable *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,26,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND jdisint;
X
X
X
XPROCEDURE jenabint ( number : CARDINAL );          (* XBIOS call #27 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(number MOD 16));  (* MFP interrupt # to enable *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,27,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND jenabint;
X
X
X
XPROCEDURE giaccess ( data, register : BYTE ) : BYTE; 
X                                                   (* XBIOS call #28 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* clear D0 in case GI read *)
X  SETREG(7,ADDRESS(register)); (* GI sound chip register # *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(data));     (* GI sound chip command *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,28,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN BYTE(REGISTER(0));    (* if GI read return value *)
X
XEND giaccess;
X
X
X
XPROCEDURE offgibit ( bitnumber : CARDINAL );         (* XBIOS call #29 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(bitnumber MOD 8)); (* set bit # port A GI sound chip *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,29,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND offgibit;
X
X
X
XPROCEDURE ongibit ( bitnumber : CARDINAL );          (* XBIOS call #30 *)
X
XBEGIN;
X
X  SETREG(7,ADDRESS(bitnumber MOD 8)); (* clear bit # port A GI sound chip *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,30,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND ongibit;
X
X
X
XPROCEDURE xbtimer ( timer : CARDINAL; control, data : BYTE; 
X                    vector : ADDRESS );              (* XBIOS call #31 *)
X
XBEGIN;
X
X  SETREG(7,vector);            (* address of timer interrupt vector *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  SETREG(7,ADDRESS(data));     (* value for MFP timer data register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(control));  (* value for MFP timer control register *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(timer MOD 4));  (* MFP timer # *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,31,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND xbtimer;
X
X
X
XPROCEDURE dosound ( pointer : ADDRESS );          (* XBIOS call #32 *)
X
XBEGIN;
X
X  SETREG(7,pointer);           (* pointer to string of sound commands *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE(3F3CH,32,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND dosound;
X
X
X
XPROCEDURE setprt ( config : INTEGER ) : CARDINAL;  (* XBIOS call #33 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear D0 *)
X  SETREG(7,ADDRESS(config));   (* printer configuration *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE(3F3CH,33,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN CARDINAL(REGISTER(0));  (* return config bit vector *)
X
XEND setprt;
X
X
X
XPROCEDURE kbdvbase () : ADDRESS;                 (* XBIOS call #34 *)
X
XBEGIN;
X
X  CODE(3F3CH,34,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN REGISTER(0);          (* return pointer to vector tbl *)
X
XEND kbdvbase;
X
X
X
XPROCEDURE kbrate ( delay, repeat : INTEGER ) : CARDINAL; 
X                                                  (* XBIOS call #35 *)
X
XBEGIN;
X
X  CODE ( 7000H );              (* MOVEQ.L #0,D0       clear reg D0 *)
X  SETREG(7,ADDRESS(repeat));   (* repeat interval *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  SETREG(7,ADDRESS(delay));    (* delay before 1st repeat *)
X  CODE ( 3F07H );              (* MOVE.W  D7,-(SP)    word on stack *)
X  CODE (3F3CH,35,4E4EH);       (* MOVE.W  #call,-(SP) then TRAP 14 *)
X  RETURN CARDINAL(REGISTER(0));  (* return repeat & delay *)
X
XEND kbrate;
X
X
X
XPROCEDURE prtblk ( parameter : ADDRESS );         (* XBIOS call #36 *)
X
XBEGIN;
X
X  SETREG(7,prtblk);            (* address of parameter list *)
X  CODE ( 2F07H );              (* MOVE.L  D7,-(SP)    longword on stack *)
X  CODE(3F3CH,36,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND prtblk;
X
X
X
XPROCEDURE wvbl ();                               (* XBIOS call #37 *)
X
XBEGIN;
X
X  CODE(3F3CH,37,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND wvbl;
X
X
X
XPROCEDURE puntaes ();                             (* XBIOS call #39 *)
X
XBEGIN;
X
X  CODE(3F3CH,39,4E4EH);        (* MOVE.W  #call,-(SP) then TRAP 14 *)
X
XEND puntaes;
X
X
X
X
XEND XBIOScalls.
SHAR_EOF
if test 20471 -ne "`wc -c 'xbioscalls.mod'`"
then
    echo shar: error transmitting "'xbioscalls.mod'" '(should have been 20471 characters)'
fi
echo shar: extracting "'commandl.def'"
sed 's/^X//' << \SHAR_EOF > 'commandl.def'
XDEFINITION MODULE  CommandLine;
X
X(***********************************************************************
X *                                                                     *
X *   CommandLine : Module to access the agruments in the command line. *
X *                                                                     *
X *   Author: Robert Ling   3/25/86                                     *
X *                                                                     *
X ***********************************************************************)
X
X
XEXPORT QUALIFIED
X
X     (* proc *)    NumberOfArguments,
X     (* proc *)    GetArgument;
X
X
XPROCEDURE  NumberOfArguments (): CARDINAL;
X
X  (* Returns the number of arguments in the command line not including
X     the name of the program. *)
X
XPROCEDURE  GetArgument ( n : CARDINAL; VAR arg : ARRAY OF CHAR);
X
X  (* Procedure to get an argument from the command line.  'n' specifies
X     the argument.  The argument is returned in 'arg' terminated by a
X     zero byte if the argument does not fill the array.   If a request
X     is made for a non-existent argument, an array with a zero byte is
X     returned.  If the size of the array 'arg' is too small to contain
X     the argument, the argument is truncated (no zero byte at end). *)
X
XEND  CommandLine.
SHAR_EOF
if test 1297 -ne "`wc -c 'commandl.def'`"
then
    echo shar: error transmitting "'commandl.def'" '(should have been 1297 characters)'
fi
echo shar: extracting "'commandl.mod'"
sed 's/^X//' << \SHAR_EOF > 'commandl.mod'
XIMPLEMENTATION MODULE  CommandLine;
X
X(***********************************************************************
X *                                                                     *
X *   CommandLine : Module to access the agruments in the command line. *
X *                                                                     *
X *   Author: Robert Ling   3/25/86                                     *
X *                                                                     *
X ***********************************************************************)
X
XFROM SYSTEM IMPORT
X
X     BYTE, WORD, LONGWORD, ADDRESS, CODE, SETREG, REGISTER;
X
XFROM GEMX IMPORT
X
X     BasePageAddress;         (* type ADDRESS: address of base page table *)
X
XTYPE    str255 = ARRAY [0..255] OF CHAR;
X
XVAR     CommandTailLength : CARDINAL;
X        NumberOfArgs : CARDINAL;
X        CommandTailPtr : POINTER TO str255;
X
X
X(***** CommandLineInit ***** Routine to find the command tail and
X determine the number of arguments.  The address of the command tail
X is at an offset of 128 bytes from the base page.  The first byte
X holds the length of the command tail. *)
X
XPROCEDURE  CommandLineInit;
X VAR     i : CARDINAL;
XBEGIN
X  SETREG (8, BasePageAddress);        (* move.l   base,a0           *)
X  CODE (41E8h,0080h);                 (* lea.l    128(a0),a0        *)
X  CODE (1018h);                       (* move.b   (a0)+,d0          *)
X  CODE (0280h,0000h,00FFh);           (* andi.l   #$ff,d0           *)
X
X  CommandTailLength := CARDINAL(REGISTER(0));   (* d0 -> length     *)
X  CommandTailPtr := REGISTER(8);                (* a0 -> tail addr. *)
X
X                                      (* count number of args *)
X  IF (CommandTailLength > 0) AND (CommandTailPtr^[0] <> ' ') THEN
X    NumberOfArgs := 1;
X  ELSE
X    NumberOfArgs := 0;
X  END;
X
X  FOR i := 0 TO (CommandTailLength-2) DO      (* sequential search *)
X    IF (CommandTailPtr^[i] = ' ') AND
X       (CommandTailPtr^[i+1] <> ' ') THEN     (* look for beginings *)
X      NumberOfArgs := NumberOfArgs + 1;
X    END;
X  END;
XEND  CommandLineInit;
X
X
X(***** NumberOfArguments *****  Routine that returns the number of
X arguments in the command line.  This could be implemented as an
X exported variable but safer not to. *)
X
XPROCEDURE  NumberOfArguments (): CARDINAL;
XBEGIN
X  RETURN (NumberOfArgs);
XEND  NumberOfArguments;
X
X
X(***** GetArgument *****  Routine that returns an argument.  If the
X specified argument is non-existent then an empty array is returned
X (null byte).  If the argument is shorter than the than the length
X of the array it is terminated by a null byte.  If longer, it is
X truncated. *)
X
XPROCEDURE  GetArgument ( n : CARDINAL; VAR arg: ARRAY OF CHAR);
X VAR    i,j,start,FirstArg : CARDINAL;
XBEGIN
X  IF (n < 1) OR (n > NumberOfArgs) THEN      (* invalid number *)
X    arg[0] := 0C;                            (* return empty array *)
X  ELSE
X    i := 0;                                  (* character pointer *)
X
X    IF (CommandTailPtr^[0] <> ' ') THEN
X      FirstArg := 1;
X    ELSE
X      FirstArg := 0;
X    END;
X
X    FOR j := FirstArg TO (n-1) DO
X      REPEAT                            (* search for next begining *)
X        i := i + 1;
X      UNTIL (CommandTailPtr^[i-1] = ' ') AND (CommandTailPtr^[i] <> ' ');
X    END;
X
X    start := i;                         (* i points at start of arg *)
X  
X                                        (* copy argument over *)
X    WHILE ((i-start) <= HIGH(arg)) AND
X          (CommandTailPtr^[i] <> ' ') AND
X          (i < CommandTailLength) DO
X      arg[i-start] := CommandTailPtr^[i];
X      i := i + 1;
X    END;
X
X    IF ((i-start) <= HIGH(arg)) THEN 
X      arg[i-start] := 0C;               (* terminate with null byte *)
X    END;
X  END;  (*else*)
XEND  GetArgument;
X
X
XBEGIN
X  CommandLineInit;                      (* initialize variables *)
XEND  CommandLine.
X
X
X    
X
SHAR_EOF
if test 3836 -ne "`wc -c 'commandl.mod'`"
then
    echo shar: error transmitting "'commandl.mod'" '(should have been 3836 characters)'
fi
echo end