File LOGIN.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

*0
	JMP I	.+1
	START
*10
LX1,	0
LX2,	0
*20
CHAR,	0
CT,	0
T1,	0
T2,	0
T3,	0
T4,	0
NUM1,	0
NUM2,	0
JOB,	0
ERROR=	JMS I	.;ERRORX
UMONX,	.-.		/GETS POINTER TO XUMON
UMON=	JMS I	.;UMONSB
RMON=	6007
PRINTC=	JMS I	.;PRINTX
PRINT6=	JMS I	.;STRING
CRLF=	JMS I	.;CRLFX
DATAXS=	JMS I	.;AXDAT
SCALE=	JMS I	.;SCALEX
	IFNZRO LOGARG&7400 <^^> /MUST BE IN FIRST BLOCK
LOGARG,	0
	1
	-LOGSIZ^400+400
	400
K7,	7
K40,	40
K77,	77
K177,	177
K200,	200
K212,	212
K215,	215
K240,	240
K260,	260
K7400,	7400
K7700,	7700
/
PAGE

START, CLA CLL RMON TAD I (57 /GET POINTER TO XUMON DCA UMONX UMON TAD (READW+0 MQL TAD (LOGARG-1 CHANIO /READ IN REST OF LOGIN SZA HLT TAD (CLOSE+0 MQL CHANIO CLA /INCASE CHANNEL 0 NOT OPEN? TAD (JOBNUM MQL SYSCALL DCA JOB DATAXS TAD UACCNT SZA /IF NON ZERO THEN ALREADY LOGGED IN JMP XLOGOUT /MUST MEAN LOGOUT XLOGIN, TAD (4021 /DUPL+^U+RUBOUT DATAXS WDCA UKBDDB+STATUS KSF /TYPE AHEAD? SKP /NO JMP .+3 PRINT6; MACCNT /PRINT ACCOUNT MESSAGE JMS GETPPN BSW DCA ACCNT /SAVE PROJECT NUMBER TAD CHAR TAD (-", /MUST BE COMMA SZA CLA JMP NUMERR JMS GETPPN TAD ACCNT DCA ACCNT L7775 TAD ACCNT SZA /[0,3] OPERATOR? JMP LOGIN1 /NO DATAXS TAD USCON SNA CLA JMP LOGIN2 /ONLY ON CONSOLE 0 JMP NOLOGIN
LOGIN1, SZL CLA / > 3? JMP NOLOGIN /YES, ERROR LOGIN2, JMS PASTST /PASSWORD TEST MQA /PROTECT WORD DATAXS DCA JOBPRV JMS LOGIO /LOGIN/LOGOUT L0003 DCA T1 /START AT JOB 3 MQL LOGINC, MQA CIA TAD ACCNT SNA CLA ISZ SAMACC /SAME ACCOUNT TAD (DATAPK MQL TAD T1 ISZ T1 BSW TAD (UACCNT SYSCALL /LOOK AT ACCOUNT NUMBER OF JOB(T1) SNA CLA /PASS JOBMAX? JMP LOGINC /NO, CHECK FOR MATCH TAD SAMACC SNA JMP LOGIN3 CLL JMS I (OCTOUT PRINT6; LMES3 LOGIN3, TAD (CLOSE+1 MQL CHANIO TAD (LOOKUP+1 MQL TAD (LOGMES-1 CHANIO JMP MESTST SAMACC, 0
UMONSB, 0000 DCA UMONAC RIF TAD (CDF 0 DCA .+1 .-. TAD UMONAC CIF 0 JMS I UMONX JMP I UMONSB UMONAC, 0 / PAGE
MESTST, SZA CLA JMP NOMES CRLF LOOP, IAC /TAD (READW+1 MQL TAD (LOGMRG-1 CHANIO SZA CLA JMP NOMES ISZ LOGMRG+1 TAD (LOGBUF-1 DCA LX1 TAD KM200 /-# OF TRIPLETS DCA CT LOOP2, TAD I LX1 JMS LOGSUB DCA T1 TAD I LX1 JMS LOGSUB CLL RTR RTR TAD T1 JMS LOGSUB KM200, 7600 /(CLA) ISZ CT JMP LOOP2 JMP LOOP LOGMRG, 0;0;-400;LOGBUF LOGSUB, 0000 MQL MQA AND K177 TAD (-32 /^Z? SNA CLA JMP NOMES /YES, DONE MQA TLS AND K7400 CLL RTR RTR JMP I LOGSUB
LOGIO, 0000 PRINT6; LMES1 TAD JOB CLL /NO LEADING ZEROES JMS OCTOUT PRINT6; LMES2 DATAXS TAD UACCNT SZA CLA TAD (LMESOUT-LMESIN PRINT6; LMESIN PRINT6; LMES2B DATAXS TAD USCON CLL JMS OCTOUT CRLF JMP I LOGIO
LOGMES, DEVICE SYS 2 TEXT /LOGMESGTXT/;*.-1 NOMES, TAD ACCNT DCA LOGMES+2 DCA LOGMRG+1 /CLEAR BASE BLOCK NUMBER ISZ LGMSFG /TWO PASS FLAG JMP I (LOGIN3 TAD ACCNT DATAXS DCA UACCNT /SET IN ACCOUNT NUMBER TAD (TOD MQL TAD (T1-1 SYSCALL /GET TIME OF DAY TAD T1 DATAXS DCA USTT1 /START TIME TAD T2 DATAXS DCA USTT2 TAD T3 DATAXS DCA USTT3 TAD T4 DATAXS DCA USTT4 DATAXS DCA URT1 /CLEAR OUT RUN TIME DATAXS DCA URT2 JMP BOOTOS /BOOTSTRAP OS8 LGMSFG, -2 / PAGE
BOOTOS, TAD (CLOSE+0 /CLOSE 0 DOUGIE MQL CHANIO SZA /CLOSE OK? HLT /NO. THIS IS IMPOSSIBLE... TAD (LOOKUP+0 MQL TAD (OSSAV-1 CHANIO SZA CLA /LOOKUP ALL RIGHT? JMP BOOS8 /NO. OS.SAV NOT FOUND MQA /GET PROTECTION WORD RAL /GET PRIV FILE BIT CLA RTR /INTO TEMP PRIV BIT IN JOBTAB JMP BOOTIT /RUN OS.SAV,PRIVILEGED IF INDICATED BOOS8, TAD JOB CLL RTR CLL RAR AND K7 TAD ("B^100+60 DCA SBKS+4 TAD JOB AND K7 TAD (60 BSW DCA SBKS+5 TAD (CLOSE+1 MQL CHANIO CLA TAD (LOOKUP+1 MQL TAD (SBKS-1 CHANIO /OPEN SCRATCH BLOCKS SZA CLA JMP EROS0 /CANNOT FIND SCRATCH BLOCKS TAD (CLOSE+0 MQL CHANIO TAD (LOOKUP+0 MQL TAD (OS8RTS-1 CHANIO SZA CLA JMP EROS1 /CANNOT FIND OS8.RTS TAD ACCNT DCA OS8DSK+2 TAD (LOOKUP+2 MQL TAD (OS8DSK-1 CHANIO SZA CLA JMP EROS2 /CANNOT FIND OS8DISK.DSK TAD I (SAMACC SNA CLA /MORE THAN ONE PERSON IN SAME ACCOUNT? JMP BOOTIT /NO, LEAVE WRITE ENABLED L0001 DATAXS WTAD PCCBP+200 DCA T1 L7776 RMON AND I T1 IAC /WRITE PROTECT CHANNEL 2 DCA I T1 UMON BOOTIT, /***** LAST DATAXS CLEARS UPRIV ***** TAD K40 /SET UP DEFAULT PRIORITY DATAXS DCA UPRV TAD (READW+0 MQL TAD (OSBOOT-1 CHANIO SZA CLA JMP EROS3 /ERROR BOOTING OS8 JMP 0
/?CANNOT FIND SCRATCH BLOCKS EROS0, PRINT6; EROSMS /"?CANNOT FIND " PRINT6; ERSCMS /"SCRATCH BLOCKS" EROSHL, CRLF /LAST DATAXS CLEARS TMP PRV TAD K40 /SET UP DEFAULT PRIORITY DATAXS DCA UPRV HLT /?CANNOT FIND OS8.RTS EROS1, PRINT6; EROSMS /"?CANNOT FIND" PRINT6; ERRTMS /"OS8.RTS" JMP EROSHL /HALT VM /?CANNOT FIND OS8DISK.DSK EROS2, PRINT6; EROSMS /"?CANNOT FIND " PRINT6; ERDSMS /"OS8DISK.DSK" JMP BOOTIT /BOOT OS/8 ANY WAY /?ERROR BOOTING OS/8 EROS3, PRINT6; EROSM2 /"?ERROR BOOTING OS/8 JMP EROSHL / PAGE
OSBOOT, 0;0;-400;0 OS8RTS, DEVICE SYS 2 TEXT /OS8@@@@RTS/;*.-1 SBKS, DEVICE SYS 3 TEXT /JOBXX@@SBK/;*.-1 OS8DSK, DEVICE SYS .-. /THIS ACCOUNT TEXT /OS8DISKDSK/;*.-1 NOLOGIN,ERROR TEXT "PROTECTION VIOLATION"
GETPPN, 0000 JMS I (NUMGET JMP I (NUMERR L7775 TAD CT SMA CLA JMP I (NUMERR /ONLY 2 DIGITS TAD NUM1 JMP I GETPPN PASTST, 0000 TAD (21 /^U+RUBOUT DATAXS WDCA UKBDDB+STATUS KSF SKP JMP .+3 PRINT6; MPASS JMS NAMGET CRLF TAD (4021 /DUPL+^U+RUBOUT DATAXS WDCA UKBDDB+STATUS TAD (LOOKUP+0 MQL TAD (LOGLST-1 CHANIO /LOOKUP UFD SNA CLA JMP I PASTST LOGERR, ERROR TEXT "ACCOUNT NOT FOUND"
XLOGOUT,CLL RAR /TEST FOR ACCOUNT #1 SNA JMP XATTACH RAL MQL DCA NAMCT TAD (-4 DCA DATAP LOGOLP, MQA RTL RAL MQL MQA RAL AND K7 TAD K260 JMS STUFF6 NAMCT LOGOPN ISZ DATAP JMP LOGOLP JMS I (LOGIO /JOB X LOGGED OUT ON CONSOLE N JMP SYLGO1 / PAGE
SYLGO1, TAD (CLOSE+0 MQL CHANIO TAD (ENTER+0 MQL TAD (LOGSTT-1 CHANIO /CREATE ACCOUNT STATUS FILE SNA JMP LGSTOK TAD (-4 SZA CLA JMP LGSTIG /ERROR, IGNORE STATUS TAD (READW+0 MQL TAD (LOGMRG-1 CHANIO /READ STATUS BLOCK SZA CLA JMP LGSTIG /ERROR, IGNORE STATUS LGSTOK, TAD (TOD MQL TAD (LSTLGO-1 SYSCALL /TIME OF LAST LOGOUT DATAXS TAD URT1 /L.O. USER RUN TIME CLL TAD I (TOTRUN /ADD TO TOTAL RUN TIME DCA I (TOTRUN RAL DATAXS TAD URT2 TAD I (TOTRUN+1 DCA I (TOTRUN+1 SZL ISZ I (TOTRUN+2 NOP DATAXS TAD USTT1 DCA I (LSTLGI DATAXS TAD USTT2 DCA I (LSTLGI+1 DATAXS TAD USTT3 DCA I (LSTLGI+2 DATAXS TAD USTT4 DCA I (LSTLGI+3 DECIMAL TAD I (LSTLGI CIA TAD I (LSTLGO CLL SPA TAD (600 MQL SZL CLL CMA DCA T1 /-1 IF BORROW MQA TAD I (TOTCON SMA TAD (-600 DCA I (TOTCON RAL /CARRY TAD T1 /-BORROW CIA /NEGATE THE WHOLE MESS TAD I (LSTLGI+1 CIA TAD I (LSTLGO+1 CLL SPA TAD (1440 MQL SZL CLL CMA DCA T1 /-1 IF BORROW MQA TAD I (TOTCON+1 SMA TAD (-1440 DCA I (TOTCON+1 RAL /CARRY TAD T1 /-BORROW CIA /NEGATE THE WHOLE MESS TAD I (LSTLGI+2 CIA TAD I (LSTLGO+2 CLL SPA TAD (365 MQL SZL CLL CMA DCA T1 /-1 IF BORROW MQA TAD I (TOTCON+2 SMA TAD (-365 OCTAL DCA I (TOTCON+2 JMP I (LGST2 / PAGE
LGST2, RAL TAD T1 SMA SZA CLA ISZ I (TOTCON+3 NOP /WOULD YOU BELEVE 4096 YEARS TAD (WRITEW+0 MQL TAD (LOGMRG-1 CHANIO CLA LGSTIG, TAD (CLOSE+0 MQL CHANIO CLA MQA IAC /INCRIMENT THE CHANNEL NUMBER AND (7 SZA /DONE ALL 10? JMP LGSTIG /NO, GO CLOSE THE NEXT ONE DATAXS DCA UACCNT SCALE; DEALP SCALE; DEACD JMP SYLGO2
NUMGET, 0 JMS NUMCOM NUMGT1, JMS KRBSUB JMS NUMTST JMP NUMGTE /TERMINATOR SZL JMP NUMERR /NONOCTAL DIGIT L7775 /3 SINGLE SHIFTS DCA T2 NUMGT2, TAD NUM1 CLL RAL /MAKE SPACE FOR THE NEW DIGIT DCA NUM1 /CONNECT THE 2 WORDS IN THE TAD NUM2 /SHIFTING PROCESS RAL DCA NUM2 ISZ T2 JMP NUMGT2 /3 TIMES TAD CHAR AND K7 TAD NUM1 DCA NUM1 ISZ CT TAD (-6 TAD CT SPA SNA CLA JMP NUMGT1 NUMERR, ERROR TEXT /BAD #/ NUMTST, 0000 TAD (-"0 /260 .LE. NUM .LT. 272 CLL TAD ("0-"9-1 SZL JMP NUMTSF /NOT A NUMBER IAC IAC /L = 1 IF 8 OR 9 ISZ NUMTST NUMTSF, CLA JMP I NUMTST
/GET A 8-CHARACTER NAME NAMGET, 0 DCA NAMCT NAMGLP, JMS KRBSUB TAD (-"U+200 SNA JMP NAMGET+1 TAD ("U-200-215 SNA CLA JMP NAMCR TAD CHAR JMS NAMGSB JMP NAMGLP NAMCR, JMS NAMGSB /FILL OUT WITH NULLS JMP NAMCR NAMGSB, 0000 JMS I (STUFF6 NAMCT /POINTER TO OFFSET PASSWD /TO PASSWORD TAD NAMCT TAD (-10 SZA CLA JMP I NAMGSB JMP I NAMGET NAMCT, 0
NUMCOM, 0 DCA CT DCA NUM1 DCA NUM2 JMS KRBSUB TAD (-240 SNA CLA JMP .-3 /IGNORE LEADING SPACES TAD CHAR ISZ NUMCOM JMP I NUMCOM NUMGTE, TAD CT SZA CLA ISZ NUMGET JMP I NUMGET KRBSUB, 0000 KRB MQL TAD K200 MQA DCA CHAR TAD CHAR JMP I KRBSUB / PAGE
XATTACH,KSF SKP JMP .+3 PRINT6; ATMES1 JMS I (GETPPN DCA ATTJOB /JOB NUMBER TO ATTACH TO L7776 TAD ATTJOB SPA SNA CLA JMP I (NUMERR TAD (DATAPK MQL TAD ATTJOB BSW TAD (UACCNT SYSCALL SZA CLA JMP I (NUMERR MQA SNA JMP I (NUMERR /NOT LOGGED IN DCA ACCNT /ACCOUNT NUMBER OF JOB TO ATTACH TO JMS I (PASTST /GET AND TEST PASSWORD TAD (CLOSE+0 MQL CHANIO /CLOSE UFD TAD ATTJOB BSW CLL RAR /* 40 TAD (USCON+JOBTAB-40 DCA T1 /POINTER TO USCON OF JOB TO ATTACH TO TAD JOB BSW CLL RAR /* 40 TAD (USCON+JOBTAB-40 DCA T2 /POINTER TO OUR CONSOLE NUMBER RMON TAD I T1 TAD I (34 /CONSOLE+IOTTAB DCA T3 L7777 /TEST FOR +1 (DETATTACHED) TAD I T3 SZA CLA /SKIP IF DETACHED JMP ATTERR IOF /**** TAD I T1 /CON CLL RAL /*2 TAD I (33 /+DDBTAB DCA T3 TAD I T2 CLL RAL TAD I (33 DCA T4 /T3,T4 POINT TO DDB POINTERS TAD I T1 MQL TAD I T2 DCA I T1 /SWITCH CONSOLE NUMBERS MQA DCA I T2 TAD I T3 MQL TAD I T4 DCA I T3 /SWITCH KBDDDB POINTERS MQA DCA I T4 ISZ T3 ISZ T4 TAD I T3 MQL TAD I T4 DCA I T3 /SWITCH TTYDDB POINTERS MQA DCA I T4 ION UMON JMP I (SYLOGO
ATMES1, TEXT "JOB? " ATTJOB, 0 ATTERR, UMON ERROR TEXT "JOB IN USE" LOGLST, DEVICE SYS 1 /MFD IS 0,1 ACCNT, .-. /SUPPLIED BY USER PASSWD, ZBLOCK 4 LOGSTT, DEVICE SYS 0003 /OPERATOR ACCOUNT LOGOPN=.+3 TEXT /ACCTIMXXXX/;*.-1 25 /?PROT? 0000 /?DATE? -1;-1 /SIZE / PAGE
PRINTX, 0000 TLS CLA JMP I PRINTX CRLFX, 0000 TAD K215 PRINTC TAD K212 PRINTC JMP I CRLFX ERRORX, 0000 CLA CLL TAD ERRORX PRINT6; 0 /0+AC= @ERRORX CRLF SYLOGO, DATAXS DCA UACCNT SYLGO2, KCLEAR TAD (SCARG SETSTAT TAD (LOGOUT MQL SYSCALL HLT JMP .-1 /WE SHOULDN'T CONTINUE? STRING, 0000 TAD I STRING DCA T4 ISZ STRING XER1, TAD I T4 BSW JMS CHTP TAD I T4 JMS CHTP ISZ T4 JMP XER1 /UNPACK A 6-BIT CHAR+PRINT IT CHTP, 0 AND K77 SNA JMP I STRING TAD K40 AND K77 TAD K40 PRINTC JMP I CHTP
SCALEX, 0000 TAD (XSCALE MQL L7777 TAD I SCALEX ISZ SCALEX SYSCALL CLA /IGNORE ERRORS JMP I SCALEX STUFF6, 0000 AND K77 DCA STUFFC /SAVE CHAR TAD I STUFF6 /FETCH POINTER TO OFFSET ISZ STUFF6 DCA STUFFP TAD I STUFFP /FETCH OFFSET ISZ I STUFFP NOP /DON'T FILL MORE THAN 2K!!!!! CLL RAR TAD I STUFF6 /ADD BASE ISZ STUFF6 DCA STUFFP /POINTER TO WORD TAD I STUFFP SNL BSW AND K7700 /SAVE HALF TAD STUFFC SNL BSW DCA I STUFFP JMP I STUFF6
/OCTAL TYPEOUT OF A 4-DIGIT OCTAL # IN AC OCTOUT, 0 DCA T1 RAL /IF L=0, SUPRESS LEADING ZEROES DCA LEZRO /IF L=1, PRINT LEADING ZEROES TAD K240 PRINTC TAD LEZRO MQL TAD T1 CLL RTL RTL JMS LEZRO TAD T1 BSW JMS LEZRO TAD T1 RAR RTR JMS LEZRO TAD T1 JMS DGTP JMP I OCTOUT LEZRO, 0000 AND K7 SZA JMP LEZRON MQA SZA CLA LEZRON, JMS DGTP JMP I LEZRO /TYPE ONE DIGIT DGTP, 0 AND K7 TAD K260 PRINTC JMP I DGTP STUFFC, 0 STUFFP, 0 / PAGE
/.SBTTL ACCESS USER DATA /CALL: DATAXS / INSTR. /IF INSTRUCTION IS OF THE FORMAT 1XX YYY ZZZ ZZZ /Z IS A WORD IN THE USERS DATA SPACE THAT POINTS /TO AN EIGHT WORD BLOCK AND Y IS THE OFFSET INTO /THAT DATA BLOCK OF THE WORD TO PREFORM THE X FUNCTION WAND= 4000 WTAD= 5000 WISZ= 6000 WDCA= 7000 JOBTAB= 200 AXDAT, 0 DCA DATACX RAL DCA DATLNK /PRESERVE LINK TAD I AXDAT DCA AXDATT TAD AXDATT AND (77 DCA DATAP TAD JOB BSW CLL RAR TAD DATAP TAD (JOBTAB-40 DCA DATAP RMON TAD AXDATT SMA JMP AXDATP BSW AND (7 TAD I DATAP DCA DATAP TAD AXDATT AXDATP, AND (3000 TAD (AND I DATAP DCA INSTR TAD DATLNK CLL RAR TAD DATACX INSTR, HLT SKP ISZ AXDAT ISZ AXDAT DCA DATACX TAD DATACX UMON JMP I AXDAT DATLNK, 0
DATAP, 0 DATACX, 0 DATAXX, 0 AXDATT, 0 LMES1, TEXT "JOB " LMES2, TEXT " LOGGED " LMESIN, TEXT "IN" LMESOUT,TEXT "OUT" LMES2B, TEXT " ON CONSOLE " LMES3, TEXT " OTHER JOB(S) USING SAME ACCOUNT" DEALP, "D;"E;"A;"S;" ;"L;"P;215 DEACD, "D;"E;"A;"S;" ;"C;"D;215 MACCNT, TEXT "ACCOUNT? " MPASS, TEXT "PASSWORD? " SCARG, DSCALE+DUPL+ENCTLU+ENCTLV+ENRUBO 200 / PAGE
LOGBUF, /400 WORDS DECIMAL TOTCON, -600 -1440 -365 0 OCTAL TOTRUN, ZBLOCK 3 LSTLGI, ZBLOCK 4 LSTLGO, ZBLOCK 4 EROSMS, TEXT "?CANNOT FIND " ERSCMS, TEXT "SCRATCH BLOCKS" ERRTMS, TEXT "OS8.RTS" ERDSMS, TEXT "OS8DISK.DSK" OSSAV, DEVICE SYS 0 /DEFAULT TO USER'S ACCOUNT TEXT /OS@@@@@SAV/;*.-1 EROSM2, TEXT "?ERROR BOOTING OS/8" RELOC LOGSIZ=.+377-LOGINN%400 *.+377&7400 /TO BLOCK BOUNDRY /NOW FOR THE DATA OF FREEBLOCKS FILE FREFIL, FREE0B /LOW ORDER FREE BLOCK POINTER 0 /HIGH ORDER FREE BLOCK POINTER PATCH3, .-. /LOW ORDER SIZE 0 /HIGH ORDER SIZE FREE1B /LOW ORDER FREE BLOCK FRE1BH /HIGH ORDER FREE BLOCK POINTER FREE1S /LOW ORDER SIZE 0 /HIGH ORDER SIZE ZBLOCK 400-.+FREFIL END=. $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search