File RAST.

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


/RASTIM MICRO PROGRAM /START OF USERS PROGRAM AREA ADDRESSES STAFZ1=2 STARZ1=0000 /USER 1=20000 STAFZ2=3 STARZ2=0000 /USER 2=30000 / / EXTENDED SYMBOLS - JANUARY 1977 / /FOR USE WITH RASBOL-8 MICRO PROGRAM SYMBOLIC TAPE / /MQ MICROINSTRUCTIONS MLD=7421 MQA=7501 CAM=7621 SWP=7521 ALD=7701 /POWER FAIL DETECTION AND RESTART TYPE KP8-E SPL=6102 /MEMORY EXTENSION AND TIME SHARE TYPE KM8-E GTF=6004 RTF=6005 CDI=6203 /PDP8-E GROUP 1 OPERATE MICROINSTRUCTION BSW=7002 / /RASTIME INSTRUCTION SET / CLEAR=0001 NEGATE=0002 REMAIN=0003 EXIT=0004 // LINCAC=0005 / WRITE=0006 / WRITSQ=0007 / WRITAB=0010 / RBSW=0011 / PRINTO=0012 / FILZRO=0013 / FILSPC=0014 / PRNTCH=0015 EXECX3=0016 / LINC2AC=0017 / OUTONE=0020 / OUTTWO=0021 / OUTBOTH=0022 / SYSDATE=0023 WAIT=0024 SLEEP=0025 DATE=0026 READAB=0027 GOACC=0030 GOSACC=0031 USERNUM=0032 FRETYPE=0033 / TYPIN=0100 / TYPCH=0100 / PRINTN=0140 PRINTD=0160 PRINT=0200 SIGN1=0310 SIGN2=0320 SHIFTR=0340 / MULTX1=0400 / MULTX2=0500 / STORX1=0610 / STORX2=0620 / STORX3=0630 / STORLC=0640 / CLEARLC=0650 / STORL2=0660 / CLRLC2=0670 LOAD=1030 LOAD2=1020 LOAD1=1010 LOADIM=1000 ADD=1130 ADD2=1120 ADD1=1110 ADDIM=1100 SUBT=1230 SUBT2=1220 SUBT1=1210 SUBTIM=1200 ADDTO=1330 ADDTO2=1320 ADDTO1=1310 / MULT=1430 / MULT2=1420 MULT1=1410 / MULTIM=1400 / DIVID=1530 / DIVID2=1520 / DIVID1=1510 / DIVIM=1500 STORE=1630 STORE2=1620 STORE1=1610 INCREM=1700 CLEARW=1710 DECREM=1720 / ANDIM=2000 / ORIM=2100 / SEARCH=2110 / HSEARCH=2120 / GETREC=2200 / PUTREC=2300 GOTO=3001 GOZERO=3011 GOPOS=3021 GONEG=3031 GONZRO=3041 GOSUB=3101 GSZERO=3111 GSPOS=3121 GSNEG=3131 GSNZRO=3141 GOPAL=3200 LOADX1=3310 LOADX2=3320 LOADX3=3330 LOADLC=3340 LOADL2=3360 / YESNO=3501 / ABORT=3511 / POWER=3521 / PRINTC=3600 / READ=3700 / READSQ=3710 / TYPTEX=4000 / TYPWDS=4100 / PRINTU=4200 / PRINTX=4300 / PRINTW=4400 GOIF=4511 INCGOZ=4601 DECGOZ=4701 GOIFZO=5001 GOWDZO=GOIFZO MOVIM=5100 ADDWIM=5101 CLRWDS=5200 MOVE1=5300 MOVE2=5400 MOVE3=5500 GOIFEQ=5601 MOVE=6200 COMPAR=6300 / CONV6W=6400 / CONVW6=6500 GOWDEQ=6601 / PICTUR=7000 FILL=7100 RANGE=7301 CHANNEL=7511 DOVAR=7601 DO=7701 /CONSTANTS OPENLOCK=0 OPEN=1 CLOSEQ=2 CLOSE=3 CHAIN=4 OVERLAY=5 SAVE=6 OS8ENTER=7 OS8CLOSE=10 /8 GETAIW=11 /9 PUTAIW=12 /10 XAREA=7200 TAB=0211 BELL=0207 FF=0214 VT=0213 SPACE=0240 CRET=215 LF=212
/RASBOL-8 MICRO PROGRAM / /WRITTEN BY: NOEL K. GODDARD / AND: ROYCE A. SMITH / /DATE: JANUARY 1973 /AND AMMENDED TO RASTIM JAN.1978 /FOR: RASMITH INDUSTRIAL SYSTEMS / ALIAS, SYSTEMS-EIGHT / 30 BURRANEER AVENUE / ST IVES N.S.W. 2075 / /THIS PROGRAM IS DESIGNED TO OPERATE IN AN /EMULATIVE MODE TO EXECUTE THE SET OF "MACRO /INSTRUCTIONS" WHICH FORM A RASBOL-8 PROGRAM / /EACH MACRO INSTRUCTION CONSISTS OF ONE TO FOUR (OR /MORE) WORDS OF CORE STORAGE. THESE ARE SEQUENTIALLY /FETCHED AND EXECUTED BY THE MICRO PROGRAM / / / /DEFINE ASSEMBLY SWITCHES / DECWRIT=0 HWTABS=1 /PAGE ZERO LOCATIONS FIELD 0 *0 JMP I .+1 PFRSEN *6 PFAIL, 0 /POWER FAIL, TIMESHARE ROUTINE JMP PFAIL2 /AUTO INCREMENT REGISTERS *10 IR1, 0 IR2, 0 IR5, 0 *17 NOOFUSERS, 0 / / / / 32 WORDS OF SWAPPED USER WORK AREA *20 STATUS, 0 STATU2, 0 /TWO WDS GOT BUT NOT PUT BACK WTMASK, 0 /WAIT MASK INPUT, CR'S , CHARS. WTMSK2, 0 / " ^C,^S, OUTPUT SPACE COUNT X1, 0 X2, 0 X3, 0 /MACRO INDEX REGISTERS LINKNT, 0 /LINE COUNT PRINTER 1 LINKN2, 0 /" " TWO MFLAG, 0 /MULTIPLY LAST FLAG / NARG, 0 /FIELD OF NEXT INSTR. OR ARG. NARGW, 0 /ADDR. OF NEXT INSTR. OR ARG. FILCHA, 0 /FILL CHARACTER FOR INPUT USDATE, 0 /USERS DATE WORD F1, 0 /FLD OF ARG1 ARG1, 0 /ARGUMENT 1 F2, 0 /FLD OF ARG2 ARG2, 0 COUNT, 0 /ARG 3 OR COUNTER ZZPFL, 0;0 /POWER FAIL GOSUB ZZABOR, 0;0 /^C ABORT GOTO CROUT, 0 /CUURENT ROUTINE BEING EXECUTED ZOBTN, 0 /WHERE TO GET A CHAR. ZPRNT, 0 /WHERE TO PUT A CHAR. ZPRNT2, 0 / DITTO 2ND. PRINTER ZWPRNT, 0 /WHICH PRINTER IS ON INST, 0 /INSTRUCTION BEING EMULATED ACH, 0 ACM, 0 ACL, 0 /MAIN ACCUMULATOR /** ** END OF 32 WORD AREA / / MQH, 0 /MUST FOLLOW ACL. MQM, 0 MQLO, 0 /REMAINDER, OVERFLOW ACCUMULATOR / / / OPCODE, 0 /PSEUDO OPCODE BITS 0-5 INSTRH, 0 /BITS 6-11 / GENERAL WORK AREAS ACCH, 0 ACCM, 0 ACCL, 0 SRH, 0 SRM, 0 SRL, 0 SR1H, 0 SR1M, 0 SR1L, 0 ERS0, 0 ERS1, 0 ERS2, 0 SFLAG, 0 SFLAG1, 0 /DISK WORK AREAS CTDEV, 0 /DEVICE CTBLK, 0 /BLOCK NO. DRTSL1, 0 DRTSL2, 0 DRTSL3, 0 DRTSL4, 0 REQKEY, 0;0;0 /KEY /MAIN ROUTINE ENTRY ADDRESS TVMOER,MOBERR /OBJECT ERROR TVBLKO,BLOKOP /DISK BLOCK READ,WRITE TVRAXT,RAEXIT /RESTORE ACCU. NEXT INSTR. TVSTOR,STORER TVLODR,LODER TVCLAM,CLAM TVSWAM,SWAM TVADDS,ADDS TVTMPY,TMPY TVCOMP,COMP TVTDIV,TDIV TVCBCH,CBCH TVCIAC, CIAC /COMPL,INCR,STORE IN COUNT TVPRNT,PRNT TVCMPA,CMPA TVPDPR,PDPR TVOBTN,OBTN TVPRCH,PRNCH TVABC,ABC TVFAIL,PFAIL TRACEP, TRACER TRACE=JMS I TRACEP / /REVERSE COUNT RCOUNT, 0 TAD COUNT SNA IAC /ZERO NOT ALLOWED JMS I TVCIAC JMP I RCOUNT /SET INPUT MASK, RETURN ADDRESS RCROUT, 0 DCA WTMASK TAD RCROUT JMP STARTC NEXT, JMP NNEXT K7,7 K77,77 VTINC,RTINC TINC=JMS I VTINC VTIN,RTIN TIN=JMS I VTIN VDINC,RDINC DINC=JMS I VDINC VDIN,RDIN DIN=JMS I VDIN / /****** INITIALISING ONCE ONLY CODE, / OVERLAYED BY FIRST USERS INFO AREA *STATUS CAF /CLEAR ALL FLAGS TLS /INIT MAIN KEYBOARD TLSZ2 CDF 0 CIF 10 JMS I IN7700 /LOCK OS.8 USR IN CORE 10 CDI 0 CLA CLL TAD ININOP DCA I NISTT JMP I ININX /GET FIRST USERS INFO IN7700, 7700 ININOP, NOP NISTT, INISTT ININX, NXINI / / / /IN THIS MULTI-PROGRAMMING VERSION OF RASBOL-8 THE FOLLOWING /CONDITIONS ARE ESTABLISHED. THE TWO /PAGES FROM 07200 UPWARDS ARE RESERVED FOR THE DATA BLOCK.
/THE THREE PAGES 06400 TO 07177, ARE SET /ASIDE FOR ANY COMBINATION OF ONE AND TWO PAGE DEVICE HANDLERS / / XAREA=7200 /TWO PAGES FOR DATA BLOCK / / /RASBOL-8 MICRO PROGRAM - TAPE 2 / /THE FIRST SECTION OF THE MICRO IS SIMPLY INITIALISATION / FIELD 0 *200 /** ** ** ** ** ** 7000 /NORMAL START IS NOP CLA CLL INISTT, JMP STATUS /INITIALISING..NOP GOES HERE MBIENT, / /THE NEXT SECTION OF THE MICRO SEPARATES THE VARIOUS /PARTS OF THE FIRST 12 BITS OF THE MACRO INSTRUCTION / NNEXT, CLA CLL START, CAM /CLEAR HARDWARE AC-MQ DCA MFLAG /CLEAR MULTIPLY FLAG MLSTRT, TINC ;NARG /GET NEXT INSTR. DCA INST DCA COUNT /CLR. STARTC, DCA CROUT /SET OR CLEAR INTERUPTED ADDRESS JMS I TVFAIL JMP EXNEXT /CHECK IF WAITING START2, TAD CROUT SZA CLA JMP I CROUT/RESUME ROUTINE TAD INST /DISSECT INSTR. AND K7 DCA F1 TAD INST RTR RAR AND K7 DCA F2 TAD INST BSW AND K77 DCA OPCODE TAD INST AND K77 DCA INSTRH / SAVE ACC. TAD ACH DCA ACCH TAD ACM DCA ACCM TAD ACL DCA ACCL /** OSR /TRACEING /** SNA CLA /** JMP TEST /** TAD NARGW /** TRACE /** CLA /** TAD INST /** JMS PROCT JMP TEST TRANS, TAD (JMP I TABLE /NO...FETCH TABLE START ADDRESS TAD OPCODE /ADD OPCODE DCA .+1 /SET EXIT INSTRUCTION 0 /TO EXECUTION ROUTINE / / /EXECUTION ROUTINES ENTRY ADDRESSES VECTOR / TABLE, NCNR TYPICR PRINTR SIGNR MLTX1R MLTX2R STORXR START LOADR ADDR SUBTR ADDTOR MDENTR MDENTR STORR IDCWR ANDIMR ORIMR GETR PUTR START START START START GOTOR1 GOTOR1 GOPALR LOADXR START YESNOR PRNTCR DREADR TYPTR TYPWR PRUR PRNTXR PRNTWR GIFELR INCGZR DECGZR GOIFZR MOVIMR CLRWDR MOV1R MOV2R MOV3R GOIFQR START START START MOVETR CMPARE CNV6WR CNVW6R GOWDQR START IMPRUR FILLR START RANGER START CHANLR DOVARR DOLOPR / /BASIC INFO OF CURRENT USER USRPFL, 0 /NON ZERO IF POWER FAILED SINCE LAST USED USRAREA,STATZ1 /ADDRESS OF 32 WORD SWAPPING AREA OF THIS USER / AS ABOVE, ONE PER USER USRINFO, 0 STATZ1 0 STATZ2 /NUMBER OF USERS IN THIS SYSTEM/******** NUMUSR, 2 /********* USRNUM, 2 /CURRENT USER NUMBER / / /THIS SECTION OF THE MICRO TRANSLATES THE OPCODE, WHICH /DETERMINES HOW MANY WORDS THE MACRO INSTRUCTION /OCCUPIES, AND FETCHES THEM TO THE MICRO WORK AREAS / PAGE /** ** ** ** ** **/400 TEST, TAD OPCODE TAD (-10 SPA CLA /<10 JMP TRANS /YES,NO ARGS TAD X1 TINC ;NARG /GET FIRST ARG DCA ARG1 DCA X1 /CLR TAD OPCODE TAD (-40 SPA CLA JMP TRANS TAD X2 TINC ;NARG /GET SECOND ARG DCA ARG2 DCA X2 TAD OPCODE TAD (-60 SPA CLA JMP TRANS /ONLY 2 ARGS TAD X3 TINC ;NARG /COUNT DCA COUNT DCA X3 JMP TRANS
/ /COMPL,INCR,AC, PUT IN COUNT CIAC, 0 CIA DCA COUNT JMP I CIAC / SWAM, 0 CAM /CLEAR WORK LOCATIONS / / /SET UP ROUTINE TO SWAP AC - MQ REGISTERS TAD ACH DCA COUNT TAD MQH DCA ACH TAD COUNT DCA MQH TAD ACM DCA COUNT TAD MQM DCA ACM TAD COUNT DCA MQM TAD ACL DCA COUNT TAD MQLO DCA ACL TAD COUNT DCA MQLO JMP I SWAM / /GO VIA ACC. GOVACR, JMS GOACCR JMP GOTOR /GOSUB VIA ACC. GOSACR, JMS GOACCR JMP GOSUBR GOACCR, 0 TAD ACL DCA ARG1 TAD ACM AND K7 DCA F1 JMP I GOACCR / / /THIS ROUTINE INCREMENTS, DECREMENTS /OR CLEARS A SPECIFIED WORD IN CORE / IDCWR, CLA CLL CMA /-1 TAD F2 CIA SNA JMP .+3 TIN ;F1 DIN ;F1 JMP NEXT /
/GOZERO,GOPOS,GONEG,GONZRO GOSIGN, TAD F2 TAD (-2 SPA /2,3 JMP IDGOIC SPA SNA CLA /3 JMP GOPOSR /GOPOS,2 TAD ACH SPA CLA JMP GOTOR /GONEG CLA CLL CMA RTL /-3 TAD F2 SPA CLA SNA /4 JMP NEXT JMP GOPOSR /THIS ROUTINE PERFORMS A BRANCH /IN THE MACRO PROGRAM GOTOR1, TAD F2 SZA CLA JMP GOSIGN /GOZERO,GOPOS,GONEG,GONZRO GOTOR, CLA TAD OPCODE TAD (-31 /GOSUB? SNA CLA /NO JMP GOSUBR GOTOR2, CLA CLL TAD F1 /FETCH FIELD DCA NARG /SET IT TAD ARG1 /FETCH ADDRESS DCA NARGW /SET IT JMP NEXT / / /THIS ROUTINE PERFORMS A SUBROUTINE /JUMP IN THE MACRO PROGRAM / GOSUBR, TAD NARG /FETCH CURRENT FIELD TAD (GOTO&7770 /ADD "GOTO" INSTRUCTION DINC ;F1 /PUT AT ADDR. TAD NARGW DINC ;F1 /PUT AT ADDR.+1 JMP GOTOR2 /TO BRANCH / / PAGE /** ** ** ** ** **/ 600 /THIS ROUTINE BRANCHES TO A "PAL" SUBROUTINE /EMBEDDED IN A RASBOL-8 PROGRAM / GOPALR, TAD F1 /FETCH F1 RAL CLL RTL TAD (CIF /ADD CIF INSTRUCTION DCA GP2 /SET CIF INSTRUCTION TAD ACL /LOAD ACCU GP2, 0 /CHANGE INSTRUCTION FIELD JMS I ARG1 /JUMP TO SUBROUTINE DCA ACL /CONTROL RETURNS HERE JMP NEXT /EXIT / / /THIS ROUTINE PERFORMS A BRANCH IN THE MACRO PROGRAM /IF THE MACRO ACCUMULATOR IS = OR < ZERO / GIFELR, TAD ACH /FETCH HIGH ORDER AC SPA CLA /WAS AC < 0? JMP GLTR /YES...GO TO "<" ADDRESS IDGOIC, CLA CLL /CLEAR AC AND LINK TAD ACH /FETCH HIGH ORDER AC SZA CLA JMP I TVRAXT
TAD ACM /ADD MED ORDER AC TAD ACL /ADD LOW ORDER AC SNA CLA /12 BIT AC = 0? SZL /YES...LINK = 0? JMP I TVRAXT /NO...NORMAL EXIT JMP GOTOR /TO BRANCH ROUTINE GLTR, TAD F2 /FETCH FIELD DCA F1 /SET IT TAD ARG2 /FETCH ADDRESS DCA ARG1 /SET IT JMP GOTOR / / /THIS ROUTINE INCREMENTS A SPECIFIED /LOCATION AND THEN PERFORMS A BRANCH IN /THE MACRO PROGRAM IF THE LOCATION IS ZERO INCGZR, CLA CLL IAC /=1 JMP GF2 DECGZR, CLA CLL CMA /=-1 GF2, TIN ;F2 DIN ;F2 GOIFZR, GOIF1, TIN ;F2 GOIF2, SNA CLA JMP GOTOR JMP NEXT / / /SUBROUTINE TO COMPLEMENT A 36 BIT REGISTER / COMP, 0 CLA CLL IAC /SET AC = 1 TAD I COMP /ADD HIGH ORDER ADDRESS DCA ERS1 /GIVES MED ORDER ADDRESS CLA CLL IAC /SET AC = 1 TAD ERS1 /ADD MED ORDER ADDRESS DCA ERS0 /GIVES LOW ORDER ADDRESS TAD I ERS0 /LOW ORDER WORD TO AC CIA /MAKE NEGATIVE DCA I ERS0 /RESTORE TO LOW ORDER WORD GLK /FETCH OVERFLOW BIT DCA ERS0 /SAVE OVERFLOW BIT TAD I ERS1 /MED ORDER WORD TO AC CMA /COMPLEMENT IT TAD ERS0 /ADD OVERFLOW BIT DCA I ERS1 /RESTORE TO MED ORDER WORD GLK /FETCH OVERFLOW BIT DCA ERS0 /SAVE OVERFLOW BIT TAD I COMP /FETCH HIGH ORDER ADDRESS DCA ERS1 /AND STORE IT TAD I ERS1 /HIGH ORDER WORD TO AC CMA /COMPLEMENT IT TAD ERS0 /ADD OVERFLOW BIT DCA I ERS1 /RESTORE TO HIGH ORDER WORD ISZ COMP /INDEX OVER ARGUMENT JMP I COMP /RETURN / /
/ / /SUBROUTINE TO ADD THE 36 BIT ACCUMULATOR TO EITHER /THE 36 BIT SR REGISTER OR THE 36 BIT SR1 REGISTER /DEPENDING ON THE VALUE TO WHICH A SOFTWARE FLAG IS SET / ADDS, 0 CLA CLL TAD SFLAG /FETCH FLAG SZA CLA /WAS IT ZERO? JMP SETSR1 /NO...SET FOR SR1 /SET TO ADD SR TO AC TAD ACL TAD SRL DCA ACL GLK TAD ACM TAD SRM DCA ACM GLK TAD SRH JMP ADDS2 SETSR1, TAD ACL TAD SR1L DCA ACL GLK TAD ACM TAD SR1M DCA ACM GLK TAD SR1H ADDS2, TAD ACH DCA ACH JMP I ADDS / / / / /THIS ROUTINE IS USED TO PERFORM THE LOAD AND /ADD FUNCTIONS, OPERATING ON THE 36 BIT AC / LOADR, JMS I TVCLAM /CLEAR AC - MQ REGISTERS ADDR, JMS I TVLODR JMS I TVADDS /ADD SR TO AC JMP NEXT /EXIT / / /THIS ROUTINE PERFORMS SUBTRACTION / SUBTR, JMS I TVLODR JMS I TVCOMP /COMPLEMENT SR SRH JMP ADDR+1 /FINISH AS FOR ADD /GOIFEQ INSTR. GO IF ACC. = ARG2 GOIFQR, CLA CLL TAD ACH TAD ACM SNA SZL CLA JMP NEXT TAD ACL CIA TAD ARG2 JMP GOIF2 / /GOWDEQ, GO IF WD. = LIT.(COUNT) GOWDQR, TAD COUNT CIA JMP GOIF1 / /
PAGE /** ** ** ** ** ** /1000 MLTX, 0 DCA ARG2 TAD INSTRH SNA TAD ACL JMS I TVCIAC TAD ARG2 ISZ COUNT JMP .-2 JMP I MLTX /THIS ROUTINE MULTIPLIES MACRO INDEX /REGISTER 1 BY A SPECIFIED CONSTANT / MLTX1R, TAD X1 JMS MLTX DCA X1 JMP NEXT /EXIT / / /THIS ROUTINE MULTIPLIES MACRO INDEX /REGISTER 2 BY A SPECIFIED CONSTANT / MLTX2R, TAD X2 JMS MLTX DCA X2
JMP NEXT /EXIT / / / /SUBROUTINE TO UPDATE A "PUSH DOWN POINTER" / PDPR, 0 TAD I PDPR /FETCH ARGUMENT DCA PDSP /STORE IT CLA CLL CMA /SET -1 TAD I PDSP /ADD COUNTER DCA I PDSP /STORE NEW COUNTER VALUE ISZ PDPR /INDEX FOR RETURN CLA CLL JMP I PDPR /RETURN / /CONSTANTS...POINTER UPDATE ROUTINE / PDSP, 0 / / TOACL, DCA ACL DCA ACH DCA ACM JMP NEXT / /AND IMMIDEATE ,OR IMMEDIATE INSTRUCTION ANDIMR, TAD ACL AND ARG1 ANDIM2, DCA ACL JMP NEXT ORIMR, TAD F2 SZA CLA JMP SEAR /SEARCH? CAM /ORIM TAD ACL MQL /PUT IN HW MQ TAD ARG1 MQA /OR JMP ANDIM2 /PRINT OCTAL ROUTINE PRNTOR, TAD ACL JMS PROCT JMP NEXT /MOVE IMMEDEATE MOVIMR, TAD F1 SZA CLA JMP ADWIMR CLA IAC /1 MOVR2, DCA COUNT JMP FILLR2 /ADDWIM ADD WORD IMMEDIATE ADWIMR, TAD ARG1 TIN ;F2 DIN ;F2 JMP NEXT /RASBOL BYTE SWAP RBSWR, TAD ACL BSW JMP ANDIM2 /CLEAR WORDS CLRWDR, TAD ARG1 DCA COUNT DCA ARG1 /0 JMP FILLR2 /MOVE ONE,TWO,THREE WORDS MOV3R, IAC MOV2R, IAC MOV1R, IAC MOVTR, DCA COUNT JMP MOVETR /EXECX3, EXECUTE CONTENTS OF X3 AS AN INSTRUCTION EXEC3R, TAD X3 DCA INST DCA X3 JMP START2 GOPOSR, CLA CLL TAD ACH SPA GPS2, JMP NEXT /NEGATIVE TAD ACM TAD ACL SZA JMP GOTOR SZL JMP GOTOR JMP GPS2 /ZERO / LINACR, TAD LINKNT JMP TOACL LINAC2, TAD LINKN2 JMP TOACL / /WHICH PRINTER OUTBOR, IAC OUTTOR, IAC OUTONR, IAC DCA ZWPRNT JMP NEXT / / /SUBROUTINE TO CLEAR BOTH THE 36 BIT ACCUMULATOR /AND THE 36 BIT MULTIPLIER QUOTIENT TO ZERO / CLAM, 0 CLA CLL DCA ACH /ZERO 36 BIT AC DCA ACM DCA ACL DCA MQH /ZERO 36 BIT MQ DCA MQM DCA MQLO JMP I CLAM /RETURN /USERS NUMBER TO ACL USERR, TAD USRNUM JMP TOACL / /SYSDATE GET SYSTEM DATE WORD SYDATE, CDF 10 TAD I (7666 CDF 0 JMP TOACL / /USERS DATE TO ACC. DATER, TAD USDATE JMP TOACL PAGE /** ** ** ** ** **/ 1200 / /PRINT NUMERIC,DECIMAL PRNTNR, TAD INSTRH AND (17 SNA TAD (12 /DEFAULT 10 DCA ARG2 DCA F2 DCA F1 TAD INSTRH AND (20 SZA CLA JMP PRNTDR TAD (MASK0 DCA ARG1 JMP PRUR PRNTDR, TAD (MASK2 JMP .-3 MASK0, TEXT ' -' MASK2, TEXT ' 0.0 -' /THIS ROUTINE LOADS THE MACRO INDEX REGISTERS / LOADXR, TIN ;F1 JMP STORX / / /THIS ROUTINE LOADS THE CONTENTS OF THE LOW ORDER /WORD OF THE MACRO ACCUMULATOR INTO A MACRO INDEX /REGISTER INDICATED BY THE VALUE OF THE F2 BITS / STORXR, TAD ACL STORX, DCA COUNT TAD F2 /FETCH F2 CLL RAL / BY 2 TAD (JMP .+2 DCA .+2 TAD COUNT 0 DCA X1 JMP NEXT DCA X2 JMP NEXT DCA X3 JMP NEXT DCA LINKNT JMP NEXT /STORE ACC IN LINCON CLA CLL JMP .-3 /CLEAR LINCON DCA LINKN2 JMP NEXT CLA CLL JMP .-3 / / / /SUBROUTINE TO PERFORM AN ARITHMETIC /COMPARISON BETWEEN TWO CHARACTERS / /THE ROUTINE SUBTRACTS THE SECOND CHARACTER /FROM THE FIRST AND LEAVES THE RESULT IN THE /ACCUMULATOR TO BE TESTED BY THE MAIN PROGRAM / CMPA, 0 CLA CLL TAD I CMPA /FETCH CHARACTER ADDRESS DCA CATS /STORE IT ISZ CMPA /INDEX FOR SECOND CHARACTER TAD I CMPA /FETCH SECOND CHARACTER CIA /NEGATE TAD I CATS /ADD FIRST CHARACTER
ISZ CMPA /INDEX FOR RETURN JMP I CMPA /RETURN / /CONSTANTS...COMPARISON ROUTINE / CATS, 0 /THIS ROUTINE CONVERTS A 1 OR 2 WORD NUMBER TO /A 3 WORD SIGNED NUMBER DEPENDING ON THE VALUE /OF THE LEFTMOST BIT OF THE UNSIGNED NUMBER / SIGNR, TAD F2 /FETCH F2 CIA /NEGATE TAD (2 /ADD 2 SPA /WAS F2 > 2? JMP RRTRR /SHIFT INSTR. SNA CLA /NO...WAS F2 = 1? JMP SGN2R /NO...PROCESS 24 BIT NUMBER SGN2, TAD ACL SPA CLA CLA CLL CMA /YES...SET -VE WORD DCA ACM /SET MED ORDER AC SGN2R, TAD ACM SPA CLA CLA CLL CMA /YES...SET -VE WORD DCA ACH /SET HIGH ORDER AC JMP NEXT /EXIT / /THIS ROUTINE PERFORMS ONE OF THE SINGLE WORD FUNCTIONS /DEPENDING ON THE VALUE OF THE RIGHT HAND /SIX BITS OF THE RASBOL MACRO INSTRUCTION / LIST2, START /NOP...CODE 00 EREXIT /CLEAR...CODE 01 NGATER /NEGATE...CODE 02 SWAPR2 /REMAIN...CODE 03 EXITR /EXIT...CODE 04 LINACR /LINE COUNT TO ACC. WRITR /WRITE RANDOM...CODE 06 WRITQR /WRITE SEQUENTIAL...CODE 07 ABSRWR /WRITE ABSOLUTE...CODE 10 RBSWR /RBSW 11 PRNTOR /OCTAL PRINT 12 FILLZO /FILZRO 13 FILLBL /FILSPC 14 RPRNCH /PRNTCH 15 EXEC3R /EXECX3, EXEC. X3 AS INSTR. LINAC2 /LINC2AC, LINE CNT TWO TO ACC. OUTONR /PRINTER ONE OUTTOR /" TWO OUTBOR / BOTH PRINTERS ,22 SYDATE /SYSDATE /23 WAITS /WAIT SLEEPR /SLEEP DATER /USER DATE ABSRWR /READAB GOVACR /GOACC GOSACR /GOSACC 31 USERR /USER NUMBER FRETYR /FREE TYPE, LF=-1 NCNR, TAD INSTRH /FETCH RIGHT HAND 6 BITS TAD (LIST2-NCNR /SUBTRACT LAST SMA SZA CLA /WAS CODE > LAST? JMP I TVMOER /YES...TO OBJECT ERROR TAD INSTRH /NO...FETCH R.H. 6 BITS TAD (JMP I LIST2 /ADD "JMP" INSTRUCTION DCA .+1 /SET INSTRUCTION 0 /BRANCH TO ROUTINE / PAGE /** ** ** ** ** ** **/1400 / /GET AND PUT RECORD GETR, TAD ARG1 DCA ARG2 TAD ACL AND (377 TAD (XAREA DCA ARG1 GETR2, TAD ACM SNA TAD (400 /256 WD.MOVE JMP MOVTR PUTR, TAD ACL AND (377 TAD (XAREA DCA ARG2 JMP GETR2 / /THIS ROUTINE COMPLEMENTS THE 36 BIT ACCUMULATOR / NGATER, JMS I TVCOMP /COMPLEMENT 36 BIT AC ACH JMP NEXT /EXIT / /THIS ROUTINE SWAPS THE 36 BIT AC WITH THE 36 BIT MQ / SWAPR, SWAPR2, JMS I TVSWAM /TO SWAP ROUTINE JMP NEXT /EXIT / /ABORT BY CONTR.C. ADDRESS ABORTN, CLA CLL DCA WTMASK /CLEAR INPUT WAITS TAD STATU2 RAL CLL RAR /REMOVE ^C CDF 10 DCA I ERS0 /SET UP BY EXNEXT CDF 0 TAD ZZABOR+1 SNA JMP EXITR IAC /IS IT -1 SNA CLA JMP EXNEX2 /IGNORE ^C TAD ZZABOR+1 DCA ARG1 TAD ZZABOR DCA F1 JMP GOTOR /SET UP ABORT ADDRESS ABORTI, TAD F1 DCA ZZABOR TAD ARG1 DCA ZZABOR+1 JMP NEXT / /SHIFT RIGHT INSTR. RRTRR, CLA CLL TAD INSTRH AND (17 JMS I TVCIAC RRT2, TAD ACM CLL RAR DCA ACM TAD ACL RAR DCA ACL ISZ COUNT JMP RRT2 JMP NEXT / /RASBOL-8 MICRO PROGRAM - / / /DO LOOP INSTR.(5 WORD INSTR) DOLOPR, TINC ;NARG /GET LIMIT DOL2, CIA TIN ;F2 /=COUNT? SNA CLA JMP I TVRAXT /YES EXIT TIN ;F2 TAD COUNT DIN ;F2 JMP GOTOR /DO VARIABLE DOVARR, TINC ;NARG /ADDR. OF LIMIT DCA ERS1 TAD F2 DCA ERS0 TIN ;ERS0 /GET LIMIT JMP DOL2
/ / / /CHARACTER CONVERSION WORH AREAS TS, ZBLOCK 12 /11 TSE, 0 TS1, ZBLOCK 11 /10 TS1E, 0 TS2, ZBLOCK 24 /21 TS2E, 0 / PAGE /** ** ** ** ** **/1600 / /WAIT WAITS, TAD (NEXT DCA CROUT JMP NXUSER / /SLEEP SLEEPR, JMS RCROUT ISZ COUNT JMP NXUSER JMP NEXT /RANGE INSTR. CHECK THAT ACL IS BETWEEN ARG2 AND COUNT RANGER, TAD ACH TAD ACM SZA CLA JMP GOTOR TAD ACL CIA TAD ARG2 SMA SZA CLA JMP GOTOR TAD COUNT CIA TAD ACL SPA SNA CLA JMP NEXT JMP GOTOR / / / /LOAD SR FROM ARG1 / LODER, 0 TAD F2 SZA /IMMEDIATE JMP LOD2 TAD ARG1 DCA SRL /LITERAL TAD F1 DCA SRM DCA SRH JMP I LODER LOD2, JMS I TVCIAC /-VE COUNT TAD F1 DCA ERS0 DCA SRH DCA SRM TAD ARG1 DCA ERS1 TAD COUNT TAD (SRL /-1,2,3 DCA IR1 LODL, TINC ;ERS0 DCA I IR1 ISZ COUNT JMP LODL JMP I LODER / /STORE ACC. VIA ARG1 / STORER, 0 TAD F2 SNA JMP I STORER JMS I TVCIAC /COUNT TAD F1 DCA ERS0 TAD ARG1 DCA ERS1 TAD COUNT TAD (ACL /-1,-2,-3 DCA IR1 STOL, TAD I IR1 DINC ;ERS0 ISZ COUNT JMP STOL JMP I STORER
/ / /POWER FAIL CKECK AND TIME SHARE OPTIONS / PFAIL2, DCA PFACSV /SAVE ACC. RDF /WHERE FROM TAD (CIF DCA PFIFSV /RETURN INST. FLD SPL /POWER LOW? JMP TIMEST /NO. HLT /WAIT AROUND PFRSEN, /RESTART COMES HERE CLA CLL DCA LSDEV /FORCE DISK RE-READ ISZ USRPFL /***** ISZ USRPFL+2 /***** ONE PER USER *** KCC TLS ISZ USRPFL+4 TLSZ2 KSFZ2+1 /KCC PFIFSV, CIF 0 CLA CLL TAD PFACSV /GET ACC. JMP I PFAIL PFACSV, 0 TIMESA, TIMESH /ADDRESS OF LOOP IN FIELD 1 /DO TIMESHARE LOOP, AND CARRY ON. TIMEST, CIF 10 JMS I TIMESA JMP PFIFSV / GET A CHARACTER OBTN, 0 CIF 10 JMS I ZOBTN CDI 0 JMP I OBTN / /PRINT A CHAR, PRNCH, 0 SNA /IGNORE ZERO JMP I PRNCH CIF 10 DCA OBTN /SAVE ACC TAD ZWPRNT /WHICH PRINTER RAR CLL CLA TAD OBTN SZL JMS I ZPRNT CLA TAD ZWPRNT RTR CLA TAD OBTN SZL JMS I ZPRNT2 CLA CLL CDI 0 JMP I PRNCH PAGE /** ** ** ** **: **/2000 / /TRIPLE PRECISION DIVIDE ROUTINE / TDIV, 0 CLA CLL DCA DSGN /SET SIGN OF RESULT SWITCH / /NOW CHECK SIGNS OF EVERYTHING / TAD ACH /FETCH HIGH ORDER AC SMA /IS IT NEGATIVE? JMP NNA /NO...CONTINUE ISZ DSGN /YES...SET SIGN SWITCH JMS C72 /COMPLEMENT 72 BIT AC-MQ NNA, CLA CLL TAD SRH /FETCH HIGH ORDER SR DCA SR1H /STORE IN HIGH ORDER SR1 TAD SRM /FETCH MED ORDER SR DCA SR1M /STORE IN MED ORDER SR1 TAD SRL /FETCH LOW ORDER SR DCA SR1L /STORE IN LOW ORDER SR1 TAD SRH /FETCH HIGH ORDER SR SMA /IS IT NEGATIVE? JMP NNSR /NO...COMPLEMENT SR1 ISZ DSGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT SR SRH JMP INDL /TO DIVIDE LOOP NNSR, JMS I TVCOMP /COMPLEMENT SR1 IF +VE SR1H INDL, TAD (-44 /PLACE -36 DCA DSHC /IN SHIFT COUNTER / /THIS BEGINS THE ACTUAL DIVIDE / /FIRST SHIFT AC-MQ LEFT 1 PLACE / DLP, JMS I TVFAIL /CHECK FOR POWER DOWN CLA CLL CML /SET LINK = 1 TAD (-6 /PUT -6 DCA ERS0 /IN INDEX LOCATION TAD (MQLO /PUT ADDRESS OF LOW ORDER MQ DCA ERS1 /IN ADDRESS INDEX LOCATION / DLP1, CLA CML TAD I ERS1 /FETCH WORD FROM 72 BIT REGISTER RAL /SHIFT LEFT 1 DCA I ERS1 /RESTORE TO 72 BIT REGISTER
CLA CMA / -1 TAD ERS1 / + ADDRESS DCA ERS1 /GIVES NEW ADDRESS ISZ ERS0 /INDEX ON NO OF WORDS JMP DLP1 /BACK IF NOT FINISHED / /CHECK TO SEE IF AC > OR = SR / CLA CLL TAD SRH /FETCH HIGH ORDER SR CIA /MAKE NEGATIVE TAD ACH /ADD HIGH ORDER AC SNA /IS RESULT ZERO? JMP DLP2 /YES...MORE TESTS SMA /NO...IS AC > SR? JMP SBTC /YES...GO TO SUBTRACT JMP INDX /NO...GO TO INDEX SHIFT COUNTER DLP2, CLA CLL TAD SRM /FETCH MED ORDER SR CMA CML IAC /NEGATE; USE LINK AS 13 BIT AC TAD ACM /ADD MED ORDER AC SNA /RESULT ZERO? JMP DLP3 /YES...MORE TESTS SNL /LINK IS SIGN; IS AC > SR? JMP SBTC /YES...GO TO SUBTRACT JMP INDX /NO...GO TO INDEX SHIFT COUNTER DLP3, CLA CLL TAD SRL /FETCH LOW ORDER SR CMA CML IAC /NEGATE; USE LINK AS 13 BIT AC TAD ACL /ADD LOW ORDER AC SZL /LINK IS SIGN; IS AC > OR = SR? JMP INDX /NO...INDEX SHIFT COUNTER / /NOW SUBTRACT SR FROM AC / SBTC, CLA CLL IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVADDS /ADD SR1 TO AC DCA SFLAG /CLEAR FLAG ISZ MQLO /LOW MQ + 1; ACCOUNTS FOR DIVISION INDX, ISZ DSHC /INDEX SHIFT COUNTER JMP DLP /BACK IF NOT FINISHED / /DIVISION COMPLETE...NOW CHECK THE SIGN / CLA CLL TAD DSGN /FETCH SIGN SWITCH RAR /SHIFT RIGHT 1 SNL /WAS IT ODD? JMP I TDIV /NO...RESULT +VE...EXIT JMS I TVCOMP /YES...COMPLEMENT RESULT MQH JMP I TDIV /RETURN / /LOCAL CONSTANTS...DIVIDE ROUTINE / DSHC, 0 DSGN, 0 /THIS SUBROUTINE PRINTS A 12 BIT /NUMBER AS A 4 DIGIT OCTAL NUMBER / PROCT, 0 DCA DSHC /STORE NUMBER DCA DSGN /CLEAR TEMPORARY LOCATION CLA CLL IAC RTL /4 JMS I TVCIAC /-4 DIGUNP, TAD DSHC /FETCH NUMBER - LINK BIT CLL RAL /ROTATE 1 LEFT TAD DSGN /ADD STORED WORD RAL /ROTATE 3 LEFT RTL DCA DSGN /STORE ROTATED NUMBER RAR /GET LINK BIT DCA DSHC /STORE IT TAD DSGN /FETCH ROTATED NUMBER AND K7 /MASK OFF 9 BITS TAD (260 /ADD ASCII 0 JMS I TVPRNT /PRINT DIGIT CLA CLL ISZ COUNT /COUNT + 1 JMP DIGUNP /BACK IF NOT LAST TAD (240 /SPACE JMS I TVPRNT CLA CLL JMP I PROCT /RETURN / TRACER, 0 DCA TDIV /SAVE AC TAD ("_ JMS CPRNT TAD TRACER /ADDR. JMS PROCT TAD TDIV JMS PROCT TAD TDIV JMP I TRACER
/ PAGE /** ** ** ** ** ** /2200 / /EXIT INSTUCTION. CHAIN IN STARTR FOR THE USER EXITR, DCA ZZABOR+1 /DONT GO ANYWHERE ON ^C JMS GORAS EXITC JMP EXITR /SHOULD NOT GET HERE / /TRIPLE PRECISION MULTIPLY ROUTINE / TMPY, 0 CLA CLL DCA SIGN /ZERO SIGN OF RESULT SWITCH DCA ACH /CLEAR 36 BIT AC. DCA ACM DCA ACL TSMQ, TAD MQH /FETCH HIGH ORDER MQ SMA /IS IT NEGATIVE? JMP TSSR /NO...CONTINUE ISZ SIGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT MQ MQH TSSR, CLA CLL TAD SRH /FETCH HIGH ORDER SR SMA /IS IT NEGATIVE? JMP STLP /NO...CONTINUE ISZ SIGN /YES...SET SIGN SWITCH JMS I TVCOMP /COMPLEMENT SR SRH STLP, CLA CLL /INITIALISE MULTIPLICATION LOOP TAD (-44 /PLACE -36 IN DCA SHCT /SHIFT COUNTER / /THIS IS THE MULTIPLICATION LOOP / MLP, CLA CLL JMS I TVFAIL /CHECK FOR POWER DOWN TAD MQLO /FETCH LOW ORDER MQ RAR /OBTAIN RIGHTMOST BIT SNL /WAS IT A 1? JMP SHFT /NO...JUST SHIFT CLA CLL /YES...CLEAR AC AND LINK DCA SFLAG /CLEAR FLAG JMS I TVADDS /ADD SR TO AC / /NOW SHIFT AC AND MQ RIGHT ONE PLACE AS A 72 BIT REGISTER / SHFT, CLA CLL DCA ERS0 /ZERO SHIFTED BIT LOCATION TAD (ACH-1 /SET ADDRESS OF HIGH ORDER AC DCA IR1 / -1 IN AUTO INDEX REGISTER 1 TAD (ACH-1 /AND ALSO TO DCA IR2 /AUTO INDEX REGISTER 2 TAD (-6 /FETCH -6 DCA ERS1 /STORE AS INDEX GETW, TAD I IR1 /FETCH WORD RAR /SHIFT RIGHT 1 TAD ERS0 /ADD BIT SHIFTED OUT OF LAST DCA I IR2 /WORD TO SAME WORD RAR /LINK TO HIGH ORDER AC DCA ERS0 /TO SHIFTED BIT LOCATION ISZ ERS1 /INCREMENT NO OF WORDS JMP GETW /BACK IF NOT FINISHED ISZ SHCT /ADD 1 TO SHIFT COUNTER JMP MLP /BACK IF NOT LAST / /MULTIPLICATION OVER...NOW SET SIGN OF RESULT / CLA CLL TAD SIGN /FETCH SIGN SWITCH RAR /SHIFT RIGHT 1 SNL /WAS IT AN ODD NO? JMP I TMPY /NO...RETURN WITH AC-MQ +VE JMS C72 /YES...COMPLEMENT 72 BIT PROD. JMP I TMPY /RETURN WITH AC-MQ -VE / / /SUBROUTINE TO COMPLEMENT AC AND MQ AS ONE 72 BIT REGISTER / C72, 0 CLA CLL TAD (-6 /PLACE -6 DCA ERS0 /IN AN INDEX LOCATION TAD (MQLO /PLACE LOW ORDER MQ ADDRESS DCA ERS1 /IN CURRENT REGISTER LOCATION TAD MQLO /FETCH LOW ORDER MQ NEG, CIA /MAKE NEGATIVE JMP ENTL /THEN ENTER LOOP IN MIDDLE / C72L, CLA CMA CLL CML / -1 TAD ERS1 / + ADDRESS OF CURRENT REGISTER DCA ERS1 /IS NEW ADDRESS TAD I ERS1 /FETCH CURRENT REGISTER CMA /COMPLEMENT IT TAD SIGN /ADD OVERFLOW BIT
ENTL, DCA I ERS1 /RESTORE TO REGISTER GLK /FETCH OVERFLOW BIT DCA SIGN /STORE IT ISZ ERS0 /INDEX ON NO OF REGISTERS JMP C72L /RETURN FOR MORE JMP I C72 /RETURN WITH AC-MQ -VE / /LOCAL CONSTANTS...MULTIPLY ROUTINE / SHCT, 0 SIGN, 0 / /THE ADDTO AND STORE FUNCTIONS / ADDTOR, CLA JMS I TVLODR JMS I TVADDS /ADD SR TO AC STORR, JMS I TVSTOR /PLACE AC IN ARG1 RAEXIT, TAD ACCH /FETCH HIGH ORDER AC DCA ACH /RESET IT TAD ACCM /FETCH MED ORDER AC DCA ACM /RESET IT TAD ACCL /FETCH LOW ORDER AC DCA ACL /RESET IT JMP NEXT /EXIT
/PWDS, PR. WDS FOLLOWING PRINT 0; PWDS, CLA CLL TINC ;NARG SNA JMP NEXT JMS I TVPRNT JMP PWDS / FRETYR, JMS I TVOBTN /FREE TYPING SNA JMP NXUSER DCA ERS0 TAD ERS0 TAD (-CRET SNA CLA JMP EREXIT /CLEAR TAD ERS0 JMS I TVPRNT TAD ERS0 TAD (-LF SNA CLA JMP ERROR1 /-1 JMP FRETYR /MORE / PAGE /** ** ** ** ** ** */2400 / /THIS ROUTINE PERFORMS A BRANCH IN THE MACRO /PROGRAM IF "N" IS TYPED AT THE KEYBOARD / YESNOR, TAD F2 /YESNOR OR ABORT SZA CLA JMP ABORTI YESN2, TAD K77 JMS RCROUT /WAIT FOR CH. DCA WTMASK JMS I TVOBTN /FETCH CHARACTER DCA ERS0 /STORE IT JMS I TVCMPA /COMPARE... ERS0 /...CHARACTER... YESCHA, "Y /...WITH ASCII Y SNA CLA /WAS IT Y? JMP YESOUT /YES...EXIT JMS I TVCMPA /NO...COMPARE... ERS0 /...CHARACTER... NOCHA, "N /...WITH ASCII N SZA CLA /WAS IT N? JMP YESN3 /NO...INCORRECT RESPONSE TAD NOCHA JMS I TVPRNT JMP GOTOR /YES...TO BRANCH ROUTINE YESOUT, TAD YESCHA JMS I TVPRNT JMP NEXT YESN3, TAD (BELL JMS I TVPRNT JMP YESN2 / /CONSTANTS...BRANCH ROUTINES / / / 6 BIT TO 8 BIT CONVERT TO8BIT, 0 DCA TO8T TAD TO8T SNA /NULL FOR NULL JMP I TO8BIT TAD (-40 SPA CLA TAD (100 TAD (200 TAD TO8T JMP I TO8BIT / /UNPACK 6 BIT CHARS, RETURN LHS IN ACC, RHS IN MQ UNPACK, 0 DCA TO8P CAM TAD TO8P AND K77 JMS TO8BIT SWP TAD TO8P BSW AND K77 JMS TO8BIT JMP I UNPACK TO8T, 0 / TO8P, 0 / /CHECK FOR SPECIAL CHARS, PRINT CPRNT, 0 DCA ERS0 TAD ERS0 TAD (-"^ //TAB? SNA JMP CPTAB TAD ("^-"_ /C.R.,L.F SZA CLA JMP CPROK TAD (CRET JMS I TVPRNT TAD (LF CPRN2, JMS I TVPRNT JMP I CPRNT CPTAB, CLA TAD CHKTAB JMP CPRN2 CPROK, TAD ERS0 JMP CPRN2 / /PRINT 2 PACKED CHARS IN AC. PTX, 0 JMS UNPACK JMS CPRNT SWP JMS CPRNT JMP I PTX / /PRINT TEXT THAT FOLLOWS "PRINT" INSTR. PRINTR, TAD INSTRH SNA JMP PWDS /COUNT=0 IAC CLL RAR /+1, /2 JMS I TVCIAC PRNX, TINC ;NARG JMS PTX ISZ COUNT JMP PRNX JMP NEXT / /PRINT VIA ARG1 IN "PRINTX" PRNTXR, TAD ARG2 IAC CLL RAR /+1, /2 JMS I TVCIAC PRNX2, TINC ;F1 JMS PTX ISZ COUNT JMP PRNX2 JMP NEXT / /PRINT WORDS PRNTWR, TAD ARG2 JMS I TVCIAC PRNW, TINC ;F1 JMS I TVPRNT ISZ COUNT JMP PRNW JMP I TVRAXT /RESTORE FROM PRINTU
CHKTAB, IFNZRO HWTABS<211 /TAB> IFZERO HWTABS<240 /SPACE> /SET TRAILING SPACES OR NULLS FILLBL, TAD (240 FILLZO, DCA FILCHA JMP NEXT / ERROR1, CLA CLL CMA /-1 SKP ERROR2, CLA CLL CMA RAL /-2 DCA ACL JMP SGN2 PAGE /** ** ** ** ** ** **/2600 / /SEARCH, HSEARCH SEAR, DCA COUNT CLA CLL CMA RAL /-2 TAD F2 SZA CLA /H JMP SEAR2 HSEAR, JMS SEARS SNA JMP SEARF SZL CLA JMP HSEAR SEARF, CLA CLL CMA /-1 TAD COUNT JMP TOACL SEAR2, JMS SEARS SZA CLA JMP SEAR2 JMP SEARF SEARS, 0 TINC ;F1 SNA JMP ERROR1 ISZ COUNT CIA CLL TAD ACL JMP I SEARS
PRFLCH, 0 CLA CLL TAD PFCM6 /FETCH -4 DCA CBSV /SET AS COUNTER PFC1, TAD (200 JMS I TVPRCH /PRINT NULL ISZ CBSV /INDEX COUNTER JMP PFC1 /BACK IF NOT LAST JMP I PRFLCH /RETURN / /CONSTANTS...PRINT FILL CHARACTERS ROUTINE / PFCM6, 0-6 / / / / / /SUBROUTINE TO CLEAR STORAGE VECTORS WITH BLANKS / CBSV, 0 CLA CLL CMA /-1 TAD (TS DCA IR1 TAD (-52 DCA COUNT TAD (SPACE DCA I IR1 ISZ COUNT JMP .-3 JMP I CBSV /RETURN / / / /MOVE MOVETR, JMS RCOUNT MOVX, TINC ;F1 DINC ;F2 ISZ COUNT JMP MOVX JMP NEXT / /COMPARE WORD STRINGS CMPARE, JMS RCOUNT JMS I TVCLAM CMPX, TINC ;F1 DCA ERS0 TINC ;F2 DCA ERS1 TAD ERS0 /1ST SPA CLA JMP CLGAM TAD ERS1 /2ND SPA JMP CMPEND CLGABP, CIA TAD ERS0 /1ST JMP CMPEND CLGAM, CLA CLL TAD ERS1 /2ND SPA JMP CLGABP CLA CLL IAC /+1 CMPEND, SZA JMP CMPUNQ ISZ COUNT JMP CMPX CMPUNQ, DCA ACH JMP NEXT / /CONVET 6 BIT STRINGS TO 8 BIT CNV6WR, JMS RCOUNT C6WX, TINC ;F1 JMS UNPACK DINC ;F2 ISZ COUNT SKP JMP NEXT SWP DINC ;F2 ISZ COUNT JMP C6WX JMP NEXT / /CONVERT 8 BIT TO 6 BIT CNVW6R, JMS RCOUNT CW6X, TINC ;F1 AND K77 BSW DIN ;F2 ISZ COUNT SKP JMP I TVRAXT TINC ;F1 AND K77 TIN ;F2 DINC ;F2 ISZ COUNT JMP CW6X JMP I TVRAXT /RESTORE FROM PICTURE / PAGE / ** ** ** ** ** **/3000 FILLR, FILLR2, JMS RCOUNT JMS CLR JMP NEXT CLR, 0 CLR2, CLA CLL TAD ARG1 DINC ;F2 ISZ COUNT JMP CLR2 JMP I CLR
/ /TWO WORD INDIRECT ROUTINS. TIN,TINC,DIN,DINC. RTINC, 0 DCA RTINS JMS RT4 JMS RTTAD RTDIN, ISZ I TINF /INCR LOW ORDER RTIN2, SKP CLA JMP RT6 /INCR. HIGH ORDER IF OVRFLO. TAD RTINS ISZ RTINC JMP I RTINC /MAIN RETURN RTLEFT, RDINC, 0 DCA RTINS TAD RDINC DCA RTINC JMS RT4 JMS RTDCA JMP RTDIN RTRITE, RTIN, 0 DCA RTINS TAD RTIN DCA RTINC JMS RT4 JMS RTTAD JMP RTIN2 TINF, RDIN, 0 DCA RTINS TAD RDIN DCA RTINC JMS RT4 JMS RTDCA JMP RTIN2 RTTAD, 0 TAD I RTRITE /ACTUAL TAD I DCA RTINS RTCDF, CDF 0 JMP I RTTAD RTDCA, 0 DCA I RTRITE /ACTUAL DCA I DCA RTINS CDF 0 JMP I RTDCA RT4, 0 CDI 0 TAD I RTINC /ADDR OF INDIR.FLD DCA TINF TAD I TINF DCA RTLEFT /INDIR FIELD ISZ TINF TAD I TINF DCA RTRITE /INDIR ADDR TAD RTLEFT CLL RAL RTL TAD RTCDF DCA .+2 TAD RTINS CDF JMP I RT4 RT6, JMS I TVPDPR /BACK TO FLD PTR. TINF ISZ I TINF JMP RTIN2 RTINS, 0 / / /SUBROUTINE TO GOVERN THE PRINTING OF SINGLE /ASCII CHARACTERS. THE ROUTINE TESTS EACH /CHARACTER FOR A "LINE FEED" AND INSERTS 8 /"FILL" CHARACTERS INTO THE OUTPUT STRING / PRNT, 0 DCA PRTCS /STORE CHARACTER TAD PRTCS /FETCH CHARACTER SZA /IGNORE ZERO JMS I TVPRCH /PRINT IT JMS I TVCMPA /COMPARE... PRTCS /...CHARACTER... 212 /...WITH LINE FEED SZA CLA /WAS IT LINE FEED? JMP I PRNT /NO...RETURN IFZERO DECWRIT< JMS PRFLCH> /YES...PRINT FILL CHARACTERS ISZ LINKNT /ADD 1 TO LINE COUNT JMP I PRNT /RETURN JMP I PRNT /RETURN / /CONSTANTS...PRINT CONTROL ROUTINE / PRTCS, 0 / MOBERR, CLA CLL JMS GORAS /TO RASBOL AT... OBMES1 /...THIS ADDRESS TAD NARG /FETCH FIELD TAD (260 /ADD ASCII 0 JMS I TVPRNT /PRINT FIELD TAD NARGW /FETCH ADDRESS JMS PROCT /TO PRINT 4 OCTAL DIGITS JMP EXITR /
PAGE /** ** ** ** ** ** ** / /THIS ROUTINE ALLOWS EITHER A SINGLE CHARACTER /OR A NUMBER UP TO TEN DIGITS LONG TO BE KEYED /IN DEPENDING ON THE VALUE OF THE F1 AND F2 BITS / TYPICR, TAD INSTRH /FETCH RIGHT HAND 6 BITS SZA /WAS IT ZERO? JMP TYPINR /NO...ENTER NUMBER JMS I TVOBTN /YES...FETCH CHARACTER SNA /WAITING? JMP NXUSER /YES. JMP TOACL /PRNTCH, PRINT CHAR. IN ACC. RPRNCH, TAD ACL JMS I TVPRNT JMP NEXT TYPINR, AND (40 /PRINTN,PRINTD? SZA CLA /NO JMP PRNTNR TAD F1 DCA ARG1 TAD F2 DCA ARG2 /SET AS ARG2 CLA CLL CMA RTL /SET -3 TAD ARG2 /ADD ARG2 SMA SZA CLA /WAS ARG2 > 3? JMP I TVMOER /YES...TO OBJECT ERROR JMS I ICNR /NO...INPUT NUMBER DCA SFLAG1 /CLEAR FLAG JMP NEXT /EXIT / /CONSTANTS...ENTER NUMERIC ROUTINE / ICNR, ICN / / / /THIS ROUTINE IS USED TO PERFORM THE MULTIPLY /AND DIVIDE FUNCTIONS OPERATING ON THE 36 BIT /SR AND 72 BIT AC - MQ MACRO REGISTERS / / MDENTR, JMS I TVSWAM /PUT AC IN MQ JMS I TVLODR TAD SRH TAD SRM TAD SRL /IS SR = 0 SNA CLA /NO JMP EREXIT /YES, ERROR EXIT TAD OPCODE /NO...FETCH OPCODE CLL RAR /OBTAIN RIGHTMOST BIT SZL CLA /WAS IT ZERO? JMP MDIVR /NO...TO DIVIDE ROUTINE JMS I TVTMPY /YES...TO MULTIPLY JMS I TVSWAM /PUT ANSWER IN AC ISZ MFLAG /SET MULTIPLY FLAG JMP MLSTRT /EXIT EREXIT, JMS I TVCLAM /CLEAR AC - MQ JMP NEXT /EXIT MDIVR, TAD MFLAG /FETCH FLAG SZA CLA /IS IT SET? JMP MDIVJ /YES...CONTINUE TAD MQH /NO...FETCH HIGH ORDER MQ SPA CLA /IS IT NEGATIVE? CLL CMA /YES...SET -1 DCA ACH /SET HIGH ORDER AC TAD ACH /FETCH HIGH ORDER AC DCA ACM /SET MED ORDER AC TAD ACH /FETCH HIGH ORDER AC DCA ACL /SET LOW ORDER AC MDIVJ, JMS I TVTDIV /DIVIDE JMS I TVSWAM /PUT ANSWER IN AC JMP NEXT /EXIT / /
/ / /THIS ROUTINE COMBINES THE 36 BIT NUMBER IN THE /MACRO AC WITH A SPECIFIED MASK TO PRODUCE A /FORMATTED PRINT IMAGE IN A SPECIFIED LOCATION / PRUR, TAD ARG2 /PRINTU DCA COUNT IMPRUR, TAD COUNT /FETCH LENGTH DCA IPSV5 /SAVE IT JMS CBSV /CLEAR STORAGE VECTORS TAD ACH /FETCH HIGH ORDER AC SMA CLA /IS NO -VE? JMP PICON /NO...CONTINUE IAC /YES...SET... DCA SFLAG1 /...1 IN FLAG JMS I TVCOMP /COMPLEMENT AC ACH PICON, JMS I TVCBCH /CONVERT NO TO CHARACTERS CLA CLL CMA /SET -1 TAD (TS1 /ADD VECTOR ADDRESS DCA IR1 /SET IN AUTO INDEX REGISTER 1 TAD (-5 /FETCH -5 DCA COUNT /SET AS COUNTER IP1, TINC ;F1 JMS UNPACK DCA I IR1 SWP DCA I IR1 ISZ COUNT /INDEX COUNTER JMP IP1 /BACK IF NOT LAST JMS I PFPIS /TO CREATE IMAGE TAD IPSV5 DCA COUNT TAD COUNT CIA IAC TAD (TS2E /START OF TEXT DCA ARG1 DCA F1 /=0 TAD OPCODE TAD (-70 /IS IT PICTURE? SNA CLA /NO, PRINTUSING JMP CNVW6R JMP PRNTWR / /CONSTANTS..."IMAGE" AND "PRINTU" ROUTINES / PFPIS, PFPI IPSV5, 0 / / /THIS ROUTINE PRINTS A SPECIFIED /CHARACTER A GIVEN NUMBER OF TIMES / PRNTCR, TAD INSTRH /FETCH NUMBER SNA TAD ACL /COUNT IN ACC. SNA JMP NEXT /NIL PRINT JMS I TVCIAC PRCLP, TAD ARG1 /FETCH CHARACTER JMS I TVPRNT /PRINT IT ISZ COUNT /INDEX COUNTER JMP PRCLP /BACK IF NOT LAST JMP NEXT /EXIT / /
PAGE /** ** ** ** ** /TRIPLE PRECISION INPUT ROUTINE / ICN, 0 ICST, JMS I TVCLAM /CLEAR 36 BIT AC TAD (7760 /WAIT FOR CR. JMS RCROUT DCA WTMASK / /NOW INITIALISE THE INPUT LOOP / DCA DPCT /CLEAR NO OF PLACES COUNTER DCA SFLAG1 /CLEAR SIGN FLAG DCA IPF /CLEAR POINT FLAG CMA /SET -1 IN ACCUMULATOR TAD (TS /ADD ADDRESS OF BUFFER DCA IR1 /PLACE IN AUTO INDEX REGISTER 1 TAD IM11 /FETCH -11 DCA ICT /SET AS INPUT COUNT INDEX / /THE INPUT LOOP BEGINS HERE / INCH, JMS I TVOBTN /FETCH CHARACTER FROM KEYBOARD SNA JMP ERROR /NO CHAR. DCA ERS0 /STORE TEMPORARILY / /NOW TEST THAT INPUT CHARACTER WAS NUMERIC / JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH
260 /ASCII ZERO SMA CLA /WAS IT NON NUMERIC? JMP NT /NO...CONTINUE JMP CHAR /YES...TEST IF LEGAL NT, JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH 271 /ASCII 9 SMA SZA CLA /WAS CHARACTER NUMERIC? JMP ERROR /NO...ERROR NT2, TAD IPF /YES...FETCH POINT FLAG SZA CLA /POINT TYPED? ISZ DPCT /YES...COUNT PLACE TAD ERS0 /NO...FETCH CHARACTER DCA I IR1 /STORE IN BUFFER ISZ ICT /INDEX INPUT COUNT JMP INCH /BACK IF NOT LAST JMP IEND /END OF INPUT / /IF CHARACTER WAS NOT NUMERIC, /TEST THAT IT WAS ALLOWABLE / CHAR, JMS I TVCMPA /COMPARE ERS0 /CHARACTER WITH 256 /ASCII DECIMAL POINT SNA CLA /WAS IT A DECIMAL POINT? JMP IPNT /YES...CHECK DECIMAL JMS I TVCMPA /NO...CONTINUE TESTING ERS0 /COMPARE CHARACTER 255 /WITH ASCII MINUS SIGN SNA CLA /WAS IT A MINUS SIGN? JMP IMS /YES...CHECK NEGATIVE JMS I TVCMPA /NO...CONTINUE TESTING ERS0 /COMPARE CHARACTER 215 /WITH ASCII RETURN SNA CLA /WAS IT A CARRIAGE RETURN? JMP IEND /YES...END OF INPUT JMS I TVCMPA ERS0 240 /SPACE SNA CLA JMP NT2 /TREAT AS ZERO JMP ERROR /NO...CHARACTER ILLEGAL...ERROR / /TEST THAT DECIMAL POINT IS ALLOWED / IPNT, TAD ARG1 /FETCH NO OF PLACES ALLOWED SNA CLA /WAS IT ZERO? JMP ERROR /YES...ERROR ISZ IPF /NO...SET POINT FLAG JMP INCH /BACK FOR NEXT CHARACTER / /TEST THAT NEGATIVE NUMBER IS ALLOWED / IMS, JMS I TVCMPA /COMPARE ARG2 /NO OF WORDS IN FIELD 3 /WITH 3 SZA CLA /WAS IT 3? JMP ERROR /NO...ERROR ISZ SFLAG1 /YES...SET SIGN FLAG JMP INCH /BACK FOR NEXT CHARACTER / /NOW THAT THE COMPLETE NUMBER HAS BEEN /INPUT, IT MUST BE CONVERTED TO BINARY /AND THEN STORED IN THE SPECIFIED FIELD / IEND, TAD IPF /FETCH POINT FLAG SNA CLA /DECIMAL POINT ENTERED? JMP TBIN /NO...CONVERT AND STORE NPT, TAD ARG1 /YES...FETCH NO OF PLACES CIA /MAKE NEGATIVE TAD DPCT /ADD NO OF PLACES ENTERED SMA SZA /WAS IT > ALLOWED? JMP ERROR /YES...ERROR SMA CLA /NO...WAS IT < ALLOWED? JMP TBIN /NO...CONVERT AND STORE TAD INA0 /YES...FETCH ASCII ZERO / /NUMBER IS PADDED WITH ZEROS IF NECESSARY / DCA I IR1 /STORE ZERO IN BUFFER ISZ DPCT /INDEX PLACE COUNT ISZ ICT /INDEX NO OF "ENTRIES" JMP NPT /BACK IF NOT LAST PLACE / /NUMBER IS NOW CONVERTED TO BINARY / TBIN, TAD IM11 /FETCH -11 CIA TAD ICT SNA /WAS IT 0? JMP NONUM /YES...TO EXIT JMS I TVCIAC CLA CLL CMA /SET -1 TAD (TS /ADD VECTOR ADDRESS DCA IR5 /SET IN AUTO INDEX REGISTER 5 JMS I TVABC /CONVERT TO BINARY CLA CLL CMA RAL /NO...SET -2 IN ACCUMULATOR TAD ARG2 /ADD NO OF WORDS IN FIELD SMA SZA /WAS IT = 3? JMP CHSG /YES...STORE NUMBER
SMA CLA /NO...WAS IT = 2? JMP ITO /YES...TEST HIGH ORDER TAD ACM /NO...FETCH MED ORDER AC ITO, TAD ACH /FETCH HIGH ORDER AC SZA CLA /OVERFLOW? JMP ERROR /YES...ERROR CHSG, CLA CLL /CLEAR AC AND LINK TAD SFLAG1 /FETCH FLAG SNA CLA /WAS IT ZERO? JMP I ICN /YES...RETURN...36 BIT AC +VE JMS I TVCOMP /NO...COMPLEMENT AC ACH JMP I ICN /RETURN...36 BIT AC -VE / /NUMERIC INPUT ROUTINE...ERROR EXIT / ERROR, CLA CLL TAD (-BELL /FETCH BELL CHARACTER JMS I TVPRNT /PRINT IT IMMEDIATE JMS I TVOBTN /EMPTY INPUT BUFFER SZA CLA JMP .-2 JMP ICST / /NUMERIC INPUT ROUTINE...NO INPUT EXIT / NONUM, JMS I TVCLAM /CLEAR AC-MQ JMP I ICN /RETURN / /CONSTANTS...NUMERIC INPUT ROUTINE / IM11, 0-13 INA0, 260 ICT, 0 DPCT, 0 IPF, 0 / /
/ /SUBROUTINE TO PREPARE A FORMATTED PRINT IMAGE / PAGE /** ** ** ** ** **/ 3600 PFPI, 0 CLA CLL TAD (TSE /FETCH NUMBER VECTOR ADDRESS DCA ERS0 /SET IN NUMBER COUNTER TAD (TS1E /FETCH MASK VECTOR ADDRESS DCA ERS1 /SET IN MASK COUNTER TAD (TS2E /FETCH RESULT VECTOR ADDRESS DCA ERS2 /SET IN RESULT COUNTER / /FIRST TEST SIGN / TAD SFLAG1 /FETCH SIGN FLAG SNA CLA /IS NUMBER +VE? JMP PUCS /YES...UPDATE COUNTERS DCA SFLAG1 /NO...CLEAR FLAG PMRL, TAD I ERS1 /MOVE MASK CHARACTER... DCA I ERS2 /...TO RESULT VECTOR PUCS, JMS I TVPDPR /UPDATE MASK COUNTER ERS1 JMS I TVPDPR /UPDATE RESULT COUNTER ERS2 / /THE MAIN LOOP OF THE ROUTINE MERGES MASK CHARACTERS /WITH NUMERICS AND STORES THEM IN THE RESULT VECTOR / PILP, CLA CLL TAD I ERS1 /FETCH MASK CHARACTER DCA PCHA /STORE IT PILP2, TAD (PBLANK-1 DCA IR1
PILP3, CDF 10 TAD I IR1 CDF 0 SNA JMP PILP4 /END TAD PCHA SNA CLA JMP PILP4 /EQUAL ISZ IR1 JMP PILP3 PILP4, CDF 10 TAD I IR1 /GET BIT SWITCHES CDF 0 DCA PBITS TAD I ERS0 /IS DIGIT A SPACE TAD (-SPACE SNA CLA JMP PILP6 /YES TAD PBITS /NO BSW DCA PBITS PILP6, JMS RBITS /40 TAD I ERS0 DCA I ERS2 /DIGIT OUT JMS RBITS /20 TAD I ERS1 DCA I ERS2 /MASK OUT JMS RBITS /10 TAD (SPACE JMP PILP8 PILP7, JMS RBITS /4 JMS I TVPDPR ERS1 /COUNT MASK JMS RBITS /2 JMS I TVPDPR ERS2 /COUNT OUTPUT JMS RBITS DCA SFLAG JMP I PFPI /FINISHED TAD ERS0 TAD (-TS SPA CLA JMP .-5 /WATCH THIS? JMP PILP /DO NEXT CHAR. PILP8, DCA I ERS0 /CLEAR DIGITS TO SPACES JMS I TVPDPR ERS0 /COUNT DIGITS JMP PILP7 PCHA, 0 PBITS, 0 RBITS, 0 /ROTATE PBITS LEFT, CLA CLL TAD PBITS RAL DCA PBITS SZL JMP I RBITS ISZ RBITS ISZ RBITS JMP I RBITS / /
/ /RASBOL-8 MICRO PROGRAM / /SUBROUTINE TO CONVERT STRINGS OF STORED 8 BIT /ASCII CHARACTERS INTO A 36 BIT BINARY NUMBER / ABC, 0 CLA CLL TAD COUNT DCA ABCKNT JMS MUL10 /MULT BY 10 TAD I IR5 /FETCH CHARACTER AND CNMSK /MASK OFF ASCII CODE DCA SR1L /PLACE RESULTING NO IN SR1 DCA SR1M DCA SR1H CLA CLL IAC /SET 1... DCA SFLAG /...IN FLAG JMS I TVADDS /ADD SR1 TO AC DCA SFLAG /CLEAR FLAG ISZ ABCKNT /INDEX COUNTER JMP CNLP /BACK IF NOT LAST JMP I ABC /RETURN MUL10, 0 TAD CV10 /FETCH 10 DCA SRL /SET SR... DCA SRM /...EQUAL... DCA SRH /...TO 10 CNLP, JMS I TVSWAM /MOVE AC TO MQ DCA ACH /ZERO 36 BIT AC DCA ACM DCA ACL JMS I TVTMPY /MULTIPLY AC-MQ BY 10 JMS I TVSWAM /MOVE RESULT TO AC DCA MQH /ZERO 36 BIT MQ DCA MQM DCA MQLO JMP I MUL10 / /CONSTANTS...ASCII TO BINARY SUBROUTINE / CV10, 12 CNMSK, 0017 ABCKNT, 0 PAGE / ** ** ** ** ** / CBCH, 0 /CONVERT BINARY TO CHAR.STRING CLA CLL DCA SFLAG TAD (-12 /10 DCA IR5 TAD (TS-1 DCA IR2 /ADDR.OF CHAR.STRING TAD (CCON-1 DCA IR1 TAD (SPACE-"0 DCA ZSW /ZERO SUPPRESS SWITCH TCLP, DCA DIGIT CDF 10 / CCON, POWERS OF TEN TAD I IR1 DCA SRH TAD I IR1 DCA SRM TAD I IR1 CDF 0 DCA SRL TC2, CLA CLL /IS ACC. ZERO? TAD ACH TAD ACM TAD ACL SNA SZL SKP CLA JMP TC6 /ZERO JMS I TVADDS /ADD NEGATIVE TAD ACH SPA CLA JMP TC4 /MINUS ISZ DIGIT /COUNT DCA ZSW /CLEAR ZERO SUPP. JMP TC2 TC4, JMS I TVCOMP SRH /CHANGE TO PLUS JMS I TVADDS /ADD BACK TC6, TAD DIGIT /CONVERT TO ASCII TC7, SNA TAD ZSW TAD ("0 DCA I IR2 /STORE CHAR TAD IR5 SMA CLA JMP I CBCH /LAST DIGIT ISZ IR5 JMP TCLP TAD ACL /LAST DIGIT JMP TC7 DIGIT, 0 ZSW, 0 / /
/ TEXT INPUT ROUTINES TYPSET, 0 TAD ARG2 JMS I TVCIAC DCA ARG2 JMP I TYPSET OBTEX, 0 CLA CLL TAD OBTEX DCA F2 /MAKE RE-ENTRANT OBTX2, TAD ARG2 SZA JMP OBTX3 /END, RETURN WITH FILL CLA CLL CMA /7777 JMS RCROUT /WAIT 1 CHAR. DCA WTMASK JMS I TVOBTN /GET CHAR. OBTX3, DCA ERS0 TAD ERS0 TAD (-CRET SZA CLA JMP OBTX4 CLA CLL CML RTR /2000 TAD FILCHA /SET END SIGNAL DCA ARG2 JMP OBTX2 OBTX4, TAD ERS0 AND (377 JMS I TVPRNT CLA TAD ERS0 JMP I F2 /RETN.WITH CHAR. / /TYPWDS, TYPE WORDS TYPWR, JMS TYPSET TYPW2, JMS OBTEX AND (377 DINC ;F1 ISZ COUNT JMP TYPW2 JMP NEXT / /TYPTEX, TYPE TEXT (6 BIT) TYPTR, JMS TYPSET TYPT2, JMS OBTEX AND K77 BSW DIN ;F1 ISZ COUNT SKP JMP NEXT JMS OBTEX AND K77 TIN ;F1 /ADD TO L.H.S. DINC ;F1 ISZ COUNT JMP TYPT2 JMP NEXT /
/ / /
/THIS IS THE START OF THE RASBOL /DISK INSTRUCTIONS EXECUTION ROUTINES / /BEGIN BY DEFINING SOME DISK ROUTINES WORK AREAS / PAGE /** ** ** ** ** ** ** CFRBA, 0 /BLOCK ADDRESS OF CURRENT RECORD CFRWI, 0 /WORD INDEX OF CURRENT RECORD TNRP1, ZBLOCK 2 /TOTAL NUMBER OF RECORDS IN FILE (+1) LSDEV, 0 /LAST DEVICE USED / /THIS ROUTINE ACTUALLY READS FROM AND WRITES TO THE DEVICE /USING THE DEVICE HANDLER LOADED BY THE "OPEN" ROUTINE / BLOKOP, 0 DCA DHENTP TAD (XAREA DCA BOXA TAD DHENTP TAD (200 /ADD 200 JMS HANDLR JMP ERROR2 JMP I BLOKOP HANDLR, 0 DCA BOFCW /SET AS FUNCTION CONTROL WORD TAD CTBLK /FETCH BLOCK NUMBER DCA BOBN /SET IT TAD CTBLK DCA CFRBA TAD CTDEV /FETCH DEVICE NUMBER DCA LSDEV TAD CTDEV TAD (7646 /ADD TABLE ADDRESS - 1 DCA DHENTP /STORE AS POINTER CDF 10 /SET DATA FIELD TO 1 TAD I DHENTP /FETCH HANDLER ENTRY POINT DCA DHENTP /STORE IT CDI 0 /SET FIELDS TO 0 JMS I DHENTP /TO DEVICE HANDLER BOFCW, 0 /FUNCTION CONTROL WORD BOXA, 0 /BUFFER ADDRESS BOBN, 0 /STARTING BLOCK NUMBER SKP /ERROR RETURN ISZ HANDLR JMP I HANDLR /TRANSFER COMPLETE...RETURN / /CONSTANTS...DISK READ/WRITE ROUTINE / DHENTP, 0 /WORK AREAS FOR FILE CHANEL CHLNUM, 0 /CHANEL NO. IN CURRENT USE / CHLWK, /16 WORD WORK AREA CHLNU, 0 /NO.OF USERS OF THIS FILE, -1=LOCK CHLDEV, 0;0 /DEVICE NAME CHLNAM, 0;0;0;0 /FILE NAME CFP1, 0 /DEVICE CODE CFP2, 0 /BLOCK ADDRESS OF FILE IIDATE, 0 /DATE IN DIRECTORY IINBI, 0 /NO.OF INDEX BLOCKS IIFUBN, 0 /FIRST UNUSED BLOCK IIFUWN, 0 / " WORD IIRECL, 0 /RECORD LENGTH IN WORDS IIKEYL, 0 /LENGTH OF KEY IN WORDS IINBFM, 0 /NO.OF BLOCKS IN FILE (MINUS) / / / CHLSAV, 0 /TEMP HOLD OPTION, 0 /OPTION BEING USED STRUCT, 0 /1=FILE STRUCTURED. / /QAREA SET-UP QSETQ, 0 CLL RTL /4 RTL /16 TAD (QAREA-1 DCA IR2 TAD (CHLWK-1 DCA IR1 TAD (-20 /16 DCA ERS0 JMP I QSETQ /PUT INFO FROM WK AREA TO QAREA QPUTQ, 0 JMS QSETQ QPTL, CDF 0 TAD I IR1 CDF 10 DCA I IR2 ISZ ERS0 JMP QPTL CDF 0 JMP I QPUTQ /GET INFO FROM QAREA TO WK AREA QGETQ, 0 JMS QSETQ QGTL, CDF 10 TAD I IR2 CDF 0 DCA I IR1 ISZ ERS0 JMP QGTL JMP I QGETQ / GET USERS DEVICE,FILENAME TO WK AREA QGINST, 0 TAD (CHLDEV-1 DCA IR1 TAD (-6 DCA ERS0 QGIL, TINC ;F2 /INSTRUCTION POINTER DCA I IR1 ISZ ERS0 JMP QGIL JMP I QGINST /FIND AN EMPTY CHANEL QEMPTY, 0 TAD (40 /32 DCA CHLNUM QEML, CLA CMA /-1 TAD CHLNUM SPA JMP I QEMPTY /-1 NOT FOUND DCA CHLNUM TAD CHLNUM CLL RTL;RTL /16 TAD (QAREA DCA QGINST /TEMP CDF 10 TAD I QGINST CDF 0 SZA JMP QEML JMP I QEMPTY
/ PAGE / / / / / / / / /SEARCH FOR A USED CHANEL WITH SAME DEV:FILE.EX AS WK AREA QSERNA, 0 TAD (40-1 /31 QSERL, DCA CHLSAV JMS QCOMNA /COMPARE SNA CLA /NOT SAME JMP I QSERNA /SAME CLA CMA CLL /-1 TAD CHLSAV SPA JMP I QSERNA JMP QSERL /COMPARE WK AREA, DEV:FILE.EX IN QAREA QCOMNA, 0 TAD CHLSAV JMS QSETQ TAD (-6 DCA ERS0 ISZ IR1 /NO USERS CDF 10 TAD I IR2 /NO.USERS SNA JMP QCOMER /NO USERS CDF 0 DCA ERS1 /SAVE NO.OF USERS QCOML, CDF 10 TAD I IR2 CIA CDF 0 TAD I IR1 SZA CLA JMP QCOMER /NOT SAME ISZ ERS0 JMP QCOML SKP /SAME 6 WDS QCOMER, CLA CMA /-1 CDI 0 JMP I QCOMNA /RETURN NOT SAME / /ENQUIRE, FETCH HANDLER FOR DEVICE IN WK AREA, /READ BLOCK ZERO AS A CHECK, RETURN NON ZERO IF ERROR QFETCH, 0 TAD CHLDEV DCA OPEN2 TAD CHLDEV+1 DCA OPEN3
CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 12 /FUNCTION 12: INQUIRE OPEN2, 0 /DEVICE... OPEN3, 0 /...NAME OPEN4, 0 /HANDLER ENTRY POINT JMP ERROR2 /ERROR RETURN CLA TAD OPEN4 /FETCH ENTRY POINT SZA CLA /HANDLER LOADED? JMP OPEN8 /YES...CONTINUE / /IF THE CORRECT DEVICE HANDLER WAS NOT IN CORE /IT IS NOW FETCHED WITH THE USER SERVICE ROUTINE / CDF 0 CIF 10 JMS GETPAG /TO FETCH HANDLER PAGE ADDRESS SNA /SPACE AVAILABLE? JMP ERROR2 /NO...ERROR DCA OPEN7 /YES...SET ADDRESS AS ARGUMENT TAD OPEN3 /FETCH DEVICE NUMBER CDF 0 CIF 10 JMS I (200 /TO USER SERVICE ROUTINE 1 /FUNCTION 1: FETCH OPEN7, 0 /ADDRESS OF HANDLER JMP ERROR2 /ERROR RETURN CDF 0 CIF 10 JMS USFLAG /UPDATE SPACE FLAG OPEN8, TAD OPEN3 DCA CFP1 /READ BLOCK 0 TAD CFP1 DCA CTDEV DCA CTBLK JMS I TVBLKO /READ CLA CLL JMP I QFETCH / / /LOOKUP THE FILE QLOOK, 0 JMS I TVFAIL TAD CFP1 /DEVICE CODE TAD (7757 /TABLE ADDRESS DCA ERS2 /POINTER DCA STRUCT CDF 10 TAD I ERS2 CDF 0 SMA CLA /FILE STRUCTURED? JMP I QLOOK /NO TAD (CHLNAM DCA OPEN10 ISZ STRUCT TAD CFP1 CDF 0 CIF 10 JMS I (200 /USER 2 /LOOKUP OPEN10, 0 0 JMP ERROR2 /ERROR RETURN CLA /NORMAL EXIT TAD OPEN10 DCA CFP2 /START BLOCK OF FILE JMP I QLOOK PAGE / * * * * * / /THE FILE INDEX INFORMATION IS NOW FETCHED FROM /THE OS/8 DIRECTORY ADDITIONAL INFORMATION WORDS / GETAIN, 0 TAD STRUCT SNA CLA JMP I GETAIN /NOT FILE DEV. OPEN11, CLA CLL IAC /FLD 1 DCA ERS0 CDF 10 TAD I (1404 /NO.OF A.I.WDS.(-VE) TAD I (17 /AIN PNTR CDF 0 DCA ERS1 TAD (IIDATE-1 DCA IR1 TAD (-7 DCA IR2 OPEN12, TINC ;ERS0 DCA I IR1 ISZ IR2 JMP OPEN12 JMP I GETAIN /THE INDEX INFORMATION WORDS IN THE FILE POINTER /ARE NOW SET UP AND WRITTEN BACK TO THE DIRECTORY / PUTAIN, 0 TAD STRUCT SNA CLA JMP I PUTAIN /NOT FILE DEV. CLOSE6, CLA CLL TAD (IIDATE-1 DCA IR1 CDF 10 TAD I (7666 /DATE CDF 0 DCA IIDATE CLA CLL IAC /FLD 1 DCA ERS0 CDF 10 TAD I (1404 /# AIN TAD I (17 CDF 0 DCA ERS1 TAD (-6 DCA IR2 CLOSE7, TAD I IR1 DINC ;ERS0 ISZ IR2 JMP CLOSE7 / /THE DIRECTORY SEGMENT IS NOW REWRITTEN / CIF 10 JMS I (REWDS /TO REWRITE DIRECTORY SEGMENT CLFP3, CDI 0 /RESET BOTH FIELDS JMS I TVCLAM /CLEAR 36 BIT AC-MQ JMP I PUTAIN
/ /GET AND PUT A.I.WORDS TO PROGRAM DATA AIWR, JMS I TVCLAM TAD OPTION TAD (-12 /10 SNA CLA /GET JMP PUTAI2 TAD (CFP1-1 DCA IR1 TAD (-11 /9 DCA ERS0 GAIWL, TAD I IR1 DINC ;F2 ISZ ERS0 JMP GAIWL JMP NEXT PUTAI2, TAD (IIDATE-1 DCA IR1 TAD (-6 DCA ERS0 ISZ ARG2 ISZ ARG2 PAIWL, TINC ;F2 /GET DCA I IR1 ISZ ERS0 JMP PAIWL DCA DSQWOF /CLR JMP WRITQ2 / /CHANNEL INSTRUCTION DECODE CHANLR, TAD COUNT TAD (-12 /-10 SZA SMA CLA JMP ERROR2 TAD COUNT DCA OPTION TAD OPTION TAD (JMP I JOPTION DCA .+1 0 JOPTION, OPENR /OPEN LOCK=0 OPENR /OPEN CLOSER /CLOSEQ 2 CLOSER /CLOSE OVERR /CHAIN OVERR /OVERLAY OVERR /SAVE OS8ENR /OS8 ENTER OS8CLS /OS8 CLOSE DREAD2 /9 GETAIW DREAD2 /10 PUTAIW / PAGE / * * * * ** * / /OPEN, OPEN-LOCK MAINLINE OPENR, JMS I TVCLAM JMS QGINST /GET INSTR. INFO JMS QSERNA /FIND IT ALREADY? SMA CLA /NO JMP OPNR2 /FOUND JMS QFETCH /GET OR FIND HANDLER JMS QLOOK /LOOK UP JMS GETAIN /GET ADDITIONAL INFO. WORDS JMS QEMPTY /FIND ROOM SPA CLA JMP ERROR1 /NO ROOM DCA CHLNU /CLR.USERS JMP OPNR4 OPNR2, TAD OPTION /IF FOUND + LOCK, EXIT SNA CLA JMP ERROR1 TAD CHLSAV DCA CHLNUM TAD CHLNUM JMS QGETQ /GET INFO TAD CHLNU /ALREADY LOCKED? SPA CLA JMP ERROR1 /YES. OPNR4, TAD OPTION /LOCK? SNA CLA JMP OPNR5 ISZ CHLNU /NO,INC.NO.OF USERS JMP OPNR6 OPNR5, CLA CMA /-1 DCA CHLNU /NO.USERS, LOCK. OPNR6, TAD CHLNUM DIN ;F1 TAD CHLNUM JMS QPUTQ /RETURN OR SETUP INFO JMS GORAS OPCALR /CALC. NO.OF RECORDS IN FILE TAD TNRP1 DCA ACM TAD TNRP1+1 DCA ACL DCA ACH JMP NEXT /CLOSE CLOSEQ MAINLINE CLOSER, JMS I TVCLAM TIN ;F1 SPA JMP ERROR2 /CLOSED BEFORE DCA CHLNUM TAD CHLNUM JMS QGETQ /GET INFO SPA CLA JMP ERROR2 /NOT FOUND TAD CHLNUM DCA CHLSAV JMS QCOMNA /COMPARE NAMES SPA CLA JMP ERROR2 /NOT SAME NAME CLA CLL RAL CMA /-2 TAD OPTION SZA CLA JMP CLOS5 JMS QLOOK /LOOKUP JMS PUTAIN CLOS5, TAD CHLNU /NO.OF USERS SPA CLA JMP CLOS7 /LOCKED =-1 CLA CMA /-1 TAD CHLNU CLOS7, DCA CHLNU /REDUCE BY 1 OR CLEAR TAD CHLNUM JMS QPUTQ /PUT INFO BACK CLA CMA /-1 DIN ;F1 /STOP CLOSING TWICE JMP NEXT /
DGDBK=DRTSL2 DGRPK=DRTSL3 DREADF=DRTSL1 / DSQWOF=DRTSL1 DWNUB=DRTSL2 DWNUW=DRTSL3 / /READ READSQ MAINLINE DREADR, TAD F2 DCA OPTION DREAD2, TIN ;F1 /READ OR READSQ DCA CHLNUM TAD CHLNUM TAD (-40 /32 SMA CLA JMP ERROR2 /INVALID TAD CHLNUM JMS QGETQ /GET INFO TAD CHLNU /NO.OF USERS SNA CLA JMP ERROR2 /NO USERS TAD OPTION CLL RAR /0 OR 1? SZA CLA JMP AIWR /NO, GET OR PUTAIW TAD ACH DCA REQKEY TAD ACM DCA REQKEY+1 TAD ACL DCA REQKEY+2 TAD F2 SNA CLA JMP READR3 JMP READR2 PAGE / * * * * * * */5200 READR2, JMS GORAS DSQSF /READSQ, RASBOL SECTION JMP DRDREX READR3, JMS GORAS DGSF DRDREX, TAD DGRPK /REC POSN. DCA ACL TAD IIRECL DCA ACM DCA ACH JMP NEXT /WRITE WRITR, JMS DWRANS JMP NEXT /WRITSQ WRITQR, CLA IAC /1 JMS DWRANS WRITQ2, TAD CHLNUM JMS QPUTQ /PUT BACK TAD DSQWOF SNA CLA JMP NEXT JMP ERROR1 /NEARLY FULL EXIT /CHAIN OVERLAY SAVE. OVERR, JMS QGINST /GET DEV,FILENA JMS QFETCH /HANDLER JMS QLOOK TAD CFP2 /START BLOCK DCA CTBLK TAD CFP1 DCA CTDEV JMS I TVBLKO /READ CORE CONT. BLOCK TO XAREA TAD XAREA+1 /CDI START RTR;RAR AND K7 DCA ACM DCA ACH TAD XAREA+2 /START ADDR. DCA ACL TAD OPTION TAD (-6 SNA CLA CLA CLL CML RAR / 4000=WRITE DCA QRWK TAD (XAREA+4 DCA ERS0 /FIRST DOUBLE WORD ISZ CTBLK /POINT TO FIRST DATA BLOCK QOVLOP, TAD I ERS0 DCA BOXA /CORE ADDR. JMS I TVFAIL ISZ ERS0 TAD I ERS0 /FUNC.CONT. WORD TAD QRWK /READ OR WRITE JMS HANDLR JMP ERROR2 /ERROR ISZ XAREA /COUNT SEGMENTS SKP CLA /NOT FINISHED JMP QOVEND /THE END TAD I ERS0 /GET NO.OF PAGES BSW IAC RAR /ROUND UP TO BLOCKS AND (37 SNA TAD (40 /NO.OF BLOCK TAD CTBLK DCA CTBLK ISZ ERS0 JMP QOVLOP QOVEND, TAD OPTION TAD (-4 /CHAIN? SNA CLA JMP GOVACR /CHAIN JMP NEXT /OVERLAY,SAVE /OS-8 ENTER, CLOSE. FILE LENGTH IN ACC. QRWK, OS8COM, 0 JMS QGINST /GET DEV.NAME JMS QFETCH TAD (CHLNAM DCA OSONAM TAD CFP1 JMP I OS8COM OS8ENR, JMS OS8COM CIF 10 JMS I (200 3 /ENTER OSONAM, 0 /NAME
OSOLEN, 0 JMP ERROR1 /ERROR CLA TAD OSOLEN JMP TOACL OS8CLS, TAD ACL DCA OSCLEN
JMS OS8COM TAD (CHLNAM
DCA OSCNAM CIF 10
JMS I (200 4 /CLOSE
OSCNAM, 0 OSCLEN, 0
JMP ERROR2 CLA JMP TOACL /CONSTANTS...READ SEQUENTIAL ROUTINE / REQREC=REQKEY DSQRWI=DRTSL3 DSQWKA=DRTSL2 DSQRPB=DRTSL4 / PAGE /* * * * * * * * / /THIS ROUTINE READS OR WRITES A GIVEN BLOCK IN ABSOLUTE MODE / ABSRWR, CLA CLL TAD ACM /FETCH DEVICE NUMBER DCA CTDEV /SET IT TAD ACL /FETCH BLOCK NUMBER DCA CTBLK /SET IT TAD F1 /FETCH OPCODE SNA CLA /WAS OPCODE = 10? CLA CLL CML RAR /YES...SET AC0 TO 1 JMS I TVBLKO /OPERATE ON BLOCK JMP NEXT /EXIT / /THIS ROUTINE CONTROLS THE OPERATIONS OF WRITING TO /THE DEVICE IN RANDOM, SEQUENTIAL OR ABSOLUTE MODE / /THE FIRST SECTION EXITS TO THE RASBOL-8 INSTRUCTIONS /WHICH SET UP THE RANDOM WRITE OPERATION / DWRANS, 0 SZA CLA /WRITE JMP DWSEQS /WRITSQ JMS GORAS /EXIT TO RASBOL... DWWLB /...AT THIS ADDRESS / /AFTER THE RASBOL SECTION HAS BEEN SUCCESSFULLY /COMPLETED, CONTROL IS RETURNED TO THIS POINT / DWRAN4, CLA CLL CML RAR /SET 4000 JMS I TVBLKO /TO WRITE BLOCK CLA CLL JMP I DWRANS / / /THE SECOND SECTION EXITS TO THE RASBOL-8 ROUTINE /WHICH SETS UP THE SEQUENTIAL WRITE OPERATION / DWSEQS, JMS GORAS /EXIT TO RASBOL... DSEQWR /...AT THIS ADDRESS / /CONTROL RETURNS HERE WHEN THE RASBOL ROUTINE ENDS / JMP DWRAN4 /TO WRITE BLOCK
/THIS SUBROUTINE TRANSFERS CONTROL TO THE /RASBOL-8 INTERPRETER FROM WITHIN ITSELF / GORAS, 0 CLA CLL TAD NARG DCA SVARG0 TAD NARGW DCA SVARG0+1 TAD I GORAS /FETCH ADDRESS DCA NARGW /SET IT CLA IAC /ALL RASBOL IN FLD.1 DCA NARG /CLEAR FIELD ISZ GORAS /INDEX FOR NORMAL RETURN JMP NEXT / /THIS SUBROUTINE RETURNS CONTROL TO WHERE IT WAS /INTERRUPTED IN THE PAL-III PORTION OF THE MICRO /IF THE 36 BIT AC IS ZERO. OTHERWISE THE ROUTINE /RETURNS CONTROL TO THE ADDRESS IN LOW ORDER AC. / RETRAS, 0 CLA CLL TAD SVARG0 /RESET DCA NARG TAD SVARG0+1 DCA NARGW TAD ACL /FETCH LOW ORDER AC SNA /WAS IT ZERO? JMP I GORAS /YES...NORMAL RETURN DCA GORAS /NO...SET ADDRESS DCA ACL /CLEAR ADDRESS FROM AC JMP I GORAS /RETURN TO ADDRESS FROM AC / /CONSTANTS...CONTROL TRANSFER ROUTINES / SVARG0, ZBLOCK 2 /
/ACCU DOUBLE WORD DIVIDE BY SINGLE WORD UNSIGNED IN DVSOR /RESULT IN ACCU, REMAINDER IN MQLO DVSOR, 0 DVD1, 0 DCA MQLO DCA MQH TAD ACM CMA DCA MQM /NEGATIVE DCA ACL /CLEAR ACC DCA ACM TAD DVSOR SNA /CHECK FOR ZERO DIVISOR JMP I DVD1 CIA DCA DVSOR DVD2, CLL TAD DVSOR TAD MQLO SZL JMP DVD4 JMS I TVFAIL ISZ MQM JMP DVD4 /DECREMENT HI.ORD.WORD CLA CLL TAD ACL JMP I DVD1 /FINISHED DVD4, DCA MQLO ISZ ACL /RESULT JMP DVD2 JMP I DVD1 SUBNCX, 0 PROG=. / / / /* * * * * * / FIELD 1 *6600 / OBMES1, PRINT 22 ;TEXT '__OBJECT ERROR AT ' / RFRAS, CLEAR GOPAL ;RETRAS / EXITC, LOADIM ;TEXT 'S0' ADD1 ;USRNUM STORE1+1 ;EXITD+6 CHANNEL ;EXITD ;EXITD+1 ;CHAIN WAIT /SHOULD NEVER GET HERE GOTO ;EXITC EXITD, 0 ;DEVICE SYS;FILENAME STARTR.S0 / /THIS RASBOL-8 SUBROUTINE CALCULATES THE RECORD /NUMBER OF THE FIRST UNUSED RECORD IN THE FILE / CALFUR, ZBLOCK 2 MOVE1 ;IIRECL ;DVSOR LOADIM ;400 /SET 256 GOPAL ;DVD1 /DIVIDE BY RECORD LENGTH STORE1 ;RPB /STORE RECORDS/BLOCK LOAD1 ;IIFUBN /GET BLOCK NUMBER MULT1 ;RPB /MULTIPLY BY REC./BLOCK STORE2 ;NREC /STORE NUMBER OF RECORDS MOVE1 ;IIRECL ;DVSOR LOAD1 ;IIFUWN /GET WORD NUMBER GOPAL ;DVD1 ADDIM ;1 /ADD 1 ADD2 ;NREC /ADD NUMBER OF RECORDS GOTO ;CALFUR /RETURN / /CONSTANTS...CALCULATION SUBROUTINE / NREC=DRTSL2 RPB=DRTSL1 /THIS IS THE SECOND PART OF THE OPEN ROUTINE WHICH /USES A SECTION OF RASBOL-8 INSTRUCTIONS TO CALCULATE /THE NUMBER OF THE FIRST UNUSED RECORD IN THE FILE / OPCALR, GOSUB ;CALFUR /TO CALCULATE ROUTINE OPOUT, STORE2 ;TNRP1 /STORE NUMBER GOTO ;RFRAS /RETURN TO MICRO / / /THIS ROUTINE WRITES A RECORD TO A FILE /WHICH MAY BE EITHER RANDOM OR SEQUENTIAL. /THE ROUTINE IS ACTUALLY WRITTEN IN RASBOL-8 / DSEQWR, CLEARW ;DSQWOF /CLEAR OVERFLOW FLAG LOAD1 ;IIFUWN /FETCH WORD NUMBER ADD1 ;IIRECL /ADD RECORD LENGTH STORE1 ;DWNUW /STORE AS NEW NUMBER ADD1 ;IIRECL SUBTIM ;400 /SUBTRACT 256 GOIF ;DWCONT ;DWCONT LOAD1 ;IIFUBN ADDIM ;1 STORE1 ;DWNUB DWSNII, MOVE1 ;DWNUB ;IIFUBN /SET NEW BLOCK NUMBER CLEARW ;DWNUW /ZERO TO NEW WORD DWCONT, MOVE1 ;DWNUW ;IIFUWN /SET NEW WORD NUMBER LOAD1 ;IINBFM SIGN1 ADD1 ;DWNUB ADDIM ;1 ADD1 ;IINBI GOZERO ;EXFULL DWWLB, MOVE1 ;CFP1 ;CTDEV /SET DEVICE NUMBER MOVE1 ;CFRBA ;CTBLK /SET BLOCK NUMBER GOTO ;RFRAS /RETURN TO MICRO / /IF THE INSTRUCTION WAS A "WRITE SEQUENTIAL" AND, /IN UPDATING THE INDEX, THE FIRST UNUSED BLOCK /IS DISCOVERED TO BE GREATER THAN OR EQUAL TO THE /LAST BLOCK IN THE FILE, AN ERROR EXIT IS TAKEN. / /IF THE BLOCK NUMBER IS GREATER THAN THE LAST BLOCK /IN THE FILE, THE MACRO 36 BIT AC IS SET TO -1 AND /THE ROUTINE EXITS WITHOUT WRITING THE BLOCK. / /IF THE BLOCK NUMBER IS EQUAL TO THE LAST BLOCK /IN THE FILE, THE OVERFLOW FLAG IS SET AND THE /ROUTINE PROCEEDS TO WRITE THE BLOCK. AFTER THE /BLOCK IS WRITTEN ,THE 36 BIT AC IS SET TO -1 /TO WARN THE USER AND THE ROUTINE EXITS. / EXFULL, INCREM ;DSQWOF /SET OVERFLOW FLAG GOTO ;DWWLB /BACK TO MAIN ROUTINE /
DSQSF, LOAD2 ;CFP1 /GET BLOCK PARAMETERS ADD1 ;IINBI /ADD NUMBER OF INDEX BLOCKS STORE2 ;CTDEV /SET BLOCK PARAMETERS CLRWDS ;4;DRTSL1 / /CALCULATE NUMBER OF RECORDS IN A 256 WORD BLOCK / DSQSFB, MOVE1 ;IIRECL ;DVSOR LOADIM ;400 /SET 256 GOPAL ;DVD1 /DIVIDE BY RECORD LENGTH STORE1 ;DSQRPB /STORE AS REC./BLOCK / /CALCULATE POSITION OF REQUIRED RECORD / DSQCRP, MOVE1 ;DSQRPB ;DVSOR LOAD ;REQREC /GET REC NO GOZERO ;DSQGNU SUBTIM ;1 /SUBTRACT 1 GOPAL ;DVD1 /NO...DIVIDE BY NO OF RECS STORE1 ;DSQWKA /STORE AS NO OF BLOCKS REMAIN /FETCH REMAINDER MULT1 ;IIRECL /MULTIPLY BY REC LENGTH STORE1 ;DSQRWI /STORE AS WORD INDEX LOAD1 ;IINBFM /GET NO OF BLOCKS (-VE) SIGN1 /SET SIGN ADD1 ;IINBI /ADD NO OF INDEX BLOCKS ADD1 ;DSQWKA /ADD NO OF BLOCKS (CALC.) GOZERO ;DGLTI3 /OVERFLOW? GOPOS ;DGLTI3 /YES...ERROR DSQSET, LOAD1 ;DSQWKA /GET NO OF BLOCKS ADDTO1 ;CTBLK /ADD TO BLOCK NUMBER / / /AT THIS POINT THE REQUIRED RECORD HAS BEEN FOUND /AND THE RELEVANT INFORMATION ABOUT IT IS STORED /FOR FUTURE REFERENCE BY THE MICRO. BEFORE THE BLOCK /IS READ AND THE ROUTINE EXITS TO THE INTERPRETER, /THE BLOCK IS CHECKED TO SEE IF IT IS ALREADY IN CORE. /IF IT IS, THE READ IS BYPASSED. / DSQEXT, MOVE1 ;DSQRWI ;CFRWI /SAVE REC. WORD INDEX LOAD1 ;CTBLK SUBT1 ;CFRBA /SAME BLOCK AS BEFORE? GONZRO ;DSQEX2 /NO,READ BLOCK DSQEX1, COMPAR ;CTDEV ;LSDEV ;1 /SAME DEV. AS BEFORE? GOZERO ;RFRAS /YES...RETURN TO MICRO DSQEX2, CLEAR /CLEAR AC GOPAL ;BLOKOP /FETCH BLOCK GOTO ;RFRAS /RETURN TO MICRO / /IF THE REQUIRED RECORD NUMBER WAS ZERO, /FETCH THE NEXT EMPTY RECORD IN THE FILE / DSQGNU, GOSUB ;CALFUR /CALCULATE RECORD NUMBER STORE ;REQREC /STORE IT STORE2 ;TNRP1 /STORE AS LAST RECORD GOTO ;DSQSFB /CONTINUE /
/ /READ. INDEXED SEQUENTIAL MAIN LINE / DGSF, CLRWDS ;4;DRTSL1 INCREM ;DREADF /SET 1 IN FLAG MOVE2 ;CFP1 ;CTDEV /SET BLOCK PARAMETERS MOVIM ;1 ;SUBNCX /SET NUMBER CHECKED / /TEST REQUIRED KEY TO SEE IF IT IS LESS /THAN THE LOWEST KEY IN THE INDEX BLOCK / DGGIB, CLEAR GOPAL ;BLOKOP /FETCH INDEX BLOCK COMPAR ;XAREA ;REQKEY ;3 /INDEX LOWEST : REQUIRED GOZERO ;DGGDBS GOPOS ;DGLIL2 /PROC.LOWEST DGG2, COMPAR ;XAREA+374 ;REQKEY ;3 /INDEX HIGHEST : REQUIRED GONEG ;DGG3 /<,SEARCH GOPOS ;DGIBS /LOCATE DATA BLOCK ADDWIM ;2 ;DREADF /ADD TO FLAG DGG3, ADDWIM; 125;DGDBK /ADD TO DATA BLOCK COUNT DECGOZ ;DGG4 ;DREADF /CLEAR "1ST" FLAG CLEARW ;DREADF /CLEAR "EQUAL" FLAG GOTO ;DGLIL2 /GET BLOCK DGG4, LOAD1 ;IINBI /GET NO. OF INDEX BLOCKS SUBNC, SUBT1 ;SUBNCX /SUBTRACT NUMBER CHECKED GOIF ;DGGDBS ;DGGDBS /GET BLOCK IF NO MORE INCREM ;SUBNCX /NUMBER CHECKED + 1 INCREM ;CTBLK /BLOCK NUMBER + 1 INCREM ;DREADF GOTO ;DGGIB /GET NEXT INDEX BLOCK / /THIS ROUTINE TAKES THE APPROPRIATE ACTION IF THE /REQUIRED KEY IS LESS THAN THE LOWEST IN AN INDEX / DGLIL2, GOIFZO ;DGLTI3 ;DGDBK DECREM ;DGDBK /DATA BLOCK COUNT - 1 DGLTIL, GOTO ;DGGDBS /GET BLOCK DGLTI3, LOADIM ;ERROR1 /SET ERROR ADDRESS GOPAL ;RETRAS /RETURN TO MICRO / /IF THE REQUIRED KEY WAS LESS THAN THE HIGHEST IN AN /INDEX BLOCK, THAT INDEX BLOCK IS SEARCHED TO LOCATE /THE DATA BLOCK IN WHICH THE REQUIRED RECORD IS STORED / DGIBS, CLEARW ;DREADF /CLEAR FLAG MOVIM+10 ;XAREA+3 ;DGIBSL+2 /SET KEY ADDRESS DGIBSL, COMPAR ;REQKEY ;0 ;3 /COMPARE KEYS GOIF ;DGGD2 ;DGGDBS /= GET NEXT: < GET THIS ADDWIM+10 ;3;DGIBSL+2 /ADD TO KEY ADDRESS INCREM ;DGDBK /DATA BLOCK COUNT + 1 GOTO ;DGIBSL /BACK FOR NEXT COMPARE / /THE DATA BLOCK CONTAINING THE REQUIRED RECORD IS NOW FETCHED / DGGD2, INCREM ;DGDBK /DATA BLOCK COUNT + 1 DGGDBS, LOAD1 ;CFP2 /SET START BLOCK ADD1 ;IINBI /ADD NO. OF INDEX BLOCKS ADD1 ;DGDBK /ADD DATA BLOCK COUNT STORE1 ;CTBLK /SET AS CURRENT BLOCK CLEAR GOPAL ;BLOKOP /READ DATA BLOCK / /THE DATA BLOCK IS NOW SEARCHED TO DETERMINE /THE POSITION OF THE REQUIRED RECORD WITHIN IT / GOIFZO ;DGERKL ;IIKEYL /ERROR IF KEY LENGTH 0 LOAD1 ;IIKEYL /GET KEY LENGTH SUBTIM ;3 /SUBTRACT 3 GOIF ;DGSB ;DGSB /BRANCH IF O.K. DGERKL, PRINT 4 ;TEXT '_KEY' /PRINT MESSAGE LOADIM ;MOBERR /SET ADDRESS GOPAL ;RETRAS /RETURN TO MICRO DGSB, MOVE1+10 ;IIKEYL ;DGFRK+3 /SET KEY LENGTH CLEARW ;DGRPK /CLEAR RECORD POSITION COUNT MOVIM+10 ;XAREA+1 ;DGFRK+1 /SET RECORD KEY ADDRES LOADIM ;3 /SET 3 SUBT1 ;IIKEYL /SUBTRACT KEY LENGTH ADDIM ;REQKEY /ADD KEY ADDRESS STORE1+1 ;DGFRK+2 /SET REQ. KEY ADDRESS DGFRLP, LOADIM ;400 /SET 256 SUBT1 ;IIRECL /SUBTRACT RECORD LENGTH SUBT1 ;DGRPK /SUBTRACT RECORD POSITION GONEG ;DGLTI3 /= O.K. < ERROR DGFRK, COMPAR ;0 ;0 ;0 /> O.K. COMPARE KEYS GOZERO ;DGEXIT /= FOUND: < CHECK NEXT GOPOS ;DGLTI3 /> ERROR: NOT FOUND LOAD1 ;IIRECL /FETCH RECORD LENGTH ADDTO1+1 ;DGFRK+1 /ADD TO KEY POINTER ADDTO1 ;DGRPK /ADD TO RECORD POSITION COUNT GOTO ;DGFRLP /BACK FOR NEXT RECORD / /AT THIS POINT THE REQUIRED RECORD HAS BEEN /FOUND. THE RELEVANT INFORMATION IS STORED /FOR FURTHER REFERENCE BY THE MICRO BEFORE /THE ROUTINE EXITS TO THE MAIN INTERPRETER. / DGEXIT, CLEARW ;LSDEV /FORCE RE-READ MOVE1 ;DGRPK ;CFRWI /STORE RECORD WORD INDEX CLEARW ;DREADF /CLEAR FLAG GOTO ;RFRAS /RETURN TO MICRO /
/* * * * * * / /THIS SUBROUTINE PROVIDES THE OPEN ROUTINE WITH THE /ADDRESS OF THE NEXT AVAILABLE PAGE FOR A DEVICE /HANDLER OR WITH ZERO IF NO MORE PAGES ARE LEFT / FIELD 1 *7400 /POWERS OF TEN NEGATIVE CCON, 6653;7501;6000 /10,000,000,000 7704;3123;3000 /1,000,000,000 7772;0241;7400 /100,000,000 7777;3166;4600 /10,000,000 7777;7413;6700 /1,000,000 7777;7747;4540 /100,000 7777;7775;4360 /10,000 7777;7777;6030 /1,000 7777;7777;7634 /100 7777;7777;7766 /10 PBLANK, -"0 ;2656 /ZERO IN MASK -SPACE ;0156 /SPACE IN MASK -"$ ;2552 /FLOAT DOLLAR -"* ;2252 /ASTER.FILL -", ;0126 /COMMA INSERT -"\ ;1414 /DELETE 0 ;2626 /ALL ELSE INSET MASK / GETPAG, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD INSTRUCTION DCA GPEX /SET IT GETPA2, TAD LIST3 /GET FLAG SNA /IS IT SET? JMP GPEX /NO...NO ROOM...EXIT TAD GETPA2 /YES...ADD INSTRUCTION DCA .+2 /SET IT CLA CLL 0 /GET PAGE ADDRESS GPEX, 0 /RESET FIELD JMP I GETPAG /RETURN / /CONSTANTS / DHALST, 6401 / 06400 - TWO PAGES 6601 / 06600 - TWO PAGES 7000 / 07000 - ONE PAGE LIST3, -3 / / /THIS SUBROUTINE UPDATES THE SPACE AVAILABLE FLAG /AFTER EACH DEVICE HANDLER HAS BEEN FETCHED / USFLAG, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD INSTRUCTION DCA USFEX /SET IT CLA CLL CMA /SET -1 TAD 37 /ADD TABLE ADDRESS TAD OPEN3 /ADD DEVICE NUMBER DCA TABPNT /SET AS POINTER CDF 10 /SET DATA FIELD TO 1 TAD I TABPNT /FETCH D.H.I. WORD SPA CLA /TWO PAGE? IAC /YES...SET 2 IAC /NO...SET 1 TAD LIST3 /ADD FLAG DCA LIST3 /RESTORE IT USFEX, 0 /RESET FIELD JMP I USFLAG /RETURN / /CONSTANT / TABPNT, 0 / / /THIS SUBROUTINE IS USED TO REWRITE THE DIRECTORY /SEGMENT AFTER MODIFYING THE INDEX INFORMATION / REWDS, 0 CLA CLL RDF /READ DATA FIELD TAD RDSCFI /ADD CDI INSTRUCTION DCA REWDSX /SET FOR EXIT CDF 10 /SET DATA FIELD TO 1 TAD 7 /GET DIRECTORY KEY WORD AND (7 /EXTRACT SEGMENT NUMBER DCA SEGNUM /SET AS ARGUMENT CIF 0 /SET INSTRUCTION FIELD TO 0 JMS I 51 /TO DEVICE HANDLER 4210 /WRITE 2 PAGES (FIELD 1)... 1400 /...FROM HERE... SEGNUM, 0 /...TO HERE JMP .+3 /ERROR RETURN REWDSX, 0 /RESET INSTRUCTION FIELD JMP I REWDS /RETURN TO CLOSE ROUTINE RDSCFI, CDI 0 /SET INSTRUCTION FIELD TO 0 JMP I (ERROR2 /TO INDICATE ERROR / / / / FIELD 0 *PROG / PAGE // // /// /// /// /// /// /THIS SECTION DEALS WITH THE WAITING AND SWAPPING OF USERS / / / /SAVE THIS USERS INFO, GET NEXT. NXUSER, CLA CLL IAC /+1 TAD USRAREA DCA IR2 /SKIP STATUS TAD (STATUS+1 DCA IR1 TAD (-36 /30 WDS. DCA ERS0 NXLU1, /LOOP TO PUT BACK TAD I IR1 CDF 10 DCA I IR2 CDF 0 ISZ ERS0 JMP NXLU1 /GET ADDR. NEXT USERS AREA NXINI, CLA CLL CMA /-1 TAD USRNUM SNA TAD NUMUSR DCA USRNUM TAD USRNUM CLL RAL / 2 PER USER TAD (USRINFO-2 DCA ERS0 TAD I ERS0 DCA USRPFL DCA I ERS0 /CLEAR P.FAIL ISZ ERS0 TAD I ERS0 DCA USRAREA / GET AREA CLA CLL CMA /-1 TAD USRAREA DCA IR1 TAD (STATUS-1 DCA IR2 TAD (-40 / 32 WDS. DCA ERS0 NXLU2, CDF 10 /LOOP TO GET AREA TAD I IR1 CDF 0 DCA I IR2 ISZ ERS0 JMP NXLU2 JMS I TVFAIL / /
/CHECK STATUS BEFORE EXECUTING NEXT INSTRUCTION EXNEXT, CLA CLL TAD USRAREA /ADDRESS OF STATUS,STATU2 DCA ERS0 CDF 10 TAD I ERS0 /STATUS,CR'S, CHARS. DCA STATUS ISZ ERS0 TAD I ERS0 /STATUS2, ^C,^S, SPACES IN OUT BUFFER DCA STATU2 CDF 0 TAD STATU2 /^C RAL SZL CLA JMP ABORTN /YES ABORT. / /SUSPEND TAKEN OUT TAD USRPFL SZA CLA /POWER FAIL? JMP NXPFL /YES /CHECK IF WAITING TAD WTMASK /WAITING FOR INPUT? SNA JMP EXNEX2 /NO AND STATUS /YES,ANY INPUT? SNA CLA JMP NXUSER /NO EXNEX2, TAD STATU2 AND WTMSK2 SNA CLA JMP NXUSER /STILL WAITING EXNXOK, JMP START2 /NO, DO THIS INSTRUCTION NORMALLY /POWER RESTART ROUTINE NXPFL, TAD USRNUM CLL RAL // X2 TAD (USRINFO-2 DCA ERS0 DCA I ERS0 /CLEAR FLAGS DCA USRPFL TAD ZZPFL+1 /ANY ADDRESS STORED? SNA JMP EXNEX2 /NO, DO NEXT DCA ARG1 TAD ZZPFL DCA F1 JMP GOSUBR /DO RE-SET-UP ROUTINE
/ / / /**************************************************************************** / FIELD 1 *2000 / /THESE ARE THE FIELD ONE TIME SHARE ROUTINES /ENTRY POINT TIMESH, 0 CLA CLL CDI 10 JMP INZ1 /FOR EACH USER KSFZ1=KSF KRBZ1=KRB TLSZ1=TLS TSFZ1=TSF / /POINTERS, INPUT CHARZ1, 0 INBIZ1, INBFZ1 /INPUT PTR.TO INPUT BUFFER INBOZ1, INBFZ1 /OUTPUT PTR.TO INPUT B. LIBFZ1=30 /LENGTH INPUT B. INEBZ1=-INBFZ1-LIBFZ1+1 /MINUS END OF BUFFER /CHECK FOR INPUT FROM KEYBOARD, STORE IN BUFFER INZ1, KSFZ1 /ANY CH.? JMP OUTZ1 /NO KRBZ1 /GET CHAR. AND (177 TAD (200 /PARITY DCA CHARZ1 TAD CHARZ1 TAD (-"C+100 /^C SZA JMP IN2Z1 TAD STA2Z1 RAL CLL CML RAR /SET 4000= ABORT INOZ1, DCA STA2Z1 JMP OUTZ1 IN2Z1, TAD ("C-"S /^S SZA JMP IN3Z1 TAD STA2Z1 RTL CLL CML RTR JMP INOZ1 /SET 2000= SUSPEND IN3Z1, TAD ("S-"Q /^Q IGNORE SZA CLA JMP IN5Z1 TAD STA2Z1 AND (5777 /UNSET ^S DCA STA2Z1 JMP OUTZ1 IN5Z1, TAD I INBIZ1 /IS ROOM IN BUFFER? SZA CLA JMP OUTZ1 /NO TAD CHARZ1 DCA I INBIZ1 TAD INBIZ1 /UPDATE BUF.POINTERS TAD (INEBZ1 SMA CLA TAD (-LIBFZ1 IAC TAD INBIZ1 DCA INBIZ1 /PUT BACK ISZ STATZ1 /CH.IN BFR TAD CHARZ1 TAD (-CRET /CR? SNA CLA IAC BSW /100 TAD STATZ1 DCA STATZ1 JMP OUTZ1 /GO DO OUTPUT /GET A CHARACTER FROM BUFFER, RETURN TO MAIN PROGRAM GCHAZ1, 0 CDI 10 CLA CLL DCA CHARZ1 TAD I INBOZ1 /GET & STORE SNA JMP GCH2Z1 DCA CHARZ1 DCA I INBOZ1 /CLR BUFFER TAD INBOZ1 /UPDATE PTRS. TAD (INEBZ1 SMA CLA TAD (-LIBFZ1 IAC TAD INBOZ1 DCA INBOZ1 /PUT BACK TAD STATZ1 JMS DECHAF /REDUCE CHAR.COUNT DCA STATZ1 TAD CHARZ1 TAD (-CRET /CR? SZA CLA JMP GCH2Z1 TAD STATZ1 /REDUCE CR.COUNT BSW JMS DECHAF BSW DCA STATZ1 GCH2Z1, TAD CHARZ1 CDI 0 JMP I GCHAZ1 /RETURN WITH CHARACTER. / /EXIT FROM TIMESHARE TIMEND, CDI 0 JMP I TIMESH / / /INPUT BUFFER, INBFZ1, ZBLOCK LIBFZ1 / PAGE /** ** ** ** ** ** ** ** / /POINTERS TO OUTPUT BUFFER OUBOZ1, OUBFZ1 /OUTPUT,OUTPUT BUFFER OUBIZ1, OUBFZ1 /INPUT,OUTPUT BUFFER LOBFZ1=200 /128, LENGTH OUTPUT BUFFER OUEBZ1=-OUBFZ1-LOBFZ1+1 OUIMZ1, 0 /IMMEDIATE PRINT BUFFER (BELL, ETC). CHORZ1,0 /TEMP /OUTPUT A CHARACTER IF PRINTER IS READY OUTZ1, TAD STA2Z1 /^S? RTL /2000 SZL CLA JMP OUTEZ1 /YES , FORGET IT TSFZ1 /PRINTER READY? JMP OUTEZ1 /NO OUT1Z1, TAD OUIMZ1 /ANY TO PRINT FIRST? SNA JMP OUT3Z1 /NO OUT2Z1, TLSZ1 /PRINT CLA CLL DCA OUIMZ1 JMP OUTEZ1 OUT3Z1, TAD I OUBOZ1 /ANY IN BUFFER? SNA JMP OUTEZ1 DCA OUIMZ1 /STORE DCA I OUBOZ1 /CLR BUFFER TAD OUBOZ1 TAD (OUEBZ1 SMA CLA TAD (-LOBFZ1 IAC TAD OUBOZ1 DCA OUBOZ1 ISZ STA2Z1 /SPACE COUNT JMP OUT1Z1 /PRINT / OUTEZ1, JMP INZ2 /CONTINE SKIP CHAIN, OR RETURN. /******* / /PUT A CHARACTER IN OUTPUT BUFFER FOR PRINTING. PCHAZ1, 0 CDI 10 DCA CHORZ1 TAD CHORZ1 SNA /NON.ZERO JMP PCHEZ1 /OUT,ZERO SMA /FOR IMMED.PRINT? JMP .+4 /NO CIA DCA OUIMZ1 JMP PCHEZ1 CLA TAD I OUBIZ1 /CHECK FOR ROOM SZA CLA JMP PCHEZ1 /NONE TAD CHORZ1 DCA I OUBIZ1 /PUT IN BUFFER TAD OUBIZ1 TAD (OUEBZ1 SMA CLA TAD (-LOBFZ1 IAC TAD OUBIZ1 DCA OUBIZ1 CLA CLL CMA /-1 TAD STA2Z1 SMA DCA STA2Z1 /SPACES LESS PCHEZ1, CDI 0 JMP I PCHAZ1 / /THIS USERS 32 WORD SWAPPING AREA / STATZ1, 0 STA2Z1, 0177 0 1700 ZBLOCK 6 1;EXITC /FIELD & ADDR. OF START ZBLOCK 11 /9 ABORZ1, 0 ;0 /FIELD ADDRESS. NNEXT OBTNZ1, GCHAZ1 PRNTZ1, PCHAZ1 PRN2Z1, PCHAZ1 /** MAYBE 2 PRINTERS 1 ZBLOCK 4 / PAGE /** ** ** ** ** ** OUBFZ1, ZBLOCK LOBFZ1
PAGE /** ** ** ** ** ** ** /FOR EACH USER KSFZ2=6301 KRBZ2=6306 TLSZ2=6316 TSFZ2=6311 / /POINTERS, INPUT CHARZ2, 0 INBIZ2, INBFZ2 /INPUT PTR.TO INPUT BUFFER INBOZ2, INBFZ2 /OUTPUT PTR.TO INPUT B. LIBFZ2=20 /LENGTH INPUT B. INEBZ2=-INBFZ2-LIBFZ2+1 /MINUS END OF BUFFER /CHECK FOR INPUT FROM KEYBOARD, STORE IN BUFFER INZ2, KSFZ2 /ANY CH.? JMP OUTZ2 /NO KRBZ2 /GET CHAR. AND (177 TAD (200 /PARITY DCA CHARZ2 TAD CHARZ2 TAD (-"C+100 /^C SZA JMP IN2Z2 TAD STA2Z2 RAL CLL CML RAR /SET 4000= ABORT INOZ2, DCA STA2Z2 JMP OUTZ2 IN2Z2, TAD ("C-"S /^S SZA JMP IN3Z2 TAD STA2Z2 RTL CLL CML RTR JMP INOZ2 /SET 2000= SUSPEND IN3Z2, TAD ("S-"Q /^Q IGNORE SZA CLA JMP IN5Z2 TAD STA2Z2 AND (5777 /UNSET ^S DCA STA2Z2 JMP OUTZ2 IN5Z2, TAD I INBIZ2 /IS ROOM IN BUFFER? SZA CLA JMP OUTZ2 /NO TAD CHARZ2 DCA I INBIZ2 TAD INBIZ2 /UPDATE BUF.POINTERS TAD (INEBZ2 SMA CLA TAD (-LIBFZ2 IAC TAD INBIZ2 DCA INBIZ2 /PUT BACK ISZ STATZ2 /CH.IN BFR TAD CHARZ2 TAD (-CRET /CR? SNA CLA IAC BSW /100 TAD STATZ2 DCA STATZ2 JMP OUTZ2 /GO DO OUTPUT /GET A CHARACTER FROM BUFFER, RETURN TO MAIN PROGRAM GCHAZ2, 0 CDI 10 CLA CLL DCA CHARZ2 TAD I INBOZ2 /GET & STORE SNA JMP GCH2Z2 DCA CHARZ2 DCA I INBOZ2 /CLR BUFFER TAD INBOZ2 /UPDATE PTRS. TAD (INEBZ2 SMA CLA TAD (-LIBFZ2 IAC TAD INBOZ2 DCA INBOZ2 /PUT BACK TAD STATZ2 JMS DECHAF /REDUCE CHAR.COUNT DCA STATZ2 TAD CHARZ2 TAD (-CRET /CR? SZA CLA JMP GCH2Z2 TAD STATZ2 /REDUCE CR.COUNT BSW JMS DECHAF BSW DCA STATZ2 GCH2Z2, TAD CHARZ2 CDI 0 JMP I GCHAZ2 /RETURN WITH CHARACTER. /DECREMENT HALF A WORD, NOT GO MINUS. DECHAF, 0 BSW DCA TEMPZ TAD TEMPZ AND (7700 SZA CLA TAD (7700 TAD TEMPZ BSW JMP I DECHAF TEMPZ, 0 / /INPUT BUFFER, INBFZ2, ZBLOCK LIBFZ2 / PAGE /** ** ** ** ** ** ** ** / /POINTERS TO OUTPUT BUFFER OUBOZ2, OUBFZ2 /OUTPUT,OUTPUT BUFFER OUBIZ2, OUBFZ2 /INPUT,OUTPUT BUFFER LOBFZ2=200 /128, LENGTH OUTPUT BUFFER OUEBZ2=-OUBFZ2-LOBFZ2+1 OUIMZ2, 0 /IMMEDIATE PRINT BUFFER (BELL, ETC). CHORZ2,0 /TEMP /OUTPUT A CHARACTER IF PRINTER IS READY OUTZ2, TAD STA2Z2 /^S? RTL /2000 SZL CLA JMP OUTEZ2 /YES , FORGET IT TSFZ2 /PRINTER READY? JMP OUTEZ2 /NO OUT1Z2, TAD OUIMZ2 /ANY TO PRINT FIRST? SNA JMP OUT3Z2 /NO OUT2Z2, TLSZ2 /PRINT CLA CLL DCA OUIMZ2 JMP OUTEZ2 OUT3Z2, TAD I OUBOZ2 /ANY IN BUFFER? SNA JMP OUTEZ2 DCA OUIMZ2 /STORE DCA I OUBOZ2 /CLR BUFFER TAD OUBOZ2 TAD (OUEBZ2 SMA CLA TAD (-LOBFZ2 IAC TAD OUBOZ2 DCA OUBOZ2 ISZ STA2Z2 /SPACE COUNT JMP OUT1Z2 /PRINT / OUTEZ2, JMP TIMEND /CONTINE SKIP CHAIN, OR RETURN. /******* / /PUT A CHARACTER IN OUTPUT BUFFER FOR PRINTING. PCHAZ2, 0 CDI 10 DCA CHORZ2 TAD CHORZ2 SNA /NON.ZERO JMP PCHEZ2 /OUT,ZERO SMA /FOR IMMED.PRINT? JMP .+4 /NO CIA DCA OUIMZ2 JMP PCHEZ2 CLA TAD I OUBIZ2 /CHECK FOR ROOM SZA CLA JMP PCHEZ2 /NONE TAD CHORZ2 DCA I OUBIZ2 /PUT IN BUFFER TAD OUBIZ2 TAD (OUEBZ2 SMA CLA TAD (-LOBFZ2 IAC TAD OUBIZ2 DCA OUBIZ2 CLA CLL CMA /-1 TAD STA2Z2 SMA DCA STA2Z2 /SPACES LESS PCHEZ2, CDI 0 JMP I PCHAZ2 / /THIS USERS 32 WORD SWAPPING AREA / STATZ2, 0 STA2Z2, 0177 0 1700 ZBLOCK 6 1;EXITC ZBLOCK 11 /9 ABORZ2, 0 ;0 /FIELD ADDRESS. NNEXT OBTNZ2, GCHAZ2 PRNTZ2, PCHAZ2 PRN2Z2, PCHAZ2 /** MAYBE 2 PRINTERS 1 ZBLOCK 4 STARZ2 / PAGE /** ** ** ** ** ** OUBFZ2, ZBLOCK LOBFZ2 / /AREA FOR FILE CHANEL DEFINITIONS, 16 WORDS EACH, 32 OF. QAREA, ZBLOCK 1000 $



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