github.com/sboydlns.univacemulators
1
0
Fork 0
mirror of https://github.com/sboydlns/univacemulators.git synced 2026-01-12 00:42:48 +00:00
Code Issues Projects Releases Wiki Activity

Fixed a bug of long standing in the DIAG instruction that caused low priority tasks to be given precedence over high priority tasks.

Browse Source 
Fixed a typo in the ASCII to EBCDIC translate table.

Added source for BEM simulator.
This commit is contained in:
sboydlns 2022-03-22 16:43:53 -04:00
parent 485733026d
commit 4b8cfde132
35 changed files with 6411 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Common/EmulatorTypes.pas
View File

@ -347,7 +347,7 @@ const
$f8, $f9, $7a, $5e, $4c, $7e, $6e, $6f,
$7c, $c1, $c2, $c3, $c4, $c5, $c6, $c7,
$c8, $c9, $d1, $d2, $d3, $d4, $d5, $d6,
$d7, $d8, $d9, $e2, $e3, $e4, $e5, $d6,
$d7, $d8, $d9, $e2, $e3, $e4, $e5, $e6,
$e7, $e8, $e9, $4a, $e0, $5a, $5f, $6d,
$79, $81, $82, $83, $84, $85, $86, $87,
$88, $89, $91, $92, $93, $94, $95, $96,

10
U494/Source/MOS.pjt
View File

@ -28,13 +28,13 @@ SysSetCwd='C:\Development\Emulators\U9030\Source'
SrchSetFlags=0x4418600b
FileSortMode=0x0
StateWindowFrame=12,0,959,1087,0x63097f08
_StateWindow=26,26,478,561,0x00100010,'C:\Development\Emulators\U9030\Source\BemFstatus.asm',208,31,212,4,20,12,46,26,126,176,8,4294967295,4294967295,1,10,'',12,255,48,72,10,467,0,0,721,252,249,169,34,400,0,212,214,210,220,721,721,720,729,217,80,0,223,224,14,124,1,208,1,6
_StateBuffer='C:\Development\Emulators\U9030\Source\BemFstatus.asm',0x0400048a,169,34,25,'10 16 40 50 60 72','',0x1,'',1,72,1
_StateHistory=FILELIST,'C:\Development\Emulators\U9030\Source\SaveCopin.jcl','C:\Development\Emulators\U9030\Source\BemSimulator.jcl','C:\Development\Emulators\U9030\Source\BemVtoc.asm','C:\Development\Emulators\U9030\Source\BemHlp.asm','C:\Development\Emulators\U9030\Source\BemLib.asm','C:\Development\Emulators\U9030\Source\BemSimulator.asm','C:\Development\Emulators\U9030\Source\BemFstatus.asm','C:\Development\Emulators\U9030\Source\LibTest.asm','C:\Development\Emulators\U9030\Source\SaveBemDsects.jcl'
_StateHistory=SEARCH,'4(R14)','NOT','EOJ','=h22','dx','LBH$SIZE','LINTMPLT','LINTPLT','LINSTRT','X\'25\''
_StateWindow=104,104,478,561,0x00100010,'C:\Development\Emulators\U9030\Source\icam3.asc',208,31,212,4,20,12,46,26,126,176,8,4294967295,4294967295,1,10,'',12,255,48,72,10,467,0,0,721,252,249,2,29,400,0,212,214,210,220,721,721,720,729,217,80,0,223,224,14,1,1,208,1,6
_StateBuffer='C:\Development\Emulators\U9030\Source\icam3.asc',0x0400048a,2,29,25,'6 12 17 22 27 32 37 41','',0x1,'',1,72,1
_StateHistory=FILELIST,'C:\Development\Emulators\U9030\Source\SaveBemDsects.jcl','C:\Development\Emulators\U9030\Source\BadCmd.asm','C:\Development\Emulators\U9030\Source\BemDelete.asm','C:\Development\Emulators\U9030\Source\BemSimulator.asm','C:\Development\Emulators\U9030\Source\BemDisplay.asm','C:\Development\Emulators\U9030\Source\BemFstatus.asm','C:\Development\Emulators\U9030\LNS.notrace.cfg','C:\Development\Emulators\U9030\Source\icam3.asc','C:\Development\Emulators\U9030\Source\icam.asc'
_StateHistory=SEARCH,'ALIASES','JTIMASK','PCNTKN','PC3','DOHALT','EOJMSG','INIT','RETURN','INVCMD','PC$'
_StateHistory=REPLACE,'.'
_StateHistory=XSYMBOL,'OUTPUT','ERROR','INPUT','FILE'
_StateHistory=EDITFILE,'C:\Development\Emulators\U9030\Source\BemSimulator.jcl','C:\Development\Emulators\U9030\Source\BemVtoc.asm','C:\Development\Emulators\U9030\Source\BemHlp.asm','C:\Development\Emulators\U9030\Source\BemLib.asm','C:\Development\Emulators\U9030\Source\SaveBemDsects.jcl','C:\Development\Emulators\U9030\Source\LibTest.asm','C:\Development\Emulators\U9030\Source\BemSimulator.asm','C:\Development\Emulators\U9030\Source\BemFstatus.asm','C:\Development\Emulators\U9030\Source\LibTest.asm','C:\Development\Emulators\U9030\Source\SaveBemDsects.jcl'
_StateHistory=EDITFILE,'C:\Development\Emulators\U9030\Source\BadCmd.asm','C:\Development\Emulators\U9030\Source\BemDelete.asm','C:\Development\Emulators\U9030\Source\BemSimulator.asm','C:\Development\Emulators\U9030\Source\BemDisplay.asm','C:\Development\Emulators\U9030\Source\BemFstatus.asm','C:\Development\Emulators\U9030\Source\icam.asc','C:\Development\Emulators\U9030\Source\icam3.asc','C:\Development\Emulators\U9030\LNS.notrace.cfg','C:\Development\Emulators\U9030\Source\icam3.asc','C:\Development\Emulators\U9030\Source\icam.asc'
_StateHistory=DIRECTORY,'c:\tmp\$Y$MAC','C:\tmp\$Y$SRC','C:\TMP','C:\tmp','C:\tmp\$Y$GEN','C:\TMP\$Y$MAC','C:\tmp\$Y$MAC'
_StateHistory=GOTOMARK,'2','1','2','1','2','1','2','1','2','1'

5
U9030/Cpu.pas
View File

@ -1436,6 +1436,9 @@ var
n: AnsiString;
isSym: Boolean;
begin
i := match and $f00;
if ((i <> 0) and (i <> $100) and (i <> $300)) then
raise ESpecificationException.Create('Unsupported DIAG option');
if (match = $100) then
begin
// This shit makes no sense to me. I have implemented this based on what I
@ -1560,7 +1563,7 @@ var
psw.CondCode := 0;
FRegisters[PSW.RegisterSet, r] := switchList - FRelocateReg;
FRegisters[PSW.RegisterSet, r + 1] := TWord(tcb - FRelocateReg);
Break;
Exit;
end;
end else if (skipUntil = tcb) then
skipUntil := 0;

BIN
U9030/Docs/U9030.odt
View File

Binary file not shown.

BIN
U9030/Docs/U9030.pdf
View File

Binary file not shown.

14
U9030/Setup/U9030.iss
View File

@ -2,7 +2,7 @@
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!
#define MyAppName "Univac 90/30 Emulator"
#define MyAppVerName "Univac 90/30 Emulator Univac 90/30 Emulator1.0"
#define MyAppVerName "Univac 90/30 Emulator 1.0"
#define MyAppPublisher "LNS Software Systems"
#define MyAppExeName "U9030.exe"
@ -39,7 +39,8 @@ Source: ..\Win32\Debug\U200TN.exe; DestDir: {app}; Flags: ignoreversion
Source: ..\Win32\Debug\U9030Print.exe; DestDir: {app}; Flags: ignoreversion
Source: ..\Disks\SDIVSB.8418; DestDir: {commonappdata}\Univac 9030 Emulator\Data; Permissions: users-full
Source: ..\Disks\VSBRES.8418; DestDir: {commonappdata}\Univac 9030 Emulator\Data; Permissions: users-full
Source: ..\Disks\REL042.8418; DestDir: {commonappdata}\Univac 9030 Emulator\Data; Permissions: users-full
Source: ..\Disks\LNSREL.8418; DestDir: {commonappdata}\Univac 9030 Emulator\Data; Permissions: users-full; DestName: REL042.8418
Source: ..\Disks\LNS001.8418; DestDir: {commonappdata}\Univac 9030 Emulator\Data; Permissions: users-full
Source: C:\Development\Emulators\U9030\REL042.cfg.release; DestDir: {app}; DestName: REL042.cfg
Source: C:\Development\Emulators\U9030\VSB.cfg.release; DestDir: {app}; DestName: VSB.cfg
Source: ..\Manuals\Univac_90_30_System_Brochure_Mar74.pdf; DestDir: {app}\Manuals
@ -76,16 +77,17 @@ Source: ..\Source\supgen.asc; DestDir: {app}\Source
Source: ..\Source\PrepLns001.jcl; DestDir: {app}\Source; DestName: Prep18.jcl
[Icons]
Name: {group}\Univac 9030 Emulator; Filename: {app}\U9030.exe; Parameters: -c REL042.cfg; IconIndex: 0
Name: {commondesktop}\Univac 9030 Emulator; Filename: {app}\U9030.exe; Tasks: desktopicon; Parameters: -c REL042.cfg; IconIndex: 0
Name: {group}\Univac 9030 Emulator (IMS - BEM); Filename: {app}\U9030.exe; Parameters: -c REL042.cfg; IconIndex: 0
Name: {commondesktop}\Univac 9030 Emulator (IMS - BEM); Filename: {app}\U9030.exe; Tasks: desktopicon; Parameters: -c REL042.cfg; IconIndex: 0
Name: {group}\U8418 Utilities; Filename: {app}\U8418Util.exe; IconIndex: 0
Name: {group}\U9030 Disassembler; Filename: {app}\U9030DisAsm.exe; IconIndex: 0
Name: {group}\U9030 Console; Filename: {app}\U9030Console.exe; IconIndex: 0
Name: {group}\Dump Restore; Filename: {app}\DmpRst.exe; IconIndex: 0
Name: {group}\Univac 9030 Emulator (VSB); Filename: {app}\U9030.exe; Parameters: -c VSB.cfg; IconIndex: 0
Name: {group}\Emulator Documentatiopn; Filename: {app}\Docs\U9030.pdf
Name: {group}\Emulator Documentation; Filename: {app}\Docs\U9030.pdf
Name: {group}\U9030 Print; Filename: {app}\U9030Print.exe; IconIndex: 0
Name: {group}\U200 Emulator; Filename: {app}\U200TN.exe; IconIndex: 0
Name: {group}\U200 Emulator (IMS); Filename: {app}\U200TN.exe; Parameters: -p 9036
Name: {group}\U200 Emulator (BEM); Filename: {app}\U200TN.exe; Parameters: -p 9034
[Run]
Filename: {app}\{#MyAppExeName}; Description: {cm:LaunchProgram,{#MyAppName}}; Flags: nowait postinstall skipifsilent; Parameters: -c REL042.cfg

87
U9030/Source/BadCmd.asm Normal file
View File

@ -0,0 +1,87 @@
TITLE 'SEND ''BAD COMMAND'' ERRORS FOR BOYD''S BEM SIMULATOR'
BADCMD START
***********************************************************************
* *
* A SIMPLE PROGRAM FOR BOYD'S BEM SIMULATOR TO SEND AN UNKNOWN COMMAND*
* ERROR TO THE USER'S TERMINAL. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
BADCMD CSECT
RGEQU
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING ZA#OMH,R6
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
CLI ZA#IMSG,C'L' SEND 'PLS LOGON'?
BE SNDLOGON YES
MVC ZA#OMSG(UNKCMDL),UNKCMD NO, SEND 'UNK COMMAND'
LA R11,UNKCMDL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
SNDLOGON MVC ZA#OMSG(LOGONL),LOGON MOVE MSG TO OMA
LA R11,LOGONL
STH R11,ZA#OTL
MVI ZA#PSIND,C'N' SET NORMAL TERMINATION
B DONE
*
DONE LM R14,R12,12(R13)
BR R14
*
UNKCMD ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,22 LINE 22 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'UNKNOWN COMMAND'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
UNKCMDL EQU *-UNKCMD
*
LOGON ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,22 LINE 22 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'PLEASE LOGON'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
LOGONL EQU *-LOGON
*
END
// FIN

180
U9030/Source/BemBuild.jcl Normal file
View File

@ -0,0 +1,180 @@
// JOB BEMBUILD,,10000,10000
// DVC 20 // LFD PRNTR
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// DVCVOL LNS001
// LBL LNSOBJ // LFD OBJ
//BADCMD ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BADCMD
INCLUDE BADCMD,OBJ
/*
// NOP
// NOP
//BEMDEL ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMDEL
INCLUDE BEMDEL,OBJ
/*
// NOP
// NOP
//BEMDSP ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMDSP
INCLUDE BEMDSP,OBJ
/*
// NOP
// NOP
//BEMFST ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMFST
INCLUDE BEMFST,OBJ
/*
// NOP
// NOP
//BEMHLP ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMHLP
INCLUDE BEMHLP,OBJ
/*
// NOP
// NOP
//BEMLGF ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMLGF
INCLUDE BEMLGF,OBJ
/*
// NOP
// NOP
//BEMLGN ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMLGN
INCLUDE BEMLGN,OBJ
/*
// NOP
// NOP
//BEMPRT ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMPRT
INCLUDE BEMPRT,OBJ
/*
// NOP
// NOP
//BEMRDY ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMRDY
INCLUDE BEMRDY,OBJ
/*
// NOP
// NOP
//BEMSTA ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMSTA
INCLUDE BEMSTA,OBJ
/*
// NOP
// NOP
//BEMVTC ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
/$
LOADM BEMVTC
INCLUDE BEMVTC,OBJ
/*
// NOP
// NOP
//BEMPRNTR ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// NOP
// NOP
//BEMLIB ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// NOP
// NOP
//BEMSIM ASM IN=(LNS001,LNSSRC), X
//1 LIN=(LNS001,LNSMAC), X
//2 OUT=(LNS001,LNSOBJ), X
//3 LST=(NC)
// NOP
// NOP
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
// PARAM NOAUTO
/$
LOADM BEMSIM
INCLUDE BEMSIM,OBJ
INCLUDE BEMLIB,OBJ
INCLUDE BEMPRNTR,OBJ
INCLUDE PR$IOE,$Y$OBJ
/*
/&
// FIN

336
U9030/Source/BemDelete.asm Normal file
View File

@ -0,0 +1,336 @@
TITLE '/DELETE COMMAND FOR BOYD''S BEM SIMULATOR'
BEMDEL START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /DELETE COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
SUPEQU REGS=YES
SA$DSECT
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMDEL CSECT
BEMDSCTS
*
SAVE (14,12),COVER=2
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING CDA,R7
USING LIBFIL,R8
USING SA$DSECT,R13
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
LA R8,LIBPKT COVER LIB RTNS PARAM PKT
ST R13,SAVAREA+4
LA R13,SAVAREA
BAL R14,INIT INIT. LIB. PARAM PACKET
*
* PARSE COMMAND LINE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,ELENAME BURN '/DELETE'
BALR R14,R15
LA R11,ELENAME GET THE ELEMENT NAME
BALR R14,R15
LA R11,FNAME GET THE FILE NAME
BALR R14,R15
LA R11,VSN GET VOLUME ID
BALR R14,R15
LA R11,ELETYP GET ELEMENT TYPE
BALR R14,R15
*
* VALIDATE PARAMS.
*
CLI ELENAME,C' ' ELEMENT NAME BLANK?
BE NOELE YES, OOPS!
CLI FNAME,C' ' FILE NAME BLANK?
BE NOFIL YES, OOPS!
CLI ELETYP,C' ' ELEMENT TYPE BLANK?
BNE CHKTYP NO, CONTINUE
MVC ELETYP,VSN COPY VOLUME ID TO ELE TYPE
CHKTYP CLI ELETYP,C' ' ELEMENT TYPE STILL BLANK?
BE BADTYP YES, OOPS
CLI ELETYP,C'O' OBJECT ELEMENT?
BNE CHKLOD NO, CONTINUE
MVI LIBTYP,LET$OBJ YES, ALL GOOD
B CHKELE
CHKLOD CLI ELETYP,C'L' LOAD ELEMENT?
BNE CHKGRP NO, CONTINUE
MVI LIBTYP,LET$PHSE YES, ALL GOOD
B CHKELE
CHKGRP CLI ELETYP,C'G' GROUP HEADER?
BNE CHKSRC NO, CONTINUE
MVI LIBTYP,LET$BGRP YES,ALL GOOD
B CHKELE
CHKSRC CLI ELETYP,C'S' SOURCE ELEMENT?
BNE CHKPROC NO, CONTINUE
MVI LIBTYP,LET$SRC YES, ALL GOOD
B CHKELE
CHKPROC CLI ELETYP,C'P' PROC ELEMENT?
BNE CHKMAC NO, CONTINUE
MVI LIBTYP,LET$PROC YES, ALL GOOD
B CHKELE
CHKMAC CLI ELETYP,C'M' MACRO ELEMENT?
BNE BADTYP NO, OOPS!
MVI LIBTYP,LET$PROC YES, ALL GOOD
*
* SEE IF ELEMENT/FILE IS VALID
*
CHKELE MVC LF$NAME,FNAME SET UP PARAM PKT
MVC LF$ELE,ELENAME
MVC LF$ETYP,LIBTYP
LA R1,LIBPKT POINT TO PARAMS.
L R15,LM$LOPN TRY TO OPEN FILE
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ BADFIL NO
L R15,LM$LDEL TRY TO DELETE IT
BALR R14,R15
LTR R0,R0 ERROR CODE = 0?
BNZ BADELE NO, OOPS!
LTR R1,R1 ELEMENT FOUND?
BZ BADELE NO, OOPS
CLI ELETYP,C'G' DELETING A GROUP?
BNE DDONE NO, WE'RE DONE
MVI LF$ETYP,LET$EGRP YES, DELETE END OF GROUP MARKER
L R15,LM$LDEL TRY TO DELETE IT
BALR R14,R15
LTR R0,R0 ERROR CODE = 0?
BNZ BADELE NO, OOPS!
LTR R1,R1 ELEMENT FOUND?
BZ BADELE NO, OOPS
*
DDONE MVC ZA#OMSG(EOJMSGL),EOJMSG MOVE MSG TO OMA
LA R11,EOJMSGL SET MSG LENGTH
STH R11,ZA#OTL
MVC OELENAM,ELENAME MOVE ELEMENT NAME TO OMA
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
DONE L R15,LM$LCLS CLOSE THE LIBRARY
BALR R14,R15
L R13,SA$BLNK RESTORE R13
RETURN (14,12) RESTORE REGS & RETURN TO MON.
************
*
* INITIALIZE PARAMETER PACKET IN WORK AREA
* R14 = RETURN ADDRESS
*
************
INIT LA R11,DIRBFR SET PTR TO DIR BUFFER
ST R11,LF$DBFR
LA R11,DTABFR SET PTR TO DATA BUFFER
ST R11,LF$EBFR
BR R14
************
*
* SEND FILE NAME MISSING ERROR
*
************
NOFIL MVC ZA#OMSG(FILMSNGL),FILMSNG MOVE MSG TO OMA
LA R11,FILMSNGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID FILE NAME ERROR
*
************
BADFIL MVC ZA#OMSG(INVFILL),INVFIL MOVE MSG TO OMA
LA R11,INVFILL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND ELEMENT NAME MISSING ERROR
*
************
NOELE MVC ZA#OMSG(ELEMSNGL),ELEMSNG MOVE MSG TO OMA
LA R11,ELEMSNGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID ELEMENT NAME ERROR
*
************
BADELE MVC ZA#OMSG(INVELEL),INVELE MOVE MSG TO OMA
LA R11,INVELEL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID ELEMENT TYPE ERROR
*
************
BADTYP MVC ZA#OMSG(TYPERRL),TYPERR MOVE MSG TO OMA
LA R11,TYPERRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND LIBRARY I/O ERROR
*
************
BADLIB MVC ZA#OMSG(LIBERRL),LIBERR MOVE MSG TO OMA
LA R11,LIBERRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
FILMSNG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'FILE NAME MISSING'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
FILMSNGL EQU *-FILMSNG
************
INVFIL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'FILE NAME NOT FOUND'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
INVFILL EQU *-INVFIL
************
ELEMSNG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT NAME MISSING'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
ELEMSNGL EQU *-ELEMSNG
************
INVELE ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT NAME / TYPE NOT FOUND'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
INVELEL EQU *-INVELE
************
TYPERR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT TYPE MUST BE SPECIFIED (S/P/M/O/L/G)'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
TYPERRL EQU *-TYPERR
************
LIBERR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ERROR WHILE READING SOURCE ELEMENT'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
LIBERRL EQU *-LIBERR
************
EOJMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
ELENAM EQU *-EOJMSG
DC C' DELETED'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
EOJMSGL EQU *-EOJMSG
************
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
OELENAM EQU ZA#OMSG+ELENAM,8
************
WORKAREA DSECT
DTEMP DS D DOUBLE WORD ALIGNED TEMP VAR.
CTEMP DS CL8
ELENAME DS CL8 SOURCE ELEMENT NAME
FNAME DS CL8 LIBRARY FILE NAME
VSN DS CL8 VOLUME ID (NOT USED)
ELETYP DS CL8 ELEMENT TYPE (S/P)
LIBTYP DS XL1 LIBRARY FRIENDLY ELE TYPE
SAVAREA DS 18F
DS 0F
LIBPKT DS XL(LF$LNGTH) LIBRARY ROUTINES PARAM PACKET
DIRBFR DS XL256 LIBRARY DIR. PARTITION BFR
DTABFR DS XL256 LIBRARY DATA PARTITION BFR
************
CDA DSECT
DUMMY DS XL1
*
BEMDEL CSECT
*
END
// FIN

390
U9030/Source/BemDisplay.asm Normal file
View File

@ -0,0 +1,390 @@
TITLE '/DISPLAY COMMAND FOR BOYD''S BEM SIMULATOR'
BEMDSP START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /DISPLAY COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
SUPEQU REGS=YES, X
TCB=YES, X
PRE=YES, X
SIB=YES, X
IO=NO, X
TRN=NO
PUBDSECT DSECT
PUBEQU
BEMDSP CSECT
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMDSP CSECT
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
* GET THE JOB'S TCB TO GET THE JOB NUMBER
*
USING JT$TCB,R7
LA R1,TCBBFR
GETINF TCB,(1),L'TCBBFR,0
LA R7,TCBBFR
XR R11,R11 GET THE JOB KEY
IC R11,JT$KEY
SRL R11,4 SHIFT RIGHT TO GET JOB #
STC R11,JOBNUM SAVE IT FOR LATER
DROP R7
*
* GET JOB PREAMBLE TO GET ABSOLUTE BASE ADDRESS OF THIS PROGRAM AND
* ITS JOB NUMBER
*
USING JP$PRE,R7
LA R1,PREBFR
GETINF PRE,(1),L'PREBFR,0
LA R7,PREBFR
MVC BASEADR,JP$JSB SAVE BASE ADDR OF PGM FOR LATER
MVI BASEADR,0 CLEAR MSB
DROP R7
*
* GET SYSTEM INFORMATION BLOCK (SIB) TO GET ADDRESS OF SWITCH LIST
* AND PUBS AND OTHER STUFF
*
USING SB$SIB,R7
LA R1,SIBBFR
GETINF SIB,(1),L'SIBBFR,0
LA R7,SIBBFR
LH R11,SB$SLA GET SWITCH LIST ADDR.
LA R11,16(R11) BUMP PAST SUPER TCBS
S R11,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
ST R11,SWADDR
L R11,SB$PBA GET 1ST PUB ADDR.
LA R11,0(R11) CLEAR MSB
S R11,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
ST R11,PUBADDR
MVC NUMPUBS,SB$PBC+2 GET # NUM OF PUBS
MVI NUMPRI,0 GET # OF USER PRIORITIES
MVC NUMPRI+1(1),SB$NOPRI
LH R11,SB$MLO GET ADDR 1ST MEMORY BLOCK
SLL R11,8
S R11,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
ST R11,MEMLOW
LH R11,SB$MHI GET ADDR LAST MEMORY BLOCK
SLL R11,8
S R11,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
ST R11,MEMHI
DROP R7
*
* DECODE THE INPUT MESSAGE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,DTYPE BURN '/DISPLAY'
BALR R14,R15
LA R11,DTYPE GET TYPE OF STATUS
BALR R14,R15
*
* CHECK STATUS TYPE AND BRANCH TO APPROPRIATE ROUTINE
*
CLI DTYPE,C'J' JOBS?
BE SENDJOB YES
CLI DTYPE,C'V' VOLUMES?
BE SENDVOL YES
*
* SEND 'INVALID OPTION' ERROR
*
MVC ZA#OMSG(BADOPTL),BADOPT MOVE ERROR TO OMA
LA R11,BADOPTL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
* SEND JOBS INFO
*
USING JT$TCB,R7
USING JP$PRE,R9
SENDJOB MVC ZA#OMSG(JOBHDRL),JOBHDR MOVE JOBS HEADER TO OMA
LA R11,JOBHDRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
SJLOOP1 L R7,SWADDR GET ADDR OF 1ST TCB IN CHAIN
L R7,0(R7)
LA R7,0(R7) CLEAR MSB
ST R7,FSTTCB SAVE IT
SJLOOP2 LTR R7,R7 TCB ADDR = ZERO?
BZ SJBUMP YES, TRY NEXT CHAIN
S R7,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
L R11,JT$ECB IS ECB PTR = ZERO?
LA R11,0(R11)
LTR R11,R11
BNZ SJNEXT YES, NOT PRIMARY TCB
*
* DISPLAY ONE LINE FOR CURRENT JOB
*
L R9,JT$PRE GET JOB PREAMBLE ADDR.
LA R9,0(R9) CLEAR MSB
S R9,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
LA R12,ZA#OMSG GET ADDR OF OUTPUT MSG
AH R12,ZA#OTL ADD CRNT OFFSET INTO OMA
MVC 0(JOBDTLL,R12),JOBDTL MOVE JOB DETAIL TEMPLATE TO OMA
AI ZA#OTL,JOBDTLL BUMP MSG LENGTH
*
MVC JNAME(8,R12),JP$NAM COPY JOB NAME TO OMA
MVC JEXEC(8,R12),JP$ROOT COPY EXEC MODULE TO OMA
L R11,JP$JOB GET MEM. SIZE
CVD R11,DTEMP CVT TO PACKED
MVC CTEMP(L'SIZMASK),SIZMASK MAKE PRINTABLE
ED CTEMP(L'SIZMASK),DTEMP+4
OI CTEMP+7,X'F0'
MVC JSIZE(6,R12),CTEMP+2 COPY TO OMA
XR R11,R11 GET JOB STEP #
IC R11,JP$JSN
CVD R11,DTEMP
MVC CTEMP(L'STEPMASK),STEPMASK MAKE PRINTABLE
ED CTEMP(L'STEPMASK),DTEMP+6
OI CTEMP+3,X'F0'
MVC JSTEP(3,R12),CTEMP+1 COPY TO OMA
XR R11,R11 GET JOB #
IC R11,JT$KEY
SRL R11,4
CVD R11,DTEMP
MVC CTEMP(L'JIDMASK),JIDMASK MAKE PRINTABLE
ED CTEMP(L'JIDMASK),DTEMP+5
OI CTEMP+5,X'F0'
MVC JNUM(5,R12),CTEMP+1 COPY TO OMA
L R11,JP$AJT GET ACCUM. CPU TIME
XR R10,R10 DIVIDE BY 100
D R10,=F'100'
CVD R11,DTEMP CONVERT QUOTIENT TO PACKED
MVC CTEMP(L'JTIMASK),JTIMASK MAKE PRINTABLE
ED CTEMP(L'JTIMASK),DTEMP+4
OI CTEMP+8,X'F0'
MVC JTIME(8,R12),CTEMP+1
*
SJNEXT L R7,JT$LNK GET PTR TO NEXT TCB
LA R7,0(R7) CLEAR MSB
C R7,FSTTCB NEXT = FIRST?
BE SJBUMP YES, END OF CHAIN, TRY NEXT
B SJLOOP2
*
SJBUMP AI NUMPRI,-1 DECR. # PRIORITIES
BNP SJMEM <= ZERO, WE'RE DONE WITH JOBS
L R11,SWADDR BUMP TO NEXT TCB CHAIN
LA R11,4(R11)
ST R11,SWADDR SAVE IT
B SJLOOP1 & LOOP
*
* FOLLOW THE MEMORY BLOCK CHAIN TO CALC. FREE MEMORY. BLOCK HEADERS
* ARE THE SAME FORMAT AS THE JOB PREAMBLE.
*
SJMEM XR R12,R12 CLR. TTL MEMORY
L R9,MEMLOW GET PTR TO 1ST BLOCK
SMLOOP TM JP$SIZ,X'80' IS THIS A FREE BLOCK?
BZ SMNEXT NO
A R12,JP$SIZ ADD BLOCK SIZE TO TTL
LA R12,0(R12) CLEAR MSB
SMNEXT LH R9,JP$MHI GET NEXT BLOCK
LTR R9,R9 ZERO?
BZ SMSHOW YES, END OF LIST
SLL R9,8
S R9,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
B SMLOOP & LOOP
*
SMSHOW LR R11,R12 SAVE TTL MEMORY
LA R12,ZA#OMSG GET ADDR OF OUTPUT MSG
AH R12,ZA#OTL ADD CRNT OFFSET INTO OMA
MVC 0(JOBFREL,R12),JOBFRE MOVE FREE MEM. TEMPLATE TO OMA
AI ZA#OTL,JOBFREL BUMP MSG LENGTH
CVD R11,DTEMP CVT FREE MEM TO PACKED
MVC CTEMP(L'SIZMASK),SIZMASK MAKE PRINTABLE
ED CTEMP(L'SIZMASK),DTEMP+4
OI CTEMP+7,X'F0'
MVC JSIZE(6,R12),CTEMP+2 COPY TO OMA
B DONE WE'RE DONE, RETURN TO TASK MGR
DROP R7,R9
*
* SEND VOLUME INFO
*
USING IP$PUB,R7
SENDVOL MVC ZA#OMSG(VOLHDRL),VOLHDR MOVE VOLUMES HEADER TO OMA
LA R11,VOLHDRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
LA R11,1 CALC. BIT TO CHECK FOR ASGNMNT
IC R12,JOBNUM
SLL R11,0(R12)
STC R11,JOBNUM
*
LA R7,PUBBFR COVER PUBS
L R11,PUBADDR POINT TO 1ST PUB
SVLOOP MVC IP$PUB(IP$LNGTH),0(R11) COPY PUB TO OUR BFR
CLI IP$TYP,X'20' IS IT FOR A DISK?
BNE SVNEXT NO, TRY NEXT
LH R12,IP$TRL GET PTR TO PUB TRAILER
S R12,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
MVC IP$PUBT(IP$LENT),0(R12) COPY TO OUR BUFFER
LA R12,ZA#OMSG GET CRNT OFFSET INTO OMA
AH R12,ZA#OTL
AI ZA#OTL,8 BUMP MSG LENGTH
MVI 0(R12),C' ' CLEAR 8 BYTES
MVC 1(7,R12),0(R12)
MVC 1(6,R12),IP$VSN COPY VOL ID TO OMA
IC R10,JOBNUM ASSIGNED TO THIS JOB?
EX R10,SVTM
BZ SVNEXT NO
MVI 0(R12),C'*' YES, PREFIX VSN WITH '*'
SVNEXT LA R11,IP$LNGTH(R11) BUMP TO NEXT PUB
AI NUMPUBS,-1 DECR. PUB COUNT
BP SVLOOP > 0, TRY AGAIN
*
LA R12,ZA#OMSG GET CRNT OFFSET INTO OMA
AH R12,ZA#OTL
MVC 0(VOLTLRL,R12),VOLTLR COPY MSG TRAILER TO OMA
AI ZA#OTL,VOLTLRL BUMP MSG LENGTH
B DONE
*
DONE LM R14,R12,12(R13) RESTORE REGISTERS
BR R14 RETURN TO MONITOR
*
SVTM TM IP$ALC,0
*
* JOBS INFO HEADER
*
JOBHDR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C' JOB NAME SIZE TIME STEP EXEC JOB NO'
JOBHDRL EQU *-JOBHDR
*
JOBDTL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C' '
JNAME EQU *-JOBDTL
DC C'XXXXXXXX '
JSIZE EQU *-JOBDTL
DC C'XXXXXX '
JTIME EQU *-JOBDTL
DC C'XXXXXX.X '
JSTEP EQU *-JOBDTL
DC C'XXX '
JEXEC EQU *-JOBDTL
DC C'XXXXXXXX '
JNUM EQU *-JOBDTL
DC C'XXXXX'
JOBDTLL EQU *-JOBDTL
*
JOBFRE ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'UNUSED MEMORY '
JFREE EQU *-JOBFRE
DC C'XXXXXX'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
JOBFREL EQU *-JOBFRE
*
VOLHDR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
VOLHDRL EQU *-VOLHDR
*
VOLTLR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
VOLTLRL EQU *-VOLTLR
*
BADOPT ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'INVALID OPTION. VALID OPTIONS ARE: JOBS, VOLUMES'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
BADOPTL EQU *-BADOPT
*
SIZMASK DC X'4020202020202120'
STEPMASK DC X'40202120'
JIDMASK DC X'402020202120'
JTIMASK DC X'402020202021204B20'
*
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
*
WORKAREA DSECT
DTEMP DS D DOUBLE WORD ALIGNED TEMP VAR.
BASEADR DS A BASE ADDR. OF BEMSIM JOB
SWADDR DS A ADDR. OF SWITCH LIST
PUBADDR DS A ADDR OF PUB
NUMPUBS DS H # OF PUBS
NUMPRI DS H # OF USER PRIORITIES
FSTTCB DS A ADDR OF 1ST TCB IN CHAIN
MEMLOW DS A ADDR OF 1ST MEMORY BLOCK
MEMHI DS A ADDR OF LAST MEMORY BLOCK
DTYPE DS CL8 DISPLAY TYPE (JOBS/VOLUMES)
CTEMP DS CL10
JOBNUM DS XL1
*
PUBNUM DS H CURRENT PUB #
DS 0D
PREBFR DS XL(JP$LNGTH) JOB PREAMBLE BUFFER
DS 0D
SIBBFR DS XL(SB$LNGTH) SYS. INFO. BLOCK BUFFER
DS 0D
PUBBFR DS XL(IP$LNGTH) PUB BUFFER
PTRLBFR DS XL(IP$LENT) PUB TRAILER BFR
*
TCBBFR DS XL(JT$LNGTH)
*
BEMDSP CSECT
*
END
// FIN

429
U9030/Source/BemFstatus.asm Normal file
View File

@ -0,0 +1,429 @@
TITLE '/FSTATUS COMMAND FOR BOYD''S BEM SIMULATOR'
BEMFST START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /FSTATUS COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
SUPEQU REGS=YES
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMFST CSECT
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING CDA,R7
USING LIBFIL,R8
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
LA R8,LIBPKT COVER LIB RTNS PARAM PKT
LA R11,SAVAREA SET UP NEW SAVE AREA
ST R13,4(R11)
LR R13,R11
*
CLI FSTPASS,X'00' IS THIS THE FIRST PASS?
BNE PASS2 NO
B PASS1
*
DONE L R15,LM$LCLS CLOSE THE LIBRARY
BALR R14,R15
L R13,4(R13) RESTORE REGISTERS
LM R14,R12,12(R13)
BR R14
*
* FIRST PASS, DECODE THE INPUT MESSAGE
*
USING L$DIRENT,R1
PASS1 BAL R14,INIT INITIALIZE PARAM PKT
MVC LINCNT,=H'22' INITIALIZE THE LINE COUNTER
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,FNAME BURN '/FSTATUS'
BALR R14,R15
LA R11,FNAME GET THE FILE NAME
BALR R14,R15
LA R11,VSN GET VOLUME ID
BALR R14,R15
LA R11,OPTN GET LONG OPTION
BALR R14,R15
CLI OPTN,C' ' OPTION PRESENT
BNE P11 YES
MVC OPTN,VSN NO, COPY VOLUME TO OPTION
P11 CLI FNAME,C' ' FILE NAME PRESENT?
BE BADFIL NO
*
MVC LF$NAME,FNAME COPY FILE NAME TO PARAM PKT
LA R1,LIBPKT TRY TO OPEN THE LIBRARY
L R15,LM$LOPN
BALR R14,R15
LTR R0,R0 SUCCESS?
BNE OPENERR NO
*
BAL R14,INITLINE INIT OMA WITH LINE TEMPLATE
L R15,LM$LDFST GET 1ST DIRECTORY ENTRY
BALR R14,R15
P1LOOP LTR R0,R0 SUCCESS?
BNZ READERR NO
LTR R1,R1 NO ENTRY FOUND?
BZ P1EOJ YES
CLI LDE$TYPE,LET$EOF END OF FILE?
BE P1EOJ YES
CLI LDE$TYPE,LET$OBJ OBJECT MODULE?
BNE P1L1 NO
MVI 0(R11),C'O'
B P1CONT
P1L1 CLI LDE$TYPE,LET$PHSE LOAD MODULE?
BNE P1L2 NO
MVI 0(R11),C'L'
B P1CONT
P1L2 CLI LDE$TYPE,LET$PROC PROC MODULE?
BNE P1L3 NO
MVI 0(R11),C'P'
B P1CONT
P1L3 CLI LDE$TYPE,LET$SRC SOURCE MODULE?
BNE P1NEXT NO, NOT INTERESTING TYPE, SKIP
MVI 0(R11),C'S'
P1CONT MVI 1(R11),C'-' MOVE SEPARATOR TO OMA
MVC 2(8,R11),LDE$NAME MOVE MODULE NAME TO OAM
CLI OPTN,C'L' LONG LIST REQUESTED?
BE P1LONG YES
LA R11,11(R11) BUMP INDEX
BCT R12,P1NEXT DECR. COUNT & GET NEXT DIR ENTRY
B P1DONE COUNT EXHAUSTED, WE DONE
*
P1NEXT LA R1,LIBPKT POINT TO PARAM PKT
L R15,LM$LDNXT & GET NEXT DIR ENTRY
BALR R14,R15
B P1LOOP
*
P1DONE AI LINCNT,-1 DECR. LINE COUNTER
BP P1DCONT > ZERO, CONTINUE
LH R11,ZA#OTL CALC OFFSET INTO OMA
LA R11,ZA#OMSG(R11)
MVC 0(MOREMSGL,R11),MOREMSG MOVE 'MORE?' TO OMA
AI ZA#OTL,MOREMSGL BUMP MSG LENGTH
MVI ZA#PSIND,ZA#PSNE SET EXTERNAL SUCCESSION
MVC ZA#PSID,=C'BEMFST' TO OURSELVES
MVI FSTPASS,X'02' SET TO CHECK 'MORE' RESPONSE
B DONE & RETURN TO MONITOR
*
P1DCONT MVI ZA#PSIND,ZA#PSNE SET EXTERNAL SUCCESSION
MVC ZA#PSID,=C'BEMFST' TO OURSELVES
MVI ZA#OAUX,ZA#OCO SET FOR CONTINUOUS OUTPUT
MVI FSTPASS,X'01' SET TO SHOW NEXT LINE
B DONE & RETURN TO MONITOR
DROP R1
*
P1EOJ CH R12,=H'7' IS LINE EMPTY?
BL EOJ NO
XC ZA#OTL,ZA#OTL YES, SET MSG LENGTH TO ZERO
EOJ LH R11,ZA#OTL CALC OFFSET INTO OMA
LA R11,ZA#OMSG(R11)
MVC 0(EOJMSGL,R11),EOJMSG APPEND BLANK LINE TO END OF OMA
AI ZA#OTL,EOJMSGL BUMP MSG LENGTH
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
USING L$SRCHDR,R1
P1LONG ST R1,LF$DIRP COPY DIR. ENTRY ADDR TO PKT.
LA R1,LIBPKT POINT TO PARAM. PKT.
L R15,LM$LMHDR GO READ THE MODULE HEADER
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ READERR NO
MVC ODCMNT,LSH$CMNT COPY COMMENTS TO OMA
BAL R14,FIXCMNT FIX NON-PRINTABLE CHARACTERS
UNPK CTEMP,LSH$DATE(4) UNPACK DATE TO TEMP
MVC ODDAT(2),CTEMP+1 MOVE DATE TO OMA
MVC ODDAT+3(2),CTEMP+3
MVC ODDAT+6(2),CTEMP+5
UNPK CTEMP(6),LSH$TIME(3) UNPACK TIME TO TEMP
MVC ODTIM(2),CTEMP+1 MOVE TIME TO OMA
MVC ODTIM+3(2),CTEMP+3
B P1DONE
DROP R1
*
PASS2 CLI FSTPASS,X'01' DISPLAY NEXT LINE?
BE P2NEXT YES
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,YN GET RESPONSE TO MORE?
BALR R14,R15
CLI YN,C'N' RESPONSE = 'N'
BE EOJ YES, QUIT
MVC LINCNT,=H'22' NO, INIT LINE COUNT & CONTINUE
*
P2NEXT LA R1,LIBPKT TRY TO OPEN THE LIBRARY
L R15,LM$LOPN
BALR R14,R15
LTR R0,R0 SUCCESS?
BNE OPENERR NO
BAL R14,INITLINE INIT OMA WITH LINE TEMPLATE
B P1NEXT GO GET NEXT DIR. ENTRY
************
*
* INITIALIZE PARAMETER PACKET IN CDA
* R14 = RETURN ADDRESS
*
************
INIT LA R11,DIRBFR SET PTR TO DIR BUFFER
ST R11,LF$DBFR
LA R11,DTABFR SET PTR TO DATA BUFFER
ST R11,LF$EBFR
BR R14
************
*
* INITIALIZE THE OMA WITH THE LINE TEMPLATE AND SET UP INDEX (R11)
* AND LOOP COUNT (R12).
* R14 = RETURN ADDRESS
*
************
INITLINE CLI OPTN,C'L' LONG LIST REQUESTED?
BE ILONG YES
MVC ZA#OMSG(SMRYLINL),SMRYLIN COPY SUMMARY TEMPLATE TO OMA
LA R11,SMRYLINL SET TEXT LENGTH
STH R11,ZA#OTL
MVI OLSTRT,C' ' CLEAR LINE DATA TO SPACES
MVC OLSTRT+1(L'OLSTRT-1),OLSTRT
LA R11,OLSTRT INIT. BFR PTR
LA R12,7 INIT. LOOP COUNT
BR R14
*
ILONG MVC ZA#OMSG(DETLINL),DETLIN COPY DETAIL TEMPLATE TO OMA
LA R11,DETLINL SET TEXT LENGTH
STH R11,ZA#OTL
LA R11,ODTYP INIT. BFR PTR
LA R12,7 INIT LOOP COUNT.
BR R14
************
*
* SEND FILE NAME ID NOT SPECIFIED ERROR
*
************
BADFIL MVC ZA#OMSG(NOFILL),NOFIL MOVE MSG TO OMA
LA R11,NOFILL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* COULD NOT OPEN THE LIBARY
* R0 = ERROR CODE
*
************
OPENERR MVC ZA#OMSG(OEMSGL),OEMSG COPY ERR MSG TEMPLATE TO OMA
LA R11,OEMSGL SET TEXT LENGTH
STH R11,ZA#OTL
MVC OFNAM,FNAME COPY FILE NAME TO ERROR MSG
LA R1,OCODE CVT ERROR CODE TO HEX
BAL R14,ER2HEX
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE & RETURN TO TASKMGR
************
*
* COULD NOT READ THE LIBARY
* R0 = ERROR CODE
*
************
READERR MVC ZA#OMSG(REMSGL),REMSG COPY ERR MSG TEMPLATE TO OMA
LA R11,REMSGL SET TEXT LENGTH
STH R11,ZA#OTL
MVC OFNAM1,FNAME COPY FILE NAME TO ERROR MSG
LA R1,OCODE1 CVT ERROR CODE TO HEX
BAL R14,ER2HEX
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE & RETURN TO TASKMGR
************
*
* CONVERT AN ERROR CODE TO A 2 DIGIT HEX NUMBER.
* R0 = ERROR CODE
* R1 = PTR TO RESULT BUFFER
* R14 = RETURN ADDRESS
*
************
ER2HEX STC R0,DTEMP SEPARATE HEX DIGITS INTO CTEMP
UNPK CTEMP(3),DTEMP(2)
TR CTEMP(2),TRHEXB XLATE TO HEX
MVC 0(2,R1),CTEMP MOVE TO RESULT BUFFER
BR R14 RETURN
************
*
* MAKE COMMENT PRINTABLE (IN CASE OF CORRUPT SOURCE MODULE HEADER)
*
************
FIXCMNT LA R11,ODCMNT POINT TO COMMENTS
LA R12,L'ODCMNT SET LOOP COUNT
FCLOOP CLI 0(R11),C' ' CHAR < SPACE?
BNL FC1 NO, OK
MVI 0(R11),C' ' SUBSTITUTE SPACE
FC1 CLI 0(R11),C'9' CHAR > 9?
BNH FC2 NO, OK
MVI 0(R11),C' ' SUBSTITUTE SPACE
FC2 LA R11,1(R11) BUMP PTR.
BCT R12,FCLOOP DECR. COUNT & LOOP
BR R14 RETURN TO CALLER
************
NOFIL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'THE FILE NAME MUST BE SPECIFIED. /FSTATUS FILE-NAME'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
NOFILL EQU *-NOFIL
************
OEMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'COULD NOT OPEN '
OEFNAM EQU *-OEMSG
DC C'XXXXXXXX. ERROR DM'
OECODE EQU *-OEMSG
DC C'XX.'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
OEMSGL EQU *-OEMSG
************
REMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'COULD NOT READ '
REFNAM EQU *-REMSG
DC C'XXXXXXXX. ERROR DM'
RECODE EQU *-REMSG
DC C'XX.'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
REMSGL EQU *-REMSG
************
SMRYLIN ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
SMRYSTRT EQU *-SMRYLIN
DC 7C'X-XXXXXXXX '
SMRYLINL EQU *-SMRYLIN
************
DETLIN ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DETTYP EQU *-DETLIN
DC C'X-'
DETNAM EQU *-DETLIN
DC C'XXXXXXXX '
DETCMNT EQU *-DETLIN
DC C'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '
DETDAT EQU *-DETLIN
DC C'XX/XX/XX '
DETTIM EQU *-DETLIN
DC C'XX:XX'
DETLINL EQU *-DETLIN
************
EOJMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
EOJMSGL EQU *-EOJMSG
************
MOREMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'MORE (Y/N)? '
DC XL1'1E' SOE
MOREMSGL EQU *-MOREMSG
*
TRHEX DC C'0123456789ABCDEF'
TRHEXB EQU TRHEX-X'F0'
************
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
OFNAM EQU ZA#OMSG+OEFNAM,8
OCODE EQU ZA#OMSG+OECODE,2
OFNAM1 EQU ZA#OMSG+REFNAM,8
OCODE1 EQU ZA#OMSG+RECODE,2
OLSTRT EQU ZA#OMSG+SMRYSTRT,77
ODTYP EQU ZA#OMSG+DETTYP,1
ODNAM EQU ZA#OMSG+DETNAM,8
ODCMNT EQU ZA#OMSG+DETCMNT,30
ODDAT EQU ZA#OMSG+DETDAT,8
ODTIM EQU ZA#OMSG+DETTIM,5
************
WORKAREA DSECT
DTEMP DS D DOUBLE WORD ALIGNED TEMP VAR.
CTEMP DS CL8
FNAME DS CL8 LIBRARY FILE NAME
VSN DS CL8 VOLUME ID (NOT USED)
YN DS CL8
SAVAREA DS 18F
************
CDA DSECT
LINCNT DS H SCREEN LINE COUNTER
FSTPASS DS X FIRST PASS FLAG (0 = FIRST PASS)
OPTN DS CL8 OPTIONS (LONG)
DS 0D
LIBPKT DS XL(LF$LNGTH) LIBRARY ROUTINES PARAM PACKET
DIRBFR DS XL256 LIBRARY DIR. PARTITION BFR
DTABFR DS XL256 LIBRARY DATA PARTITION BFR
*
BEMFST CSECT
*
END
// FIN

81
U9030/Source/BemHlp.asm Normal file
View File

@ -0,0 +1,81 @@
TITLE '/HELP COMMAND FOR BOYD''S BEM SIMULATOR'
BEMHLP START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /HELP COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
BEMHLP CSECT
RGEQU
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING ZA#OMH,R6
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
MVC ZA#OMSG(CMDHELPL),CMDHELP SET UP OMA WITH MESSAGE
LA R11,CMDHELPL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
LM R14,R12,12(R13)
BR R14
*
CMDHELP ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ALL SYSTEM COMMANDS MUST BE PRECEDED BY A SLASH.'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'VALID COMMANDS ARE:'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'LOGON, LOGOFF, HELP, STATUS, DISPLAY, VTOC, FSTATUS'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'PRINT, DELETE'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
CMDHELPL EQU *-CMDHELP
*
END
// FIN

623
U9030/Source/BemLib.asm Normal file
View File

@ -0,0 +1,623 @@
TITLE 'LIBRARY INTERFACE ROUTINES FOR BOYD''S BEM SIMULATOR'
BEMLIB START
***********************************************************************
* *
* LIBRARY I/O ROUTINES FOR BOYD'S BEM SIMULATOR *
* *
***********************************************************************
PRINT NOGEN
SUPEQU REGS=YES
SA$DSECT
DTFDM
BEMDSCTS
ENTRY L$OPEN,L$CLOSE,L$DFIRST,L$DNEXT,L$EHDR
ENTRY L$DFIND,L$EFIRST,L$ENEXT,L$DELETE
*
USING DM$DSCT,R3
USING LIBFIL,R5
USING SA$DSECT,R13
*
************
*
* OPEN A LIBRARY FILE.
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMTER PACKET
* R2 = COVER
* R5 = PARAM. PACKET COVER
* R14 = RETURN ADDR.
* R15 = ENTRY POINT ADDR.
*
************
DS 0H
L$OPEN SAVE (14,12),COVER=2
LR R5,R1 COVER PARAM. PACKET
BAL R14,L$LOCK ACQUIRE SGL THREAD LOCK
LA R3,L$DTF COVER THE DTF
MVC DC$NME,LF$NAME MDFY DTF WITH FILE NAME
LA R11,L$OPNERR SET ERROR ADDRESS
ST R11,DC$ERCD
OPEN L$DTF OPEN THE FILE
XC SA$R0,SA$R0 ERROR CODE = 0
RETURN (14,12)
DROP R2
************
*
* CLOSE A LIBRARY FILE
* R14 = RETURN ADDR.
* R15 = ENTRY POINT ADDR.
*
************
L$CLOSE SAVE (14,12),COVER=2
CLI L$TS,X'FF' IS FILE OPEN?
BNE LC$DONE NO, IGNORE REQUEST
LC$OK LA R3,L$DTF
XR R11,R11 CLEAR ERROR ADDRESS
ST R11,DC$ERCD
CLOSE L$DTF
MVI L$TS,0 RELEASE THE LOCK
LC$DONE XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12)
DROP R2
************
*
* GET THE FIRST DIRECTORY ENTRY FOR THE CURRENT LIBRARY
* R0 = RETURNS ERROR CODE
* R1 = ON ENTRY PTR TO PARAMETER PACKET. ON EXIT, RETURNS PTR
* TO DIRECTORY ENTRY
* R2 = COVER
* R5 = PARAMETER PACKET COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADDR.
*
************
L$DFIRST SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LDF$SAVE+4 SAVE SA BACK LINK
LA R13,LDF$SAVE POINT TO OUR SAVE AREA
LR R5,R1 COVER PARAMETER PACKET
LA R11,1 SET NEXT BLOCK ID TO 1
ST R11,LF$DBLK
L R15,=A(L$DGET) READ BLOCK 1
BALR R14,R15
XR R1,R1 CLEAR DIR. ENTRY PTR
LTR R0,R0 I/O SUCCESS?
BNZ LDF$DONE NO, QUIT
LA R11,LBH$SIZE SET INITIAL BLK OFFSET
STH R11,LF$DOFST
L R1,LF$DBFR CALC PTR. TO DIR. ENTRY
AR R1,R11
XR R0,R0 ERROR CODE = 0
LDF$DONE L R13,SA$BLNK COVER CALLER SAVE AREA
ST R0,SA$R0 RETURN ERROR CODE
ST R1,SA$R1 RETURN PTR TO DIR. ENTRY
RETURN (14,12)
*
LDF$SAVE DS 18F
DROP R2
************
*
* GET THE NEXT DIRECTORY ENTRY FOR THE CURRENT LIBRARY
*
* R0 = RETURNS ERROR CODE
* R1 = ON ENTRY PTR TO PARAMETER PACKET. ON EXIT, RETURNS PTR
* TO DIRECTORY ENTRY
* R2 = COVER
* R5 = PARAMETER PACKET COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADDR.
*
************
L$DNEXT SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LDN$SAVE+4 SAVE SA BACK LINK
LA R13,LDN$SAVE POINT TO OUT SAVE AREA
LR R5,R1 COVER PARAMETER PACKET
LH R11,LF$DOFST GET OFFSET TO LAST DIR ENTRY
LA R11,LDE$SIZE(R11) BUMP TO NEXT
CH R11,LF$DLEN END OF BLOCK?
BL LDN$BOK NO
L R11,LF$DBLK YES, BUMP BLOCK #
LA R11,1(R11)
ST R11,LF$DBLK
L R15,=A(L$DGET) READ NEXT BLOCK
BALR R14,R15
XR R1,R1 CLEAR DIR. ENTRY PTR.
LTR R0,R0 I/O SUCCESS?
BNZ LDN$DONE NO, QUIT
LA R11,LBH$SIZE SET OFFSET TO 1ST ENTRY
LDN$BOK STH R11,LF$DOFST SAVE NEW OFFSET
L R1,LF$DBFR CALC PTR TO DIR. ENTRY
AR R1,R11
XR R0,R0 ERROR CODE = 0
LDN$DONE L R13,SA$BLNK COVER CALLER SAVE AREA
ST R0,SA$R0 RETURN ERROR CODE
ST R1,SA$R1 RETURN PTR TO DIR. ENTRY
RETURN (14,12)
*
LDN$SAVE DS 18F
DROP R2
************
*
* FIND AN ENTRY IN THE DIRECTORY
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMETER PACKET / RETURNS PTR TO DIR. ENTRY
* ZERO IF NOT FOUND
* R2 = COVER
* R5 = PARAMETER PACKET COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADDRESS
************
USING L$DIRENT,R1
L$DFIND SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LFN$SAVE+4 SAVE SA BACK LINK
LA R13,LFN$SAVE POINT TO OUT SAVE AREA
LR R5,R1 COVER PARAMETER PACKET
L R15,=A(L$DFIRST) GET 1ST DIRECTORY ENTRY
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ LFN$NFND NO, QUIT
LFN$LOOP CLI LDE$TYPE,LET$EOF END OF FILE?
BE LFN$NFND YES
CLC LDE$NAME,LF$ELE NAME MATCH?
BNE LFN$NEXT NO
CLC LDE$TYPE,LF$ETYP ELE. TYPE MATCH?
BE LFN$FND YES
LFN$NEXT LR R1,R5 POINT TO PARAM PACKET
L R15,=A(L$DNEXT) GET NEXT DIRECTORY ENTRY
BALR R14,R15
LTR R0,R0 SUCCESS?
BZ LFN$LOOP YES
*
LFN$NFND XR R1,R1
LFN$FND L R13,SA$BLNK RESTORE R13
ST R0,SA$R0 RETURN ERROR CODE
ST R1,SA$R1 RETURN PTR TO DIR ENTRY
RETURN (14,12)
*
LFN$SAVE DS 18F
DROP R1
************
*
* DELETE THE ELEMENT SPECIFIED IN THE PARAMETER PACKET.
*
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMETER PACKET. RETURNS ZERO IF NOT FOUND.
* ONE OTHERWISE.
* R2 = COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADDRESS
************
USING L$DIRENT,R1
L$DELETE SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LD$SAVE+4 SAVE SA BACK LINK
LA R13,LD$SAVE POINT TO OUT SAVE AREA
LR R5,R1 SAVE PTR TO PARAM PACKET.
L R15,=A(L$DFIND) FIND ELE TO BE DELETED
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ LD$NFND NO
LTR R1,R1 ELEMENT FOUND?
BZ LD$NFND NO
MVI LDE$TYPE,LET$NULL SHOW ELEMENT DELETED
LR R1,R5 RESTORE PTR TO PARAM PACKET
L R15,=A(L$DPUT) REWRITE DIRECTORY BLOCK
BALR R14,R15
LA R1,1 SHOW RECORD FOUND
B LD$FND
*
LD$NFND XR R1,R1 SHOW NOT FOUND
LD$FND L R13,SA$BLNK RESTORE R13
ST R0,SA$R0 RETURN ERROR CODE
ST R1,SA$R1 RETURN FOUND/NOT FOUND
RETURN (14,12) & RETURN TO CALLER
*
LD$SAVE DS 18F
DROP R1
************
*
* READ THE ELEMENT HEADER BELONGING TO THE DIRECTORY ENTRY GIVEN
* BY LF$DIRP.
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMETER PACKET / RETURNS PTR TO MODULE HEADER
* R2 = COVER ADDRESS
* R4 = DIRECTORY ENTRY COVER
* R5 = PARAMETER PACKET COVEVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT
*
************
USING L$DIRENT,R4
L$EHDR SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LEH$SAVE+4 SET SA BACK LINK
LA R13,LEH$SAVE POINT TO OUR SAVE AREA
LR R5,R1 COVER PARAMETER PACKET
L R4,LF$DIRP COVER DIRECTORY ENTRY
XC LF$EBLK,LF$EBLK CLEAR BLOCK # IN PKT
MVC LF$EBLK+1(3),LDE$BLK GET BLOCK # TO READ
XC LF$EOFST,LF$EOFST GET OFFSET TO HEADER
MVC LF$EOFST+1,LDE$REC
L R15,=A(L$EGET) READ THE BLOCK
BALR R14,R15
XR R1,R1 CLEAR MODULE HEADER PTR
LTR R0,R0 I/O SUCCESS?
BNZ LEH$DONE NO, QUIT
L R1,LF$EBFR CALC. PTR TO MODULE HEADER
AH R1,LF$EOFST
*
LEH$DONE L R13,SA$BLNK COVER CALLER SAVE AREA
ST R0,SA$R0 RETURN ERROR CODE
ST R1,SA$R1 RETURN PTR TO DIR. ENTRY
RETURN (14,12)
*
LEH$SAVE DS 18F
DROP R2,R4
************
*
* GET THE FIRST RECORD OF AN ELEMENT
*
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMETER PACKET
* R2 = COVER ADDRESS
* R4 = DIRECTORY ENTRY COVER
* R5 = PARAMETER PACKET COVEVER
* R6 = SOURCE MODULE HEADER COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADDR.
*
************
USING L$DIRENT,R4
USING L$MODHDR,R6
L$EFIRST SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LEN$SAVE+4 SET SA BACK LINK
LA R13,LEN$SAVE POINT TO OUR SAVE AREA
LR R5,R1 COVER PARAM PACKET
L R4,LF$DIRP COVER DIRECTORY ENTRY
*
XC LF$EBLK,LF$EBLK SET 1ST DATA BLOCK #
MVC LF$EBLK+1(3),LDE$BLK
L R15,=A(L$EGET) READ THE BLOCK
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ LEN$DONE
*
* BUMP PAST MODULE HEADER
*
XR R6,R6 GET OFFSET TO MODULE HEADER
IC R6,LDE$REC
STH R6,LF$EOFST SAVE IT
A R6,LF$EBFR POINT TO MODULE HDR IN BUFFER
XR R11,R11 GET MODULDE HDR LENGTH
IC R11,LMH$LEN
LA R11,2(R11) CALC. OFFSET TO 1ST DATA RECORD
AH R11,LF$EOFST
STH R11,LF$EOFST SAVE IT.
B L$ENEXT1 GO GET DATA RECORD
DROP R2,R4,R6
************
*
* GET THE NEXT RECORD OF AN ELEMENT
* R0 = RETURNS ERROR CODE
* R1 = PTR TO PARAMETER PACKET
* R2 = COVER ADDRESS
* R4 = PTR. TO USER'S LINE BFR
* R5 = PARAMETER PACKET COVEVER
* R7 = SOURCE MODULE HEADER COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT ADRESS
*
************
USING L$MODHDR,R7
L$ENEXT SAVE (14,12),COVER=2
BAL R14,L$CKLOCK CHECK FILE HAS BEEN OPENED
ST R13,LEN$SAVE+4 SET SA BACK LINK
LA R13,LEN$SAVE POINT TO OUR SAVE AREA
LR R5,R1 COVER PARAM PACKET
*
L$ENEXT1 BALR R2,0
USING *,R2
*
L R4,LF$SBFR GET USER'S SOURCE BFR ADDR.
MVI 0(R4),C' ' CLEAR THE USER'S BUFFER
MVC 1(255,R4),0(R4)
LH R11,LF$EOFST GET OFFSET TO RECORD
CH R11,LF$ELEN END OF BLOCK?
BL LEN$OK NO
L R11,LF$EBLK BUMP BLOCK #
LA R11,1(R11)
ST R11,LF$EBLK
L R15,=A(L$EGET) READ THE BLOCK
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ LEN$DONE NO
LA R11,LBH$SIZE SET INITIAL OFFSET
*
LEN$OK LR R7,R11 CALC. ADDR OF RECORD
A R7,LF$EBFR
XR R10,R10 GET LENGTH OF RECORD
IC R10,LMH$LEN
STH R10,LEN$LEN SAVE IT FOR LATER
AR R10,R11 CALC. OFFSET TO NEXT RECORD
LA R10,2(R10)
STH R10,LF$EOFST SAVE IT
CLI LMH$TYPE,X'24' TRUNCATED?
BE LEN$TRNC YES
CLI LMH$TYPE,X'25' COMPRESSED
BE LEN$COMP YES
B LEN$EOF IF NOT ONE OF ABOVE, END OF ELE.
*
LEN$TRNC LH R10,LEN$LEN GET LENGTH OF DATA
AH R10,=H'-1' MAKE ZERO RELATIVE
EX R10,LEN$MVC MOVE DATA TO USER BUFFER
XR R0,R0 SHOW NOT END OF FILE
B LEN$DONE
*
LEN$COMP LH R10,LEN$LEN
LEN$LOOP LTR R10,R10 END OF RECORD
BNP LEN$EOR YES
XR R11,R11 GET # BLANKS
IC R11,3(R7)
AR R4,R11 BUMP USER BFR PTR.
IC R11,2(R7) GET DATA LENGTH
EX R11,LEN$MVC1 MOVE DATA TO USER BUFFER
LA R4,1(R11,R4) BUMP USER DATA BFR PTR
LA R11,3(R11) BUMP LENGTH TO INCLUDE HDR.
AR R7,R11 BUMP DATA BUFFER PTR.
SR R10,R11 DECR. RECORD LENGTH
B LEN$LOOP & LOOP
*
LEN$EOR XR R0,R0 SHOW NOT END OF FILE
B LEN$DONE
*
LEN$EOF LA R0,1 SHOW END OF FILE
*
LEN$DONE L R13,LEN$SAVE+4 RESTORE CALLER'S R13
ST R0,SA$R0 RETURN R1
RETURN (14,12)
*
LEN$SAVE DS 18F
LEN$LEN DS H
LEN$MVC MVC 0(0,R4),2(R7)
LEN$MVC1 MVC 0(0,R4),4(R7)
DROP R2,R7
************
*
* READ THE DIRECTORY BLOCK WHOSE BLOCK NUMBER IS GIVEN BY LF$DBLK
* R0 = RETURNS ERROR CODE
* R2 = COVER ADDRESS
* R3 = DTF COVER
* R4 = LIBRARY BLOCK HEADER COVER
* R5 = PARAMETER PACKET ADDRESS (SET BY CALLER)
* R6 = PCA COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT
*
************
USING L$BLKHDR,R4
USING PCA,R6
L$DGET SAVE (14,12),COVER=2,SA=L$SAVE
*
LA R3,L$DTF COVER THE DTF
LA R6,L$DIRPCA COVER DIRECTORY PCA
L R4,LF$DBFR COVER THE I/O BUFFER
LA R11,L$GETERR SET ERROR ADDRESS
ST R11,DC$ERCD
L R11,LF$DBLK SET THE BLOCK # TO READ
ST R11,PC$PCAID
ST R4,PC$A1F SET I/O BFR ADDRESS
MVI PC$IOCNT,1 SET TO READ 1 BLOCK
GET L$DTF,L$DIRPCA READ THE BLOCK
XC FTEMP,FTEMP CONFIRM THAT BLOCK JUST READ IS
MVC FTEMP+1(3),LBH$NUM THE ONE WE ASKED FOR
C R11,FTEMP
BNE L$BADBLK OOPS!
XR R11,R11 GET BLOCK SIZE
IC R11,LBH$LEN
LA R11,LBH$SIZE(R11) ADD HEADER SIZE TO GET ACTUAL
STH R11,LF$DLEN SAVE IT
*
L R13,SA$BLNK RESTORE R13
XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12) RESTORE REGS & RETURN
DROP R2,R4,R6
************
*
* WRITE THE DIRECTORY BLOCK WHOSE BLOCK NUMBER IS GIVEN BY LF$DBLK
* R0 = RETURNS ERROR CODE
* R2 = COVER ADDRESS
* R3 = DTF COVER
* R4 = LIBRARY BLOCK HEADER COVER
* R5 = PARAMETER PACKET ADDRESS (SET BY CALLER)
* R6 = PCA COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT
*
************
USING L$BLKHDR,R4
USING PCA,R6
L$DPUT SAVE (14,12),COVER=2,SA=L$SAVE
*
LA R3,L$DTF COVER THE DTF
LA R6,L$DIRPCA COVER DIRECTORY PCA
L R4,LF$DBFR COVER THE I/O BUFFER
LA R11,L$GETERR SET ERROR ADDRESS
ST R11,DC$ERCD
L R11,LF$DBLK SET THE BLOCK # TO READ
ST R11,PC$PCAID
ST R4,PC$A1F SET I/O BFR ADDRESS
MVI PC$IOCNT,1 SET TO READ 1 BLOCK
PUT L$DTF,L$DIRPCA WRITE THE BLOCK
*
L R13,SA$BLNK RESTORE R13
XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12) RESTORE REGS & RETURN
DROP R2,R4,R6
************
*
* READ THE DATA (ELEMENT) BLOCK WHOSE BLOCK NUMBER IS GIVEN BY LF$EBLK
* R0 = RETURNS ERROR CODE
* R2 = COVER ADDRESS
* R3 = DTF COVER
* R4 = LIBRARY BLOCK HEADER COVER
* R5 = PARAMETER PACKET ADDRESS (SET BY CALLER)
* R6 = PCA COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY POINT
*
************
USING L$BLKHDR,R4
USING PCA,R6
L$EGET SAVE (14,12),COVER=2,SA=L$SAVE
*
LA R3,L$DTF COVER THE DTF
LA R6,L$DTAPCA COVER DATA PCA
L R4,LF$EBFR COVER THE I/O BUFFER
LA R11,L$GETERR SET ERROR ADDRESS
ST R11,DC$ERCD
L R11,LF$EBLK SET THE BLOCK # TO READ
ST R11,PC$PCAID
ST R4,PC$A1F SET I/O BFR ADDRESS
MVI PC$IOCNT,1 SET TO READ 1 BLOCK
GET L$DTF,L$DTAPCA READ THE BLOCK
XC FTEMP,FTEMP CONFIRM THAT BLOCK JUST READ IS
MVC FTEMP+1(3),LBH$NUM THE ONE WE ASKED FOR
C R11,FTEMP
BNE L$BADBLK OOPS!
XR R11,R11 GET BLOCK SIZE
IC R11,LBH$LEN
LA R11,LBH$SIZE(R11) ADD HEADER SIZE TO GET ACTUAL
STH R11,LF$ELEN SAVE IT
*
L R13,SA$BLNK RESTORE CALLER'S R13
XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12) RESTORE REGS & RETURN
DROP R2,R4,R6
************
*
* ACQUIRE THE LIBRARY I/O LOCK
*
* R11 = COVER
* R14 = RETURN ADDRESS
*
************
L$LOCK BALR R11,0
USING *,R11
L$LOOP TS L$TS TRY TO SET THE LOCK
BZ LL$OK SUCCESS
SETIME 10,WAIT,M FAIL, WAIT A BIT
B L$LOOP & TRY AGAIN
LL$OK BR R14
DROP R11
************
*
* CHECK THAT THE LIBRARY LOCK IS SET. IF LOCK IS NOT SET, SET
* THE ERROR CODE IN R0 AND RETURN TO THE ORIGINAL CALLER.
*
* R0 = RETURNS ERROR CODE
* R11 = COVER
* R14 = RETURN ADDRESS
*
************
L$CKLOCK BALR R11,0
USING *,R11
CLI L$TS,X'FF' IS FILE OPEN?
BE LCL$LOK YES, CONTINUE
LA R0,X'13' SET 'FILE NOT OPEN' ERR CODE
ST R0,SA$R0
XC SA$R1,SA$R1 CLEAR PTR TO DIR. ENTRY
RETURN (14,12) RETURN TO CALLER
*
LCL$LOK BR R14
DROP R11
************
*
* ERROR OCCURRED WHEN ATTEMPTING TO OPEN THE LIBRARY
*
************
L$OPNERR BALR R2,0
USING *,R2
LA R1,OP$ERCD GET ERROR CODE TO ERR MSG
BAL R14,L$ER2HEX
ST R0,SA$R0 RETURN R0
OPR OP$ERR,L'OP$ERR SHOW MSG TO OPERATOR
RETURN (14,12)
************
*
* ERROR OCCURRED WHEN ATTEMPTING TO READ THE LIBRARY
*
************
L$GETERR BALR R2,0
USING *,R2
LA R1,GT$ERCD GET ERROR CODE TO ERR MSG
BAL R14,L$ER2HEX
L R13,SA$BLNK RESTORE R13
ST R0,SA$R0 RETURN R0
OPR GT$ERR,L'GT$ERR SHOW MSG TO OPERATOR
RETURN (14,12)
************
*
* CONVERT THE CURRENT ERROR CODE (DC$ERCD) TO A 2 DIGIT HEX NUMBER.
* ALSO PUTS DC$ERCD INTO R0 FOR RETURN TO CALLER.
* R1 = PTR TO RESULT BUFFER
* R11 = COVER
* R14 = RETURN ADDRESS
*
************
DS 0H
L$ER2HEX BALR R11,0
USING *,R11
UNPK EH$TEMP,DC$ERCD(2) SEPARATE HEX DIGITS INTO EHTEMP
TR EH$TEMP(2),TRHEXB XLATE TO HEX
MVC 0(2,R1),EH$TEMP MOVE TO RESULT BUFFER
XR R0,R0 GET ERR CODE TO R0
IC R0,DC$ERCD
BR R14 RETURN
************
DS 0H
L$ERROR BALR R2,0
USING *,R2
OPR OOPS,L'OOPS
EOJ
*
L$BADBLK BALR R2,0
USING *,R2
OPR BADBLK,L'BADBLK
CANCEL 99
*
L$DTF DTFPF PCA1=L$DIRPCA, X
PCA2=L$DTAPCA, X
PCA3=L$BLKPCA, X
ERROR=L$ERROR, X
WAIT=YES
*
L$DIRPCA PCA BLKSIZE=256, X
IOAREA1=DUMMY, X
LACE=18
*
L$DTAPCA PCA BLKSIZE=256, X
IOAREA1=DUMMY, X
LACE=18
*
L$BLKPCA PCA BLKSIZE=256, X
IOAREA1=DUMMY, X
LACE=18
*
DUMMY EQU * DUMMY I/O AREA
L$SAVE DS 18F
L$TS DS XL1 LOCK TO MAKE LIB IO SGL THREAD
OP$ERR DC C'OPEN ERROR DM '
OP$ERCD EQU OP$ERR+13,2
GT$ERR DC C'READ ERROR DM '
GT$ERCD EQU GT$ERR+13,2
EH$TEMP DS CL3
TRHEX DC C'0123456789ABCDEF'
TRHEXB EQU TRHEX-X'F0'
OOPS DC C'OOPS!'
BADBLK DC C'WRONG BLOCK NUMBER'
FTEMP DS F
*
END
// FIN

81
U9030/Source/BemLogoff.asm Normal file
View File

@ -0,0 +1,81 @@
TITLE '/LOGOFF COMMAND FOR BOYD''S BEM SIMULATOR'
BEMLGF START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /LOGOFF COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
BRMLGF CSECT
RGEQU
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R10 = TERM TABLE
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING ZA#OMH,R6
USING TERMTBL,R10
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
* CLEAR THE PTR. TO THE LOGGED ON USER IN THE TERMINAL TABLE
*
L R1,ZA#ISTID FIND TERMINAL TABLE
L R15,LM$FTNAM
BALR R14,R15
LTR R10,R1 DID WE FIND IT?
BZ DONE NO, WTF???
XC TT$USER,TT$USER
*
* SEND USER LOGGED OFF MESSAGE
*
MVC ZA#OMSG(LOGOFOKL),LOGOFOK SET UP OMA WITH MESSAGE
LA R11,LOGOFOKL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
XC TT$USER,TT$USER CLEAR PTR TO USER TABLE
NI TT$FLAGS,X'FF'--TT$LOGON CLEAR LOGGED ON FLAG
*
DONE LM R14,R12,12(R13) RESTORE REGISTERS
BR R14 RETURN TO MONITOR
*
LOGOFOK ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'USER SUCCESSFULLY LOGGED OFF'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
LOGOFOKL EQU *-LOGOFOK
*
END
// FIN

190
U9030/Source/BemLogon.asm Normal file
View File

@ -0,0 +1,190 @@
TITLE '/LOGON COMMAND FOR BOYD''S BEM SIMULATOR'
BEMLGN START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /LOGON COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
BEMLGN CSECT
RGEQU
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R9 = USER TABLE
* R10 = TERM TABLE
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING USERTBL,R9
USING TERMTBL,R10
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
* SEE IF USER IS ALREADY LOGGED ON
*
L R1,ZA#ISTID FIND TERMINAL TABLE
L R15,LM$FTNAM
BALR R14,R15
LTR R10,R1 DID WE FIND IT?
BZ BADTRM NO, WTF???
CLC TT$USER,LM$ZERO IS THERE ALREADY A USER?
BNE LOGGEDON YES
*
* DECODE THE INPUT MESSAGE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,USERID BURN '/LOGON'
BALR R14,R15
LA R11,USERID GET USER ID
BALR R14,R15
LA R11,ACCTID GET ACCT. ID.
BALR R14,R15
LA R11,PASSWD GET PASSWORD
BALR R14,R15
*
* SEE IF WE CAN FIND THE USER IN THE USER TABLE
*
L R9,LM$UFRST POINT TO 1ST USER TABLE
LOOP CLC UT$ID,USERID CHECK USER ID
BNE NEXT NOT VALID
CLC UT$ACCT,ACCTID CHECK ACCT. ID
BNE NEXT NOT VALID
CLC UT$PWD,PASSWD CHECK PASSWORD
BE SUCCESS A MATCH!!
NEXT L R9,UT$NEXT POINT TO NEXT USER TABLE
LTR R9,R9 END OF TABLE?
BNZ LOOP NO, KEEP TRYING
*
* SEND BAD USER ID MESSAGE
*
MVC ZA#OMSG(BADUSERL),BADUSER SET UP OMA WITH MESSAGE
LA R11,BADUSERL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
* SEND LOGON SUCCESS MESSAGE
*
SUCCESS MVC ZA#OMSG(LOGONOKL),LOGONOK SET UP OMA WITH MESSAGE
LA R11,LOGONOKL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
ST R9,TT$USER SAVE PTR TO USER TBL
OI TT$FLAGS,TT$LOGON SET LOGGED ON FLAG
GETIME S SAVE LOGGED ON TIME
ST R0,TT$LGNDT
ST R1,TT$LGNTM
B DONE
*
* SEND ALREADY LOGGED ON MESSAGE
*
LOGGEDON MVC ZA#OMSG(ALRDYONL),ALRDYON SET UP OMA WITH MESSAGE
LA R11,ALRDYONL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
* SEND UNKNOWN TERMINAL MESSAGE
*
BADTRM MVC ZA#OMSG(UNKTERML),UNKTERM SET UP OMA WITH MESSAGE
LA R11,UNKTERML
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
DONE LM R14,R12,12(R13) RESTORE REGISTERS
BR R14 RETURN TO MONITOR
*
BADUSER ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'INVALID ID, ACCOUNT, PASSWORD FOR LOGON'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
BADUSERL EQU *-BADUSER
*
LOGONOK ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'USER SUCCESSFULLY LOGGED ON'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
LOGONOKL EQU *-LOGONOK
*
ALRDYON ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'TERMINAL ALREADY LOGGED ON, PROCEED'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
ALRDYONL EQU *-ALRDYON
*
UNKTERM ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'TERMINAL NOT CONFIGURED'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
UNKTERML EQU *-UNKTERM
*
WORKAREA DSECT
USERID DS CL4
ACCTID DS CL4
PASSWD DS CL4
*
END
// FIN

367
U9030/Source/BemPrint.asm Normal file
View File

@ -0,0 +1,367 @@
TITLE '/PRINT COMMAND FOR BOYD''S BEM SIMULATOR'
BEMPRT START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /PRINT COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
SUPEQU REGS=YES
SA$DSECT
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMPRT CSECT
BEMDSCTS
*
SAVE (14,12),COVER=2
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING CDA,R7
USING LIBFIL,R8
USING SA$DSECT,R13
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
LA R8,LIBPKT COVER LIB RTNS PARAM PKT
ST R13,SAVAREA+4
LA R13,SAVAREA
BAL R14,INIT INIT. LIB. PARAM PACKET
*
* PARSE COMMAND LINE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,ELENAME BURN '/PRINT'
BALR R14,R15
LA R11,ELENAME GET THE ELEMENT NAME
BALR R14,R15
LA R11,FNAME GET THE FILE NAME
BALR R14,R15
LA R11,VSN GET VOLUME ID
BALR R14,R15
LA R11,ELETYP GET ELEMENT TYPE
BALR R14,R15
*
* VALIDATE PARAMS.
*
CLI ELENAME,C' ' ELEMENT NAME BLANK?
BE NOELE YES, OOPS!
CLI FNAME,C' ' FILE NAME BLANK?
BE NOFIL YES, OOPS!
CLI ELETYP,C' ' ELEMENT TYPE BLANK?
BNE CHKTYP NO, CONTINUE
MVC ELETYP,VSN COPY VOLUME ID TO ELE TYPE
CHKTYP CLI ELETYP,C' ' ELEMENT TYPE STILL BLANK?
BE BADTYP YES, OOPS
CLI ELETYP,C'S' SOURCE ELEMENT?
BNE CHKPROC NO, CONTINUE
MVI LIBTYP,LET$SRC YES, ALL GOOD
B CHKELE
CHKPROC CLI ELETYP,C'P' PROC ELEMENT?
BNE CHKMAC NO, CONTINUE
MVI LIBTYP,LET$PROC YES, ALL GOOD
B CHKELE
CHKMAC CLI ELETYP,C'M' MACRO ELEMENT?
BNE BADTYP NO, OOPS
MVI LIBTYP,LET$PROC YES,ALL GOOD
*
* SEE IF ELEMENT/FILE IS VALID
*
CHKELE MVC LF$NAME,FNAME SET UP PARAM PKT
MVC LF$ELE,ELENAME
MVC LF$ETYP,LIBTYP
LA R1,LIBPKT POINT TO PARAMS.
L R15,LM$LOPN TRY TO OPEN FILE
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ BADFIL NO
L R15,LM$LFIND SEE IF IT EXISTS IN FILE
BALR R14,R15
LTR R0,R0 ERROR CODE = 0?
BNZ BADELE NO, OOPS!
LTR R1,R1 ELEMENT FOUND?
BZ BADELE NO, OOPS
ST R1,LF$DIRP SAVE PTR TO DIR. ENTRY
*
L R15,LM$POPEN OPEN THE PRINTER
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ BADPRT NO
*
* PRINT THE ELEMENT
*
LA R1,LIBPKT POINT TO PARAMETERS
L R15,LM$LEFST GET 1ST SOURCE LINE
BALR R14,R15
PLOOP LTR R0,R0 EOF?
BNZ PDONE YES
LA R0,SRCBFR POINT TO SOURCE BUFFER
L R15,LM$PWRIT WRITE LINE TO PRINTER
BALR R14,R15
LTR R0,R0 SUCCESS?
BNZ BADPRT NO
LA R1,LIBPKT POINT TO PARAMETERS
L R15,LM$LENXT GET NEXT SOURCE LINE
BALR R14,R15
B PLOOP
*
PDONE L R15,LM$PCLSE CLOSE THE PRINTER
BALR R14,R15
*
MVC ZA#OMSG(EOJMSGL),EOJMSG MOVE MSG TO OMA
LA R11,EOJMSGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
DONE L R15,LM$LCLS CLOSE THE LIBRARY
BALR R14,R15
L R13,SA$BLNK RESTORE R13
RETURN (14,12) RESTORE REGS & RETURN TO MON.
************
*
* INITIALIZE PARAMETER PACKET IN WORK AREA
* R14 = RETURN ADDRESS
*
************
INIT LA R11,DIRBFR SET PTR TO DIR BUFFER
ST R11,LF$DBFR
LA R11,DTABFR SET PTR TO DATA BUFFER
ST R11,LF$EBFR
LA R11,SRCBFR SET PTR TO SRC LINE BUFFER
ST R11,LF$SBFR
BR R14
************
*
* SEND FILE NAME MISSING ERROR
*
************
NOFIL MVC ZA#OMSG(FILMSNGL),FILMSNG MOVE MSG TO OMA
LA R11,FILMSNGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID FILE NAME ERROR
*
************
BADFIL MVC ZA#OMSG(INVFILL),INVFIL MOVE MSG TO OMA
LA R11,INVFILL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND ELEMENT NAME MISSING ERROR
*
************
NOELE MVC ZA#OMSG(ELEMSNGL),ELEMSNG MOVE MSG TO OMA
LA R11,ELEMSNGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID ELEMENT NAME ERROR
*
************
BADELE MVC ZA#OMSG(INVELEL),INVELE MOVE MSG TO OMA
LA R11,INVELEL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND INVALID ELEMENT TYPE ERROR
*
************
BADTYP MVC ZA#OMSG(TYPERRL),TYPERR MOVE MSG TO OMA
LA R11,TYPERRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND PRINTER ERROR
*
************
BADPRT MVC ZA#OMSG(PRTERRL),PRTERR MOVE MSG TO OMA
LA R11,PRTERRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND LIBRARY I/O ERROR
*
************
BADLIB MVC ZA#OMSG(LIBERRL),LIBERR MOVE MSG TO OMA
LA R11,LIBERRL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
FILMSNG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'FILE NAME MISSING'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
FILMSNGL EQU *-FILMSNG
************
INVFIL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'FILE NAME NOT FOUND'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
INVFILL EQU *-INVFIL
************
ELEMSNG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT NAME MISSING'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
ELEMSNGL EQU *-ELEMSNG
************
INVELE ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT NAME / TYPE NOT FOUND'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
INVELEL EQU *-INVELE
************
TYPERR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ELEMENT TYPE MUST BE SPECIFIED (S/P/M)'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
TYPERRL EQU *-TYPERR
************
PRTERR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'PRINTER ERROR'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
PRTERRL EQU *-PRTERR
************
LIBERR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'ERROR WHILE READING SOURCE ELEMENT'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
LIBERRL EQU *-LIBERR
************
EOJMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'PRINT COMPLETE'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
EOJMSGL EQU *-EOJMSG
************
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
************
WORKAREA DSECT
DTEMP DS D DOUBLE WORD ALIGNED TEMP VAR.
CTEMP DS CL8
ELENAME DS CL8 SOURCE ELEMENT NAME
FNAME DS CL8 LIBRARY FILE NAME
VSN DS CL8 VOLUME ID (NOT USED)
ELETYP DS CL8 ELEMENT TYPE (S/P)
LIBTYP DS XL1 LIBRARY FRIENDLY ELE TYPE
SAVAREA DS 18F
DS 0F
LIBPKT DS XL(LF$LNGTH) LIBRARY ROUTINES PARAM PACKET
DIRBFR DS XL256 LIBRARY DIR. PARTITION BFR
DTABFR DS XL256 LIBRARY DATA PARTITION BFR
SRCBFR DS CL256 SOURCE LINE BUFFER
************
CDA DSECT
DUMMY DS XL1
*
BEMPRT CSECT
*
END
// FIN

128
U9030/Source/BemPrinter.asm Normal file
View File

@ -0,0 +1,128 @@
TITLE 'PRINTER SUPPORT FOR BOYD''S BEM SIMULATOR'
BEMPRNTR START
***********************************************************************
* *
* PRINTER SUPPORT FOR BEM SIMULATOR *
* *
***********************************************************************
PRINT NOGEN
SUPEQU REGS=YES
SA$DSECT
BEMDSCTS
*
USING LOWMEM,R0
USING SA$DSECT,R13
ENTRY P$OPEN,P$BRKPT,P$CLOSE,P$PUT
************
*
* OPEN A NEW PRINTER FILE.
* R2 = COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY PT.
*
************
P$OPEN SAVE (14,12),COVER=2
BAL R14,P$LOCK ACQUIRE THE SINGLE THREAD LOCK
CLI POPEN,X'FF' IS IT ALREADY OPEN?
BE PO$DONE YES, WE'RE DONE
OPEN PRNTR OPEN THE PRINTER
MVI POPEN,X'FF' SHOW FILE OPEN
PO$DONE XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12) RETURN TO CALLER
************
*
* ACQUIRE THE SINGLE THREAD LOCK
*
************
P$LOCK TS PLOCK TRY TO ACQUIRE THE LOCK
BZ PL$OK WE GOT IT
SETIME 10,WAIT,M BUSY, WAIT A BIT
B P$LOCK & LOOP
PL$OK BR R14 RETURN TO CALLER
DROP R2
************
*
* BREAKPOINT THE PRINT FILE
* R2 = COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY PT.
*
************
P$BRKPT SAVE (14,12),COVER=2
CLI PLOCK,X'FF' IS PRINTER OURS?
BNE PC$SKIP NO, SKIP REQUEST
BRKPT PRNTR BREAKPOINT THE FILE
MVI PLOCK,X'00' RELEASE THE LOCK
PC$SKIP RETURN (14,12)
DROP R2
************
*
* CLOSE THE PRINTER. ONLY CALLED AT EOJ
* R2 = COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY PT.
*
************
P$CLOSE SAVE (14,12),COVER=2
CLOSE PRNTR
MVI POPEN,X'00'
MVI PLOCK,X'00'
RETURN (14,12)
DROP 2
************
*
* WRITE A LINE TO THE PRINTER FILE
* R0 = ADDRESS OF PRINT LINE BUFFER (132 CHARS). RETURNS ERROR
* CODE.
* R2 = COVER
* R14 = RETURN ADDRESS
* R15 = ENTRY PT.
*
************
P$PUT SAVE (14,12),COVER=2
CLI PLOCK,X'FF' IS PRINTER OURS?
BE PP$OK YES, CONTINUE
LA R0,X'02' SET 'INVALID MACRO SEQ' ERROR
ST R0,SA$R0
RETURN (14,12) & RETURN TO CALLER
*
PP$OK ST R13,PP$SAVE+4 SAVE SA BACK LINK
LA R13,PP$SAVE POINT TO OUR SAVE AREA
PUT PRNTR,(0) WRITE THE PRINT LINE
L R13,SA$BLNK RESTORE R13
XC SA$R0,SA$R0 CLEAR ERROR CODE
RETURN (14,12) & RETURN TO CALLER
*
PP$SAVE DS 18F
DROP R2
************
*
* ERROR HANDLER
* R2 = COVER
*
************
PRTERR BALR R2,0
USING *,R2
CLC SA$BLNK(4),LM$ZERO SA BACK LINE = ZERO?
BE PE$OK YES, CONTINUE
L R13,SA$BLNK RESTORE R13 FROM BACK LINK
PE$OK XR R0,R0 ERROR CODE TO R0
IC R0,PRNTRC
ST R0,SA$R0 RETURN ERROR CODE
RETURN (14,12) RETURN TO CALLER
DROP R2
************
PLOCK DC X'00'
POPEN DC X'00'
DS 0H
PRTBFR DS CL132
*
PRNTR DTFPR BLKSIZE=132, X
ERROR=PRTERR, X
IOAREA1=PRTBFR, X
PRAD=1, X
PRINTOV=SKIP, X
WORKA=YES
*
END
// FIN

59
U9030/Source/BemRdy.asm Normal file
View File

@ -0,0 +1,59 @@
TITLE 'SEND ''BEM READY'' MESSAGE FOR BOYD''S BEM SIMULATOR'
BEMRDY START
***********************************************************************
* *
* A SIMPLE PROGRAM TO SEND TO 'BEM READY' MESSAGE TO THE USER'S *
* TERMINAL. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
BEMRDY CSECT
RGEQU
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING ZA#OMH,R6
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
MVC ZA#OMSG(RDYL),RDY SET UP OMA WITH MESSAGE
LA R11,RDYL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
LM R14,R12,12(R13)
BR R14
*
RDY ZO#COORD 1,1 CURSOR HOME
DC XL1'27' ERASE PROTECTED DISPLAY
DC CL1'M'
ZO#COORD 1,22 LINE 22 COLUMN 1
DC XL1'1E' SOE
DC C'BOYD''S BEM SIMULATOR READY'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
RDYL EQU *-RDY
*
END
// FIN

1370
U9030/Source/BemSimulator.asm Normal file
View File

File diff suppressed because it is too large Load Diff

28
U9030/Source/BemSimulator.jcl Normal file
View File

@ -0,0 +1,28 @@
// JOB BEMSIM,,8000,8000,2
// DVC 20 // LFD PRNTR
// OPTION JOBDUMP
// DVCVOL REL042
// LBL $Y$SRC // LFD $Y$SRC
// DVCVOL REL042
// LBL $Y$MAC // LFD $Y$MAC
// DVCVOL LNS001
// LBL LNSSRC // LFD SRC
// DVCVOL LNS001
// LBL LNSMAC // LFD MAC
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// WORK1
// WORK2
// EXEC BEMSIM,LOD
/$
* NETWORK NAME
EDT
* ALLOWED TERMINALS
T001
T002
* USERS
USER GUES,0,GUES
USER SBOY,0,SBOY
/*
/&
// FIN

306
U9030/Source/BemStatus.asm Normal file
View File

@ -0,0 +1,306 @@
TITLE '/STATUS COMMAND FOR BOYD''S BEM SIMULATOR'
BEMSTA START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /STATUS COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMSTA CSECT
RGEQU
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R9 = TERMTBL
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING TERMTBL,R9
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
*
* DECODE THE INPUT MESSAGE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,STYPE BURN '/STATUS'
BALR R14,R15
LA R11,STYPE GET TYPE OF STATUS
BALR R14,R15
*
* CHECK STATUS TYPE AND BRANCH TO APPROPRIATE ROUTINE
*
CLI STYPE,C'R' RESOURCE?
BE SENDRES YES
CLI STYPE,C'T' TERMINALS?
BE SENDTERM YES
*
* SEND CURRENT USER STATUS
*
MVC ZA#OMSG(USERMSGL),USERMSG SET UP OMA WITH MSG TEMPLATE
LA R11,USERMSGL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
USING USERTBL,R10
L R1,ZA#ISTID FIND TERM TABLE FOR INPUT TERM
L R15,LM$FTNAM
BALR R14,R15
LTR R9,R1 TERM TABLE FOUND?
BZ SU1 NO, WTF?
MVC OUTERM,TT$NAME COPY TERM NAME TO OMA
L R10,TT$USER GET PTR TO LOGGED ON USER TBL
LTR R10,R10 ZERO?
BZ SU1 YES, WTF?
MVC OUUSER,UT$ID COPY USER NAME TO OMA
MVC CTEMP,TMMASK FORMAT LOGGED ON TIME
ED CTEMP,TT$LGNTM
MVC OULGNTM,CTEMP+2 COPY HH:MM TO OMA
SU1 GETIME S GET CURRENT DATE/TIME
ST R0,DTEMP FORMAT DATE
MVC CTEMP,DTMASK
ED CTEMP,DTEMP
MVC OUDATE,CTEMP+2 MOVE DATE TO OMA
ST R1,DTEMP FORMAT TIME
MVC CTEMP,TMMASK
ED CTEMP,DTEMP
MVC OUTIME,CTEMP+2
B DONE
DROP R10
*
* SEND RESOURCE STATUS
*
SENDRES EQU *
*
* COUNT # OF LOGGED ON TERMINALS
*
XR R12,R12 CLEAR TERMINAL COUNT
L R9,LM$TFRST POINT TO 1ST TERM TABLE
SRLOOP LTR R9,R9 END OF TABLE?
BZ SRCONT YES, CONTINUE
TM TT$FLAGS,TT$LOGON TERM LOGGED ON?
BZ SRNEXT NO, TRY NEXT TERM.
LA R12,1(R12) YES, BUMP TERMINAL COUNT
SRNEXT L R9,TT$NEXT GET PTR TO NEXT TERM TABLE
B SRLOOP & LOOP
*
SRCONT MVC ZA#OMSG(RESMSGL),RESMSG SET UP OMA WITH MSG TEMPLATE
LA R11,RESMSGL
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
CVD R12,DTEMP CVT # TERMS TO PACKED
ED OTERMS,DTEMP+6 UNPACK TO OMA
L R11,LM$FEND GET TTL MEMORY FOR JOB
CVD R11,DTEMP CVT TO PACKED
ED OMAXMEM,DTEMP+4 UNPACK TO OMA
S R11,LM$FSTRT CALC. FREE MEM LEFT
CVD R11,DTEMP CVT TO PACKED
ED OFREEMEM,DTEMP+4 UNPACK TO OMA
L R11,LM$FTTL GET TTOL FREE MEMORY AT BEM STRT
CVD R11,DTEMP CVT TO PACKED
ED OAVALMEM,DTEMP+4 UNPACK TO MOA
B DONE
*
* SEND TERMINALS STATUS
*
SENDTERM MVC ZA#OMSG(TERMHDRL),TERMHDR MOVE MSG HDR TO OMA
LA R12,TERMHDRL GET OFFSET TO NEXT LINE IN OMA
L R9,LM$TFRST POINT TO 1ST TERM TABLE
STLOOP LTR R9,R9 END OF TABLE?
BZ STDONE YES
CH R12,=H'1920' END OF MSG
BH STDONE YES, QUIT
TM TT$FLAGS,TT$LOGON TERMINAL LOGGED ON?
BZ STNEXT NO, TRY NEXT TERMINAL
LA R11,ZA#OMSG(R12) MOVE LINE TEMPLATE TO OMA
MVC 0(TERMLNEL,R11),TERMLNE
MVC TTERM(4,R11),TT$NAME MOVE TERMINAL NAME TO OMA
USING PGMTBL,R10
L R10,TT$LSTPG PROGRAM NAME
LTR R10,R10
BZ STNOP
MVC TCMD(7,R11),PT$CODE+1
USING USERTBL,R10
STNOP L R10,TT$USER USER NAME
LTR R10,R10
BZ STNOU
MVC TUSER(4,R11),UT$ID
STNOU LA R12,TERMLNEL(R12) BUMP OMA OFFSET
STNEXT L R9,TT$NEXT GET PTR TO NEXT TERM TBL
B STLOOP & LOOP
STDONE LA R11,ZA#OMSG(R12) MOVE TERM TRAILER TO OMA
MVC 0(TERMTLRL,R11),TERMTLR
LA R12,TERMTLRL(R12) BUMP MSG LENGTH
STH R12,ZA#OTL SAVE TTL MSG LENGTH
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
*
DONE LM R14,R12,12(R13) RESTORE REGISTERS
BR R14 RETURN TO MONITOR
*
* RESOURCE STATUS TEMPLATE
*
RESMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'TASKS TERMS ----------MEMORY----------'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C' MAX AVAIL FREE'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C' 1 '
TERMS EQU *-RESMSG
DC XL4'40202021'
DC C' '
MAXMEM EQU *-RESMSG
DC XL8'4020202020202021'
AVAILMEM EQU *-RESMSG
DC XL8'4020202020202021'
FREEMEM EQU *-RESMSG
DC XL8'4020202020202021'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
RESMSGL EQU *-RESMSG
*
* TERMINAL STATUS TEMPLATES
*
TERMHDR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'TERMINAL COMMAND SCRATCH SPACE USER'
TERMHDRL EQU *-TERMHDR
*
TERMLNE ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C' '
TTERM EQU *-TERMLNE
DC C' '
DC C' '
TCMD EQU *-TERMLNE
DC C' '
TUSER EQU *-TERMLNE
DC C' '
TERMLNEL EQU *-TERMLNE
*
TERMTLR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
TERMTLRL EQU *-TERMTLR
*
* CURRENT USER STATUS TEMPLATE
*
USERMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'TERMINAL USER LOGON DATE CUR-TIME'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C' '
UTERM EQU *-USERMSG
DC C' '
DC C' '
UUSER EQU *-USERMSG
DC C' '
DC C' '
ULGNTM EQU *-USERMSG
DC C' '
DC C' '
UDATE EQU *-USERMSG
DC C' '
DC C' '
UTIME EQU *-USERMSG
DC C' '
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
USERMSGL EQU *-USERMSG
*
TMMASK DC C' '
DC X'202120'
DC C':'
DC X'2020'
DC C':'
DC X'2020'
DTMASK DC C' '
DC X'202120'
DC C'/'
DC X'2020'
DC C'/'
DC X'2020'
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
OTERMS EQU ZA#OMSG+TERMS,4
OMAXMEM EQU ZA#OMSG+MAXMEM,8
OAVALMEM EQU ZA#OMSG+AVAILMEM,8
OFREEMEM EQU ZA#OMSG+FREEMEM,8
OUTERM EQU ZA#OMSG+UTERM,4
OUUSER EQU ZA#OMSG+UUSER,4
OULGNTM EQU ZA#OMSG+ULGNTM,5
OUDATE EQU ZA#OMSG+UDATE,8
OUTIME EQU ZA#OMSG+UTIME,8
*
WORKAREA DSECT
STYPE DS CL8
DTEMP DS D
CTEMP DS CL10
*
BEMSTA CSECT
*
END
// FIN

687
U9030/Source/BemVtoc.asm Normal file
View File

@ -0,0 +1,687 @@
TITLE '/VTOC COMMAND FOR BOYD''S BEM SIMULATOR'
BEMVTC START
***********************************************************************
* *
* AN IMPLEMENTATION OF THE /VTOC COMMAND FOR BOYD'S BEM SIMULATOR. *
* *
***********************************************************************
*
PRINT NOGEN
SUPEQU
VTOC FCB=YES, X
VOL1=YES, X
F1=YES, X
F2=YES, X
F3=YES, X
F4=YES
PUBDSECT DSECT
PUBEQU
BEMVTC CSECT
ZM#DPIB
ZM#DIMH
ZA#IMSG DS CL2048
BEMVTC CSECT
BEMDSCTS
*
STM R14,R12,12(R13)
************
* R2 = COVER
* R3 = PIB
* R4 = IMA
* R5 = WORK AREA
* R6 = OMA
* R7 = CDA
* R14 = RETURN ADDRESS
************
BALR R2,0 SET COVER
USING *,R2
USING LOWMEM,R0
USING ZA#DPIB,R3
USING ZA#IMH,R4
USING WORKAREA,R5
USING ZA#OMH,R6
USING CDA,R7
*
L R3,0(R1) COVER THE PARAMETERS
L R4,4(R1)
L R5,8(R1)
L R6,12(R1)
L R7,16(R1)
LA R11,SAVAREA SET UP NEW SAVE AREA
ST R13,4(R11)
LR R13,R11
*
CLI FSTPASS,X'00' IS THIS THE FIRST PASS?
BNE PASS2 NO
*
* FIRST PASS, DECODE THE INPUT MESSAGE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,VSN BURN '/VTOC'
BALR R14,R15
LA R11,VSN GET VOLUME ID
BALR R14,R15
CLI VSN,C' ' VOLUME ID PRESENT?
BE BADVOL NO
BAL R14,INIT INIIIALIZE THE I/O STRUCTURES
MVC LINCNT,=H'22' INIT. LINE COUNTER
B FSTF1 GO FETCH THE FIRST FMT1 RECORD
*
* COME HERE FOR ALL BUT FIRST PASS
*
PASS2 CLI FSTPASS,X'01' SHOULD WE SHOW NEXT LINE?
BE P2NEXT YES, CONTINUE
*
LH R0,ZA#ITL SET UP GETOKEN PARAMS
LA R1,ZA#IMSG
L R15,LM$GTKN
LA R11,YN GET RESPONSE TO MORE?
BALR R14,R15
CLI YN,C'N' RESPONSE = 'N'
BE EOJ YES, QUIT
MVC LINCNT,=H'22' NO, INIT LINE COUNT & CONTINUE
P2NEXT BAL R14,INIT INITIALIZE THE I/O STRUCTURES
B NXTF1 GO FETCH THE NEXT FMT1 RECORD
*
* ALL SET, LET'S READ THE VTOC.
*
FSTF1 MVC ZA#OMSG(HDRL),HDR MOVE HEADER TO OMA
LA R11,HDRL SET THE MSG LENGTH
STH R11,ZA#OTL
*
BAL R14,RDV1 READ THE VOLUME LABEL
BAL R14,RDF4 READ THE FMT4 RECORD
BAL R14,FRSTF1 READ THE NEXT FMT1 RECORD
CHKOK LTR R1,R1 FMT1 RECORD FOUND?
BZ EOJ NO, QUIT
*
USING DL$F1,R9
LA R9,VBFR COVER FMT1 RECORD
MVC F2ADDR,DL$CP1 SAVE FMT2 ADDR FOR LATER
LH R12,ZA#OTL GET CRNT OFFSET INTO OMA
LA R12,ZA#OMSG(R12)
MVC 0(FILMSGL,R12),FILMSG COPY FILE NAME TEMPLATE TO OMA
AI ZA#OTL,FILMSGL BUMP MSG LENGTH
MVC FNAME(20,R12),DL$KEY1 COPY FILE NAME TO OMA
MVC FTYPE(4,R12),TUNK COPY FILE TYPE TO OMA
CLI DL$FT1,X'20'
BNE P21
MVC FTYPE(4,R12),TSAM
P21 CLI DL$FT1,X'40'
BNE P22
MVC FTYPE(4,R12),TDA
P22 CLI DL$FT1,X'60'
BNE P23
MVC FTYPE(4,R12),TNI
P23 CLI DL$FT1,X'80'
BNE P24
MVC FTYPE(4,R12),TISAM
P24 CLI DL$FT1,X'90'
BNE P25
MVC FTYPE(4,R12),TIRAM
P25 CLI DL$FT1,X'02'
BNE P26
MVC FTYPE(4,R12),TSAT
P26 XR R11,R11 GET # EXTENTS
IC R11,DL$XC1
STH R11,NUMEXT SAVE FOR LATER
CVD R11,DTEMP CONVERT TO PACKED
MVC FEXTENTS(4,R12),XCMASK COPY # OF EXTENTS TO OMA
ED FEXTENTS(4,R12),DTEMP+6
BAL R14,CALCEXT GO CALC # CYLINDERS IN ALL EXTS
CVD R0,DTEMP CONVERT TO PACKED
MVC FCYL(4,R12),CYLMASK COPY TO OMA
ED FCYL(4,R12),DTEMP+6
*
AI LINCNT,-1 DECR. LINE COUNTER
BP P2CONT > ZERO? THEN CONTINUE
LH R11,ZA#OTL CALC OFFSET INTO OMA
LA R11,ZA#OMSG(R11)
MVC 0(MOREMSGL,R11),MOREMSG MOVE 'MORE?' TO OMA
AI ZA#OTL,MOREMSGL BUMP MSG LENGTH
MVI ZA#PSIND,ZA#PSNE SET EXTERNAL SUCCESSION
MVC ZA#PSID,=C'BEMVTC' TO OURSELVES
MVI FSTPASS,X'02' SET TO CHECK 'MORE' RESPONSE
B DONE & RETURN TO MONITOR
*
P2CONT MVI ZA#OAUX,ZA#OCO SET UP CONTINUOUS OUTPUT
MVI ZA#PSIND,ZA#PSNE SET UP EXT SUCCESSION
MVC ZA#PSID,=C'BEMVTC' TO MYSELF
MVI FSTPASS,X'01' SET TO SHOW NEXT LINE
B DONE
DROP R9
*
NXTF1 BAL R14,NEXTF1
B CHKOK
*
* EOJ. SEND BLANK LINE
*
EOJ MVC ZA#OMSG(EOJMSGL),EOJMSG MOVE MSG TO OMA
LA R11,EOJMSGL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
*
DONE L R13,4(R13) RESTORE REGISTERS
LM R14,R12,12(R13)
BR R14
************
*
* INITIALIZE THE I/O STRUCTURES
*
************
INIT STM R14,R12,12(R13)
*
* INITIALIZE THE CCB
*
USING IC$CCB,R12
LA R12,VCCB
SETBIT BC$TRAFF,VCCB SET TRAFFIC (I/O COMPLETE) FLAG
LA R11,VBCW SET BCW ADDRESS
ST R11,IC$CCW
LA R11,VFCB+14 SET PIOCB (FCB) ADDRESS
ST R11,IC$PIO
DROP R12
*
* FIND THE PUB FOR THE GIVEN VOLUME AND POPULATE THE FCB
*
LA R1,VSN POINT TO VOLUME ID
BAL R14,FNDPUB GO FIND PUB
LTR R1,R1 WAS IT FOUND?
BZ UNKVOL NO
USING DF$FCB,R12
LA R12,VFCB
MVC DF$FNM,VSN SET UP VOLUME ID
STH R1,DF$PUB SET UP ABS. PUB ADDR.
LA R11,16 SET FCB LENGTH (MINIMUM)
STH R11,DF$CBL
*
LM R14,R12,12(R13)
BR R14
************
*
* READ THE VOL1 LABEL. THIS IS ALWAYS AT CYL 0, HEAD 0, REC 3 ON THE
* DISK
*
************
USING IB$BCW,R1
RDV1 LA R1,VBCW
LA R11,VBFR SET BFR ADDRESS
ST R11,IB$DATA
MVI IB$COM,X'02' COMMAND = READ
LA R11,1 SET RECORD COUNT
STH R11,IB$COUNT
XC IB$HEAD,IB$HEAD HEAD = 0
XC IB$CYL,IB$CYL CYL = 0
OI IB$CYL,X'80' RECALIBRATE ON
MVI IB$RECRD,3 REC = 3
LA R1,VCCB
EXCP (1) START I/O
WAIT (1),RDV1E WAIT FOR IT
USING DL$VL,R1
LA R1,VBFR COVER VOL1 LBL
MVC F4ADDR,DL$VTC SAVE FMT4 RECORD ADDRESS
BR R14 RETURN
DROP R1
************
*
* READ THE FMT2 RECORD. THE LOCATION OF THIS RECORD IS FOUND IN THE
* FMT1 RECORD
*
************
USING IB$BCW,R1
RDF2 LA R1,VBCW
LA R11,VBFR SET BFR ADDRESS
ST R11,IB$DATA
MVI IB$COM,X'02' COMMAND = READ
LA R11,1 SET RECORD COUNT
STH R11,IB$COUNT
MVC IB$HEAD,F2ADDR+3 MOVE HEAD
MVC IB$CYL,F2ADDR CYL
MVC IB$RECRD,F2ADDR+4 & RECORD TO BCW
LA R1,VCCB
EXCP (1) START I/O
WAIT (1),RDF2E WAIT FOR IT
USING DL$SATF2,R1
LA R1,VBFR COVER FMT2 RECORD
MVC F3ADDR,DL$SCID2 SAVE FMT3 RECORD ADDRESS
BR R14
DROP R1
************
*
* READ THE FMT3 RECORD. THE LOCATION OF THIS RECORD IS FOUND IN THE
* FMT2 RECORD
*
************
USING IB$BCW,R1
RDF3 LA R1,VBCW
LA R11,VBFR SET BFR ADDRESS
ST R11,IB$DATA
MVI IB$COM,X'02' COMMAND = READ
LA R11,1 SET RECORD COUNT
STH R11,IB$COUNT
MVC IB$HEAD,F3ADDR+3 MOVE HEAD
MVC IB$CYL,F3ADDR CYL
MVC IB$RECRD,F3ADDR+4 & RECORD TO BCW
LA R1,VCCB
EXCP (1) START I/O
WAIT (1),RDF3E WAIT FOR IT
USING DL$F3,R1
LA R1,VBFR COVER FMT2 RECORD
MVC F3ADDR,DL$CP3 SAVE NEXT FMT3 RECORD ADDRESS
BR R14
DROP R1
************
*
* READ THE FMT4 RECORD. THE LOCATION OF THIS RECORD IS FOUND IN THE
* VOL1 RECORD
*
************
USING IB$BCW,R1
RDF4 LA R1,VBCW
LA R11,VBFR SET BFR ADDRESS
ST R11,IB$DATA
MVI IB$COM,X'02' COMMAND = READ
LA R11,1 SET RECORD COUNT
STH R11,IB$COUNT
MVC IB$HEAD,F4ADDR+3 MOVE HEAD
MVC IB$CYL,F4ADDR CYL
MVC IB$RECRD,F4ADDR+4 & RECORD TO BCW
LA R1,VCCB
EXCP (1) START I/O
WAIT (1),RDF4E WAIT FOR IT
USING DL$F4,R1
LA R1,VBFR COVER FMT4 RECORD
MVC VTSTRT(4),DL$VX4+2 SAVE VTOC START ADDRESS
MVI VTSTRT+4,1 SET STARTING RECORD # = 1
MVC VTEND(4),DL$VX4+6 SAVE VTOC END ADDRESS
MVI VTEND+4,40 SET ENDING RECORD # = 40
BR R14
DROP R1
************
*
* FIND THE FIRST FMT1 RECORD IN THE VTOC. ON EXIT, R1 = 0 IF
* NO FMT1 FOUND.
*
************
USING IB$BCW,R8
USING DL$F1,R9
FRSTF1 LA R8,VBCW
LA R9,VBFR
MVC IB$HEAD,VTSTRT+3 VTOC START HEAD
MVC IB$CYL,VTSTRT CYL
MVC IB$RECRD,VTSTRT+4 RECORD
B NF1READ GO READ THIS RECORD
DROP R8,R9
************
*
* FIND THE NEXT FMT1 RECORD IN THE VTOC. ON EXIT, R1 = 0 IF NO
* FMT1 FOUND.
*
************
USING IB$BCW,R8
USING DL$F1,R9
NEXTF1 LA R8,VBCW
LA R9,VBFR
NF1LOOP MVC IB$HEAD,VTSTRT+3 SET HEAD IN BCW
MVC IB$CYL,VTSTRT CYL
XR R11,R11 BUMP RECORD #
IC R11,VTSTRT+4
LA R11,1(R11)
STC R11,IB$RECRD
STC R11,VTSTRT+4
CH R11,=H'40' END OF TRACK?
BNH NF1READ NO
MVI IB$RECRD,1 YES, RESET RECORD # TO 1
MVI VTSTRT+4,1
IC R11,VTSTRT+3 BUMP HEAD
LA R11,1(R11)
STC R11,IB$HEAD
STC R11,VTSTRT+3
CH R11,VTEND+2 END OF CYL?
BNH NF1READ NO
MVI IB$HEAD,0 YES, RESET HEAD # TO ZERO
MVI VTSTRT+3,0
LH R11,VTSTRT BUMP CYLINDER
LA R11,1(R11)
STH R11,IB$CYL
STH R11,VTSTRT
CH R11,VTEND END OF VTOC?
BH NF1NOFND NO
NF1READ LA R11,VBFR SET BFR ADDRESS
ST R11,IB$DATA
MVI IB$COM,X'02' COMMAND = READ
LA R11,1 SET RECORD COUNT
STH R11,IB$COUNT
LA R1,VCCB
EXCP (1)
WAIT (1),NEXTF1E
CLI DL$ID1,C'1' IS IT FMT1?
BNE NF1LOOP NO, TRY AGAIN
LA R1,1 SHOW SUCCESS
BR R14 & RETURN
*
NF1NOFND XR R1,R1 SHOW NOT FOUND
BR R14 & RETURN
DROP R8,R9
************
*
* CALCULATE THE NUMBER OF CYLINDERS ASSIGNED TO THE CURRENT FILE
* ON EXIT, R0 CONTAINS TTL # CYLINDERS ASSIGNED
*
************
CALCEXT STM R14,R12,12(R13) SAVE REGISTERS
*
* CALC. FOR EXTENTS IN FMT1 RECORD WHICH IS CURRENTLY IN VBFR
*
USING DL$F1,R1
LA R1,VBFR
LA R1,DL$XT1 POINT TO 1ST OF 3 EXTENTS
DROP R1
XR R0,R0 CLEAR CYLINDER COUNT
LA R12,3 SET LOOP COUNT
CELOOP1 CLI 0(R1),0 EXTENT VALID?
BE CEBUMP1 NO
MVC ELOW(2),2(R1) GET EXTENT LOWER CYLINDER
MVC EHIGH(2),6(R1) GET EXTENT UPPER CYLINDER
LH R11,EHIGH CALC # CYLINDERS
SH R11,ELOW
LA R11,1(R11)
AR R0,R11 ADD TO TOTAL
CEBUMP1 LA R1,10(R1) BUMP EXTENT TABLE ADDRESS
BCT R12,CELOOP1
*
* CALC. FOR EXTENTS GIVEN IN FMT3 RECORD
*
LH R11,NUMEXT # EXTENTS > 3?
CH R11,=H'3'
BNH CEDONE NO, WE'RE DONE
BAL R14,RDF2 READ THE FMT2 RECORD
CENXTF3 CLC F3ADDR,LM$ZERO FMT3 ADDR = 0?
BE CEDONE YES, WE'RE DONE
BAL R14,RDF3 READ THE FMT3 RECORD
*
* DO EXTENTS 4-7
*
USING DL$F3,R1
LA R1,VBFR COVER FMT3
LA R1,DL$XT3 GET ADDR OF EXTENT 4
DROP R1
LA R12,4 INIT. LOOP COUNT
CELOOP2 CLI 0(R1),0 EXTENT VALID?
BE CEBUMP2 NO
MVC ELOW(2),2(R1) GET EXTENT LOWER CYLINDER
MVC EHIGH(2),6(R1) GET EXTENT UPPER CYLINDER
LH R11,EHIGH CALC # CYLINDERS
SH R11,ELOW
LA R11,1(R11)
AR R0,R11 ADD TO TOTAL
CEBUMP2 LA R1,10(R1) BUMP EXTENT TABLE ADDRESS
BCT R12,CELOOP2
*
* DO EXTENTS 8-16
*
LA R1,1(R1) BUMP PAST FORMAT ID
LA R12,9 INIT LOOP COUNT
CELOOP3 CLI 0(R1),0 EXTENT VALID?
BE CEBUMP3 NO
MVC ELOW(2),2(R1) GET EXTENT LOWER CYLINDER
MVC EHIGH(2),6(R1) GET EXTENT UPPER CYLINDER
LH R11,EHIGH CALC # CYLINDERS
SH R11,ELOW
LA R11,1(R11)
AR R0,R11 ADD TO TOTAL
CEBUMP3 LA R1,10(R1) BUMP EXTENT TABLE ADDRESS
BCT R12,CELOOP3
B CENXTF3 CHECK NEXT FMT3 IN CHAIN
*
CEDONE ST R0,20(R13) RETURN R0
LM R14,R12,12(R13) RESTORE REGISTERS
BR R14 & RETURN
************
*
* ERROR READING VOL1 LABEL
*
************
USING IC$CCB,R1
RDV1E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
***********
*
* ERROR READING FMT2 LABEL
*
************
USING IC$CCB,R1
RDF2E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
***********
*
* ERROR READING FMT3 LABEL
*
************
USING IC$CCB,R1
RDF3E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
***********
*
* ERROR READING FMT4 LABEL
*
************
USING IC$CCB,R1
RDF4E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
***********
*
* ERROR READING FMT1 LABEL
*
************
USING IC$CCB,R1
NEXTF1E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
************
*
* SEND VOLUME ID NOT SPECIFIED ERROR
*
************
BADVOL MVC ZA#OMSG(NOVOLL),NOVOL MOVE MSG TO OMA
LA R11,NOVOLL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* SEND UNKNOWN VOLUME ID ERROR
*
************
UNKVOL MVC ZA#OMSG(ILLVOLL),ILLVOL MOVE MSG TO OMA
LA R11,ILLVOLL SET MSG LENGTH
STH R11,ZA#OTL
MVI ZA#PSIND,ZA#PSNN SET NORMAL TERMINATION
B DONE
************
*
* FIND THE PUB FOR THE VOLUME POINTED TO BY R1. R1 WILL HAVE THE
* ABSOLUTE ADDRESS OF THE PUB ON EXIT. ZERO IF NOT FOUND.
*
************
USING SB$SIB,R10
USING JP$PRE,R8
USING IP$PUB,R9
FNDPUB LR R11,R1 SAVE R1 FOR LATER
*
* GET ABSOLUTE BASE ADDR OF BEMSIM FROM THE PREAMBLE
*
LA R8,PREBFR
LR R1,R8
GETINF PRE,(1),L'PREBFR,0 GET PREAMBLE INFO
MVC BASEADR,JP$JSB SAVE BASE ADDR OF JOB FOR LATER
*
* GET PTR TO 1ST PUB & NUMBER OF PUBS FROM THE SIB
*
LA R10,SIBBFR
LR R1,R10
GETINF SIB,(1),L'SIBBFR,0 GET SIB INFO
MVC NUMPUBS,SB$PBC+2 SAVE # OF PUBS
L R1,SB$PBA POINT TO 1ST PUB
S R1,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
*
* LOOP THROUGH THE PUB TABLE LOOKING FOR A MATCH
*
LA R9,PUBBFR COVER PUBBFR
FPLOOP MVC PUBBFR(IP$LNGTH),0(R1) COPY PUB TO MY BUFFER
CLI IP$TYP,X'20' IS IT DISK?
BNE FPNEXT NO, TRY NEXT PUB
LH R12,IP$TRL GET TRAILER ADDRESS
S R12,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
MVC IP$PUBT(IP$LENT),0(R12) COPY TRAILER TO MY BUFFER
CLC IP$VSN,0(R11) VOLUME ID A MATCH?
BNE FPNEXT NO, TRY NEXT PUB
A R1,BASEADR MAKE PUB ADDR ABSOLUTE
BR R14 RETURN
*
FPNEXT LA R1,IP$LNGTH(R1) BUMP PUB PTR
AI NUMPUBS,-1 DECR. PUB COUNT
BP FPLOOP > ZERO, THEN LOOP
*
XR R1,R1 SHOW NOT FOUND
BR R14 RETURN
DROP R8,R9,R10
************
TSAM DC CL4'SAM'
TDA DC CL4'D.A.'
TNI DC CL4'N.I.'
TISAM DC CL4'ISAM'
TIRAM DC CL4'IRAM'
TSAT DC CL4'SAT'
TUNK DC CL4'UNKN'
XCMASK DC XL4'40202120'
CYLMASK DC XL4'40202120'
************
NOVOL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'THE VOLUME ID MUST BE SPECIFIED. /VTOC VOL-ID'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
NOVOLL EQU *-NOVOL
************
ILLVOL ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'UNKNOWN VOLUME ID'
ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
ILLVOLL EQU *-ILLVOL
************
HDR ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
DC C'FILENAME CYL EXTENTS TYPE'
HDRL EQU *-HDR
************
FILMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
FNAME EQU *-FILMSG
DC C'XXXXXXXXXXXXXXXXXXXX'
FCYL EQU *-FILMSG
DC C' XXX '
FEXTENTS EQU *-FILMSG
DC C' XXX '
FTYPE EQU *-FILMSG
DC C'XXXX'
FILMSGL EQU *-FILMSG
************
EOJMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'27' ERASE PROTECTED
DC CL1'M'
DC XL1'1E' SOE
EOJMSGL EQU *-EOJMSG
************
MOREMSG ZO#COORD 1,1 CURSOR HOME
DC XL1'27' DELETE LINE
DC CL1'k'
ZO#COORD 1,23 LINE 23 COLUMN 1
DC XL1'1E' SOE
DC C'MORE (Y/N)? '
DC XL1'1E' SOE
MOREMSGL EQU *-MOREMSG
************
ZM#DOMH
ZA#OMSG DS CL2048 OUTPUT MSG BFR.
************
WORKAREA DSECT
DTEMP DS D DOUBLE WORD ALIGNED TEMP VAR.
ELOW DS H EXTENT LOWER CYL
EHIGH DS H EXTENT UPPER CYL
BASEADR DS A BASE ADDR. OF BEMSIM JOB
NUMPUBS DS H # OF PUBS
NUMEXT DS H # OF EXTENTS
CTEMP DS CL10
YN DS CL1
DS 0D
PREBFR DS XL(JP$LNGTH) JOB PREAMBLE BUFFER
DS 0D
SIBBFR DS XL(SB$LNGTH) SYS. INFO. BLOCK BUFFER
DS 0D
PUBBFR DS XL(IP$LNGTH) PUB BUFFER
PTRLBFR DS XL(IP$LENT) PUB TRAILER BFR
DS 0D
VBCW DS XL(IB$LNGTH) DISK BCW
DS 0H
VBFR DS XL256 DISK I/O BUFFER
DS 0D
VCCB DS XL(IC$LNGTH) DISK CCB
DS 0D
VFCB DS XL(256) DISK FCB
F4ADDR DS CL5 FMT4 RECORD ADDRESS (CCHHR)
F2ADDR DS CL5 FMT2 RECORD ADDRESS (CCHHR)
F3ADDR DS CL5 FMT2 RECORD ADDRESS (CCHHR)
SAVAREA DS 18F
************
CDA DSECT
FSTPASS DS XL1 FIRST PASS FLAG (0 = FIRST PASS)
DS XL1
LINCNT DS H SCREEN LINE COUNTER
VSN DS CL8 VOLUME ID
DS 0H
VTSTRT DS XL5 VTOC START ADDRESS (CCHHR)
DS 0H
VTEND DS XL5 VTOC END ADDRESS (CCHHR)
*
BEMVTC CSECT
*
END
// FIN

201
U9030/Source/DdiTst.asm Normal file
View File

@ -0,0 +1,201 @@
DDITST START
*
* An attempt to write an ICAM Direct Data Interface (DDI)
* Communications User Program (CUP).
*
PRINT GEN
SUPEQU REGS=YES,TCB=NO,PRE=YES,SIB=NO,IO=NO,TRN=NO
TQ#X ALL ICAM PACKETS
*
BALR R2,0
USING *,R2
************
*
* GET INFO FROM THE JOB PREAMBLE SO THAT CAN KNOW HOW MUCH MEMORY
* WE HAVE TO PLAY WITH.
*
************
GETINF PRE,PREWA,JP$LNGTH,0
************
*
* OPEN THE NETWORK
*
************
LA R11,NQEMSG POINT TO APPROPRIATE ERR MSG
ST R11,EMSGADR
XR R0,R0
NETREQ EDT,ERRET=NETERR OPEN THE NETWORK
LTR R0,R0 SUCCESS?
BNZ NETERR NO
OPR NQOK,L'NQOK YES, TELL OPERATOR
************
*
* GET DEVICE INFO FOR KNOWN TERMINALS
*
************
LA R11,CCEMSG POINT TO APPROPRIATE ERR MSG
ST R11,EMSGADR
CCACPY TNAMES,TNAMESL,CCAINFO,CCAINFOL
* CANCEL 1 TAKE A DUMP
************
*
* SEND 'DDITST READY' MESSAGE TO A TERIMAL. CURRENTLY, THIS SENDS
* ONE MESSAGE AND WAITS FOR THE OUTPUT COMPLETION ROUTINE TO ADJUST
* THE MCTPKT TO THE NEXT TERMINAL ID BEFORE SENDING ANOTHER. I SUSPECT
* THAT, ALTHOUGH THIS WORKS FOR THIS TEST, I WILL NEED A MCTPKT FOR
* EACH TERMINAL IF THINGS LIKE BUFFER TOGGLING ARE TO WORK PROPERLY.
* THAT WOULD ALSO ALLOW ME TO SEND MESSAGES TO MULTIPLE TERMINALS
* CONCURRENTLY AND LET ICAM SORT OUT THE DELIVERY TIMING.
*
************
USING TN#MCTDS,R1
SNRDY LA R1,MCTO COVER OUTPUT MCT PACKET
LA R11,SNEMSG POINT TO APPROPRIATE ERROR MSG
ST R11,EMSGADR
LA R11,RDYMSG POINT TO MESSAGE
ST R11,TN#MCBFA
LA R11,L'RDYMSG SET MSG LENGTH
STH R11,TN#MCBAL
MVI TN#MCCKB,TN#MCEM1++TN#MCLBW SET LAST BUFFER FLAGS
MCPCALL (1) SEND IT
OPR CALLDONE,L'CALLDONE WE SHOULD NEVER COME HERE
CANCEL 1 TAKE A DUMP
************
*
* ECHO MOST RECENTLY RECEIVED INPUT BACK TO ORIGINATING TERMINAL
*
************
USING TN#MCTDS,R1
ECHO MVI BFRI,C' ' CLEAR DICE CODE FROM INPUT
MVC BFRI+1(3),BFRI
LA R1,MCTI COVER INPUT MCT PACKET
LH R11,TN#MCCHC GET MSG LENGTH
LH R12,TN#MCTIN GET SRC TERMINAL ID
LA R1,MCTO COVER OUTPUT MCT PACKET
STH R11,TN#MCBAL SET MSG LENGTH
STH R12,TN#MCTIN SET TERMINAL ID
LA R11,BFRI SET TO SEND FROM INPUT BFR
ST R11,TN#MCBFA
MVI TN#MCCKB,TN#MCEM1++TN#MCLBW SET LAST BUFFER FLAGS
MCPCALL (1) SEND IT
OPR CALLDONE,L'CALLDONE WE SHOULD NEVER COME HERE
CANCEL 1 TAKE A DUMP
************
*
* REQUEST INPUT FROM LINE 1
*
************
USING TN#MCTDS,R1
INPUT LA R1,MCTI COVER INPUT MCT PACKET
LA R11,RCEMSG POINT TO APPROPRIATE ERROR MSG
ST R11,EMSGADR
LA R11,BFRI POINT TO BUFFER
ST R11,TN#MCBFA
LA R11,L'BFRI SET BUFFER LENGTH
STH R11,TN#MCBAL
XC TN#MCCHC,TN#MCCHC CLEAR RECV'D CHAR COUNT
LA R11,1 SET TERM. ID TO 1
STH R11,TN#MCTIN
XC TN#MCCKB,TN#MCCKB CLEAR BFR CTRL BYTE
MCPCALL (1) GET THE INPUT
OPR CALLDONE,L'CALLDONE WE SHOULD NEVER COME HERE
CANCEL 3 TAKE A DUMP
************
*
* RELEASE THE NETWORK
*
************
NETREL EDT
*
EOJ
***********
*
* NETWORK REQUEST ERROR HANDLER
* R0 = ERROR CODE
*
***********
NETERR LR R11,R0
LA R1,EMSGADR
LA R0,20
OPR (1),(0)
LR R0,R11
CANCEL (0)
***********
*
* INPUT COMPLETION ROUTINE
* R1 = PTR TO MCTPKT
*
* THIS NEEDS TO BE ABLE TO HANDLE ERRORS, RETRIES, ETC.
*
***********
USING TN#MCTDS,R1
ICMPL LR R11,R1 SAVE MCTPKT PTR
OPR IDONE,L'IDONE TELL OPR INPUT COMPLETE
LR R1,R11 RESTORE R1
B ECHO
***********
*
* OUTPUT COMPLETION ROUTINE
* R1 = PTR TO MCTPKT
*
* THIS NEEDS TO BE ABLE TO HANDLE ERRORS, RETRIES, ETC.
*
***********
USING TN#MCTDS,R1
OCMPL NOP RDYDONE
LR R11,R1 SAVE MCTPKT PTR
OPR ODONE,L'ODONE TELL OPR OUTPUT COMPLETE
LR R1,R11 RESTORE R1
LH R11,TN#MCTIN GET LAST TERIMINAL ID
LA R11,1(R11) BUMP BY 1
STH R11,TN#MCTIN UPDATE MCTPKT
CH R11,MAXTERMS > MAX. CONFIGURED TERMINALS?
BNH SNRDY NO, SEND RDY MSG TO NEXT TERM.
*
MVI OCMPL+1,X'FF' MAKE NOP A BRANCH
RDYDONE B INPUT
************
*
* CONFIGURATION VALES
*
************
MAXTERMS DC H'2'
************
EMSGADR DS A
NQOK DC C'NETREQ OK'
NQEMSG DC CL20'NETWORK ERROR'
CCEMSG DC CL20'CCACPY ERROR'
SNEMSG DC CL20'SEND ERROR'
RCEMSG DC CL20'RECEIVE ERROR'
CALLDONE DC C'BACK FROM MCPCALL'
ODONE DC C'OUTPUT COMPLETE'
IDONE DC C'INPUT COMPLETE'
RDYMSG DC C'DDITST READY'
DS 0F
* LIST OF KNOWN TERMINALS PASSED TO CCACPY TO GET DVC INFO.
TNAMES DC CL4'T001'
DC CL4'T002'
DC F'-1'
TNAMESL EQU *-TNAMES
CCAINFO DS 25F ENOUGH ROOM FOR 4 TERMINALS
CCAINFOL EQU *-CCAINFO
* MCT PACKET FOR OUTPUT
MCTO MCTPKT OCMPL,SEND, X
BUFFERA=BFRO, X
BAL=L'BFRO, X
ID=(1,1), X
ENDBUF=1
* MCT PACKET FOR INPUT
MCTI MCTPKT ICMPL,RECEIVE, X
BUFFERA=BFRI, X
BAL=L'BFRI, X
ID=(1,1), X
ENDBUF=1
* WORK AREA FOR JOB PREAMBLE
DS 0D
PREWA DS (JP$LNGTH)XL1
BFRI DS CL2048
BFRO EQU BFRI
*
END
// FIN

8
U9030/Source/DdiTst.jcl Normal file
View File

@ -0,0 +1,8 @@
// JOB DDITST
// DVC 20 // LFD PRNTR
// OPTION JOBDUMP
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// EXEC DDITST,LOD
/&
// FIN

2
U9030/Source/OS3.asm
View File

@ -962,7 +962,7 @@
1744: BCR R15,R3 RETURN
*
1746: DC X'042E' ADDRESS OF SAVE USER REGS. RTN.
* SUPERVISOR ENTRY POINT AFTER IPL. (IDLE LOOP???)
* SUPERVISOR ENTRY POINT AFTER IPL. SWITCHER!!
USING *,R15
USING JT$TCB,R14
USING SB$SIB,0

47
U9030/Source/SaveBemAsm.jcl Normal file
View File

@ -0,0 +1,47 @@
// JOB LIBS
// DVC 20 // LFD PRNTR
// DVC 50 // VOL REL042 // LBL $Y$JCS // LFD D0
// EXEC LIBS
/$
FIL D0=D0
DEL D0,S,BEMASM
ELE D0,S,BEMASM
// JOB BEMASM,,10000
// OPTION SCAN,SUB
// DVC 20 // LFD PRNTR
// DVCVOL LNS001
// LBL LNSMAC // LFD MAC
// DVCVOL LNS001
// LBL LNSOBJ // LFD OBJ
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// WORK1
// WORK2
// EXEC ASM
// PARAM LST=(NC)
// PARAM OUT=OBJ
// PARAM LIN=MAC
/$
// CR
/*
// SKIP DONE,11111111
// OPTION SUB
// WORK1
// EXEC LNKEDT
// PARAM OUT=LOD
// PARAM NOAUTO
/$
LOADM BEMSIM
INCLUDE BEMSIM,OBJ
INCLUDE BEMLIB,OBJ
INCLUDE BEMPRNTR,OBJ
INCLUDE BEMSCRCH
INCLUDE PR$IOE,$Y$OBJ
/*
//DONE NOP
/&
EOD
COP.D D0,S,BEMASM
/*
/&
// FIN

312
U9030/Source/SaveBemDsects.jcl Normal file
View File

@ -0,0 +1,312 @@
// JOB LIBS
// DVC 20 // LFD PRNTR
// DVCVOL LNS001
// LBL LNSMAC // LFD D0
// EXEC LIBS
/$
FIL D0=D0
DEL D0,P,BEMDSCTS
ELE D0,P,BEMDSCTS
PROC &P,1
BEMDSCTS NAME
************
*
* LOW MEMORY DESCRIPTION
*
************
LOWMEM DSECT
LM$TEST DS 16XL1 LOW MEMORY TEST PATTERN
LM$ZERO EQU LM$TEST WORD OF ZEROS
LM$FTTL DS F TTL FREE MEMORY AT BEM START
LM$FSTRT DS A FREE MEMORY START
LM$FEND DS A FREE MEMORY END
LM$TCNT DS H # TERMINALS
DS H UNUSED
LM$TFRST DS A FIRST TERM. TABLE
LM$TLAST DS A LAST TERM. TABLE
LM$TLSVC DS A LAST TERM. SERVICED
LM$PFRST DS A FIRST PGM. TABLE
LM$PLAST DS A LAST PGM. TBLE
LM$PMAX DS F MAX. PGM. SIZE
LM$UFRST DS A FIRST USER TABLE
LM$ULAST DS A LAST USER TABLE
LM$AFRST DS A FIRST ALIAS TABLE
LM$ALAST DS A LAST ALIAS TABLE
LM$MAIN DS A MAIN PGM COVER
LM$CLRM DS A CLRMEM ENTRY POINT
LM$CPYM DS A CPYMEM ENTRY POINT
LM$GTKN DS A GETOKEN ENTRY POINT
LM$FTNAM DS A FIND TERM. NAME ENTRY POINT
LM$IBFR DS A ICAM INPUT BUFFER
LM$OBFR DS A ICAM OUTPUT BUFFER
LM$LOPN DS A LIBRARY OPEN RTN (L$OPEN)
LM$LCLS DS A LIBRARY CLOSE RTN (L$CLOSE)
LM$LDFST DS A LIBRARY DIR 1ST RTN (L$DFIRST)
LM$LDNXT DS A LIBRARY DIR NEXT RTN (L$DNEXT)
LM$LFIND DS A LIBRARY FIND ELEMENT (L$DFIND)
LM$LMHDR DS A LIBRARY GET MODULE HDR (L$EHDR)
LM$LEFST DS A LIBRARY 1ST ELE REC (L$EFIRST)
LM$LENXT DS A LIBRARY 1ST ELE REC (L$ENEXT)
LM$POPEN DS A OPEN A PRINTER FILE (P$OPEN)
LM$PCLSE DS A CLOSE A PRINTER FILE (P$BRKPT)
LM$PWRIT DS A WRITE A PRINT LINE (P$PUT)
LM$LDEL DS A LIBRARY DELETE AN ELE (L$DELETE)
LM$SAVE DS 18F REGISTER SAVE AREA
LM$LNGTH EQU *-LOWMEM
************
*
* TERMINAL TABLE DESCRIPTION
*
************
TERMTBL DSECT
TT$NEXT DS A PTR. TO NEXT ENTRY
TT$NAME DS CL4 TERM. NAME
TT$LINE DS H LOGICAL LINE #
TT$ID DS H LOGICAL TERM. #
TT$IDF EQU TT$LINE,4 FULL WORD LINE # / TERM #
TT$TNUM DS H TERM. # (REC # IN BFR FILE)
TT$FLAGS DS XL1 FLAG BYTE
TT$WAITO EQU X'80' WAIT FOR OUTPUT COMPLETION
TT$WAITI EQU X'40' WAIT FOR INPUT
TT$WAIT EQU TT$WAITO++TT$WAITI
TT$IPEND EQU X'20' INPUT PENDING
TT$LOGON EQU X'10' TERMINAL LOGGED ON
TT$ODELV EQU X'08' OUTPUT DELV. NOTIFICATION PEND.
TT$DLVCD DS XL1 CONTINUOUS OUTPUT DELIVERY CODE
TT$NXTPG DS A PTR. TO NEXT PGM TO BE SCHEDULED
TT$USER DS A PTR. TO LOGGED ON USER TABLE
TT$LSTPG DS A PTR. TO LAST PGM EXECUTED
TT$LGNDT DS F LOGON DATE
TT$LGNTM DS F LOGON TIME
TT$CONT DS F CONTINUOUS OUTPUT CODE
TT$LNGTH EQU *-TERMTBL
************
*
* PROGRAM TABLE DEFINTION
*
************
PGMTBL DSECT
PT$NEXT DS A LINK TO NEXT PROG TBL ENTRY
PT$CODE DS CL8 COMMAND CODE
PT$MNAME DS CL8 EXECUTABLE MODULE NAME
PT$SIZE DS F LOAD MODULE SIZE
PT$FLAGS DS XL1 FLAG BYTE
PT$DISBL EQU X'80' DISABLED
PT$LOGON EQU X'40' LOGON REQUIRED
PT$NTRY DS XL3 ENTRY PT. ADDRESS
PT$NTRYA EQU PT$FLAGS,4 FULL WORD ENTRY PT. ADDRESS
PT$LNGTH EQU *-PGMTBL
************
*
* PROGRAM ALIAS TABLE DEFINITION
*
************
ALIASTBL DSECT
AT$ALIAS DS CL8 ALIAS
AT$PGM DS A PTR. TO PROGRAM TABLE
AT$LNGTH EQU *-ALIASTBL TABLE ENTRY LENGTH
************
*
* PROGRAM PHASE HEADER
*
************
PHASEHDR DSECT
DS H
PH$NUM DS XL1 PHASE NUMBER
PH$FLGS DS XL2 FLAGS
PH$LADDR DS XL4 LOAD ADDRESS
PH$PLNTH DS XL4 PHASE LENGTH
PH$NAME DS CL8 PHASE NAME
PH$DATE DS XL3 DATE
PH$TIME DS XL3 TIME
PH$MLNTH DS XL4 MODULE LENGTH
PH$ANAME DS CL8 ALIAS NAME
PH$CMNTS DS CL30 COMMENTS
************
*
* USER SECURITY TABLE
*
************
USERTBL DSECT
UT$NEXT DS A LINK TO NEXT USER TABLE ENTRY
UT$ID DS CL4 USER ID
UT$ACCT DS CL4 ACCOUNT ID
UT$PWD DS CL4 PASSWORD
UT$LNGTH EQU *-USERTBL
************
*
* SAT PARTITION (PCA) DEFINITION
*
************
PCA DSECT
PC$PCAID DS A CURRENT PCA RELATIVE ADDRESS
PC$PMBA DS A MAX PCA BLOCK ADDRESS
PC$BPT DS A BLOCKS PER TRACK
PC$PID DS CL1 PCA ID
PC$EODID DS AL3 END OF DATA ID
PC$IOCNT DS XL1 I/O COUNT
PC$A1 DS XL3 IOAREA1 ADDRESS
PC$A1F EQU PC$IOCNT,4 FULL WORK I/O AREA1 ADDRESS
PC$PBKS DS H PCA RELATIVE BLOCK SIZE
DS CL1 RESERVED
PC$PSPB DS CL1 SECTORS PER BLOCK
PC$LACE DS H INTERLACE FACTOR
PD$KLE EQU PC$LACE KEY LENGTH
PC$UOS DS H UNIT OF STORE
PC$LADJ DS A INTERLACE ADJUSTMENT FACTOR
PC$PFG1 DS CL1 PCA FLAG BYTE
* BIT 0 FORMAT WRITE
* BIT 1 INTERLACED FILE
* BIT 2 SEQUENTIAL = YES
* BIT 3 WRITE VERIFY
* BIT 4 VERIFY REQUIRED/INITIAL ALLOCATION
* BIT 5 NO EXTENSION PERMITTED
* BIT 6 INTERLACE ADJUST/KEYED DATA
* BIT 7 SIZE SPECIFIED IN TRACKS
PC$EOD DS AL3 END OF DATA ADDRESS
PS$EOFA EQU PC$PFG1,4
************
*
* LIBRARY FILE PARAMETER PACKET
*
************
LIBFIL DSECT
LF$NAME DS CL8 FILE NAME AS GIVEN ON // LFD
LF$ELE DS CL8 ELEMENT NAME
LF$ETYP DS XL1 ELEMENT TYPE
DS XL3 UNUSED
LF$DIRP DS A PTR TO ELEMENT DIR. ENTRY
LF$DBFR DS A DIRECTORY PARTITION I/O BFR
LF$EBFR DS A DATA (ELEMENT) PARTITION I/O BFR
LF$DBLK DS F BLOCK # OF CURRENT DIR. BLOCK
LF$DOFST DS H OFFSET TO CURRENT DIR. ENTRY
LF$DLEN DS H LENGTH OF CURRENT DIR. BLOCK
LF$EBLK DS F BLOCK # OF CURRENT ELE. BLOCK
LF$EOFST DS H OFFSET TO CURRENT ELE. ENTRY
LF$ELEN DS H LENGTH OF CURRENT ELE. BLOCK
LF$SBFR DS A PTR TO 256 CHAR SRC RECORD BFR.
LF$LNGTH EQU *-LIBFIL
*
************
*
* LIBRARY BLOCK HEADER DEFINITIONS
*
************
L$BLKHDR DSECT
LBH$NUM DS XL3
LBH$LEN DS XL1
LBH$CHK DS XL1
LBH$SIZE EQU *-L$BLKHDR
************
*
* LIBRARY DIRECTORY ENTRY
*
************
L$DIRENT DSECT
LDE$NAME DS CL8 MODULE NAME
LDE$TYPE DS XL1 MODULE TYPE
LDE$BLK DS XL3 DATA PARTITION BLOCK #
LDE$REC DS XL1 OFFSET WITHIN BLOCK
LDE$BKRC EQU LDE$BLK,4 BLOCK & OFFSET COMBINED
LDE$SIZE EQU *-L$DIRENT
************
*
* LIBRARY MODULE HEADER
*
************
L$MODHDR DSECT
LMH$LEN DS XL1
LMH$TYPE DS XL1
************
*
* LIBRARY SOURCE / PROC MODULE HEADER
*
************
L$SRCHDR DSECT
LSH$LEN DS XL1 RECORD LENGTH
LSH$TYPE DS XL1 RECORD TYPE (A3 OR A4)
DS XL1 UNUSED
LSH$FLGS DS XL2
DS XL9 UNUSED
LSH$NAME DS CL8 MODULE NAME
LSH$DATE DS XL3 DATE
LSH$TIME DS XL2 TIME
DS XL1 UNUSED
LSH$CMNT DS XL30 COMMENTS
LSH$SIZE EQU *-L$SRCHDR
************
*
* LIBRARY ELEMENT TYPES
*
************
LET$NULL EQU X'00'
LET$NTRY EQU X'04'
LET$CSCT EQU X'08'
LET$OBJ EQU X'80'
LET$PHSE EQU X'90'
LET$BGRP EQU X'A0'
LET$EOF EQU X'A1'
LET$PNME EQU X'A2'
LET$PROC EQU X'A3'
LET$SRC EQU X'A4'
LET$EGRP EQU X'A8'
LET$BLK EQU X'B0'
*
************
*
* SCRATCH FILE DSECTS
*
************
*
************
*
* THE BITMAP BLOCK. A 1 BIT INDICATES AN ALLOCATED BLOCK.
*
************
SF$BMAP DSECT
SF$BITS DS 2048XL1 2048 1 BYTE ENTRIES
************
*
************
*
* INDEX BLOCK. 1023 HALF WORD ENTRIES CONTAINING THE BLOCK # FOR
* A DATA BLOCK CONTAINING 24 SOURCE LINES. SO, ENTRY ZERO IS FOR
* LINES 0-23, ENTRY 1 IS FOR 24-47, ETC.
*
************
SF$IDXBK DSECT
SF$INEXT DS H BLOCK # OF NEXT BLK IN CHAIN
SF$INDEX DS 1023H BLOCK #S OF DATA BLOCKS
*
************
*
* DATA BLOCK. 24 84 BYTE ENTRIES FOR THE SOURCE LINES CONTAINED
* IN THIS BLOCK. DATA BLOCKS FOR INTEGER LINE #S WILL CONTAIN
* 24 ENTRIES. DATA BLOCKS FOR FRACTIONAL LINE #S WILL CONTAIN 10
* ENTRIES. THERE CAN BE UP TO 4 LEVELS OF OVERFLOW BLOCKS FOR EACH
* INTEGER LINE #. ONE FOR EACH DECIMAL DIGIT OF THE FRACTION.
*
************
SF$DTABK DSECT
SF$DNEXT DS H BLOCK # OF NEXT BLK IN CHAIN
SF$LINES DS 24XL84 24 SOURCE LINES / BLOCK
*
************
*
* SOURCE LINE.
*
************
SF$SRCLN DSECT
SF$DEL DS XL1 NON ZERO = DELETED
DS XL1 UNUSED
SF$OVLF DS H BLOCK # OF LINE INSERTED
* FOLLOWING THIS LINE
SF$SRC DS CL80 THE SOURCE CODE
*
&SYSECT CSECT
END
EOD
COP.D D0,P,BEMDSCTS
/*
/&
// FIN

31
U9030/Source/SaveCopin.jcl Normal file
View File

@ -0,0 +1,31 @@
// JOB LIBS
// DVC 20 // LFD PRNTR
// DVC 50 // VOL REL042 // LBL $Y$JCS // LFD D0
// EXEC LIBS
/$
FIL D0=D0
DEL D0,S,LNSCOPIN
ELE D0,S,LNSCOPIN
// JOB LNSCOPIN,,10000
// OPTION SCAN,SUB
// IF ('&F.X' NE 'X')FOK
//F JSET LNSSRC
//FOK NOP
// DVC 20 // LFD PRNTR
// DVCVOL LNS001
// LBL &F // LFD D0
// EXEC LIBS
/$
FIL D0=D0
DEL D0,S,&M
ELE D0,S,&M
// CR
EOD
COP.D D0,S,&M
/*
/&
EOD
COP.D D0,S,LNSCOPIN
/*
/&
// FIN

19
U9030/Source/SaveDalgn.jcl Normal file
View File

@ -0,0 +1,19 @@
// JOB LIBS
// DVC 20 // LFD PRNTR
// DVC 50 // VOL LNS001 // LBL LNSMAC // LFD D0
// EXEC LIBS
/$
FIL D0=D0
DEL D0,P,DALGN
ELE D0,P,DALGN
&L PROC &P,1
DALGN NAME
&L SRL &P(1),3
LA &P(1),1(&P(1))
SLL &P(1),3
END
EOD
COP.D D0,P,DALGN
/*
/&
// FIN

115
U9030/Source/SupervisorTest.asm Normal file
View File

@ -0,0 +1,115 @@
***********************************************************************
* *
* A PROGRAM TO TEST ACCESS TO RESTRICTED SUPERVISOR TABLES. AN *
* EXPERIMENT TO SEE IF I CAN FIGURE OUT HOW THE BEM /DISPLAY JOBS *
* AND /DISPLAY VOLUMES COMMANDS WORK. *
* *
***********************************************************************
*
SUPTST START
PRINT NOGEN
SUPEQU REGS=YES, X
TCB=YES, X
PRE=YES, X
SIB=YES, X
IO=NO, X
TRN=NO
PUBDSECT DSECT
PUBEQU
SUPTST CSECT
PRINT GEN
*
BALR R2,0
USING *,R2
USING SB$SIB,R3
USING JP$PRE,R4
USING JT$TCB,R5
USING IP$PUB,R6
************
*
* TRY TO SCAN THE SWITCH LIST LOOKING FOR JOBS
*
************
*
* GET JOB PREAMBLE TO GET ABSOLUTE BASE ADDRESS OF THIS PROGRAM
*
GETINF PRE,PREBFR,L'PREBFR,0
LA R4,PREBFR
*
* GET THE SYSTEM INFORMATION BLOCK (SIB)
*
GETINF SIB,SIBBFR,L'SIBBFR,0
LA R3,SIBBFR
*
* CALCULATE A POINTER TO THE FIRST NON-SUPERVISOR TCB CHAIN. THIS WILL
* END UP BEING A NEGATIVE ADDRESS WHICH, WHEN ADDED TO THE CURRENT
* RELOCATION REGISTER (JP$JSB), WILL GIVE US THE ADDRESS IN THE
* SUPERVISOR TO READ. FORTUNATELY, OS/3 DOESN'T SEEM TO SET THE
* READ PROTECTED BIT IN THE STORAGE KEY SO WE CAN GET AWAY WITH THIS.
*
LH R11,SB$SLA GET ABS ADDR OF SWITCH LIST
AH R11,=H'16' SKIP SUPERVISOR TCBS
S R11,JP$JSB SUBTRACT BASE ADDR OF PRGM
MVC BASEADR,JP$JSB SAVE BASE ADDR FOR LATER
*
SWLOOP1 L R5,0(R11) GET ADDR OF 1ST TCB IN LIST
LA R5,0(R5) CLEAR MSB
ST R5,FSTTCB SAVE IT
SWLOOP LTR R5,R5 ZERO?
BZ SWBUMP YES, TRY NEXT CHAIN
S R5,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
L R12,JT$ECB IS ECB PTR ZERO?
LA R12,0(R12)
LTR R12,R12
BNZ SWNTCB NO, NOT A PRIMARY TCB
L R4,JT$PRE GET PTR TO PREAMBLE
LA R4,0(R4) CLEAR MSB
S R4,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
MVC JOBNAME,JP$NAM
OPR JOBNAME,8
SWNTCB L R5,JT$LNK GET PRT TO NEXT TCB
LA R5,0(R5) CLEAR MSB
C R5,FSTTCB NEXT = FIRST?
BE SWBUMP YES, END OF CHAIN, TRY NEXT
B SWLOOP NO, LOOP
*
SWBUMP LA R11,4(R11) BUMP TO NEXT TCB CHAIN
TM 0(R11),X'FF' IS 1ST BYTE OF TCB ADDR X'FF'?
BO SWDONE YES, END OF LIST
B SWLOOP1
*
* DONE JOBS, DISPLAY MOUNTED VOLUMES
*
SWDONE LA R6,PUBBFR COVER PUB
XC PUBNUM,PUBNUM SET PUB # TO ZERO
LH R1,PUBNUM
VLOOP GETINF PUB,PUBBFR,L'PUBBFR,0 GET INFO FOR PUB # GIVEN IN R1
TM IP$TYP,X'20' IS IT A DISK?
BZ VNEXT NO, TRY NEXT
LH R11,IP$TRL GET ADDR OF PUB TRAILER
LTR R11,R11 ZERO?
BZ VNEXT YES, TRY NEXT
S R11,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
MVC PTRLBFR,0(R11) COPY TRAILER TO MY BUFFER
CLI IP$VSN,0 IS THERE A VOLUME MOUNTED?
BE VNEXT NO, TRY NEXT
LA R1,IP$VSN SUCCESS, SHOW IT TO THE OPERATOR
OPR (1),L'IP$VSN
VNEXT AI PUBNUM,1 BUMP PUB #
LH R1,PUBNUM
C R1,SB$PBC REACHED MAX PUBS?
BNH VLOOP NO
*
EOJ
*
JOBNAME DS CL8
BASEADR DS A
FSTTCB DS A
PREBFR DS XL(JP$LNGTH)
SIBBFR DS XL(SB$LNGTH)
PUBBFR DS XL(IP$LNGTH)
PTRLBFR DS XL(IP$LENT)
PUBNUM DS H
*
END
// FIN

8
U9030/Source/SupervisorTest.jcl Normal file
View File

@ -0,0 +1,8 @@
// JOB SUPTST,,6000,6000
// DVC 20 // LFD PRNTR
// OPTION JOBDUMP
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// EXEC SUPTST,LOD
/&
// FIN

250
U9030/Source/VtocTest.asm Normal file
View File

@ -0,0 +1,250 @@
VTEST START
*
* AN ATTEMPT TO ACCESS A DISK'S VTOC. AS WRITTEN, THIS WILL ONLY WORK
* FOR IDA DISKS.
*
PRINT NOGEN
SUPEQU
VTOC VOL1=YES, X
F1=YES, X
F4=YES
PRINT GEN
*
BALR R2,0
USING *,R2
*
* RDFCB VOLIN,RDFCBE READ THE FILE CONTROL BLOCK
*
* INSTEAD OF READING THE FCB FROM A DEVICE ASSIGNMENT IN THE JOB
* CONTROL, WE CAN JUST MANUALLY FILL IN THE FCB PORTION OF THE
* PIOCB BY SEARCHING THE SUPERVISOR'S PUB TABLE FOR THE DESIRED
* VOLUME NAME.
*
LA R1,=CL6'REL042' FIND PUB FOR VOLUME LNS001
BAL R14,FNDPUB
LTR R1,R1 SUCCESS?
BZ BADVOL NO, WTF?
STH R1,VOLIN+14 SAVE PTR. TO PUB
MVC VOLIN+8(2),=H'16' SET FCB LENGTH TO 16 (MINIMUM)
*
BAL R14,RDV1 READ THE VOL1 LABEL
* BAL R14,OBV1 OBTAIN THE VOL1 LABEL
BAL R14,RDF4 READ THE FMT4 LABEL
BAL R14,FRSTF1 FIND 1ST FMT1 RECORD IN VTOC
LTR R1,R1 FMT1 FOUND?
BZ DONE NO
LOOP OPR VBFR-1,9
BAL R14,NEXTF1 GET NEXT FMT1
LTR R1,R1 FMT1 FOUND?
BZ DONE NO
B LOOP YES, TRY AGAIN
*
DONE EOJ
************
*
* READ THE VOL1 LABEL. THIS IS ALWAYS AT CYL 0, HEAD 0, REC 3 ON THE
* DISK
*
************
USING IB$BCW,R1
RDV1 LA R1,VBCW
XC IB$HEAD,IB$HEAD HEAD = 0
XC IB$CYL,IB$CYL CYL = 0
OI IB$CYL,X'80' RECALIBRATE ON
MVI IB$RECRD,3 REC = 3
EXCP VCCB START I/O
WAIT VCCB,RDV1E WAIT FOR IT
USING DL$VL,R1
LA R1,VBFR COVER VOL1 LBL
MVC F4ADDR,DL$VTC SAVE FMT4 RECORD ADDRESS
BR R14 RETURN
DROP R1
************
*
* READ THE VOL1 LABEL USING THE OBTAIN MACRO
*
************
OBV1 MVI OBPARAMS+8,X'80' SET FUNC CODE TO 80 (READ VOL1)
OBTAIN OBPARAMS,OBV1E,1,FCBCORE
USING DL$VL,R1
LA R1,VBFR COVER VOL1 LBL
MVC F4ADDR,DL$VTC SAVE FMT4 RECORD ADDRESS
BR R14 RETURN
DROP R1
*
DS 0F
OBPARAMS DC CL8'VOLIN'
DC A(VBFR)
DC A(VOLIN)
************
*
* READ THE FMT4 LABEL. THE LOCATION OF THIS RECORD IS FOUND IN THE
* VOL1 RECORD
*
************
USING IB$BCW,R1
RDF4 LA R1,VBCW
MVC IB$HEAD,F4ADDR+3 MOVE HEAD
MVC IB$CYL,F4ADDR CYL
MVC IB$RECRD,F4ADDR+4 & RECORD TO BCW
EXCP VCCB START I/O
WAIT VCCB,RDF4E WAIT FOR IT
USING DL$F4,R1
LA R1,VBFR COVER FMT4 RECORD
MVC VTSTRT,DL$VX4+2 SAVE VTOC START/END ADDRESSES
MVC VTEND,DL$VX4+6
BR R14
DROP R1
************
*
* FIND THE FIRST FMT1 RECORD IN THE VTOC. ON EXIT, R1 = 0 IF
* NO FMT1 FOUND.
*
************
USING IB$BCW,R3
USING DL$F1,R4
FRSTF1 LA R3,VBCW
LA R4,VBFR
MVC IB$HEAD,VTSTRT+3 VTOC START HEAD
MVC IB$CYL,VTSTRT CYL
MVI IB$RECRD,1 RECORD 1
B NF1READ GO READ THIS RECORD
DROP R3
************
*
* FIND THE NEXT FMT1 RECORD IN THE VTOC. ON EXIT, R1 = 0 IF NO
* FMT1 FOUND.
*
************
USING IB$BCW,R3
USING DL$F1,R4
NEXTF1 LA R3,VBCW
LA R4,VBFR
NF1LOOP XR R11,R11 NO, BUMP RECORD #
IC R11,IB$RECRD
LA R11,1(R11)
STC R11,IB$RECRD
CH R11,=H'40' END OF TRACK?
BNH NF1READ NO
MVI IB$RECRD,1 YES, RESET RECORD # TO 1
IC R11,IB$HEAD BUMP TRACK
LA R11,1(R11)
STC R11,IB$HEAD
CH R11,VTEND+2 END OF CYL?
BNH NF1READ NO
MVI IB$HEAD,0 YES, RESET TRACK # TO ZERO
LH R11,IB$CYL BUMP CYLINDER
LA R11,1(R11)
STH R11,IB$CYL
CH R11,VTEND END OF VTOC?
BH NF1NOFND NO
NF1READ EXCP VCCB
WAIT VCCB,NEXTF1E
CLI DL$ID1,C'1' IS IT FMT1?
BNE NF1LOOP NO, TRY AGAIN
LA R1,1 SHOW SUCCESS
BR R14 & RETURN
*
NF1NOFND XR R1,R1 SHOW NOT FOUND
BR R14 & RETURN
************
*
* FIND THE PUB FOR THE VOLUME POINTED TO BY R1. R1 WILL HAVE THE
* ABSOLUTE ADDRESS OF THE PUB ON EXIT. ZERO IF NOT FOUND.
*
************
USING SB$SIB,R3
USING JP$PRE,R5
USING IP$PUB,R6
FNDPUB LR R11,R1 SAVE R1 FOR LATER
LA R5,PREBFR
GETINF PRE,PREBFR,L'PREBFR,0 GET PREAMBLE INFO
MVC BASEADR,JP$JSB SAVE BASE ADDR OF JOB FOR LATER
*
LA R3,SIBBFR
GETINF SIB,SIBBFR,L'SIBBFR,0 GET SIB INFO
MVC NUMPUBS,SB$PBC+2 SAVE # OF PUBS
L R4,SB$PBA POINT TO 1ST PUB
S R4,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
LA R6,PUBBFR
*
FPLOOP MVC PUBBFR(IP$LNGTH),0(R4) COPY PUB TO MY BUFFER
CLI IP$TYP,X'20' IS IT DISK?
BNE FPNEXT NO, TRY NEXT PUB
LH R12,IP$TRL GET TRAILER ADDRESS
S R12,BASEADR MAKE NEGATIVE OFFSET INTO SUPER
MVC IP$PUBT(IP$LENT),0(R12) COPY TRAILER TO MY BUFFER
CLC IP$VSN,0(R11) VOLUME ID A MATCH?
BNE FPNEXT NO, TRY NEXT PUB
A R4,BASEADR MAKE ADDR ABSOLUTE
LR R1,R4 RETURN PTR T O PUB
BR R14
*
FPNEXT LA R4,IP$LNGTH(R4) BUMP PUB PTR
AI NUMPUBS,-1 DECR. PUB COUNT
BP FPLOOP > ZERO, THEN LOOP
*
XR R1,R1 NOT FOUND
BR R14 RETURN
DROP R3,R5,R6
*
* RDFCB ERROR ROUTINE
*
RDFCBE N R0,=A(X'FF') ISOLATE ERROR CODE
CANCEL (0) ABORT WITH ERROR CODE IN R0
*
* ERROR READING VOL1 LABEL
*
USING IC$CCB,R1
RDV1E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
*
OBV1E CANCEL (0) ABORT WITH STATUS
*
* ERROR READING FMT4 LABEL
*
USING IC$CCB,R1
RDF4E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
*
* ERROR READING FMT 1 RECORD
*
USING IC$CCB,R1
NEXTF1E LA R1,VCCB
LH R0,IC$SF GET DEV / CHAN STATUS TO R0
CANCEL (0) ABORT WITH STATUS
*
BADVOL OPR VOLERR,L'VOLERR
CANCEL 100
*
* AN IDA BCW TO READ 1, 256 BYTE RECORD INTO VBFR
*
VBCW BCW X'02', X
VBFR, X
X'00', X
1
*
DC CL4' '
VBFR DS XL256
*
VOLIN PIOCB MAX
*
VCCB CCB VOLIN,VBCW
*
DS 0D
SIBBFR DS XL(SB$LNGTH) BUFFER TO HOLD SIB INFO
PREBFR DS XL(JP$LNGTH) BUFFER TO HOLD JOB PREAMBLE INFO
PUBBFR DS XL(IP$LNGTH+IP$LENT) BUFFER TO HOLD PUB & TRAILER
BASEADR DS A
NUMPUBS DS H
F4ADDR DS CL5 FMT4 RECORD ADDRESS (CCHHR)
DS 0H
VTSTRT DS XL4 VTOC START ADDRESS (CCHH)
VTEND DS XL4 VTOC END ADDRESS (CCHH)
*
VOLERR DC C'INVALID VOLUME ID'
*
END
// FIN

7
U9030/Source/VtocTest.jcl Normal file
View File

@ -0,0 +1,7 @@
// JOB VTOCTEST,,6000
// DVC 20 // LFD PRNTR
// DVCVOL LNS001
// LBL LNSLOD // LFD LOD
// EXEC VTEST,LOD
/&
// FIN

43
U9030/Source/icam.asc
View File

@ -3,41 +3,26 @@ IMS6 CCA TYPE=(TCI),FEATURES=(OPCOM,OUTDELV), X
PASSWORD=IMSNET01
BUFFERS 25,100,1,ARP=63
LNETBL LNE2
LNE1 LINE DEVICE=(UNISCOPE),TYPE=(19200,HALF,SYNC), X
TERMS=2,LBL=256,ID=4
TERMTB T002
T001 TERM ADDR=(21,51),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H001,M001,L001)
T002 TERM ADDR=(21,52),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H002,M002,L002)
QTABLE H002
L001 QUEUE TYPE=TERM
M001 QUEUE TYPE=TERM
H001 QUEUE TYPE=TERM
L002 QUEUE TYPE=TERM
M002 QUEUE TYPE=TERM
H002 QUEUE TYPE=TERM
LNE2 LINE DEVICE=(UNISCOPE),TYPE=(19200,HALF,SYNC), X
TERMS=2,LBL=256,ID=5
TERMTB T202
T201 TERM ADDR=(22,51),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H201,M201,L201)
T202 TERM ADDR=(22,52),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H201,M201,L201)
QTABLE H202
L201 QUEUE TYPE=TERM
M201 QUEUE TYPE=TERM
H201 QUEUE TYPE=TERM
L202 QUEUE TYPE=TERM
M202 QUEUE TYPE=TERM
H202 QUEUE TYPE=TERM
TERMS=2,LBL=256,ID=6
TERMTB T022
T021 TERM ADDR=(22,51),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H021,M021,L021)
T022 TERM ADDR=(22,52),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H022,M022,L022)
QTABLE H022
L021 QUEUE TYPE=TERM
M021 QUEUE TYPE=TERM
H021 QUEUE TYPE=TERM
L022 QUEUE TYPE=TERM
M022 QUEUE TYPE=TERM
H022 QUEUE TYPE=TERM
PRCSTB PRC1
PRC1 PRCS LOW=MAIN
TCIDTF DISCFILE MSGSIZE=1920
ENDCCA
MCP
MCPNAME=C2
CACH=(04,IMS6,01)
CACH=(05,IMS6,02)
CACH=(06,IMS6,01)
END
// FIN

38
U9030/Source/icam3.asc Normal file
View File

@ -0,0 +1,38 @@
COMMCT
EDT CCA TYPE=(DDI,2),FEATURES=(OPCOM,OUTDELV)
BUFFERS ,,,ARP=20
LNETBL LNE1
LNE1 LINE DEVICE=(UNISCOPE),TYPE=(19200,HALF,SYNC), X
TERMS=2,LBL=256,ID=4
TERMTB T002
T001 TERM ADDR=(21,51),FEATURES=(U200,1920),AUX1=(COP,73)
T002 TERM ADDR=(21,52),FEATURES=(U200,1920),AUX1=(COP,73)
ENDCCA
IMS6 CCA TYPE=(TCI),FEATURES=(OPCOM,OUTDELV), X
PASSWORD=IMSNET01
BUFFERS 25,100,1,ARP=63
LNETBL LNE2
LNE2 LINE DEVICE=(UNISCOPE),TYPE=(19200,HALF,SYNC), X
TERMS=2,LBL=256,ID=6
TERMTB T022
T021 TERM ADDR=(22,51),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H021,M021,L021)
T022 TERM ADDR=(22,52),FEATURES=(U200,1920),AUX1=(COP,73), X
QUEUES=(H022,M022,L022)
QTABLE H022
L021 QUEUE TYPE=TERM
M021 QUEUE TYPE=TERM
H021 QUEUE TYPE=TERM
L022 QUEUE TYPE=TERM
M022 QUEUE TYPE=TERM
H022 QUEUE TYPE=TERM
PRCSTB PRC1
PRC1 PRCS LOW=MAIN
TCIDTF DISCFILE MSGSIZE=1920
ENDCCA
MCP
MCPNAME=C3
CACH=(04,EDT,01)
CACH=(06,IMS6,01)
END
// FIN